# HG changeset patch # User John W. Eaton # Date 1344020380 14400 # Node ID a132d206a36a512544d5aa0804aa5c8ef27bfd68 # Parent d02b229ce693fa37a1eecf25dfa47da3face6258# Parent 6c5b6c0ab528f716289afe1bc049cacf6edbcee3 maint: periodic merge of default to gui diff -r d02b229ce693 -r a132d206a36a .hgsubstate --- a/.hgsubstate Thu Aug 02 12:12:00 2012 +0200 +++ b/.hgsubstate Fri Aug 03 14:59:40 2012 -0400 @@ -1,2 +1,2 @@ -33f823397dbb0edb57503f2f6dad2362456bc6a9 gnulib +0e3af50c9e20938bd1cea0182bf749ce61cb6782 gnulib f91e00f96bc29f7f6395f08c828e09599f945511 gui/qterminal diff -r d02b229ce693 -r a132d206a36a autogen.sh --- a/autogen.sh Thu Aug 02 12:12:00 2012 +0200 +++ b/autogen.sh Fri Aug 03 14:59:40 2012 -0400 @@ -30,9 +30,9 @@ (cd doc/interpreter; ./config-images.sh) -echo "generating src/DLD-FUNCTIONS/module.mk..." +echo "generating src/dldfcn/module.mk..." -(cd src/DLD-FUNCTIONS; ./config-module.sh) +(cd src/dldfcn; ./config-module.sh) echo "bootstrapping..." diff -r d02b229ce693 -r a132d206a36a build-aux/bootstrap.conf --- a/build-aux/bootstrap.conf Thu Aug 02 12:12:00 2012 +0200 +++ b/build-aux/bootstrap.conf Fri Aug 03 14:59:40 2012 -0400 @@ -18,6 +18,7 @@ # gnulib modules used by this package. gnulib_modules=" + base64 c-strcase copysign copysignf @@ -60,7 +61,6 @@ signal sigprocmask sleep - sleep stat stdint stdio diff -r d02b229ce693 -r a132d206a36a configure.ac --- a/configure.ac Thu Aug 02 12:12:00 2012 +0200 +++ b/configure.ac Fri Aug 03 14:59:40 2012 -0400 @@ -44,7 +44,7 @@ AC_REVISION($Revision: 1.603 $) AC_PREREQ([2.62]) AC_CONFIG_SRCDIR([src/octave.cc]) -AC_CONFIG_HEADER([config.h]) +AC_CONFIG_HEADERS([config.h]) AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_MACRO_DIR([m4]) @@ -52,9 +52,11 @@ OCTAVE_HOST_TYPE -AC_DEFINE(OCTAVE_SOURCE, 1, [Define if this is Octave.]) +AC_DEFINE(OCTAVE_SOURCE, 1, [Define to 1 if this is Octave.]) -dnl FIXME -- we should probably only generate this file if it is missing. +dnl FIXME: Can this MSVC test be moved down to the section on finding a +dnl a C compiler which already has an MSVC exception test? +dnl FIXME: We should probably only generate this file if it is missing. ### Produce unistd.h for MSVC target, this simplifies changes in ### Octave source tree and avoid problems with lex-generated code. case "$canonical_host_type" in @@ -72,24 +74,8 @@ AC_USE_SYSTEM_EXTENSIONS -### Check for MSVC -have_msvc=no -case "$canonical_host_type" in - *-*-msdosmsvc) - have_msvc=yes - ;; - *-*-mingw*) - AC_MSG_CHECKING([for MSVC compiler]) - AC_PREPROC_IFELSE([AC_LANG_SOURCE([ -#ifndef _MSC_VER -#error "Not MSVC compiler" -#endif -])], have_msvc=yes, have_msvc=no) - AC_MSG_RESULT([$have_msvc]) - ;; -esac - ### Path separator. + sepchar=: AC_ARG_WITH(sepchar, [AS_HELP_STRING([--with-sepchar=], @@ -113,7 +99,7 @@ AC_DEFINE_UNQUOTED(SEPCHAR, ['$sepchar'], [Define this to be the path separator for your system, as a character constant.]) AC_DEFINE_UNQUOTED(SEPCHAR_STR, ["$sepchar"], [Define this to the path separator, as a string.]) -### some defaults +### Set default file locations OCTAVE_SET_DEFAULT(man1dir, '$(mandir)/man1') OCTAVE_SET_DEFAULT(man1ext, '.1') @@ -155,9 +141,9 @@ config_opts=$ac_configure_args AC_SUBST(config_opts) -### Make it possible to have Octave's array and matrix classes do bounds -### checking on element references. This slows some operations down a -### bit, so it is turned off by default. +### Enable bounds checking on element references within Octave's array and +### matrix classes. This slows down some operations a bit, so it is turned off +### by default. BOUNDS_CHECKING=false AC_ARG_ENABLE(bounds-check, @@ -165,29 +151,37 @@ [bounds checking for indexing in internal array classes (default is no)])], [if test "$enableval" = yes; then BOUNDS_CHECKING=true; fi], []) if $BOUNDS_CHECKING; then - AC_DEFINE(BOUNDS_CHECKING, 1, [Define to use internal bounds checking.]) + AC_DEFINE(BOUNDS_CHECKING, 1, [Define to 1 to use internal bounds checking.]) fi +### Use Octave's built-in memory allocator rather than straightforward malloc. +### Disabled by default. + USE_OCTAVE_ALLOCATOR=false AC_ARG_ENABLE(octave-allocator, [AS_HELP_STRING([--enable-octave-allocator], [use the obsolete octave_allocator class for many of Octave's objects (mostly octave_value types). You probably do NOT want to enable this feature. (default is no)])], [if test "$enableval" = yes; then USE_OCTAVE_ALLOCATOR=true; fi], []) if $USE_OCTAVE_ALLOCATOR; then - AC_DEFINE(USE_OCTAVE_ALLOCATOR, 1, [Define to use octave_allocator class.]) + AC_DEFINE(USE_OCTAVE_ALLOCATOR, 1, [Define to 1 to use octave_allocator class.]) fi +### Use atomic operations for internal reference counting. This is required +### for thread-safe behavior but incurs a significant slowdown, and is thus +### disabled by default. + USE_ATOMIC_REFCOUNT=false AC_ARG_ENABLE(atomic-refcount, [AS_HELP_STRING([--enable-atomic-refcount], - [use atomic operations for internal reference counting. This is required for thread-safe behavior. (default is no)])], + [use atomic operations for internal reference counting. This is required for thread-safe behavior. (default is no)])], [if test "$enableval" = yes; then USE_ATOMIC_REFCOUNT=true; fi], []) if $USE_ATOMIC_REFCOUNT; then - AC_DEFINE(USE_ATOMIC_REFCOUNT, 1, [Define to use atomic operations for reference counting.]) + AC_DEFINE(USE_ATOMIC_REFCOUNT, 1, [Define to 1 to use atomic operations for reference counting.]) fi -### Make it possible to disable running Make in the doc directory. -### Useful for building on systems without TeX, for example. +### Disable running Make in the doc directory. +### This is useful, for example, when building Octave on systems without TeX. + DOCDIR=doc AC_ARG_ENABLE(docs, [AS_HELP_STRING([--enable-docs], [build documentation (default is yes)])], @@ -215,23 +209,23 @@ OCTAVE_IDX_TYPE=int elif test $ac_cv_sizeof_long -eq 8; then OCTAVE_IDX_TYPE=long - AC_DEFINE(IDX_TYPE_LONG, 1, [Define to 1 if octave index type is long]) + AC_DEFINE(IDX_TYPE_LONG, 1, [Define to 1 if octave index type is long.]) else warn_64_bit="no suitable type found for octave_idx_type so disabling 64-bit features" OCTAVE_CONFIGURE_WARNING([warn_64_bit]) USE_64_BIT_IDX_T=false fi else - warn_64_bit="pointers are not 64-bits wide so disabling 64-bit features" + warn_64_bit="pointers are not 64-bits wide; disabling 64-bit features" OCTAVE_CONFIGURE_WARNING([warn_64_bit]) USE_64_BIT_IDX_T=false fi fi AC_SUBST(OCTAVE_IDX_TYPE) AC_DEFINE_UNQUOTED(OCTAVE_IDX_TYPE, $OCTAVE_IDX_TYPE, - [Define to the type of octave_idx_type (64 or 32 bit signed integer)]) + [Define to the type of octave_idx_type (64 or 32 bit signed integer).]) if $USE_64_BIT_IDX_T; then - AC_DEFINE(USE_64_BIT_IDX_T, 1, [Define if using 64-bit integers for array dimensions and indexing]) + AC_DEFINE(USE_64_BIT_IDX_T, 1, [Define to 1 if using 64-bit integers for array dimensions and indexing.]) fi AC_SUBST(USE_64_BIT_IDX_T) @@ -240,14 +234,14 @@ ### GNU libc, just disable them for all platforms. AC_MSG_NOTICE([defining __NO_MATH_INLINES avoids buggy GNU libc exp function]) -AC_DEFINE(__NO_MATH_INLINES, 1, [Define if your version of GNU libc has buggy inline assembly code for math functions like exp.]) - -### See which C++ compiler to use (we expect to find g++). +AC_DEFINE(__NO_MATH_INLINES, 1, [Define to 1 if your version of GNU libc has buggy inline assembly code for math functions like exp.]) + +### Determine which C++ compiler to use (we expect to find g++). AC_PROG_CXX AC_PROG_CXXCPP -### Do special things for g++. +### Check version number when using g++. gxx_version=`$CXX -v 2>&1 | grep "^.*g.. version" | \ sed -e 's/^.*g.. version *//' -e 's/cygnus-//' -e 's/egcs-//' -e 's/ .*//'` @@ -269,18 +263,35 @@ OCTAVE_CXX_ISO_COMPLIANT_LIBRARY OCTAVE_CXX_BROKEN_REINTERPRET_CAST -### See which C compiler to use (we expect to find gcc). +### Determine which C compiler to use (we expect to find gcc). AC_PROG_CC AC_PROG_CPP AC_PROG_GCC_TRADITIONAL -### gnulib +## Check for MSVC +have_msvc=no +case "$canonical_host_type" in + *-*-msdosmsvc) + have_msvc=yes + ;; + *-*-mingw*) + AC_MSG_CHECKING([for MSVC compiler]) + AC_PREPROC_IFELSE([AC_LANG_SOURCE([ +#ifndef _MSC_VER +#error "Not MSVC compiler" +#endif +])], have_msvc=yes, have_msvc=no) + AC_MSG_RESULT([$have_msvc]) + ;; +esac + +### gnulib initialization gl_EARLY gl_INIT -### Do special things for gcc. +### Check version number when using gcc. gcc_version=`$CC -v 2>&1 | grep "^.*gcc version" | \ sed -e 's/^.*g.. version *//' -e 's/cygnus-//' -e 's/egcs-//'` @@ -297,9 +308,9 @@ fi AC_SUBST(CC_VERSION) -### The flag to create dependency varies depending on the compier. - -# Assume GCC. +### Determine the compiler flag necessary to create dependencies + +## Assume GCC. INCLUDE_DEPS=true DEPEND_FLAGS="-M" DEPEND_EXTRA_SED_PATTERN="" @@ -327,40 +338,14 @@ AC_SUBST(DEPEND_FLAGS) AC_SUBST(DEPEND_EXTRA_SED_PATTERN) +### Check for pthread library + AX_PTHREAD -### Include pthread libs and flags here in case other tests need them. -### They seem to be required for the OpenGL tests on Debian systems. +## Include pthread libs and flags here in case other tests need them. +## They seem to be required for the OpenGL tests on Debian systems. LIBS="$PTHREAD_LIBS $LIBS" CFLAGS="$CFLAGS $PTHREAD_CFLAGS" -AC_PATH_X -if test "$have_x" = "yes"; then - AC_DEFINE(HAVE_X_WINDOWS, 1, [Define if you have X11]) - - if test "$x_includes" != "NONE"; then - X11_INCFLAGS="$x_includes" - fi - AC_SUBST(X11_INCFLAGS) - - if test -z $x_libraries; then - AC_CHECK_LIB(X11, XrmInitialize, [X11_LIBS=-lX11], [X11_LIBS=]) - elif test $x_libraries != "NONE"; then - AC_CHECK_LIB(X11, XrmInitialize, - [X11_LIBS="-L$x_libraries -lX11"], [X11_LIBS=], "-L$x_libraries") - fi - AC_SUBST(X11_LIBS) -fi - -### On MacOSX system the Carbon framework is used to determine ScreenSize -OCTAVE_HAVE_FRAMEWORK(Carbon, [#include ], [CGMainDisplayID ()], - [have_framework_carbon="yes"], [have_framework_carbon="no"]) -if test $have_framework_carbon = "yes"; then - AC_DEFINE(HAVE_FRAMEWORK_CARBON, 1, [Define if framework CARBON is available.]) - CARBON_LIBS="-Wl,-framework -Wl,Carbon" - AC_MSG_NOTICE([adding -Wl,-framework -Wl,Carbon to CARBON_LIBS]) - AC_SUBST(CARBON_LIBS) -fi - ### When compiling math for x87, problems may arise in some code comparing ### floating-point intermediate results. ### Generally, it helps to store the result in a local volatile variable, @@ -376,12 +361,14 @@ ac_float_truncate=) AC_DEFINE_UNQUOTED(FLOAT_TRUNCATE, $ac_float_truncate, - [Define to volatile if you need truncating intermediate FP results]) - -### On Intel systems with gcc, we may need to compile with -mieee-fp -### and -ffloat-store to get full support for IEEE floating point. -### -### On Alpha/OSF systems, we need -mieee. + [Define to volatile if you need to truncate intermediate FP results.]) + +### Determine extra CFLAGS that may be necessary for Octave. + +## On Intel systems with gcc, we may need to compile with -mieee-fp +## and -ffloat-store to get full support for IEEE floating point. +## +## On Alpha/OSF systems, we need -mieee. ieee_fp_flag= case "$canonical_host_type" in @@ -394,10 +381,10 @@ XTRA_CFLAGS="$XTRA_CFLAGS -mieee-fp" AC_MSG_NOTICE([adding -mieee-fp to XTRA_CFLAGS])]) -### OCTAVE_CC_FLAG(-ffloat-store, [ -### float_store_flag=-ffloat-store -### XTRA_CFLAGS="$XTRA_CFLAGS -ffloat-store" -### AC_MSG_RESULT([adding -ffloat-store to XTRA_CFLAGS])]) +## OCTAVE_CC_FLAG(-ffloat-store, [ +## float_store_flag=-ffloat-store +## XTRA_CFLAGS="$XTRA_CFLAGS -ffloat-store" +## AC_MSG_RESULT([adding -ffloat-store to XTRA_CFLAGS])]) fi if test "$GXX" = yes; then OCTAVE_CXX_FLAG(-mieee-fp, [ @@ -405,10 +392,10 @@ XTRA_CXXFLAGS="$XTRA_CXXFLAGS -mieee-fp" AC_MSG_NOTICE([adding -mieee-fp to XTRA_CXXFLAGS])]) -### OCTAVE_CXX_FLAG(-ffloat-store, [ -### float_store_flag=-ffloat-store -### XTRA_CXXFLAGS="$XTRA_CXXFLAGS -ffloat-store" -### AC_MSG_RESULT([adding -ffloat-store to XTRA_CXXFLAGS])]) +## OCTAVE_CXX_FLAG(-ffloat-store, [ +## float_store_flag=-ffloat-store +## XTRA_CXXFLAGS="$XTRA_CXXFLAGS -ffloat-store" +## AC_MSG_RESULT([adding -ffloat-store to XTRA_CXXFLAGS])]) fi ;; alpha*-*-*) @@ -444,8 +431,12 @@ ;; esac -## Test whether the compiler supports OpenMP. Experimental so disable by -## default. Enable it with the flag --enable-openmp +AC_SUBST(XTRA_CFLAGS) +AC_SUBST(XTRA_CXXFLAGS) + +### Test whether the compiler supports OpenMP. This is experimental so disable +### it by default. Enable it with the flag --enable-openmp. + USE_OPENMP=false AC_ARG_ENABLE(openmp, [AS_HELP_STRING([--enable-openmp], @@ -457,21 +448,15 @@ OCTAVE_CHECK_OPENMP(-fopenmp) ;; *-*-msdosmsvc) - ## FIXME is this the right flag for MSVC? + ## FIXME: is this the right flag for MSVC? OCTAVE_CHECK_OPENMP(-openmp) ;; ## Add other compilers supporting OpenMP here esac fi -AC_SUBST(XTRA_CFLAGS) -AC_SUBST(XTRA_CXXFLAGS) - -## Avoid #define of min/max from windows.h header -if test "$have_msvc" = "yes"; then - AC_DEFINE(NOMINMAX, 1, [Define if you want to avoid min/max macro definition in Windows headers]) -fi - +dnl FIXME: This is OS-specific tests. Can this be moved further down in +dnl configure.ac to reside with other similar tests? ### Use -static if compiling on Alpha OSF/1 1.3 systems. case "$canonical_host_type" in @@ -502,15 +487,18 @@ BUILD_CXX='$(CXX)' BUILD_CXXFLAGS='$(CXXFLAGS)' BUILD_LDFLAGS='$(LDFLAGS)' - case "$canonical_host_type" in - sparc-sun-solaris2*) - if test "$GCC" != yes; then - ## The Sun C++ compiler never seems to complete compiling - ## gendoc.cc unless we reduce the optimization level... - BUILD_CXXFLAGS="-g -O1" - fi - ;; - esac + ## 2012/07/31: Commented out special build requirements + ## for Sun compiler now that gendoc.cc is no longer part of build. + ################################################################## + #case "$canonical_host_type" in + # sparc-sun-solaris2*) + # if test "$GCC" != yes; then + # ## The Sun C++ compiler never seems to complete compiling + # ## gendoc.cc unless we reduce the optimization level... + # ## BUILD_CXXFLAGS="-g -O1" + # fi + # ;; + #esac BUILD_EXEEXT='$(EXEEXT)' fi @@ -536,6 +524,8 @@ ;; esac +### Determine the Fortran compiler and how to invoke it + ## Default FFLAGS is -O. if test "x$FFLAGS" = x; then FFLAGS="-O" @@ -590,13 +580,13 @@ AC_SUBST(F77_APPEND_EXTRA_UNDERSCORE) if test -z "$F77"; then - AC_MSG_ERROR([in order to build octave, you must have a compatible Fortran compiler or wrapper script for f2c that functions as a Fortran compiler installed and in your path. See the file INSTALL for more information.]) + AC_MSG_ERROR([in order to build Octave, you must have a compatible Fortran compiler or wrapper script for f2c that functions as a Fortran compiler installed and in your path. See the file INSTALL for more information.]) fi OCTAVE_CHECK_FORTRAN_HAVE_ISNAN F77_ISNAN_MACRO= if test "x$octave_cv_fortran_have_isnan" = xno; then - AC_MSG_NOTICE([substituting ISNAN(X) with X.NE.X in fortran sources]) + AC_MSG_NOTICE([substituting ISNAN(X) with X.NE.X in Fortran sources]) F77_ISNAN_MACRO="s|ISNAN(\(@<:@^)@:>@*\))|(\1.NE.\1)|" fi AC_SUBST(F77_ISNAN_MACRO) @@ -631,7 +621,7 @@ OCTAVE_CHECK_FORTRAN_INTEGER_SIZE fi if test "x$octave_cv_fortran_integer_size" = xno; then - AC_MSG_ERROR([in order to build octave with 64-bit indexing support your Fortran compiler must have an option for setting the default integer size to 8 bytes. See the file INSTALL for more information.]) + AC_MSG_ERROR([in order to build Octave with 64-bit indexing support your Fortran compiler must have an option for setting the default integer size to 8 bytes. See the file INSTALL for more information.]) fi else AC_MSG_ERROR([your Fortran compiler must have an option to make integers the same size as octave_idx_type ($OCTAVE_IDX_TYPE). See the file INSTALL for more information.]) @@ -648,15 +638,15 @@ AC_SUBST(F77_FLOAT_STORE_FLAG) ]) +### Check that C compiler and libraries support IEEE754 data format. OCTAVE_IEEE754_DATA_FORMAT +### Check C++ library for various capabilities. OCTAVE_CXX_BITWISE_OP_TEMPLATES OCTAVE_CXX_COMPLEX_SETTERS OCTAVE_CXX_COMPLEX_REFERENCE_ACCESSORS -OCTAVE_CARBON_CGDISPLAYBITSPERPIXEL - -### Check for the QHull library +### Check for the Qhull library OCTAVE_CHECK_LIBRARY(qhull, QHull, [Qhull library not found -- this will result in loss of functionality of some geometry functions.], @@ -664,10 +654,10 @@ [warn_qhull= OCTAVE_CHECK_QHULL_VERSION OCTAVE_CHECK_QHULL_OK([TEXINFO_QHULL="@set HAVE_QHULL" - AC_DEFINE(HAVE_QHULL, 1, [Define if QHull is available.])], [ - warn_qhull="Qhull library found, but seems not to work properly -- this will result in loss of functionality of some geometry functions. Please try recompiling the library with -fno-strict-aliasing."])]) - -### Check for pcre regex library. + AC_DEFINE(HAVE_QHULL, 1, [Define to 1 if Qhull is available.])], [ + warn_qhull="Qhull library found, but does not seem to work properly -- this will result in loss of functionality of some geometry functions. Please try recompiling the library with -fno-strict-aliasing."])]) + +### Check for PCRE regex library. REGEX_LIBS= @@ -715,26 +705,25 @@ [ZLIB library not found. Octave will not be able to save or load compressed data files or HDF5 files.], [zlib.h], [gzclearerr]) -### Check for the llvm library -dnl +### Check for the LLVM library dnl -dnl llvm is odd and has its own pkg-config like script. We should probably check -dnl for existance and +dnl LLVM is odd and has its own pkg-config like script. We should probably +dnl check for existence and ???. dnl save_CPPFLAGS="$CPPFLAGS" save_CXXFLAGS="$CXXFLAGS" save_LIBS="$LIBS" save_LDFLAGS="$LDFLAGS" -warn_llvm="LLVM library fails tests. JIT compilation will be disabled." +warn_llvm="LLVM library fails tests. JIT compilation will be disabled." AC_ARG_VAR(LLVM_CONFIG, [path to llvm-config utility]) AC_ARG_ENABLE([jit-debug], - AS_HELP_STRING([--enable-jit-debug], [Enable debug printing of jit IRs])) + AS_HELP_STRING([--enable-jit-debug], [Enable debug printing of JIT IRs])) AS_IF([test "x$enable_jit_debug" = "xyes"], [ - AC_DEFINE(OCTAVE_JIT_DEBUG, 1, [Define for jit debug printing]) + AC_DEFINE(OCTAVE_JIT_DEBUG, 1, [Define to 1 for JIT debug printing.]) ]) LLVM_CXXFLAGS= @@ -743,7 +732,7 @@ LLVM_LIBS= if test "x$ac_cv_env_LLVM_CONFIG_set" = "xset"; then - # We use -isystem if avaiable because we do not want to see warnings in llvm + ## We use -isystem if available because we do not want to see warnings in LLVM LLVM_INCLUDE_FLAG=-I OCTAVE_CC_FLAG(-isystem ., [ LLVM_INCLUDE_FLAG=-isystem @@ -756,8 +745,8 @@ LLVM_CXXFLAGS= dnl - dnl We define some extra flags that llvm requires in order to include headers. - dnl Idealy we should get these from llvm-config, but llvm-config isn't very + dnl We define some extra flags that LLVM requires in order to include headers. + dnl Ideally we should get these from llvm-config, but llvm-config isn't very dnl helpful. dnl CPPFLAGS="-D__STDC_CONSTANT_MACROS -D__STDC_LIMIT_MACROS $LLVM_CPPFLAGS $CPPFLAGS" @@ -782,11 +771,11 @@ AC_LANG_POP(C++) else - warn_llvm="LLVM_CONFIG not set. JIT compilation will be disabled." + warn_llvm="LLVM_CONFIG not set. JIT compilation will be disabled." fi if test -z "$warn_llvm"; then - AC_DEFINE(HAVE_LLVM, 1, [Define if LLVM is available]) + AC_DEFINE(HAVE_LLVM, 1, [Define to 1 if LLVM is available.]) else LLVM_CXXFLAGS= LLVM_CPPFLAGS= @@ -817,7 +806,7 @@ [warn_hdf5= OCTAVE_HDF5_HAS_ENFORCED_16_API TEXINFO_HDF5="@set HAVE_HDF5" - AC_DEFINE(HAVE_HDF5, 1, [Define if HDF5 is available and newer than version 1.6.]) + AC_DEFINE(HAVE_HDF5, 1, [Define to 1 if HDF5 is available and newer than version 1.6.]) if test "$have_msvc" = "yes"; then OCTAVE_HDF5_DLL fi @@ -825,12 +814,6 @@ CPPFLAGS="$save_CPPFLAGS" LIBS="$save_LIBS" - -# Subdirectory of libcruft to build if fftw is not found: - -FFT_DIR="fftpack" -AC_SUBST(FFT_DIR) - dnl @synopsis BNV_HAVE_QT [--with-Qt-dir=DIR] [--with-Qt-lib-dir=DIR] [--with-Qt-lib=LIB] dnl @synopsis BNV_HAVE_QT [--with-Qt-include-dir=DIR] [--with-Qt-bin-dir=DIR] [--with-Qt-lib-dir=DIR] [--with-Qt-lib=LIB] dnl @@ -1345,8 +1328,9 @@ fi dnl Done setting up for non-traditional Trolltech installation ]) -# Checks for FFTW header and library. - +### Check for FFTW library. Default to Fortran FFTPACK if it is not available. + +## Check for FFTW header and library. OCTAVE_CHECK_LIBRARY(fftw3, FFTW3, [FFTW3 library not found. The slower FFTPACK library will be used instead.], [fftw3.h], [fftw_plan_dft_1d]) @@ -1358,7 +1342,11 @@ AM_CONDITIONAL([AMCOND_HAVE_FFTW], [test -n "$FFTW3_LIBS" && test -n "$FFTW3F_LIBS"]) -# Checks for GLPK header and library. +## Subdirectory of libcruft to build if FFTW is not found: +FFT_DIR="fftpack" +AC_SUBST(FFT_DIR) + +### Check for GLPK library and header. save_CPPFLAGS="$CPPFLAGS" CPPFLAGS="$Z_CPPFLAGS $CPPFLAGS" @@ -1370,7 +1358,7 @@ LIBS="$save_LIBS" CPPFLAGS="$save_CPPFLAGS" -# Checks for CURL header and library. +### Checks for cURL header and library. save_CPPFLAGS="$CPPFLAGS" CPPFLAGS="$Z_CPPFLAGS $CPPFLAGS" @@ -1382,7 +1370,7 @@ LIBS="$save_LIBS" CPPFLAGS="$save_CPPFLAGS" -### Graphics/ImageMagick++ +### Check for either of Graphics/ImageMagick++ libraries AC_ARG_WITH([magick], [AS_HELP_STRING([--with-magick=LIB], @@ -1414,12 +1402,17 @@ AC_LANG_PUSH(C++) AC_CHECK_HEADER([Magick++.h], [ AC_MSG_CHECKING([for Magick::ColorRGB in Magick++.h]) - AC_TRY_LINK([#include ], [Magick::ColorRGB c;], [ - AC_MSG_RESULT(yes) - warn_magick= - ], [ - AC_MSG_RESULT(no) - ]) + AC_PREPROC_IFELSE( + [AC_LANG_SOURCE( + [[#include ]], + [[Magick::ColorRGB c;]]) + ], [ + AC_MSG_RESULT(yes) + warn_magick= + ], [ + AC_MSG_RESULT(no) + ] + ) ]) AC_LANG_POP(C++) CPPFLAGS="$save_CPPFLAGS" @@ -1427,7 +1420,7 @@ ]) if test -z "$warn_magick"; then - AC_DEFINE(HAVE_MAGICK, 1, [Define if Graphics/ImageMagick++ is available.]) + AC_DEFINE(HAVE_MAGICK, 1, [Define to 1 if Graphics/ImageMagick++ is available.]) else MAGICK_CPPFLAGS= MAGICK_LDFLAGS= @@ -1437,9 +1430,37 @@ AC_SUBST(MAGICK_LDFLAGS) AC_SUBST(MAGICK_LIBS) -# --------------------------------------------------------------------- - -## libraries needed for native graphics renderer +### Check for X11 libraries + +AC_PATH_X +if test "$have_x" = "yes"; then + AC_DEFINE(HAVE_X_WINDOWS, 1, [Define to 1 if you have X11.]) + + if test "$x_includes" != "NONE"; then + X11_INCFLAGS="$x_includes" + fi + AC_SUBST(X11_INCFLAGS) + + if test -z $x_libraries; then + AC_CHECK_LIB(X11, XrmInitialize, [X11_LIBS=-lX11], [X11_LIBS=]) + elif test $x_libraries != "NONE"; then + AC_CHECK_LIB(X11, XrmInitialize, + [X11_LIBS="-L$x_libraries -lX11"], [X11_LIBS=], "-L$x_libraries") + fi + AC_SUBST(X11_LIBS) +fi + +### Check for the Carbon framework on MacOSX systems +OCTAVE_HAVE_FRAMEWORK(Carbon, [#include ], [CGMainDisplayID ()], + [have_framework_carbon="yes"], [have_framework_carbon="no"]) +if test $have_framework_carbon = "yes"; then + AC_DEFINE(HAVE_FRAMEWORK_CARBON, 1, [Define to 1 if framework CARBON is available.]) + CARBON_LIBS="-Wl,-framework -Wl,Carbon" + AC_MSG_NOTICE([adding -Wl,-framework -Wl,Carbon to CARBON_LIBS]) + AC_SUBST(CARBON_LIBS) +fi + +### Check for list of libraries needed for native graphics renderer. warn_freetype="" native_graphics=true @@ -1456,6 +1477,7 @@ fi], [check_opengl=true]) +## Check for OpenGL library if $check_opengl; then OCTAVE_OPENGL fi @@ -1465,18 +1487,18 @@ if test -z "$OPENGL_LIBS"; then if $check_opengl; then - warn_fltk_opengl="OpenGL libs (GL and GLU) not found. Native graphics will be disabled." + warn_fltk_opengl="OpenGL libs (GL and GLU) not found. Native graphics will be disabled." OCTAVE_CONFIGURE_WARNING([warn_fltk_opengl]) native_graphics=false fi fi if test -n "$OPENGL_LIBS"; then - AC_DEFINE(HAVE_OPENGL, 1, [Define if OpenGL is available]) - - ## freetype 2 - - AC_CHECK_FT2([9.0.3], [AC_DEFINE(HAVE_FREETYPE, 1, [Define to 1 if you have Freetype library.]) + AC_DEFINE(HAVE_OPENGL, 1, [Define to 1 if OpenGL is available.]) + + ## Check for FreeType 2 library + + AC_CHECK_FT2([9.0.3], [AC_DEFINE(HAVE_FREETYPE, 1, [Define to 1 if you have FreeType library.]) XTRA_CXXFLAGS="$XTRA_CXXFLAGS $FT2_CFLAGS"], [warn_freetype="FreeType library not found. Native graphics will be disabled."]) @@ -1485,7 +1507,7 @@ native_graphics=false fi - ## fontconfig library + ## Check for fontconfig library warn_fontconfig="" if test -z "$warn_freetype"; then @@ -1493,7 +1515,7 @@ have_fontconfig=yes OPENGL_LIBS="$FONTCONFIG_LIBS $OPENGL_LIBS" XTRA_CXXFLAGS="$XTRA_CXXFLAGS $FONTCONFIG_CFLAGS" - AC_DEFINE(HAVE_FONTCONFIG, 1, [Define to 1 if fontconfig is present])], [ + AC_DEFINE(HAVE_FONTCONFIG, 1, [Define to 1 if fontconfig is present.])], [ have_fontconfig=no warn_fontconfig="Fontconfig library not found. Native graphics will be disabled."]) fi @@ -1503,7 +1525,7 @@ native_graphics=false fi - ## fltk (www.fltk.org) + ## Check for FLTK (www.fltk.org) library AC_ARG_WITH([fltk-prefix], [ AS_HELP_STRING([--with-fltk-prefix=PFX], @@ -1559,7 +1581,7 @@ AC_MSG_RESULT([no]) warn_fltk_opengl="FLTK does not have OpenGL support. Native graphics will be disabled." ],[ - AC_DEFINE(HAVE_FLTK, 1, [Define if FLTK is available]) + AC_DEFINE(HAVE_FLTK, 1, [Define to 1 if FLTK is available.]) AC_MSG_RESULT([yes]) ]) @@ -1577,7 +1599,7 @@ AC_SUBST(GRAPHICS_CFLAGS) AC_SUBST(GRAPHICS_LIBS) -# ---------------------------------------------------------------------- +### Start determination of shared vs. static libraries OCTAVE_PROG_AR @@ -1608,7 +1630,7 @@ fi AC_SUBST(XTRA_CRUFT_SH_LDFLAGS) -### Checks for BLAS and LAPACK libraries: +### Check for BLAS and LAPACK libraries: ## Need to adjust FFLAGS to include correct integer size. save_FFLAGS="$FFLAGS" @@ -1672,7 +1694,7 @@ else ## wrapper in libcruft, remove from BLAS_LIBS BLAS_LIBS="`echo $BLAS_LIBS | sed -e 's/blaswrap.[[^ ]]* //g'`" - AC_DEFINE(USE_BLASWRAP, [1], [Define this if BLAS functions need to be wrapped (potentially needed for 64-bit OSX only).]) + AC_DEFINE(USE_BLASWRAP, 1, [Define to 1 if BLAS functions need to be wrapped (potentially needed for 64-bit OSX only).]) fi ;; esac @@ -1681,20 +1703,20 @@ if test "x$ax_blas_f77_func_ok" = "xno"; then if $USE_64_BIT_IDX_T && test "$ax_blas_integer_size_ok" = "no" ; then ## Attempt to be more informative. - AC_MSG_ERROR([BLAS doesn't seem to support 64-bit integers. This is incompatible with --enable-64.]) + AC_MSG_ERROR([BLAS doesn't seem to support 64-bit integers. This is incompatible with --enable-64.]) else AC_MSG_ERROR([A BLAS library was detected but found incompatible with your Fortran 77 compiler settings.]) fi fi if test x$ax_blas_ok = xno || test x$ax_lapack_ok = xno; then - AC_MSG_ERROR([You are required to have BLAS and LAPACK libraries]) + AC_MSG_ERROR([BLAS and LAPACK libraries are required]) fi ### Check for the qrupdate library + ## No need to adjust FFLAGS because only link is attempted. ## Must supply proper LIBS, however. - save_LIBS="$LIBS" LIBS="$LAPACK_LIBS $BLAS_LIBS $FLIBS $LIBS" OCTAVE_CHECK_LIBRARY(qrupdate, qrupdate, @@ -1712,13 +1734,13 @@ [octave_qrupdate_luu=yes]) AC_MSG_RESULT([$octave_qrupdate_luu]) if test "$octave_qrupdate_luu" = yes; then - AC_DEFINE(HAVE_QRUPDATE_LUU, [1], [Define if qrupdate supports LU updates]) + AC_DEFINE(HAVE_QRUPDATE_LUU, 1, [Define to 1 if qrupdate supports LU updates.]) fi AC_LANG_POP([Fortran 77]) fi LIBS="$save_LIBS" -# Check for AMD library +### Check for AMD library OCTAVE_CHECK_LIBRARY(amd, AMD, [AMD library not found. This will result in some lack of functionality for sparse matrices.], @@ -1726,7 +1748,7 @@ [amd_postorder], [], [don't use AMD library, disable some sparse matrix functionality]) -# Check for CAMD library +### Check for CAMD library OCTAVE_CHECK_LIBRARY(camd, CAMD, [CAMD library not found. This will result in some lack of functionality for sparse matrices.], @@ -1734,7 +1756,7 @@ [camd_postorder], [], [don't use CAMD library, disable some sparse matrix functionality]) -# Check for COLAMD library +### Check for COLAMD library OCTAVE_CHECK_LIBRARY(colamd, COLAMD, [COLAMD library not found. This will result in some lack of functionality for sparse matrices.], @@ -1742,7 +1764,7 @@ [colamd], [], [don't use COLAMD library, disable some sparse matrix functionality]) -# Check for CCOLAMD library +### Check for CCOLAMD library OCTAVE_CHECK_LIBRARY(ccolamd, CCOLAMD, [CCOLAMD library not found. This will result in some lack of functionality for sparse matrices.], @@ -1750,8 +1772,8 @@ [ccolamd], [], [don't use CCOLAMD library, disable some sparse matrix functionality]) -# Check for CHOLMOD library. If your cholmod library requires cblas, -# then you will need to configure with --with-cholmod="-lcholmod -lcblas". +### Check for CHOLMOD library. If your cholmod library requires cblas, +### then you will need to configure with --with-cholmod="-lcholmod -lcblas". save_LIBS="$LIBS" LIBS="$COLAMD_LDFLAGS $COLAMD_LIBS $AMD_LDFLAGS $AMD_LIBS $LAPACK_LIBS $BLAS_LIBS $FLIBS $LIBS" @@ -1762,7 +1784,7 @@ [], [don't use CHOLMOD library, disable some sparse matrix functionality]) LIBS="$save_LIBS" -# Check for CXSparse library +### Check for CXSparse library OCTAVE_CHECK_LIBRARY(cxsparse, CXSparse, [CXSparse library not found. This will result in some lack of functionality for sparse matrices.], @@ -1770,7 +1792,7 @@ [cs_di_sqr], [C++], [don't use CXSparse library, disable some sparse matrix functionality]) -# Check for UMFPACK library. +### Check for UMFPACK library. save_LIBS="$LIBS" save_CPPFLAGS="$CPPFLAGS" @@ -1807,6 +1829,8 @@ LIBS="$save_LIBS" fi +### Check for ARPACK library. + save_LIBS="$LIBS" LIBS="$LAPACK_LIBS $BLAS_LIBS $FLIBS $LIBS" OCTAVE_CHECK_LIBRARY(arpack, ARPACK, @@ -1816,10 +1840,14 @@ [Fortran 77], [don't use the ARPACK library, disable eigs function], [warn_arpack= OCTAVE_CHECK_ARPACK_OK([ - AC_DEFINE(HAVE_ARPACK, 1, [Define if ARPACK is available.])], [ - warn_arpack="ARPACK library found, but seems not to work properly -- disabling eigs function"])]) + AC_DEFINE(HAVE_ARPACK, 1, [Define to 1 if ARPACK is available.])], [ + warn_arpack="ARPACK library found, but does not seem to work properly -- disabling eigs function"])]) LIBS="$save_LIBS" +### Check for readline library. + +OCTAVE_ENABLE_READLINE + ### Enable dynamic linking. --enable-shared implies this, so ### --enable-dl is only need if you are only building static libraries ### and want to try dynamic linking too (works on some systems, for @@ -2223,8 +2251,8 @@ AC_MSG_CHECKING([whether unordered_map requires tr1 namespace]) unordered_map_requires_tr1_namespace=no if test "$ac_cv_header_unordered_map" = "yes"; then - ### Have , but still have to check whether - ### tr1 namespace is required (like MSVC, for instance). + ## Have , but still have to check whether + ## tr1 namespace is required (like MSVC, for instance). AC_COMPILE_IFELSE([ AC_LANG_PROGRAM([ #include @@ -2235,7 +2263,7 @@ unordered_map_requires_tr1_namespace=yes fi if test "$unordered_map_requires_tr1_namespace" = "yes"; then - AC_DEFINE(USE_UNORDERED_MAP_WITH_TR1, 1, [Defines whether unordered_map requires the use of tr1 namespace.]) + AC_DEFINE(USE_UNORDERED_MAP_WITH_TR1, 1, [Define to 1 if unordered_map requires the use of tr1 namespace.]) fi AC_MSG_RESULT([$unordered_map_requires_tr1_namespace]) AC_LANG_POP(C++) @@ -2255,6 +2283,11 @@ AC_MSG_WARN([I couldn't find termios.h, termio.h, or sgtty.h!]) fi +### For MSVC compilers, avoid #define of min/max from windows.h header +if test "$have_msvc" = "yes"; then + AC_DEFINE(NOMINMAX, 1, [Define to 1 if you want to avoid min/max macro definition in Windows headers.]) +fi + ### Checks for functions and variables. AC_CHECK_FUNCS(basename canonicalize_file_name \ @@ -2304,7 +2337,7 @@ )], [AC_MSG_RESULT(yes) HAVE_MKSTEMPS=yes - AC_DEFINE(HAVE_MKSTEMPS, 1, [Define if mkstemps is available in libiberty.]) + AC_DEFINE(HAVE_MKSTEMPS, 1, [Define to 1 if mkstemps is available in libiberty.]) ], [AC_MSG_RESULT(no) HAVE_MKSTEMPS=no @@ -2324,21 +2357,24 @@ #error "Wrong version" #endif]], [])], AC_MSG_RESULT([none]), [ - AC_DEFINE(_WIN32_WINNT, 0x0403, [Define to 0x0403 to access InitializeCriticalSectionAndSpinCount]) + AC_DEFINE(_WIN32_WINNT, 0x0403, [Define to 0x0403 to access InitializeCriticalSectionAndSpinCount.]) AC_MSG_RESULT([0x0403])]) AC_MSG_CHECKING([whether _USE_MATH_DEFINES needs to be defined]) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[int x = M_LN2;]])], AC_MSG_RESULT([no]), [ - AC_DEFINE(_USE_MATH_DEFINES, 1, [Define if your system needs it to define math constants like M_LN2]) + AC_DEFINE(_USE_MATH_DEFINES, 1, [Define to 1 if your system needs to define math constants like M_LN2.]) AC_MSG_RESULT([yes])]) ;; esac +## Check for CGDisplayBitsPerPixel function on Mac OSX systems with Carbon +OCTAVE_CARBON_CGDISPLAYBITSPERPIXEL + ### Dynamic linking is now enabled only if we are building shared ### libs and some API for dynamic linking is detected. -## FIXME -- a lot of the following duplicates the functionality of +## FIXME: A lot of the following duplicates the functionality of ## code generated by the dlopen option for LT_INIT. LD_CXX='$(CXX)' @@ -2355,23 +2391,23 @@ dlopen) dlopen_api=true DL_API_MSG="(dlopen)" - AC_DEFINE(HAVE_DLOPEN_API, 1, [Define if your system has dlopen, dlsym, dlerror, and dlclose for dynamic linking]) + AC_DEFINE(HAVE_DLOPEN_API, 1, [Define to 1 if your system has dlopen, dlsym, dlerror, and dlclose for dynamic linking.]) OCTAVE_CXX_FLAG(-rdynamic, [RDYNAMIC_FLAG=-rdynamic]) ;; shl_load) shl_load_api=true DL_API_MSG="(shl_load)" - AC_DEFINE(HAVE_SHL_LOAD_API, 1, [Define if your system has shl_load and shl_findsym for dynamic linking]) + AC_DEFINE(HAVE_SHL_LOAD_API, 1, [Define to 1 if your system has shl_load and shl_findsym for dynamic linking.]) ;; LoadLibrary) loadlibrary_api=true DL_API_MSG="(LoadLibrary)" - AC_DEFINE(HAVE_LOADLIBRARY_API, 1, [Define if your system has LoadLibrary for dynamic linking]) + AC_DEFINE(HAVE_LOADLIBRARY_API, 1, [Define to 1 if your system has LoadLibrary for dynamic linking.]) ;; dyld) dyld_api=true DL_API_MSG="(dyld)" - AC_DEFINE(HAVE_DYLD_API, 1, [Define if your system has dyld for dynamic linking]) + AC_DEFINE(HAVE_DYLD_API, 1, [Define to 1 if your system has dyld for dynamic linking.]) ;; esac @@ -2387,7 +2423,7 @@ fi if $ENABLE_DYNAMIC_LINKING; then - AC_DEFINE(ENABLE_DYNAMIC_LINKING, 1, [Define if using dynamic linking]) + AC_DEFINE(ENABLE_DYNAMIC_LINKING, 1, [Define to 1 if using dynamic linking.]) fi AM_CONDITIONAL([AMCOND_ENABLE_DYNAMIC_LINKING], @@ -2468,14 +2504,13 @@ fi AC_SUBST(TERM_LIBS) -OCTAVE_ENABLE_READLINE - +### Return type of matherr() AC_MSG_CHECKING([for struct exception in math.h]) AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], [[struct exception *x; x->type; x->name;]])], [AC_MSG_RESULT(yes) AC_DEFINE(EXCEPTION_IN_MATH, 1, - [Define if your math.h declares struct exception for matherr().])], + [Define to 1 if your math.h declares struct exception for matherr().])], [AC_MSG_RESULT(no)]) ### Signal stuff. @@ -2488,17 +2523,17 @@ #endif ]) -### A system dependent kluge or two. +### A system dependent kludge or two. AC_CHECK_FUNCS(getrusage) case "$canonical_host_type" in *-*-cygwin*) - AC_DEFINE(RUSAGE_TIMES_ONLY, 1, [Define if your struct rusage only has time information.]) + AC_DEFINE(RUSAGE_TIMES_ONLY, 1, [Define to 1 if your struct rusage only has time information.]) ;; esac -### Checks for other programs used for building, testing, installing, -### and running Octave. +### Checks for other programs used in building, testing, installing, and +### running Octave. AC_PROG_AWK OCTAVE_PROG_FIND @@ -2668,7 +2703,7 @@ #define OCTAVE_HAVE_POSIX_FILESYSTEM 1 #endif -/* Define if we expect to have , Sleep, etc. */ +/* Define to 1 if we expect to have , Sleep, etc. */ #if defined (__WIN32__) && ! defined (__CYGWIN__) #define OCTAVE_USE_WINDOWS_API 1 #endif @@ -2698,7 +2733,7 @@ /* To be able to use long doubles for 64-bit mixed arithmetics, we need them at least 80 bits wide and we need roundl declared in math.h. - FIXME -- maybe substitute this by a more precise check in the future. */ + FIXME: Maybe substitute this by a more precise check in the future? */ #if (SIZEOF_LONG_DOUBLE >= 10) && defined (HAVE_ROUNDL) #define OCTAVE_INT_USE_LONG_DOUBLE #endif @@ -2706,7 +2741,7 @@ #define OCTAVE_EMPTY_CPP_ARG /* Octave is currently unable to use FFTW unless both float - and double versions are both available. */ + and double versions are available. */ #if defined (HAVE_FFTW3) && defined (HAVE_FFTW3F) #define HAVE_FFTW #endif @@ -2761,7 +2796,7 @@ #include -/* Tag indicating octave config.h has been included */ +/* Tag indicating Octave config.h has been included */ #define OCTAVE_CONFIG_INCLUDED 1 ]) @@ -2846,16 +2881,16 @@ GLPK libraries: $GLPK_LIBS graphics CFLAGS: $GRAPHICS_CFLAGS graphics libraries: $GRAPHICS_LIBS - Magick++ CPPFLAGS: $MAGICK_CPPFLAGS - Magick++ LDFLAGS: $MAGICK_LDFLAGS - Magick++ libraries: $MAGICK_LIBS - LLVM CPPFLAGS: $LLVM_CPPFLAGS - LLVM LDFLAGS: $LLVM_LDFLAGS - LLVM libraries: $LLVM_LIBS HDF5 CPPFLAGS: $HDF5_CPPFLAGS HDF5 LDFLAGS: $HDF5_LDFLAGS HDF5 libraries: $HDF5_LIBS LAPACK libraries: $LAPACK_LIBS + LLVM CPPFLAGS: $LLVM_CPPFLAGS + LLVM LDFLAGS: $LLVM_LDFLAGS + LLVM libraries: $LLVM_LIBS + Magick++ CPPFLAGS: $MAGICK_CPPFLAGS + Magick++ LDFLAGS: $MAGICK_LDFLAGS + Magick++ libraries: $MAGICK_LIBS OPENGL libraries: $OPENGL_LIBS PTHREAD flags: $PTHREAD_CFLAGS PTHREAD libraries: $PTHREAD_LIBS @@ -2922,7 +2957,7 @@ AC_MSG_WARN([Are you sure that is what you want to do?]) AC_MSG_WARN([]) AC_MSG_WARN([This option enables experimental SMP multithreding]) - AC_MSG_WARN([code that has had very little testing. There is no]) + AC_MSG_WARN([code that has had very little testing. There is no]) AC_MSG_WARN([certainity that the results returned by Octave with]) AC_MSG_WARN([this option enabled will be correct.]) AC_MSG_WARN([]) @@ -2969,9 +3004,9 @@ if $USE_ATOMIC_REFCOUNT; then AC_MSG_WARN([]) AC_MSG_WARN([Using atomic reference counting.]) - AC_MSG_WARN([This feature allows to access octave data safely from]) - AC_MSG_WARN([another thread, for instance from a GUI. However this]) - AC_MSG_WARN([results in a small performance penalty in the octave]) + AC_MSG_WARN([This feature allows access to Octave data safely from]) + AC_MSG_WARN([another thread, for instance from a GUI. However this]) + AC_MSG_WARN([results in a small performance penalty in the Octave]) AC_MSG_WARN([interpreter.]) AC_MSG_WARN([]) if $USE_OCTAVE_ALLOCATOR; then diff -r d02b229ce693 -r a132d206a36a liboctave/lo-specfun.cc --- a/liboctave/lo-specfun.cc Thu Aug 02 12:12:00 2012 +0200 +++ b/liboctave/lo-specfun.cc Fri Aug 03 14:59:40 2012 -0400 @@ -2137,15 +2137,6 @@ } static void -gripe_betainc_nonconformant (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2, octave_idx_type r3, - octave_idx_type c3) -{ - (*current_liboctave_error_handler) - ("betainc: nonconformant arguments (x is %dx%d, a is %dx%d, b is %dx%d)", - r1, c1, r2, c2, r3, c3); -} - -static void gripe_betainc_nonconformant (const dim_vector& d1, const dim_vector& d2, const dim_vector& d3) { @@ -2159,15 +2150,6 @@ } static void -gripe_betaincinv_nonconformant (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2, octave_idx_type r3, - octave_idx_type c3) -{ - (*current_liboctave_error_handler) - ("betaincinv: nonconformant arguments (x is %dx%d, a is %dx%d, b is %dx%d)", - r1, c1, r2, c2, r3, c3); -} - -static void gripe_betaincinv_nonconformant (const dim_vector& d1, const dim_vector& d2, const dim_vector& d3) { diff -r d02b229ce693 -r a132d206a36a m4/acinclude.m4 --- a/m4/acinclude.m4 Thu Aug 02 12:12:00 2012 +0200 +++ b/m4/acinclude.m4 Fri Aug 03 14:59:40 2012 -0400 @@ -85,7 +85,7 @@ [[operator delete((void *)0, (void *)0);]])], octave_cv_placement_delete=yes, octave_cv_placement_delete=no)]) if test $octave_cv_placement_delete = yes; then -AC_DEFINE(HAVE_PLACEMENT_DELETE,1,[Define if C++ supports operator delete(void *, void *)]) +AC_DEFINE(HAVE_PLACEMENT_DELETE,1,[Define to 1 if C++ supports operator delete(void *, void *).]) fi AC_LANG_POP(C++) ]) @@ -100,7 +100,7 @@ [[void test(char *); int length(); char x[length()]; test(x);]])], octave_cv_dynamic_auto_arrays=yes, octave_cv_dynamic_auto_arrays=no)]) if test $octave_cv_dynamic_auto_arrays = yes; then -AC_DEFINE(HAVE_DYNAMIC_AUTO_ARRAYS,1,[Define if C++ supports dynamic auto arrays]) +AC_DEFINE(HAVE_DYNAMIC_AUTO_ARRAYS,1,[Define to 1 if C++ supports dynamic auto arrays.]) fi AC_LANG_POP(C++) ]) @@ -120,7 +120,7 @@ int z3 = std::bit_xor() (x, y);]])], octave_cv_cxx_bitwise_op_templates=yes, octave_cv_cxx_bitwise_op_templates=no)]) if test $octave_cv_cxx_bitwise_op_templates = yes; then -AC_DEFINE(HAVE_CXX_BITWISE_OP_TEMPLATES,1,[Define if C++ library has templated bitwise operators]) +AC_DEFINE(HAVE_CXX_BITWISE_OP_TEMPLATES,1,[Define to 1 if C++ library has templated bitwise operators.]) fi AC_LANG_POP(C++) ]) @@ -137,7 +137,7 @@ [[std::complex x; x.real (1.0); x.imag (2.0);]])], octave_cv_cxx_complex_setters=yes, octave_cv_cxx_complex_setters=no)]) if test $octave_cv_cxx_complex_setters = yes; then -AC_DEFINE(HAVE_CXX_COMPLEX_SETTERS,1,[Define if C++ complex class has void real (T) and void imag (T) methods]) +AC_DEFINE(HAVE_CXX_COMPLEX_SETTERS,1,[Define to 1 if C++ complex class has void real (T) and void imag (T) methods.]) fi AC_LANG_POP(C++) ]) @@ -153,7 +153,7 @@ [[std::complex x; x.real () = 1.0; x.imag () = 1.0;]])], octave_cv_cxx_complex_reference_accessors=yes, octave_cv_cxx_complex_reference_accessors=no)]) if test $octave_cv_cxx_complex_reference_accessors = yes; then -AC_DEFINE(HAVE_CXX_COMPLEX_REFERENCE_ACCESSORS,1,[Define if C++ complex class has T& real (void) and T& imag (void) methods]) +AC_DEFINE(HAVE_CXX_COMPLEX_REFERENCE_ACCESSORS,1,[Define to 1 if C++ complex class has T& real (void) and T& imag (void) methods.]) fi AC_LANG_POP(C++) ]) @@ -172,7 +172,7 @@ ]])], octave_cv_carbon_cgdisplaybitsperpixel=yes, octave_cv_carbon_cgdisplaybitsperpixel=no)]) if test $octave_cv_carbon_cgdisplaybitsperpixel = yes; then -AC_DEFINE(HAVE_CARBON_CGDISPLAYBITSPERPIXEL,1,[Define if Carbon Framework has CGDisplayBitsPerPixel]) +AC_DEFINE(HAVE_CARBON_CGDISPLAYBITSPERPIXEL,1,[Define to 1 if Carbon Framework has CGDisplayBitsPerPixel.]) fi AC_LANG_POP(C++) ]) @@ -275,7 +275,7 @@ ]) AC_MSG_RESULT([$octave_cv_cxx_new_friend_template_decl]) if test $octave_cv_cxx_new_friend_template_decl = yes; then - AC_DEFINE(CXX_NEW_FRIEND_TEMPLATE_DECL,1,[Define if your compiler supports `<>' stuff for template friends.]) + AC_DEFINE(CXX_NEW_FRIEND_TEMPLATE_DECL,1,[Define to 1 if your compiler supports `<>' stuff for template friends.]) fi ]) dnl @@ -528,7 +528,7 @@ m4_ifblank([$8], [ warn_$1= AC_DEFINE([HAVE_]m4_toupper([$1]), 1, - [Define if $2 is available.]) + [Define to 1 if $2 is available.]) [TEXINFO_]m4_toupper([$1])="@set [HAVE_]m4_toupper([$1])"], [$8]) fi LIBS="$octave_check_library_save_LIBS" @@ -761,7 +761,7 @@ ]) AC_MSG_RESULT([$octave_cv_cxx_iso_compliant_library]) if test $octave_cv_cxx_iso_compliant_library = yes; then - AC_DEFINE(CXX_ISO_COMPLIANT_LIBRARY, 1, [Define if your C++ runtime library is ISO compliant.]) + AC_DEFINE(CXX_ISO_COMPLIANT_LIBRARY, 1, [Define to 1 if your C++ runtime library is ISO compliant.]) fi ]) dnl @@ -783,7 +783,7 @@ LIBS="$TERM_LIBS" AC_CHECK_LIB(readline, rl_set_keyboard_input_timeout, [ READLINE_LIBS="-lreadline" - AC_DEFINE(USE_READLINE, 1, [Define to use the readline library.]) + AC_DEFINE(USE_READLINE, 1, [Define to 1 to use the readline library.]) ], [ AC_MSG_WARN([I need GNU Readline 4.2 or later]) AC_MSG_ERROR([this is fatal unless you specify --disable-readline]) @@ -810,7 +810,7 @@ octave_cv_cxx_broken_reinterpret_cast=no, octave_cv_cxx_broken_reinterpret_cast=yes)]) if test $octave_cv_cxx_broken_reinterpret_cast = yes ; then - AC_DEFINE(CXX_BROKEN_REINTERPRET_CAST, 1, [Define if C++ reinterpret_cast fails for function pointers.]) + AC_DEFINE(CXX_BROKEN_REINTERPRET_CAST, 1, [Define to 1 if C++ reinterpret_cast fails for function pointers.]) fi AC_LANG_POP(C++)]) dnl @@ -938,7 +938,7 @@ AC_MSG_RESULT([$octave_cv_ieee754_data_format]) fi if test "$octave_cv_ieee754_data_format" = yes; then - AC_DEFINE(HAVE_IEEE754_DATA_FORMAT, 1, [Define if your system uses IEEE 754 data format.]) + AC_DEFINE(HAVE_IEEE754_DATA_FORMAT, 1, [Define to 1 if your system uses IEEE 754 data format.]) else ## If the format is unknown, then you will probably not have a ## useful system, so we will abort here. Anyone wishing to @@ -1001,7 +1001,7 @@ AC_MSG_RESULT([$octave_cv_umfpack_seperate_split]) fi if test "$octave_cv_umfpack_seperate_split" = yes; then - AC_DEFINE(UMFPACK_SEPARATE_SPLIT, 1, [Define if the UMFPACK Complex solver allow matrix and RHS to be split independently]) + AC_DEFINE(UMFPACK_SEPARATE_SPLIT, 1, [Define to 1 if the UMFPACK Complex solver allow matrix and RHS to be split independently.]) fi ]) dnl @@ -1023,7 +1023,7 @@ CFLAGS="$save_CFLAGS" LIBS="$save_LIBS"])]) if test "$octave_cv_hdf5_dll" = yes; then - AC_DEFINE(_HDF5USEDLL_, 1, [Define if using HDF5 dll (Win32)]) + AC_DEFINE(_HDF5USEDLL_, 1, [Define to 1 if using HDF5 dll (Win32).]) fi]) dnl dnl Check whether HDF5 library has version 1.6 API functions. @@ -1038,11 +1038,11 @@ octave_cv_hdf5_has_enforced_16_api=yes], [ octave_cv_hdf5_has_enforced_16_api=no])]) if test "$octave_cv_hdf5_has_enforced_16_api" != "yes"; then - AC_DEFINE(HAVE_HDF5_18, 1, [Define if >=HDF5-1.8 is available.]) + AC_DEFINE(HAVE_HDF5_18, 1, [Define to 1 if >=HDF5-1.8 is available.]) fi ]) dnl -dnl Check for the QHull version. +dnl Check for the Qhull version. dnl AC_DEFUN([OCTAVE_CHECK_QHULL_VERSION], [AC_CACHE_CHECK([for qh_version in $QHULL_LIBS], @@ -1081,11 +1081,11 @@ ]])], [octave_cv_lib_qhull_version=yes], [octave_cv_lib_qhull_version=no])]) if test "$octave_cv_lib_qhull_version" = no; then AC_DEFINE(NEED_QHULL_VERSION, 1, - [Define if the QHull library needs a qh_version variable defined.]) + [Define to 1 if the Qhull library needs a qh_version variable defined.]) fi ]) dnl -dnl Check whether QHull works (does not crash) +dnl Check whether Qhull works (does not crash) dnl AC_DEFUN([OCTAVE_CHECK_QHULL_OK], [AC_CACHE_CHECK([whether the qhull library works], @@ -1291,10 +1291,10 @@ dnl dnl Check for OpenGL. If found, define OPENGL_LIBS dnl -dnl FIXME -- the following tests should probably check for the +dnl FIXME: The following tests should probably check for the dnl libraries separately. dnl -dnl FIXME -- should we allow a way to specify a directory for OpenGL +dnl FIXME: Should we allow a way to specify a directory for OpenGL dnl libraries and header files? dnl AC_DEFUN([OCTAVE_OPENGL], [ @@ -1307,7 +1307,7 @@ [have_framework_opengl="yes"], [have_framework_opengl="no"]) if test $have_framework_opengl = "yes"; then - AC_DEFINE(HAVE_FRAMEWORK_OPENGL, 1, [Define if framework OPENGL is available.]) + AC_DEFINE(HAVE_FRAMEWORK_OPENGL, 1, [Define to 1 if framework OPENGL is available.]) OPENGL_LIBS="-Wl,-framework -Wl,OpenGL" AC_MSG_NOTICE([adding -Wl,-framework -Wl,OpenGL to OPENGL_LIBS]) OCTAVE_GLUTESSCALLBACK_THREEDOTS @@ -1382,7 +1382,7 @@ AC_LANG_POP(C++) if test $octave_cv_glutesscallback_threedots = "yes"; then AC_DEFINE(HAVE_GLUTESSCALLBACK_THREEDOTS, 1, - [Define if gluTessCallback is called with (...)]) + [Define to 1 if gluTessCallback is called with (...).]) fi ]) dnl @@ -1408,7 +1408,7 @@ ]])],octave_cv_openmp=yes, octave_cv_openmmp=no, octave_cv_openmp=no)]) AC_MSG_RESULT($octave_cv_openmp) if test "$octave_cv_openmp" = yes; then - AC_DEFINE(HAVE_OPENMP,1,[Define if compiler supports OpenMP]) + AC_DEFINE(HAVE_OPENMP,1,[Define to 1 if compiler supports OpenMP.]) CXXFLAGS="$CXXFLAGS $1" else CFLAGS="$XCFLAGS" @@ -1627,7 +1627,7 @@ take_func(std::$1); ]])], [AC_MSG_RESULT([yes]) - AC_DEFINE(HAVE_CMATH_[]AS_TR_CPP($1),1,[Define if provides $1])], + AC_DEFINE(HAVE_CMATH_[]AS_TR_CPP($1),1,[Define to 1 if provides $1.])], [AC_MSG_RESULT([no])]) AC_MSG_CHECKING([for std::$1 (float variant) in ]) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ @@ -1640,13 +1640,13 @@ take_func(std::$1); ]])], [AC_MSG_RESULT([yes]) - AC_DEFINE(HAVE_CMATH_[]AS_TR_CPP($1)F,1,[Define if provides float variant of $1])], + AC_DEFINE(HAVE_CMATH_[]AS_TR_CPP($1)F,1,[Define to 1 if provides float variant of $1.])], [AC_MSG_RESULT([no])]) AC_LANG_POP(C++) ]) dnl Check whether fast signed integer arithmetics using bit tricks -dnl can be used in oct-inttypes.h. Defines HAVE_FAST_INT_OPS if +dnl can be used in oct-inttypes.h. Defines HAVE_FAST_INT_OPS if dnl the following conditions hold: dnl 1. Signed numbers are represented by twos complement dnl (see ) @@ -1711,7 +1711,7 @@ AC_LANG_POP(C++)]) if test $octave_cv_fast_int_ops = yes; then AC_DEFINE(HAVE_FAST_INT_OPS, 1, - [Define if signed integers use two's complement]) + [Define to 1 if signed integers use two's complement.]) fi ]) dnl @@ -1719,7 +1719,7 @@ dnl "-framework $1" for the given prologue $2 and the given body $3 of dnl a source file. Arguments 2 and 3 optionally can also be empty. dnl Add options (lower case letters $1) "--with-framework-$1" and -dnl "--without-framework-$1". If this test is successful then perform +dnl "--without-framework-$1". If this test is successful then perform dnl $4, otherwise do $5. dnl dnl OCTAVE_HAVE_FRAMEWORK diff -r d02b229ce693 -r a132d206a36a scripts/image/image.m --- a/scripts/image/image.m Thu Aug 02 12:12:00 2012 +0200 +++ b/scripts/image/image.m Fri Aug 03 14:59:40 2012 -0400 @@ -72,6 +72,11 @@ firstnonnumeric = 4; endif + if (iscomplex (img)) + warning ("image: only showing real part of complex image"); + img = real (img); + endif + oldax = gca (); unwind_protect axes (ax); @@ -241,3 +246,6 @@ %! hold off; %! title ("line, image, line, image, line"); +## Test input validation +%!error image (1+i) +%!error image ([]) diff -r d02b229ce693 -r a132d206a36a scripts/pkg/pkg.m --- a/scripts/pkg/pkg.m Thu Aug 02 12:12:00 2012 +0200 +++ b/scripts/pkg/pkg.m Fri Aug 03 14:59:40 2012 -0400 @@ -428,7 +428,7 @@ endif warning ("creating the directory %s\n", prefix); endif - local_packages = prefix = canonicalize_filename (prefix); + local_packages = prefix = canonicalize_file_name (prefix); user_prefix = true; if (length (files) >= 2 && ischar (files{2})) archprefix = files{2}; diff -r d02b229ce693 -r a132d206a36a scripts/plot/gtext.m --- a/scripts/plot/gtext.m Thu Aug 02 12:12:00 2012 +0200 +++ b/scripts/plot/gtext.m Fri Aug 03 14:59:40 2012 -0400 @@ -18,16 +18,24 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} gtext (@var{s}) +## @deftypefnx {Function File} {} gtext (@{@var{s1}, @var{s2}, @dots{}@}) ## @deftypefnx {Function File} {} gtext (@{@var{s1}; @var{s2}; @dots{}@}) ## @deftypefnx {Function File} {} gtext (@dots{}, @var{prop}, @var{val}) +## @deftypefnx {Function File} {@var{h} =} gtext (@dots{}) ## Place text on the current figure using the mouse. The text is defined -## by the string @var{s}. If @var{s} is a cell array, each element of the cell -## array is written to a separate line. Additional arguments are passed to -## the underlying text object as properties. +## by the string @var{s}. If @var{s} is a cell string organized as a row +## vector then each string of the cell array is written to a separate line. +## If @var{s} is organized as a column vector then one string element of the +## cell array is placed for every mouse click. Additional inputs besides a +## string or cellstr are passed to the underlying text object as Property-value +## pairs. +## +## The optional return value @var{h} is a graphics handle to the created +## text object. ## @seealso{ginput, text} ## @end deftypefn -function gtext (s, varargin) +function h = gtext (s, varargin) if (nargin < 1) print_usage (); @@ -37,9 +45,21 @@ error ("gtext: S must be a string or cell array of strings"); endif + htmp = -1; if (! isempty (s)) - [x, y] = ginput (1); - text (x, y, s, varargin{:}); + if (ischar (s) || isrow (s)) + [x, y] = ginput (1); + htmp = text (x, y, s, varargin{:}); + else + for i = 1:numel (s) + [x, y] = ginput (1); + htmp = text (x, y, s{i}, varargin{:}); + endfor + endif + endif + + if (nargout > 0) + h = htmp; endif endfunction diff -r d02b229ce693 -r a132d206a36a scripts/polynomial/splinefit.m --- a/scripts/polynomial/splinefit.m Thu Aug 02 12:12:00 2012 +0200 +++ b/scripts/polynomial/splinefit.m Fri Aug 03 14:59:40 2012 -0400 @@ -221,19 +221,19 @@ pp = __splinefit__ (x, y, breaks, args{:}); endfunction + %!shared xb, yb, x %! xb = 0:2:10; -%! yb = randn (size (xb)); +%! yb = 2*rand (size (xb)) - 1; %! x = 0:0.1:10; %!test %! y = interp1 (xb, yb, x, "linear"); -%! assert (ppval (splinefit (x, y, xb, "order", 1), x), y, 10 * eps ()); +%! assert (ppval (splinefit (x, y, xb, "order", 1), x), y, 15 * eps ()); %!test %! y = interp1 (xb, yb, x, "spline"); -%! assert (ppval (splinefit (x, y, xb, "order", 3), x), y, 10 * eps ()); +%! assert (ppval (splinefit (x, y, xb, "order", 3), x), y, 15 * eps ()); %!test %! y = interp1 (xb, yb, x, "spline"); -%! assert (ppval (splinefit (x, y, xb), x), y, 10 * eps ()); +%! assert (ppval (splinefit (x, y, xb), x), y, 15 * eps ()); - diff -r d02b229ce693 -r a132d206a36a scripts/testfun/demo.m --- a/scripts/testfun/demo.m Thu Aug 02 12:12:00 2012 +0200 +++ b/scripts/testfun/demo.m Fri Aug 03 14:59:40 2012 -0400 @@ -123,19 +123,11 @@ ## Process each demo without failing try block = code(idx(doidx(i)):idx(doidx(i)+1)-1); - ## FIXME: need to check for embedded test functions, which cause - ## segfaults, until issues with subfunctions in functions are resolved. - embed_func = regexp (block, '^\s*function ', 'once', 'lineanchors'); - if (isempty (embed_func)) - ## Use an environment without variables - eval (cstrcat ("function __demo__ ()\n", block, "\nendfunction")); - ## Display the code that will be executed before executing it - printf ("%s example %d:%s\n\n", name, doidx(i), block); - __demo__; - else - error (["Functions embedded in %!demo blocks are not allowed.\n", ... - "Use the %!function/%!endfunction syntax instead to define shared functions for testing.\n"]); - endif + ## Use an environment without variables + eval (cstrcat ("function __demo__ ()\n", block, "\nendfunction")); + ## Display the code that will be executed before executing it + printf ("%s example %d:%s\n\n", name, doidx(i), block); + __demo__; catch ## Let the programmer know which demo failed. printf ("%s example %d: failed\n%s\n", name, doidx(i), lasterr ()); diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/__delaunayn__.cc --- a/src/DLD-FUNCTIONS/__delaunayn__.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,229 +0,0 @@ -/* - -Copyright (C) 2000-2012 Kai Habel - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - 16. July 2000 - Kai Habel: first release - - 25. September 2002 - Changes by Rafael Laboissiere - - * Added Qbb option to normalize the input and avoid crashes in Octave. - * delaunayn accepts now a second (optional) argument that must be a string - containing extra options to the qhull command. - * Fixed doc string. The dimension of the result matrix is [m, dim+1], and - not [n, dim-1]. - - 6. June 2006: Changes by Alexander Barth - - * triangulate non-simplicial facets - * allow options to be specified as cell array of strings - * change the default options (for compatibility with matlab) -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "Cell.h" -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" -#include "unwind-prot.h" - -#if defined (HAVE_QHULL) -# include "oct-qhull.h" -# if defined (NEED_QHULL_VERSION) -char qh_version[] = "__delaunayn__.oct 2007-08-21"; -# endif -#endif - -static void -close_fcn (FILE *f) -{ - gnulib::fclose (f); -} - -DEFUN_DLD (__delaunayn__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts})\n\ -@deftypefnx {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts}, @var{options})\n\ -Undocumented internal function.\n\ -@end deftypefn") - -{ - octave_value_list retval; - -#if defined (HAVE_QHULL) - - retval(0) = 0.0; - - int nargin = args.length (); - if (nargin < 1 || nargin > 2) - { - print_usage (); - return retval; - } - - Matrix p (args(0).matrix_value ()); - const octave_idx_type dim = p.columns (); - const octave_idx_type n = p.rows (); - - // Default options - std::string options; - if (dim <= 3) - options = "Qt Qbb Qc Qz"; - else - options = "Qt Qbb Qc Qx"; - - if (nargin == 2) - { - if (args(1).is_string ()) - options = args(1).string_value (); - else if (args(1).is_empty ()) - ; // Use default options - else if (args(1).is_cellstr ()) - { - options = ""; - Array tmp = args(1).cellstr_value (); - - for (octave_idx_type i = 0; i < tmp.numel (); i++) - options += tmp(i) + " "; - } - else - { - error ("__delaunayn__: OPTIONS argument must be a string, cell array of strings, or empty"); - return retval; - } - } - - if (n > dim + 1) - { - p = p.transpose (); - double *pt_array = p.fortran_vec (); - boolT ismalloc = false; - - // Qhull flags argument is not const char* - OCTAVE_LOCAL_BUFFER (char, flags, 9 + options.length ()); - - sprintf (flags, "qhull d %s", options.c_str ()); - - unwind_protect frame; - - // Replace the outfile pointer with stdout for debugging information. -#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) - FILE *outfile = gnulib::fopen ("NUL", "w"); -#else - FILE *outfile = gnulib::fopen ("/dev/null", "w"); -#endif - FILE *errfile = stderr; - - if (outfile) - frame.add_fcn (close_fcn, outfile); - else - { - error ("__delaunayn__: unable to create temporary file for output"); - return retval; - } - - int exitcode = qh_new_qhull (dim, n, pt_array, - ismalloc, flags, outfile, errfile); - if (! exitcode) - { - // triangulate non-simplicial facets - qh_triangulate (); - - facetT *facet; - vertexT *vertex, **vertexp; - octave_idx_type nf = 0, i = 0; - - FORALLfacets - { - if (! facet->upperdelaunay) - nf++; - - // Double check. Non-simplicial facets will cause segfault below - if (! facet->simplicial) - { - error ("__delaunayn__: Qhull returned non-simplicial facets -- try delaunayn with different options"); - exitcode = 1; - break; - } - } - - if (! exitcode) - { - Matrix simpl (nf, dim+1); - - FORALLfacets - { - if (! facet->upperdelaunay) - { - octave_idx_type j = 0; - - FOREACHvertex_ (facet->vertices) - { - simpl(i, j++) = 1 + qh_pointid(vertex->point); - } - i++; - } - } - - retval(0) = simpl; - } - } - else - error ("__delaunayn__: qhull failed"); - - // Free memory from Qhull - qh_freeqhull (! qh_ALL); - - int curlong, totlong; - qh_memfreeshort (&curlong, &totlong); - - if (curlong || totlong) - warning ("__delaunay__: did not free %d bytes of long memory (%d pieces)", - totlong, curlong); - } - else if (n == dim + 1) - { - // one should check if nx points span a simplex - // I will look at this later. - RowVector vec (n); - for (octave_idx_type i = 0; i < n; i++) - vec(i) = i + 1.0; - - retval(0) = vec; - } - -#else - error ("__delaunayn__: not available in this version of Octave"); -#endif - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/__dsearchn__.cc --- a/src/DLD-FUNCTIONS/__dsearchn__.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,115 +0,0 @@ -/* - -Copyright (C) 2007-2012 David Bateman - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "lo-math.h" - -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" - -DEFUN_DLD (__dsearchn__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{idx}, @var{d}] =} dsearch (@var{x}, @var{xi})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value_list retval; - - if (nargin != 2) - { - print_usage (); - return retval; - } - - Matrix x = args(0).matrix_value ().transpose (); - Matrix xi = args(1).matrix_value ().transpose (); - - if (! error_state) - { - if (x.rows () != xi.rows () || x.columns () < 1) - error ("__dsearch__: number of rows of X and XI must match"); - else - { - octave_idx_type n = x.rows (); - octave_idx_type nx = x.columns (); - octave_idx_type nxi = xi.columns (); - - ColumnVector idx (nxi); - double *pidx = idx.fortran_vec (); - ColumnVector dist (nxi); - double *pdist = dist.fortran_vec (); - -#define DIST(dd, y, yi, m) \ - dd = 0.; \ - for (octave_idx_type k = 0; k < m; k++) \ - { \ - double yd = y[k] - yi[k]; \ - dd += yd * yd; \ - } \ - dd = sqrt (dd); - - const double *pxi = xi.fortran_vec (); - for (octave_idx_type i = 0; i < nxi; i++) - { - double d0; - const double *px = x.fortran_vec (); - DIST(d0, px, pxi, n); - *pidx = 1.; - for (octave_idx_type j = 1; j < nx; j++) - { - px += n; - double d; - DIST (d, px, pxi, n); - if (d < d0) - { - d0 = d; - *pidx = static_cast(j + 1); - } - OCTAVE_QUIT; - } - - *pdist++ = d0; - pidx++; - pxi += n; - } - - retval(1) = dist; - retval(0) = idx; - } - } - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/__fltk_uigetfile__.cc --- a/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,142 +0,0 @@ -/* - -Copyright (C) 2010-2012 Kai Habel - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#if defined (HAVE_FLTK) - -#ifdef WIN32 -#define WIN32_LEAN_AND_MEAN -#endif - -#include -#include - -// FLTK headers may include X11/X.h which defines Complex, and that -// conflicts with Octave's Complex typedef. We don't need the X11 -// Complex definition in this file, so remove it before including Octave -// headers which may require Octave's Complex typedef. -#undef Complex - -#include "defun-dld.h" -#include "file-ops.h" - -DEFUN_DLD (__fltk_uigetfile__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __fltk_uigetfile__ (@dots{})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - // Expected argument list: - // - // args(0) ... FileFilter in fltk format - // args(1) ... Title - // args(2) ... Default Filename - // args(3) ... PostionValue [x,y] - // args(4) ... SelectValue "on"/"off"/"dir"/"create" - - octave_value_list retval (3, octave_value (0)); - - std::string file_filter = args(0).string_value (); - std::string title = args(1).string_value (); - std::string default_name = args(2).string_value (); - Matrix pos = args(3).matrix_value (); - - int multi_type = Fl_File_Chooser::SINGLE; - std::string flabel = "Filename:"; - - std::string multi = args(4).string_value (); - if (multi == "on") - multi_type = Fl_File_Chooser::MULTI; - else if (multi == "dir") - { - multi_type = Fl_File_Chooser::DIRECTORY; - flabel = "Directory:"; - } - else if (multi == "create") - multi_type = Fl_File_Chooser::CREATE; - - Fl_File_Chooser::filename_label = flabel.c_str (); - - Fl_File_Chooser fc (default_name.c_str (), file_filter.c_str (), - multi_type, title.c_str ()); - - fc.preview (0); - - if (multi_type == Fl_File_Chooser::CREATE) - fc.ok_label ("Save"); - - fc.show (); - - while (fc.shown ()) - Fl::wait (); - - if (fc.value ()) - { - int file_count = fc.count (); - std::string fname; - - //fltk uses forward slash even for windows - std::string sep = "/"; - std::size_t idx; - - if (file_count == 1 && multi_type != Fl_File_Chooser::DIRECTORY) - { - fname = fc.value (); - idx = fname.find_last_of (sep); - retval(0) = fname.substr (idx + 1); - } - else - { - Cell file_cell = Cell (file_count, 1); - for (octave_idx_type n = 1; n <= file_count; n++) - { - fname = fc.value (n); - idx = fname.find_last_of (sep); - file_cell(n - 1) = fname.substr (idx + 1); - } - retval(0) = file_cell; - } - - if (multi_type == Fl_File_Chooser::DIRECTORY) - retval(0) = std::string (fc.value ()); - else - { - retval(1) = std::string (fc.directory ()) + sep; - retval(2) = fc.filter_value () + 1; - } - } - - fc.hide (); - Fl::flush (); - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ - -#endif diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/__glpk__.cc --- a/src/DLD-FUNCTIONS/__glpk__.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,861 +0,0 @@ -/* - -Copyright (C) 2005-2012 Nicolo' Giorgetti - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "lo-ieee.h" - -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "pager.h" - -#if defined (HAVE_GLPK) - -extern "C" -{ -#if defined (HAVE_GLPK_GLPK_H) -#include -#else -#include -#endif - -#if 0 -#ifdef GLPK_PRE_4_14 - -#ifndef _GLPLIB_H -#include -#endif -#ifndef lib_set_fault_hook -#define lib_set_fault_hook lib_fault_hook -#endif -#ifndef lib_set_print_hook -#define lib_set_print_hook lib_print_hook -#endif - -#else - -void _glp_lib_print_hook (int (*func)(void *info, char *buf), void *info); -void _glp_lib_fault_hook (int (*func)(void *info, char *buf), void *info); - -#endif -#endif -} - -#define NIntP 17 -#define NRealP 10 - -int lpxIntParam[NIntP] = { - 0, - 1, - 0, - 1, - 0, - -1, - 0, - 200, - 1, - 2, - 0, - 1, - 0, - 0, - 2, - 2, - 1 -}; - -int IParam[NIntP] = { - LPX_K_MSGLEV, - LPX_K_SCALE, - LPX_K_DUAL, - LPX_K_PRICE, - LPX_K_ROUND, - LPX_K_ITLIM, - LPX_K_ITCNT, - LPX_K_OUTFRQ, - LPX_K_MPSINFO, - LPX_K_MPSOBJ, - LPX_K_MPSORIG, - LPX_K_MPSWIDE, - LPX_K_MPSFREE, - LPX_K_MPSSKIP, - LPX_K_BRANCH, - LPX_K_BTRACK, - LPX_K_PRESOL -}; - - -double lpxRealParam[NRealP] = { - 0.07, - 1e-7, - 1e-7, - 1e-9, - -DBL_MAX, - DBL_MAX, - -1.0, - 0.0, - 1e-6, - 1e-7 -}; - -int RParam[NRealP] = { - LPX_K_RELAX, - LPX_K_TOLBND, - LPX_K_TOLDJ, - LPX_K_TOLPIV, - LPX_K_OBJLL, - LPX_K_OBJUL, - LPX_K_TMLIM, - LPX_K_OUTDLY, - LPX_K_TOLINT, - LPX_K_TOLOBJ -}; - -static jmp_buf mark; //-- Address for long jump to jump to - -#if 0 -int -glpk_fault_hook (void * /* info */, char *msg) -{ - error ("CRITICAL ERROR in GLPK: %s", msg); - longjmp (mark, -1); -} - -int -glpk_print_hook (void * /* info */, char *msg) -{ - message (0, "%s", msg); - return 1; -} -#endif - -int -glpk (int sense, int n, int m, double *c, int nz, int *rn, int *cn, - double *a, double *b, char *ctype, int *freeLB, double *lb, - int *freeUB, double *ub, int *vartype, int isMIP, int lpsolver, - int save_pb, double *xmin, double *fmin, double *status, - double *lambda, double *redcosts, double *time, double *mem) -{ - int errnum; - int typx = 0; - int method; - - clock_t t_start = clock (); - -#if 0 -#ifdef GLPK_PRE_4_14 - lib_set_fault_hook (0, glpk_fault_hook); -#else - _glp_lib_fault_hook (glpk_fault_hook, 0); -#endif - - if (lpxIntParam[0] > 1) -#ifdef GLPK_PRE_4_14 - lib_set_print_hook (0, glpk_print_hook); -#else - _glp_lib_print_hook (glpk_print_hook, 0); -#endif -#endif - - LPX *lp = lpx_create_prob (); - - - //-- Set the sense of optimization - if (sense == 1) - lpx_set_obj_dir (lp, LPX_MIN); - else - lpx_set_obj_dir (lp, LPX_MAX); - - //-- If the problem has integer structural variables switch to MIP - if (isMIP) - lpx_set_class (lp, LPX_MIP); - - lpx_add_cols (lp, n); - for (int i = 0; i < n; i++) - { - //-- Define type of the structural variables - if (! freeLB[i] && ! freeUB[i]) - { - if (lb[i] != ub[i]) - lpx_set_col_bnds (lp, i+1, LPX_DB, lb[i], ub[i]); - else - lpx_set_col_bnds (lp, i+1, LPX_FX, lb[i], ub[i]); - } - else - { - if (! freeLB[i] && freeUB[i]) - lpx_set_col_bnds (lp, i+1, LPX_LO, lb[i], ub[i]); - else - { - if (freeLB[i] && ! freeUB[i]) - lpx_set_col_bnds (lp, i+1, LPX_UP, lb[i], ub[i]); - else - lpx_set_col_bnds (lp, i+1, LPX_FR, lb[i], ub[i]); - } - } - - // -- Set the objective coefficient of the corresponding - // -- structural variable. No constant term is assumed. - lpx_set_obj_coef(lp,i+1,c[i]); - - if (isMIP) - lpx_set_col_kind (lp, i+1, vartype[i]); - } - - lpx_add_rows (lp, m); - - for (int i = 0; i < m; i++) - { - /* If the i-th row has no lower bound (types F,U), the - corrispondent parameter will be ignored. - If the i-th row has no upper bound (types F,L), the corrispondent - parameter will be ignored. - If the i-th row is of S type, the i-th LB is used, but - the i-th UB is ignored. - */ - - switch (ctype[i]) - { - case 'F': - typx = LPX_FR; - break; - - case 'U': - typx = LPX_UP; - break; - - case 'L': - typx = LPX_LO; - break; - - case 'S': - typx = LPX_FX; - break; - - case 'D': - typx = LPX_DB; - break; - } - - lpx_set_row_bnds (lp, i+1, typx, b[i], b[i]); - - } - - lpx_load_matrix (lp, nz, rn, cn, a); - - if (save_pb) - { - static char tmp[] = "outpb.lp"; - if (lpx_write_cpxlp (lp, tmp) != 0) - { - error ("__glpk__: unable to write problem"); - longjmp (mark, -1); - } - } - - //-- scale the problem data (if required) - //-- if (scale && (!presol || method == 1)) lpx_scale_prob (lp); - //-- LPX_K_SCALE=IParam[1] LPX_K_PRESOL=IParam[16] - if (lpxIntParam[1] && (! lpxIntParam[16] || lpsolver != 1)) - lpx_scale_prob (lp); - - //-- build advanced initial basis (if required) - if (lpsolver == 1 && ! lpxIntParam[16]) - lpx_adv_basis (lp); - - for (int i = 0; i < NIntP; i++) - lpx_set_int_parm (lp, IParam[i], lpxIntParam[i]); - - for (int i = 0; i < NRealP; i++) - lpx_set_real_parm (lp, RParam[i], lpxRealParam[i]); - - if (lpsolver == 1) - method = 'S'; - else - method = 'T'; - - switch (method) - { - case 'S': - { - if (isMIP) - { - method = 'I'; - errnum = lpx_simplex (lp); - errnum = lpx_integer (lp); - } - else - errnum = lpx_simplex (lp); - } - break; - - case 'T': - errnum = lpx_interior (lp); - break; - - default: - break; -#if 0 -#ifdef GLPK_PRE_4_14 - insist (method != method); -#else - static char tmp[] = "method != method"; - glpk_fault_hook (0, tmp); -#endif -#endif - } - - /* errnum assumes the following results: - errnum = 0 <=> No errors - errnum = 1 <=> Iteration limit exceeded. - errnum = 2 <=> Numerical problems with basis matrix. - */ - if (errnum == LPX_E_OK) - { - if (isMIP) - { - *status = lpx_mip_status (lp); - *fmin = lpx_mip_obj_val (lp); - } - else - { - if (lpsolver == 1) - { - *status = lpx_get_status (lp); - *fmin = lpx_get_obj_val (lp); - } - else - { - *status = lpx_ipt_status (lp); - *fmin = lpx_ipt_obj_val (lp); - } - } - - if (isMIP) - { - for (int i = 0; i < n; i++) - xmin[i] = lpx_mip_col_val (lp, i+1); - } - else - { - /* Primal values */ - for (int i = 0; i < n; i++) - { - if (lpsolver == 1) - xmin[i] = lpx_get_col_prim (lp, i+1); - else - xmin[i] = lpx_ipt_col_prim (lp, i+1); - } - - /* Dual values */ - for (int i = 0; i < m; i++) - { - if (lpsolver == 1) - lambda[i] = lpx_get_row_dual (lp, i+1); - else - lambda[i] = lpx_ipt_row_dual (lp, i+1); - } - - /* Reduced costs */ - for (int i = 0; i < lpx_get_num_cols (lp); i++) - { - if (lpsolver == 1) - redcosts[i] = lpx_get_col_dual (lp, i+1); - else - redcosts[i] = lpx_ipt_col_dual (lp, i+1); - } - } - - *time = (clock () - t_start) / CLOCKS_PER_SEC; - -#ifdef GLPK_PRE_4_14 - *mem = (lib_env_ptr () -> mem_tpeak); -#else - *mem = 0; -#endif - - lpx_delete_prob (lp); - return 0; - } - - lpx_delete_prob (lp); - - *status = errnum; - - return errnum; -} - -#endif - -#define OCTAVE_GLPK_GET_REAL_PARAM(NAME, IDX) \ - do \ - { \ - octave_value tmp = PARAM.getfield (NAME); \ - \ - if (tmp.is_defined ()) \ - { \ - if (! tmp.is_empty ()) \ - { \ - lpxRealParam[IDX] = tmp.scalar_value (); \ - \ - if (error_state) \ - { \ - error ("glpk: invalid value in PARAM." NAME); \ - return retval; \ - } \ - } \ - else \ - { \ - error ("glpk: invalid value in PARAM." NAME); \ - return retval; \ - } \ - } \ - } \ - while (0) - -#define OCTAVE_GLPK_GET_INT_PARAM(NAME, VAL) \ - do \ - { \ - octave_value tmp = PARAM.getfield (NAME); \ - \ - if (tmp.is_defined ()) \ - { \ - if (! tmp.is_empty ()) \ - { \ - VAL = tmp.int_value (); \ - \ - if (error_state) \ - { \ - error ("glpk: invalid value in PARAM." NAME); \ - return retval; \ - } \ - } \ - else \ - { \ - error ("glpk: invalid value in PARAM." NAME); \ - return retval; \ - } \ - } \ - } \ - while (0) - -DEFUN_DLD (__glpk__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{values}] =} __glpk__ (@var{args})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - // The list of values to return. See the declaration in oct-obj.h - octave_value_list retval; - -#if defined (HAVE_GLPK) - - int nrhs = args.length (); - - if (nrhs != 9) - { - print_usage (); - return retval; - } - - //-- 1nd Input. A column array containing the objective function - //-- coefficients. - volatile int mrowsc = args(0).rows (); - - Matrix C (args(0).matrix_value ()); - - if (error_state) - { - error ("__glpk__: invalid value of C"); - return retval; - } - - double *c = C.fortran_vec (); - Array rn; - Array cn; - ColumnVector a; - volatile int mrowsA; - volatile int nz = 0; - - //-- 2nd Input. A matrix containing the constraints coefficients. - // If matrix A is NOT a sparse matrix - if (args(1).is_sparse_type ()) - { - SparseMatrix A = args(1).sparse_matrix_value (); // get the sparse matrix - - if (error_state) - { - error ("__glpk__: invalid value of A"); - return retval; - } - - mrowsA = A.rows (); - octave_idx_type Anc = A.cols (); - octave_idx_type Anz = A.nnz (); - rn.resize (dim_vector (Anz+1, 1)); - cn.resize (dim_vector (Anz+1, 1)); - a.resize (Anz+1, 0.0); - - if (Anc != mrowsc) - { - error ("__glpk__: invalid value of A"); - return retval; - } - - for (octave_idx_type j = 0; j < Anc; j++) - for (octave_idx_type i = A.cidx (j); i < A.cidx (j+1); i++) - { - nz++; - rn(nz) = A.ridx (i) + 1; - cn(nz) = j + 1; - a(nz) = A.data(i); - } - } - else - { - Matrix A (args(1).matrix_value ()); // get the matrix - - if (error_state) - { - error ("__glpk__: invalid value of A"); - return retval; - } - - mrowsA = A.rows (); - rn.resize (dim_vector (mrowsA*mrowsc+1, 1)); - cn.resize (dim_vector (mrowsA*mrowsc+1, 1)); - a.resize (mrowsA*mrowsc+1, 0.0); - - for (int i = 0; i < mrowsA; i++) - { - for (int j = 0; j < mrowsc; j++) - { - if (A(i,j) != 0) - { - nz++; - rn(nz) = i + 1; - cn(nz) = j + 1; - a(nz) = A(i,j); - } - } - } - - } - - //-- 3rd Input. A column array containing the right-hand side value - // for each constraint in the constraint matrix. - Matrix B (args(2).matrix_value ()); - - if (error_state) - { - error ("__glpk__: invalid value of B"); - return retval; - } - - double *b = B.fortran_vec (); - - //-- 4th Input. An array of length mrowsc containing the lower - //-- bound on each of the variables. - Matrix LB (args(3).matrix_value ()); - - if (error_state || LB.length () < mrowsc) - { - error ("__glpk__: invalid value of LB"); - return retval; - } - - double *lb = LB.fortran_vec (); - - //-- LB argument, default: Free - Array freeLB (dim_vector (mrowsc, 1)); - for (int i = 0; i < mrowsc; i++) - { - if (xisinf (lb[i])) - { - freeLB(i) = 1; - lb[i] = -octave_Inf; - } - else - freeLB(i) = 0; - } - - //-- 5th Input. An array of at least length numcols containing the upper - //-- bound on each of the variables. - Matrix UB (args(4).matrix_value ()); - - if (error_state || UB.length () < mrowsc) - { - error ("__glpk__: invalid value of UB"); - return retval; - } - - double *ub = UB.fortran_vec (); - - Array freeUB (dim_vector (mrowsc, 1)); - for (int i = 0; i < mrowsc; i++) - { - if (xisinf (ub[i])) - { - freeUB(i) = 1; - ub[i] = octave_Inf; - } - else - freeUB(i) = 0; - } - - //-- 6th Input. A column array containing the sense of each constraint - //-- in the constraint matrix. - charMatrix CTYPE (args(5).char_matrix_value ()); - - if (error_state) - { - error ("__glpk__: invalid value of CTYPE"); - return retval; - } - - char *ctype = CTYPE.fortran_vec (); - - //-- 7th Input. A column array containing the types of the variables. - charMatrix VTYPE (args(6).char_matrix_value ()); - - if (error_state) - { - error ("__glpk__: invalid value of VARTYPE"); - return retval; - } - - Array vartype (dim_vector (mrowsc, 1)); - volatile int isMIP = 0; - for (int i = 0; i < mrowsc ; i++) - { - if (VTYPE(i,0) == 'I') - { - isMIP = 1; - vartype(i) = LPX_IV; - } - else - vartype(i) = LPX_CV; - } - - //-- 8th Input. Sense of optimization. - volatile int sense; - double SENSE = args(7).scalar_value (); - - if (error_state) - { - error ("__glpk__: invalid value of SENSE"); - return retval; - } - - if (SENSE >= 0) - sense = 1; - else - sense = -1; - - //-- 9th Input. A structure containing the control parameters. - octave_scalar_map PARAM = args(8).scalar_map_value (); - - if (error_state) - { - error ("__glpk__: invalid value of PARAM"); - return retval; - } - - //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - //-- Integer parameters - //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - //-- Level of messages output by the solver - OCTAVE_GLPK_GET_INT_PARAM ("msglev", lpxIntParam[0]); - if (lpxIntParam[0] < 0 || lpxIntParam[0] > 3) - { - error ("__glpk__: PARAM.msglev must be 0 (no output [default]) or 1 (error messages only) or 2 (normal output) or 3 (full output)"); - return retval; - } - - //-- scaling option - OCTAVE_GLPK_GET_INT_PARAM ("scale", lpxIntParam[1]); - if (lpxIntParam[1] < 0 || lpxIntParam[1] > 2) - { - error ("__glpk__: PARAM.scale must be 0 (no scaling) or 1 (equilibration scaling [default]) or 2 (geometric mean scaling)"); - return retval; - } - - //-- Dual dimplex option - OCTAVE_GLPK_GET_INT_PARAM ("dual", lpxIntParam[2]); - if (lpxIntParam[2] < 0 || lpxIntParam[2] > 1) - { - error ("__glpk__: PARAM.dual must be 0 (do NOT use dual simplex [default]) or 1 (use dual simplex)"); - return retval; - } - - //-- Pricing option - OCTAVE_GLPK_GET_INT_PARAM ("price", lpxIntParam[3]); - if (lpxIntParam[3] < 0 || lpxIntParam[3] > 1) - { - error ("__glpk__: PARAM.price must be 0 (textbook pricing) or 1 (steepest edge pricing [default])"); - return retval; - } - - //-- Solution rounding option - OCTAVE_GLPK_GET_INT_PARAM ("round", lpxIntParam[4]); - if (lpxIntParam[4] < 0 || lpxIntParam[4] > 1) - { - error ("__glpk__: PARAM.round must be 0 (report all primal and dual values [default]) or 1 (replace tiny primal and dual values by exact zero)"); - return retval; - } - - //-- Simplex iterations limit - OCTAVE_GLPK_GET_INT_PARAM ("itlim", lpxIntParam[5]); - - //-- Simplex iterations count - OCTAVE_GLPK_GET_INT_PARAM ("itcnt", lpxIntParam[6]); - - //-- Output frequency, in iterations - OCTAVE_GLPK_GET_INT_PARAM ("outfrq", lpxIntParam[7]); - - //-- Branching heuristic option - OCTAVE_GLPK_GET_INT_PARAM ("branch", lpxIntParam[14]); - if (lpxIntParam[14] < 0 || lpxIntParam[14] > 2) - { - error ("__glpk__: PARAM.branch must be (MIP only) 0 (branch on first variable) or 1 (branch on last variable) or 2 (branch using a heuristic by Driebeck and Tomlin [default]"); - return retval; - } - - //-- Backtracking heuristic option - OCTAVE_GLPK_GET_INT_PARAM ("btrack", lpxIntParam[15]); - if (lpxIntParam[15] < 0 || lpxIntParam[15] > 2) - { - error ("__glpk__: PARAM.btrack must be (MIP only) 0 (depth first search) or 1 (breadth first search) or 2 (backtrack using the best projection heuristic [default]"); - return retval; - } - - //-- Presolver option - OCTAVE_GLPK_GET_INT_PARAM ("presol", lpxIntParam[16]); - if (lpxIntParam[16] < 0 || lpxIntParam[16] > 1) - { - error ("__glpk__: PARAM.presol must be 0 (do NOT use LP presolver) or 1 (use LP presolver [default])"); - return retval; - } - - //-- LPsolver option - volatile int lpsolver = 1; - OCTAVE_GLPK_GET_INT_PARAM ("lpsolver", lpsolver); - if (lpsolver < 1 || lpsolver > 2) - { - error ("__glpk__: PARAM.lpsolver must be 1 (simplex method) or 2 (interior point method)"); - return retval; - } - - //-- Save option - volatile int save_pb = 0; - OCTAVE_GLPK_GET_INT_PARAM ("save", save_pb); - save_pb = save_pb != 0; - - //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - //-- Real parameters - //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - //-- Ratio test option - OCTAVE_GLPK_GET_REAL_PARAM ("relax", 0); - - //-- Relative tolerance used to check if the current basic solution - //-- is primal feasible - OCTAVE_GLPK_GET_REAL_PARAM ("tolbnd", 1); - - //-- Absolute tolerance used to check if the current basic solution - //-- is dual feasible - OCTAVE_GLPK_GET_REAL_PARAM ("toldj", 2); - - //-- Relative tolerance used to choose eligible pivotal elements of - //-- the simplex table in the ratio test - OCTAVE_GLPK_GET_REAL_PARAM ("tolpiv", 3); - - OCTAVE_GLPK_GET_REAL_PARAM ("objll", 4); - - OCTAVE_GLPK_GET_REAL_PARAM ("objul", 5); - - OCTAVE_GLPK_GET_REAL_PARAM ("tmlim", 6); - - OCTAVE_GLPK_GET_REAL_PARAM ("outdly", 7); - - OCTAVE_GLPK_GET_REAL_PARAM ("tolint", 8); - - OCTAVE_GLPK_GET_REAL_PARAM ("tolobj", 9); - - //-- Assign pointers to the output parameters - ColumnVector xmin (mrowsc, octave_NA); - double fmin = octave_NA; - double status; - ColumnVector lambda (mrowsA, octave_NA); - ColumnVector redcosts (mrowsc, octave_NA); - double time; - double mem; - - int jmpret = setjmp (mark); - - if (jmpret == 0) - glpk (sense, mrowsc, mrowsA, c, nz, rn.fortran_vec (), - cn.fortran_vec (), a.fortran_vec (), b, ctype, - freeLB.fortran_vec (), lb, freeUB.fortran_vec (), ub, - vartype.fortran_vec (), isMIP, lpsolver, save_pb, - xmin.fortran_vec (), &fmin, &status, lambda.fortran_vec (), - redcosts.fortran_vec (), &time, &mem); - - octave_scalar_map extra; - - if (! isMIP) - { - extra.assign ("lambda", lambda); - extra.assign ("redcosts", redcosts); - } - - extra.assign ("time", time); - extra.assign ("mem", mem); - - retval(3) = extra; - retval(2) = status; - retval(1) = fmin; - retval(0) = xmin; - -#else - - gripe_not_supported ("glpk"); - -#endif - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/__init_fltk__.cc --- a/src/DLD-FUNCTIONS/__init_fltk__.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2129 +0,0 @@ -/* - -Copyright (C) 2007-2012 Shai Ayal - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - -To initialize: - - graphics_toolkit ("fltk"); - plot (randn (1e3, 1)); - -*/ - -// PKG_ADD: register_graphics_toolkit ("fltk"); - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "defun-dld.h" -#include "error.h" - -#if defined (HAVE_FLTK) - -#include -#include -#include -#include - -#ifdef WIN32 -#define WIN32_LEAN_AND_MEAN -#endif - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -// FLTK headers may include X11/X.h which defines Complex, and that -// conflicts with Octave's Complex typedef. We don't need the X11 -// Complex definition in this file, so remove it before including Octave -// headers which may require Octave's Complex typedef. -#undef Complex - -#include "cmd-edit.h" -#include "lo-ieee.h" - -#include "file-ops.h" -#include "gl-render.h" -#include "gl2ps-renderer.h" -#include "graphics.h" -#include "parse.h" -#include "sysdep.h" -#include "toplev.h" -#include "variables.h" - -#define FLTK_GRAPHICS_TOOLKIT_NAME "fltk" - -// Give FLTK no more than 0.01 sec to do its stuff. -static double fltk_maxtime = 1e-2; - -const char* help_text = "\ -Keyboard Shortcuts\n\ -a - autoscale\n\ -p - pan/zoom\n\ -r - rotate\n\ -g - toggle grid\n\ -\n\ -Mouse\n\ -left drag - pan\n\ -mouse wheel - zoom\n\ -right drag - rectangle zoom\n\ -left double click - autoscale\n\ -"; - -class OpenGL_fltk : public Fl_Gl_Window -{ -public: - OpenGL_fltk (int xx, int yy, int ww, int hh, double num) - : Fl_Gl_Window (xx, yy, ww, hh, 0), number (num), renderer (), - in_zoom (false), zoom_box (), print_mode (false) - { - // Ask for double buffering and a depth buffer. - mode (FL_DEPTH | FL_DOUBLE); - } - - ~OpenGL_fltk (void) { } - - void zoom (bool z) - { - in_zoom = z; - if (! in_zoom) - hide_overlay (); - } - - bool zoom (void) { return in_zoom; } - void set_zoom_box (const Matrix& zb) { zoom_box = zb; } - - void print (const std::string& cmd, const std::string& term) - { - print_mode = true; - print_cmd = cmd; - print_term = term; - } - - void resize (int xx, int yy, int ww, int hh) - { - Fl_Gl_Window::resize (xx, yy, ww, hh); - setup_viewport (ww, hh); - redraw (); - } - - bool renumber (double new_number) - { - bool retval = false; - - if (number != new_number) - { - number = new_number; - retval = true; - } - - return retval; - } - -private: - double number; - opengl_renderer renderer; - bool in_zoom; - // (x1,y1,x2,y2) - Matrix zoom_box; - - bool print_mode; - std::string print_cmd; - std::string print_term; - - void setup_viewport (int ww, int hh) - { - glMatrixMode (GL_PROJECTION); - glLoadIdentity (); - glViewport (0, 0, ww, hh); - } - - void draw (void) - { - if (! valid ()) - { - valid (1); - setup_viewport (w (), h ()); - } - - if (print_mode) - { - FILE *fp = octave_popen (print_cmd.c_str (), "w"); - glps_renderer rend (fp, print_term); - - rend.draw (gh_manager::get_object (number)); - - octave_pclose (fp); - print_mode = false; - } - else - { - renderer.draw (gh_manager::get_object (number)); - - if (zoom ()) - overlay (); - } - } - - void zoom_box_vertex (void) - { - glVertex2d (zoom_box(0), h () - zoom_box(1)); - glVertex2d (zoom_box(0), h () - zoom_box(3)); - glVertex2d (zoom_box(2), h () - zoom_box(3)); - glVertex2d (zoom_box(2), h () - zoom_box(1)); - glVertex2d (zoom_box(0), h () - zoom_box(1)); - } - - void overlay (void) - { - glPushMatrix (); - - glMatrixMode (GL_MODELVIEW); - glLoadIdentity (); - - glMatrixMode (GL_PROJECTION); - glLoadIdentity (); - gluOrtho2D (0.0, w (), 0.0, h ()); - - glPushAttrib (GL_DEPTH_BUFFER_BIT | GL_CURRENT_BIT); - glDisable (GL_DEPTH_TEST); - - glBegin (GL_POLYGON); - glColor4f (0.45, 0.62, 0.81, 0.1); - zoom_box_vertex (); - glEnd (); - - glBegin (GL_LINE_STRIP); - glLineWidth (1.5); - glColor4f (0.45, 0.62, 0.81, 0.9); - zoom_box_vertex (); - glEnd (); - - glPopAttrib (); - glPopMatrix (); - } - - int handle (int event) - { - int retval = Fl_Gl_Window::handle (event); - - switch (event) - { - case FL_ENTER: - window ()->cursor (FL_CURSOR_CROSS); - return 1; - - case FL_LEAVE: - window ()->cursor (FL_CURSOR_DEFAULT); - return 1; - } - - return retval; - } -}; - -// Parameter controlling how fast we zoom when using the scrool wheel. -static double wheel_zoom_speed = 0.05; -// Parameter controlling the GUI mode. -static enum { pan_zoom, rotate_zoom, none } gui_mode; - -void script_cb (Fl_Widget*, void* data) - { - static_cast (data)->execute_callback (); - } - - -class fltk_uimenu -{ -public: - fltk_uimenu (int xx, int yy, int ww, int hh) - { - menubar = new - Fl_Menu_Bar (xx, yy, ww, hh); - } - - int items_to_show (void) - { - //returns the number of visible menu items - int len = menubar->size (); - int n = 0; - for (int t = 0; t < len; t++ ) - { - const Fl_Menu_Item *m = static_cast (&(menubar->menu ()[t])); - if ((m->label () != NULL) && m->visible ()) - n++; - } - - return n; - } - - void show (void) - { - menubar->show (); - } - - void hide (void) - { - menubar->hide (); - } - - bool is_visible (void) - { - return menubar->visible (); - } - - int find_index_by_name (const std::string& findname) - { - // This function is derived from Greg Ercolano's function - // int GetIndexByName(...), see: - // http://seriss.com/people/erco/fltk/#Menu_ChangeLabel - // He agreed via PM that it can be included in octave using GPLv3 - // Kai Habel (14.10.2010) - - std::string menupath; - for (int t = 0; t < menubar->size (); t++ ) - { - Fl_Menu_Item *m = const_cast (&(menubar->menu ()[t])); - if (m->submenu ()) - { - // item has submenu - if (!menupath.empty ()) - menupath += "/"; - menupath += m->label (); - - if (menupath.compare (findname) == 0 ) - return (t); - } - else - { - // End of submenu? Pop back one level. - if (m->label () == NULL) - { - std::size_t idx = menupath.find_last_of ("/"); - if (idx != std::string::npos) - menupath.erase (idx); - else - menupath.clear (); - continue; - } - // Menu item? - std::string itempath = menupath; - if (!itempath.empty ()) - itempath += "/"; - itempath += m->label (); - - if (itempath.compare (findname) == 0) - return (t); - } - } - return (-1); - } - - Matrix find_uimenu_children (uimenu::properties& uimenup) const - { - Matrix uimenu_childs = uimenup.get_all_children (); - Matrix retval = do_find_uimenu_children (uimenu_childs); - return retval; - } - - Matrix find_uimenu_children (figure::properties& figp) const - { - Matrix uimenu_childs = figp.get_all_children (); - Matrix retval = do_find_uimenu_children (uimenu_childs); - return retval; - } - - Matrix do_find_uimenu_children (Matrix uimenu_childs) const - { - octave_idx_type k = 0; - - - Matrix pos = Matrix (uimenu_childs.numel (), 1); - - for (octave_idx_type ii = 0; ii < uimenu_childs.numel (); ii++) - { - graphics_object kidgo = gh_manager::get_object (uimenu_childs (ii)); - - if (kidgo.valid_object () && kidgo.isa ("uimenu")) - { - uimenu_childs(k) = uimenu_childs(ii); - pos(k++) = - dynamic_cast (kidgo.get_properties ()).get_position (); - } - } - - uimenu_childs.resize (k, 1); - pos.resize (k, 1); - Matrix retval = Matrix (k, 1); - // Don't know if this is the best method to sort. - // Can we avoid the for loop? - Array sidx = pos.sort_rows_idx (DESCENDING); - for (octave_idx_type ii = 0; ii < k; ii++) - retval(ii) = uimenu_childs (sidx(ii)); - - return retval; - } - - void delete_entry (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - int idx = find_index_by_name (fltk_label.c_str ()); - - if (idx >= 0) - menubar->remove (idx); - } - - void update_accelerator (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); - if (item != NULL) - { - std::string acc = uimenup.get_accelerator (); - if (acc.length () > 0) - { - int key = FL_CTRL + acc[0]; - item->shortcut (key); - } - } - } - } - - void update_callback (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); - if (item != NULL) - { - if (!uimenup.get_callback ().is_empty ()) - item->callback (static_cast (script_cb), - static_cast (&uimenup)); - else - item->callback (NULL, static_cast (0)); - } - } - } - - void update_enable (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); - if (item != NULL) - { - if (uimenup.is_enable ()) - item->activate (); - else - item->deactivate (); - } - } - } - - void update_foregroundcolor (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); - if (item != NULL) - { - Matrix rgb = uimenup.get_foregroundcolor_rgb (); - - uchar r = static_cast (gnulib::floor (rgb (0) * 255)); - uchar g = static_cast (gnulib::floor (rgb (1) * 255)); - uchar b = static_cast (gnulib::floor (rgb (2) * 255)); - - item->labelcolor (fl_rgb_color (r, g, b)); - } - } - } - - void update_seperator (const uimenu::properties& uimenup) - { - // Matlab places the separator before the current - // menu entry, while fltk places it after. So we need to find - // the previous item in this menu/submenu. (Kai) - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - int itemflags = 0, idx; - int curr_idx = find_index_by_name (fltk_label.c_str ()); - - for (idx = curr_idx - 1; idx >= 0; idx--) - { - Fl_Menu_Item* item = const_cast (&menubar->menu () [idx]); - itemflags = item->flags; - if (item->label () != NULL) - break; - } - - if (idx >= 0 && idx < menubar->size ()) - { - if (uimenup.is_separator ()) - { - if (idx >= 0 && !(itemflags & FL_SUBMENU)) - menubar->mode (idx, itemflags | FL_MENU_DIVIDER); - } - else - menubar->mode (idx, itemflags & (~FL_MENU_DIVIDER)); - } - } - } - - void update_visible (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - Fl_Menu_Item* item - = const_cast (menubar->find_item (fltk_label.c_str ())); - if (item != NULL) - { - if (uimenup.is_visible ()) - item->show (); - else - item->hide (); - } - } - } - - void add_entry (uimenu::properties& uimenup) - { - - std::string fltk_label = uimenup.get_fltk_label (); - - if (!fltk_label.empty ()) - { - bool item_added = false; - do - { - const Fl_Menu_Item* item - = menubar->find_item (fltk_label.c_str ()); - - if (item == NULL) - { - Matrix uimenu_ch = find_uimenu_children (uimenup); - int len = uimenu_ch.numel (); - int flags = 0; - if (len > 0) - flags = FL_SUBMENU; - if (len == 0 && uimenup.is_checked ()) - flags += FL_MENU_TOGGLE + FL_MENU_VALUE; - menubar->add (fltk_label.c_str (), 0, 0, 0, flags); - item_added = true; - } - else - { - //avoid duplicate menulabels - std::size_t idx1 = fltk_label.find_last_of ("("); - std::size_t idx2 = fltk_label.find_last_of (")"); - int len = idx2 - idx1; - int val = 1; - if (len > 0) - { - std::string valstr = fltk_label.substr (idx1 + 1, len - 1); - fltk_label.erase (idx1, len + 1); - val = atoi (valstr.c_str ()); - if (val > 0 && val < 99) - val++; - } - std::ostringstream valstream; - valstream << val; - fltk_label += "(" + valstream.str () + ")"; - } - } - while (!item_added); - uimenup.set_fltk_label (fltk_label); - } - } - - void add_to_menu (uimenu::properties& uimenup) - { - Matrix kids = find_uimenu_children (uimenup); - int len = kids.length (); - std::string fltk_label = uimenup.get_fltk_label (); - - add_entry (uimenup); - update_foregroundcolor (uimenup); - update_callback (uimenup); - update_accelerator (uimenup); - update_enable (uimenup); - update_visible (uimenup); - update_seperator (uimenup); - - for (octave_idx_type ii = 0; ii < len; ii++) - { - graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); - if (kgo.valid_object ()) - { - uimenu::properties& kprop = dynamic_cast (kgo.get_properties ()); - add_to_menu (kprop); - } - } - } - - void add_to_menu (figure::properties& figp) - { - Matrix kids = find_uimenu_children (figp); - int len = kids.length (); - menubar->clear (); - for (octave_idx_type ii = 0; ii < len; ii++) - { - graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); - - if (kgo.valid_object ()) - { - uimenu::properties& kprop = dynamic_cast (kgo.get_properties ()); - add_to_menu (kprop); - } - } - } - - template - void remove_from_menu (T_prop& prop) - { - Matrix kids; - std::string type = prop.get_type (); - kids = find_uimenu_children (prop); - int len = kids.length (); - - for (octave_idx_type ii = 0; ii < len; ii++) - { - graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); - - if (kgo.valid_object ()) - { - uimenu::properties kprop = dynamic_cast (kgo.get_properties ()); - remove_from_menu (kprop); - } - } - - if (type.compare ("uimenu") == 0) - delete_entry (dynamic_cast (prop)); - else if (type.compare ("figure") == 0) - menubar->clear (); - } - - ~fltk_uimenu (void) - { - delete menubar; - } - -private: - - // No copying! - - fltk_uimenu (const fltk_uimenu&); - - fltk_uimenu operator = (const fltk_uimenu&); - - Fl_Menu_Bar* menubar; -}; - -class plot_window : public Fl_Window -{ - friend class fltk_uimenu; -public: - plot_window (int xx, int yy, int ww, int hh, figure::properties& xfp) - : Fl_Window (xx, yy, ww, hh, "octave"), window_label (), shift (0), - ndim (2), fp (xfp), canvas (0), autoscale (0), togglegrid (0), - panzoom (0), rotate (0), help (0), status (0), - ax_obj (), pos_x (0), pos_y (0) - { - callback (window_close, static_cast (this)); - size_range (4*status_h, 2*status_h); - - // FIXME: The function below is only available in FLTK >= 1.3 - // At some point support for FLTK 1.1 will be dropped in Octave. - // At that point this function should be uncommented. - // The current solution is to call xclass() before show() for each window. - // Set WM_CLASS which allows window managers to properly group related - // windows. Otherwise, the class is just "FLTK" - //default_xclass ("Octave"); - - begin (); - { - - canvas = new OpenGL_fltk (0, 0, ww, hh - status_h, number ()); - - uimenu = new fltk_uimenu (0, 0, ww, menu_h); - uimenu->hide (); - - bottom = new Fl_Box (0, hh - status_h, ww, status_h); - bottom->box (FL_FLAT_BOX); - - ndim = calc_dimensions (gh_manager::get_object (fp.get___myhandle__ ())); - - autoscale = new Fl_Button (0, hh - status_h, status_h, status_h, "A"); - autoscale->callback (button_callback, static_cast (this)); - autoscale->tooltip ("Autoscale"); - - togglegrid = new Fl_Button (status_h, hh - status_h, status_h, - status_h, "G"); - togglegrid->callback (button_callback, static_cast (this)); - togglegrid->tooltip ("Toggle Grid"); - - panzoom = new Fl_Button (2 * status_h, hh - status_h, status_h, - status_h, "P"); - panzoom->callback (button_callback, static_cast (this)); - panzoom->tooltip ("Mouse Pan/Zoom"); - - rotate = new Fl_Button (3 * status_h, hh - status_h, status_h, - status_h, "R"); - rotate->callback (button_callback, static_cast (this)); - rotate->tooltip ("Mouse Rotate"); - - if (ndim == 2) - rotate->deactivate (); - - help = new Fl_Button (4 * status_h, hh - status_h, status_h, - status_h, "?"); - help->callback (button_callback, static_cast (this)); - help->tooltip ("Help"); - - status = new Fl_Output (5 * status_h, hh - status_h, - ww > 2*status_h ? ww - status_h : 0, - status_h, ""); - - status->textcolor (FL_BLACK); - status->color (FL_GRAY); - status->textfont (FL_COURIER); - status->textsize (10); - status->box (FL_ENGRAVED_BOX); - - // This allows us to have a valid OpenGL context right away. - canvas->mode (FL_DEPTH | FL_DOUBLE ); - if (fp.is_visible ()) - { - // FIXME: This code should be removed when Octave drops support - // for FLTK 1.1. Search for default_xclass in this file to find - // code that should be uncommented to take its place. - // - // Set WM_CLASS which allows window managers to properly group - // related windows. Otherwise, the class is just "FLTK" - xclass ("Octave"); - show (); - if (fp.get_currentaxes ().ok ()) - show_canvas (); - else - hide_canvas (); - } - } - end (); - - status->show (); - autoscale->show (); - togglegrid->show (); - panzoom->show (); - rotate->show (); - - set_name (); - resizable (canvas); - gui_mode = (ndim == 3 ? rotate_zoom : pan_zoom); - uimenu->add_to_menu (fp); - if (uimenu->items_to_show ()) - show_menubar (); - else - hide_menubar (); - } - - ~plot_window (void) - { - canvas->hide (); - status->hide (); - uimenu->hide (); - this->hide (); - } - - double number (void) { return fp.get___myhandle__ ().value (); } - - void renumber (double new_number) - { - if (canvas) - { - if (canvas->renumber (new_number)) - mark_modified (); - } - else - error ("unable to renumber figure"); - } - - void print (const std::string& cmd, const std::string& term) - { - canvas->print (cmd, term); - - // Print immediately so the output file will exist when the drawnow - // command is done. - mark_modified (); - Fl::wait (fltk_maxtime); - } - - void show_menubar (void) - { - if (!uimenu->is_visible ()) - { - canvas->resize (canvas->x (), - canvas->y () + menu_h, - canvas->w (), - canvas->h () - menu_h); - uimenu->show (); - mark_modified (); - } - } - - void hide_menubar (void) - { - if (uimenu->is_visible ()) - { - canvas->resize (canvas->x (), - canvas->y () - menu_h, - canvas->w (), - canvas->h () + menu_h); - uimenu->hide (); - mark_modified (); - } - } - - void uimenu_update (const graphics_handle& gh, int id) - { - graphics_object uimenu_obj = gh_manager::get_object (gh); - - if (uimenu_obj.valid_object () && uimenu_obj.isa ("uimenu")) - { - uimenu::properties& uimenup = - dynamic_cast (uimenu_obj.get_properties ()); - std::string fltk_label = uimenup.get_fltk_label (); - graphics_object fig = uimenu_obj.get_ancestor ("figure"); - figure::properties& figp = - dynamic_cast (fig.get_properties ()); - - switch (id) - { - case base_properties::ID_BEINGDELETED: - uimenu->remove_from_menu (uimenup); - break; - - case base_properties::ID_VISIBLE: - uimenu->update_visible (uimenup); - break; - - case uimenu::properties::ID_ACCELERATOR: - uimenu->update_accelerator (uimenup); - break; - - case uimenu::properties::ID_CALLBACK: - uimenu->update_callback (uimenup); - break; - - case uimenu::properties::ID_CHECKED: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - - case uimenu::properties::ID_ENABLE: - uimenu->update_enable (uimenup); - break; - - case uimenu::properties::ID_FOREGROUNDCOLOR: - uimenu->update_foregroundcolor (uimenup); - break; - - case uimenu::properties::ID_LABEL: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - - case uimenu::properties::ID_POSITION: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - - case uimenu::properties::ID_SEPARATOR: - uimenu->update_seperator (uimenup); - break; - } - - if (uimenu->items_to_show ()) - show_menubar (); - else - hide_menubar (); - - mark_modified (); - } - } - - void show_canvas (void) - { - if (fp.is_visible ()) - { - canvas->show (); - canvas->make_current (); - } - } - - void hide_canvas (void) - { - canvas->hide (); - } - - void mark_modified (void) - { - damage (FL_DAMAGE_ALL); - canvas->damage (FL_DAMAGE_ALL); - ndim = calc_dimensions (gh_manager::get_object (fp.get___myhandle__ ())); - - if (ndim == 3) - rotate->activate (); - else if (ndim == 2 && gui_mode == rotate_zoom) - { - rotate->deactivate (); - gui_mode = pan_zoom; - } - } - - void set_name (void) - { - window_label = fp.get_title (); - label (window_label.c_str ()); - } - -private: - - // No copying! - - plot_window (const plot_window&); - - plot_window& operator = (const plot_window&); - - // window name -- this must exists for the duration of the window's - // life - std::string window_label; - - // Mod keys status - int shift; - - // Number of dimensions, 2 or 3. - int ndim; - - // Figure properties. - figure::properties& fp; - - // Status area height. - static const int status_h = 20; - - // Menu height - static const int menu_h = 20; - - // Window callback. - static void window_close (Fl_Widget*, void* data) - { - octave_value_list args; - args(0) = static_cast (data)->number (); - feval ("close", args); - } - - // Button callbacks. - static void button_callback (Fl_Widget* ww, void* data) - { - static_cast (data)->button_press (ww, data); - } - - void button_press (Fl_Widget* widg, void*) - { - if (widg == autoscale) - axis_auto (); - - if (widg == togglegrid) - toggle_grid (); - - if (widg == panzoom) - gui_mode = pan_zoom; - - if (widg == rotate && ndim == 3) - gui_mode = rotate_zoom; - - if (widg == help) - fl_message ("%s", help_text); - } - - fltk_uimenu* uimenu; - OpenGL_fltk* canvas; - Fl_Box* bottom; - Fl_Button* autoscale; - Fl_Button* togglegrid; - Fl_Button* panzoom; - Fl_Button* rotate; - Fl_Button* help; - Fl_Output* status; - graphics_object ax_obj; - int pos_x; - int pos_y; - - void axis_auto (void) - { - octave_value_list args; - args(0) = fp.get_currentaxes ().as_octave_value (); - args(1) = "auto"; - feval ("axis", args); - mark_modified (); - } - - void toggle_grid (void) - { - octave_value_list args; - if (fp.get_currentaxes ().ok ()) - args(0) = fp.get_currentaxes ().as_octave_value (); - - feval ("grid", args); - mark_modified (); - } - - void pixel2pos (const graphics_handle& ax, int px, int py, double& xx, - double& yy) const - { - pixel2pos ( gh_manager::get_object (ax), px, py, xx, yy); - } - - void pixel2pos (graphics_object ax, int px, int py, double& xx, - double& yy) const - { - if (ax && ax.isa ("axes")) - { - axes::properties& ap = - dynamic_cast (ax.get_properties ()); - ColumnVector pp = ap.pixel2coord (px, py); - xx = pp(0); - yy = pp(1); - } - } - - graphics_handle pixel2axes_or_ca (int px, int py ) - { - Matrix kids = fp.get_children (); - int len = kids.length (); - - for (int k = 0; k < len; k++) - { - graphics_handle hnd = gh_manager::lookup (kids(k)); - - if (hnd.ok ()) - { - graphics_object kid = gh_manager::get_object (hnd); - - if (kid.valid_object () && kid.isa ("axes")) - { - Matrix bb = kid.get_properties ().get_boundingbox (true); - - if (bb(0) <= px && px < (bb(0)+bb(2)) - && bb(1) <= py && py < (bb(1)+bb(3))) - { - return hnd; - } - } - } - } - return fp.get_currentaxes (); - } - - void pixel2status (const graphics_handle& ax, int px0, int py0, - int px1 = -1, int py1 = -1) - { - pixel2status (gh_manager::get_object (ax), px0, py0, px1, py1); - } - - void pixel2status (graphics_object ax, int px0, int py0, - int px1 = -1, int py1 = -1) - { - double x0, y0, x1, y1; - std::stringstream cbuf; - cbuf.precision (4); - cbuf.width (6); - pixel2pos (ax, px0, py0, x0, y0); - cbuf << "[" << x0 << ", " << y0 << "]"; - if (px1 >= 0) - { - pixel2pos (ax, px1, py1, x1, y1); - cbuf << " -> ["<< x1 << ", " << y1 << "]"; - } - - status->value (cbuf.str ().c_str ()); - status->redraw (); - } - - void view2status (graphics_object ax) - { - if (ax && ax.isa ("axes")) - { - axes::properties& ap = - dynamic_cast (ax.get_properties ()); - std::stringstream cbuf; - cbuf.precision (4); - cbuf.width (6); - Matrix v (1,2,0); - v = ap.get ("view").matrix_value (); - cbuf << "[azimuth: " << v(0) << ", elevation: " << v(1) << "]"; - - status->value (cbuf.str ().c_str ()); - status->redraw (); - } - } - - void set_currentpoint (int px, int py) - { - if (!fp.is_beingdeleted ()) - { - Matrix pos (1,2,0); - pos(0) = px; - pos(1) = h () - status_h - menu_h - py; - fp.set_currentpoint (pos); - } - } - - void set_axes_currentpoint (graphics_object ax, int px, int py) - { - if (ax.valid_object ()) - { - axes::properties& ap = - dynamic_cast (ax.get_properties ()); - - double xx, yy; - pixel2pos (ax, px, py, xx, yy); - - Matrix pos (2,3,0); - pos(0,0) = xx; - pos(1,0) = yy; - pos(0,1) = xx; - pos(1,1) = yy; - - ap.set_currentpoint (pos); - } - } - - int key2shift (int key) - { - if (key == FL_Shift_L || key == FL_Shift_R) - return FL_SHIFT; - - if (key == FL_Control_L || key == FL_Control_R) - return FL_CTRL; - - if (key == FL_Alt_L || key == FL_Alt_R) - return FL_ALT; - - if (key == FL_Meta_L || key == FL_Meta_R) - return FL_META; - - return 0; - } - - int key2ascii (int key) - { - if (key < 256) return key; - if (key == FL_Tab) return '\t'; - if (key == FL_Enter) return 0x0a; - if (key == FL_BackSpace) return 0x08; - if (key == FL_Escape) return 0x1b; - - return 0; - } - - Cell modifier2cell () - { - string_vector mod; - - if (shift & FL_SHIFT) - mod.append (std::string ("shift")); - if (shift & FL_CTRL) - mod.append (std::string ("control")); - if (shift & FL_ALT || shift & FL_META) - mod.append (std::string ("alt")); - - return Cell (mod); - } - - void resize (int xx,int yy,int ww,int hh) - { - Fl_Window::resize (xx, yy, ww, hh); - - Matrix pos (1,4,0); - pos(0) = xx; - pos(1) = yy; - pos(2) = ww; - pos(3) = hh - status_h - menu_h; - - fp.set_boundingbox (pos, true); - } - - void draw (void) - { - Matrix pos = fp.get_boundingbox (true); - Fl_Window::resize (pos(0), pos(1), pos(2), pos(3) + status_h + menu_h); - - return Fl_Window::draw (); - } - - int handle (int event) - { - graphics_handle gh; - - graphics_object fig = gh_manager::get_object (fp.get___myhandle__ ()); - int retval = Fl_Window::handle (event); - - // We only handle events which are in the canvas area. - if (!Fl::event_inside (canvas)) - return retval; - - if (!fp.is_beingdeleted ()) - { - switch (event) - { - case FL_KEYDOWN: - { - int key = Fl::event_key (); - - shift |= key2shift (key); - int key_a = key2ascii (key); - if (key_a && fp.get_keypressfcn ().is_defined ()) - { - Octave_map evt; - evt.assign ("Character", octave_value (key_a)); - evt.assign ("Key", octave_value (std::tolower (key_a))); - evt.assign ("Modifier", octave_value (modifier2cell ())); - fp.execute_keypressfcn (evt); - } - switch (key) - { - case 'a': - case 'A': - axis_auto (); - break; - - case 'g': - case 'G': - toggle_grid (); - break; - - case 'p': - case 'P': - gui_mode = pan_zoom; - break; - - case 'r': - case 'R': - gui_mode = rotate_zoom; - break; - } - } - break; - - case FL_KEYUP: - { - int key = Fl::event_key (); - - shift &= (~key2shift (key)); - int key_a = key2ascii (key); - if (key_a && fp.get_keyreleasefcn ().is_defined ()) - { - Octave_map evt; - evt.assign ("Character", octave_value (key_a)); - evt.assign ("Key", octave_value (std::tolower (key_a))); - evt.assign ("Modifier", octave_value (modifier2cell ())); - fp.execute_keyreleasefcn (evt); - } - } - break; - - case FL_MOVE: - pixel2status (pixel2axes_or_ca (Fl::event_x (), Fl::event_y ()), - Fl::event_x (), Fl::event_y ()); - break; - - case FL_PUSH: - pos_x = Fl::event_x (); - pos_y = Fl::event_y (); - - set_currentpoint (Fl::event_x (), Fl::event_y ()); - - gh = pixel2axes_or_ca (pos_x, pos_y); - - if (gh.ok ()) - { - ax_obj = gh_manager::get_object (gh); - set_axes_currentpoint (ax_obj, pos_x, pos_y); - } - - fp.execute_windowbuttondownfcn (); - - if (Fl::event_button () == 1 || Fl::event_button () == 3) - return 1; - - break; - - case FL_DRAG: - if (fp.get_windowbuttonmotionfcn ().is_defined ()) - { - set_currentpoint (Fl::event_x (), Fl::event_y ()); - fp.execute_windowbuttonmotionfcn (); - } - - if (Fl::event_button () == 1) - { - if (ax_obj && ax_obj.isa ("axes")) - { - if (gui_mode == pan_zoom) - pixel2status (ax_obj, pos_x, pos_y, - Fl::event_x (), Fl::event_y ()); - else - view2status (ax_obj); - axes::properties& ap = - dynamic_cast (ax_obj.get_properties ()); - - double x0, y0, x1, y1; - Matrix pos = fp.get_boundingbox (true); - pixel2pos (ax_obj, pos_x, pos_y, x0, y0); - pixel2pos (ax_obj, Fl::event_x (), Fl::event_y (), x1, y1); - - if (gui_mode == pan_zoom) - ap.translate_view (x0, x1, y0, y1); - else if (gui_mode == rotate_zoom) - { - double daz, del; - daz = (Fl::event_x () - pos_x) / pos(2) * 360; - del = (Fl::event_y () - pos_y) / pos(3) * 360; - ap.rotate_view (del, daz); - } - - pos_x = Fl::event_x (); - pos_y = Fl::event_y (); - mark_modified (); - } - return 1; - } - else if (Fl::event_button () == 3) - { - pixel2status (ax_obj, pos_x, pos_y, - Fl::event_x (), Fl::event_y ()); - Matrix zoom_box (1,4,0); - zoom_box (0) = pos_x; - zoom_box (1) = pos_y; - zoom_box (2) = Fl::event_x (); - zoom_box (3) = Fl::event_y (); - canvas->set_zoom_box (zoom_box); - canvas->zoom (true); - canvas->redraw (); - } - - break; - - case FL_MOUSEWHEEL: - { - graphics_object ax = - gh_manager::get_object (pixel2axes_or_ca (Fl::event_x (), - Fl::event_y ())); - if (ax && ax.isa ("axes")) - { - axes::properties& ap = - dynamic_cast (ax.get_properties ()); - - // Determine if we're zooming in or out. - const double factor = - (Fl::event_dy () > 0) ? 1.0 + wheel_zoom_speed : 1.0 - wheel_zoom_speed; - - // Get the point we're zooming about. - double x1, y1; - pixel2pos (ax, Fl::event_x (), Fl::event_y (), x1, y1); - - ap.zoom_about_point (x1, y1, factor, false); - mark_modified (); - } - } - return 1; - - case FL_RELEASE: - if (fp.get_windowbuttonupfcn ().is_defined ()) - { - set_currentpoint (Fl::event_x (), Fl::event_y ()); - fp.execute_windowbuttonupfcn (); - } - - if (Fl::event_button () == 1) - { - if ( Fl::event_clicks () == 1) - { - if (ax_obj && ax_obj.isa ("axes")) - { - axes::properties& ap = - dynamic_cast (ax_obj.get_properties ()); - ap.set_xlimmode ("auto"); - ap.set_ylimmode ("auto"); - ap.set_zlimmode ("auto"); - mark_modified (); - } - } - } - if (Fl::event_button () == 3) - { - // End of drag -- zoom. - if (canvas->zoom ()) - { - canvas->zoom (false); - double x0,y0,x1,y1; - if (ax_obj && ax_obj.isa ("axes")) - { - axes::properties& ap = - dynamic_cast (ax_obj.get_properties ()); - pixel2pos (ax_obj, pos_x, pos_y, x0, y0); - int pos_x1 = Fl::event_x (); - int pos_y1 = Fl::event_y (); - pixel2pos (ax_obj, pos_x1, pos_y1, x1, y1); - Matrix xl (1,2,0); - Matrix yl (1,2,0); - int dx = abs (pos_x - pos_x1); - int dy = abs (pos_y - pos_y1); - // Smallest zoom box must be 4 pixels square - if ((dx > 4) && (dy > 4)) - { - if (x0 < x1) - { - xl(0) = x0; - xl(1) = x1; - } - else - { - xl(0) = x1; - xl(1) = x0; - } - if (y0 < y1) - { - yl(0) = y0; - yl(1) = y1; - } - else - { - yl(0) = y1; - yl(1) = y0; - } - ap.zoom (xl, yl); - } - mark_modified (); - } - } - } - break; - } - } - - return retval; - } -}; - -class figure_manager -{ -public: - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - instance = new figure_manager (); - - if (! instance) - { - ::error ("unable to create figure_manager object!"); - - retval = false; - } - - return retval; - } - - ~figure_manager (void) - { - close_all (); - } - - static void close_all (void) - { - if (instance_ok ()) - instance->do_close_all (); - } - - static void new_window (figure::properties& fp) - { - if (instance_ok ()) - instance->do_new_window (fp); - } - - static void delete_window (int idx) - { - if (instance_ok ()) - instance->do_delete_window (idx); - } - - static void delete_window (const std::string& idx_str) - { - delete_window (str2idx (idx_str)); - } - - static void renumber_figure (const std::string& idx_str, double new_number) - { - if (instance_ok ()) - instance->do_renumber_figure (str2idx (idx_str), new_number); - } - - static void toggle_window_visibility (int idx, bool is_visible) - { - if (instance_ok ()) - instance->do_toggle_window_visibility (idx, is_visible); - } - - static void toggle_window_visibility (const std::string& idx_str, - bool is_visible) - { - toggle_window_visibility (str2idx (idx_str), is_visible); - } - - static void mark_modified (int idx) - { - if (instance_ok ()) - instance->do_mark_modified (idx); - } - - static void mark_modified (const graphics_handle& gh) - { - mark_modified (hnd2idx (gh)); - } - - static void set_name (int idx) - { - if (instance_ok ()) - instance->do_set_name (idx); - } - - static void set_name (const std::string& idx_str) - { - set_name (str2idx (idx_str)); - } - - static Matrix get_size (int idx) - { - return instance_ok () ? instance->do_get_size (idx) : Matrix (); - } - - static Matrix get_size (const graphics_handle& gh) - { - return get_size (hnd2idx (gh)); - } - - static void print (const graphics_handle& gh, const std::string& cmd, - const std::string& term) - { - if (instance_ok ()) - instance->do_print (hnd2idx (gh), cmd, term); - } - - static void uimenu_update (const graphics_handle& figh, - const graphics_handle& uimenuh, int id) - { - if (instance_ok ()) - instance->do_uimenu_update (hnd2idx (figh), uimenuh, id); - } - - static void update_canvas (const graphics_handle& gh, - const graphics_handle& ca) - { - if (instance_ok ()) - instance->do_update_canvas (hnd2idx (gh), ca); - } - - static void toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) - { - if (instance_ok ()) - instance->do_toggle_menubar_visibility (fig_idx, menubar_is_figure); - } - - static void toggle_menubar_visibility (const std::string& fig_idx_str, - bool menubar_is_figure) - { - toggle_menubar_visibility (str2idx (fig_idx_str), menubar_is_figure); - } - -private: - - static figure_manager *instance; - - figure_manager (void) { } - - // No copying! - figure_manager (const figure_manager&); - figure_manager& operator = (const figure_manager&); - - // Singelton -- hide all of the above. - - static int curr_index; - typedef std::map window_map; - typedef window_map::iterator wm_iterator;; - window_map windows; - - static std::string fltk_idx_header; - - void do_close_all (void) - { - wm_iterator win; - for (win = windows.begin (); win != windows.end (); win++) - delete win->second; - windows.clear (); - } - - void do_new_window (figure::properties& fp) - { - int idx = figprops2idx (fp); - - if (idx >= 0 && windows.find (idx) == windows.end ()) - { - Matrix pos = fp.get_boundingbox (true); - - int x = pos(0); - int y = pos(1); - int w = pos(2); - int h = pos(3); - - idx2figprops (curr_index, fp); - - windows[curr_index++] = new plot_window (x, y, w, h, fp); - } - } - - void do_delete_window (int idx) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - { - delete win->second; - windows.erase (win); - } - } - - void do_renumber_figure (int idx, double new_number) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - win->second->renumber (new_number); - } - - void do_toggle_window_visibility (int idx, bool is_visible) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - { - if (is_visible) - win->second->show (); - else - win->second->hide (); - - win->second->redraw (); - } - } - - void do_toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) - { - wm_iterator win = windows.find (fig_idx); - - if (win != windows.end ()) - { - if (menubar_is_figure) - win->second->show_menubar (); - else - win->second->hide_menubar (); - - win->second->redraw (); - } - } - - void do_mark_modified (int idx) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - win->second->mark_modified (); - } - - void do_set_name (int idx) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - win->second->set_name (); - } - - Matrix do_get_size (int idx) - { - Matrix sz (1, 2, 0.0); - - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - { - sz(0) = win->second->w (); - sz(1) = win->second->h (); - } - - return sz; - } - - void do_print (int idx, const std::string& cmd, const std::string& term) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - win->second->print (cmd, term); - } - - void do_uimenu_update (int idx, const graphics_handle& gh, int id) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - win->second->uimenu_update (gh, id); - } - - void do_update_canvas (int idx, const graphics_handle& ca) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - { - if (ca.ok ()) - win->second->show_canvas (); - else - win->second->hide_canvas (); - } - } - - static int str2idx (const caseless_str& clstr) - { - int ind; - if (clstr.find (fltk_idx_header,0) == 0) - { - std::istringstream istr (clstr.substr (fltk_idx_header.size ())); - if (istr >> ind) - return ind; - } - error ("figure_manager: could not recognize fltk index"); - return -1; - } - - void idx2figprops (int idx, figure::properties& fp) - { - std::ostringstream ind_str; - ind_str << fltk_idx_header << idx; - fp.set___plot_stream__ (ind_str.str ()); - } - - static int figprops2idx (const figure::properties& fp) - { - if (fp.get___graphics_toolkit__ () == FLTK_GRAPHICS_TOOLKIT_NAME) - { - octave_value ps = fp.get___plot_stream__ (); - if (ps.is_string ()) - return str2idx (ps.string_value ()); - else - return 0; - } - error ("figure_manager: figure is not fltk"); - return -1; - } - - static int hnd2idx (double h) - { - graphics_object fobj = gh_manager::get_object (h); - if (fobj && fobj.isa ("figure")) - { - figure::properties& fp = - dynamic_cast (fobj.get_properties ()); - return figprops2idx (fp); - } - error ("figure_manager: H (= %g) is not a figure", h); - return -1; - } - - static int hnd2idx (const graphics_handle& fh) - { - return hnd2idx (fh.value ()); - } -}; - -figure_manager *figure_manager::instance = 0; - -std::string figure_manager::fltk_idx_header="fltk index="; -int figure_manager::curr_index = 1; - -static bool toolkit_loaded = false; - -static int -__fltk_redraw__ (void) -{ - if (toolkit_loaded) - { - // We scan all figures and add those which use FLTK. - graphics_object obj = gh_manager::get_object (0); - if (obj && obj.isa ("root")) - { - base_properties& props = obj.get_properties (); - Matrix children = props.get_all_children (); - - for (octave_idx_type n = 0; n < children.numel (); n++) - { - graphics_object fobj = gh_manager::get_object (children (n)); - if (fobj && fobj.isa ("figure")) - { - figure::properties& fp = - dynamic_cast (fobj.get_properties ()); - if (fp.get___graphics_toolkit__ () - == FLTK_GRAPHICS_TOOLKIT_NAME) - figure_manager::new_window (fp); - } - } - } - - // it seems that we have to call Fl::check twice to get everything drawn - Fl::check (); - Fl::check (); - } - - return 0; -} - -class fltk_graphics_toolkit : public base_graphics_toolkit -{ -public: - fltk_graphics_toolkit (void) - : base_graphics_toolkit (FLTK_GRAPHICS_TOOLKIT_NAME) { } - - ~fltk_graphics_toolkit (void) { } - - bool is_valid (void) const { return true; } - - bool initialize (const graphics_object& go) - { return go.isa ("figure"); } - - void finalize (const graphics_object& go) - { - if (go.isa ("figure")) - { - octave_value ov = go.get (caseless_str ("__plot_stream__")); - - if (! ov.is_empty ()) - figure_manager::delete_window (ov.string_value ()); - } - } - - void uimenu_set_fltk_label (graphics_object uimenu_obj) - { - if (uimenu_obj.valid_object ()) - { - uimenu::properties& uimenup = - dynamic_cast (uimenu_obj.get_properties ()); - std::string fltk_label = uimenup.get_label (); - graphics_object go = gh_manager::get_object (uimenu_obj.get_parent ()); - if (go.isa ("uimenu")) - fltk_label = dynamic_cast (go.get_properties ()).get_fltk_label () - + "/" - + fltk_label; - else if (go.isa ("figure")) - ; - else - error ("unexpected parent object\n"); - - uimenup.set_fltk_label (fltk_label); - } - } - - void update (const graphics_object& go, int id) - { - if (go.isa ("figure")) - { - octave_value ov = go.get (caseless_str ("__plot_stream__")); - - if (! ov.is_empty ()) - { - const figure::properties& fp = - dynamic_cast (go.get_properties ()); - - switch (id) - { - case base_properties::ID_VISIBLE: - figure_manager::toggle_window_visibility - (ov.string_value (), fp.is_visible ()); - break; - - case figure::properties::ID_MENUBAR: - figure_manager::toggle_menubar_visibility - (ov.string_value (), fp.menubar_is ("figure")); - break; - - case figure::properties::ID_CURRENTAXES: - figure_manager::update_canvas - (go.get_handle (), fp.get_currentaxes ()); - break; - - case figure::properties::ID_NAME: - case figure::properties::ID_NUMBERTITLE: - figure_manager::set_name (ov.string_value ()); - break; - - case figure::properties::ID_INTEGERHANDLE: - { - std::string tmp = ov.string_value (); - graphics_handle gh = fp.get___myhandle__ (); - figure_manager::renumber_figure (tmp, gh.value ()); - figure_manager::set_name (tmp); - } - break; - } - } - } - else if (go.isa ("uimenu")) - { - if (id == uimenu::properties::ID_LABEL) - uimenu_set_fltk_label (go); - - graphics_object fig = go.get_ancestor ("figure"); - figure_manager::uimenu_update (fig.get_handle (), go.get_handle (), id); - } - } - - void redraw_figure (const graphics_object& go) const - { - figure_manager::mark_modified (go.get_handle ()); - - __fltk_redraw__ (); - } - - void print_figure (const graphics_object& go, - const std::string& term, - const std::string& file_cmd, bool /*mono*/, - const std::string& /*debug_file*/) const - { - figure_manager::print (go.get_handle (), file_cmd, term); - redraw_figure (go); - } - - Matrix get_canvas_size (const graphics_handle& fh) const - { - return figure_manager::get_size (fh); - } - - double get_screen_resolution (void) const - { - // FLTK doesn't give this info. - return 72.0; - } - - Matrix get_screen_size (void) const - { - Matrix sz (1, 2, 0.0); - sz(0) = Fl::w (); - sz(1) = Fl::h (); - return sz; - } - - void close (void) - { - if (toolkit_loaded) - { - munlock ("__init_fltk__"); - - figure_manager::close_all (); - gtk_manager::unload_toolkit (FLTK_GRAPHICS_TOOLKIT_NAME); - toolkit_loaded = false; - - octave_value_list args; - args(0) = "__fltk_redraw__"; - feval ("remove_input_event_hook", args, 0); - - // FIXME ??? - Fl::wait (fltk_maxtime); - } - } -}; - -// Initialize the fltk graphics toolkit. - -DEFUN_DLD (__init_fltk__, , , "") -{ - if (! toolkit_loaded) - { - mlock (); - - graphics_toolkit tk (new fltk_graphics_toolkit ()); - gtk_manager::load_toolkit (tk); - toolkit_loaded = true; - - octave_value_list args; - args(0) = "__fltk_redraw__"; - feval ("add_input_event_hook", args, 0); - } - - octave_value retval; - return retval; -} - -DEFUN_DLD (__fltk_redraw__, , , "") -{ - __fltk_redraw__ (); - - return octave_value (); -} - -DEFUN_DLD (__fltk_maxtime__, args, ,"") -{ - octave_value retval = fltk_maxtime; - - if (args.length () == 1) - { - if (args(0).is_real_scalar ()) - fltk_maxtime = args(0).double_value (); - else - error ("argument must be a real scalar"); - } - - return retval; -} - -#endif - -// FIXME -- This function should be abstracted and made potentially -// available to all graphics toolkits. This suggests putting it in -// graphics.cc as is done for drawnow() and having the master -// mouse_wheel_zoom function call fltk_mouse_wheel_zoom. The same -// should be done for gui_mode and fltk_gui_mode. For now (2011.01.30), -// just changing function names and docstrings. - -DEFUN_DLD (mouse_wheel_zoom, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{speed} =} mouse_wheel_zoom ()\n\ -@deftypefnx {Built-in Function} {} mouse_wheel_zoom (@var{speed})\n\ -Query or set the mouse wheel zoom factor.\n\ -\n\ -This function is currently implemented only for the FLTK graphics toolkit.\n\ -@seealso{gui_mode}\n\ -@end deftypefn") -{ -#if defined (HAVE_FLTK) - octave_value retval = wheel_zoom_speed; - - if (args.length () == 1) - { - if (args(0).is_real_scalar ()) - wheel_zoom_speed = args(0).double_value (); - else - error ("mouse_wheel_zoom: SPEED must be a real scalar"); - } - - return retval; -#else - error ("mouse_wheel_zoom: not available without OpenGL and FLTK libraries"); - return octave_value (); -#endif -} - -DEFUN_DLD (gui_mode, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{mode} =} gui_mode ()\n\ -@deftypefnx {Built-in Function} {} gui_mode (@var{mode})\n\ -Query or set the GUI mode for the current graphics toolkit.\n\ -The @var{mode} argument can be one of the following strings:\n\ -\n\ -@table @asis\n\ -@item '2d'\n\ -Allows panning and zooming of current axes.\n\ -\n\ -@item '3d'\n\ -Allows rotating and zooming of current axes.\n\ -\n\ -@item 'none'\n\ -Mouse inputs have no effect.\n\ -@end table\n\ -\n\ -This function is currently implemented only for the FLTK graphics toolkit.\n\ -@seealso{mouse_wheel_zoom}\n\ -@end deftypefn") -{ -#if defined (HAVE_FLTK) - caseless_str mode_str; - - if (gui_mode == pan_zoom) - mode_str = "2d"; - else if (gui_mode == rotate_zoom) - mode_str = "3d"; - else - mode_str = "none"; - - bool failed = false; - - if (args.length () == 1) - { - if (args(0).is_string ()) - { - mode_str = args(0).string_value (); - - if (mode_str.compare ("2d")) - gui_mode = pan_zoom; - else if (mode_str.compare ("3d")) - gui_mode = rotate_zoom; - else if (mode_str.compare ("none")) - gui_mode = none; - else - failed = true; - } - else - failed = true; - } - - if (failed) - error ("MODE must be one of the strings: \"2D\", \"3D\", or \"none\""); - - return octave_value (mode_str); -#else - error ("mouse_wheel_zoom: not available without OpenGL and FLTK libraries"); - return octave_value (); -#endif -} - diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/__init_gnuplot__.cc --- a/src/DLD-FUNCTIONS/__init_gnuplot__.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,193 +0,0 @@ -/* - -Copyright (C) 2007-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - -To initialize: - - graphics_toolkit ("gnuplot"); - plot (randn (1e3, 1)); - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "defun-dld.h" -#include "error.h" -#include "graphics.h" -#include "parse.h" -#include "variables.h" - -// PKG_ADD: register_graphics_toolkit ("gnuplot"); - -static bool toolkit_loaded = false; - -class gnuplot_graphics_toolkit : public base_graphics_toolkit -{ -public: - gnuplot_graphics_toolkit (void) - : base_graphics_toolkit ("gnuplot") { } - - ~gnuplot_graphics_toolkit (void) { } - - bool is_valid (void) const { return true; } - - bool initialize (const graphics_object& go) - { - return go.isa ("figure"); - } - - void finalize (const graphics_object& go) - { - if (go.isa ("figure")) - { - const figure::properties& props = - dynamic_cast (go.get_properties ()); - - send_quit (props.get___plot_stream__ ()); - } - } - - void update (const graphics_object& go, int id) - { - if (go.isa ("figure")) - { - graphics_object obj (go); - - figure::properties& props = - dynamic_cast (obj.get_properties ()); - - switch (id) - { - case base_properties::ID_VISIBLE: - if (! props.is_visible ()) - { - send_quit (props.get___plot_stream__ ()); - props.set___plot_stream__ (Matrix ()); - props.set___enhanced__ (false); - } - break; - } - } - } - - void redraw_figure (const graphics_object& go) const - { - octave_value_list args; - args(0) = go.get_handle ().as_octave_value (); - feval ("__gnuplot_drawnow__", args); - } - - void print_figure (const graphics_object& go, const std::string& term, - const std::string& file, bool mono, - const std::string& debug_file) const - { - octave_value_list args; - if (! debug_file.empty ()) - args(4) = debug_file; - args(3) = mono; - args(2) = file; - args(1) = term; - args(0) = go.get_handle ().as_octave_value (); - feval ("__gnuplot_drawnow__", args); - } - - Matrix get_canvas_size (const graphics_handle&) const - { - Matrix sz (1, 2, 0.0); - return sz; - } - - double get_screen_resolution (void) const - { return 72.0; } - - Matrix get_screen_size (void) const - { return Matrix (1, 2, 0.0); } - - void close (void) - { - if (toolkit_loaded) - { - munlock ("__init_gnuplot__"); - - gtk_manager::unload_toolkit ("gnuplot"); - - toolkit_loaded = false; - } - } - -private: - - void send_quit (const octave_value& pstream) const - { - if (! pstream.is_empty ()) - { - octave_value_list args; - Matrix fids = pstream.matrix_value (); - - if (! error_state) - { - args(1) = "\nquit;\n"; - args(0) = fids(0); - feval ("fputs", args); - - args.resize (1); - feval ("fflush", args); - feval ("pclose", args); - - if (fids.numel () > 1) - { - args(0) = fids(1); - feval ("pclose", args); - - if (fids.numel () > 2) - { - args(0) = fids(2); - feval ("waitpid", args); - } - } - } - } - } -}; - -// Initialize the fltk graphics toolkit. - -DEFUN_DLD (__init_gnuplot__, , , "") -{ - octave_value retval; - - if (! toolkit_loaded) - { - mlock (); - - graphics_toolkit tk (new gnuplot_graphics_toolkit ()); - gtk_manager::load_toolkit (tk); - - toolkit_loaded = true; - } - - return retval; -} - diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/__magick_read__.cc --- a/src/DLD-FUNCTIONS/__magick_read__.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1216 +0,0 @@ -/* - -Copyright (C) 2002-2012 Andy Adler -Copyright (C) 2008 Thomas L. Scofield -Copyright (C) 2010 David Grundberg - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "file-stat.h" -#include "oct-env.h" -#include "oct-time.h" - -#include "defun-dld.h" -#include "error.h" -#include "ov-struct.h" - -#ifdef HAVE_MAGICK - -#include -#include - -octave_value_list -read_indexed_images (std::vector& imvec, - const Array& frameidx, bool wantalpha) -{ - octave_value_list output; - - int rows = imvec[0].baseRows (); - int columns = imvec[0].baseColumns (); - int nframes = frameidx.length (); - - dim_vector idim = dim_vector (); - idim.resize (4); - idim(0) = rows; - idim(1) = columns; - idim(2) = 1; - idim(3) = nframes; - - Array idx (dim_vector (4, 1)); - - Magick::ImageType type = imvec[0].type (); - - unsigned int mapsize = imvec[0].colorMapSize (); - unsigned int i = mapsize; - unsigned int depth = 0; - while (i >>= 1) - depth++; - i = 0; - depth--; - while (depth >>= 1) - i++; - depth = 1 << i; - - switch (depth) - { - case 1: - case 2: - case 4: - case 8: - { - uint8NDArray im = uint8NDArray (idim); - - idx(2) = 0; - for (int frame = 0; frame < nframes; frame++) - { - imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - const Magick::IndexPacket *pix - = imvec[frameidx(frame)].getConstIndexes (); - - i = 0; - idx(3) = frame; - - for (int y = 0; y < rows; y++) - { - idx(0) = y; - for (int x = 0; x < columns; x++) - { - idx(1) = x; - im(idx) = static_cast (pix[i++]); - } - } - } - - output(0) = octave_value (im); - } - break; - - case 16: - { - uint16NDArray im = uint16NDArray (idim); - - idx(2) = 0; - for (int frame = 0; frame < nframes; frame++) - { - imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - const Magick::IndexPacket *pix - = imvec[frameidx(frame)].getConstIndexes (); - - i = 0; - idx(3) = frame; - - for (int y = 0; y < rows; y++) - { - idx(0) = y; - for (int x = 0; x < columns; x++) - { - idx(1) = x; - im(idx) = static_cast (pix[i++]); - } - } - } - - output(0) = octave_value (im); - } - break; - - default: - error ("__magic_read__: index depths greater than 16-bit are not supported"); - return octave_value_list (); - } - - Matrix map = Matrix (mapsize, 3); - Matrix alpha; - - switch (type) - { - case Magick::PaletteMatteType: -#if 0 - warning ("palettematte"); - Matrix map (mapsize, 3); - Matrix alpha (mapsize, 1); - for (i = 0; i < mapsize; i++) - { - warning ("%d", i); - Magick::ColorRGB c = imvec[0].colorMap (i); - map(i,0) = c.red (); - map(i,1) = c.green (); - map(i,2) = c.blue (); - alpha(i,1) = c.alpha (); - } - break; -#endif - - case Magick::PaletteType: - alpha = Matrix (0, 0); - for (i = 0; i < mapsize; i++) - { - Magick::ColorRGB c = imvec[0].colorMap (i); - map(i,0) = c.red (); - map(i,1) = c.green (); - map(i,2) = c.blue (); - } - break; - - default: - error ("__magick_read__: unsupported indexed image type"); - return octave_value_list (); - } - - if (wantalpha) - output(2) = alpha; - - output(1) = map; - - return output; -} - -template -octave_value_list -read_images (const std::vector& imvec, - const Array& frameidx, unsigned int depth) -{ - typedef typename T::element_type P; - - octave_value_list retval (3, Matrix ()); - - T im; - - int rows = imvec[0].baseRows (); - int columns = imvec[0].baseColumns (); - int nframes = frameidx.length (); - - dim_vector idim = dim_vector (); - idim.resize (4); - idim(0) = rows; - idim(1) = columns; - idim(2) = 1; - idim(3) = nframes; - - Magick::ImageType type = imvec[0].type (); - const int divisor = ((uint64_t (1) << QuantumDepth) - 1) / - ((uint64_t (1) << depth) - 1); - - switch (type) - { - case Magick::BilevelType: - case Magick::GrayscaleType: - { - im = T (idim); - P *vec = im.fortran_vec (); - - for (int frame = 0; frame < nframes; frame++) - { - const Magick::PixelPacket *pix - = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - P *rbuf = vec; - for (int y = 0; y < rows; y++) - { - for (int x = 0; x < columns; x++) - { - *rbuf = pix->red / divisor; - pix++; - rbuf += rows; - } - rbuf -= rows * columns - 1; - } - - // Next frame. - vec += rows * columns * idim(2); - } - } - break; - - case Magick::GrayscaleMatteType: - { - idim(2) = 2; - im = T (idim); - P *vec = im.fortran_vec (); - - for (int frame = 0; frame < nframes; frame++) - { - const Magick::PixelPacket *pix - = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - P *rbuf = vec; - P *obuf = vec + rows * columns; - for (int y = 0; y < rows; y++) - { - for (int x = 0; x < columns; x++) - { - *rbuf = pix->red / divisor; - *obuf = pix->opacity / divisor; - pix++; - rbuf += rows; - obuf += rows; - } - rbuf -= rows * columns - 1; - obuf -= rows * columns - 1; - } - - // Next frame. - vec += rows * columns * idim(2); - } - } - break; - - case Magick::PaletteType: - case Magick::TrueColorType: - { - idim(2) = 3; - im = T (idim); - P *vec = im.fortran_vec (); - - for (int frame = 0; frame < nframes; frame++) - { - const Magick::PixelPacket *pix - = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - P *rbuf = vec; - P *gbuf = vec + rows * columns; - P *bbuf = vec + rows * columns * 2; - for (int y = 0; y < rows; y++) - { - for (int x = 0; x < columns; x++) - { - *rbuf = pix->red / divisor; - *gbuf = pix->green / divisor; - *bbuf = pix->blue / divisor; - pix++; - rbuf += rows; - gbuf += rows; - bbuf += rows; - } - rbuf -= rows * columns - 1; - gbuf -= rows * columns - 1; - bbuf -= rows * columns - 1; - } - - // Next frame. - vec += rows * columns * idim(2); - } - } - break; - - case Magick::PaletteMatteType: - case Magick::TrueColorMatteType: - case Magick::ColorSeparationType: - { - idim(2) = 4; - im = T (idim); - P *vec = im.fortran_vec (); - - for (int frame = 0; frame < nframes; frame++) - { - const Magick::PixelPacket *pix - = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - P *rbuf = vec; - P *gbuf = vec + rows * columns; - P *bbuf = vec + rows * columns * 2; - P *obuf = vec + rows * columns * 3; - for (int y = 0; y < rows; y++) - { - for (int x = 0; x < columns; x++) - { - *rbuf = pix->red / divisor; - *gbuf = pix->green / divisor; - *bbuf = pix->blue / divisor; - *obuf = pix->opacity / divisor; - pix++; - rbuf += rows; - gbuf += rows; - bbuf += rows; - obuf += rows; - } - rbuf -= rows * columns - 1; - gbuf -= rows * columns - 1; - bbuf -= rows * columns - 1; - obuf -= rows * columns - 1; - } - - // Next frame. - vec += rows * columns * idim(2); - } - } - break; - - default: - error ("__magick_read__: undefined ImageMagick image type"); - return retval; - } - - retval(0) = im; - - return retval; -} - -#endif - -static void -maybe_initialize_magick (void) -{ -#ifdef HAVE_MAGICK - - static bool initialized = false; - - if (! initialized) - { - // Save the locale as GraphicsMagick might change this (depending on version) - const char *static_locale = setlocale (LC_ALL, NULL); - const std::string locale (static_locale); - - std::string program_name = octave_env::get_program_invocation_name (); - - Magick::InitializeMagick (program_name.c_str ()); - - // Restore locale from before GraphicsMagick initialisation - setlocale (LC_ALL, locale.c_str ()); - - if (QuantumDepth < 32) - warning ("your version of %s limits images to %d bits per pixel", - MagickPackageName, QuantumDepth); - - initialized = true; - } -#endif -} - -DEFUN_DLD (__magick_read__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Function File} {@var{m} =} __magick_read__ (@var{fname}, @var{index})\n\ -@deftypefnx {Function File} {[@var{m}, @var{colormap}] =} __magick_read__ (@var{fname}, @var{index})\n\ -@deftypefnx {Function File} {[@var{m}, @var{colormap}, @var{alpha}] =} __magick_read__ (@var{fname}, @var{index})\n\ -Read images with ImageMagick++. In general you should not be using this\n\ -function. Instead use @code{imread}.\n\ -@seealso{imread}\n\ -@end deftypefn") -{ - octave_value_list output; - -#ifdef HAVE_MAGICK - - maybe_initialize_magick (); - - if (args.length () > 3 || args.length () < 1 || ! args(0).is_string () - || nargout > 3) - { - print_usage (); - return output; - } - - Array frameidx; - bool all_frames = false; - - if (args.length () == 2 && args(1).is_real_type ()) - frameidx = args(1).int_vector_value (); - else if (args.length () == 3 && args(1).is_string () - && args(1).string_value () == "frames") - { - if (args(2).is_string () && args(2).string_value () == "all") - all_frames = true; - else if (args(2).is_real_type ()) - frameidx = args(2).int_vector_value (); - } - else - { - frameidx = Array (dim_vector (1, 1)); - frameidx(0) = 1; - } - - std::vector imvec; - - try - { - // Read a file into vector of image objects - Magick::readImages (&imvec, args(0).string_value ()); - } - catch (Magick::Warning& w) - { - warning ("Magick++ warning: %s", w.what ()); - } - catch (Magick::ErrorCoder& e) - { - warning ("Magick++ coder error: %s", e.what ()); - } - catch (Magick::Exception& e) - { - error ("Magick++ exception: %s", e.what ()); - return output; - } - - int nframes = imvec.size (); - if (all_frames) - { - frameidx = Array (dim_vector (1, nframes)); - for (int i = 0; i < frameidx.length (); i++) - frameidx(i) = i; - } - else - { - for (int i = 0; i < frameidx.length (); i++) - { - frameidx(i) = frameidx(i) - 1; - - if (frameidx(i) >= nframes || frameidx(i) < 0) - { - error ("__magick_read__: invalid INDEX vector"); - return output; - } - } - } - - Magick::ClassType klass = imvec[0].classType (); - - if (klass == Magick::PseudoClass && nargout > 1) - output = read_indexed_images (imvec, frameidx, (nargout == 3)); - else - { - unsigned int depth = imvec[0].modulusDepth (); - if (depth > 1) - { - --depth; - int i = 1; - while (depth >>= 1) - i++; - depth = 1 << i; - } - - switch (depth) - { - case 1: - output = read_images (imvec, frameidx, depth); - break; - - case 2: - case 4: - case 8: - output = read_images (imvec, frameidx, depth) ; - break; - - case 16: - output = read_images (imvec, frameidx, depth); - break; - - case 32: - case 64: - default: - error ("__magick_read__: image depths greater than 16-bit are not supported"); - } - } -#else - - error ("imread: image reading capabilities were disabled when Octave was compiled"); - -#endif - - return output; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ - -#ifdef HAVE_MAGICK - -static void -jpg_settings (std::vector& imvec, - const Octave_map& options, - bool) -{ - bool something_set = false; - - // Quality setting - octave_value result; - Octave_map::const_iterator p; - bool found_it = false; - - for (p = options.begin (); p != options.end (); p++) - { - if (options.key (p) == "Quality") - { - found_it = true; - result = options.contents (p).elem (0); - break; - } - } - - if (found_it && (! result.is_empty ())) - { - something_set = true; - - if (result.is_real_type ()) - { - int qlev = result.int_value (); - - if (qlev < 0 || qlev > 100) - warning ("warning: Quality setting invalid--use default of 75"); - else - { - for (size_t fnum = 0; fnum < imvec.size (); fnum++) - imvec[fnum].quality (static_cast(qlev)); - } - } - else - warning ("warning: Quality setting invalid--use default of 75"); - } - - // Other settings go here - - if (! something_set) - warning ("__magick_write__ warning: all write parameters ignored"); -} - -static void -encode_bool_image (std::vector& imvec, const octave_value& img) -{ - unsigned int nframes = 1; - boolNDArray m = img.bool_array_value (); - - dim_vector dsizes = m.dims (); - if (dsizes.length () == 4) - nframes = dsizes(3); - - Array idx (dim_vector (dsizes.length (), 1)); - - octave_idx_type rows = m.rows (); - octave_idx_type columns = m.columns (); - - for (unsigned int ii = 0; ii < nframes; ii++) - { - Magick::Image im (Magick::Geometry (columns, rows), "black"); - im.classType (Magick::DirectClass); - im.depth (1); - - for (int y = 0; y < columns; y++) - { - idx(1) = y; - - for (int x = 0; x < rows; x++) - { - if (nframes > 1) - { - idx(2) = 0; - idx(3) = ii; - } - - idx(0) = x; - - if (m(idx)) - im.pixelColor (y, x, "white"); - } - } - - im.quantizeColorSpace (Magick::GRAYColorspace); - im.quantizeColors (2); - im.quantize (); - - imvec.push_back (im); - } -} - -template -static void -encode_uint_image (std::vector& imvec, - const octave_value& img, - bool has_map) -{ - unsigned int bitdepth = 0; - T m; - - if (img.is_uint8_type ()) - { - bitdepth = 8; - m = img.uint8_array_value (); - } - else if (img.is_uint16_type ()) - { - bitdepth = 16; - m = img.uint16_array_value (); - } - else - error ("__magick_write__: invalid image class"); - - dim_vector dsizes = m.dims (); - unsigned int nframes = 1; - if (dsizes.length () == 4) - nframes = dsizes(3); - - bool is_color = ((dsizes.length () > 2) && (dsizes(2) > 2)); - bool has_alpha = (dsizes.length () > 2 && (dsizes(2) == 2 || dsizes(2) == 4)); - - Array idx (dim_vector (dsizes.length (), 1)); - octave_idx_type rows = m.rows (); - octave_idx_type columns = m.columns (); - - unsigned int div_factor = (1 << bitdepth) - 1; - - for (unsigned int ii = 0; ii < nframes; ii++) - { - Magick::Image im (Magick::Geometry (columns, rows), "black"); - - im.depth (bitdepth); - - if (has_map) - im.classType (Magick::PseudoClass); - else - im.classType (Magick::DirectClass); - - if (is_color) - { - if (has_alpha) - im.type (Magick::TrueColorMatteType); - else - im.type (Magick::TrueColorType); - - Magick::ColorRGB c; - - for (int y = 0; y < columns; y++) - { - idx(1) = y; - - for (int x = 0; x < rows; x++) - { - idx(0) = x; - - if (nframes > 1) - idx(3) = ii; - - idx(2) = 0; - c.red (static_cast(m(idx)) / div_factor); - - idx(2) = 1; - c.green (static_cast(m(idx)) / div_factor); - - idx(2) = 2; - c.blue (static_cast(m(idx)) / div_factor); - - if (has_alpha) - { - idx(2) = 3; - c.alpha (static_cast(m(idx)) / div_factor); - } - - im.pixelColor (y, x, c); - } - } - } - else - { - if (has_alpha) - im.type (Magick::GrayscaleMatteType); - else - im.type (Magick::GrayscaleType); - - Magick::ColorGray c; - - for (int y = 0; y < columns; y++) - { - idx(1) = y; - - for (int x=0; x < rows; x++) - { - idx(0) = x; - - if (nframes > 1) - { - idx(2) = 0; - idx(3) = ii; - } - - if (has_alpha) - { - idx(2) = 1; - c.alpha (static_cast(m(idx)) / div_factor); - idx(2) = 0; - } - - c.shade (static_cast(m(idx)) / div_factor); - - im.pixelColor (y, x, c); - } - } - - im.quantizeColorSpace (Magick::GRAYColorspace); - im.quantizeColors (1 << bitdepth); - im.quantize (); - } - - imvec.push_back (im); - } -} - -static void -encode_map (std::vector& imvec, const NDArray& cmap) -{ - unsigned int mapsize = cmap.dim1 (); - - for (size_t fnum = 0; fnum < imvec.size (); fnum++) - { - imvec[fnum].colorMapSize (mapsize); - imvec[fnum].type (Magick::PaletteType); - } - - for (unsigned int ii = 0; ii < mapsize; ii++) - { - Magick::ColorRGB c (cmap(ii,0), cmap(ii,1), cmap(ii,2)); - - // FIXME -- is this case needed? - if (cmap.dim2 () == 4) - c.alpha (cmap(ii,3)); - - try - { - for_each (imvec.begin (), imvec.end (), - Magick::colorMapImage (ii, c)); - } - catch (Magick::Warning& w) - { - warning ("Magick++ warning: %s", w.what ()); - } - catch (Magick::ErrorCoder& e) - { - warning ("Magick++ coder error: %s", e.what ()); - } - catch (Magick::Exception& e) - { - error ("Magick++ exception: %s", e.what ()); - } - } -} - -static void -write_image (const std::string& filename, const std::string& fmt, - const octave_value& img, - const octave_value& map = octave_value (), - const octave_value& params = octave_value ()) -{ - std::vector imvec; - - bool has_map = map.is_defined (); - - if (has_map) - { - error ("__magick_write__: direct saving of indexed images not currently supported; use ind2rgb and save converted image"); - return; - } - - if (img.is_bool_type ()) - encode_bool_image (imvec, img); - else if (img.is_uint8_type ()) - encode_uint_image (imvec, img, has_map); - else if (img.is_uint16_type ()) - encode_uint_image (imvec, img, has_map); - else - error ("__magick_write__: image type not supported"); - - if (! error_state && has_map) - { - NDArray cmap = map.array_value (); - - if (! error_state) - encode_map (imvec, cmap); - } - - if (! error_state && params.is_defined ()) - { - Octave_map options = params.map_value (); - - // Insert calls here to handle parameters for various image formats - if (fmt == "jpg" || fmt == "jpeg") - jpg_settings (imvec, options, has_map); - else - warning ("warning: your parameter(s) currently not supported"); - } - - try - { - Magick::writeImages (imvec.begin (), imvec.end (), fmt + ":" + filename); - } - catch (Magick::Warning& w) - { - warning ("Magick++ warning: %s", w.what ()); - } - catch (Magick::ErrorCoder& e) - { - warning ("Magick++ coder error: %s", e.what ()); - } - catch (Magick::Exception& e) - { - error ("Magick++ exception: %s", e.what ()); - } -} - -#endif - -DEFUN_DLD (__magick_write__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} {} __magick_write__ (@var{fname}, @var{fmt}, @var{img})\n\ -@deftypefnx {Function File} {} __magick_write__ (@var{fname}, @var{fmt}, @var{img}, @var{map})\n\ -Write images with ImageMagick++. In general you should not be using this\n\ -function. Instead use @code{imwrite}.\n\ -@seealso{imread}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_MAGICK - maybe_initialize_magick (); - - int nargin = args.length (); - - if (nargin > 2) - { - std::string filename = args(0).string_value (); - - if (! error_state) - { - std::string fmt = args(1).string_value (); - - if (! error_state) - { - if (nargin > 4) - write_image (filename, fmt, args(2), args(3), args(4)); - else if (nargin > 3) - if (args(3).is_real_type ()) - write_image (filename, fmt, args(2), args(3)); - else - write_image (filename, fmt, args(2), octave_value (), args(3)); - else - write_image (filename, fmt, args(2)); - } - else - error ("__magick_write__: FMT must be string"); - } - else - error ("__magick_write__: FNAME must be a string"); - } - else - print_usage (); -#else - - error ("__magick_write__: not available in this version of Octave"); - -#endif - -return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ - -#ifdef HAVE_MAGICK - -template -static octave_value -magick_to_octave_value (const T magick) -{ - return octave_value (magick); -} - -static octave_value -magick_to_octave_value (const Magick::EndianType magick) -{ - switch (magick) - { - case Magick::LSBEndian: - return octave_value ("little-endian"); - - case Magick::MSBEndian: - return octave_value ("big-endian"); - - default: - return octave_value ("undefined"); - } -} - -static octave_value -magick_to_octave_value (const Magick::ResolutionType magick) -{ - switch (magick) - { - case Magick::PixelsPerInchResolution: - return octave_value ("pixels per inch"); - - case Magick::PixelsPerCentimeterResolution: - return octave_value ("pixels per centimeter"); - - default: - return octave_value ("undefined"); - } -} - -static octave_value -magick_to_octave_value (const Magick::ImageType magick) -{ - switch (magick) - { - case Magick::BilevelType: - case Magick::GrayscaleType: - case Magick::GrayscaleMatteType: - return octave_value ("grayscale"); - - case Magick::PaletteType: - case Magick::PaletteMatteType: - return octave_value ("indexed"); - - case Magick::TrueColorType: - case Magick::TrueColorMatteType: - case Magick::ColorSeparationType: - return octave_value ("truecolor"); - - default: - return octave_value ("undefined"); - } -} - -// We put this in a try-block because GraphicsMagick will throw -// exceptions if a parameter isn't present in the current image. -#define GET_PARAM(NAME, OUTNAME) \ - try \ - { \ - info.contents (OUTNAME)(frame,0) = magick_to_octave_value (im.NAME ()); \ - } \ - catch (Magick::Warning& w) \ - { \ - } - -#endif - -DEFUN_DLD (__magick_finfo__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __magick_finfo__ (@var{fname})\n\ -Read image information with GraphicsMagick++. In general you should\n\ -not be using this function. Instead use @code{imfinfo}.\n\ -@seealso{imfinfo, imread}\n\ -@end deftypefn") -{ - octave_value retval; - -#ifdef HAVE_MAGICK - - maybe_initialize_magick (); - - if (args.length () < 1 || ! args (0).is_string ()) - { - print_usage (); - return retval; - } - - const std::string filename = args (0).string_value (); - - try - { - // Read the file. - std::vector imvec; - Magick::readImages (&imvec, args(0).string_value ()); - int nframes = imvec.size (); - - // Create the right size for the output. - - static const char *fields[] = - { - "Filename", - "FileModDate", - "FileSize", - "Height", - "Width", - "BitDepth", - "Format", - "LongFormat", - "XResolution", - "YResolution", - "TotalColors", - "TileName", - "AnimationDelay", - "AnimationIterations", - "ByteOrder", - "Gamma", - "Matte", - "ModulusDepth", - "Quality", - "QuantizeColors", - "ResolutionUnits", - "ColorType", - "View", - 0 - }; - - Octave_map info (string_vector (fields), dim_vector (nframes, 1)); - - file_stat fs (filename); - - std::string filetime; - - if (fs) - { - octave_localtime mtime = fs.mtime (); - - filetime = mtime.strftime ("%e-%b-%Y %H:%M:%S"); - } - else - { - std::string msg = fs.error (); - - error ("imfinfo: error reading `%s': %s", - filename.c_str (), msg.c_str ()); - - return retval; - } - - // For each frame in the image (some images contain multiple - // layers, each to be treated like a separate image). - for (int frame = 0; frame < nframes; frame++) - { - Magick::Image im = imvec[frame]; - - // Add file name and timestamp. - info.contents ("Filename")(frame,0) = filename; - info.contents ("FileModDate")(frame,0) = filetime; - - // Annoying CamelCase naming is for Matlab compatibility. - GET_PARAM (fileSize, "FileSize") - GET_PARAM (rows, "Height") - GET_PARAM (columns, "Width") - GET_PARAM (depth, "BitDepth") - GET_PARAM (magick, "Format") - GET_PARAM (format, "LongFormat") - GET_PARAM (xResolution, "XResolution") - GET_PARAM (yResolution, "YResolution") - GET_PARAM (totalColors, "TotalColors") - GET_PARAM (tileName, "TileName") - GET_PARAM (animationDelay, "AnimationDelay") - GET_PARAM (animationIterations, "AnimationIterations") - GET_PARAM (endian, "ByteOrder") - GET_PARAM (gamma, "Gamma") - GET_PARAM (matte, "Matte") - GET_PARAM (modulusDepth, "ModulusDepth") - GET_PARAM (quality, "Quality") - GET_PARAM (quantizeColors, "QuantizeColors") - GET_PARAM (resolutionUnits, "ResolutionUnits") - GET_PARAM (type, "ColorType") - GET_PARAM (view, "View") - } - - retval = octave_value (info); - } - catch (Magick::Warning& w) - { - warning ("Magick++ warning: %s", w.what ()); - } - catch (Magick::ErrorCoder& e) - { - warning ("Magick++ coder error: %s", e.what ()); - } - catch (Magick::Exception& e) - { - error ("Magick++ exception: %s", e.what ()); - return retval; - } - -#else - - error ("imfinfo: not available in this version of Octave"); - -#endif - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ - -#undef GET_PARAM - -// Determine the file formats supported by GraphicsMagick. This is -// called once at the beginning of imread or imwrite to determine -// exactly which file formats are supported, so error messages can be -// displayed properly. - -DEFUN_DLD (__magick_format_list__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} {} __magick_format_list__ (@var{formats})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - -#ifdef HAVE_MAGICK - maybe_initialize_magick (); - - std::list accepted_formats; - - if (args.length () == 1) - { - Cell c = args (0).cell_value (); - - if (! error_state) - { - for (octave_idx_type i = 0; i < c.nelem (); i++) - { - try - { - std::string fmt = c.elem (i).string_value (); - - Magick::CoderInfo info(fmt); - - if (info.isReadable () && info.isWritable ()) - accepted_formats.push_back (fmt); - } - catch (Magick::Exception& e) - { - // Do nothing: exception here are simply missing formats. - } - } - } - else - error ("__magick_format_list__: expecting a cell array of image format names"); - } - else - print_usage (); - - retval = Cell (accepted_formats); - -#else - - error ("__magick_format_list__: not available in this version of Octave"); - -#endif - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/__voronoi__.cc --- a/src/DLD-FUNCTIONS/__voronoi__.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,334 +0,0 @@ -/* - -Copyright (C) 2000-2012 Kai Habel - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* -20. Augiust 2000 - Kai Habel: first release -*/ - -/* -2003-12-14 Rafael Laboissiere -Added optional second argument to pass options to the underlying -qhull command -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "lo-ieee.h" - -#include "Cell.h" -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" -#include "unwind-prot.h" - -#if defined (HAVE_QHULL) -# include "oct-qhull.h" -# if defined (NEED_QHULL_VERSION) -char qh_version[] = "__voronoi__.oct 2007-07-24"; -# endif -#endif - -static void -close_fcn (FILE *f) -{ - gnulib::fclose (f); -} - -DEFUN_DLD (__voronoi__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{caller}, @var{pts})\n\ -@deftypefnx {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{caller}, @var{pts}, @var{options})\n\ -@deftypefnx {Loadable Function} {@var{C}, @var{F}, @var{Inf_Pts} =} __voronoi__ (@dots{})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - - std::string caller = args(0).string_value (); - -#if defined (HAVE_QHULL) - - retval(0) = 0.0; - - int nargin = args.length (); - if (nargin < 2 || nargin > 3) - { - print_usage (); - return retval; - } - - Matrix points = args(1).matrix_value (); - const octave_idx_type dim = points.columns (); - const octave_idx_type num_points = points.rows (); - - points = points.transpose (); - - std::string options; - - if (dim <= 4) - options = " Qbb"; - else - options = " Qbb Qx"; - - if (nargin == 3) - { - octave_value opt_arg = args(2); - - if (opt_arg.is_string ()) - options = " " + opt_arg.string_value (); - else if (opt_arg.is_empty ()) - ; // Use default options. - else if (opt_arg.is_cellstr ()) - { - options = ""; - - Array tmp = opt_arg.cellstr_value (); - - for (octave_idx_type i = 0; i < tmp.numel (); i++) - options += " " + tmp(i); - } - else - { - error ("%s: OPTIONS must be a string, cell array of strings, or empty", - caller.c_str ()); - return retval; - } - } - - boolT ismalloc = false; - - unwind_protect frame; - - // Replace the outfile pointer with stdout for debugging information. -#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) - FILE *outfile = gnulib::fopen ("NUL", "w"); -#else - FILE *outfile = gnulib::fopen ("/dev/null", "w"); -#endif - FILE *errfile = stderr; - - if (outfile) - frame.add_fcn (close_fcn, outfile); - else - { - error ("__voronoi__: unable to create temporary file for output"); - return retval; - } - - // qh_new_qhull command and points arguments are not const... - - std::string cmd = "qhull v" + options; - - OCTAVE_LOCAL_BUFFER (char, cmd_str, cmd.length () + 1); - - strcpy (cmd_str, cmd.c_str ()); - - int exitcode = qh_new_qhull (dim, num_points, points.fortran_vec (), - ismalloc, cmd_str, outfile, errfile); - if (! exitcode) - { - // Calling findgood_all provides the number of Voronoi vertices - // (sets qh num_good). - - qh_findgood_all (qh facet_list); - - octave_idx_type num_voronoi_regions - = qh num_vertices - qh_setsize (qh del_vertices); - - octave_idx_type num_voronoi_vertices = qh num_good; - - // Find the voronoi centers for all facets. - - qh_setvoronoi_all (); - - facetT *facet; - vertexT *vertex; - octave_idx_type k; - - // Find the number of Voronoi vertices for each Voronoi cell and - // store them in NI so we can use them later to set the dimensions - // of the RowVector objects used to collect them. - - FORALLfacets - { - facet->seen = false; - } - - OCTAVE_LOCAL_BUFFER (octave_idx_type, ni, num_voronoi_regions); - for (octave_idx_type i = 0; i < num_voronoi_regions; i++) - ni[i] = 0; - - k = 0; - - FORALLvertices - { - if (qh hull_dim == 3) - qh_order_vertexneighbors (vertex); - - bool infinity_seen = false; - - facetT *neighbor, **neighborp; - - FOREACHneighbor_ (vertex) - { - if (neighbor->upperdelaunay) - { - if (! infinity_seen) - { - infinity_seen = true; - ni[k]++; - } - } - else - { - neighbor->seen = true; - ni[k]++; - } - } - - k++; - } - - // If Qhull finds fewer regions than points, we will pad the end - // of the at_inf and C arrays so that they always contain at least - // as many elements as the given points array. - - // FIXME -- is it possible (or does it make sense) for - // num_voronoi_regions to ever be larger than num_points? - - octave_idx_type nr = (num_points > num_voronoi_regions - ? num_points : num_voronoi_regions); - - boolMatrix at_inf (nr, 1, false); - - // The list of Voronoi vertices. The first element is always - // Inf. - Matrix F (num_voronoi_vertices+1, dim); - - for (octave_idx_type d = 0; d < dim; d++) - F(0,d) = octave_Inf; - - // The cell array of vectors of indices into F that represent the - // vertices of the Voronoi regions (cells). - - Cell C (nr, 1); - - // Now loop through the list of vertices again and store the - // coordinates of the Voronoi vertices and the lists of indices - // for the cells. - - FORALLfacets - { - facet->seen = false; - } - - octave_idx_type i = 0; - k = 0; - - FORALLvertices - { - if (qh hull_dim == 3) - qh_order_vertexneighbors (vertex); - - bool infinity_seen = false; - - octave_idx_type idx = qh_pointid (vertex->point); - - octave_idx_type num_vertices = ni[k++]; - - // Qhull seems to sometimes produces regions with a single - // vertex. Is that a bug? How can a region have just one - // vertex? Let's skip it. - - if (num_vertices == 1) - continue; - - RowVector facet_list (num_vertices); - - octave_idx_type m = 0; - - facetT *neighbor, **neighborp; - - FOREACHneighbor_(vertex) - { - if (neighbor->upperdelaunay) - { - if (! infinity_seen) - { - infinity_seen = true; - facet_list(m++) = 1; - at_inf(idx) = true; - } - } - else - { - if (! neighbor->seen) - { - i++; - for (octave_idx_type d = 0; d < dim; d++) - F(i,d) = neighbor->center[d]; - - neighbor->seen = true; - neighbor->visitid = i; - } - - facet_list(m++) = neighbor->visitid + 1; - } - } - - C(idx) = facet_list; - } - - retval(2) = at_inf; - retval(1) = C; - retval(0) = F; - } - else - error ("%s: qhull failed", caller.c_str ()); - - // Free memory from Qhull - qh_freeqhull (! qh_ALL); - - int curlong, totlong; - qh_memfreeshort (&curlong, &totlong); - - if (curlong || totlong) - warning ("%s: qhull did not free %d bytes of long memory (%d pieces)", - caller.c_str (), totlong, curlong); - -#else - error ("%s: not available in this version of Octave", caller.c_str ()); -#endif - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/amd.cc --- a/src/DLD-FUNCTIONS/amd.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,206 +0,0 @@ -/* - -Copyright (C) 2008-2012 David Bateman - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// This is the octave interface to amd, which bore the copyright given -// in the help of the functions. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "ov.h" -#include "defun-dld.h" -#include "pager.h" -#include "ov-re-mat.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "oct-map.h" - -#include "oct-sparse.h" -#include "oct-locbuf.h" - -#ifdef IDX_TYPE_LONG -#define AMD_NAME(name) amd_l ## name -#else -#define AMD_NAME(name) amd ## name -#endif - -DEFUN_DLD (amd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} amd (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} amd (@var{S}, @var{opts})\n\ -\n\ -Return the approximate minimum degree permutation of a matrix. This\n\ -permutation such that the Cholesky@tie{}factorization of @code{@var{S}\n\ -(@var{p}, @var{p})} tends to be sparser than the Cholesky@tie{}factorization\n\ -of @var{S} itself. @code{amd} is typically faster than @code{symamd} but\n\ -serves a similar purpose.\n\ -\n\ -The optional parameter @var{opts} is a structure that controls the\n\ -behavior of @code{amd}. The fields of the structure are\n\ -\n\ -@table @asis\n\ -@item @var{opts}.dense\n\ -Determines what @code{amd} considers to be a dense row or column of the\n\ -input matrix. Rows or columns with more than @code{max(16, (dense *\n\ -sqrt (@var{n})} entries, where @var{n} is the order of the matrix @var{S},\n\ -are ignored by @code{amd} during the calculation of the permutation\n\ -The value of dense must be a positive scalar and its default value is 10.0\n\ -\n\ -@item @var{opts}.aggressive\n\ -If this value is a non zero scalar, then @code{amd} performs aggressive\n\ -absorption. The default is not to perform aggressive absorption.\n\ -@end table\n\ -\n\ -The author of the code itself is Timothy A. Davis\n\ -@email{davis@@cise.ufl.edu}, University of Florida (see\n\ -@url{http://www.cise.ufl.edu/research/sparse/amd}).\n\ -@seealso{symamd, colamd}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_AMD - int nargin = args.length (); - - if (nargin < 1 || nargin > 2) - print_usage (); - else - { - octave_idx_type n_row, n_col; - const octave_idx_type *ridx, *cidx; - SparseMatrix sm; - SparseComplexMatrix scm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0).sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - } - else - { - if (args(0).is_complex_type ()) - sm = SparseMatrix (real (args(0).complex_matrix_value ())); - else - sm = SparseMatrix (args(0).matrix_value ()); - - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - if (!error_state && n_row != n_col) - error ("amd: matrix S must be square"); - - if (!error_state) - { - OCTAVE_LOCAL_BUFFER (double, Control, AMD_CONTROL); - AMD_NAME (_defaults) (Control) ; - if (nargin > 1) - { - octave_scalar_map arg1 = args(1).scalar_map_value (); - - if (!error_state) - { - octave_value tmp; - - tmp = arg1.getfield ("dense"); - if (tmp.is_defined ()) - Control[AMD_DENSE] = tmp.double_value (); - - tmp = arg1.getfield ("aggressive"); - if (tmp.is_defined ()) - Control[AMD_AGGRESSIVE] = tmp.double_value (); - } - else - error ("amd: OPTS argument must be a scalar structure"); - } - - if (!error_state) - { - OCTAVE_LOCAL_BUFFER (octave_idx_type, P, n_col); - Matrix xinfo (AMD_INFO, 1); - double *Info = xinfo.fortran_vec (); - - // FIXME -- how can we manage the memory allocation of - // amd in a cleaner manner? - amd_malloc = malloc; - amd_free = free; - amd_calloc = calloc; - amd_realloc = realloc; - amd_printf = printf; - - octave_idx_type result = AMD_NAME (_order) (n_col, cidx, ridx, P, - Control, Info); - - switch (result) - { - case AMD_OUT_OF_MEMORY: - error ("amd: out of memory"); - break; - case AMD_INVALID: - error ("amd: matrix S is corrupted"); - break; - default: - { - if (nargout > 1) - retval(1) = xinfo; - - Matrix Pout (1, n_col); - for (octave_idx_type i = 0; i < n_col; i++) - Pout.xelem (i) = P[i] + 1; - - retval(0) = Pout; - } - } - } - } - } -#else - - error ("amd: not available in this version of Octave"); - -#endif - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/ccolamd.cc --- a/src/DLD-FUNCTIONS/ccolamd.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,583 +0,0 @@ -/* - -Copyright (C) 2005-2012 David Bateman - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// This is the octave interface to ccolamd, which bore the copyright given -// in the help of the functions. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "ov.h" -#include "defun-dld.h" -#include "pager.h" -#include "ov-re-mat.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -#include "oct-sparse.h" -#include "oct-locbuf.h" - -#ifdef IDX_TYPE_LONG -#define CCOLAMD_NAME(name) ccolamd_l ## name -#define CSYMAMD_NAME(name) csymamd_l ## name -#else -#define CCOLAMD_NAME(name) ccolamd ## name -#define CSYMAMD_NAME(name) csymamd ## name -#endif - -DEFUN_DLD (ccolamd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} ccolamd (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} ccolamd (@var{S}, @var{knobs})\n\ -@deftypefnx {Loadable Function} {@var{p} =} ccolamd (@var{S}, @var{knobs}, @var{cmember})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} ccolamd (@dots{})\n\ -\n\ -Constrained column approximate minimum degree permutation.\n\ -@code{@var{p} = ccolamd (@var{S})} returns the column approximate minimum\n\ -degree permutation vector for the sparse matrix @var{S}. For a non-symmetric\n\ -matrix\n\ -@var{S},\n\ -@code{@var{S}(:, @var{p})} tends to have sparser LU@tie{}factors than\n\ -@var{S}. @code{chol (@var{S}(:, @var{p})' * @var{S}(:, @var{p}))} also\n\ -tends to be sparser than @code{chol (@var{S}' * @var{S})}. @code{@var{p} =\n\ -ccolamd (@var{S}, 1)} optimizes the ordering for @code{lu (@var{S}(:,\n\ -@var{p}))}. The ordering is followed by a column elimination tree\n\ -post-ordering.\n\ -\n\ -@var{knobs} is an optional 1-element to 5-element input vector, with a\n\ -default value of @code{[0 10 10 1 0]} if not present or empty. Entries not\n\ -present are set to their defaults.\n\ -\n\ -@table @code\n\ -@item @var{knobs}(1)\n\ -if nonzero, the ordering is optimized for @code{lu (S(:, p))}. It will be a\n\ -poor ordering for @code{chol (@var{S}(:, @var{p})' * @var{S}(:,\n\ -@var{p}))}. This is the most important knob for ccolamd.\n\ -\n\ -@item @var{knobs}(2)\n\ -if @var{S} is m-by-n, rows with more than @code{max (16, @var{knobs}(2) *\n\ -sqrt (n))} entries are ignored.\n\ -\n\ -@item @var{knobs}(3)\n\ -columns with more than @code{max (16, @var{knobs}(3) * sqrt (min (@var{m},\n\ -@var{n})))} entries are ignored and ordered last in the output permutation\n\ -(subject to the cmember constraints).\n\ -\n\ -@item @var{knobs}(4)\n\ -if nonzero, aggressive absorption is performed.\n\ -\n\ -@item @var{knobs}(5)\n\ -if nonzero, statistics and knobs are printed.\n\ -\n\ -@end table\n\ -\n\ -@var{cmember} is an optional vector of length @math{n}. It defines the\n\ -constraints on the column ordering. If @code{@var{cmember}(j) = @var{c}},\n\ -then column @var{j} is in constraint set @var{c} (@var{c} must be in the\n\ -range 1 to\n\ -n). In the output permutation @var{p}, all columns in set 1 appear\n\ -first, followed by all columns in set 2, and so on. @code{@var{cmember} =\n\ -ones (1,n)} if not present or empty.\n\ -@code{ccolamd (@var{S}, [], 1 : n)} returns @code{1 : n}\n\ -\n\ -@code{@var{p} = ccolamd (@var{S})} is about the same as\n\ -@code{@var{p} = colamd (@var{S})}. @var{knobs} and its default values\n\ -differ. @code{colamd} always does aggressive absorption, and it finds an\n\ -ordering suitable for both @code{lu (@var{S}(:, @var{p}))} and @code{chol\n\ -(@var{S}(:, @var{p})' * @var{S}(:, @var{p}))}; it cannot optimize its\n\ -ordering for @code{lu (@var{S}(:, @var{p}))} to the extent that\n\ -@code{ccolamd (@var{S}, 1)} can.\n\ -\n\ -@var{stats} is an optional 20-element output vector that provides data\n\ -about the ordering and the validity of the input matrix @var{S}. Ordering\n\ -statistics are in @code{@var{stats}(1 : 3)}. @code{@var{stats}(1)} and\n\ -@code{@var{stats}(2)} are the number of dense or empty rows and columns\n\ -ignored by @sc{ccolamd} and @code{@var{stats}(3)} is the number of garbage\n\ -collections performed on the internal data structure used by @sc{ccolamd}\n\ -(roughly of size @code{2.2 * nnz (@var{S}) + 4 * @var{m} + 7 * @var{n}}\n\ -integers).\n\ -\n\ -@code{@var{stats}(4 : 7)} provide information if CCOLAMD was able to\n\ -continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ -invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ -unsorted or contains duplicate entries, or zero if no such column exists.\n\ -@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ -index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ -such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ -or out-of-order row indices. @code{@var{stats}(8 : 20)} is always zero in\n\ -the current version of @sc{ccolamd} (reserved for future use).\n\ -\n\ -The authors of the code itself are S. Larimore, T. Davis (Univ. of Florida)\n\ -and S. Rajamanickam in collaboration with J. Bilbert and E. Ng. Supported\n\ -by the National Science Foundation (DMS-9504974, DMS-9803599, CCR-0203270),\n\ -and a grant from Sandia National Lab. See\n\ -@url{http://www.cise.ufl.edu/research/sparse} for ccolamd, csymamd, amd,\n\ -colamd, symamd, and other related orderings.\n\ -@seealso{colamd, csymamd}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_CCOLAMD - - int nargin = args.length (); - int spumoni = 0; - - if (nargout > 2 || nargin < 1 || nargin > 3) - usage ("ccolamd: incorrect number of input and/or output arguments"); - else - { - // Get knobs - OCTAVE_LOCAL_BUFFER (double, knobs, CCOLAMD_KNOBS); - CCOLAMD_NAME (_set_defaults) (knobs); - - // Check for user-passed knobs - if (nargin > 1) - { - NDArray User_knobs = args(1).array_value (); - int nel_User_knobs = User_knobs.length (); - - if (nel_User_knobs > 0) - knobs[CCOLAMD_LU] = (User_knobs(0) != 0); - if (nel_User_knobs > 1) - knobs[CCOLAMD_DENSE_ROW] = User_knobs(1); - if (nel_User_knobs > 2) - knobs[CCOLAMD_DENSE_COL] = User_knobs(2); - if (nel_User_knobs > 3) - knobs[CCOLAMD_AGGRESSIVE] = (User_knobs(3) != 0); - if (nel_User_knobs > 4) - spumoni = (User_knobs(4) != 0); - - // print knob settings if spumoni is set - if (spumoni) - { - octave_stdout << "\nccolamd version " << CCOLAMD_MAIN_VERSION << "." - << CCOLAMD_SUB_VERSION << ", " << CCOLAMD_DATE - << ":\nknobs(1): " << User_knobs(0) << ", order for "; - if (knobs[CCOLAMD_LU] != 0) - octave_stdout << "lu (A)\n"; - else - octave_stdout << "chol (A'*A)\n"; - - if (knobs[CCOLAMD_DENSE_ROW] >= 0) - octave_stdout << "knobs(2): " << User_knobs(1) - << ", rows with > max (16," - << knobs[CCOLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" - << " entries removed\n"; - else - octave_stdout << "knobs(2): " << User_knobs(1) - << ", no dense rows removed\n"; - - if (knobs[CCOLAMD_DENSE_COL] >= 0) - octave_stdout << "knobs(3): " << User_knobs(2) - << ", cols with > max (16," - << knobs[CCOLAMD_DENSE_COL] << "*sqrt (size(A)))" - << " entries removed\n"; - else - octave_stdout << "knobs(3): " << User_knobs(2) - << ", no dense columns removed\n"; - - if (knobs[CCOLAMD_AGGRESSIVE] != 0) - octave_stdout << "knobs(4): " << User_knobs(3) - << ", aggressive absorption: yes"; - else - octave_stdout << "knobs(4): " << User_knobs(3) - << ", aggressive absorption: no"; - - octave_stdout << "knobs(5): " << User_knobs(4) - << ", statistics and knobs printed\n"; - } - } - - octave_idx_type n_row, n_col, nnz; - octave_idx_type *ridx, *cidx; - SparseComplexMatrix scm; - SparseMatrix sm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0). sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - nnz = scm.nnz (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - - n_row = sm.rows (); - n_col = sm.cols (); - nnz = sm.nnz (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - } - else - { - if (args(0).is_complex_type ()) - sm = SparseMatrix (real (args(0).complex_matrix_value ())); - else - sm = SparseMatrix (args(0).matrix_value ()); - - n_row = sm.rows (); - n_col = sm.cols (); - nnz = sm.nnz (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - // Allocate workspace for ccolamd - OCTAVE_LOCAL_BUFFER (octave_idx_type, p, n_col+1); - for (octave_idx_type i = 0; i < n_col+1; i++) - p[i] = cidx[i]; - - octave_idx_type Alen = CCOLAMD_NAME (_recommended) (nnz, n_row, n_col); - OCTAVE_LOCAL_BUFFER (octave_idx_type, A, Alen); - for (octave_idx_type i = 0; i < nnz; i++) - A[i] = ridx[i]; - - OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, CCOLAMD_STATS); - - if (nargin > 2) - { - NDArray in_cmember = args(2).array_value (); - octave_idx_type cslen = in_cmember.length (); - OCTAVE_LOCAL_BUFFER (octave_idx_type, cmember, cslen); - for (octave_idx_type i = 0; i < cslen; i++) - // convert cmember from 1-based to 0-based - cmember[i] = static_cast(in_cmember(i) - 1); - - if (cslen != n_col) - error ("ccolamd: CMEMBER must be of length equal to #cols of A"); - else - // Order the columns (destroys A) - if (! CCOLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats, cmember)) - { - CCOLAMD_NAME (_report) (stats) ; - error ("ccolamd: internal error!"); - return retval; - } - } - else - { - // Order the columns (destroys A) - if (! CCOLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats, 0)) - { - CCOLAMD_NAME (_report) (stats) ; - error ("ccolamd: internal error!"); - return retval; - } - } - - // return the permutation vector - NDArray out_perm (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - out_perm(i) = p[i] + 1; - - retval(0) = out_perm; - - // print stats if spumoni > 0 - if (spumoni > 0) - CCOLAMD_NAME (_report) (stats) ; - - // Return the stats vector - if (nargout == 2) - { - NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); - for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) - out_stats(i) = stats[i] ; - retval(1) = out_stats; - - // fix stats (5) and (6), for 1-based information on - // jumbled matrix. note that this correction doesn't - // occur if symamd returns FALSE - out_stats (CCOLAMD_INFO1) ++ ; - out_stats (CCOLAMD_INFO2) ++ ; - } - } - -#else - - error ("ccolamd: not available in this version of Octave"); - -#endif - - return retval; -} - -DEFUN_DLD (csymamd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} csymamd (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} csymamd (@var{S}, @var{knobs})\n\ -@deftypefnx {Loadable Function} {@var{p} =} csymamd (@var{S}, @var{knobs}, @var{cmember})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} csymamd (@dots{})\n\ -\n\ -For a symmetric positive definite matrix @var{S}, returns the permutation\n\ -vector @var{p} such that @code{@var{S}(@var{p},@var{p})} tends to have a\n\ -sparser Cholesky@tie{}factor than @var{S}. Sometimes @code{csymamd} works\n\ -well for symmetric indefinite matrices too. The matrix @var{S} is assumed\n\ -to be symmetric; only the strictly lower triangular part is referenced.\n\ -@var{S} must be square. The ordering is followed by an elimination tree\n\ -post-ordering.\n\ -\n\ -@var{knobs} is an optional 1-element to 3-element input vector, with a\n\ -default value of @code{[10 1 0]} if present or empty. Entries not\n\ -present are set to their defaults.\n\ -\n\ -@table @code\n\ -@item @var{knobs}(1)\n\ -If @var{S} is n-by-n, then rows and columns with more than\n\ -@code{max(16,@var{knobs}(1)*sqrt(n))} entries are ignored, and ordered\n\ -last in the output permutation (subject to the cmember constraints).\n\ -\n\ -@item @var{knobs}(2)\n\ -If nonzero, aggressive absorption is performed.\n\ -\n\ -@item @var{knobs}(3)\n\ -If nonzero, statistics and knobs are printed.\n\ -\n\ -@end table\n\ -\n\ -@var{cmember} is an optional vector of length n. It defines the constraints\n\ -on the ordering. If @code{@var{cmember}(j) = @var{S}}, then row/column j is\n\ -in constraint set @var{c} (@var{c} must be in the range 1 to n). In the\n\ -output permutation @var{p}, rows/columns in set 1 appear first, followed\n\ -by all rows/columns in set 2, and so on. @code{@var{cmember} = ones (1,n)}\n\ -if not present or empty. @code{csymamd (@var{S},[],1:n)} returns @code{1:n}.\n\ -\n\ -@code{@var{p} = csymamd (@var{S})} is about the same as @code{@var{p} =\n\ -symamd (@var{S})}. @var{knobs} and its default values differ.\n\ -\n\ -@code{@var{stats}(4:7)} provide information if CCOLAMD was able to\n\ -continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ -invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ -unsorted or contains duplicate entries, or zero if no such column exists.\n\ -@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ -index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ -such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ -or out-of-order row indices. @code{@var{stats}(8:20)} is always zero in\n\ -the current version of @sc{ccolamd} (reserved for future use).\n\ -\n\ -The authors of the code itself are S. Larimore, T. Davis (Uni of Florida)\n\ -and S. Rajamanickam in collaboration with J. Bilbert and E. Ng. Supported\n\ -by the National Science Foundation (DMS-9504974, DMS-9803599, CCR-0203270),\n\ -and a grant from Sandia National Lab. See\n\ -@url{http://www.cise.ufl.edu/research/sparse} for ccolamd, csymamd, amd,\n\ -colamd, symamd, and other related orderings.\n\ -@seealso{symamd, ccolamd}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#if HAVE_CCOLAMD - - int nargin = args.length (); - int spumoni = 0; - - if (nargout > 2 || nargin < 1 || nargin > 3) - usage ("ccolamd: incorrect number of input and/or output arguments"); - else - { - // Get knobs - OCTAVE_LOCAL_BUFFER (double, knobs, CCOLAMD_KNOBS); - CCOLAMD_NAME (_set_defaults) (knobs); - - // Check for user-passed knobs - if (nargin > 1) - { - NDArray User_knobs = args(1).array_value (); - int nel_User_knobs = User_knobs.length (); - - if (nel_User_knobs > 0) - knobs[CCOLAMD_DENSE_ROW] = User_knobs(0); - if (nel_User_knobs > 0) - knobs[CCOLAMD_AGGRESSIVE] = User_knobs(1); - if (nel_User_knobs > 1) - spumoni = static_cast (User_knobs(2)); - - // print knob settings if spumoni is set - if (spumoni) - { - octave_stdout << "\ncsymamd version " << CCOLAMD_MAIN_VERSION << "." - << CCOLAMD_SUB_VERSION << ", " << CCOLAMD_DATE << "\n"; - - if (knobs[CCOLAMD_DENSE_ROW] >= 0) - octave_stdout << "knobs(1): " << User_knobs(0) - << ", rows/cols with > max (16," - << knobs[CCOLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" - << " entries removed\n"; - else - octave_stdout << "knobs(1): " << User_knobs(0) - << ", no dense rows/cols removed\n"; - - if (knobs[CCOLAMD_AGGRESSIVE] != 0) - octave_stdout << "knobs(2): " << User_knobs(1) - << ", aggressive absorption: yes"; - else - octave_stdout << "knobs(2): " << User_knobs(1) - << ", aggressive absorption: no"; - - - octave_stdout << "knobs(3): " << User_knobs(2) - << ", statistics and knobs printed\n"; - } - } - - octave_idx_type n_row, n_col; - octave_idx_type *ridx, *cidx; - SparseMatrix sm; - SparseComplexMatrix scm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0).sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - } - else - { - if (args(0).is_complex_type ()) - sm = SparseMatrix (real (args(0).complex_matrix_value ())); - else - sm = SparseMatrix (args(0).matrix_value ()); - - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - if (n_row != n_col) - { - error ("csymamd: matrix S must be square"); - return retval; - } - - // Allocate workspace for symamd - OCTAVE_LOCAL_BUFFER (octave_idx_type, perm, n_col+1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, CCOLAMD_STATS); - - if (nargin > 2) - { - NDArray in_cmember = args(2).array_value (); - octave_idx_type cslen = in_cmember.length (); - OCTAVE_LOCAL_BUFFER (octave_idx_type, cmember, cslen); - for (octave_idx_type i = 0; i < cslen; i++) - // convert cmember from 1-based to 0-based - cmember[i] = static_cast(in_cmember(i) - 1); - - if (cslen != n_col) - error ("csymamd: CMEMBER must be of length equal to #cols of A"); - else - if (!CSYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, - &calloc, &free, cmember, -1)) - { - CSYMAMD_NAME (_report) (stats) ; - error ("csymamd: internal error!") ; - return retval; - } - } - else - { - if (!CSYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, - &calloc, &free, 0, -1)) - { - CSYMAMD_NAME (_report) (stats) ; - error ("csymamd: internal error!") ; - return retval; - } - } - - // return the permutation vector - NDArray out_perm (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - out_perm(i) = perm[i] + 1; - - retval(0) = out_perm; - - // Return the stats vector - if (nargout == 2) - { - NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); - for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) - out_stats(i) = stats[i] ; - retval(1) = out_stats; - - // fix stats (5) and (6), for 1-based information on - // jumbled matrix. note that this correction doesn't - // occur if symamd returns FALSE - out_stats (CCOLAMD_INFO1) ++ ; - out_stats (CCOLAMD_INFO2) ++ ; - } - - // print stats if spumoni > 0 - if (spumoni > 0) - CSYMAMD_NAME (_report) (stats) ; - - // Return the stats vector - if (nargout == 2) - { - NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); - for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) - out_stats(i) = stats[i] ; - retval(1) = out_stats; - - // fix stats (5) and (6), for 1-based information on - // jumbled matrix. note that this correction doesn't - // occur if symamd returns FALSE - out_stats (CCOLAMD_INFO1) ++ ; - out_stats (CCOLAMD_INFO2) ++ ; - } - } - -#else - - error ("csymamd: not available in this version of Octave"); - -#endif - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/chol.cc --- a/src/DLD-FUNCTIONS/chol.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1385 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2008-2009 Jaroslav Hajek -Copyright (C) 2008-2009 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "CmplxCHOL.h" -#include "dbleCHOL.h" -#include "fCmplxCHOL.h" -#include "floatCHOL.h" -#include "SparseCmplxCHOL.h" -#include "SparsedbleCHOL.h" -#include "oct-spparms.h" -#include "sparse-util.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "utils.h" - -template -static octave_value -get_chol_r (const CHOLT& fact) -{ - return octave_value (fact.chol_matrix (), - MatrixType (MatrixType::Upper)); -} - -template -static octave_value -get_chol_l (const CHOLT& fact) -{ - return octave_value (fact.chol_matrix ().transpose (), - MatrixType (MatrixType::Lower)); -} - -DEFUN_DLD (chol, args, nargout, -"-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{R} =} chol (@var{A})\n\ -@deftypefnx {Loadable Function} {[@var{R}, @var{p}] =} chol (@var{A})\n\ -@deftypefnx {Loadable Function} {[@var{R}, @var{p}, @var{Q}] =} chol (@var{S})\n\ -@deftypefnx {Loadable Function} {[@var{R}, @var{p}, @var{Q}] =} chol (@var{S}, \"vector\")\n\ -@deftypefnx {Loadable Function} {[@var{L}, @dots{}] =} chol (@dots{}, \"lower\")\n\ -@deftypefnx {Loadable Function} {[@var{L}, @dots{}] =} chol (@dots{}, \"upper\")\n\ -@cindex Cholesky factorization\n\ -Compute the Cholesky@tie{}factor, @var{R}, of the symmetric positive definite\n\ -matrix @var{A}, where\n\ -@tex\n\ -$ R^T R = A $.\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@var{R}' * @var{R} = @var{A}.\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -\n\ -Called with one output argument @code{chol} fails if @var{A} or @var{S} is\n\ -not positive definite. With two or more output arguments @var{p} flags\n\ -whether the matrix was positive definite and @code{chol} does not fail. A\n\ -zero value indicated that the matrix was positive definite and the @var{R}\n\ -gives the factorization, and @var{p} will have a positive value otherwise.\n\ -\n\ -If called with 3 outputs then a sparsity preserving row/column permutation\n\ -is applied to @var{A} prior to the factorization. That is @var{R}\n\ -is the factorization of @code{@var{A}(@var{Q},@var{Q})} such that\n\ -@tex\n\ -$ R^T R = Q^T A Q$.\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@var{R}' * @var{R} = @var{Q}' * @var{A} * @var{Q}.\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -\n\ -The sparsity preserving permutation is generally returned as a matrix.\n\ -However, given the flag \"vector\", @var{Q} will be returned as a vector\n\ -such that\n\ -@tex\n\ -$ R^T R = A (Q, Q)$.\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@var{R}' * @var{R} = @var{A}(@var{Q}, @var{Q}).\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -\n\ -Called with either a sparse or full matrix and using the \"lower\" flag,\n\ -@code{chol} returns the lower triangular factorization such that\n\ -@tex\n\ -$ L L^T = A $.\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@var{L} * @var{L}' = @var{A}.\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -\n\ -For full matrices, if the \"lower\" flag is set only the lower triangular\n\ -part of the matrix is used for the factorization, otherwise the upper\n\ -triangular part is used.\n\ -\n\ -In general the lower triangular factorization is significantly faster for\n\ -sparse matrices.\n\ -@seealso{cholinv, chol2inv}\n\ -@end deftypefn") -{ - octave_value_list retval; - int nargin = args.length (); - bool LLt = false; - bool vecout = false; - - if (nargin < 1 || nargin > 3 || nargout > 3 - || (! args(0).is_sparse_type () && nargout > 2)) - { - print_usage (); - return retval; - } - - int n = 1; - while (n < nargin && ! error_state) - { - std::string tmp = args(n++).string_value (); - - if (! error_state ) - { - if (tmp.compare ("vector") == 0) - vecout = true; - else if (tmp.compare ("lower") == 0) - // FIXME currently the option "lower" is handled by transposing the - // matrix, factorizing it with the lapack function DPOTRF ('U', ...) - // and finally transposing the factor. It would be more efficient to use - // DPOTRF ('L', ...) in this case. - LLt = true; - else if (tmp.compare ("upper") == 0) - LLt = false; - else - error ("chol: unexpected second or third input"); - } - else - error ("chol: expecting trailing string arguments"); - } - - if (! error_state) - { - octave_value arg = args(0); - - octave_idx_type nr = arg.rows (); - octave_idx_type nc = arg.columns (); - bool natural = (nargout != 3); - - int arg_is_empty = empty_arg ("chol", nr, nc); - - if (arg_is_empty < 0) - return retval; - if (arg_is_empty > 0) - return octave_value (Matrix ()); - - if (arg.is_sparse_type ()) - { - if (arg.is_real_type ()) - { - SparseMatrix m = arg.sparse_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - SparseCHOL fact (m, info, natural); - if (nargout == 3) - { - if (vecout) - retval(2) = fact.perm (); - else - retval(2) = fact.Q (); - } - - if (nargout > 1 || info == 0) - { - retval(1) = fact.P (); - if (LLt) - retval(0) = fact.L (); - else - retval(0) = fact.R (); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - SparseComplexMatrix m = arg.sparse_complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - SparseComplexCHOL fact (m, info, natural); - - if (nargout == 3) - { - if (vecout) - retval(2) = fact.perm (); - else - retval(2) = fact.Q (); - } - - if (nargout > 1 || info == 0) - { - retval(1) = fact.P (); - if (LLt) - retval(0) = fact.L (); - else - retval(0) = fact.R (); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else - gripe_wrong_type_arg ("chol", arg); - } - else if (arg.is_single_type ()) - { - if (arg.is_real_type ()) - { - FloatMatrix m = arg.float_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - - FloatCHOL fact; - if (LLt) - fact = FloatCHOL (m.transpose (), info); - else - fact = FloatCHOL (m, info); - - if (nargout == 2 || info == 0) - { - retval(1) = info; - if (LLt) - retval(0) = get_chol_l (fact); - else - retval(0) = get_chol_r (fact); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - FloatComplexMatrix m = arg.float_complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - - FloatComplexCHOL fact; - if (LLt) - fact = FloatComplexCHOL (m.transpose (), info); - else - fact = FloatComplexCHOL (m, info); - - if (nargout == 2 || info == 0) - { - retval(1) = info; - if (LLt) - retval(0) = get_chol_l (fact); - else - retval(0) = get_chol_r (fact); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else - gripe_wrong_type_arg ("chol", arg); - } - else - { - if (arg.is_real_type ()) - { - Matrix m = arg.matrix_value (); - - if (! error_state) - { - octave_idx_type info; - - CHOL fact; - if (LLt) - fact = CHOL (m.transpose (), info); - else - fact = CHOL (m, info); - - if (nargout == 2 || info == 0) - { - retval(1) = info; - if (LLt) - retval(0) = get_chol_l (fact); - else - retval(0) = get_chol_r (fact); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - ComplexMatrix m = arg.complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - - ComplexCHOL fact; - if (LLt) - fact = ComplexCHOL (m.transpose (), info); - else - fact = ComplexCHOL (m, info); - - if (nargout == 2 || info == 0) - { - retval(1) = info; - if (LLt) - retval(0) = get_chol_l (fact); - else - retval(0) = get_chol_r (fact); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else - gripe_wrong_type_arg ("chol", arg); - } - } - - return retval; -} - -/* -%!assert (chol ([2, 1; 1, 1]), [sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)], sqrt (eps)) -%!assert (chol (single ([2, 1; 1, 1])), single ([sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)]), sqrt (eps ("single"))) - -%!error chol () -%!error chol ([1, 2; 3, 4]) -%!error chol ([1, 2; 3, 4; 5, 6]) -%!error chol (1, 2) -*/ - -DEFUN_DLD (cholinv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} cholinv (@var{A})\n\ -Use the Cholesky@tie{}factorization to compute the inverse of the\n\ -symmetric positive definite matrix @var{A}.\n\ -@seealso{chol, chol2inv, inv}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value arg = args(0); - - octave_idx_type nr = arg.rows (); - octave_idx_type nc = arg.columns (); - - if (nr == 0 || nc == 0) - retval = Matrix (); - else - { - if (arg.is_sparse_type ()) - { - if (arg.is_real_type ()) - { - SparseMatrix m = arg.sparse_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - SparseCHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - SparseComplexMatrix m = arg.sparse_complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - SparseComplexCHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else - gripe_wrong_type_arg ("cholinv", arg); - } - else if (arg.is_single_type ()) - { - if (arg.is_real_type ()) - { - FloatMatrix m = arg.float_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - FloatCHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - FloatComplexMatrix m = arg.float_complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - FloatComplexCHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else - gripe_wrong_type_arg ("chol", arg); - } - else - { - if (arg.is_real_type ()) - { - Matrix m = arg.matrix_value (); - - if (! error_state) - { - octave_idx_type info; - CHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - ComplexMatrix m = arg.complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - ComplexCHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else - gripe_wrong_type_arg ("chol", arg); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!shared A, Ainv -%! A = [2,0.2;0.2,1]; -%! Ainv = inv (A); -%!test -%! Ainv1 = cholinv (A); -%! assert (norm (Ainv-Ainv1), 0, 1e-10); -%!testif HAVE_CHOLMOD -%! Ainv2 = inv (sparse (A)); -%! assert (norm (Ainv-Ainv2), 0, 1e-10); -%!testif HAVE_CHOLMOD -%! Ainv3 = cholinv (sparse (A)); -%! assert (norm (Ainv-Ainv3), 0, 1e-10); -*/ - -DEFUN_DLD (chol2inv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} chol2inv (@var{U})\n\ -Invert a symmetric, positive definite square matrix from its Cholesky\n\ -decomposition, @var{U}. Note that @var{U} should be an upper-triangular\n\ -matrix with positive diagonal elements. @code{chol2inv (@var{U})}\n\ -provides @code{inv (@var{U}'*@var{U})} but it is much faster than\n\ -using @code{inv}.\n\ -@seealso{chol, cholinv, inv}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value arg = args(0); - - octave_idx_type nr = arg.rows (); - octave_idx_type nc = arg.columns (); - - if (nr == 0 || nc == 0) - retval = Matrix (); - else - { - if (arg.is_sparse_type ()) - { - if (arg.is_real_type ()) - { - SparseMatrix r = arg.sparse_matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else if (arg.is_complex_type ()) - { - SparseComplexMatrix r = arg.sparse_complex_matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else - gripe_wrong_type_arg ("chol2inv", arg); - } - else if (arg.is_single_type ()) - { - if (arg.is_real_type ()) - { - FloatMatrix r = arg.float_matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else if (arg.is_complex_type ()) - { - FloatComplexMatrix r = arg.float_complex_matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else - gripe_wrong_type_arg ("chol2inv", arg); - - } - else - { - if (arg.is_real_type ()) - { - Matrix r = arg.matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else if (arg.is_complex_type ()) - { - ComplexMatrix r = arg.complex_matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else - gripe_wrong_type_arg ("chol2inv", arg); - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN_DLD (cholupdate, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{R1}, @var{info}] =} cholupdate (@var{R}, @var{u}, @var{op})\n\ -Update or downdate a Cholesky@tie{}factorization. Given an upper triangular\n\ -matrix @var{R} and a column vector @var{u}, attempt to determine another\n\ -upper triangular matrix @var{R1} such that\n\ -\n\ -@itemize @bullet\n\ -@item\n\ -@var{R1}'*@var{R1} = @var{R}'*@var{R} + @var{u}*@var{u}'\n\ -if @var{op} is \"+\"\n\ -\n\ -@item\n\ -@var{R1}'*@var{R1} = @var{R}'*@var{R} - @var{u}*@var{u}'\n\ -if @var{op} is \"-\"\n\ -@end itemize\n\ -\n\ -If @var{op} is \"-\", @var{info} is set to\n\ -\n\ -@itemize\n\ -@item 0 if the downdate was successful,\n\ -\n\ -@item 1 if @var{R}'*@var{R} - @var{u}*@var{u}' is not positive definite,\n\ -\n\ -@item 2 if @var{R} is singular.\n\ -@end itemize\n\ -\n\ -If @var{info} is not present, an error message is printed in cases 1 and 2.\n\ -@seealso{chol, qrupdate}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - - octave_value_list retval; - - if (nargin > 3 || nargin < 2) - { - print_usage (); - return retval; - } - - octave_value argr = args(0); - octave_value argu = args(1); - - if (argr.is_numeric_type () && argu.is_numeric_type () - && (nargin < 3 || args(2).is_string ())) - { - octave_idx_type n = argr.rows (); - - std::string op = (nargin < 3) ? "+" : args(2).string_value (); - - bool down = op == "-"; - - if (down || op == "+") - if (argr.columns () == n && argu.rows () == n && argu.columns () == 1) - { - int err = 0; - if (argr.is_single_type () || argu.is_single_type ()) - { - if (argr.is_real_type () && argu.is_real_type ()) - { - // real case - FloatMatrix R = argr.float_matrix_value (); - FloatColumnVector u = argu.float_column_vector_value (); - - FloatCHOL fact; - fact.set (R); - - if (down) - err = fact.downdate (u); - else - fact.update (u); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - FloatComplexMatrix R = argr.float_complex_matrix_value (); - FloatComplexColumnVector u = argu.float_complex_column_vector_value (); - - FloatComplexCHOL fact; - fact.set (R); - - if (down) - err = fact.downdate (u); - else - fact.update (u); - - retval(0) = get_chol_r (fact); - } - } - else - { - if (argr.is_real_type () && argu.is_real_type ()) - { - // real case - Matrix R = argr.matrix_value (); - ColumnVector u = argu.column_vector_value (); - - CHOL fact; - fact.set (R); - - if (down) - err = fact.downdate (u); - else - fact.update (u); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - ComplexMatrix R = argr.complex_matrix_value (); - ComplexColumnVector u = argu.complex_column_vector_value (); - - ComplexCHOL fact; - fact.set (R); - - if (down) - err = fact.downdate (u); - else - fact.update (u); - - retval(0) = get_chol_r (fact); - } - } - - if (nargout > 1) - retval(1) = err; - else if (err == 1) - error ("cholupdate: downdate violates positiveness"); - else if (err == 2) - error ("cholupdate: singular matrix"); - } - else - error ("cholupdate: dimension mismatch between R and U"); - else - error ("cholupdate: OP must be \"+\" or \"-\""); - } - else - print_usage (); - - return retval; -} - -/* -%!shared A, u, Ac, uc -%! A = [ 0.436997 -0.131721 0.124120 -0.061673 ; -%! -0.131721 0.738529 0.019851 -0.140295 ; -%! 0.124120 0.019851 0.354879 -0.059472 ; -%! -0.061673 -0.140295 -0.059472 0.600939 ]; -%! -%! u = [ 0.98950 ; -%! 0.39844 ; -%! 0.63484 ; -%! 0.13351 ]; -%! Ac = [ 0.5585528 + 0.0000000i -0.1662088 - 0.0315341i 0.0107873 + 0.0236411i -0.0276775 - 0.0186073i ; -%! -0.1662088 + 0.0315341i 0.6760061 + 0.0000000i 0.0011452 - 0.0475528i 0.0145967 + 0.0247641i ; -%! 0.0107873 - 0.0236411i 0.0011452 + 0.0475528i 0.6263149 - 0.0000000i -0.1585837 - 0.0719763i ; -%! -0.0276775 + 0.0186073i 0.0145967 - 0.0247641i -0.1585837 + 0.0719763i 0.6034234 - 0.0000000i ]; -%! -%! uc = [ 0.54267 + 0.91519i ; -%! 0.99647 + 0.43141i ; -%! 0.83760 + 0.68977i ; -%! 0.39160 + 0.90378i ]; - -%!test -%! R = chol (A); -%! R1 = cholupdate (R, u); -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - R'*R - u*u', Inf) < 1e1*eps); -%! -%! R1 = cholupdate (R1, u, "-"); -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1 - R, Inf) < 1e1*eps); - -%!test -%! R = chol (Ac); -%! R1 = cholupdate (R, uc); -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - R'*R - uc*uc', Inf) < 1e1*eps); -%! -%! R1 = cholupdate (R1, uc, "-"); -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1 - R, Inf) < 1e1*eps); - -%!test -%! R = chol (single (A)); -%! R1 = cholupdate (R, single (u)); -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1'*R1 - R'*R - single (u*u'), Inf) < 1e1*eps ("single")); -%! -%! R1 = cholupdate (R1, single (u), "-"); -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1 - R, Inf) < 2e1*eps ("single")); - -%!test -%! R = chol (single (Ac)); -%! R1 = cholupdate (R, single (uc)); -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1'*R1 - R'*R - single (uc*uc'), Inf) < 1e1*eps ("single")); -%! -%! R1 = cholupdate (R1, single (uc), "-"); -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1 - R, Inf) < 2e1*eps ("single")); -*/ - -DEFUN_DLD (cholinsert, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{R1} =} cholinsert (@var{R}, @var{j}, @var{u})\n\ -@deftypefnx {Loadable Function} {[@var{R1}, @var{info}] =} cholinsert (@var{R}, @var{j}, @var{u})\n\ -Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ -positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ -triangular, return the Cholesky@tie{}factorization of\n\ -@var{A1}, where @w{A1(p,p) = A}, @w{A1(:,j) = A1(j,:)' = u} and\n\ -@w{p = [1:j-1,j+1:n+1]}. @w{u(j)} should be positive.\n\ -On return, @var{info} is set to\n\ -\n\ -@itemize\n\ -@item 0 if the insertion was successful,\n\ -\n\ -@item 1 if @var{A1} is not positive definite,\n\ -\n\ -@item 2 if @var{R} is singular.\n\ -@end itemize\n\ -\n\ -If @var{info} is not present, an error message is printed in cases 1 and 2.\n\ -@seealso{chol, cholupdate, choldelete}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - - octave_value_list retval; - - if (nargin != 3) - { - print_usage (); - return retval; - } - - octave_value argr = args(0); - octave_value argj = args(1); - octave_value argu = args(2); - - if (argr.is_numeric_type () && argu.is_numeric_type () - && argj.is_real_scalar ()) - { - octave_idx_type n = argr.rows (); - octave_idx_type j = argj.scalar_value (); - - if (argr.columns () == n && argu.rows () == n+1 && argu.columns () == 1) - { - if (j > 0 && j <= n+1) - { - int err = 0; - if (argr.is_single_type () || argu.is_single_type ()) - { - if (argr.is_real_type () && argu.is_real_type ()) - { - // real case - FloatMatrix R = argr.float_matrix_value (); - FloatColumnVector u = argu.float_column_vector_value (); - - FloatCHOL fact; - fact.set (R); - err = fact.insert_sym (u, j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - FloatComplexMatrix R = argr.float_complex_matrix_value (); - FloatComplexColumnVector u = argu.float_complex_column_vector_value (); - - FloatComplexCHOL fact; - fact.set (R); - err = fact.insert_sym (u, j-1); - - retval(0) = get_chol_r (fact); - } - } - else - { - if (argr.is_real_type () && argu.is_real_type ()) - { - // real case - Matrix R = argr.matrix_value (); - ColumnVector u = argu.column_vector_value (); - - CHOL fact; - fact.set (R); - err = fact.insert_sym (u, j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - ComplexMatrix R = argr.complex_matrix_value (); - ComplexColumnVector u = argu.complex_column_vector_value (); - - ComplexCHOL fact; - fact.set (R); - err = fact.insert_sym (u, j-1); - - retval(0) = get_chol_r (fact); - } - } - - if (nargout > 1) - retval(1) = err; - else if (err == 1) - error ("cholinsert: insertion violates positiveness"); - else if (err == 2) - error ("cholinsert: singular matrix"); - else if (err == 3) - error ("cholinsert: diagonal element must be real"); - } - else - error ("cholinsert: index J out of range"); - } - else - error ("cholinsert: dimension mismatch between R and U"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! u2 = [ 0.35080 ; -%! 0.63930 ; -%! 3.31057 ; -%! -0.13825 ; -%! 0.45266 ]; -%! -%! R = chol (A); -%! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert (R, j, u2); -%! A1 = R1'*R1; -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (A1(p,p) - A, Inf) < 1e1*eps); - -%!test -%! u2 = [ 0.35080 + 0.04298i; -%! 0.63930 + 0.23778i; -%! 3.31057 + 0.00000i; -%! -0.13825 + 0.19879i; -%! 0.45266 + 0.50020i]; -%! -%! R = chol (Ac); -%! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert (R, j, u2); -%! A1 = R1'*R1; -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (A1(p,p) - Ac, Inf) < 1e1*eps); - -%!test -%! u2 = single ([ 0.35080 ; -%! 0.63930 ; -%! 3.31057 ; -%! -0.13825 ; -%! 0.45266 ]); -%! -%! R = chol (single (A)); -%! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert (R, j, u2); -%! A1 = R1'*R1; -%! -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (A1(p,p) - A, Inf) < 1e1*eps ("single")); - -%!test -%! u2 = single ([ 0.35080 + 0.04298i; -%! 0.63930 + 0.23778i; -%! 3.31057 + 0.00000i; -%! -0.13825 + 0.19879i; -%! 0.45266 + 0.50020i]); -%! -%! R = chol (single (Ac)); -%! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert (R, j, u2); -%! A1 = R1'*R1; -%! -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (A1(p,p) - single (Ac), Inf) < 2e1*eps ("single")); - -%!test -%! cu = chol (triu (A), "upper"); -%! cl = chol (tril (A), "lower"); -%! assert (cu, cl', eps); - -%!test -%! cca = chol (Ac); -%! -%! ccal = chol (Ac, "lower"); -%! ccal2 = chol (tril (Ac), "lower"); -%! -%! ccau = chol (Ac, "upper"); -%! ccau2 = chol (triu (Ac), "upper"); -%! -%! assert (cca'*cca, Ac, eps); -%! assert (ccau'*ccau, Ac, eps); -%! assert (ccau2'*ccau2, Ac, eps); -%! -%! assert (cca, ccal', eps); -%! assert (cca, ccau, eps); -%! assert (cca, ccal2', eps); -%! assert (cca, ccau2, eps); - -%!test -%! cca = chol (single (Ac)); -%! -%! ccal = chol (single (Ac), "lower"); -%! ccal2 = chol (tril (single (Ac)), "lower"); -%! -%! ccau = chol (single (Ac), "upper"); -%! ccau2 = chol (triu (single (Ac)), "upper"); -%! -%! assert (cca'*cca, single (Ac), eps ("single")); -%! assert (ccau'*ccau, single (Ac), eps ("single")); -%! assert (ccau2'*ccau2, single (Ac), eps ("single")); -%! -%! assert (cca, ccal', eps ("single")); -%! assert (cca, ccau, eps ("single")); -%! assert (cca, ccal2', eps ("single")); -%! assert (cca, ccau2, eps ("single")); - -%!test -%! a = [12, 2, 3, 4; -%! 2, 14, 5, 3; -%! 3, 5, 16, 6; -%! 4, 3, 6, 16]; -%! -%! b = [0, 1, 2, 3; -%! -1, 0, 1, 2; -%! -2, -1, 0, 1; -%! -3, -2, -1, 0]; -%! -%! ca = a + i*b; -%! -%! cca = chol (ca); -%! -%! ccal = chol (ca, "lower"); -%! ccal2 = chol (tril (ca), "lower"); -%! -%! ccau = chol (ca, "upper"); -%! ccau2 = chol (triu (ca), "upper"); -%! -%! assert (cca'*cca, ca, 16*eps); -%! assert (ccau'*ccau, ca, 16*eps); -%! assert (ccau2'*ccau2, ca, 16*eps); -%! -%! assert (cca, ccal', 16*eps); -%! assert (cca, ccau, 16*eps); -%! assert (cca, ccal2', 16*eps); -%! assert (cca, ccau2, 16*eps); -*/ - -DEFUN_DLD (choldelete, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{R1} =} choldelete (@var{R}, @var{j})\n\ -Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ -positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ -triangular, return the Cholesky@tie{}factorization of @w{A(p,p)}, where\n\ -@w{p = [1:j-1,j+1:n+1]}.\n\ -@seealso{chol, cholupdate, cholinsert}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - - octave_value_list retval; - - if (nargin != 2) - { - print_usage (); - return retval; - } - - octave_value argr = args(0); - octave_value argj = args(1); - - if (argr.is_numeric_type () && argj.is_real_scalar ()) - { - octave_idx_type n = argr.rows (); - octave_idx_type j = argj.scalar_value (); - - if (argr.columns () == n) - { - if (j > 0 && j <= n) - { - if (argr.is_single_type ()) - { - if (argr.is_real_type ()) - { - // real case - FloatMatrix R = argr.float_matrix_value (); - - FloatCHOL fact; - fact.set (R); - fact.delete_sym (j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - FloatComplexMatrix R = argr.float_complex_matrix_value (); - - FloatComplexCHOL fact; - fact.set (R); - fact.delete_sym (j-1); - - retval(0) = get_chol_r (fact); - } - } - else - { - if (argr.is_real_type ()) - { - // real case - Matrix R = argr.matrix_value (); - - CHOL fact; - fact.set (R); - fact.delete_sym (j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - ComplexMatrix R = argr.complex_matrix_value (); - - ComplexCHOL fact; - fact.set (R); - fact.delete_sym (j-1); - - retval(0) = get_chol_r (fact); - } - } - } - else - error ("choldelete: index J out of range"); - } - else - error ("choldelete: matrix R must be square"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! R = chol (A); -%! -%! j = 3; p = [1:j-1,j+1:4]; -%! R1 = choldelete (R, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); - -%!test -%! R = chol (Ac); -%! -%! j = 3; p = [1:j-1,j+1:4]; -%! R1 = choldelete (R, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); - -%!test -%! R = chol (single (A)); -%! -%! j = 3; p = [1:j-1,j+1:4]; -%! R1 = choldelete (R, j); -%! -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); - -%!test -%! R = chol (single (Ac)); -%! -%! j = 3; p = [1:j-1,j+1:4]; -%! R1 = choldelete (R,j); -%! -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); -*/ - -DEFUN_DLD (cholshift, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{R1} =} cholshift (@var{R}, @var{i}, @var{j})\n\ -Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ -positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ -triangular, return the Cholesky@tie{}factorization of\n\ -@w{@var{A}(p,p)}, where @w{p} is the permutation @*\n\ -@code{p = [1:i-1, shift(i:j, 1), j+1:n]} if @w{@var{i} < @var{j}} @*\n\ - or @*\n\ -@code{p = [1:j-1, shift(j:i,-1), i+1:n]} if @w{@var{j} < @var{i}}. @*\n\ -\n\ -@seealso{chol, cholinsert, choldelete}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - - octave_value_list retval; - - if (nargin != 3) - { - print_usage (); - return retval; - } - - octave_value argr = args(0); - octave_value argi = args(1); - octave_value argj = args(2); - - if (argr.is_numeric_type () && argi.is_real_scalar () && argj.is_real_scalar ()) - { - octave_idx_type n = argr.rows (); - octave_idx_type i = argi.scalar_value (); - octave_idx_type j = argj.scalar_value (); - - if (argr.columns () == n) - { - if (j > 0 && j <= n+1 && i > 0 && i <= n+1) - { - - if (argr.is_single_type () && argi.is_single_type () && - argj.is_single_type ()) - { - if (argr.is_real_type ()) - { - // real case - FloatMatrix R = argr.float_matrix_value (); - - FloatCHOL fact; - fact.set (R); - fact.shift_sym (i-1, j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - FloatComplexMatrix R = argr.float_complex_matrix_value (); - - FloatComplexCHOL fact; - fact.set (R); - fact.shift_sym (i-1, j-1); - - retval(0) = get_chol_r (fact); - } - } - else - { - if (argr.is_real_type ()) - { - // real case - Matrix R = argr.matrix_value (); - - CHOL fact; - fact.set (R); - fact.shift_sym (i-1, j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - ComplexMatrix R = argr.complex_matrix_value (); - - ComplexCHOL fact; - fact.set (R); - fact.shift_sym (i-1, j-1); - - retval(0) = get_chol_r (fact); - } - } - } - else - error ("cholshift: index I or J is out of range"); - } - else - error ("cholshift: R must be a square matrix"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! R = chol (A); -%! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); -%! -%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1) - R1, Inf), 0); -%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); - -%!test -%! R = chol (Ac); -%! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); -%! -%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); - -%!test -%! R = chol (single (A)); -%! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); -%! -%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); - -%!test -%! R = chol (single (Ac)); -%! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); -%! -%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); -*/ diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/colamd.cc --- a/src/DLD-FUNCTIONS/colamd.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,768 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// This is the octave interface to colamd, which bore the copyright given -// in the help of the functions. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "ov.h" -#include "defun-dld.h" -#include "pager.h" -#include "ov-re-mat.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -#include "oct-sparse.h" -#include "oct-locbuf.h" - -#ifdef IDX_TYPE_LONG -#define COLAMD_NAME(name) colamd_l ## name -#define SYMAMD_NAME(name) symamd_l ## name -#else -#define COLAMD_NAME(name) colamd ## name -#define SYMAMD_NAME(name) symamd ## name -#endif - -// The symmetric column elimination tree code take from the Davis LDL code. -// Copyright given elsewhere in this file. -static void -symetree (const octave_idx_type *ridx, const octave_idx_type *cidx, - octave_idx_type *Parent, octave_idx_type *P, octave_idx_type n) -{ - OCTAVE_LOCAL_BUFFER (octave_idx_type, Flag, n); - OCTAVE_LOCAL_BUFFER (octave_idx_type, Pinv, (P ? n : 0)); - if (P) - // If P is present then compute Pinv, the inverse of P - for (octave_idx_type k = 0 ; k < n ; k++) - Pinv[P[k]] = k ; - - for (octave_idx_type k = 0 ; k < n ; k++) - { - // L(k,:) pattern: all nodes reachable in etree from nz in A(0:k-1,k) - Parent[k] = n ; // parent of k is not yet known - Flag[k] = k ; // mark node k as visited - octave_idx_type kk = (P) ? (P[k]) : (k) ; // kth original, or permuted, column - octave_idx_type p2 = cidx[kk+1] ; - for (octave_idx_type p = cidx[kk] ; p < p2 ; p++) - { - // A (i,k) is nonzero (original or permuted A) - octave_idx_type i = (Pinv) ? (Pinv[ridx[p]]) : (ridx[p]) ; - if (i < k) - { - // follow path from i to root of etree, stop at flagged node - for ( ; Flag[i] != k ; i = Parent[i]) - { - // find parent of i if not yet determined - if (Parent[i] == n) - Parent[i] = k ; - Flag[i] = k ; // mark i as visited - } - } - } - } -} - -// The elimination tree post-ordering code below is taken from SuperLU -static inline octave_idx_type -make_set (octave_idx_type i, octave_idx_type *pp) -{ - pp[i] = i; - return i; -} - -static inline octave_idx_type -link (octave_idx_type s, octave_idx_type t, octave_idx_type *pp) -{ - pp[s] = t; - return t; -} - -static inline octave_idx_type -find (octave_idx_type i, octave_idx_type *pp) -{ - register octave_idx_type p, gp; - - p = pp[i]; - gp = pp[p]; - - while (gp != p) - { - pp[i] = gp; - i = gp; - p = pp[i]; - gp = pp[p]; - } - - return p; -} - -static octave_idx_type -etdfs (octave_idx_type v, octave_idx_type *first_kid, - octave_idx_type *next_kid, octave_idx_type *post, - octave_idx_type postnum) -{ - for (octave_idx_type w = first_kid[v]; w != -1; w = next_kid[w]) - postnum = etdfs (w, first_kid, next_kid, post, postnum); - - post[postnum++] = v; - - return postnum; -} - -static void -tree_postorder (octave_idx_type n, octave_idx_type *parent, - octave_idx_type *post) -{ - // Allocate storage for working arrays and results - OCTAVE_LOCAL_BUFFER (octave_idx_type, first_kid, n+1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, next_kid, n+1); - - // Set up structure describing children - for (octave_idx_type v = 0; v <= n; first_kid[v++] = -1) - /* do nothing */; - - for (octave_idx_type v = n-1; v >= 0; v--) - { - octave_idx_type dad = parent[v]; - next_kid[v] = first_kid[dad]; - first_kid[dad] = v; - } - - // Depth-first search from dummy root vertex #n - etdfs (n, first_kid, next_kid, post, 0); -} - -static void -coletree (const octave_idx_type *ridx, const octave_idx_type *colbeg, - octave_idx_type *colend, octave_idx_type *parent, - octave_idx_type nr, octave_idx_type nc) -{ - OCTAVE_LOCAL_BUFFER (octave_idx_type, root, nc); - OCTAVE_LOCAL_BUFFER (octave_idx_type, pp, nc); - OCTAVE_LOCAL_BUFFER (octave_idx_type, firstcol, nr); - - // Compute firstcol[row] = first nonzero column in row - for (octave_idx_type row = 0; row < nr; firstcol[row++] = nc) - /* do nothing */; - - for (octave_idx_type col = 0; col < nc; col++) - for (octave_idx_type p = colbeg[col]; p < colend[col]; p++) - { - octave_idx_type row = ridx[p]; - if (firstcol[row] > col) - firstcol[row] = col; - } - - // Compute etree by Liu's algorithm for symmetric matrices, - // except use (firstcol[r],c) in place of an edge (r,c) of A. - // Thus each row clique in A'*A is replaced by a star - // centered at its first vertex, which has the same fill. - for (octave_idx_type col = 0; col < nc; col++) - { - octave_idx_type cset = make_set (col, pp); - root[cset] = col; - parent[col] = nc; - for (octave_idx_type p = colbeg[col]; p < colend[col]; p++) - { - octave_idx_type row = firstcol[ridx[p]]; - if (row >= col) - continue; - octave_idx_type rset = find (row, pp); - octave_idx_type rroot = root[rset]; - if (rroot != col) - { - parent[rroot] = col; - cset = link (cset, rset, pp); - root[cset] = col; - } - } - } -} - -DEFUN_DLD (colamd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} colamd (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} colamd (@var{S}, @var{knobs})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} colamd (@var{S})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} colamd (@var{S}, @var{knobs})\n\ -\n\ -Column approximate minimum degree permutation.\n\ -@code{@var{p} = colamd (@var{S})} returns the column approximate minimum\n\ -degree permutation vector for the sparse matrix @var{S}. For a\n\ -non-symmetric matrix @var{S}, @code{@var{S}(:,@var{p})} tends to have\n\ -sparser LU@tie{}factors than @var{S}. The Cholesky@tie{}factorization of\n\ -@code{@var{S}(:,@var{p})' * @var{S}(:,@var{p})} also tends to be sparser\n\ -than that of @code{@var{S}' * @var{S}}.\n\ -\n\ -@var{knobs} is an optional one- to three-element input vector. If @var{S} is\n\ -m-by-n, then rows with more than @code{max(16,@var{knobs}(1)*sqrt(n))}\n\ -entries are ignored. Columns with more than\n\ -@code{max (16,@var{knobs}(2)*sqrt(min(m,n)))} entries are removed prior to\n\ -ordering, and ordered last in the output permutation @var{p}. Only\n\ -completely dense rows or columns are removed if @code{@var{knobs}(1)} and\n\ -@code{@var{knobs}(2)} are < 0, respectively. If @code{@var{knobs}(3)} is\n\ -nonzero, @var{stats} and @var{knobs} are printed. The default is\n\ -@code{@var{knobs} = [10 10 0]}. Note that @var{knobs} differs from earlier\n\ -versions of colamd.\n\ -\n\ -@var{stats} is an optional 20-element output vector that provides data\n\ -about the ordering and the validity of the input matrix @var{S}. Ordering\n\ -statistics are in @code{@var{stats}(1:3)}. @code{@var{stats}(1)} and\n\ -@code{@var{stats}(2)} are the number of dense or empty rows and columns\n\ -ignored by @sc{colamd} and @code{@var{stats}(3)} is the number of garbage\n\ -collections performed on the internal data structure used by @sc{colamd}\n\ -(roughly of size @code{2.2 * nnz(@var{S}) + 4 * @var{m} + 7 * @var{n}}\n\ -integers).\n\ -\n\ -Octave built-in functions are intended to generate valid sparse matrices,\n\ -with no duplicate entries, with ascending row indices of the nonzeros\n\ -in each column, with a non-negative number of entries in each column (!)\n\ -and so on. If a matrix is invalid, then @sc{colamd} may or may not be able\n\ -to continue. If there are duplicate entries (a row index appears two or\n\ -more times in the same column) or if the row indices in a column are out\n\ -of order, then @sc{colamd} can correct these errors by ignoring the duplicate\n\ -entries and sorting each column of its internal copy of the matrix\n\ -@var{S} (the input matrix @var{S} is not repaired, however). If a matrix\n\ -is invalid in other ways then @sc{colamd} cannot continue, an error message\n\ -is printed, and no output arguments (@var{p} or @var{stats}) are returned.\n\ -@sc{colamd} is thus a simple way to check a sparse matrix to see if it's\n\ -valid.\n\ -\n\ -@code{@var{stats}(4:7)} provide information if COLAMD was able to\n\ -continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ -invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ -unsorted or contains duplicate entries, or zero if no such column exists.\n\ -@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ -index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ -such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ -or out-of-order row indices. @code{@var{stats}(8:20)} is always zero in\n\ -the current version of @sc{colamd} (reserved for future use).\n\ -\n\ -The ordering is followed by a column elimination tree post-ordering.\n\ -\n\ -The authors of the code itself are Stefan I. Larimore and Timothy A.\n\ -Davis @email{davis@@cise.ufl.edu}, University of Florida. The algorithm was\n\ -developed in collaboration with John Gilbert, Xerox PARC, and Esmond\n\ -Ng, Oak Ridge National Laboratory. (see\n\ -@url{http://www.cise.ufl.edu/research/sparse/colamd})\n\ -@seealso{colperm, symamd, ccolamd}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_COLAMD - - int nargin = args.length (); - int spumoni = 0; - - if (nargout > 2 || nargin < 1 || nargin > 2) - print_usage (); - else - { - // Get knobs - OCTAVE_LOCAL_BUFFER (double, knobs, COLAMD_KNOBS); - COLAMD_NAME (_set_defaults) (knobs); - - // Check for user-passed knobs - if (nargin == 2) - { - NDArray User_knobs = args(1).array_value (); - int nel_User_knobs = User_knobs.length (); - - if (nel_User_knobs > 0) - knobs[COLAMD_DENSE_ROW] = User_knobs(0); - if (nel_User_knobs > 1) - knobs[COLAMD_DENSE_COL] = User_knobs(1) ; - if (nel_User_knobs > 2) - spumoni = static_cast (User_knobs(2)); - - // print knob settings if spumoni is set - if (spumoni) - { - - octave_stdout << "\ncolamd version " << COLAMD_MAIN_VERSION << "." - << COLAMD_SUB_VERSION << ", " << COLAMD_DATE << ":\n"; - - if (knobs[COLAMD_DENSE_ROW] >= 0) - octave_stdout << "knobs(1): " << User_knobs (0) - << ", rows with > max (16," - << knobs[COLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" - << " entries removed\n"; - else - octave_stdout << "knobs(1): " << User_knobs (0) - << ", only completely dense rows removed\n"; - - if (knobs[COLAMD_DENSE_COL] >= 0) - octave_stdout << "knobs(2): " << User_knobs (1) - << ", cols with > max (16," - << knobs[COLAMD_DENSE_COL] << "*sqrt (size(A)))" - << " entries removed\n"; - else - octave_stdout << "knobs(2): " << User_knobs (1) - << ", only completely dense columns removed\n"; - - octave_stdout << "knobs(3): " << User_knobs (2) - << ", statistics and knobs printed\n"; - - } - } - - octave_idx_type n_row, n_col, nnz; - octave_idx_type *ridx, *cidx; - SparseComplexMatrix scm; - SparseMatrix sm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0). sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - nnz = scm.nnz (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - - n_row = sm.rows (); - n_col = sm.cols (); - nnz = sm.nnz (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - } - else - { - if (args(0).is_complex_type ()) - sm = SparseMatrix (real (args(0).complex_matrix_value ())); - else - sm = SparseMatrix (args(0).matrix_value ()); - - n_row = sm.rows (); - n_col = sm.cols (); - nnz = sm.nnz (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - // Allocate workspace for colamd - OCTAVE_LOCAL_BUFFER (octave_idx_type, p, n_col+1); - for (octave_idx_type i = 0; i < n_col+1; i++) - p[i] = cidx[i]; - - octave_idx_type Alen = COLAMD_NAME (_recommended) (nnz, n_row, n_col); - OCTAVE_LOCAL_BUFFER (octave_idx_type, A, Alen); - for (octave_idx_type i = 0; i < nnz; i++) - A[i] = ridx[i]; - - // Order the columns (destroys A) - OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, COLAMD_STATS); - if (! COLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats)) - { - COLAMD_NAME (_report) (stats) ; - error ("colamd: internal error!"); - return retval; - } - - // column elimination tree post-ordering (reuse variables) - OCTAVE_LOCAL_BUFFER (octave_idx_type, colbeg, n_col + 1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, colend, n_col + 1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); - - for (octave_idx_type i = 0; i < n_col; i++) - { - colbeg[i] = cidx[p[i]]; - colend[i] = cidx[p[i]+1]; - } - - coletree (ridx, colbeg, colend, etree, n_row, n_col); - - // Calculate the tree post-ordering - tree_postorder (n_col, etree, colbeg); - - // return the permutation vector - NDArray out_perm (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - out_perm(i) = p[colbeg[i]] + 1; - - retval(0) = out_perm; - - // print stats if spumoni > 0 - if (spumoni > 0) - COLAMD_NAME (_report) (stats) ; - - // Return the stats vector - if (nargout == 2) - { - NDArray out_stats (dim_vector (1, COLAMD_STATS)); - for (octave_idx_type i = 0 ; i < COLAMD_STATS ; i++) - out_stats(i) = stats[i] ; - retval(1) = out_stats; - - // fix stats (5) and (6), for 1-based information on - // jumbled matrix. note that this correction doesn't - // occur if symamd returns FALSE - out_stats (COLAMD_INFO1) ++ ; - out_stats (COLAMD_INFO2) ++ ; - } - } - -#else - - error ("colamd: not available in this version of Octave"); - -#endif - - return retval; -} - -DEFUN_DLD (symamd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} symamd (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} symamd (@var{S}, @var{knobs})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} symamd (@var{S})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} symamd (@var{S}, @var{knobs})\n\ -\n\ -For a symmetric positive definite matrix @var{S}, returns the permutation\n\ -vector p such that @code{@var{S}(@var{p}, @var{p})} tends to have a\n\ -sparser Cholesky@tie{}factor than @var{S}. Sometimes @code{symamd} works\n\ -well for symmetric indefinite matrices too. The matrix @var{S} is assumed\n\ -to be symmetric; only the strictly lower triangular part is referenced.\n\ -@var{S} must be square.\n\ -\n\ -@var{knobs} is an optional one- to two-element input vector. If @var{S} is\n\ -n-by-n, then rows and columns with more than\n\ -@code{max (16,@var{knobs}(1)*sqrt(n))} entries are removed prior to ordering,\n\ -and ordered last in the output permutation @var{p}. No rows/columns are\n\ -removed if @code{@var{knobs}(1) < 0}. If @code{@var{knobs} (2)} is nonzero,\n\ -@code{stats} and @var{knobs} are printed. The default is @code{@var{knobs}\n\ -= [10 0]}. Note that @var{knobs} differs from earlier versions of symamd.\n\ -\n\ -@var{stats} is an optional 20-element output vector that provides data\n\ -about the ordering and the validity of the input matrix @var{S}. Ordering\n\ -statistics are in @code{@var{stats}(1:3)}. @code{@var{stats}(1) =\n\ -@var{stats}(2)} is the number of dense or empty rows and columns\n\ -ignored by SYMAMD and @code{@var{stats}(3)} is the number of garbage\n\ -collections performed on the internal data structure used by SYMAMD\n\ -(roughly of size @code{8.4 * nnz (tril (@var{S}, -1)) + 9 * @var{n}}\n\ -integers).\n\ -\n\ -Octave built-in functions are intended to generate valid sparse matrices,\n\ -with no duplicate entries, with ascending row indices of the nonzeros\n\ -in each column, with a non-negative number of entries in each column (!)\n\ -and so on. If a matrix is invalid, then SYMAMD may or may not be able\n\ -to continue. If there are duplicate entries (a row index appears two or\n\ -more times in the same column) or if the row indices in a column are out\n\ -of order, then SYMAMD can correct these errors by ignoring the duplicate\n\ -entries and sorting each column of its internal copy of the matrix S (the\n\ -input matrix S is not repaired, however). If a matrix is invalid in\n\ -other ways then SYMAMD cannot continue, an error message is printed, and\n\ -no output arguments (@var{p} or @var{stats}) are returned. SYMAMD is\n\ -thus a simple way to check a sparse matrix to see if it's valid.\n\ -\n\ -@code{@var{stats}(4:7)} provide information if SYMAMD was able to\n\ -continue. The matrix is OK if @code{@var{stats} (4)} is zero, or 1\n\ -if invalid. @code{@var{stats}(5)} is the rightmost column index that\n\ -is unsorted or contains duplicate entries, or zero if no such column\n\ -exists. @code{@var{stats}(6)} is the last seen duplicate or out-of-order\n\ -row index in the column index given by @code{@var{stats}(5)}, or zero\n\ -if no such row index exists. @code{@var{stats}(7)} is the number of\n\ -duplicate or out-of-order row indices. @code{@var{stats}(8:20)} is\n\ -always zero in the current version of SYMAMD (reserved for future use).\n\ -\n\ -The ordering is followed by a column elimination tree post-ordering.\n\ -\n\ -The authors of the code itself are Stefan I. Larimore and Timothy A.\n\ -Davis @email{davis@@cise.ufl.edu}, University of Florida. The algorithm was\n\ -developed in collaboration with John Gilbert, Xerox PARC, and Esmond\n\ -Ng, Oak Ridge National Laboratory. (see\n\ -@url{http://www.cise.ufl.edu/research/sparse/colamd})\n\ -@seealso{colperm, colamd}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_COLAMD - - int nargin = args.length (); - int spumoni = 0; - - if (nargout > 2 || nargin < 1 || nargin > 2) - print_usage (); - else - { - // Get knobs - OCTAVE_LOCAL_BUFFER (double, knobs, COLAMD_KNOBS); - COLAMD_NAME (_set_defaults) (knobs); - - // Check for user-passed knobs - if (nargin == 2) - { - NDArray User_knobs = args(1).array_value (); - int nel_User_knobs = User_knobs.length (); - - if (nel_User_knobs > 0) - knobs[COLAMD_DENSE_ROW] = User_knobs(COLAMD_DENSE_ROW); - if (nel_User_knobs > 1) - spumoni = static_cast (User_knobs (1)); - } - - // print knob settings if spumoni is set - if (spumoni > 0) - octave_stdout << "symamd: dense row/col fraction: " - << knobs[COLAMD_DENSE_ROW] << std::endl; - - octave_idx_type n_row, n_col; - octave_idx_type *ridx, *cidx; - SparseMatrix sm; - SparseComplexMatrix scm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0).sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - } - else - { - if (args(0).is_complex_type ()) - sm = SparseMatrix (real (args(0).complex_matrix_value ())); - else - sm = SparseMatrix (args(0).matrix_value ()); - - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - if (n_row != n_col) - { - error ("symamd: matrix S must be square"); - return retval; - } - - // Allocate workspace for symamd - OCTAVE_LOCAL_BUFFER (octave_idx_type, perm, n_col+1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, COLAMD_STATS); - if (!SYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, &calloc, &free)) - { - SYMAMD_NAME (_report) (stats) ; - error ("symamd: internal error!") ; - return retval; - } - - // column elimination tree post-ordering - OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); - symetree (ridx, cidx, etree, perm, n_col); - - // Calculate the tree post-ordering - OCTAVE_LOCAL_BUFFER (octave_idx_type, post, n_col + 1); - tree_postorder (n_col, etree, post); - - // return the permutation vector - NDArray out_perm (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - out_perm(i) = perm[post[i]] + 1; - - retval(0) = out_perm; - - // print stats if spumoni > 0 - if (spumoni > 0) - SYMAMD_NAME (_report) (stats) ; - - // Return the stats vector - if (nargout == 2) - { - NDArray out_stats (dim_vector (1, COLAMD_STATS)); - for (octave_idx_type i = 0 ; i < COLAMD_STATS ; i++) - out_stats(i) = stats[i] ; - retval(1) = out_stats; - - // fix stats (5) and (6), for 1-based information on - // jumbled matrix. note that this correction doesn't - // occur if symamd returns FALSE - out_stats (COLAMD_INFO1) ++ ; - out_stats (COLAMD_INFO2) ++ ; - } - } - -#else - - error ("symamd: not available in this version of Octave"); - -#endif - - return retval; -} - -DEFUN_DLD (etree, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} etree (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} etree (@var{S}, @var{typ})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{q}] =} etree (@var{S}, @var{typ})\n\ -\n\ -Return the elimination tree for the matrix @var{S}. By default @var{S}\n\ -is assumed to be symmetric and the symmetric elimination tree is\n\ -returned. The argument @var{typ} controls whether a symmetric or\n\ -column elimination tree is returned. Valid values of @var{typ} are\n\ -\"sym\" or \"col\", for symmetric or column elimination tree respectively\n\ -\n\ -Called with a second argument, @code{etree} also returns the postorder\n\ -permutations on the tree.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargout > 2 || nargin < 1 || nargin > 2) - print_usage (); - else - { - octave_idx_type n_row, n_col; - octave_idx_type *ridx, *cidx; - bool is_sym = true; - SparseMatrix sm; - SparseComplexMatrix scm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0).sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - } - else - { - error ("etree: S must be a sparse matrix"); - return retval; - } - - if (nargin == 2) - { - if (args(1).is_string ()) - { - std::string str = args(1).string_value (); - if (str.find ("C") == 0 || str.find ("c") == 0) - is_sym = false; - } - else - { - error ("etree: TYP must be a string"); - return retval; - } - } - - // column elimination tree post-ordering (reuse variables) - OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); - - if (is_sym) - { - if (n_row != n_col) - { - error ("etree: S is marked as symmetric, but is not square"); - return retval; - } - - symetree (ridx, cidx, etree, 0, n_col); - } - else - { - OCTAVE_LOCAL_BUFFER (octave_idx_type, colbeg, n_col); - OCTAVE_LOCAL_BUFFER (octave_idx_type, colend, n_col); - - for (octave_idx_type i = 0; i < n_col; i++) - { - colbeg[i] = cidx[i]; - colend[i] = cidx[i+1]; - } - - coletree (ridx, colbeg, colend, etree, n_row, n_col); - } - - NDArray tree (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - // We flag a root with n_col while Matlab does it with zero - // Convert for matlab compatiable output - if (etree[i] == n_col) - tree(i) = 0; - else - tree(i) = etree[i] + 1; - - retval(0) = tree; - - if (nargout == 2) - { - // Calculate the tree post-ordering - OCTAVE_LOCAL_BUFFER (octave_idx_type, post, n_col + 1); - tree_postorder (n_col, etree, post); - - NDArray postorder (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - postorder(i) = post[i] + 1; - - retval(1) = postorder; - } - } - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/config-module.awk --- a/src/DLD-FUNCTIONS/config-module.awk Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,77 +0,0 @@ -BEGIN { - FS = "|"; - nfiles = 0; - - print "## DO NOT EDIT -- generated from module-files by config-module.awk"; - print "" - print "EXTRA_DIST += \\" - print " DLD-FUNCTIONS/config-module.sh \\" - print " DLD-FUNCTIONS/config-module.awk \\" - print " DLD-FUNCTIONS/module-files \\" - print " DLD-FUNCTIONS/oct-qhull.h" - print "" -} -/^#.*/ { next; } -{ - nfiles++; - files[nfiles] = $1; - cppflags[nfiles] = $2; - ldflags[nfiles] = $3; - libraries[nfiles] = $4; -} END { - sep = " \\\n"; - print "DLD_FUNCTIONS_SRC = \\"; - for (i = 1; i <= nfiles; i++) { - if (i == nfiles) - sep = "\n"; - printf (" DLD-FUNCTIONS/%s%s", files[i], sep); - } - print ""; - - sep = " \\\n"; - print "DLD_FUNCTIONS_LIBS = $(DLD_FUNCTIONS_SRC:.cc=.la)"; - print ""; - print "if AMCOND_ENABLE_DYNAMIC_LINKING"; - print ""; - print "octlib_LTLIBRARIES += $(DLD_FUNCTIONS_LIBS)"; - print ""; - print "## Use stamp files to avoid problems with checking timestamps"; - print "## of symbolic links"; - print ""; - for (i = 1; i <= nfiles; i++) { - basename = files[i]; - sub (/\.cc$/, "", basename); - printf ("DLD-FUNCTIONS/$(am__leading_dot)%s.oct-stamp: DLD-FUNCTIONS/%s.la\n", basename, basename); - print "\trm -f $(<:.la=.oct)"; - print "\tla=$( $dld_dir/module.mk-t - -$move_if_change $dld_dir/module.mk-t $dld_dir/module.mk diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/convhulln.cc --- a/src/DLD-FUNCTIONS/convhulln.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,316 +0,0 @@ -/* - -Copyright (C) 2000-2012 Kai Habel - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* -29. July 2000 - Kai Habel: first release -2002-04-22 Paul Kienzle -* Use warning(...) function rather than writing to cerr -2006-05-01 Tom Holroyd -* add support for consistent winding in all dimensions; output is -* guaranteed to be simplicial. -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "Cell.h" -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" -#include "parse.h" -#include "unwind-prot.h" - -#if defined (HAVE_QHULL) -# include "oct-qhull.h" -# if defined (NEED_QHULL_VERSION) -char qh_version[] = "convhulln.oct 2007-07-24"; -# endif -#endif - -static void -close_fcn (FILE *f) -{ - gnulib::fclose (f); -} - -DEFUN_DLD (convhulln, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{h} =} convhulln (@var{pts})\n\ -@deftypefnx {Loadable Function} {@var{h} =} convhulln (@var{pts}, @var{options})\n\ -@deftypefnx {Loadable Function} {[@var{h}, @var{v}] =} convhulln (@dots{})\n\ -Compute the convex hull of the set of points @var{pts} which is a matrix\n\ -of size [n, dim] containing n points in a space of dimension dim.\n\ -The hull @var{h} is an index vector into the set of points and specifies\n\ -which points form the enclosing hull.\n\ -\n\ -An optional second argument, which must be a string or cell array of strings,\n\ -contains options passed to the underlying qhull command.\n\ -See the documentation for the Qhull library for details\n\ -@url{http://www.qhull.org/html/qh-quick.htm#options}.\n\ -The default options depend on the dimension of the input:\n\ -\n\ -@itemize\n\ -@item 2D, 3D, 4D: @var{options} = @code{@{\"Qt\"@}}\n\ -\n\ -@item 5D and higher: @var{options} = @code{@{\"Qt\", \"Qx\"@}}\n\ -@end itemize\n\ -\n\ -If @var{options} is not present or @code{[]} then the default arguments are\n\ -used. Otherwise, @var{options} replaces the default argument list.\n\ -To append user options to the defaults it is necessary to repeat the\n\ -default arguments in @var{options}. Use a null string to pass no arguments.\n\ -\n\ -If the second output @var{v} is requested the volume of the enclosing\n\ -convex hull is calculated.\n\n\ -@seealso{convhull, delaunayn, voronoin}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#if defined (HAVE_QHULL) - - int nargin = args.length (); - if (nargin < 1 || nargin > 2) - { - print_usage (); - return retval; - } - - Matrix points (args(0).matrix_value ()); - const octave_idx_type dim = points.columns (); - const octave_idx_type num_points = points.rows (); - - points = points.transpose (); - - std::string options; - - if (dim <= 4) - options = " Qt"; - else - options = " Qt Qx"; - - if (nargin == 2) - { - if (args(1).is_string ()) - options = " " + args(1).string_value (); - else if (args(1).is_empty ()) - ; // Use default options. - else if (args(1).is_cellstr ()) - { - options = ""; - - Array tmp = args(1).cellstr_value (); - - for (octave_idx_type i = 0; i < tmp.numel (); i++) - options += " " + tmp(i); - } - else - { - error ("convhulln: OPTIONS must be a string, cell array of strings, or empty"); - return retval; - } - } - - boolT ismalloc = false; - - unwind_protect frame; - - // Replace the outfile pointer with stdout for debugging information. -#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) - FILE *outfile = gnulib::fopen ("NUL", "w"); -#else - FILE *outfile = gnulib::fopen ("/dev/null", "w"); -#endif - FILE *errfile = stderr; - - if (outfile) - frame.add_fcn (close_fcn, outfile); - else - { - error ("convhulln: unable to create temporary file for output"); - return retval; - } - - // qh_new_qhull command and points arguments are not const... - - std::string cmd = "qhull" + options; - - OCTAVE_LOCAL_BUFFER (char, cmd_str, cmd.length () + 1); - - strcpy (cmd_str, cmd.c_str ()); - - int exitcode = qh_new_qhull (dim, num_points, points.fortran_vec (), - ismalloc, cmd_str, outfile, errfile); - if (! exitcode) - { - bool nonsimp_seen = false; - - octave_idx_type nf = qh num_facets; - - Matrix idx (nf, dim + 1); - - facetT *facet; - - octave_idx_type i = 0; - - FORALLfacets - { - octave_idx_type j = 0; - - if (! nonsimp_seen && ! facet->simplicial) - { - nonsimp_seen = true; - - if (cmd.find ("QJ") != std::string::npos) - { - // Should never happen with QJ. - error ("convhulln: qhull failed: option 'QJ' returned non-simplicial facet"); - return retval; - } - } - - if (dim == 3) - { - setT *vertices = qh_facet3vertex (facet); - - vertexT *vertex, **vertexp; - - FOREACHvertex_ (vertices) - idx(i, j++) = 1 + qh_pointid(vertex->point); - - qh_settempfree (&vertices); - } - else - { - if (facet->toporient ^ qh_ORIENTclock) - { - vertexT *vertex, **vertexp; - - FOREACHvertex_ (facet->vertices) - idx(i, j++) = 1 + qh_pointid(vertex->point); - } - else - { - vertexT *vertex, **vertexp; - - FOREACHvertexreverse12_ (facet->vertices) - idx(i, j++) = 1 + qh_pointid(vertex->point); - } - } - if (j < dim) - warning ("convhulln: facet %d only has %d vertices", i, j); - - i++; - } - - // Remove extra dimension if all facets were simplicial. - - if (! nonsimp_seen) - idx.resize (nf, dim, 0.0); - - if (nargout == 2) - { - // Calculate volume of convex hull, taken from qhull src/geom2.c. - - realT area; - realT dist; - - FORALLfacets - { - if (! facet->normal) - continue; - - if (facet->upperdelaunay && qh ATinfinity) - continue; - - facet->f.area = area = qh_facetarea (facet); - facet->isarea = True; - - if (qh DELAUNAY) - { - if (facet->upperdelaunay == qh UPPERdelaunay) - qh totarea += area; - } - else - { - qh totarea += area; - qh_distplane (qh interior_point, facet, &dist); - qh totvol += -dist * area/ qh hull_dim; - } - } - - retval(1) = octave_value (qh totvol); - } - - retval(0) = idx; - } - else - error ("convhulln: qhull failed"); - - // Free memory from Qhull - qh_freeqhull (! qh_ALL); - - int curlong, totlong; - qh_memfreeshort (&curlong, &totlong); - - if (curlong || totlong) - warning ("convhulln: did not free %d bytes of long memory (%d pieces)", - totlong, curlong); - -#else - error ("convhulln: not available in this version of Octave"); -#endif - - return retval; -} - -/* -%!testif HAVE_QHULL -%! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; -%! [h, v] = convhulln (cube, "Qt"); -%! assert (size (h), [12 3]); -%! h = sortrows (sort (h, 2), [1:3]); -%! assert (h, [1 2 4; 1 2 6; 1 4 8; 1 5 6; 1 5 8; 2 3 4; 2 3 7; 2 6 7; 3 4 7; 4 7 8; 5 6 7; 5 7 8]); -%! assert (v, 1, 10*eps); -%! [h2, v2] = convhulln (cube); % Test defaut option = "Qt" -%! assert (size (h2), size (h)); -%! h2 = sortrows (sort (h2, 2), [1:3]); -%! assert (h2, h); -%! assert (v2, v, 10*eps); - -%!testif HAVE_QHULL -%! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; -%! [h, v] = convhulln (cube, "QJ"); -%! assert (size (h), [12 3]); -%! assert (sortrows (sort (h, 2), [1:3]), [1 2 4; 1 2 5; 1 4 5; 2 3 4; 2 3 6; 2 5 6; 3 4 8; 3 6 7; 3 7 8; 4 5 8; 5 6 8; 6 7 8]); -%! assert (v, 1.0, 1e6*eps); - -%!testif HAVE_QHULL -%! tetrahedron = [1 1 1;-1 -1 1;-1 1 -1;1 -1 -1]; -%! [h, v] = convhulln (tetrahedron); -%! h = sortrows (sort (h, 2), [1 2 3]); -%! assert (h, [1 2 3;1 2 4; 1 3 4; 2 3 4]); -%! assert (v, 8/3, 10*eps); -*/ diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/dmperm.cc --- a/src/DLD-FUNCTIONS/dmperm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,229 +0,0 @@ -/* - -Copyright (C) 2005-2012 David Bateman -Copyright (C) 1998-2005 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "utils.h" - -#include "oct-sparse.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "SparseQR.h" -#include "SparseCmplxQR.h" - -#ifdef IDX_TYPE_LONG -#define CXSPARSE_NAME(name) cs_dl ## name -#else -#define CXSPARSE_NAME(name) cs_di ## name -#endif - -static RowVector -put_int (octave_idx_type *p, octave_idx_type n) -{ - RowVector ret (n); - for (octave_idx_type i = 0; i < n; i++) - ret.xelem (i) = p[i] + 1; - return ret; -} - -#if HAVE_CXSPARSE -static octave_value_list -dmperm_internal (bool rank, const octave_value arg, int nargout) -{ - octave_value_list retval; - octave_idx_type nr = arg.rows (); - octave_idx_type nc = arg.columns (); - SparseMatrix m; - SparseComplexMatrix cm; - CXSPARSE_NAME () csm; - csm.m = nr; - csm.n = nc; - csm.x = 0; - csm.nz = -1; - - if (arg.is_real_type ()) - { - m = arg.sparse_matrix_value (); - csm.nzmax = m.nnz (); - csm.p = m.xcidx (); - csm.i = m.xridx (); - } - else - { - cm = arg.sparse_complex_matrix_value (); - csm.nzmax = cm.nnz (); - csm.p = cm.xcidx (); - csm.i = cm.xridx (); - } - - if (!error_state) - { - if (nargout <= 1 || rank) - { -#if defined(CS_VER) && (CS_VER >= 2) - octave_idx_type *jmatch = CXSPARSE_NAME (_maxtrans) (&csm, 0); -#else - octave_idx_type *jmatch = CXSPARSE_NAME (_maxtrans) (&csm); -#endif - if (rank) - { - octave_idx_type r = 0; - for (octave_idx_type i = 0; i < nc; i++) - if (jmatch[nr+i] >= 0) - r++; - retval(0) = static_cast(r); - } - else - retval(0) = put_int (jmatch + nr, nc); - CXSPARSE_NAME (_free) (jmatch); - } - else - { -#if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_NAME (d) *dm = CXSPARSE_NAME(_dmperm) (&csm, 0); -#else - CXSPARSE_NAME (d) *dm = CXSPARSE_NAME(_dmperm) (&csm); -#endif - - //retval(5) = put_int (dm->rr, 5); - //retval(4) = put_int (dm->cc, 5); -#if defined(CS_VER) && (CS_VER >= 2) - retval(3) = put_int (dm->s, dm->nb+1); - retval(2) = put_int (dm->r, dm->nb+1); - retval(1) = put_int (dm->q, nc); - retval(0) = put_int (dm->p, nr); -#else - retval(3) = put_int (dm->S, dm->nb+1); - retval(2) = put_int (dm->R, dm->nb+1); - retval(1) = put_int (dm->Q, nc); - retval(0) = put_int (dm->P, nr); -#endif - CXSPARSE_NAME (_dfree) (dm); - } - } - return retval; -} -#endif - -DEFUN_DLD (dmperm, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} dmperm (@var{S})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{q}, @var{r}, @var{S}] =} dmperm (@var{S})\n\ -\n\ -@cindex Dulmage-Mendelsohn decomposition\n\ -Perform a Dulmage-Mendelsohn permutation of the sparse matrix @var{S}.\n\ -With a single output argument @code{dmperm} performs the row permutations\n\ -@var{p} such that @code{@var{S}(@var{p},:)} has no zero elements on the\n\ -diagonal.\n\ -\n\ -Called with two or more output arguments, returns the row and column\n\ -permutations, such that @code{@var{S}(@var{p}, @var{q})} is in block\n\ -triangular form. The values of @var{r} and @var{S} define the boundaries\n\ -of the blocks. If @var{S} is square then @code{@var{r} == @var{S}}.\n\ -\n\ -The method used is described in: A. Pothen & C.-J. Fan. @cite{Computing the\n\ -Block Triangular Form of a Sparse Matrix}. ACM Trans. Math. Software,\n\ -16(4):303-324, 1990.\n\ -@seealso{colamd, ccolamd}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value_list retval; - - if (nargin != 1) - { - print_usage (); - return retval; - } - -#if HAVE_CXSPARSE - retval = dmperm_internal (false, args(0), nargout); -#else - error ("dmperm: not available in this version of Octave"); -#endif - - return retval; -} - -/* -%!testif HAVE_CXSPARSE -%! n = 20; -%! a = speye (n,n); -%! a = a(randperm (n),:); -%! assert (a(dmperm (a),:), speye (n)); - -%!testif HAVE_CXSPARSE -%! n = 20; -%! d = 0.2; -%! a = tril (sprandn (n,n,d), -1) + speye (n,n); -%! a = a(randperm (n), randperm (n)); -%! [p,q,r,s] = dmperm (a); -%! assert (tril (a(p,q), -1), sparse (n, n)); -*/ - -DEFUN_DLD (sprank, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} sprank (@var{S})\n\ -@cindex structural rank\n\ -\n\ -Calculate the structural rank of the sparse matrix @var{S}. Note that\n\ -only the structure of the matrix is used in this calculation based on\n\ -a Dulmage-Mendelsohn permutation to block triangular form. As such the\n\ -numerical rank of the matrix @var{S} is bounded by\n\ -@code{sprank (@var{S}) >= rank (@var{S})}. Ignoring floating point errors\n\ -@code{sprank (@var{S}) == rank (@var{S})}.\n\ -@seealso{dmperm}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value_list retval; - - if (nargin != 1) - { - print_usage (); - return retval; - } - -#if HAVE_CXSPARSE - retval = dmperm_internal (true, args(0), nargout); -#else - error ("sprank: not available in this version of Octave"); -#endif - - return retval; -} - -/* -%!testif HAVE_CXSPARSE -%! assert (sprank (speye (20)), 20) -%!testif HAVE_CXSPARSE -%! assert (sprank ([1,0,2,0;2,0,4,0]), 2) - -%!error sprank (1,2) -*/ diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/eigs.cc --- a/src/DLD-FUNCTIONS/eigs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1521 +0,0 @@ -/* - -Copyright (C) 2005-2012 David Bateman - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "ov.h" -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "quit.h" -#include "variables.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "oct-map.h" -#include "pager.h" -#include "unwind-prot.h" - -#include "eigs-base.cc" - -// Global pointer for user defined function. -static octave_function *eigs_fcn = 0; - -// Have we warned about imaginary values returned from user function? -static bool warned_imaginary = false; - -// Is this a recursive call? -static int call_depth = 0; - -ColumnVector -eigs_func (const ColumnVector &x, int &eigs_error) -{ - ColumnVector retval; - octave_value_list args; - args(0) = x; - - if (eigs_fcn) - { - octave_value_list tmp = eigs_fcn->do_multi_index_op (1, args); - - if (error_state) - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - return retval; - } - - if (tmp.length () && tmp(0).is_defined ()) - { - if (! warned_imaginary && tmp(0).is_complex_type ()) - { - warning ("eigs: ignoring imaginary part returned from user-supplied function"); - warned_imaginary = true; - } - - retval = ColumnVector (tmp(0).vector_value ()); - - if (error_state) - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - } - } - else - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - } - } - - return retval; -} - -ComplexColumnVector -eigs_complex_func (const ComplexColumnVector &x, int &eigs_error) -{ - ComplexColumnVector retval; - octave_value_list args; - args(0) = x; - - if (eigs_fcn) - { - octave_value_list tmp = eigs_fcn->do_multi_index_op (1, args); - - if (error_state) - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - return retval; - } - - if (tmp.length () && tmp(0).is_defined ()) - { - retval = ComplexColumnVector (tmp(0).complex_vector_value ()); - - if (error_state) - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - } - } - else - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - } - } - - return retval; -} - -DEFUN_DLD (eigs, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{d} =} eigs (@var{A})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k}, @var{sigma})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k}, @var{sigma}, @var{opts})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k}, @var{sigma})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k}, @var{sigma}, @var{opts})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k}, @var{sigma})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k}, @var{sigma})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k}, @var{sigma}, @var{opts})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k}, @var{sigma}, @var{opts})\n\ -@deftypefnx {Loadable Function} {[@var{V}, @var{d}] =} eigs (@var{A}, @dots{})\n\ -@deftypefnx {Loadable Function} {[@var{V}, @var{d}] =} eigs (@var{af}, @var{n}, @dots{})\n\ -@deftypefnx {Loadable Function} {[@var{V}, @var{d}, @var{flag}] =} eigs (@var{A}, @dots{})\n\ -@deftypefnx {Loadable Function} {[@var{V}, @var{d}, @var{flag}] =} eigs (@var{af}, @var{n}, @dots{})\n\ -Calculate a limited number of eigenvalues and eigenvectors of @var{A},\n\ -based on a selection criteria. The number of eigenvalues and eigenvectors to\n\ -calculate is given by @var{k} and defaults to 6.\n\ -\n\ -By default, @code{eigs} solve the equation\n\ -@tex\n\ -$A \\nu = \\lambda \\nu$,\n\ -@end tex\n\ -@ifinfo\n\ -@code{A * v = lambda * v},\n\ -@end ifinfo\n\ -where\n\ -@tex\n\ -$\\lambda$ is a scalar representing one of the eigenvalues, and $\\nu$\n\ -@end tex\n\ -@ifinfo\n\ -@code{lambda} is a scalar representing one of the eigenvalues, and @code{v}\n\ -@end ifinfo\n\ -is the corresponding eigenvector. If given the positive definite matrix\n\ -@var{B} then @code{eigs} solves the general eigenvalue equation\n\ -@tex\n\ -$A \\nu = \\lambda B \\nu$.\n\ -@end tex\n\ -@ifinfo\n\ -@code{A * v = lambda * B * v}.\n\ -@end ifinfo\n\ -\n\ -The argument @var{sigma} determines which eigenvalues are returned.\n\ -@var{sigma} can be either a scalar or a string. When @var{sigma} is a\n\ -scalar, the @var{k} eigenvalues closest to @var{sigma} are returned. If\n\ -@var{sigma} is a string, it must have one of the following values.\n\ -\n\ -@table @asis\n\ -@item \"lm\"\n\ -Largest Magnitude (default).\n\ -\n\ -@item \"sm\"\n\ -Smallest Magnitude.\n\ -\n\ -@item \"la\"\n\ -Largest Algebraic (valid only for real symmetric problems).\n\ -\n\ -@item \"sa\"\n\ -Smallest Algebraic (valid only for real symmetric problems).\n\ -\n\ -@item \"be\"\n\ -Both Ends, with one more from the high-end if @var{k} is odd (valid only for\n\ -real symmetric problems).\n\ -\n\ -@item \"lr\"\n\ -Largest Real part (valid only for complex or unsymmetric problems).\n\ -\n\ -@item \"sr\"\n\ -Smallest Real part (valid only for complex or unsymmetric problems).\n\ -\n\ -@item \"li\"\n\ -Largest Imaginary part (valid only for complex or unsymmetric problems).\n\ -\n\ -@item \"si\"\n\ -Smallest Imaginary part (valid only for complex or unsymmetric problems).\n\ -@end table\n\ -\n\ -If @var{opts} is given, it is a structure defining possible options that\n\ -@code{eigs} should use. The fields of the @var{opts} structure are:\n\ -\n\ -@table @code\n\ -@item issym\n\ -If @var{af} is given, then flags whether the function @var{af} defines a\n\ -symmetric problem. It is ignored if @var{A} is given. The default is false.\n\ -\n\ -@item isreal\n\ -If @var{af} is given, then flags whether the function @var{af} defines a\n\ -real problem. It is ignored if @var{A} is given. The default is true.\n\ -\n\ -@item tol\n\ -Defines the required convergence tolerance, calculated as\n\ -@code{tol * norm (A)}. The default is @code{eps}.\n\ -\n\ -@item maxit\n\ -The maximum number of iterations. The default is 300.\n\ -\n\ -@item p\n\ -The number of Lanzcos basis vectors to use. More vectors will result in\n\ -faster convergence, but a greater use of memory. The optimal value of\n\ -@code{p} is problem dependent and should be in the range @var{k} to @var{n}.\n\ -The default value is @code{2 * @var{k}}.\n\ -\n\ -@item v0\n\ -The starting vector for the algorithm. An initial vector close to the\n\ -final vector will speed up convergence. The default is for @sc{arpack}\n\ -to randomly generate a starting vector. If specified, @code{v0} must be\n\ -an @var{n}-by-1 vector where @code{@var{n} = rows (@var{A})}\n\ -\n\ -@item disp\n\ -The level of diagnostic printout (0|1|2). If @code{disp} is 0 then\n\ -diagnostics are disabled. The default value is 0.\n\ -\n\ -@item cholB\n\ -Flag if @code{chol (@var{B})} is passed rather than @var{B}. The default is\n\ -false.\n\ -\n\ -@item permB\n\ -The permutation vector of the Cholesky@tie{}factorization of @var{B} if\n\ -@code{cholB} is true. That is @code{chol (@var{B}(permB, permB))}. The\n\ -default is @code{1:@var{n}}.\n\ -\n\ -@end table\n\ -\n\ -It is also possible to represent @var{A} by a function denoted @var{af}.\n\ -@var{af} must be followed by a scalar argument @var{n} defining the length\n\ -of the vector argument accepted by @var{af}. @var{af} can be\n\ -a function handle, an inline function, or a string. When @var{af} is a\n\ -string it holds the name of the function to use.\n\ -\n\ -@var{af} is a function of the form @code{y = af (x)}\n\ -where the required return value of @var{af} is determined by\n\ -the value of @var{sigma}. The four possible forms are\n\ -\n\ -@table @code\n\ -@item A * x\n\ -if @var{sigma} is not given or is a string other than \"sm\".\n\ -\n\ -@item A \\ x\n\ -if @var{sigma} is 0 or \"sm\".\n\ -\n\ -@item (A - sigma * I) \\ x\n\ -for the standard eigenvalue problem, where @code{I} is the identity matrix of\n\ -the same size as @var{A}.\n\ -\n\ -@item (A - sigma * B) \\ x\n\ -for the general eigenvalue problem.\n\ -@end table\n\ -\n\ -The return arguments of @code{eigs} depend on the number of return arguments\n\ -requested. With a single return argument, a vector @var{d} of length @var{k}\n\ -is returned containing the @var{k} eigenvalues that have been found. With\n\ -two return arguments, @var{V} is a @var{n}-by-@var{k} matrix whose columns\n\ -are the @var{k} eigenvectors corresponding to the returned eigenvalues. The\n\ -eigenvalues themselves are returned in @var{d} in the form of a\n\ -@var{n}-by-@var{k} matrix, where the elements on the diagonal are the\n\ -eigenvalues.\n\ -\n\ -Given a third return argument @var{flag}, @code{eigs} returns the status\n\ -of the convergence. If @var{flag} is 0 then all eigenvalues have converged.\n\ -Any other value indicates a failure to converge.\n\ -\n\ -This function is based on the @sc{arpack} package, written by R. Lehoucq,\n\ -K. Maschhoff, D. Sorensen, and C. Yang. For more information see\n\ -@url{http://www.caam.rice.edu/software/ARPACK/}.\n\ -\n\ -@seealso{eig, svds}\n\ -@end deftypefn") -{ - octave_value_list retval; -#ifdef HAVE_ARPACK - int nargin = args.length (); - std::string fcn_name; - octave_idx_type n = 0; - octave_idx_type k = 6; - Complex sigma = 0.; - double sigmar, sigmai; - bool have_sigma = false; - std::string typ = "LM"; - Matrix amm, bmm, bmt; - ComplexMatrix acm, bcm, bct; - SparseMatrix asmm, bsmm, bsmt; - SparseComplexMatrix ascm, bscm, bsct; - int b_arg = 0; - bool have_b = false; - bool have_a_fun = false; - bool a_is_complex = false; - bool b_is_complex = false; - bool symmetric = false; - bool sym_tested = false; - bool cholB = false; - bool a_is_sparse = false; - ColumnVector permB; - int arg_offset = 0; - double tol = DBL_EPSILON; - int maxit = 300; - int disp = 0; - octave_idx_type p = -1; - ColumnVector resid; - ComplexColumnVector cresid; - octave_idx_type info = 1; - - warned_imaginary = false; - - unwind_protect frame; - - frame.protect_var (call_depth); - call_depth++; - - if (call_depth > 1) - { - error ("eigs: invalid recursive call"); - if (fcn_name.length ()) - clear_function (fcn_name); - return retval; - } - - if (nargin == 0) - print_usage (); - else if (args(0).is_function_handle () || args(0).is_inline_function () - || args(0).is_string ()) - { - if (args(0).is_string ()) - { - std::string name = args(0).string_value (); - std::string fname = "function y = "; - fcn_name = unique_symbol_name ("__eigs_fcn_"); - fname.append (fcn_name); - fname.append ("(x) y = "); - eigs_fcn = extract_function (args(0), "eigs", fcn_name, fname, - "; endfunction"); - } - else - eigs_fcn = args(0).function_value (); - - if (!eigs_fcn) - { - error ("eigs: unknown function"); - return retval; - } - - if (nargin < 2) - { - error ("eigs: incorrect number of arguments"); - return retval; - } - else - { - n = args(1).nint_value (); - arg_offset = 1; - have_a_fun = true; - } - } - else - { - if (args(0).is_complex_type ()) - { - if (args(0).is_sparse_type ()) - { - ascm = (args(0).sparse_complex_matrix_value ()); - a_is_sparse = true; - } - else - acm = (args(0).complex_matrix_value ()); - a_is_complex = true; - symmetric = false; // ARPACK doesn't special case complex symmetric - sym_tested = true; - } - else - { - if (args(0).is_sparse_type ()) - { - asmm = (args(0).sparse_matrix_value ()); - a_is_sparse = true; - } - else - { - amm = (args(0).matrix_value ()); - } - } - - } - - // Note hold off reading B till later to avoid issues of double - // copies of the matrix if B is full/real while A is complex. - if (!error_state && nargin > 1 + arg_offset && - !(args(1 + arg_offset).is_real_scalar ())) - { - if (args(1+arg_offset).is_complex_type ()) - { - b_arg = 1+arg_offset; - have_b = true; - b_is_complex = true; - arg_offset++; - } - else - { - b_arg = 1+arg_offset; - have_b = true; - arg_offset++; - } - } - - if (!error_state && nargin > (1+arg_offset)) - k = args(1+arg_offset).nint_value (); - - if (!error_state && nargin > (2+arg_offset)) - { - if (args(2+arg_offset).is_string ()) - { - typ = args(2+arg_offset).string_value (); - - // Use STL function to convert to upper case - transform (typ.begin (), typ.end (), typ.begin (), toupper); - - sigma = 0.; - } - else - { - sigma = args(2+arg_offset).complex_value (); - - if (! error_state) - have_sigma = true; - else - { - error ("eigs: SIGMA must be a scalar or a string"); - return retval; - } - } - } - - sigmar = std::real (sigma); - sigmai = std::imag (sigma); - - if (!error_state && nargin > (3+arg_offset)) - { - if (args(3+arg_offset).is_map ()) - { - octave_scalar_map map = args(3+arg_offset).scalar_map_value (); - - if (! error_state) - { - octave_value tmp; - - // issym is ignored for complex matrix inputs - tmp = map.getfield ("issym"); - if (tmp.is_defined () && !sym_tested) - { - symmetric = tmp.double_value () != 0.; - sym_tested = true; - } - - // isreal is ignored if A is not a function - tmp = map.getfield ("isreal"); - if (tmp.is_defined () && have_a_fun) - a_is_complex = ! (tmp.double_value () != 0.); - - tmp = map.getfield ("tol"); - if (tmp.is_defined ()) - tol = tmp.double_value (); - - tmp = map.getfield ("maxit"); - if (tmp.is_defined ()) - maxit = tmp.nint_value (); - - tmp = map.getfield ("p"); - if (tmp.is_defined ()) - p = tmp.nint_value (); - - tmp = map.getfield ("v0"); - if (tmp.is_defined ()) - { - if (a_is_complex || b_is_complex) - cresid = ComplexColumnVector (tmp.complex_vector_value ()); - else - resid = ColumnVector (tmp.vector_value ()); - } - - tmp = map.getfield ("disp"); - if (tmp.is_defined ()) - disp = tmp.nint_value (); - - tmp = map.getfield ("cholB"); - if (tmp.is_defined ()) - cholB = tmp.double_value () != 0.; - - tmp = map.getfield ("permB"); - if (tmp.is_defined ()) - permB = ColumnVector (tmp.vector_value ()) - 1.0; - } - else - { - error ("eigs: OPTS argument must be a scalar structure"); - return retval; - } - } - else - { - error ("eigs: OPTS argument must be a structure"); - return retval; - } - } - - if (nargin > (4+arg_offset)) - { - error ("eigs: incorrect number of arguments"); - return retval; - } - - // Test undeclared (no issym) matrix inputs for symmetry - if (!sym_tested && !have_a_fun) - { - if (a_is_sparse) - symmetric = asmm.is_symmetric (); - else - symmetric = amm.is_symmetric (); - } - - if (have_b) - { - if (a_is_complex || b_is_complex) - { - if (a_is_sparse) - bscm = args(b_arg).sparse_complex_matrix_value (); - else - bcm = args(b_arg).complex_matrix_value (); - } - else - { - if (a_is_sparse) - bsmm = args(b_arg).sparse_matrix_value (); - else - bmm = args(b_arg).matrix_value (); - } - } - - // Mode 1 for SM mode seems unstable for some reason. - // Use Mode 3 instead, with sigma = 0. - if (!error_state && !have_sigma && typ == "SM") - have_sigma = true; - - if (!error_state) - { - octave_idx_type nconv; - if (a_is_complex || b_is_complex) - { - ComplexMatrix eig_vec; - ComplexColumnVector eig_val; - - - if (have_a_fun) - nconv = EigsComplexNonSymmetricFunc - (eigs_complex_func, n, typ, sigma, k, p, info, eig_vec, eig_val, - cresid, octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - else if (have_sigma) - { - if (a_is_sparse) - nconv = EigsComplexNonSymmetricMatrixShift - (ascm, sigma, k, p, info, eig_vec, eig_val, bscm, permB, - cresid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else - nconv = EigsComplexNonSymmetricMatrixShift - (acm, sigma, k, p, info, eig_vec, eig_val, bcm, permB, cresid, - octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - } - else - { - if (a_is_sparse) - nconv = EigsComplexNonSymmetricMatrix - (ascm, typ, k, p, info, eig_vec, eig_val, bscm, permB, cresid, - octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - else - nconv = EigsComplexNonSymmetricMatrix - (acm, typ, k, p, info, eig_vec, eig_val, bcm, permB, cresid, - octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - } - - if (nargout < 2) - retval(0) = eig_val; - else - { - retval(2) = double (info); - retval(1) = ComplexDiagMatrix (eig_val); - retval(0) = eig_vec; - } - } - else if (sigmai != 0.) - { - // Promote real problem to a complex one. - ComplexMatrix eig_vec; - ComplexColumnVector eig_val; - - if (have_a_fun) - nconv = EigsComplexNonSymmetricFunc - (eigs_complex_func, n, typ, sigma, k, p, info, eig_vec, eig_val, - cresid, octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - else - { - if (a_is_sparse) - nconv = EigsComplexNonSymmetricMatrixShift - (SparseComplexMatrix (asmm), sigma, k, p, info, eig_vec, - eig_val, SparseComplexMatrix (bsmm), permB, cresid, - octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - else - nconv = EigsComplexNonSymmetricMatrixShift - (ComplexMatrix (amm), sigma, k, p, info, eig_vec, - eig_val, ComplexMatrix (bmm), permB, cresid, - octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - } - - if (nargout < 2) - retval(0) = eig_val; - else - { - retval(2) = double (info); - retval(1) = ComplexDiagMatrix (eig_val); - retval(0) = eig_vec; - } - } - else - { - if (symmetric) - { - Matrix eig_vec; - ColumnVector eig_val; - - if (have_a_fun) - nconv = EigsRealSymmetricFunc - (eigs_func, n, typ, sigmar, k, p, info, eig_vec, eig_val, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else if (have_sigma) - { - if (a_is_sparse) - nconv = EigsRealSymmetricMatrixShift - (asmm, sigmar, k, p, info, eig_vec, eig_val, bsmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else - nconv = EigsRealSymmetricMatrixShift - (amm, sigmar, k, p, info, eig_vec, eig_val, bmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - } - else - { - if (a_is_sparse) - nconv = EigsRealSymmetricMatrix - (asmm, typ, k, p, info, eig_vec, eig_val, bsmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else - nconv = EigsRealSymmetricMatrix - (amm, typ, k, p, info, eig_vec, eig_val, bmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - } - - if (nargout < 2) - retval(0) = eig_val; - else - { - retval(2) = double (info); - retval(1) = DiagMatrix (eig_val); - retval(0) = eig_vec; - } - } - else - { - ComplexMatrix eig_vec; - ComplexColumnVector eig_val; - - if (have_a_fun) - nconv = EigsRealNonSymmetricFunc - (eigs_func, n, typ, sigmar, k, p, info, eig_vec, eig_val, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else if (have_sigma) - { - if (a_is_sparse) - nconv = EigsRealNonSymmetricMatrixShift - (asmm, sigmar, k, p, info, eig_vec, eig_val, bsmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else - nconv = EigsRealNonSymmetricMatrixShift - (amm, sigmar, k, p, info, eig_vec, eig_val, bmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - } - else - { - if (a_is_sparse) - nconv = EigsRealNonSymmetricMatrix - (asmm, typ, k, p, info, eig_vec, eig_val, bsmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else - nconv = EigsRealNonSymmetricMatrix - (amm, typ, k, p, info, eig_vec, eig_val, bmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - } - - if (nargout < 2) - retval(0) = eig_val; - else - { - retval(2) = double (info); - retval(1) = ComplexDiagMatrix (eig_val); - retval(0) = eig_vec; - } - } - } - - if (nconv <= 0) - warning ("eigs: None of the %d requested eigenvalues converged", k); - else if (nconv < k) - warning ("eigs: Only %d of the %d requested eigenvalues converged", - nconv, k); - } - - if (! fcn_name.empty ()) - clear_function (fcn_name); -#else - error ("eigs: not available in this version of Octave"); -#endif - - return retval; -} - -/* #### SPARSE MATRIX VERSIONS #### */ - -/* -## Real positive definite tests, n must be even -%!shared n, k, A, d0, d2 -%! n = 20; -%! k = 4; -%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)]); -%! d0 = eig (A); -%! d2 = sort (d0); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); # initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (d1, d0(end:-1:(end-k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, "sm"); -%! assert (d1, d0(k:-1:1), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "la"); -%! assert (d1, d2(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sa"); -%! assert (d1, d2(1:k), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "be"); -%! assert (d1, d2([1:floor(k/2), (end - ceil(k/2) + 1):end]), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1, "be"); -%! assert (d1, d2([1:floor((k+1)/2), (end - ceil((k+1)/2) + 1):end]), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (d1(idx1), d0(idx0(1:k)), 1e-11); -%!testif HAVE_ARPACK, HAVE_CHOLMOD -%! d1 = eigs (A, speye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (eigs (A, k, 4.1), eigs (A, speye (n), k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (eigs (A, k, 4.1), eigs (A, speye (n), k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (d1, d0(k:-1:1), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (d1, eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! AA = speye (10); -%! fn = @(x) AA * x; -%! opts.issym = 1; opts.isreal = 1; -%! assert (eigs (fn, 10, AA, 3, "lm", opts), [1; 1; 1], 10*eps); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "la"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sa"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "be"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ - -/* -## Real unsymmetric tests -%!shared n, k, A, d0 -%! n = 20; -%! k = 4; -%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)]); -%! d0 = eig (A); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); % initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, "sm"); -%! assert (abs (d1), abs (d0(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lr"); -%! [~, idx] = sort (real (d0)); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "li"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "si"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); -%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); -%!testif HAVE_ARPACK, HAVE_CHOLMOD -%! d1 = eigs (A, speye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, speye (n), k, 4.1)), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, speye (n), k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (abs (d1), d0(1:k), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "li"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "si"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ - -/* -## Complex hermitian tests -%!shared n, k, A, d0 -%! n = 20; -%! k = 4; -%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)]); -%! d0 = eig (A); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); % initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, "sm"); -%! assert (abs (d1), abs (d0(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "li"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "si"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); -%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); -%!testif HAVE_ARPACK, HAVE_CHOLMOD -%! d1 = eigs (A, speye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, 4.1, opts); -%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); -%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); -%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); -%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, speye (n), k, 4.1)), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, speye (n), k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (abs (d1), d0(1:k), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "li"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "si"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ - -/* #### FULL MATRIX VERSIONS #### */ - -/* -## Real positive definite tests, n must be even -%!shared n, k, A, d0, d2 -%! n = 20; -%! k = 4; -%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)])); -%! d0 = eig (A); -%! d2 = sort (d0); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); % initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (d1, d0(end:-1:(end-k)),1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sm"); -%! assert (d1, d0(k:-1:1), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "la"); -%! assert (d1, d2(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sa"); -%! assert (d1, d2(1:k), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "be"); -%! assert (d1, d2([1:floor(k/2), (end - ceil(k/2) + 1):end]), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1, "be"); -%! assert (d1, d2([1:floor((k+1)/2), (end - ceil((k+1)/2) + 1):end]), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (d1(idx1), d0(idx0(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, eye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! assert (eigs (A, k, 4.1), eigs (A, eye (n), k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! assert (eigs (A, k, 4.1), eigs (A, eye (n), k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (d1, d0(k:-1:1), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (d1, eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "la"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sa"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "be"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ - -/* -## Real unsymmetric tests -%!shared n, k, A, d0 -%! n = 20; -%! k = 4; -%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)])); -%! d0 = eig (A); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); % initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sm"); -%! assert (abs (d1), abs (d0(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lr"); -%! [~, idx] = sort (real (d0)); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "li"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "si"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); -%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, eye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, eye (n), k, 4.1)), 1e-11); -%!testif HAVE_ARPACK -%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, eye (n), k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (abs (d1), d0(1:k), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "li"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "si"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ - -/* -## Complex hermitian tests -%!shared n, k, A, d0 -%! n = 20; -%! k = 4; -%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)])); -%! d0 = eig (A); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); % initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sm"); -%! assert (abs (d1), abs (d0(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "li"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "si"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); -%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, eye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, 4.1, opts); -%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); -%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); -%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); -%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, eye (n), k, 4.1)), 1e-11); -%!testif HAVE_ARPACK -%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, eye (n), k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (abs (d1), d0(1:k), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "li"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "si"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/fftw.cc --- a/src/DLD-FUNCTIONS/fftw.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,269 +0,0 @@ -/* - -Copyright (C) 2006-2012 David Bateman - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "oct-fftw.h" - -#include "defun-dld.h" -#include "error.h" -#include "ov.h" - -DEFUN_DLD (fftw, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{method} =} fftw (\"planner\")\n\ -@deftypefnx {Loadable Function} {} fftw (\"planner\", @var{method})\n\ -@deftypefnx {Loadable Function} {@var{wisdom} =} fftw (\"dwisdom\")\n\ -@deftypefnx {Loadable Function} {} fftw (\"dwisdom\", @var{wisdom})\n\ -\n\ -Manage @sc{fftw} wisdom data. Wisdom data can be used to significantly\n\ -accelerate the calculation of the FFTs, but implies an initial cost\n\ -in its calculation. When the @sc{fftw} libraries are initialized, they read\n\ -a system wide wisdom file (typically in @file{/etc/fftw/wisdom}), allowing\n\ -wisdom to be shared between applications other than Octave. Alternatively,\n\ -the @code{fftw} function can be used to import wisdom. For example,\n\ -\n\ -@example\n\ -@var{wisdom} = fftw (\"dwisdom\")\n\ -@end example\n\ -\n\ -@noindent\n\ -will save the existing wisdom used by Octave to the string @var{wisdom}.\n\ -This string can then be saved to a file and restored using the @code{save}\n\ -and @code{load} commands respectively. This existing wisdom can be\n\ -reimported as follows\n\ -\n\ -@example\n\ -fftw (\"dwisdom\", @var{wisdom})\n\ -@end example\n\ -\n\ -If @var{wisdom} is an empty matrix, then the wisdom used is cleared.\n\ -\n\ -During the calculation of Fourier transforms further wisdom is generated.\n\ -The fashion in which this wisdom is generated is also controlled by\n\ -the @code{fftw} function. There are five different manners in which the\n\ -wisdom can be treated:\n\ -\n\ -@table @asis\n\ -@item \"estimate\"\n\ -Specifies that no run-time measurement of the optimal means of\n\ -calculating a particular is performed, and a simple heuristic is used\n\ -to pick a (probably sub-optimal) plan. The advantage of this method is\n\ -that there is little or no overhead in the generation of the plan, which\n\ -is appropriate for a Fourier transform that will be calculated once.\n\ -\n\ -@item \"measure\"\n\ -In this case a range of algorithms to perform the transform is considered\n\ -and the best is selected based on their execution time.\n\ -\n\ -@item \"patient\"\n\ -Similar to \"measure\", but a wider range of algorithms is considered.\n\ -\n\ -@item \"exhaustive\"\n\ -Like \"measure\", but all possible algorithms that may be used to\n\ -treat the transform are considered.\n\ -\n\ -@item \"hybrid\"\n\ -As run-time measurement of the algorithm can be expensive, this is a\n\ -compromise where \"measure\" is used for transforms up to the size of 8192\n\ -and beyond that the \"estimate\" method is used.\n\ -@end table\n\ -\n\ -The default method is \"estimate\". The current method can\n\ -be queried with\n\ -\n\ -@example\n\ -@var{method} = fftw (\"planner\")\n\ -@end example\n\ -\n\ -@noindent\n\ -or set by using\n\ -\n\ -@example\n\ -fftw (\"planner\", @var{method})\n\ -@end example\n\ -\n\ -Note that calculated wisdom will be lost when restarting Octave. However,\n\ -the wisdom data can be reloaded if it is saved to a file as described\n\ -above. Saved wisdom files should not be used on different platforms since\n\ -they will not be efficient and the point of calculating the wisdom is lost.\n\ -@seealso{fft, ifft, fft2, ifft2, fftn, ifftn}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 2) - { - print_usage (); - return retval; - } - -#if defined (HAVE_FFTW) - if (args(0).is_string ()) - { - std::string arg0 = args(0).string_value (); - - if (!error_state) - { - // Use STL function to convert to lower case - std::transform (arg0.begin (), arg0.end (), arg0.begin (), tolower); - - if (nargin == 2) - { - std::string arg1 = args(1).string_value (); - if (!error_state) - { - if (arg0 == "planner") - { - std::transform (arg1.begin (), arg1.end (), - arg1.begin (), tolower); - octave_fftw_planner::FftwMethod meth - = octave_fftw_planner::UNKNOWN; - octave_float_fftw_planner::FftwMethod methf - = octave_float_fftw_planner::UNKNOWN; - - if (arg1 == "estimate") - { - meth = octave_fftw_planner::ESTIMATE; - methf = octave_float_fftw_planner::ESTIMATE; - } - else if (arg1 == "measure") - { - meth = octave_fftw_planner::MEASURE; - methf = octave_float_fftw_planner::MEASURE; - } - else if (arg1 == "patient") - { - meth = octave_fftw_planner::PATIENT; - methf = octave_float_fftw_planner::PATIENT; - } - else if (arg1 == "exhaustive") - { - meth = octave_fftw_planner::EXHAUSTIVE; - methf = octave_float_fftw_planner::EXHAUSTIVE; - } - else if (arg1 == "hybrid") - { - meth = octave_fftw_planner::HYBRID; - methf = octave_float_fftw_planner::HYBRID; - } - else - error ("unrecognized planner METHOD"); - - if (!error_state) - { - meth = octave_fftw_planner::method (meth); - octave_float_fftw_planner::method (methf); - - if (meth == octave_fftw_planner::MEASURE) - retval = octave_value ("measure"); - else if (meth == octave_fftw_planner::PATIENT) - retval = octave_value ("patient"); - else if (meth == octave_fftw_planner::EXHAUSTIVE) - retval = octave_value ("exhaustive"); - else if (meth == octave_fftw_planner::HYBRID) - retval = octave_value ("hybrid"); - else - retval = octave_value ("estimate"); - } - } - else if (arg0 == "dwisdom") - { - char *str = fftw_export_wisdom_to_string (); - - if (arg1.length () < 1) - fftw_forget_wisdom (); - else if (! fftw_import_wisdom_from_string (arg1.c_str ())) - error ("could not import supplied WISDOM"); - - if (!error_state) - retval = octave_value (std::string (str)); - - free (str); - } - else if (arg0 == "swisdom") - { - char *str = fftwf_export_wisdom_to_string (); - - if (arg1.length () < 1) - fftwf_forget_wisdom (); - else if (! fftwf_import_wisdom_from_string (arg1.c_str ())) - error ("could not import supplied WISDOM"); - - if (!error_state) - retval = octave_value (std::string (str)); - - free (str); - } - else - error ("unrecognized argument"); - } - } - else - { - if (arg0 == "planner") - { - octave_fftw_planner::FftwMethod meth = - octave_fftw_planner::method (); - - if (meth == octave_fftw_planner::MEASURE) - retval = octave_value ("measure"); - else if (meth == octave_fftw_planner::PATIENT) - retval = octave_value ("patient"); - else if (meth == octave_fftw_planner::EXHAUSTIVE) - retval = octave_value ("exhaustive"); - else if (meth == octave_fftw_planner::HYBRID) - retval = octave_value ("hybrid"); - else - retval = octave_value ("estimate"); - } - else if (arg0 == "dwisdom") - { - char *str = fftw_export_wisdom_to_string (); - retval = octave_value (std::string (str)); - free (str); - } - else if (arg0 == "swisdom") - { - char *str = fftwf_export_wisdom_to_string (); - retval = octave_value (std::string (str)); - free (str); - } - else - error ("unrecognized argument"); - } - } - } -#else - - warning ("fftw: this copy of Octave was not configured to use the FFTW3 planner"); - -#endif - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/module-files --- a/src/DLD-FUNCTIONS/module-files Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -# FILE|CPPFLAGS|LDFLAGS|LIBRARIES -chol.cc -__delaunayn__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) -__dsearchn__.cc -__fltk_uigetfile__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) -__glpk__.cc|$(GLPK_CPPFLAGS)|$(GLPK_LDFLAGS)|$(GLPK_LIBS) -__init_fltk__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) -__init_gnuplot__.cc -__magick_read__.cc|$(MAGICK_CPPFLAGS)|$(MAGICK_LDFLAGS)|$(MAGICK_LIBS) -__voronoi__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) -amd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -ccolamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -colamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -convhulln.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) -dmperm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -eigs.cc|$(ARPACK_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(ARPACK_LDFLAGS) $(SPARSE_XLDFLAGS)|$(ARPACK_LIBS) $(SPARSE_XLIBS) $(LAPACK_LIBS) $(BLAS_LIBS) -fftw.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) -qr.cc|$(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(QRUPDATE_LDFLAGS) $(SPARSE_XLDFLAGS)|$(QRUPDATE_LIBS) $(SPARSE_XLIBS) -symbfact.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -symrcm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -tsearch.cc -urlwrite.cc|$(CURL_CPPFLAGS)|$(CURL_LDFLAGS)|$(CURL_LIBS) diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/oct-qhull.h --- a/src/DLD-FUNCTIONS/oct-qhull.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,60 +0,0 @@ -/* - -Copyright (C) 2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_oct_qhull_h) -#define octave_oct_qhull_h 1 - -#include - -extern "C" { - -#if defined (HAVE_LIBQHULL_LIBQHULL_H) -# include -# include -# include -# include -# include -#elif defined (HAVE_QHULL_LIBQHULL_H) || defined (HAVE_QHULL_QHULL_H) -# if defined (HAVE_QHULL_LIBQHULL_H) -# include -# else -# include -# endif -# include -# include -# include -# include -#elif defined (HAVE_LIBQHULL_H) || defined (HAVE_QHULL_H) -# if defined (HAVE_LIBQHULL_H) -# include -# else -# include -# endif -# include -# include -# include -# include -#endif - -} - -#endif diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/qr.cc --- a/src/DLD-FUNCTIONS/qr.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1598 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2008-2009 Jaroslav Hajek -Copyright (C) 2008-2009 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "CmplxQR.h" -#include "CmplxQRP.h" -#include "dbleQR.h" -#include "dbleQRP.h" -#include "fCmplxQR.h" -#include "fCmplxQRP.h" -#include "floatQR.h" -#include "floatQRP.h" -#include "SparseQR.h" -#include "SparseCmplxQR.h" - - -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "utils.h" - -template -static octave_value -get_qr_r (const base_qr& fact) -{ - MT R = fact.R (); - if (R.is_square () && fact.regular ()) - return octave_value (R, MatrixType (MatrixType::Upper)); - else - return R; -} - -// [Q, R] = qr (X): form Q unitary and R upper triangular such -// that Q * R = X -// -// [Q, R] = qr (X, 0): form the economy decomposition such that if X is -// m by n then only the first n columns of Q are -// computed. -// -// [Q, R, P] = qr (X): form QRP factorization of X where -// P is a permutation matrix such that -// A * P = Q * R -// -// [Q, R, P] = qr (X, 0): form the economy decomposition with -// permutation vector P such that Q * R = X (:, P) -// -// qr (X) alone returns the output of the LAPACK routine dgeqrf, such -// that R = triu (qr (X)) - -DEFUN_DLD (qr, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A})\n\ -@deftypefnx {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A}, '0')\n\ -@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B})\n\ -@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B}, '0')\n\ -@cindex QR factorization\n\ -Compute the QR@tie{}factorization of @var{A}, using standard @sc{lapack}\n\ -subroutines. For example, given the matrix @code{@var{A} = [1, 2; 3, 4]},\n\ -\n\ -@example\n\ -[@var{Q}, @var{R}] = qr (@var{A})\n\ -@end example\n\ -\n\ -@noindent\n\ -returns\n\ -\n\ -@example\n\ -@group\n\ -@var{Q} =\n\ -\n\ - -0.31623 -0.94868\n\ - -0.94868 0.31623\n\ -\n\ -@var{R} =\n\ -\n\ - -3.16228 -4.42719\n\ - 0.00000 -0.63246\n\ -@end group\n\ -@end example\n\ -\n\ -The @code{qr} factorization has applications in the solution of least\n\ -squares problems\n\ -@tex\n\ -$$\n\ -\\min_x \\left\\Vert A x - b \\right\\Vert_2\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -min norm(A x - b)\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -for overdetermined systems of equations (i.e.,\n\ -@tex\n\ -$A$\n\ -@end tex\n\ -@ifnottex\n\ -@var{A}\n\ -@end ifnottex\n\ - is a tall, thin matrix). The QR@tie{}factorization is\n\ -@tex\n\ -$QR = A$ where $Q$ is an orthogonal matrix and $R$ is upper triangular.\n\ -@end tex\n\ -@ifnottex\n\ -@code{@var{Q} * @var{Q} = @var{A}} where @var{Q} is an orthogonal matrix and\n\ -@var{R} is upper triangular.\n\ -@end ifnottex\n\ -\n\ -If given a second argument of '0', @code{qr} returns an economy-sized\n\ -QR@tie{}factorization, omitting zero rows of @var{R} and the corresponding\n\ -columns of @var{Q}.\n\ -\n\ -If the matrix @var{A} is full, the permuted QR@tie{}factorization\n\ -@code{[@var{Q}, @var{R}, @var{P}] = qr (@var{A})} forms the\n\ -QR@tie{}factorization such that the diagonal entries of @var{R} are\n\ -decreasing in magnitude order. For example, given the matrix @code{a = [1,\n\ -2; 3, 4]},\n\ -\n\ -@example\n\ -[@var{Q}, @var{R}, @var{P}] = qr (@var{A})\n\ -@end example\n\ -\n\ -@noindent\n\ -returns\n\ -\n\ -@example\n\ -@group\n\ -@var{Q} =\n\ -\n\ - -0.44721 -0.89443\n\ - -0.89443 0.44721\n\ -\n\ -@var{R} =\n\ -\n\ - -4.47214 -3.13050\n\ - 0.00000 0.44721\n\ -\n\ -@var{P} =\n\ -\n\ - 0 1\n\ - 1 0\n\ -@end group\n\ -@end example\n\ -\n\ -The permuted @code{qr} factorization @code{[@var{Q}, @var{R}, @var{P}] = qr\n\ -(@var{A})} factorization allows the construction of an orthogonal basis of\n\ -@code{span (A)}.\n\ -\n\ -If the matrix @var{A} is sparse, then compute the sparse\n\ -QR@tie{}factorization of @var{A}, using @sc{CSparse}. As the matrix @var{Q}\n\ -is in general a full matrix, this function returns the @var{Q}-less\n\ -factorization @var{R} of @var{A}, such that @code{@var{R} = chol (@var{A}' *\n\ -@var{A})}.\n\ -\n\ -If the final argument is the scalar @code{0} and the number of rows is\n\ -larger than the number of columns, then an economy factorization is\n\ -returned. That is @var{R} will have only @code{size (@var{A},1)} rows.\n\ -\n\ -If an additional matrix @var{B} is supplied, then @code{qr} returns\n\ -@var{C}, where @code{@var{C} = @var{Q}' * @var{B}}. This allows the\n\ -least squares approximation of @code{@var{A} \\ @var{B}} to be calculated\n\ -as\n\ -\n\ -@example\n\ -@group\n\ -[@var{C}, @var{R}] = qr (@var{A}, @var{B})\n\ -x = @var{R} \\ @var{C}\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > (args(0).is_sparse_type () ? 3 : 2)) - { - print_usage (); - return retval; - } - - octave_value arg = args(0); - - int arg_is_empty = empty_arg ("qr", arg.rows (), arg.columns ()); - - if (arg_is_empty < 0) - return retval; - - if (arg.is_sparse_type ()) - { - bool economy = false; - bool is_cmplx = false; - int have_b = 0; - - if (arg.is_complex_type ()) - is_cmplx = true; - if (nargin > 1) - { - have_b = 1; - if (args(nargin-1).is_scalar_type ()) - { - int val = args(nargin-1).int_value (); - if (val == 0) - { - economy = true; - have_b = (nargin > 2 ? 2 : 0); - } - } - if (have_b > 0 && args(have_b).is_complex_type ()) - is_cmplx = true; - } - - if (!error_state) - { - if (have_b && nargout < 2) - error ("qr: incorrect number of output arguments"); - else if (is_cmplx) - { - SparseComplexQR q (arg.sparse_complex_matrix_value ()); - if (!error_state) - { - if (have_b > 0) - { - retval(1) = q.R (economy); - retval(0) = q.C (args(have_b).complex_matrix_value ()); - if (arg.rows () < arg.columns ()) - warning ("qr: non minimum norm solution for under-determined problem"); - } - else if (nargout > 1) - { - retval(1) = q.R (economy); - retval(0) = q.Q (); - } - else - retval(0) = q.R (economy); - } - } - else - { - SparseQR q (arg.sparse_matrix_value ()); - if (!error_state) - { - if (have_b > 0) - { - retval(1) = q.R (economy); - retval(0) = q.C (args(have_b).matrix_value ()); - if (args(0).rows () < args(0).columns ()) - warning ("qr: non minimum norm solution for under-determined problem"); - } - else if (nargout > 1) - { - retval(1) = q.R (economy); - retval(0) = q.Q (); - } - else - retval(0) = q.R (economy); - } - } - } - } - else - { - QR::type type = (nargout == 0 || nargout == 1) ? QR::raw - : (nargin == 2 ? QR::economy : QR::std); - - if (arg.is_single_type ()) - { - if (arg.is_real_type ()) - { - FloatMatrix m = arg.float_matrix_value (); - - if (! error_state) - { - switch (nargout) - { - case 0: - case 1: - { - FloatQR fact (m, type); - retval(0) = fact.R (); - } - break; - - case 2: - { - FloatQR fact (m, type); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - - default: - { - FloatQRP fact (m, type); - if (type == QR::economy) - retval(2) = fact.Pvec (); - else - retval(2) = fact.P (); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - } - } - } - else if (arg.is_complex_type ()) - { - FloatComplexMatrix m = arg.float_complex_matrix_value (); - - if (! error_state) - { - switch (nargout) - { - case 0: - case 1: - { - FloatComplexQR fact (m, type); - retval(0) = fact.R (); - } - break; - - case 2: - { - FloatComplexQR fact (m, type); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - - default: - { - FloatComplexQRP fact (m, type); - if (type == QR::economy) - retval(2) = fact.Pvec (); - else - retval(2) = fact.P (); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - } - } - } - } - else - { - if (arg.is_real_type ()) - { - Matrix m = arg.matrix_value (); - - if (! error_state) - { - switch (nargout) - { - case 0: - case 1: - { - QR fact (m, type); - retval(0) = fact.R (); - } - break; - - case 2: - { - QR fact (m, type); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - - default: - { - QRP fact (m, type); - if (type == QR::economy) - retval(2) = fact.Pvec (); - else - retval(2) = fact.P (); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - } - } - } - else if (arg.is_complex_type ()) - { - ComplexMatrix m = arg.complex_matrix_value (); - - if (! error_state) - { - switch (nargout) - { - case 0: - case 1: - { - ComplexQR fact (m, type); - retval(0) = fact.R (); - } - break; - - case 2: - { - ComplexQR fact (m, type); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - - default: - { - ComplexQRP fact (m, type); - if (type == QR::economy) - retval(2) = fact.Pvec (); - else - retval(2) = fact.P (); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - } - } - } - else - gripe_wrong_type_arg ("qr", arg); - } - } - - return retval; -} - -/* -%!test -%! a = [0, 2, 1; 2, 1, 2]; -%! -%! [q, r] = qr (a); -%! [qe, re] = qr (a, 0); -%! -%! assert (q * r, a, sqrt (eps)); -%! assert (qe * re, a, sqrt (eps)); - -%!test -%! a = [0, 2, 1; 2, 1, 2]; -%! -%! [q, r, p] = qr (a); # FIXME: not giving right dimensions. -%! [qe, re, pe] = qr (a, 0); -%! -%! assert (q * r, a * p, sqrt (eps)); -%! assert (qe * re, a(:, pe), sqrt (eps)); - -%!test -%! a = [0, 2; 2, 1; 1, 2]; -%! -%! [q, r] = qr (a); -%! [qe, re] = qr (a, 0); -%! -%! assert (q * r, a, sqrt (eps)); -%! assert (qe * re, a, sqrt (eps)); - -%!test -%! a = [0, 2; 2, 1; 1, 2]; -%! -%! [q, r, p] = qr (a); -%! [qe, re, pe] = qr (a, 0); -%! -%! assert (q * r, a * p, sqrt (eps)); -%! assert (qe * re, a(:, pe), sqrt (eps)); - -%!error qr () -%!error qr ([1, 2; 3, 4], 0, 2) - -%!function retval = __testqr (q, r, a, p) -%! tol = 100*eps (class (q)); -%! retval = 0; -%! if (nargin == 3) -%! n1 = norm (q*r - a); -%! n2 = norm (q'*q - eye (columns (q))); -%! retval = (n1 < tol && n2 < tol); -%! else -%! n1 = norm (q'*q - eye (columns (q))); -%! retval = (n1 < tol); -%! if (isvector (p)) -%! n2 = norm (q*r - a(:,p)); -%! retval = (retval && n2 < tol); -%! else -%! n2 = norm (q*r - a*p); -%! retval = (retval && n2 < tol); -%! endif -%! endif -%!endfunction - -%!test -%! t = ones (24, 1); -%! j = 1; -%! -%! if (false) # eliminate big matrix tests -%! a = rand (5000, 20); -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps; -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! endif -%! -%! a = [ ones(1,15); sqrt(eps)*eye(15) ]; -%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps; -%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); -%! -%! a = [ ones(1,15); sqrt(eps)*eye(15) ]; -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps; -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! -%! a = [ 611 196 -192 407 -8 -52 -49 29 -%! 196 899 113 -192 -71 -43 -8 -44 -%! -192 113 899 196 61 49 8 52 -%! 407 -192 196 611 8 44 59 -23 -%! -8 -71 61 8 411 -599 208 208 -%! -52 -43 49 44 -599 411 208 208 -%! -49 -8 8 59 208 208 99 -911 -%! 29 -44 52 -23 208 208 -911 99 ]; -%! [q,r] = qr (a); -%! -%! assert (all (t) && norm (q*r - a) < 5000*eps); - -%!test -%! a = single ([0, 2, 1; 2, 1, 2]); -%! -%! [q, r] = qr (a); -%! [qe, re] = qr (a, 0); -%! -%! assert (q * r, a, sqrt (eps ("single"))); -%! assert (qe * re, a, sqrt (eps ("single"))); - -%!test -%! a = single ([0, 2, 1; 2, 1, 2]); -%! -%! [q, r, p] = qr (a); # FIXME: not giving right dimensions. -%! [qe, re, pe] = qr (a, 0); -%! -%! assert (q * r, a * p, sqrt (eps ("single"))); -%! assert (qe * re, a(:, pe), sqrt (eps ("single"))); - -%!test -%! a = single ([0, 2; 2, 1; 1, 2]); -%! -%! [q, r] = qr (a); -%! [qe, re] = qr (a, 0); -%! -%! assert (q * r, a, sqrt (eps ("single"))); -%! assert (qe * re, a, sqrt (eps ("single"))); - -%!test -%! a = single ([0, 2; 2, 1; 1, 2]); -%! -%! [q, r, p] = qr (a); -%! [qe, re, pe] = qr (a, 0); -%! -%! assert (q * r, a * p, sqrt (eps ("single"))); -%! assert (qe * re, a(:, pe), sqrt (eps ("single"))); - -%!error qr () -%!error qr ([1, 2; 3, 4], 0, 2) - -%!test -%! t = ones (24, 1); -%! j = 1; -%! -%! if (false) # eliminate big matrix tests -%! a = rand (5000,20); -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps ("single"); -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! endif -%! -%! a = [ ones(1,15); sqrt(eps("single"))*eye(15) ]; -%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps ("single"); -%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); -%! -%! a = [ ones(1,15); sqrt(eps("single"))*eye(15) ]; -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps ("single"); -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a',p); -%! -%! a = [ 611 196 -192 407 -8 -52 -49 29 -%! 196 899 113 -192 -71 -43 -8 -44 -%! -192 113 899 196 61 49 8 52 -%! 407 -192 196 611 8 44 59 -23 -%! -8 -71 61 8 411 -599 208 208 -%! -52 -43 49 44 -599 411 208 208 -%! -49 -8 8 59 208 208 99 -911 -%! 29 -44 52 -23 208 208 -911 99 ]; -%! [q,r] = qr (a); -%! -%! assert (all (t) && norm (q*r-a) < 5000*eps ("single")); - -## The deactivated tests below can't be tested till rectangular back-subs is -## implemented for sparse matrices. - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = sprandn (n,n,d) + speye (n,n); -%! r = qr (a); -%! assert (r'*r, a'*a, 1e-10) - -%!testif HAVE_COLAMD -%! n = 20; d = 0.2; -%! a = sprandn (n,n,d) + speye (n,n); -%! q = symamd (a); -%! a = a(q,q); -%! r = qr (a); -%! assert (r'*r, a'*a, 1e-10) - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = sprandn (n,n,d) + speye (n,n); -%! [c,r] = qr (a, ones (n,1)); -%! assert (r\c, full (a)\ones (n,1), 10e-10) - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = sprandn (n,n,d) + speye (n,n); -%! b = randn (n,2); -%! [c,r] = qr (a, b); -%! assert (r\c, full (a)\b, 10e-10) - -%% Test under-determined systems!! -%!#testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = sprandn (n,n+1,d) + speye (n,n+1); -%! b = randn (n,2); -%! [c,r] = qr (a, b); -%! assert (r\c, full (a)\b, 10e-10) - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = 1i*sprandn (n,n,d) + speye (n,n); -%! r = qr (a); -%! assert (r'*r,a'*a,1e-10) - -%!testif HAVE_COLAMD -%! n = 20; d = 0.2; -%! a = 1i*sprandn (n,n,d) + speye (n,n); -%! q = symamd (a); -%! a = a(q,q); -%! r = qr (a); -%! assert (r'*r, a'*a, 1e-10) - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = 1i*sprandn (n,n,d) + speye (n,n); -%! [c,r] = qr (a, ones (n,1)); -%! assert (r\c, full (a)\ones (n,1), 10e-10) - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = 1i*sprandn (n,n,d) + speye (n,n); -%! b = randn (n,2); -%! [c,r] = qr (a, b); -%! assert (r\c, full (a)\b, 10e-10) - -%% Test under-determined systems!! -%!#testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = 1i*sprandn (n,n+1,d) + speye (n,n+1); -%! b = randn (n,2); -%! [c,r] = qr (a, b); -%! assert (r\c, full (a)\b, 10e-10) - -%!error qr (sprandn (10,10,0.2), ones (10,1)) -*/ - -static -bool check_qr_dims (const octave_value& q, const octave_value& r, - bool allow_ecf = false) -{ - octave_idx_type m = q.rows (), k = r.rows (), n = r.columns (); - return ((q.ndims () == 2 && r.ndims () == 2 && k == q.columns ()) - && (m == k || (allow_ecf && k == n && k < m))); -} - -static -bool check_index (const octave_value& i, bool vector_allowed = false) -{ - return ((i.is_real_type () || i.is_integer_type ()) - && (i.is_scalar_type () || vector_allowed)); -} - -DEFUN_DLD (qrupdate, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrupdate (@var{Q}, @var{R}, @var{u}, @var{v})\n\ -Given a QR@tie{}factorization of a real or complex matrix\n\ -@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ -@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization\n\ -of @w{@var{A} + @var{u}*@var{v}'}, where @var{u} and @var{v} are\n\ -column vectors (rank-1 update) or matrices with equal number of columns\n\ -(rank-k update). Notice that the latter case is done as a sequence of rank-1\n\ -updates; thus, for k large enough, it will be both faster and more accurate\n\ -to recompute the factorization from scratch.\n\ -\n\ -The QR@tie{}factorization supplied may be either full\n\ -(Q is square) or economized (R is square).\n\ -\n\ -@seealso{qr, qrinsert, qrdelete}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - octave_value_list retval; - - if (nargin != 4) - { - print_usage (); - return retval; - } - - octave_value argq = args(0); - octave_value argr = args(1); - octave_value argu = args(2); - octave_value argv = args(3); - - if (argq.is_numeric_type () && argr.is_numeric_type () - && argu.is_numeric_type () && argv.is_numeric_type ()) - { - if (check_qr_dims (argq, argr, true)) - { - if (argq.is_real_type () - && argr.is_real_type () - && argu.is_real_type () - && argv.is_real_type ()) - { - // all real case - if (argq.is_single_type () - || argr.is_single_type () - || argu.is_single_type () - || argv.is_single_type ()) - { - FloatMatrix Q = argq.float_matrix_value (); - FloatMatrix R = argr.float_matrix_value (); - FloatMatrix u = argu.float_matrix_value (); - FloatMatrix v = argv.float_matrix_value (); - - FloatQR fact (Q, R); - fact.update (u, v); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - Matrix Q = argq.matrix_value (); - Matrix R = argr.matrix_value (); - Matrix u = argu.matrix_value (); - Matrix v = argv.matrix_value (); - - QR fact (Q, R); - fact.update (u, v); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - else - { - // complex case - if (argq.is_single_type () - || argr.is_single_type () - || argu.is_single_type () - || argv.is_single_type ()) - { - FloatComplexMatrix Q = argq.float_complex_matrix_value (); - FloatComplexMatrix R = argr.float_complex_matrix_value (); - FloatComplexMatrix u = argu.float_complex_matrix_value (); - FloatComplexMatrix v = argv.float_complex_matrix_value (); - - FloatComplexQR fact (Q, R); - fact.update (u, v); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - ComplexMatrix Q = argq.complex_matrix_value (); - ComplexMatrix R = argr.complex_matrix_value (); - ComplexMatrix u = argu.complex_matrix_value (); - ComplexMatrix v = argv.complex_matrix_value (); - - ComplexQR fact (Q, R); - fact.update (u, v); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - } - else - error ("qrupdate: Q and R dimensions don't match"); - } - else - error ("qrupdate: Q, R, U, and V must be numeric"); - - return retval; -} - -/* -%!shared A, u, v, Ac, uc, vc -%! A = [0.091364 0.613038 0.999083; -%! 0.594638 0.425302 0.603537; -%! 0.383594 0.291238 0.085574; -%! 0.265712 0.268003 0.238409; -%! 0.669966 0.743851 0.445057 ]; -%! -%! u = [0.85082; -%! 0.76426; -%! 0.42883; -%! 0.53010; -%! 0.80683 ]; -%! -%! v = [0.98810; -%! 0.24295; -%! 0.43167 ]; -%! -%! Ac = [0.620405 + 0.956953i 0.480013 + 0.048806i 0.402627 + 0.338171i; -%! 0.589077 + 0.658457i 0.013205 + 0.279323i 0.229284 + 0.721929i; -%! 0.092758 + 0.345687i 0.928679 + 0.241052i 0.764536 + 0.832406i; -%! 0.912098 + 0.721024i 0.049018 + 0.269452i 0.730029 + 0.796517i; -%! 0.112849 + 0.603871i 0.486352 + 0.142337i 0.355646 + 0.151496i ]; -%! -%! uc = [0.20351 + 0.05401i; -%! 0.13141 + 0.43708i; -%! 0.29808 + 0.08789i; -%! 0.69821 + 0.38844i; -%! 0.74871 + 0.25821i ]; -%! -%! vc = [0.85839 + 0.29468i; -%! 0.20820 + 0.93090i; -%! 0.86184 + 0.34689i ]; -%! - -%!test -%! [Q,R] = qr (A); -%! [Q,R] = qrupdate (Q, R, u, v); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R)-R), Inf) == 0); -%! assert (norm (vec (Q*R - A - u*v'), Inf) < norm (A)*1e1*eps); -%! -%!test -%! [Q,R] = qr (Ac); -%! [Q,R] = qrupdate (Q, R, uc, vc); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R)-R), Inf) == 0); -%! assert (norm (vec (Q*R - Ac - uc*vc'), Inf) < norm (Ac)*1e1*eps); - -%!test -%! [Q,R] = qr (single (A)); -%! [Q,R] = qrupdate (Q, R, single (u), single (v)); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R)-R), Inf) == 0); -%! assert (norm (vec (Q*R - single (A) - single (u)*single (v)'), Inf) < norm (single (A))*1e1*eps ("single")); -%! -%!test -%! [Q,R] = qr (single (Ac)); -%! [Q,R] = qrupdate (Q, R, single (uc), single (vc)); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R)-R), Inf) == 0); -%! assert (norm (vec (Q*R - single (Ac) - single (uc)*single (vc)'), Inf) < norm (single (Ac))*1e1*eps ("single")); -*/ - -DEFUN_DLD (qrinsert, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrinsert (@var{Q}, @var{R}, @var{j}, @var{x}, @var{orient})\n\ -Given a QR@tie{}factorization of a real or complex matrix\n\ -@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ -@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization of\n\ -@w{[A(:,1:j-1) x A(:,j:n)]}, where @var{u} is a column vector to be\n\ -inserted into @var{A} (if @var{orient} is @code{\"col\"}), or the\n\ -QR@tie{}factorization of @w{[A(1:j-1,:);x;A(:,j:n)]}, where @var{x}\n\ -is a row vector to be inserted into @var{A} (if @var{orient} is\n\ -@code{\"row\"}).\n\ -\n\ -The default value of @var{orient} is @code{\"col\"}.\n\ -If @var{orient} is @code{\"col\"},\n\ -@var{u} may be a matrix and @var{j} an index vector\n\ -resulting in the QR@tie{}factorization of a matrix @var{B} such that\n\ -@w{B(:,@var{j})} gives @var{u} and @w{B(:,@var{j}) = []} gives @var{A}.\n\ -Notice that the latter case is done as a sequence of k insertions;\n\ -thus, for k large enough, it will be both faster and more accurate to\n\ -recompute the factorization from scratch.\n\ -\n\ -If @var{orient} is @code{\"col\"},\n\ -the QR@tie{}factorization supplied may be either full\n\ -(Q is square) or economized (R is square).\n\ -\n\ -If @var{orient} is @code{\"row\"}, full factorization is needed.\n\ -@seealso{qr, qrupdate, qrdelete}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - octave_value_list retval; - - if (nargin < 4 || nargin > 5) - { - print_usage (); - return retval; - } - - octave_value argq = args(0); - octave_value argr = args(1); - octave_value argj = args(2); - octave_value argx = args(3); - - if (argq.is_numeric_type () && argr.is_numeric_type () - && argx.is_numeric_type () - && (nargin < 5 || args(4).is_string ())) - { - std::string orient = (nargin < 5) ? "col" : args(4).string_value (); - - bool col = orient == "col"; - - if (col || orient == "row") - if (check_qr_dims (argq, argr, col) - && (col || argx.rows () == 1)) - { - if (check_index (argj, col)) - { - MArray j - = argj.octave_idx_type_vector_value (); - - octave_idx_type one = 1; - - if (argq.is_real_type () - && argr.is_real_type () - && argx.is_real_type ()) - { - // real case - if (argq.is_single_type () - || argr.is_single_type () - || argx.is_single_type ()) - { - FloatMatrix Q = argq.float_matrix_value (); - FloatMatrix R = argr.float_matrix_value (); - FloatMatrix x = argx.float_matrix_value (); - - FloatQR fact (Q, R); - - if (col) - fact.insert_col (x, j-one); - else - fact.insert_row (x.row (0), j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - - } - else - { - Matrix Q = argq.matrix_value (); - Matrix R = argr.matrix_value (); - Matrix x = argx.matrix_value (); - - QR fact (Q, R); - - if (col) - fact.insert_col (x, j-one); - else - fact.insert_row (x.row (0), j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - - } - } - else - { - // complex case - if (argq.is_single_type () - || argr.is_single_type () - || argx.is_single_type ()) - { - FloatComplexMatrix Q = argq.float_complex_matrix_value (); - FloatComplexMatrix R = argr.float_complex_matrix_value (); - FloatComplexMatrix x = argx.float_complex_matrix_value (); - - FloatComplexQR fact (Q, R); - - if (col) - fact.insert_col (x, j-one); - else - fact.insert_row (x.row (0), j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - ComplexMatrix Q = argq.complex_matrix_value (); - ComplexMatrix R = argr.complex_matrix_value (); - ComplexMatrix x = argx.complex_matrix_value (); - - ComplexQR fact (Q, R); - - if (col) - fact.insert_col (x, j-one); - else - fact.insert_row (x.row (0), j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - - } - else - error ("qrinsert: invalid index J"); - } - else - error ("qrinsert: dimension mismatch"); - - else - error ("qrinsert: ORIENT must be \"col\" or \"row\""); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! [Q,R] = qr (A); -%! [Q,R] = qrinsert (Q, R, 3, u); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [A(:,1:2) u A(:,3)]), Inf) < norm (A)*1e1*eps); -%!test -%! [Q,R] = qr (Ac); -%! [Q,R] = qrinsert (Q, R, 3, uc); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [Ac(:,1:2) uc Ac(:,3)]), Inf) < norm (Ac)*1e1*eps); -%!test -%! x = [0.85082 0.76426 0.42883 ]; -%! -%! [Q,R] = qr (A); -%! [Q,R] = qrinsert (Q, R, 3, x, "row"); -%! assert (norm (vec (Q'*Q - eye (6)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [A(1:2,:);x;A(3:5,:)]), Inf) < norm (A)*1e1*eps); -%!test -%! x = [0.20351 + 0.05401i 0.13141 + 0.43708i 0.29808 + 0.08789i ]; -%! -%! [Q,R] = qr (Ac); -%! [Q,R] = qrinsert (Q, R, 3, x, "row"); -%! assert (norm (vec (Q'*Q - eye (6)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [Ac(1:2,:);x;Ac(3:5,:)]), Inf) < norm (Ac)*1e1*eps); - -%!test -%! [Q,R] = qr (single (A)); -%! [Q,R] = qrinsert (Q, R, 3, single (u)); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - single ([A(:,1:2) u A(:,3)])), Inf) < norm (single (A))*1e1*eps ("single")); -%!test -%! [Q,R] = qr (single (Ac)); -%! [Q,R] = qrinsert (Q, R, 3, single (uc)); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - single ([Ac(:,1:2) uc Ac(:,3)])), Inf) < norm (single (Ac))*1e1*eps ("single")); -%!test -%! x = single ([0.85082 0.76426 0.42883 ]); -%! -%! [Q,R] = qr (single (A)); -%! [Q,R] = qrinsert (Q, R, 3, x, "row"); -%! assert (norm (vec (Q'*Q - eye (6,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - single ([A(1:2,:);x;A(3:5,:)])), Inf) < norm (single (A))*1e1*eps ("single")); -%!test -%! x = single ([0.20351 + 0.05401i 0.13141 + 0.43708i 0.29808 + 0.08789i ]); -%! -%! [Q,R] = qr (single (Ac)); -%! [Q,R] = qrinsert (Q, R, 3, x, "row"); -%! assert (norm (vec (Q'*Q - eye (6,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - single ([Ac(1:2,:);x;Ac(3:5,:)])), Inf) < norm (single (Ac))*1e1*eps ("single")); -*/ - -DEFUN_DLD (qrdelete, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrdelete (@var{Q}, @var{R}, @var{j}, @var{orient})\n\ -Given a QR@tie{}factorization of a real or complex matrix\n\ -@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ -@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization of\n\ -@w{[A(:,1:j-1) A(:,j+1:n)]}, i.e., @var{A} with one column deleted\n\ -(if @var{orient} is \"col\"), or the QR@tie{}factorization of\n\ -@w{[A(1:j-1,:);A(j+1:n,:)]}, i.e., @var{A} with one row deleted (if\n\ -@var{orient} is \"row\").\n\ -\n\ -The default value of @var{orient} is \"col\".\n\ -\n\ -If @var{orient} is @code{\"col\"},\n\ -@var{j} may be an index vector\n\ -resulting in the QR@tie{}factorization of a matrix @var{B} such that\n\ -@w{A(:,@var{j}) = []} gives @var{B}.\n\ -Notice that the latter case is done as a sequence of k deletions;\n\ -thus, for k large enough, it will be both faster and more accurate to\n\ -recompute the factorization from scratch.\n\ -\n\ -If @var{orient} is @code{\"col\"},\n\ -the QR@tie{}factorization supplied may be either full\n\ -(Q is square) or economized (R is square).\n\ -\n\ -If @var{orient} is @code{\"row\"}, full factorization is needed.\n\ -@seealso{qr, qrinsert, qrupdate}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - octave_value_list retval; - - if (nargin < 3 || nargin > 4) - { - print_usage (); - return retval; - } - - octave_value argq = args(0); - octave_value argr = args(1); - octave_value argj = args(2); - - if (argq.is_numeric_type () && argr.is_numeric_type () - && (nargin < 4 || args(3).is_string ())) - { - std::string orient = (nargin < 4) ? "col" : args(3).string_value (); - - bool col = orient == "col"; - - if (col || orient == "row") - if (check_qr_dims (argq, argr, col)) - { - if (check_index (argj, col)) - { - MArray j - = argj.octave_idx_type_vector_value (); - - octave_idx_type one = 1; - - if (argq.is_real_type () - && argr.is_real_type ()) - { - // real case - if (argq.is_single_type () - || argr.is_single_type ()) - { - FloatMatrix Q = argq.float_matrix_value (); - FloatMatrix R = argr.float_matrix_value (); - - FloatQR fact (Q, R); - - if (col) - fact.delete_col (j-one); - else - fact.delete_row (j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - Matrix Q = argq.matrix_value (); - Matrix R = argr.matrix_value (); - - QR fact (Q, R); - - if (col) - fact.delete_col (j-one); - else - fact.delete_row (j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - else - { - // complex case - if (argq.is_single_type () - || argr.is_single_type ()) - { - FloatComplexMatrix Q = argq.float_complex_matrix_value (); - FloatComplexMatrix R = argr.float_complex_matrix_value (); - - FloatComplexQR fact (Q, R); - - if (col) - fact.delete_col (j-one); - else - fact.delete_row (j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - ComplexMatrix Q = argq.complex_matrix_value (); - ComplexMatrix R = argr.complex_matrix_value (); - - ComplexQR fact (Q, R); - - if (col) - fact.delete_col (j-one); - else - fact.delete_row (j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - } - else - error ("qrdelete: invalid index J"); - } - else - error ("qrdelete: dimension mismatch"); - - else - error ("qrdelete: ORIENT must be \"col\" or \"row\""); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! AA = [0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 16*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps); -%! -%!test -%! AA = [0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; -%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; -%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; -%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; -%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ] * I; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 16*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps); -%! -%!test -%! AA = [0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3, "row"); -%! assert (norm (vec (Q'*Q - eye (4)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps); -%! -%!test -%! AA = [0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; -%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; -%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; -%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; -%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ] * I; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3, "row"); -%! assert (norm (vec (Q'*Q - eye (4)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps); - -%!test -%! AA = single ([0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]); -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps ("single")); -%! -%!test -%! AA = single ([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; -%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; -%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; -%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; -%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ]) * I; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps ("single")); -%! -%!test -%! AA = single ([0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]); -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3, "row"); -%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1.5e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); -%!testif HAVE_QRUPDATE -%! # Same test as above but with more precicision -%! AA = single ([0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]); -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3, "row"); -%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); -%! -%!test -%! AA = single ([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; -%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; -%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; -%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; -%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ]) * I; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3, "row"); -%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); -*/ - -DEFUN_DLD (qrshift, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrshift (@var{Q}, @var{R}, @var{i}, @var{j})\n\ -Given a QR@tie{}factorization of a real or complex matrix\n\ -@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ -@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization\n\ -of @w{@var{A}(:,p)}, where @w{p} is the permutation @*\n\ -@code{p = [1:i-1, shift(i:j, 1), j+1:n]} if @w{@var{i} < @var{j}} @*\n\ - or @*\n\ -@code{p = [1:j-1, shift(j:i,-1), i+1:n]} if @w{@var{j} < @var{i}}. @*\n\ -\n\ -@seealso{qr, qrinsert, qrdelete}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - octave_value_list retval; - - if (nargin != 4) - { - print_usage (); - return retval; - } - - octave_value argq = args(0); - octave_value argr = args(1); - octave_value argi = args(2); - octave_value argj = args(3); - - if (argq.is_numeric_type () && argr.is_numeric_type ()) - { - if (check_qr_dims (argq, argr, true)) - { - if (check_index (argi) && check_index (argj)) - { - octave_idx_type i = argi.int_value (); - octave_idx_type j = argj.int_value (); - - if (argq.is_real_type () - && argr.is_real_type ()) - { - // all real case - if (argq.is_single_type () - && argr.is_single_type ()) - { - FloatMatrix Q = argq.float_matrix_value (); - FloatMatrix R = argr.float_matrix_value (); - - FloatQR fact (Q, R); - fact.shift_cols (i-1, j-1); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - Matrix Q = argq.matrix_value (); - Matrix R = argr.matrix_value (); - - QR fact (Q, R); - fact.shift_cols (i-1, j-1); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - else - { - // complex case - if (argq.is_single_type () - && argr.is_single_type ()) - { - FloatComplexMatrix Q = argq.float_complex_matrix_value (); - FloatComplexMatrix R = argr.float_complex_matrix_value (); - - FloatComplexQR fact (Q, R); - fact.shift_cols (i-1, j-1); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - ComplexMatrix Q = argq.complex_matrix_value (); - ComplexMatrix R = argr.complex_matrix_value (); - - ComplexQR fact (Q, R); - fact.shift_cols (i-1, j-1); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - } - else - error ("qrshift: invalid index I or J"); - } - else - error ("qrshift: dimensions mismatch"); - } - else - error ("qrshift: Q and R must be numeric"); - - return retval; -} - -/* -%!test -%! AA = A.'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); -%! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); -%! -%!test -%! AA = Ac.'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); -%! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); - -%!test -%! AA = single (A).'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); -%! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); -%! -%!test -%! AA = single (Ac).'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); -%! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); -*/ diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/symbfact.cc --- a/src/DLD-FUNCTIONS/symbfact.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,363 +0,0 @@ -/* - -Copyright (C) 2005-2012 David Bateman -Copyright (C) 1998-2005 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "SparseCmplxCHOL.h" -#include "SparsedbleCHOL.h" -#include "oct-spparms.h" -#include "sparse-util.h" -#include "oct-locbuf.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "utils.h" - -DEFUN_DLD (symbfact, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{count}, @var{h}, @var{parent}, @var{post}, @var{r}] =} symbfact (@var{S})\n\ -@deftypefnx {Loadable Function} {[@dots{}] =} symbfact (@var{S}, @var{typ})\n\ -@deftypefnx {Loadable Function} {[@dots{}] =} symbfact (@var{S}, @var{typ}, @var{mode})\n\ -\n\ -Perform a symbolic factorization analysis on the sparse matrix @var{S}.\n\ -Where\n\ -\n\ -@table @var\n\ -@item S\n\ -@var{S} is a complex or real sparse matrix.\n\ -\n\ -@item typ\n\ -Is the type of the factorization and can be one of\n\ -\n\ -@table @samp\n\ -@item sym\n\ -Factorize @var{S}. This is the default.\n\ -\n\ -@item col\n\ -Factorize @code{@var{S}' * @var{S}}.\n\ -\n\ -@item row\n\ -Factorize @xcode{@var{S} * @var{S}'}.\n\ -\n\ -@item lo\n\ -Factorize @xcode{@var{S}'}\n\ -@end table\n\ -\n\ -@item mode\n\ -The default is to return the Cholesky@tie{}factorization for @var{r}, and if\n\ -@var{mode} is 'L', the conjugate transpose of the Cholesky@tie{}factorization\n\ -is returned. The conjugate transpose version is faster and uses less\n\ -memory, but returns the same values for @var{count}, @var{h}, @var{parent}\n\ -and @var{post} outputs.\n\ -@end table\n\ -\n\ -The output variables are\n\ -\n\ -@table @var\n\ -@item count\n\ -The row counts of the Cholesky@tie{}factorization as determined by @var{typ}.\n\ -\n\ -@item h\n\ -The height of the elimination tree.\n\ -\n\ -@item parent\n\ -The elimination tree itself.\n\ -\n\ -@item post\n\ -A sparse boolean matrix whose structure is that of the Cholesky\n\ -factorization as determined by @var{typ}.\n\ -@end table\n\ -@end deftypefn") -{ - octave_value_list retval; - int nargin = args.length (); - - if (nargin < 1 || nargin > 3 || nargout > 5) - { - print_usage (); - return retval; - } - -#ifdef HAVE_CHOLMOD - - cholmod_common Common; - cholmod_common *cm = &Common; - CHOLMOD_NAME(start) (cm); - - double spu = octave_sparse_params::get_key ("spumoni"); - if (spu == 0.) - { - cm->print = -1; - cm->print_function = 0; - } - else - { - cm->print = static_cast (spu) + 2; - cm->print_function =&SparseCholPrint; - } - - cm->error_handler = &SparseCholError; - cm->complex_divide = CHOLMOD_NAME(divcomplex); - cm->hypotenuse = CHOLMOD_NAME(hypot); - - double dummy; - cholmod_sparse Astore; - cholmod_sparse *A = &Astore; - A->packed = true; - A->sorted = true; - A->nz = 0; -#ifdef IDX_TYPE_LONG - A->itype = CHOLMOD_LONG; -#else - A->itype = CHOLMOD_INT; -#endif - A->dtype = CHOLMOD_DOUBLE; - A->stype = 1; - A->x = &dummy; - - if (args(0).is_real_type ()) - { - const SparseMatrix a = args(0).sparse_matrix_value (); - A->nrow = a.rows (); - A->ncol = a.cols (); - A->p = a.cidx (); - A->i = a.ridx (); - A->nzmax = a.nnz (); - A->xtype = CHOLMOD_REAL; - - if (a.rows () > 0 && a.cols () > 0) - A->x = a.data (); - } - else if (args(0).is_complex_type ()) - { - const SparseComplexMatrix a = args(0).sparse_complex_matrix_value (); - A->nrow = a.rows (); - A->ncol = a.cols (); - A->p = a.cidx (); - A->i = a.ridx (); - A->nzmax = a.nnz (); - A->xtype = CHOLMOD_COMPLEX; - - if (a.rows () > 0 && a.cols () > 0) - A->x = a.data (); - } - else - gripe_wrong_type_arg ("symbfact", args(0)); - - octave_idx_type coletree = false; - octave_idx_type n = A->nrow; - - if (nargin > 1) - { - char ch; - std::string str = args(1).string_value (); - ch = tolower (str.c_str ()[0]); - if (ch == 'r') - A->stype = 0; - else if (ch == 'c') - { - n = A->ncol; - coletree = true; - A->stype = 0; - } - else if (ch == 's') - A->stype = 1; - else if (ch == 's') - A->stype = -1; - else - error ("symbfact: unrecognized TYP in symbolic factorization"); - } - - if (A->stype && A->nrow != A->ncol) - error ("symbfact: S must be a square matrix"); - - if (!error_state) - { - OCTAVE_LOCAL_BUFFER (octave_idx_type, Parent, n); - OCTAVE_LOCAL_BUFFER (octave_idx_type, Post, n); - OCTAVE_LOCAL_BUFFER (octave_idx_type, ColCount, n); - OCTAVE_LOCAL_BUFFER (octave_idx_type, First, n); - OCTAVE_LOCAL_BUFFER (octave_idx_type, Level, n); - - cholmod_sparse *F = CHOLMOD_NAME(transpose) (A, 0, cm); - cholmod_sparse *Aup, *Alo; - - if (A->stype == 1 || coletree) - { - Aup = A ; - Alo = F ; - } - else - { - Aup = F ; - Alo = A ; - } - - CHOLMOD_NAME(etree) (Aup, Parent, cm); - - if (cm->status < CHOLMOD_OK) - { - error ("matrix corrupted"); - goto symbfact_error; - } - - if (CHOLMOD_NAME(postorder) (Parent, n, 0, Post, cm) != n) - { - error ("postorder failed"); - goto symbfact_error; - } - - CHOLMOD_NAME(rowcolcounts) (Alo, 0, 0, Parent, Post, 0, - ColCount, First, Level, cm); - - if (cm->status < CHOLMOD_OK) - { - error ("matrix corrupted"); - goto symbfact_error; - } - - if (nargout > 4) - { - cholmod_sparse *A1, *A2; - - if (A->stype == 1) - { - A1 = A; - A2 = 0; - } - else if (A->stype == -1) - { - A1 = F; - A2 = 0; - } - else if (coletree) - { - A1 = F; - A2 = A; - } - else - { - A1 = A; - A2 = F; - } - - // count the total number of entries in L - octave_idx_type lnz = 0 ; - for (octave_idx_type j = 0 ; j < n ; j++) - lnz += ColCount[j]; - - - // allocate the output matrix L (pattern-only) - SparseBoolMatrix L (n, n, lnz); - - // initialize column pointers - lnz = 0; - for (octave_idx_type j = 0 ; j < n ; j++) - { - L.xcidx(j) = lnz; - lnz += ColCount[j]; - } - L.xcidx(n) = lnz; - - - /* create a copy of the column pointers */ - octave_idx_type *W = First; - for (octave_idx_type j = 0 ; j < n ; j++) - W[j] = L.xcidx (j); - - // get workspace for computing one row of L - cholmod_sparse *R = cholmod_allocate_sparse (n, 1, n, false, true, - 0, CHOLMOD_PATTERN, cm); - octave_idx_type *Rp = static_cast(R->p); - octave_idx_type *Ri = static_cast(R->i); - - // compute L one row at a time - for (octave_idx_type k = 0 ; k < n ; k++) - { - // get the kth row of L and store in the columns of L - CHOLMOD_NAME (row_subtree) (A1, A2, k, Parent, R, cm) ; - for (octave_idx_type p = 0 ; p < Rp[1] ; p++) - L.xridx (W[Ri[p]]++) = k ; - - // add the diagonal entry - L.xridx (W[k]++) = k ; - } - - // free workspace - cholmod_free_sparse (&R, cm) ; - - - // transpose L to get R, or leave as is - if (nargin < 3) - L = L.transpose (); - - // fill numerical values of L with one's - for (octave_idx_type p = 0 ; p < lnz ; p++) - L.xdata(p) = true; - - retval(4) = L; - } - - ColumnVector tmp (n); - if (nargout > 3) - { - for (octave_idx_type i = 0; i < n; i++) - tmp(i) = Post[i] + 1; - retval(3) = tmp; - } - - if (nargout > 2) - { - for (octave_idx_type i = 0; i < n; i++) - tmp(i) = Parent[i] + 1; - retval(2) = tmp; - } - - if (nargout > 1) - { - /* compute the elimination tree height */ - octave_idx_type height = 0 ; - for (int i = 0 ; i < n ; i++) - height = (height > Level[i] ? height : Level[i]); - height++ ; - retval(1) = static_cast (height); - } - - for (octave_idx_type i = 0; i < n; i++) - tmp(i) = ColCount[i]; - retval(0) = tmp; - } - - symbfact_error: -#else - error ("symbfact: not available in this version of Octave"); -#endif - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/symrcm.cc --- a/src/DLD-FUNCTIONS/symrcm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,702 +0,0 @@ -/* - -Copyright (C) 2007-2012 Michael Weitzel - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* -An implementation of the Reverse Cuthill-McKee algorithm (symrcm) - -The implementation of this algorithm is based in the descriptions found in - -@INPROCEEDINGS{, - author = {E. Cuthill and J. McKee}, - title = {Reducing the Bandwidth of Sparse Symmetric Matrices}, - booktitle = {Proceedings of the 24th ACM National Conference}, - publisher = {Brandon Press}, - pages = {157 -- 172}, - location = {New Jersey}, - year = {1969} -} - -@BOOK{, - author = {Alan George and Joseph W. H. Liu}, - title = {Computer Solution of Large Sparse Positive Definite Systems}, - publisher = {Prentice Hall Series in Computational Mathematics}, - ISBN = {0-13-165274-5}, - year = {1981} -} - -The algorithm represents a heuristic approach to the NP-complete minimum -bandwidth problem. - -Written by Michael Weitzel - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "ov.h" -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "utils.h" -#include "oct-locbuf.h" - -#include "ov-re-mat.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "oct-sparse.h" - -// A node struct for the Cuthill-McKee algorithm -struct CMK_Node -{ - // the node's id (matrix row index) - octave_idx_type id; - // the node's degree - octave_idx_type deg; - // minimal distance to the root of the spanning tree - octave_idx_type dist; -}; - -// A simple queue. -// Queues Q have a fixed maximum size N (rows,cols of the matrix) and are -// stored in an array. qh and qt point to queue head and tail. - -// Enqueue operation (adds a node "o" at the tail) - -inline static void -Q_enq (CMK_Node *Q, octave_idx_type N, octave_idx_type& qt, const CMK_Node& o) -{ - Q[qt] = o; - qt = (qt + 1) % (N + 1); -} - -// Dequeue operation (removes a node from the head) - -inline static CMK_Node -Q_deq (CMK_Node * Q, octave_idx_type N, octave_idx_type& qh) -{ - CMK_Node r = Q[qh]; - qh = (qh + 1) % (N + 1); - return r; -} - -// Predicate (queue empty) -#define Q_empty(Q, N, qh, qt) ((qh) == (qt)) - -// A simple, array-based binary heap (used as a priority queue for nodes) - -// the left descendant of entry i -#define LEFT(i) (((i) << 1) + 1) // = (2*(i)+1) -// the right descendant of entry i -#define RIGHT(i) (((i) << 1) + 2) // = (2*(i)+2) -// the parent of entry i -#define PARENT(i) (((i) - 1) >> 1) // = floor(((i)-1)/2) - -// Builds a min-heap (the root contains the smallest element). A is an array -// with the graph's nodes, i is a starting position, size is the length of A. - -static void -H_heapify_min (CMK_Node *A, octave_idx_type i, octave_idx_type size) -{ - octave_idx_type j = i; - for (;;) - { - octave_idx_type l = LEFT(j); - octave_idx_type r = RIGHT(j); - - octave_idx_type smallest; - if (l < size && A[l].deg < A[j].deg) - smallest = l; - else - smallest = j; - - if (r < size && A[r].deg < A[smallest].deg) - smallest = r; - - if (smallest != j) - { - std::swap (A[j], A[smallest]); - j = smallest; - } - else - break; - } -} - -// Heap operation insert. Running time is O(log(n)) - -static void -H_insert (CMK_Node *H, octave_idx_type& h, const CMK_Node& o) -{ - octave_idx_type i = h++; - - H[i] = o; - - if (i == 0) - return; - do - { - octave_idx_type p = PARENT(i); - if (H[i].deg < H[p].deg) - { - std::swap (H[i], H[p]); - - i = p; - } - else - break; - } - while (i > 0); -} - -// Heap operation remove-min. Removes the smalles element in O(1) and -// reorganizes the heap optionally in O(log(n)) - -inline static CMK_Node -H_remove_min (CMK_Node *H, octave_idx_type& h, int reorg/*=1*/) -{ - CMK_Node r = H[0]; - H[0] = H[--h]; - if (reorg) - H_heapify_min (H, 0, h); - return r; -} - -// Predicate (heap empty) -#define H_empty(H, h) ((h) == 0) - -// Helper function for the Cuthill-McKee algorithm. Tries to determine a -// pseudo-peripheral node of the graph as starting node. - -static octave_idx_type -find_starting_node (octave_idx_type N, const octave_idx_type *ridx, - const octave_idx_type *cidx, const octave_idx_type *ridx2, - const octave_idx_type *cidx2, octave_idx_type *D, - octave_idx_type start) -{ - CMK_Node w; - - OCTAVE_LOCAL_BUFFER (CMK_Node, Q, N+1); - boolNDArray btmp (dim_vector (1, N), false); - bool *visit = btmp.fortran_vec (); - - octave_idx_type qh = 0; - octave_idx_type qt = 0; - CMK_Node x; - x.id = start; - x.deg = D[start]; - x.dist = 0; - Q_enq (Q, N, qt, x); - visit[start] = true; - - // distance level - octave_idx_type level = 0; - // current largest "eccentricity" - octave_idx_type max_dist = 0; - - for (;;) - { - while (! Q_empty (Q, N, qh, qt)) - { - CMK_Node v = Q_deq (Q, N, qh); - - if (v.dist > x.dist || (v.id != x.id && v.deg > x.deg)) - x = v; - - octave_idx_type i = v.id; - - // add all unvisited neighbors to the queue - octave_idx_type j1 = cidx[i]; - octave_idx_type j2 = cidx2[i]; - while (j1 < cidx[i+1] || j2 < cidx2[i+1]) - { - OCTAVE_QUIT; - - if (j1 == cidx[i+1]) - { - octave_idx_type r2 = ridx2[j2++]; - if (! visit[r2]) - { - // the distance of node j is dist(i)+1 - w.id = r2; - w.deg = D[r2]; - w.dist = v.dist+1; - Q_enq (Q, N, qt, w); - visit[r2] = true; - - if (w.dist > level) - level = w.dist; - } - } - else if (j2 == cidx2[i+1]) - { - octave_idx_type r1 = ridx[j1++]; - if (! visit[r1]) - { - // the distance of node j is dist(i)+1 - w.id = r1; - w.deg = D[r1]; - w.dist = v.dist+1; - Q_enq (Q, N, qt, w); - visit[r1] = true; - - if (w.dist > level) - level = w.dist; - } - } - else - { - octave_idx_type r1 = ridx[j1]; - octave_idx_type r2 = ridx2[j2]; - if (r1 <= r2) - { - if (! visit[r1]) - { - w.id = r1; - w.deg = D[r1]; - w.dist = v.dist+1; - Q_enq (Q, N, qt, w); - visit[r1] = true; - - if (w.dist > level) - level = w.dist; - } - j1++; - if (r1 == r2) - j2++; - } - else - { - if (! visit[r2]) - { - w.id = r2; - w.deg = D[r2]; - w.dist = v.dist+1; - Q_enq (Q, N, qt, w); - visit[r2] = true; - - if (w.dist > level) - level = w.dist; - } - j2++; - } - } - } - } // finish of BFS - - if (max_dist < x.dist) - { - max_dist = x.dist; - - for (octave_idx_type i = 0; i < N; i++) - visit[i] = false; - - visit[x.id] = true; - x.dist = 0; - qt = qh = 0; - Q_enq (Q, N, qt, x); - } - else - break; - } - return x.id; -} - -// Calculates the node's degrees. This means counting the non-zero elements -// in the symmetric matrix' rows. This works for non-symmetric matrices -// as well. - -static octave_idx_type -calc_degrees (octave_idx_type N, const octave_idx_type *ridx, - const octave_idx_type *cidx, octave_idx_type *D) -{ - octave_idx_type max_deg = 0; - - for (octave_idx_type i = 0; i < N; i++) - D[i] = 0; - - for (octave_idx_type j = 0; j < N; j++) - { - for (octave_idx_type i = cidx[j]; i < cidx[j+1]; i++) - { - OCTAVE_QUIT; - octave_idx_type k = ridx[i]; - // there is a non-zero element (k,j) - D[k]++; - if (D[k] > max_deg) - max_deg = D[k]; - // if there is no element (j,k) there is one in - // the symmetric matrix: - if (k != j) - { - bool found = false; - for (octave_idx_type l = cidx[k]; l < cidx[k + 1]; l++) - { - OCTAVE_QUIT; - - if (ridx[l] == j) - { - found = true; - break; - } - else if (ridx[l] > j) - break; - } - - if (! found) - { - // A(j,k) == 0 - D[j]++; - if (D[j] > max_deg) - max_deg = D[j]; - } - } - } - } - return max_deg; -} - -// Transpose of the structure of a square sparse matrix - -static void -transpose (octave_idx_type N, const octave_idx_type *ridx, - const octave_idx_type *cidx, octave_idx_type *ridx2, - octave_idx_type *cidx2) -{ - octave_idx_type nz = cidx[N]; - - OCTAVE_LOCAL_BUFFER (octave_idx_type, w, N + 1); - for (octave_idx_type i = 0; i < N; i++) - w[i] = 0; - for (octave_idx_type i = 0; i < nz; i++) - w[ridx[i]]++; - nz = 0; - for (octave_idx_type i = 0; i < N; i++) - { - OCTAVE_QUIT; - cidx2[i] = nz; - nz += w[i]; - w[i] = cidx2[i]; - } - cidx2[N] = nz; - w[N] = nz; - - for (octave_idx_type j = 0; j < N; j++) - for (octave_idx_type k = cidx[j]; k < cidx[j + 1]; k++) - { - OCTAVE_QUIT; - octave_idx_type q = w[ridx[k]]++; - ridx2[q] = j; - } -} - -// An implementation of the Cuthill-McKee algorithm. -DEFUN_DLD (symrcm, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} symrcm (@var{S})\n\ -Return the symmetric reverse Cuthill-McKee permutation of @var{S}.\n\ -@var{p} is a permutation vector such that\n\ -@code{@var{S}(@var{p}, @var{p})} tends to have its diagonal elements\n\ -closer to the diagonal than @var{S}. This is a good preordering for LU\n\ -or Cholesky@tie{}factorization of matrices that come from ``long, skinny''\n\ -problems. It works for both symmetric and asymmetric @var{S}.\n\ -\n\ -The algorithm represents a heuristic approach to the NP-complete\n\ -bandwidth minimization problem. The implementation is based in the\n\ -descriptions found in\n\ -\n\ -E. Cuthill, J. McKee. @cite{Reducing the Bandwidth of Sparse Symmetric\n\ -Matrices}. Proceedings of the 24th ACM National Conference, 157--172\n\ -1969, Brandon Press, New Jersey.\n\ -\n\ -A. George, J.W.H. Liu. @cite{Computer Solution of Large Sparse\n\ -Positive Definite Systems}, Prentice Hall Series in Computational\n\ -Mathematics, ISBN 0-13-165274-5, 1981.\n\ -\n\ -@seealso{colperm, colamd, symamd}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin != 1) - { - print_usage (); - return retval; - } - - octave_value arg = args(0); - - // the parameter of the matrix is converted into a sparse matrix - //(if necessary) - octave_idx_type *cidx; - octave_idx_type *ridx; - SparseMatrix Ar; - SparseComplexMatrix Ac; - - if (arg.is_real_type ()) - { - Ar = arg.sparse_matrix_value (); - // Note cidx/ridx are const, so use xridx and xcidx... - cidx = Ar.xcidx (); - ridx = Ar.xridx (); - } - else - { - Ac = arg.sparse_complex_matrix_value (); - cidx = Ac.xcidx (); - ridx = Ac.xridx (); - } - - if (error_state) - return retval; - - octave_idx_type nr = arg.rows (); - octave_idx_type nc = arg.columns (); - - if (nr != nc) - { - gripe_square_matrix_required ("symrcm"); - return retval; - } - - if (nr == 0 && nc == 0) - return octave_value (NDArray (dim_vector (1, 0))); - - // sizes of the heaps - octave_idx_type s = 0; - - // head- and tail-indices for the queue - octave_idx_type qt = 0, qh = 0; - CMK_Node v, w; - // dimension of the matrix - octave_idx_type N = nr; - - OCTAVE_LOCAL_BUFFER (octave_idx_type, cidx2, N + 1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, ridx2, cidx[N]); - transpose (N, ridx, cidx, ridx2, cidx2); - - // the permutation vector - NDArray P (dim_vector (1, N)); - - // compute the node degrees - OCTAVE_LOCAL_BUFFER (octave_idx_type, D, N); - octave_idx_type max_deg = calc_degrees (N, ridx, cidx, D); - - // if none of the nodes has a degree > 0 (a matrix of zeros) - // the return value corresponds to the identity permutation - if (max_deg == 0) - { - for (octave_idx_type i = 0; i < N; i++) - P(i) = i; - return octave_value (P); - } - - // a heap for the a node's neighbors. The number of neighbors is - // limited by the maximum degree max_deg: - OCTAVE_LOCAL_BUFFER (CMK_Node, S, max_deg); - - // a queue for the BFS. The array is always one element larger than - // the number of entries that are stored. - OCTAVE_LOCAL_BUFFER (CMK_Node, Q, N+1); - - // a counter (for building the permutation) - octave_idx_type c = -1; - - // upper bound for the bandwidth (=quality of solution) - // initialize the bandwidth of the graph with 0. B contains the - // the maximum of the theoretical lower limits of the subgraphs - // bandwidths. - octave_idx_type B = 0; - - // mark all nodes as unvisited; with the exception of the nodes - // that have degree==0 and build a CC of the graph. - - boolNDArray btmp (dim_vector (1, N), false); - bool *visit = btmp.fortran_vec (); - - do - { - // locate an unvisited starting node of the graph - octave_idx_type i; - for (i = 0; i < N; i++) - if (! visit[i]) - break; - - // locate a probably better starting node - v.id = find_starting_node (N, ridx, cidx, ridx2, cidx2, D, i); - - // mark the node as visited and enqueue it (a starting node - // for the BFS). Since the node will be a root of a spanning - // tree, its dist is 0. - v.deg = D[v.id]; - v.dist = 0; - visit[v.id] = true; - Q_enq (Q, N, qt, v); - - // lower bound for the bandwidth of a subgraph - // keep a "level" in the spanning tree (= min. distance to the - // root) for determining the bandwidth of the computed - // permutation P - octave_idx_type Bsub = 0; - // min. dist. to the root is 0 - octave_idx_type level = 0; - // the root is the first/only node on level 0 - octave_idx_type level_N = 1; - - while (! Q_empty (Q, N, qh, qt)) - { - v = Q_deq (Q, N, qh); - i = v.id; - - c++; - - // for computing the inverse permutation P where - // A(inv(P),inv(P)) or P'*A*P is banded - // P(i) = c; - - // for computing permutation P where - // A(P(i),P(j)) or P*A*P' is banded - P(c) = i; - - // put all unvisited neighbors j of node i on the heap - s = 0; - octave_idx_type j1 = cidx[i]; - octave_idx_type j2 = cidx2[i]; - - OCTAVE_QUIT; - while (j1 < cidx[i+1] || j2 < cidx2[i+1]) - { - OCTAVE_QUIT; - if (j1 == cidx[i+1]) - { - octave_idx_type r2 = ridx2[j2++]; - if (! visit[r2]) - { - // the distance of node j is dist(i)+1 - w.id = r2; - w.deg = D[r2]; - w.dist = v.dist+1; - H_insert (S, s, w); - visit[r2] = true; - } - } - else if (j2 == cidx2[i+1]) - { - octave_idx_type r1 = ridx[j1++]; - if (! visit[r1]) - { - w.id = r1; - w.deg = D[r1]; - w.dist = v.dist+1; - H_insert (S, s, w); - visit[r1] = true; - } - } - else - { - octave_idx_type r1 = ridx[j1]; - octave_idx_type r2 = ridx2[j2]; - if (r1 <= r2) - { - if (! visit[r1]) - { - w.id = r1; - w.deg = D[r1]; - w.dist = v.dist+1; - H_insert (S, s, w); - visit[r1] = true; - } - j1++; - if (r1 == r2) - j2++; - } - else - { - if (! visit[r2]) - { - w.id = r2; - w.deg = D[r2]; - w.dist = v.dist+1; - H_insert (S, s, w); - visit[r2] = true; - } - j2++; - } - } - } - - // add the neighbors to the queue (sorted by node degree) - while (! H_empty (S, s)) - { - OCTAVE_QUIT; - - // locate a neighbor of i with minimal degree in O(log(N)) - v = H_remove_min (S, s, 1); - - // entered the BFS a new level? - if (v.dist > level) - { - // adjustment of bandwith: - // "[...] the minimum bandwidth that - // can be obtained [...] is the - // maximum number of nodes per level" - if (Bsub < level_N) - Bsub = level_N; - - level = v.dist; - // v is the first node on the new level - level_N = 1; - } - else - { - // there is no new level but another node on - // this level: - level_N++; - } - - // enqueue v in O(1) - Q_enq (Q, N, qt, v); - } - - // synchronize the bandwidth with level_N once again: - if (Bsub < level_N) - Bsub = level_N; - } - // finish of BFS. If there are still unvisited nodes in the graph - // then it is split into CCs. The computed bandwidth is the maximum - // of all subgraphs. Update: - if (Bsub > B) - B = Bsub; - } - // are there any nodes left? - while (c+1 < N); - - // compute the reverse-ordering - s = N / 2 - 1; - for (octave_idx_type i = 0, j = N - 1; i <= s; i++, j--) - std::swap (P.elem (i), P.elem (j)); - - // increment all indices, since Octave is not C - return octave_value (P+1); -} diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/tsearch.cc --- a/src/DLD-FUNCTIONS/tsearch.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,186 +0,0 @@ -/* - -Copyright (C) 2002-2012 Andreas Stahel - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: Andreas Stahel - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "lo-ieee.h" -#include "lo-math.h" - -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" -#include "parse.h" - -inline double max (double a, double b, double c) -{ - if (a < b) - return (b < c ? c : b); - else - return (a < c ? c : a); -} - -inline double min (double a, double b, double c) -{ - if (a > b) - return (b > c ? c : b); - else - return (a > c ? c : a); -} - -#define REF(x,k,i) x(static_cast(elem((k), (i))) - 1) - -// for large data set the algorithm is very slow -// one should presort (how?) either the elements of the points of evaluation -// to cut down the time needed to decide which triangle contains the -// given point - -// e.g., build up a neighbouring triangle structure and use a simplex-like -// method to traverse it - -DEFUN_DLD (tsearch, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{idx} =} tsearch (@var{x}, @var{y}, @var{t}, @var{xi}, @var{yi})\n\ -Search for the enclosing Delaunay convex hull. For @code{@var{t} =\n\ -delaunay (@var{x}, @var{y})}, finds the index in @var{t} containing the\n\ -points @code{(@var{xi}, @var{yi})}. For points outside the convex hull,\n\ -@var{idx} is NaN.\n\ -@seealso{delaunay, delaunayn}\n\ -@end deftypefn") -{ - const double eps=1.0e-12; - - octave_value_list retval; - const int nargin = args.length (); - if (nargin != 5) - { - print_usage (); - return retval; - } - - const ColumnVector x (args(0).vector_value ()); - const ColumnVector y (args(1).vector_value ()); - const Matrix elem (args(2).matrix_value ()); - const ColumnVector xi (args(3).vector_value ()); - const ColumnVector yi (args(4).vector_value ()); - - if (error_state) - return retval; - - const octave_idx_type nelem = elem.rows (); - - ColumnVector minx (nelem); - ColumnVector maxx (nelem); - ColumnVector miny (nelem); - ColumnVector maxy (nelem); - for (octave_idx_type k = 0; k < nelem; k++) - { - minx(k) = min (REF (x, k, 0), REF (x, k, 1), REF (x, k, 2)) - eps; - maxx(k) = max (REF (x, k, 0), REF (x, k, 1), REF (x, k, 2)) + eps; - miny(k) = min (REF (y, k, 0), REF (y, k, 1), REF (y, k, 2)) - eps; - maxy(k) = max (REF (y, k, 0), REF (y, k, 1), REF (y, k, 2)) + eps; - } - - const octave_idx_type np = xi.length (); - ColumnVector values (np); - - double x0 = 0.0, y0 = 0.0; - double a11 = 0.0, a12 = 0.0, a21 = 0.0, a22 = 0.0, det = 0.0; - - octave_idx_type k = nelem; // k is a counter of elements - for (octave_idx_type kp = 0; kp < np; kp++) - { - const double xt = xi(kp); - const double yt = yi(kp); - - // check if last triangle contains the next point - if (k < nelem) - { - const double dx1 = xt - x0; - const double dx2 = yt - y0; - const double c1 = (a22 * dx1 - a21 * dx2) / det; - const double c2 = (-a12 * dx1 + a11 * dx2) / det; - if (c1 >= -eps && c2 >= -eps && (c1 + c2) <= (1 + eps)) - { - values(kp) = double(k+1); - continue; - } - } - - // it doesn't, so go through all elements - for (k = 0; k < nelem; k++) - { - OCTAVE_QUIT; - if (xt >= minx(k) && xt <= maxx(k) && yt >= miny(k) && yt <= maxy(k)) - { - // element inside the minimum rectangle: examine it closely - x0 = REF (x, k, 0); - y0 = REF (y, k, 0); - a11 = REF (x, k, 1) - x0; - a12 = REF (y, k, 1) - y0; - a21 = REF (x, k, 2) - x0; - a22 = REF (y, k, 2) - y0; - det = a11 * a22 - a21 * a12; - - // solve the system - const double dx1 = xt - x0; - const double dx2 = yt - y0; - const double c1 = (a22 * dx1 - a21 * dx2) / det; - const double c2 = (-a12 * dx1 + a11 * dx2) / det; - if ((c1 >= -eps) && (c2 >= -eps) && ((c1 + c2) <= (1 + eps))) - { - values(kp) = double(k+1); - break; - } - } //endif # examine this element closely - } //endfor # each element - - if (k == nelem) - values(kp) = lo_ieee_nan_value (); - - } //endfor # kp - - retval(0) = values; - - return retval; -} - -/* -%!shared x, y, tri -%! x = [-1;-1;1]; -%! y = [-1;1;-1]; -%! tri = [1, 2, 3]; -%!assert (tsearch (x,y,tri,-1,-1), 1) -%!assert (tsearch (x,y,tri, 1,-1), 1) -%!assert (tsearch (x,y,tri,-1, 1), 1) -%!assert (tsearch (x,y,tri,-1/3, -1/3), 1) -%!assert (tsearch (x,y,tri, 1, 1), NaN) - -%!error tsearch () -*/ diff -r d02b229ce693 -r a132d206a36a src/DLD-FUNCTIONS/urlwrite.cc --- a/src/DLD-FUNCTIONS/urlwrite.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1740 +0,0 @@ -// urlwrite and urlread, a curl front-end for octave -/* - -Copyright (C) 2006-2012 Alexander Barth -Copyright (C) 2009 David Bateman - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: Alexander Barth -// Adapted-By: jwe - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include - -#include "dir-ops.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "glob-match.h" - -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" -#include "ov-cell.h" -#include "pager.h" -#include "oct-map.h" -#include "oct-refcount.h" -#include "unwind-prot.h" - -#ifdef HAVE_CURL - -#include -#include -#include - -// Backwards compatibility for curl < 7.17.0 -#if LIBCURL_VERSION_NUM < 0x071100 -#define CURLOPT_DIRLISTONLY CURLOPT_FTPLISTONLY -#endif - -static int -write_data (void *buffer, size_t size, size_t nmemb, void *streamp) -{ - std::ostream& stream = *(static_cast (streamp)); - stream.write (static_cast (buffer), size*nmemb); - return (stream.fail () ? 0 : size * nmemb); -} - -static int -read_data (void *buffer, size_t size, size_t nmemb, void *streamp) -{ - std::istream& stream = *(static_cast (streamp)); - stream.read (static_cast (buffer), size*nmemb); - if (stream.eof ()) - return stream.gcount (); - else - return (stream.fail () ? 0 : size * nmemb); -} - -static size_t -throw_away (void *, size_t size, size_t nmemb, void *) -{ - return static_cast(size * nmemb); -} - -class -curl_handle -{ -private: - class - curl_handle_rep - { - public: - curl_handle_rep (void) : count (1), valid (true), ascii (false) - { - curl = curl_easy_init (); - if (!curl) - error ("can not create curl handle"); - } - - ~curl_handle_rep (void) - { - if (curl) - curl_easy_cleanup (curl); - } - - bool is_valid (void) const - { - return valid; - } - - bool perform (bool curlerror) const - { - bool retval = false; - if (!error_state) - { - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - errnum = curl_easy_perform (curl); - if (errnum != CURLE_OK) - { - if (curlerror) - error ("%s", curl_easy_strerror (errnum)); - } - else - retval = true; - - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - return retval; - } - - CURL* handle (void) const - { - return curl; - } - - bool is_ascii (void) const - { - return ascii; - } - - bool is_binary (void) const - { - return !ascii; - } - - octave_refcount count; - std::string host; - bool valid; - bool ascii; - mutable CURLcode errnum; - - private: - CURL *curl; - - // No copying! - - curl_handle_rep (const curl_handle_rep& ov); - - curl_handle_rep& operator = (const curl_handle_rep&); - }; - -public: - -// I'd love to rewrite this as a private method of the curl_handle -// class, but you can't pass the va_list from the wrapper setopt to -// the curl_easy_setopt function. -#define setopt(option, parameter) \ - { \ - CURLcode res = curl_easy_setopt (rep->handle (), option, parameter); \ - if (res != CURLE_OK) \ - error ("%s", curl_easy_strerror (res)); \ - } - - curl_handle (void) : rep (new curl_handle_rep ()) - { - rep->valid = false; - } - - curl_handle (const std::string& _host, const std::string& user, - const std::string& passwd) : - rep (new curl_handle_rep ()) - { - rep->host = _host; - init (user, passwd, std::cin, octave_stdout); - - std::string url = "ftp://" + _host; - setopt (CURLOPT_URL, url.c_str ()); - - // Setup the link, with no transfer - if (!error_state) - perform (); - } - - curl_handle (const std::string& url, const std::string& method, - const Cell& param, std::ostream& os, bool& retval) : - rep (new curl_handle_rep ()) - { - retval = false; - - init ("", "", std::cin, os); - - setopt (CURLOPT_NOBODY, 0); - - // Don't need to store the parameters here as we can't change - // the URL after the handle is created - std::string query_string = form_query_string (param); - - if (method == "get") - { - query_string = url + "?" + query_string; - setopt (CURLOPT_URL, query_string.c_str ()); - } - else if (method == "post") - { - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_POSTFIELDS, query_string.c_str ()); - } - else - setopt (CURLOPT_URL, url.c_str ()); - - if (!error_state) - retval = perform (false); - } - - curl_handle (const curl_handle& h) : rep (h.rep) - { - rep->count++; - } - - ~curl_handle (void) - { - if (--rep->count == 0) - delete rep; - } - - curl_handle& operator = (const curl_handle& h) - { - if (this != &h) - { - if (--rep->count == 0) - delete rep; - - rep = h.rep; - rep->count++; - } - return *this; - } - - bool is_valid (void) const - { - return rep->is_valid (); - } - - std::string lasterror (void) const - { - return std::string (curl_easy_strerror (rep->errnum)); - } - - void set_ostream (std::ostream& os) const - { - setopt (CURLOPT_WRITEDATA, static_cast (&os)); - } - - void set_istream (std::istream& is) const - { - setopt (CURLOPT_READDATA, static_cast (&is)); - } - - void ascii (void) const - { - setopt (CURLOPT_TRANSFERTEXT, 1); - rep->ascii = true; - } - - void binary (void) const - { - setopt (CURLOPT_TRANSFERTEXT, 0); - rep->ascii = false; - } - - bool is_ascii (void) const - { - return rep->is_ascii (); - } - - bool is_binary (void) const - { - return rep->is_binary (); - } - - void cwd (const std::string& path) const - { - struct curl_slist *slist = 0; - std::string cmd = "cwd " + path; - slist = curl_slist_append (slist, cmd.c_str ()); - setopt (CURLOPT_POSTQUOTE, slist); - if (! error_state) - perform (); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - } - - void del (const std::string& file) const - { - struct curl_slist *slist = 0; - std::string cmd = "dele " + file; - slist = curl_slist_append (slist, cmd.c_str ()); - setopt (CURLOPT_POSTQUOTE, slist); - if (! error_state) - perform (); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - } - - void rmdir (const std::string& path) const - { - struct curl_slist *slist = 0; - std::string cmd = "rmd " + path; - slist = curl_slist_append (slist, cmd.c_str ()); - setopt (CURLOPT_POSTQUOTE, slist); - if (! error_state) - perform (); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - } - - bool mkdir (const std::string& path, bool curlerror = true) const - { - bool retval = false; - struct curl_slist *slist = 0; - std::string cmd = "mkd " + path; - slist = curl_slist_append (slist, cmd.c_str ()); - setopt (CURLOPT_POSTQUOTE, slist); - if (! error_state) - retval = perform (curlerror); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - return retval; - } - - void rename (const std::string& oldname, const std::string& newname) const - { - struct curl_slist *slist = 0; - std::string cmd = "rnfr " + oldname; - slist = curl_slist_append (slist, cmd.c_str ()); - cmd = "rnto " + newname; - slist = curl_slist_append (slist, cmd.c_str ()); - setopt (CURLOPT_POSTQUOTE, slist); - if (! error_state) - perform (); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - } - - void put (const std::string& file, std::istream& is) const - { - std::string url = "ftp://" + rep->host + "/" + file; - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_UPLOAD, 1); - setopt (CURLOPT_NOBODY, 0); - set_istream (is); - if (! error_state) - perform (); - set_istream (std::cin); - setopt (CURLOPT_NOBODY, 1); - setopt (CURLOPT_UPLOAD, 0); - url = "ftp://" + rep->host; - setopt (CURLOPT_URL, url.c_str ()); - } - - void get (const std::string& file, std::ostream& os) const - { - std::string url = "ftp://" + rep->host + "/" + file; - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_NOBODY, 0); - set_ostream (os); - if (! error_state) - perform (); - set_ostream (octave_stdout); - setopt (CURLOPT_NOBODY, 1); - url = "ftp://" + rep->host; - setopt (CURLOPT_URL, url.c_str ()); - } - - void dir (void) const - { - std::string url = "ftp://" + rep->host + "/"; - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_NOBODY, 0); - if (! error_state) - perform (); - setopt (CURLOPT_NOBODY, 1); - url = "ftp://" + rep->host; - setopt (CURLOPT_URL, url.c_str ()); - } - - string_vector list (void) const - { - std::ostringstream buf; - std::string url = "ftp://" + rep->host + "/"; - setopt (CURLOPT_WRITEDATA, static_cast (&buf)); - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_DIRLISTONLY, 1); - setopt (CURLOPT_NOBODY, 0); - if (! error_state) - perform (); - setopt (CURLOPT_NOBODY, 1); - url = "ftp://" + rep->host; - setopt (CURLOPT_WRITEDATA, static_cast (&octave_stdout)); - setopt (CURLOPT_DIRLISTONLY, 0); - setopt (CURLOPT_URL, url.c_str ()); - - // Count number of directory entries - std::string str = buf.str (); - octave_idx_type n = 0; - size_t pos = 0; - while (true) - { - pos = str.find_first_of ('\n', pos); - if (pos == std::string::npos) - break; - pos++; - n++; - } - string_vector retval (n); - pos = 0; - for (octave_idx_type i = 0; i < n; i++) - { - size_t newpos = str.find_first_of ('\n', pos); - if (newpos == std::string::npos) - break; - - retval(i) = str.substr(pos, newpos - pos); - pos = newpos + 1; - } - return retval; - } - - void get_fileinfo (const std::string& filename, double& filesize, - time_t& filetime, bool& fileisdir) const - { - std::string path = pwd (); - - std::string url = "ftp://" + rep->host + "/" + path + "/" + filename; - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_FILETIME, 1); - setopt (CURLOPT_HEADERFUNCTION, throw_away); - setopt (CURLOPT_WRITEFUNCTION, throw_away); - - // FIXME - // The MDTM command fails for a directory on the servers I tested - // so this is a means of testing for directories. It also means - // I can't get the date of directories! - if (! error_state) - { - if (! perform (false)) - { - fileisdir = true; - filetime = -1; - filesize = 0; - } - else - { - fileisdir = false; - time_t ft; - curl_easy_getinfo (rep->handle (), CURLINFO_FILETIME, &ft); - filetime = ft; - double fs; - curl_easy_getinfo (rep->handle (), - CURLINFO_CONTENT_LENGTH_DOWNLOAD, &fs); - filesize = fs; - } - } - - setopt (CURLOPT_WRITEFUNCTION, write_data); - setopt (CURLOPT_HEADERFUNCTION, 0); - setopt (CURLOPT_FILETIME, 0); - url = "ftp://" + rep->host; - setopt (CURLOPT_URL, url.c_str ()); - - // The MDTM command seems to reset the path to the root with the - // servers I tested with, so cd again into the correct path. Make - // the path absolute so that this will work even with servers that - // don't end up in the root after an MDTM command. - cwd ("/" + path); - } - - std::string pwd (void) const - { - struct curl_slist *slist = 0; - std::string retval; - std::ostringstream buf; - - slist = curl_slist_append (slist, "pwd"); - setopt (CURLOPT_POSTQUOTE, slist); - setopt (CURLOPT_HEADERFUNCTION, write_data); - setopt (CURLOPT_WRITEHEADER, static_cast(&buf)); - - if (! error_state) - { - perform (); - retval = buf.str (); - - // Can I assume that the path is alway in "" on the last line - size_t pos2 = retval.rfind ('"'); - size_t pos1 = retval.rfind ('"', pos2 - 1); - retval = retval.substr (pos1 + 1, pos2 - pos1 - 1); - } - setopt (CURLOPT_HEADERFUNCTION, 0); - setopt (CURLOPT_WRITEHEADER, 0); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - - return retval; - } - - bool perform (bool curlerror = true) const - { - return rep->perform (curlerror); - } - -private: - curl_handle_rep *rep; - - std::string form_query_string (const Cell& param) - { - std::ostringstream query; - - for (int i = 0; i < param.numel (); i += 2) - { - std::string name = param(i).string_value (); - std::string text = param(i+1).string_value (); - - // Encode strings. - char *enc_name = curl_easy_escape (rep->handle (), name.c_str (), - name.length ()); - char *enc_text = curl_easy_escape (rep->handle (), text.c_str (), - text.length ()); - - query << enc_name << "=" << enc_text; - - curl_free (enc_name); - curl_free (enc_text); - - if (i < param.numel ()-1) - query << "&"; - } - - query.flush (); - - return query.str (); - } - - void init (const std::string& user, const std::string& passwd, - std::istream& is, std::ostream& os) - { - // No data transfer by default - setopt (CURLOPT_NOBODY, 1); - - // Set the username and password - std::string userpwd = user; - if (! passwd.empty ()) - userpwd += ":" + passwd; - if (! userpwd.empty ()) - setopt (CURLOPT_USERPWD, userpwd.c_str ()); - - // Define our callback to get called when there's data to be written. - setopt (CURLOPT_WRITEFUNCTION, write_data); - - // Set a pointer to our struct to pass to the callback. - setopt (CURLOPT_WRITEDATA, static_cast (&os)); - - // Define our callback to get called when there's data to be read - setopt (CURLOPT_READFUNCTION, read_data); - - // Set a pointer to our struct to pass to the callback. - setopt (CURLOPT_READDATA, static_cast (&is)); - - // Follow redirects. - setopt (CURLOPT_FOLLOWLOCATION, true); - - // Don't use EPSV since connecting to sites that don't support it - // will hang for some time (3 minutes?) before moving on to try PASV - // instead. - setopt (CURLOPT_FTP_USE_EPSV, false); - - setopt (CURLOPT_NOPROGRESS, true); - setopt (CURLOPT_FAILONERROR, true); - - setopt (CURLOPT_POSTQUOTE, 0); - setopt (CURLOPT_QUOTE, 0); - } - -#undef setopt -}; - -class -curl_handles -{ -public: - - typedef std::map::iterator iterator; - typedef std::map::const_iterator const_iterator; - - curl_handles (void) : map () - { - curl_global_init (CURL_GLOBAL_DEFAULT); - } - - ~curl_handles (void) - { - // Remove the elements of the map explicitly as they should - // be deleted before the call to curl_global_cleanup - map.erase (begin (), end ()); - - curl_global_cleanup (); - } - - iterator begin (void) { return iterator (map.begin ()); } - const_iterator begin (void) const { return const_iterator (map.begin ()); } - - iterator end (void) { return iterator (map.end ()); } - const_iterator end (void) const { return const_iterator (map.end ()); } - - iterator seek (const std::string& k) { return map.find (k); } - const_iterator seek (const std::string& k) const { return map.find (k); } - - std::string key (const_iterator p) const { return p->first; } - - curl_handle& contents (const std::string& k) - { - return map[k]; - } - - curl_handle contents (const std::string& k) const - { - const_iterator p = seek (k); - return p != end () ? p->second : curl_handle (); - } - - curl_handle& contents (iterator p) - { return p->second; } - - curl_handle contents (const_iterator p) const - { return p->second; } - - void del (const std::string& k) - { - iterator p = map.find (k); - - if (p != map.end ()) - map.erase (p); - } - -private: - std::map map; -}; - -static curl_handles handles; - -static void -cleanup_urlwrite (std::string filename) -{ - octave_unlink (filename); -} - -static void -reset_path (const curl_handle curl) -{ - curl.cwd (".."); -} - -static void -delete_file (std::string file) -{ - octave_unlink (file); -} -#endif - -DEFUN_DLD (urlwrite, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} urlwrite (@var{url}, @var{localfile})\n\ -@deftypefnx {Loadable Function} {@var{f} =} urlwrite (@var{url}, @var{localfile})\n\ -@deftypefnx {Loadable Function} {[@var{f}, @var{success}] =} urlwrite (@var{url}, @var{localfile})\n\ -@deftypefnx {Loadable Function} {[@var{f}, @var{success}, @var{message}] =} urlwrite (@var{url}, @var{localfile})\n\ -Download a remote file specified by its @var{url} and save it as\n\ -@var{localfile}. For example:\n\ -\n\ -@example\n\ -@group\n\ -urlwrite (\"ftp://ftp.octave.org/pub/octave/README\",\n\ - \"README.txt\");\n\ -@end group\n\ -@end example\n\ -\n\ -The full path of the downloaded file is returned in @var{f}. The\n\ -variable @var{success} is 1 if the download was successful,\n\ -otherwise it is 0 in which case @var{message} contains an error\n\ -message. If no output argument is specified and an error occurs,\n\ -then the error is signaled through Octave's error handling mechanism.\n\ -\n\ -This function uses libcurl. Curl supports, among others, the HTTP,\n\ -FTP and FILE protocols. Username and password may be specified in\n\ -the URL, for example:\n\ -\n\ -@example\n\ -@group\n\ -urlwrite (\"http://username:password@@example.com/file.txt\",\n\ - \"file.txt\");\n\ -@end group\n\ -@end example\n\ -\n\ -GET and POST requests can be specified by @var{method} and @var{param}.\n\ -The parameter @var{method} is either @samp{get} or @samp{post}\n\ -and @var{param} is a cell array of parameter and value pairs.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -urlwrite (\"http://www.google.com/search\", \"search.html\",\n\ - \"get\", @{\"query\", \"octave\"@});\n\ -@end group\n\ -@end example\n\ -@seealso{urlread}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_CURL - - int nargin = args.length (); - - // verify arguments - if (nargin != 2 && nargin != 4) - { - print_usage (); - return retval; - } - - std::string url = args(0).string_value (); - - if (error_state) - { - error ("urlwrite: URL must be a character string"); - return retval; - } - - // name to store the file if download is succesful - std::string filename = args(1).string_value (); - - if (error_state) - { - error ("urlwrite: LOCALFILE must be a character string"); - return retval; - } - - std::string method; - Cell param; // empty cell array - - if (nargin == 4) - { - method = args(2).string_value (); - - if (error_state) - { - error ("urlwrite: METHOD must be \"get\" or \"post\""); - return retval; - } - - if (method != "get" && method != "post") - { - error ("urlwrite: METHOD must be \"get\" or \"post\""); - return retval; - } - - param = args(3).cell_value (); - - if (error_state) - { - error ("urlwrite: parameters (PARAM) for get and post requests must be given as a cell"); - return retval; - } - - - if (param.numel () % 2 == 1 ) - { - error ("urlwrite: number of elements in PARAM must be even"); - return retval; - } - } - - // The file should only be deleted if it doesn't initially exist, we - // create it, and the download fails. We use unwind_protect to do - // it so that the deletion happens no matter how we exit the function. - - file_stat fs (filename); - - std::ofstream ofile (filename.c_str (), std::ios::out | std::ios::binary); - - if (! ofile.is_open ()) - { - error ("urlwrite: unable to open file"); - return retval; - } - - unwind_protect_safe frame; - - frame.add_fcn (cleanup_urlwrite, filename); - - bool ok; - curl_handle curl = curl_handle (url, method, param, ofile, ok); - - ofile.close (); - - if (!error_state) - frame.discard (); - else - frame.run (); - - if (nargout > 0) - { - if (ok) - { - retval(2) = std::string (); - retval(1) = true; - retval(0) = octave_env::make_absolute (filename); - } - else - { - retval(2) = curl.lasterror (); - retval(1) = false; - retval(0) = std::string (); - } - } - - if (nargout < 2 && ! ok) - error ("urlwrite: curl: %s", curl.lasterror ().c_str ()); - -#else - error ("urlwrite: not available in this version of Octave"); -#endif - - return retval; -} - -DEFUN_DLD (urlread, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{s} =} urlread (@var{url})\n\ -@deftypefnx {Loadable Function} {[@var{s}, @var{success}] =} urlread (@var{url})\n\ -@deftypefnx {Loadable Function} {[@var{s}, @var{success}, @var{message}] =} urlread (@var{url})\n\ -@deftypefnx {Loadable Function} {[@dots{}] =} urlread (@var{url}, @var{method}, @var{param})\n\ -Download a remote file specified by its @var{url} and return its content\n\ -in string @var{s}. For example:\n\ -\n\ -@example\n\ -s = urlread (\"ftp://ftp.octave.org/pub/octave/README\");\n\ -@end example\n\ -\n\ -The variable @var{success} is 1 if the download was successful,\n\ -otherwise it is 0 in which case @var{message} contains an error\n\ -message. If no output argument is specified and an error occurs,\n\ -then the error is signaled through Octave's error handling mechanism.\n\ -\n\ -This function uses libcurl. Curl supports, among others, the HTTP,\n\ -FTP and FILE protocols. Username and password may be specified in the\n\ -URL@. For example:\n\ -\n\ -@example\n\ -s = urlread (\"http://user:password@@example.com/file.txt\");\n\ -@end example\n\ -\n\ -GET and POST requests can be specified by @var{method} and @var{param}.\n\ -The parameter @var{method} is either @samp{get} or @samp{post}\n\ -and @var{param} is a cell array of parameter and value pairs.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -s = urlread (\"http://www.google.com/search\", \"get\",\n\ - @{\"query\", \"octave\"@});\n\ -@end group\n\ -@end example\n\ -@seealso{urlwrite}\n\ -@end deftypefn") -{ - // Octave's return value - octave_value_list retval; - -#ifdef HAVE_CURL - - int nargin = args.length (); - - // verify arguments - if (nargin != 1 && nargin != 3) - { - print_usage (); - return retval; - } - - std::string url = args(0).string_value (); - - if (error_state) - { - error ("urlread: URL must be a character string"); - return retval; - } - - std::string method; - Cell param; // empty cell array - - if (nargin == 3) - { - method = args(1).string_value (); - - if (error_state) - { - error ("urlread: METHOD must be \"get\" or \"post\""); - return retval; - } - - if (method != "get" && method != "post") - { - error ("urlread: METHOD must be \"get\" or \"post\""); - return retval; - } - - param = args(2).cell_value (); - - if (error_state) - { - error ("urlread: parameters (PARAM) for get and post requests must be given as a cell"); - return retval; - } - - if (param.numel () % 2 == 1 ) - { - error ("urlread: number of elements in PARAM must be even"); - return retval; - } - } - - std::ostringstream buf; - - bool ok; - curl_handle curl = curl_handle (url, method, param, buf, ok); - - if (nargout > 0) - { - // Return empty string if no error occured. - retval(2) = ok ? "" : curl.lasterror (); - retval(1) = ok; - retval(0) = buf.str (); - } - - if (nargout < 2 && ! ok) - error ("urlread: curl: %s", curl.lasterror().c_str()); - -#else - error ("urlread: not available in this version of Octave"); -#endif - - return retval; -} - -DEFUN_DLD (__ftp__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp__ (@var{handle}, @var{host})\n\ -@deftypefnx {Loadable Function} {} __ftp__ (@var{handle}, @var{host}, @var{username}, @var{password})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - std::string handle; - std::string host; - std::string user = "anonymous"; - std::string passwd = ""; - - if (nargin < 2 || nargin > 4) - error ("incorrect number of arguments"); - else - { - handle = args(0).string_value (); - host = args(1).string_value (); - - if (nargin > 1) - user = args(2).string_value (); - - if (nargin > 2) - passwd = args(3).string_value (); - - if (!error_state) - { - handles.contents (handle) = curl_handle (host, user, passwd); - - if (error_state) - handles.del (handle); - } - } -#else - error ("__ftp__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_pwd__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_pwd__ (@var{handle})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ - octave_value retval; -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_pwd__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - retval = curl.pwd (); - else - error ("__ftp_pwd__: invalid ftp handle"); - } - } -#else - error ("__ftp_pwd__: not available in this version of Octave"); -#endif - - return retval; -} - -DEFUN_DLD (__ftp_cwd__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_cwd__ (@var{handle}, @var{path})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1 && nargin != 2) - error ("__ftp_cwd__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string path = ""; - - if (nargin > 1) - path = args(1).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.cwd (path); - else - error ("__ftp_cwd__: invalid ftp handle"); - } - } -#else - error ("__ftp_cwd__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_dir__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_dir__ (@var{handle})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ - octave_value retval; -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_dir__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - { - if (nargout == 0) - curl.dir (); - else - { - string_vector sv = curl.list (); - octave_idx_type n = sv.length (); - if (n == 0) - { - string_vector flds (5); - flds(0) = "name"; - flds(1) = "date"; - flds(2) = "bytes"; - flds(3) = "isdir"; - flds(4) = "datenum"; - retval = octave_map (flds); - } - else - { - octave_map st; - Cell filectime (dim_vector (n, 1)); - Cell filesize (dim_vector (n, 1)); - Cell fileisdir (dim_vector (n, 1)); - Cell filedatenum (dim_vector (n, 1)); - - st.assign ("name", Cell (sv)); - - for (octave_idx_type i = 0; i < n; i++) - { - time_t ftime; - bool fisdir; - double fsize; - - curl.get_fileinfo (sv(i), fsize, ftime, fisdir); - - fileisdir (i) = fisdir; - filectime (i) = ctime (&ftime); - filesize (i) = fsize; - filedatenum (i) = double (ftime); - } - st.assign ("date", filectime); - st.assign ("bytes", filesize); - st.assign ("isdir", fileisdir); - st.assign ("datenum", filedatenum); - retval = st; - } - } - } - else - error ("__ftp_dir__: invalid ftp handle"); - } - } -#else - error ("__ftp_dir__: not available in this version of Octave"); -#endif - - return retval; -} - -DEFUN_DLD (__ftp_ascii__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_ascii__ (@var{handle})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_ascii__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.ascii (); - else - error ("__ftp_ascii__: invalid ftp handle"); - } - } -#else - error ("__ftp_ascii__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_binary__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_binary__ (@var{handle})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_binary__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.binary (); - else - error ("__ftp_binary__: invalid ftp handle"); - } - } -#else - error ("__ftp_binary__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_close__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_close__ (@var{handle})\n\ - Undocumented internal function\n\ - @end deftypefn") - { - #ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_close__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - if (!error_state) - handles.del (handle); - } - #else - error ("__ftp_close__: not available in this version of Octave"); - #endif - - return octave_value (); - } - -DEFUN_DLD (__ftp_mode__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_mode__ (@var{handle})\n\ - Undocumented internal function\n\ - @end deftypefn") - { - octave_value retval; - #ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_mode__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - retval = (curl.is_ascii () ? "ascii" : "binary"); - else - error ("__ftp_binary__: invalid ftp handle"); - } - } - #else - error ("__ftp_mode__: not available in this version of Octave"); - #endif - - return retval; - } - -DEFUN_DLD (__ftp_delete__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_delete__ (@var{handle}, @var{path})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 2) - error ("__ftp_delete__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string file = args(1).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.del (file); - else - error ("__ftp_delete__: invalid ftp handle"); - } - } -#else - error ("__ftp_delete__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_rmdir__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_rmdir__ (@var{handle}, @var{path})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 2) - error ("__ftp_rmdir__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string dir = args(1).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.rmdir (dir); - else - error ("__ftp_rmdir__: invalid ftp handle"); - } - } -#else - error ("__ftp_rmdir__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_mkdir__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_mkdir__ (@var{handle}, @var{path})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 2) - error ("__ftp_mkdir__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string dir = args(1).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.mkdir (dir); - else - error ("__ftp_mkdir__: invalid ftp handle"); - } - } -#else - error ("__ftp_mkdir__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_rename__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_rename__ (@var{handle}, @var{path})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 3) - error ("__ftp_rename__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string oldname = args(1).string_value (); - std::string newname = args(2).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.rename (oldname, newname); - else - error ("__ftp_rename__: invalid ftp handle"); - } - } -#else - error ("__ftp_rename__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -#ifdef HAVE_CURL -static string_vector -mput_directory (const curl_handle& curl, const std::string& base, - const std::string& dir) -{ - string_vector retval; - - if (! curl.mkdir (dir, false)) - warning ("__ftp_mput__: can not create the remote directory ""%s""", - (base.length () == 0 ? dir : base + - file_ops::dir_sep_str () + dir).c_str ()); - - curl.cwd (dir); - - if (! error_state) - { - unwind_protect_safe frame; - - frame.add_fcn (reset_path, curl); - - std::string realdir = base.length () == 0 ? dir : base + - file_ops::dir_sep_str () + dir; - - dir_entry dirlist (realdir); - - if (dirlist) - { - string_vector files = dirlist.read (); - - for (octave_idx_type i = 0; i < files.length (); i++) - { - std::string file = files (i); - - if (file == "." || file == "..") - continue; - - std::string realfile = realdir + file_ops::dir_sep_str () + file; - file_stat fs (realfile); - - if (! fs.exists ()) - { - error ("__ftp__mput: file ""%s"" does not exist", - realfile.c_str ()); - break; - } - - if (fs.is_dir ()) - { - retval.append (mput_directory (curl, realdir, file)); - - if (error_state) - break; - } - else - { - // FIXME Does ascii mode need to be flagged here? - std::ifstream ifile (realfile.c_str (), std::ios::in | - std::ios::binary); - - if (! ifile.is_open ()) - { - error ("__ftp_mput__: unable to open file ""%s""", - realfile.c_str ()); - break; - } - - curl.put (file, ifile); - - ifile.close (); - - if (error_state) - break; - - retval.append (realfile); - } - } - } - else - error ("__ftp_mput__: can not read the directory ""%s""", - realdir.c_str ()); - } - - return retval; -} -#endif - -DEFUN_DLD (__ftp_mput__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_mput__ (@var{handle}, @var{files})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ - string_vector retval; - -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 2) - error ("__ftp_mput__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string pat = args(1).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - { - glob_match pattern (file_ops::tilde_expand (pat)); - string_vector files = pattern.glob (); - - for (octave_idx_type i = 0; i < files.length (); i++) - { - std::string file = files (i); - - file_stat fs (file); - - if (! fs.exists ()) - { - error ("__ftp__mput: file does not exist"); - break; - } - - if (fs.is_dir ()) - { - retval.append (mput_directory (curl, "", file)); - if (error_state) - break; - } - else - { - // FIXME Does ascii mode need to be flagged here? - std::ifstream ifile (file.c_str (), std::ios::in | - std::ios::binary); - - if (! ifile.is_open ()) - { - error ("__ftp_mput__: unable to open file"); - break; - } - - curl.put (file, ifile); - - ifile.close (); - - if (error_state) - break; - - retval.append (file); - } - } - } - else - error ("__ftp_mput__: invalid ftp handle"); - } - } -#else - error ("__ftp_mput__: not available in this version of Octave"); -#endif - - return (nargout > 0 ? octave_value (retval) : octave_value ()); -} - -#ifdef HAVE_CURL -static void -getallfiles (const curl_handle& curl, const std::string& dir, - const std::string& target) -{ - std::string sep = file_ops::dir_sep_str (); - file_stat fs (dir); - - if (!fs || !fs.is_dir ()) - { - std::string msg; - int status = octave_mkdir (dir, 0777, msg); - - if (status < 0) - error ("__ftp_mget__: can't create directory %s%s%s. %s", - target.c_str (), sep.c_str (), dir.c_str (), msg.c_str ()); - } - - if (! error_state) - { - curl.cwd (dir); - - if (! error_state) - { - unwind_protect_safe frame; - - frame.add_fcn (reset_path, curl); - - string_vector sv = curl.list (); - - for (octave_idx_type i = 0; i < sv.length (); i++) - { - time_t ftime; - bool fisdir; - double fsize; - - curl.get_fileinfo (sv(i), fsize, ftime, fisdir); - - if (fisdir) - getallfiles (curl, sv(i), target + dir + sep); - else - { - std::string realfile = target + dir + sep + sv(i); - std::ofstream ofile (realfile.c_str (), - std::ios::out | - std::ios::binary); - - if (! ofile.is_open ()) - { - error ("__ftp_mget__: unable to open file"); - break; - } - - unwind_protect_safe frame2; - - frame2.add_fcn (delete_file, realfile); - - curl.get (sv(i), ofile); - - ofile.close (); - - if (!error_state) - frame2.discard (); - else - frame2.run (); - } - - if (error_state) - break; - } - } - } -} -#endif - -DEFUN_DLD (__ftp_mget__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_mget__ (@var{handle}, @var{files})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 2 && nargin != 3) - error ("__ftp_mget__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string file = args(1).string_value (); - std::string target; - - if (nargin == 3) - target = args(2).string_value () + file_ops::dir_sep_str (); - - if (! error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - { - string_vector sv = curl.list (); - octave_idx_type n = 0; - glob_match pattern (file); - - for (octave_idx_type i = 0; i < sv.length (); i++) - { - if (pattern.match (sv(i))) - { - n++; - - time_t ftime; - bool fisdir; - double fsize; - - curl.get_fileinfo (sv(i), fsize, ftime, fisdir); - - if (fisdir) - getallfiles (curl, sv(i), target); - else - { - std::ofstream ofile ((target + sv(i)).c_str (), - std::ios::out | - std::ios::binary); - - if (! ofile.is_open ()) - { - error ("__ftp_mget__: unable to open file"); - break; - } - - unwind_protect_safe frame; - - frame.add_fcn (delete_file, target + sv(i)); - - curl.get (sv(i), ofile); - - ofile.close (); - - if (!error_state) - frame.discard (); - else - frame.run (); - } - - if (error_state) - break; - } - } - if (n == 0) - error ("__ftp_mget__: file not found"); - } - } - } -#else - error ("__ftp_mget__: not available in this version of Octave"); -#endif - - return octave_value (); -} diff -r d02b229ce693 -r a132d206a36a src/Makefile.am --- a/src/Makefile.am Thu Aug 02 12:12:00 2012 +0200 +++ b/src/Makefile.am Fri Aug 03 14:59:40 2012 -0400 @@ -22,11 +22,14 @@ ## Search local directories before those specified by the user. AM_CPPFLAGS = \ - -I../libgnu -I$(top_srcdir)/libgnu \ -I$(top_srcdir)/libcruft/misc \ -I../liboctave -I$(top_srcdir)/liboctave \ - -Icorefcn -I$(srcdir)/corefcn \ + -Iinterpfcn -I$(srcdir)/interpfcn \ + -Icorefcn \ + -Ioctave-value -I$(srcdir)/octave-value \ + -Iparse-tree -I$(srcdir)/parse-tree \ -I. -I$(srcdir) \ + -I../libgnu -I$(top_srcdir)/libgnu \ @CPPFLAGS@ AUTOMAKE_OPTIONS = subdir-objects @@ -64,28 +67,28 @@ ## (except builtins.cc) to be available. BUILT_SOURCES = \ $(BUILT_SOURCES_EXTRA) \ - defaults.h \ - graphics.h \ - graphics-props.cc \ - lex.cc \ + interpfcn/defaults.h \ + interpfcn/graphics.h \ + interpfcn/graphics-props.cc \ + parse-tree/lex.cc \ mxarray.h \ oct-conf.h \ oct-errno.cc \ oct-gperf.h \ - oct-parse.cc \ + parse-tree/oct-parse.cc \ ops.cc \ version.h \ builtins.cc BUILT_DISTFILES = \ oct-gperf.h \ - oct-parse.h + parse-tree/oct-parse.h ## Files that are created during build process and installed, ## BUT not distributed in tarball. BUILT_NODISTFILES = \ - defaults.h \ - graphics.h \ + interpfcn/defaults.h \ + interpfcn/graphics.h \ oct-conf.h \ oct-errno.cc \ ops.cc \ @@ -121,117 +124,6 @@ version.in.h \ $(BUILT_DISTFILES) -OPT_HANDLERS = \ - DASPK-opts.cc \ - DASRT-opts.cc \ - DASSL-opts.cc \ - LSODE-opts.cc \ - Quad-opts.cc - -OPT_INC = \ - ../liboctave/DASPK-opts.h \ - ../liboctave/DASRT-opts.h \ - ../liboctave/DASSL-opts.h \ - ../liboctave/LSODE-opts.h \ - ../liboctave/Quad-opts.h - -OV_INTTYPE_INC = \ - ov-base-int.h \ - ov-base-int.cc \ - ov-int-traits.h \ - ov-int16.h \ - ov-int32.h \ - ov-int64.h \ - ov-int8.h \ - ov-intx.h \ - ov-uint16.h \ - ov-uint32.h \ - ov-uint64.h \ - ov-uint8.h - -OV_INCLUDES = \ - ov-base-diag.h \ - ov-base-diag.cc \ - ov-base-mat.h \ - ov-base-mat.cc \ - ov-base-scalar.h \ - ov-base-scalar.cc \ - ov-base.h \ - ov-bool-mat.h \ - ov-bool-mat.cc \ - ov-bool.h \ - ov-builtin.h \ - ov-cell.h \ - ov-ch-mat.h \ - ov-class.h \ - ov-colon.h \ - ov-complex.h \ - ov-cs-list.h \ - ov-cx-diag.h \ - ov-cx-mat.h \ - ov-dld-fcn.h \ - ov-fcn-handle.h \ - ov-fcn-inline.h \ - ov-fcn.h \ - ov-float.h \ - ov-flt-complex.h \ - ov-flt-cx-diag.h \ - ov-flt-cx-mat.h \ - ov-flt-re-diag.h \ - ov-flt-re-mat.h \ - ov-lazy-idx.h \ - ov-mex-fcn.h \ - ov-null-mat.h \ - ov-oncleanup.h \ - ov-perm.h \ - ov-range.h \ - ov-re-diag.h \ - ov-re-mat.h \ - ov-scalar.h \ - ov-str-mat.h \ - ov-struct.h \ - ov-type-conv.h \ - ov-typeinfo.h \ - ov-usr-fcn.h \ - ov.h \ - $(OV_INTTYPE_INC) - -OV_SPARSE_INCLUDES = \ - ov-base-sparse.h \ - ov-bool-sparse.h \ - ov-cx-sparse.h \ - ov-re-sparse.h - -PT_INCLUDES = \ - pt-all.h \ - pt-arg-list.h \ - pt-assign.h \ - pt-binop.h \ - pt-bp.h \ - pt-cbinop.h \ - pt-cell.h \ - pt-check.h \ - pt-cmd.h \ - pt-colon.h \ - pt-const.h \ - pt-decl.h \ - pt-eval.h \ - pt-except.h \ - pt-exp.h \ - pt-fcn-handle.h \ - pt-id.h \ - pt-idx.h \ - pt-jump.h \ - pt-loop.h \ - pt-mat.h \ - pt-misc.h \ - pt-pr-code.h \ - pt-select.h \ - pt-stmt.h \ - pt-unop.h \ - pt-walk.h \ - pt.h - JIT_INCLUDES = \ jit-util.h \ jit-typeinfo.h \ @@ -244,32 +136,20 @@ c-file-ptr-stream.h \ comment-list.h \ cutils.h \ - data.h \ - debug.h \ defun-dld.h \ defun-int.h \ - defun.h \ - dirfns.h \ display.h \ dynamic-ld.h \ - error.h \ - file-io.h \ gl-render.h \ gl2ps.h \ gl2ps-renderer.h \ - graphics-props.cc \ + interpfcn/graphics-props.cc \ gripes.h \ - help.h \ - input.h \ - lex.h \ - load-path.h \ - load-save.h \ ls-ascii-helper.h \ ls-hdf5.h \ ls-mat-ascii.h \ ls-mat4.h \ ls-mat5.h \ - ls-oct-ascii.h \ ls-oct-binary.h \ ls-utils.h \ mex.h \ @@ -278,7 +158,6 @@ oct-fstrm.h \ oct-gperf.h \ oct-hdf5.h \ - oct-hist.h \ oct-iostrm.h \ oct-lvalue.h \ oct-map.h \ @@ -291,25 +170,14 @@ oct.h \ octave.h \ ops.h \ - pager.h \ - parse.h \ - parse-private.h \ - pr-output.h \ procstream.h \ - profiler.h \ - sighandlers.h \ siglist.h \ sparse-xdiv.h \ sparse-xpow.h \ - symtab.h \ - sysdep.h \ token.h \ - toplev.h \ txt-eng-ft.h \ txt-eng.h \ unwind-prot.h \ - utils.h \ - variables.h \ xdiv.h \ xnorm.h \ xpow.h \ @@ -317,199 +185,85 @@ $(OV_INCLUDES) \ $(OV_SPARSE_INCLUDES) \ $(PT_INCLUDES) \ + $(INTERPFCN_INCLUDES) \ $(JIT_INCLUDES) nodist_octinclude_HEADERS = \ - defaults.h \ - graphics.h \ + interpfcn/defaults.h \ + interpfcn/graphics.h \ oct-conf.h \ mxarray.h \ version.h -OV_INTTYPE_SRC = \ - ov-int16.cc \ - ov-int32.cc \ - ov-int64.cc \ - ov-int8.cc \ - ov-uint16.cc \ - ov-uint32.cc \ - ov-uint64.cc \ - ov-uint8.cc - -OV_SPARSE_SRC = \ - ov-base-sparse.cc \ - ov-bool-sparse.cc \ - ov-cx-sparse.cc \ - ov-re-sparse.cc - -OV_SRC = \ - ov-base.cc \ - ov-bool-mat.cc \ - ov-bool.cc \ - ov-builtin.cc \ - ov-cell.cc \ - ov-ch-mat.cc \ - ov-class.cc \ - ov-colon.cc \ - ov-complex.cc \ - ov-cs-list.cc \ - ov-cx-diag.cc \ - ov-cx-mat.cc \ - ov-dld-fcn.cc \ - ov-fcn-handle.cc \ - ov-fcn-inline.cc \ - ov-fcn.cc \ - ov-float.cc \ - ov-flt-complex.cc \ - ov-flt-cx-diag.cc \ - ov-flt-cx-mat.cc \ - ov-flt-re-diag.cc \ - ov-flt-re-mat.cc \ - ov-lazy-idx.cc \ - ov-mex-fcn.cc \ - ov-null-mat.cc \ - ov-oncleanup.cc \ - ov-perm.cc \ - ov-range.cc \ - ov-re-diag.cc \ - ov-re-mat.cc \ - ov-scalar.cc \ - ov-str-mat.cc \ - ov-struct.cc \ - ov-typeinfo.cc \ - ov-usr-fcn.cc \ - ov.cc \ - $(OV_INTTYPE_SRC) \ - $(OV_SPARSE_SRC) - -PT_SRC = \ - pt-arg-list.cc \ - pt-assign.cc \ - pt-binop.cc \ - pt-bp.cc \ - pt-cbinop.cc \ - pt-cell.cc \ - pt-check.cc \ - pt-cmd.cc \ - pt-colon.cc \ - pt-const.cc \ - pt-decl.cc \ - pt-eval.cc \ - pt-except.cc \ - pt-exp.cc \ - pt-fcn-handle.cc \ - pt-id.cc \ - pt-idx.cc \ - pt-jump.cc \ - pt-loop.cc \ - pt-mat.cc \ - pt-misc.cc \ - pt-pr-code.cc \ - pt-select.cc \ - pt-stmt.cc \ - pt-unop.cc \ - pt.cc - JIT_SRC = \ jit-util.cc \ jit-typeinfo.cc \ jit-ir.cc \ pt-jit.cc -#noinst_LTLIBRARIES = -# -#include corefcn/module.mk -# DIST_SRC = \ Cell.cc \ - bitfcns.cc \ c-file-ptr-stream.cc \ comment-list.cc \ cutils.c \ - data.cc \ - debug.cc \ - defaults.cc \ - defun.cc \ - dirfns.cc \ display.cc \ dynamic-ld.cc \ - error.cc \ - file-io.cc \ gl-render.cc \ gl2ps-renderer.cc \ - graphics.cc \ gripes.cc \ - help.cc \ - input.cc \ - lex.ll \ - load-path.cc \ - load-save.cc \ ls-ascii-helper.cc \ ls-hdf5.cc \ ls-mat-ascii.cc \ ls-mat4.cc \ ls-mat5.cc \ - ls-oct-ascii.cc \ ls-oct-binary.cc \ ls-utils.cc \ - mappers.cc \ matherr.c \ mex.cc \ oct-fstrm.cc \ - oct-hist.cc \ oct-iostrm.cc \ oct-lvalue.cc \ oct-map.cc \ oct-obj.cc \ - oct-parse.yy \ oct-prcstrm.cc \ oct-procbuf.cc \ oct-stream.cc \ oct-strstrm.cc \ octave.cc \ - pager.cc \ - pr-output.cc \ procstream.cc \ - profiler.cc \ - sighandlers.cc \ siglist.c \ - sparse.cc \ sparse-xdiv.cc \ sparse-xpow.cc \ - strfns.cc \ - symtab.cc \ - syscalls.cc \ - sysdep.cc \ token.cc \ - toplev.cc \ txt-eng-ft.cc \ unwind-prot.cc \ - utils.cc \ - variables.cc \ xdiv.cc \ xgl2ps.c \ xnorm.cc \ xpow.cc \ zfstream.cc \ - $(corefcn_SRC) \ - $(OV_SRC) \ - $(PT_SRC) \ - $(JIT_SRC) + $(OCTAVE_VALUE_SRC) \ + $(PARSE_TREE_SRC) \ + $(JIT_SRC) \ + $(INTERPFCN_SRC) \ + $(COREFCN_SRC) noinst_LTLIBRARIES = +include parse-tree/module.mk +include octave-value/module.mk +include operators/module.mk +include template-inst/module.mk +include interpfcn/module.mk include corefcn/module.mk -include DLD-FUNCTIONS/module.mk +include dldfcn/module.mk -$(srcdir)/DLD-FUNCTIONS/module.mk: $(srcdir)/DLD-FUNCTIONS/config-module.sh $(srcdir)/DLD-FUNCTIONS/config-module.awk $(srcdir)/DLD-FUNCTIONS/module-files - $(srcdir)/DLD-FUNCTIONS/config-module.sh $(top_srcdir) - -include OPERATORS/module.mk -include TEMPLATE-INST/module.mk +$(srcdir)/dldfcn/module.mk: $(srcdir)/dldfcn/config-module.sh $(srcdir)/dldfcn/config-module.awk $(srcdir)/dldfcn/module-files + $(srcdir)/dldfcn/config-module.sh $(top_srcdir) if AMCOND_ENABLE_DYNAMIC_LINKING - OCT_FILES = $(DLD_FUNCTIONS_LIBS:.la=.oct) - OCT_STAMP_FILES = $(subst DLD-FUNCTIONS/,DLD-FUNCTIONS/$(am__leading_dot),$(DLD_FUNCTIONS_LIBS:.la=.oct-stamp)) + OCT_FILES = $(DLDFCN_LIBS:.la=.oct) + OCT_STAMP_FILES = $(subst dldfcn/,dldfcn/$(am__leading_dot),$(DLDFCN_LIBS:.la=.oct-stamp)) DLD_LIBOCTINTERP_LIBADD = liboctinterp.la else OCT_FILES = @@ -524,8 +278,8 @@ nodist_liboctinterp_la_SOURCES = \ builtins.cc \ - defaults.h \ - graphics.h \ + interpfcn/defaults.h \ + interpfcn/graphics.h \ mxarray.h \ oct-conf.h \ oct-errno.cc \ @@ -575,17 +329,17 @@ ## Section for defining and creating DEF_FILES SRC_DEF_FILES := $(shell $(srcdir)/find-defun-files.sh "$(srcdir)" $(DIST_SRC)) -DLD_FUNCTIONS_DEF_FILES = $(DLD_FUNCTIONS_SRC:.cc=.df) +DLDFCN_DEF_FILES = $(DLDFCN_SRC:.cc=.df) ## builtins.cc depends on $(DEF_FILES), so DEF_FILES should only include ## .df files that correspond to sources included in liboctave. if AMCOND_ENABLE_DYNAMIC_LINKING DEF_FILES = $(SRC_DEF_FILES) else - DEF_FILES = $(SRC_DEF_FILES) $(DLD_FUNCTIONS_DEF_FILES) + DEF_FILES = $(SRC_DEF_FILES) $(DLDFCN_DEF_FILES) endif -ALL_DEF_FILES = $(SRC_DEF_FILES) $(DLD_FUNCTIONS_DEF_FILES) +ALL_DEF_FILES = $(SRC_DEF_FILES) $(DLDFCN_DEF_FILES) $(SRC_DEF_FILES): mkdefs Makefile @@ -607,13 +361,6 @@ ## defaults.h and oct-conf.h must depend on Makefile. Calling configure ## may change default/config values. However, calling configure will also ## regenerate the Makefiles from Makefile.am and trigger the rules below. -defaults.h: defaults.in.h Makefile - @$(do_subst_default_vals) - -graphics.h: graphics.in.h genprops.awk Makefile - $(AWK) -f $(srcdir)/genprops.awk $< > $@-t - mv $@-t $@ - oct-conf.h: oct-conf.in.h Makefile @$(do_subst_config_vals) @@ -645,10 +392,6 @@ $(srcdir)/mkbuiltins $(DEF_FILES) > $@-t mv $@-t $@ -graphics-props.cc: graphics.in.h genprops.awk Makefile - $(AWK) -v emit_graphics_props=1 -f $(srcdir)/genprops.awk $< > $@-t - mv $@-t $@ - ops.cc: $(OPERATORS_SRC) mkops $(srcdir)/mkops $(OPERATORS_SRC) > $@-t mv $@-t $@ @@ -663,24 +406,14 @@ fi mv $@-t $@ -$(OPT_HANDLERS) : %.cc : $(top_srcdir)/liboctave/%.in $(top_srcdir)/build-aux/mk-opts.pl - $(PERL) $(top_srcdir)/build-aux/mk-opts.pl --opt-handler-fcns $< > $@-t - mv $@-t $@ +if AMCOND_ENABLE_DYNAMIC_LINKING +DLDFCN_PKG_ADD_FILE = dldfcn/PKG_ADD -$(OPT_INC) : %.h : %.in - $(MAKE) -C $(@D) $(@F) - -if AMCOND_ENABLE_DYNAMIC_LINKING -DLD_FUNCTIONS_PKG_ADD_FILE = DLD-FUNCTIONS/PKG_ADD - -DLD-FUNCTIONS/PKG_ADD: $(DLD_FUNCTIONS_DEF_FILES) mk-pkg-add - $(srcdir)/mk-pkg-add $(DLD_FUNCTIONS_DEF_FILES) > $@-t +dldfcn/PKG_ADD: $(DLDFCN_DEF_FILES) mk-pkg-add + $(srcdir)/mk-pkg-add $(DLDFCN_DEF_FILES) > $@-t mv $@-t $@ endif -lex.lo lex.o oct-parse.lo oct-parse.o: \ - AM_CXXFLAGS := $(filter-out -Wold-style-cast, $(AM_CXXFLAGS)) - __fltk_uigetfile__.lo __fltk_uigetfile__.o: \ AM_CXXFLAGS := $(filter-out $(DLL_CXXDEFS), $(AM_CXXFLAGS) $(GRAPHICS_CFLAGS)) @@ -698,9 +431,9 @@ $(top_srcdir)/build-aux/move-if-change $@ DOCSTRINGS touch $@ -all-local: $(OCT_STAMP_FILES) $(DLD_FUNCTIONS_PKG_ADD_FILE) .DOCSTRINGS +all-local: $(OCT_STAMP_FILES) $(DLDFCN_PKG_ADD_FILE) .DOCSTRINGS else -all-local: $(OCT_STAMP_FILES) $(DLD_FUNCTIONS_PKG_ADD_FILE) +all-local: $(OCT_STAMP_FILES) $(DLDFCN_PKG_ADD_FILE) endif if AMCOND_BUILD_COMPILED_AUX_PROGRAMS @@ -754,11 +487,11 @@ if AMCOND_ENABLE_DYNAMIC_LINKING install-oct: $(top_srcdir)/build-aux/mkinstalldirs $(DESTDIR)$(octfiledir) - if [ -n "`cat $(DLD_FUNCTIONS_PKG_ADD_FILE)`" ]; then \ - $(INSTALL_DATA) $(DLD_FUNCTIONS_PKG_ADD_FILE) $(DESTDIR)$(octfiledir)/PKG_ADD; \ + if [ -n "`cat $(DLDFCN_PKG_ADD_FILE)`" ]; then \ + $(INSTALL_DATA) $(DLDFCN_PKG_ADD_FILE) $(DESTDIR)$(octfiledir)/PKG_ADD; \ fi cd $(DESTDIR)$(octlibdir) && \ - for ltlib in $(DLD_FUNCTIONS_LIBS); do \ + for ltlib in $(DLDFCN_LIBS); do \ f=`echo $$ltlib | $(SED) 's,.*/,,'`; \ dl=`$(SED) -n -e "s/dlname='\([^']*\)'/\1/p" < $$f`; \ if [ -n "$$dl" ]; then \ @@ -783,9 +516,9 @@ CLEANFILES = \ $(bin_SCRIPTS) \ - $(DLD_FUNCTIONS_PKG_ADD_FILE) \ - graphics-props.cc \ - oct-parse.output + $(DLDFCN_PKG_ADD_FILE) \ + interpfcn/graphics-props.cc \ + parse-tree/oct-parse.output DISTCLEANFILES = \ .DOCSTRINGS \ diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/module.mk --- a/src/OPERATORS/module.mk Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,136 +0,0 @@ -EXTRA_DIST += OPERATORS/module.mk - -OPERATORS_SRC = \ - OPERATORS/op-b-b.cc \ - OPERATORS/op-b-bm.cc \ - OPERATORS/op-b-sbm.cc \ - OPERATORS/op-bm-b.cc \ - OPERATORS/op-bm-bm.cc \ - OPERATORS/op-bm-sbm.cc \ - OPERATORS/op-cdm-cdm.cc \ - OPERATORS/op-cdm-cm.cc \ - OPERATORS/op-cdm-cs.cc \ - OPERATORS/op-cdm-dm.cc \ - OPERATORS/op-cdm-m.cc \ - OPERATORS/op-cdm-s.cc \ - OPERATORS/op-cell.cc \ - OPERATORS/op-chm.cc \ - OPERATORS/op-class.cc \ - OPERATORS/op-cm-cdm.cc \ - OPERATORS/op-cm-cm.cc \ - OPERATORS/op-cm-cs.cc \ - OPERATORS/op-cm-dm.cc \ - OPERATORS/op-cm-m.cc \ - OPERATORS/op-cm-pm.cc \ - OPERATORS/op-cm-s.cc \ - OPERATORS/op-cm-scm.cc \ - OPERATORS/op-cm-sm.cc \ - OPERATORS/op-cs-cm.cc \ - OPERATORS/op-cs-cs.cc \ - OPERATORS/op-cs-m.cc \ - OPERATORS/op-cs-s.cc \ - OPERATORS/op-cs-scm.cc \ - OPERATORS/op-cs-sm.cc \ - OPERATORS/op-dm-cdm.cc \ - OPERATORS/op-dm-cm.cc \ - OPERATORS/op-dm-cs.cc \ - OPERATORS/op-dm-dm.cc \ - OPERATORS/op-dm-m.cc \ - OPERATORS/op-dm-s.cc \ - OPERATORS/op-dm-scm.cc \ - OPERATORS/op-dm-sm.cc \ - OPERATORS/op-double-conv.cc \ - OPERATORS/op-fcdm-fcdm.cc \ - OPERATORS/op-fcdm-fcm.cc \ - OPERATORS/op-fcdm-fcs.cc \ - OPERATORS/op-fcdm-fdm.cc \ - OPERATORS/op-fcdm-fm.cc \ - OPERATORS/op-fcdm-fs.cc \ - OPERATORS/op-fcm-fcdm.cc \ - OPERATORS/op-fcm-fcm.cc \ - OPERATORS/op-fcm-fcs.cc \ - OPERATORS/op-fcm-fdm.cc \ - OPERATORS/op-fcm-fm.cc \ - OPERATORS/op-fcm-fs.cc \ - OPERATORS/op-fcm-pm.cc \ - OPERATORS/op-fcn.cc \ - OPERATORS/op-fcs-fcm.cc \ - OPERATORS/op-fcs-fcs.cc \ - OPERATORS/op-fcs-fm.cc \ - OPERATORS/op-fcs-fs.cc \ - OPERATORS/op-fdm-fcdm.cc \ - OPERATORS/op-fdm-fcm.cc \ - OPERATORS/op-fdm-fcs.cc \ - OPERATORS/op-fdm-fdm.cc \ - OPERATORS/op-fdm-fm.cc \ - OPERATORS/op-fdm-fs.cc \ - OPERATORS/op-float-conv.cc \ - OPERATORS/op-fm-fcdm.cc \ - OPERATORS/op-fm-fcm.cc \ - OPERATORS/op-fm-fcs.cc \ - OPERATORS/op-fm-fdm.cc \ - OPERATORS/op-fm-fm.cc \ - OPERATORS/op-fm-fs.cc \ - OPERATORS/op-fm-pm.cc \ - OPERATORS/op-fs-fcm.cc \ - OPERATORS/op-fs-fcs.cc \ - OPERATORS/op-fs-fm.cc \ - OPERATORS/op-fs-fs.cc \ - OPERATORS/op-i16-i16.cc \ - OPERATORS/op-i32-i32.cc \ - OPERATORS/op-i64-i64.cc \ - OPERATORS/op-i8-i8.cc \ - OPERATORS/op-int-concat.cc \ - OPERATORS/op-int-conv.cc \ - OPERATORS/op-m-cdm.cc \ - OPERATORS/op-m-cm.cc \ - OPERATORS/op-m-cs.cc \ - OPERATORS/op-m-dm.cc \ - OPERATORS/op-m-m.cc \ - OPERATORS/op-m-pm.cc \ - OPERATORS/op-m-s.cc \ - OPERATORS/op-m-scm.cc \ - OPERATORS/op-m-sm.cc \ - OPERATORS/op-pm-cm.cc \ - OPERATORS/op-pm-fcm.cc \ - OPERATORS/op-pm-fm.cc \ - OPERATORS/op-pm-m.cc \ - OPERATORS/op-pm-pm.cc \ - OPERATORS/op-pm-scm.cc \ - OPERATORS/op-pm-sm.cc \ - OPERATORS/op-range.cc \ - OPERATORS/op-s-cm.cc \ - OPERATORS/op-s-cs.cc \ - OPERATORS/op-s-m.cc \ - OPERATORS/op-s-s.cc \ - OPERATORS/op-s-scm.cc \ - OPERATORS/op-s-sm.cc \ - OPERATORS/op-sbm-b.cc \ - OPERATORS/op-sbm-bm.cc \ - OPERATORS/op-sbm-sbm.cc \ - OPERATORS/op-scm-cm.cc \ - OPERATORS/op-scm-cs.cc \ - OPERATORS/op-scm-m.cc \ - OPERATORS/op-scm-s.cc \ - OPERATORS/op-scm-scm.cc \ - OPERATORS/op-scm-sm.cc \ - OPERATORS/op-sm-cm.cc \ - OPERATORS/op-sm-cs.cc \ - OPERATORS/op-sm-m.cc \ - OPERATORS/op-sm-s.cc \ - OPERATORS/op-sm-scm.cc \ - OPERATORS/op-sm-sm.cc \ - OPERATORS/op-str-m.cc \ - OPERATORS/op-str-s.cc \ - OPERATORS/op-str-str.cc \ - OPERATORS/op-struct.cc \ - OPERATORS/op-ui16-ui16.cc \ - OPERATORS/op-ui32-ui32.cc \ - OPERATORS/op-ui64-ui64.cc \ - OPERATORS/op-ui8-ui8.cc - -octinclude_HEADERS += \ - OPERATORS/op-dm-template.cc \ - OPERATORS/op-dms-template.cc \ - OPERATORS/op-int.h \ - OPERATORS/op-pm-template.cc diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-b-b.cc --- a/src/OPERATORS/op-b-b.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,95 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// bool unary ops. - -// scalar unary ops. - -DEFUNOP_OP (not, bool, !) - -UNOPDECL (uplus, a) -{ - CAST_UNOP_ARG (const octave_bool&); - return octave_value (v.double_value ()); -} - -UNOPDECL (uminus, a) -{ - CAST_UNOP_ARG (const octave_bool&); - return octave_value (- v.double_value ()); -} - -DEFUNOP_OP (transpose, bool, /* no-op */) -DEFUNOP_OP (hermitian, bool, /* no-op */) - -// bool by bool ops. - -DEFBINOP_OP (eq, bool, bool, ==) -DEFBINOP_OP (ne, bool, bool, !=) -DEFBINOP_OP (el_and, bool, bool, &&) -DEFBINOP_OP (el_or, bool, bool, ||) - -DEFNDCATOP_FN (b_b, bool, bool, bool_array, bool_array, concat) -DEFNDCATOP_FN (b_s, bool, scalar, array, array, concat) -DEFNDCATOP_FN (s_b, scalar, bool, array, array, concat) -DEFNDCATOP_FN (b_f, bool, float_scalar, float_array, float_array, concat) -DEFNDCATOP_FN (f_b, float_scalar, bool, float_array, float_array, concat) - -void -install_b_b_ops (void) -{ - INSTALL_UNOP (op_not, octave_bool, not); - INSTALL_UNOP (op_uplus, octave_bool, uplus); - INSTALL_UNOP (op_uminus, octave_bool, uminus); - INSTALL_UNOP (op_transpose, octave_bool, transpose); - INSTALL_UNOP (op_hermitian, octave_bool, hermitian); - - INSTALL_BINOP (op_eq, octave_bool, octave_bool, eq); - INSTALL_BINOP (op_ne, octave_bool, octave_bool, ne); - INSTALL_BINOP (op_el_and, octave_bool, octave_bool, el_and); - INSTALL_BINOP (op_el_or, octave_bool, octave_bool, el_or); - - INSTALL_CATOP (octave_bool, octave_bool, b_b); - INSTALL_CATOP (octave_bool, octave_scalar, b_s); - INSTALL_CATOP (octave_scalar, octave_bool, s_b); - INSTALL_CATOP (octave_bool, octave_float_scalar, b_f); - INSTALL_CATOP (octave_float_scalar, octave_bool, f_b); - - INSTALL_ASSIGNCONV (octave_bool, octave_bool, octave_bool_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-b-bm.cc --- a/src/OPERATORS/op-b-bm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,80 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// bool matrix by bool ops. - -DEFNDBINOP_FN (el_and, bool, bool_matrix, bool, bool_array, mx_el_and) -DEFNDBINOP_FN (el_or, bool, bool_matrix, bool, bool_array, mx_el_or) - -DEFNDBINOP_FN (el_and_not, bool, bool_matrix, bool, bool_array, mx_el_and_not) -DEFNDBINOP_FN (el_or_not, bool, bool_matrix, bool, bool_array, mx_el_or_not) - -DEFNDCATOP_FN (b_bm, bool, bool_matrix, bool_array, bool_array, concat) -DEFNDCATOP_FN (b_m, bool, matrix, array, array, concat) -DEFNDCATOP_FN (s_bm, scalar, bool_matrix, array, array, concat) - -DEFNDCATOP_FN (b_fm, bool, float_matrix, float_array, float_array, concat) -DEFNDCATOP_FN (f_bm, float_scalar, bool_matrix, float_array, float_array, concat) - -DEFCONV (bool_matrix_conv, bool, bool_matrix) -{ - CAST_CONV_ARG (const octave_bool&); - - return new octave_bool_matrix (v.bool_matrix_value ()); -} - -void -install_b_bm_ops (void) -{ - INSTALL_BINOP (op_el_and, octave_bool, octave_bool_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_bool, octave_bool_matrix, el_or); - INSTALL_BINOP (op_el_and_not, octave_bool, octave_bool_matrix, el_and_not); - INSTALL_BINOP (op_el_or_not, octave_bool, octave_bool_matrix, el_or_not); - - INSTALL_CATOP (octave_bool, octave_bool_matrix, b_bm); - INSTALL_CATOP (octave_bool, octave_matrix, b_m); - INSTALL_CATOP (octave_scalar, octave_bool_matrix, s_bm); - INSTALL_CATOP (octave_bool, octave_float_matrix, b_fm); - INSTALL_CATOP (octave_float_scalar, octave_bool_matrix, f_bm); - - INSTALL_ASSIGNCONV (octave_bool, octave_bool_matrix, octave_bool_matrix); - - INSTALL_WIDENOP (octave_bool, octave_bool_matrix, bool_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-b-sbm.cc --- a/src/OPERATORS/op-b-sbm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,95 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-scalar.h" -#include "ops.h" - -#include "ov-re-sparse.h" -#include "ov-bool-sparse.h" - -// bool by sparse bool matrix ops. - -DEFBINOP_FN (ne, bool, sparse_bool_matrix, mx_el_ne) -DEFBINOP_FN (eq, bool, sparse_bool_matrix, mx_el_eq) - -DEFBINOP_FN (el_and, bool, sparse_bool_matrix, mx_el_and) -DEFBINOP_FN (el_or, bool, sparse_bool_matrix, mx_el_or) - -DEFCATOP (b_sbm, bool, sparse_bool_matrix) -{ - CAST_BINOP_ARGS (octave_bool&, const octave_sparse_bool_matrix&); - SparseBoolMatrix tmp (1, 1, v1.bool_value ()); - return octave_value (tmp. concat (v2.sparse_bool_matrix_value (), - ra_idx)); -} - -DEFCATOP (b_sm, bool, sparse_matrix) -{ - CAST_BINOP_ARGS (octave_bool&, const octave_sparse_matrix&); - SparseMatrix tmp (1, 1, v1.scalar_value ()); - return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); -} - -DEFCATOP (s_sbm, scalar, sparse_bool_matrix) -{ - CAST_BINOP_ARGS (octave_scalar&, const octave_sparse_bool_matrix&); - SparseMatrix tmp (1, 1, v1.scalar_value ()); - return octave_value(tmp. concat (v2.sparse_matrix_value (), ra_idx)); -} - -DEFCONV (sparse_bool_matrix_conv, bool, sparse_bool_matrix) -{ - CAST_CONV_ARG (const octave_bool&); - - return new octave_sparse_bool_matrix - (SparseBoolMatrix (1, 1, v.bool_value ())); -} - -void -install_b_sbm_ops (void) -{ - INSTALL_BINOP (op_eq, octave_bool, octave_sparse_bool_matrix, eq); - INSTALL_BINOP (op_ne, octave_bool, octave_sparse_bool_matrix, ne); - - INSTALL_BINOP (op_el_and, octave_bool, octave_sparse_bool_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_bool, octave_sparse_bool_matrix, el_or); - - INSTALL_CATOP (octave_bool, octave_sparse_bool_matrix, b_sbm); - INSTALL_CATOP (octave_bool, octave_sparse_matrix, b_sm); - INSTALL_CATOP (octave_scalar, octave_sparse_bool_matrix, s_sbm); - - INSTALL_ASSIGNCONV (octave_bool, octave_sparse_bool_matrix, - octave_bool_matrix); - - INSTALL_WIDENOP (octave_bool, octave_sparse_bool_matrix, sparse_bool_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-bm-b.cc --- a/src/OPERATORS/op-bm-b.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,111 +0,0 @@ -/* - -Copyright (C) 2001-2012 Cai Jianming - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-str-mat.h" -#include "ov-int8.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-uint8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// bool matrix by bool ops. - -DEFNDBINOP_FN (el_and, bool_matrix, bool, bool_array, bool, mx_el_and) -DEFNDBINOP_FN (el_or, bool_matrix, bool, bool_array, bool, mx_el_or) - -DEFNDBINOP_FN (el_not_and, bool_matrix, bool, bool_array, bool, mx_el_not_and) -DEFNDBINOP_FN (el_not_or, bool_matrix, bool, bool_array, bool, mx_el_not_or) - -DEFNDCATOP_FN (bm_b, bool_matrix, bool, bool_array, bool_array, concat) -DEFNDCATOP_FN (bm_s, bool_matrix, scalar, array, array, concat) -DEFNDCATOP_FN (m_b, matrix, bool, array, array, concat) -DEFNDCATOP_FN (bm_f, bool_matrix, float_scalar, float_array, float_array, concat) -DEFNDCATOP_FN (fm_b, float_matrix, bool, float_array, float_array, concat) - -DEFNDASSIGNOP_FN (assign, bool_matrix, bool, bool_array, assign) - -static octave_value -oct_assignop_conv_and_assign (octave_base_value& a1, - const octave_value_list& idx, - const octave_base_value& a2) -{ - octave_bool_matrix& v1 = dynamic_cast (a1); - - // FIXME -- perhaps add a warning for this conversion if the values - // are not all 0 or 1? - - boolNDArray v2 = a2.bool_array_value (true); - - if (! error_state) - v1.assign (idx, v2); - - return octave_value (); -} - -void -install_bm_b_ops (void) -{ - INSTALL_BINOP (op_el_and, octave_bool_matrix, octave_bool, el_and); - INSTALL_BINOP (op_el_or, octave_bool_matrix, octave_bool, el_or); - INSTALL_BINOP (op_el_not_and, octave_bool_matrix, octave_bool, el_not_and); - INSTALL_BINOP (op_el_not_or, octave_bool_matrix, octave_bool, el_not_or); - - INSTALL_CATOP (octave_bool_matrix, octave_bool, bm_b); - INSTALL_CATOP (octave_bool_matrix, octave_scalar, bm_s); - INSTALL_CATOP (octave_matrix, octave_bool, m_b); - INSTALL_CATOP (octave_bool_matrix, octave_float_scalar, bm_f); - INSTALL_CATOP (octave_float_matrix, octave_bool, fm_b); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_bool, assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_scalar, conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int8_scalar, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int16_scalar, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int32_scalar, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int64_scalar, conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint8_scalar, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint16_scalar, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint32_scalar, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint64_scalar, conv_and_assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-bm-bm.cc --- a/src/OPERATORS/op-bm-bm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,184 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-bool-mat.h" -#include "ov-scalar.h" -#include "ov-range.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-re-sparse.h" -#include "ov-str-mat.h" -#include "ov-int8.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-uint8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// unary bool matrix ops. - -DEFNDUNOP_OP (not, bool_matrix, bool_array, !) -DEFNDUNOP_OP (uplus, bool_matrix, array, +) -DEFNDUNOP_OP (uminus, bool_matrix, array, -) - -DEFNCUNOP_METHOD (invert, bool_matrix, invert) - -DEFUNOP (transpose, bool_matrix) -{ - CAST_UNOP_ARG (const octave_bool_matrix&); - - if (v.ndims () > 2) - { - error ("transpose not defined for N-d objects"); - return octave_value (); - } - else - return octave_value (v.bool_matrix_value ().transpose ()); -} - -// bool matrix by bool matrix ops. - -DEFNDBINOP_FN (eq, bool_matrix, bool_matrix, bool_array, bool_array, mx_el_eq) -DEFNDBINOP_FN (ne, bool_matrix, bool_matrix, bool_array, bool_array, mx_el_ne) - -DEFNDBINOP_FN (el_and, bool_matrix, bool_matrix, bool_array, bool_array, - mx_el_and) - -DEFNDBINOP_FN (el_or, bool_matrix, bool_matrix, bool_array, bool_array, - mx_el_or) - -DEFNDBINOP_FN (el_not_and, bool_matrix, bool_matrix, bool_array, bool_array, - mx_el_not_and) - -DEFNDBINOP_FN (el_not_or, bool_matrix, bool_matrix, bool_array, bool_array, - mx_el_not_or) - -DEFNDBINOP_FN (el_and_not, bool_matrix, bool_matrix, bool_array, bool_array, - mx_el_and_not) - -DEFNDBINOP_FN (el_or_not, bool_matrix, bool_matrix, bool_array, bool_array, - mx_el_or_not) - -DEFNDCATOP_FN (bm_bm, bool_matrix, bool_matrix, bool_array, bool_array, concat) -DEFNDCATOP_FN (bm_m, bool_matrix, matrix, array, array, concat) -DEFNDCATOP_FN (m_bm, matrix, bool_matrix, array, array, concat) -DEFNDCATOP_FN (bm_fm, bool_matrix, float_matrix, float_array, float_array, concat) -DEFNDCATOP_FN (fm_bm, float_matrix, bool_matrix, float_array, float_array, concat) - -DEFNDASSIGNOP_FN (assign, bool_matrix, bool_matrix, bool_array, assign) -DEFNDASSIGNOP_FNOP (assign_and, bool_matrix, bool_matrix, bool_array, mx_el_and_assign) -DEFNDASSIGNOP_FNOP (assign_or, bool_matrix, bool_matrix, bool_array, mx_el_or_assign) - -DEFNULLASSIGNOP_FN (null_assign, bool_matrix, delete_elements) - -static octave_value -oct_assignop_conv_and_assign (octave_base_value& a1, - const octave_value_list& idx, - const octave_base_value& a2) -{ - octave_bool_matrix& v1 = dynamic_cast (a1); - - // FIXME -- perhaps add a warning for this conversion if the values - // are not all 0 or 1? - - boolNDArray v2 = a2.bool_array_value (true); - - if (! error_state) - v1.assign (idx, v2); - - return octave_value (); -} - -DEFCONVFN (matrix_to_bool_matrix, matrix, bool) -DEFCONVFN (scalar_to_bool_matrix, scalar, bool) - -void -install_bm_bm_ops (void) -{ - INSTALL_UNOP (op_not, octave_bool_matrix, not); - INSTALL_UNOP (op_uplus, octave_bool_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_bool_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_bool_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_bool_matrix, transpose); - - INSTALL_NCUNOP (op_not, octave_bool_matrix, invert); - - INSTALL_BINOP (op_eq, octave_bool_matrix, octave_bool_matrix, eq); - INSTALL_BINOP (op_ne, octave_bool_matrix, octave_bool_matrix, ne); - - INSTALL_BINOP (op_el_and, octave_bool_matrix, octave_bool_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_bool_matrix, octave_bool_matrix, el_or); - INSTALL_BINOP (op_el_not_and, octave_bool_matrix, octave_bool_matrix, el_not_and); - INSTALL_BINOP (op_el_not_or, octave_bool_matrix, octave_bool_matrix, el_not_or); - INSTALL_BINOP (op_el_and_not, octave_bool_matrix, octave_bool_matrix, el_and_not); - INSTALL_BINOP (op_el_or_not, octave_bool_matrix, octave_bool_matrix, el_or_not); - - INSTALL_CATOP (octave_bool_matrix, octave_bool_matrix, bm_bm); - INSTALL_CATOP (octave_bool_matrix, octave_matrix, bm_m); - INSTALL_CATOP (octave_matrix, octave_bool_matrix, m_bm); - INSTALL_CATOP (octave_bool_matrix, octave_float_matrix, bm_fm); - INSTALL_CATOP (octave_float_matrix, octave_bool_matrix, fm_bm); - - INSTALL_CONVOP (octave_matrix, octave_bool_matrix, matrix_to_bool_matrix); - INSTALL_CONVOP (octave_scalar, octave_bool_matrix, scalar_to_bool_matrix); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_bool_matrix, assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_matrix, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_char_matrix_str, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_char_matrix_sq_str, conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_range, conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_sparse_matrix, conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int8_matrix, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int16_matrix, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int32_matrix, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int64_matrix, conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint8_matrix, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint16_matrix, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint32_matrix, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint64_matrix, conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_null_matrix, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_null_str, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_null_sq_str, null_assign); - - INSTALL_ASSIGNOP (op_el_and_eq, octave_bool_matrix, octave_bool_matrix, assign_and); - INSTALL_ASSIGNOP (op_el_or_eq, octave_bool_matrix, octave_bool_matrix, assign_or); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-bm-sbm.cc --- a/src/OPERATORS/op-bm-sbm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,103 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-bool-mat.h" -#include "boolMatrix.h" -#include "ov-scalar.h" -#include "ops.h" - -#include "ov-re-sparse.h" -#include "ov-bool-sparse.h" -#include "smx-bm-sbm.h" -#include "smx-sbm-bm.h" - -// bool matrix by sparse bool matrix ops. - -DEFBINOP_FN (eq, bool_matrix, sparse_bool_matrix, mx_el_eq) -DEFBINOP_FN (ne, bool_matrix, sparse_bool_matrix, mx_el_ne) - -DEFBINOP_FN (el_and, bool_matrix, sparse_bool_matrix, mx_el_and) -DEFBINOP_FN (el_or, bool_matrix, sparse_bool_matrix, mx_el_or) - -DEFCATOP (bm_sbm, bool_matrix, sparse_bool_matrix) -{ - CAST_BINOP_ARGS (octave_bool_matrix&, const octave_sparse_bool_matrix&); - SparseBoolMatrix tmp (v1.bool_matrix_value ()); - return octave_value (tmp. concat (v2.sparse_bool_matrix_value (), - ra_idx)); -} - -DEFCATOP (m_sbm, matrix, sparse_bool_matrix) -{ - CAST_BINOP_ARGS (octave_matrix&, const octave_sparse_bool_matrix&); - SparseMatrix tmp (v1.matrix_value ()); - return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); -} - -DEFCATOP (bm_sm, bool_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (octave_bool_matrix&, const octave_sparse_matrix&); - SparseMatrix tmp (v1.matrix_value ()); - return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); -} - -DEFCONV (sparse_bool_matrix_conv, bool_matrix, sparse_bool_matrix) -{ - CAST_CONV_ARG (const octave_bool_matrix&); - return new octave_sparse_bool_matrix - (SparseBoolMatrix (v.bool_matrix_value ())); -} - -DEFNDASSIGNOP_FN (assign, bool_matrix, sparse_bool_matrix, bool_array, assign) - -void -install_bm_sbm_ops (void) -{ - INSTALL_BINOP (op_eq, octave_bool_matrix, octave_sparse_bool_matrix, eq); - INSTALL_BINOP (op_ne, octave_bool_matrix, octave_sparse_bool_matrix, ne); - - INSTALL_BINOP (op_el_and, octave_bool_matrix, octave_sparse_bool_matrix, - el_and); - INSTALL_BINOP (op_el_or, octave_bool_matrix, octave_sparse_bool_matrix, - el_or); - - INSTALL_CATOP (octave_bool_matrix, octave_sparse_bool_matrix, bm_sbm); - INSTALL_CATOP (octave_bool_matrix, octave_sparse_matrix, bm_sm); - INSTALL_CATOP (octave_matrix, octave_sparse_bool_matrix, m_sbm); - - INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_sparse_bool_matrix, - assign) - INSTALL_ASSIGNCONV (octave_bool_matrix, octave_sparse_bool_matrix, - octave_bool_matrix); - - INSTALL_WIDENOP (octave_bool_matrix, octave_sparse_bool_matrix, - sparse_bool_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cdm-cdm.cc --- a/src/OPERATORS/op-cdm-cdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,110 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-cx-mat.h" -#include "ov-cx-diag.h" -#include "ov-flt-cx-diag.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix unary ops. - -DEFUNOP_OP (uplus, complex_diag_matrix, /* no-op */) -DEFUNOP_OP (uminus, complex_diag_matrix, -) - -DEFUNOP (transpose, complex_diag_matrix) -{ - CAST_UNOP_ARG (const octave_complex_diag_matrix&); - return octave_value (v.complex_diag_matrix_value ().transpose ()); -} - -DEFUNOP (hermitian, complex_diag_matrix) -{ - CAST_UNOP_ARG (const octave_complex_diag_matrix&); - return octave_value (v.complex_diag_matrix_value ().hermitian ()); -} - -// matrix by matrix ops. - -DEFBINOP_OP (add, complex_diag_matrix, complex_diag_matrix, +) -DEFBINOP_OP (sub, complex_diag_matrix, complex_diag_matrix, -) -DEFBINOP_OP (mul, complex_diag_matrix, complex_diag_matrix, *) - -DEFBINOP (div, complex_diag_matrix, complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_complex_diag_matrix&); - - return xdiv (v1.complex_diag_matrix_value (), - v2.complex_diag_matrix_value ()); -} - -DEFBINOP (ldiv, complex_diag_matrix, complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_complex_diag_matrix&); - - return xleftdiv (v1.complex_diag_matrix_value (), - v2.complex_diag_matrix_value ()); -} - -CONVDECL (complex_diag_matrix_to_complex_matrix) -{ - CAST_CONV_ARG (const octave_complex_diag_matrix&); - - return new octave_complex_matrix (v.complex_matrix_value ()); -} - -CONVDECL (complex_diag_matrix_to_float_complex_diag_matrix) -{ - CAST_CONV_ARG (const octave_complex_diag_matrix&); - - return new octave_float_complex_diag_matrix (v.float_complex_diag_matrix_value ()); -} - -void -install_cdm_cdm_ops (void) -{ - INSTALL_UNOP (op_uplus, octave_complex_diag_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_complex_diag_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_complex_diag_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_complex_diag_matrix, hermitian); - - INSTALL_BINOP (op_add, octave_complex_diag_matrix, octave_complex_diag_matrix, add); - INSTALL_BINOP (op_sub, octave_complex_diag_matrix, octave_complex_diag_matrix, sub); - INSTALL_BINOP (op_mul, octave_complex_diag_matrix, octave_complex_diag_matrix, mul); - INSTALL_BINOP (op_div, octave_complex_diag_matrix, octave_complex_diag_matrix, div); - INSTALL_BINOP (op_ldiv, octave_complex_diag_matrix, octave_complex_diag_matrix, ldiv); - - INSTALL_CONVOP (octave_complex_diag_matrix, octave_complex_matrix, complex_diag_matrix_to_complex_matrix); - INSTALL_CONVOP (octave_complex_diag_matrix, octave_float_complex_diag_matrix, - complex_diag_matrix_to_float_complex_diag_matrix); - INSTALL_ASSIGNCONV (octave_complex_diag_matrix, octave_complex_matrix, octave_complex_matrix); - INSTALL_WIDENOP (octave_complex_diag_matrix, octave_complex_matrix, complex_diag_matrix_to_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cdm-cm.cc --- a/src/OPERATORS/op-cdm-cm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-cx-diag.h" -#define RINCLUDE "ov-cx-mat.h" - -#define LMATRIX complex_diag_matrix -#define RMATRIX complex_matrix - -#define LSHORT cdm -#define RSHORT cm - -#define DEFINELDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cdm-cs.cc --- a/src/OPERATORS/op-cdm-cs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define SINCLUDE "ov-complex.h" -#define MINCLUDE "ov-cx-diag.h" - -#define SCALAR complex -#define MATRIX complex_diag_matrix - -#define SSHORT cs -#define MSHORT cdm - -#include "op-dms-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cdm-dm.cc --- a/src/OPERATORS/op-cdm-dm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-cx-diag.h" -#define RINCLUDE "ov-re-diag.h" - -#define LMATRIX complex_diag_matrix -#define RMATRIX diag_matrix -#define RDMATRIX LMATRIX - -#define LSHORT cdm -#define RSHORT dm - -#define DEFINEDIV -#define DEFINELDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cdm-m.cc --- a/src/OPERATORS/op-cdm-m.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-cx-diag.h" -#define RINCLUDE "ov-re-mat.h" - -#define LMATRIX complex_diag_matrix -#define LDMATRIX complex_matrix -#define RMATRIX matrix -#define RDMATRIX complex_matrix - -#define LSHORT cdm -#define RSHORT m - -#define DEFINELDIV -#define DEFINENULLASSIGNCONV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cdm-s.cc --- a/src/OPERATORS/op-cdm-s.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define SINCLUDE "ov-scalar.h" -#define MINCLUDE "ov-cx-diag.h" - -#define SCALAR scalar -#define SCALARV complex -#define MATRIX complex_diag_matrix - -#define SSHORT s -#define MSHORT cdm - -#include "op-dms-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cell.cc --- a/src/OPERATORS/op-cell.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-cell.h" -#include "ov-scalar.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" - -// cell ops. - -DEFUNOP (transpose, cell) -{ - CAST_UNOP_ARG (const octave_cell&); - - if (v.ndims () > 2) - { - error ("transpose not defined for N-d objects"); - return octave_value (); - } - else - return octave_value (Cell (v.cell_value ().transpose ())); -} - -DEFCATOP_FN (c_c, cell, cell, concat) - -DEFASSIGNANYOP_FN (assign, cell, assign); - -DEFNULLASSIGNOP_FN (null_assign, cell, delete_elements) - -void -install_cell_ops (void) -{ - INSTALL_UNOP (op_transpose, octave_cell, transpose); - INSTALL_UNOP (op_hermitian, octave_cell, transpose); - - INSTALL_CATOP (octave_cell, octave_cell, c_c); - - INSTALL_ASSIGNANYOP (op_asn_eq, octave_cell, assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_cell, octave_null_matrix, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_cell, octave_null_str, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_cell, octave_null_sq_str, null_assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-chm.cc --- a/src/OPERATORS/op-chm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,105 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-ch-mat.h" -#include "ov-scalar.h" -#include "ov-re-mat.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" - -// char matrix unary ops. - -DEFUNOP (transpose, char_matrix) -{ - CAST_UNOP_ARG (const octave_char_matrix&); - - return octave_value (v.matrix_value ().transpose ()); -} - -DEFNDCATOP_FN (chm_chm, char_matrix, char_matrix, char_array, char_array, - concat) - -DEFCATOP (chm_s, char_matrix, scalar) -{ - CAST_BINOP_ARGS (octave_char_matrix&, const octave_scalar&); - - gripe_implicit_conversion ("Octave:num-to-str", - v2.type_name (), v1.type_name ()); - - return octave_value (v1.char_array_value (). concat(v2.array_value (), - ra_idx)); -} - -DEFCATOP (chm_m, char_matrix, matrix) -{ - CAST_BINOP_ARGS (octave_char_matrix&, const octave_matrix&); - - gripe_implicit_conversion ("Octave:num-to-str", - v2.type_name (), v1.type_name ()); - - return octave_value (v1.char_array_value (). concat (v2.array_value (), - ra_idx)); -} - -DEFCATOP (s_chm, scalar, char_matrix) -{ - CAST_BINOP_ARGS (octave_scalar&, const octave_char_matrix&); - - gripe_implicit_conversion ("Octave:num-to-str", - v1.type_name (), v2.type_name ()); - - return octave_value (v1.array_value (). concat (v2.char_array_value (), - ra_idx)); -} - -DEFCATOP (m_chm, matrix, char_matrix) -{ - CAST_BINOP_ARGS (octave_matrix&, const octave_char_matrix&); - - gripe_implicit_conversion ("Octave:num-to-str", - v1.type_name (), v2.type_name ()); - - return octave_value (v1.array_value (). concat (v2.char_array_value (), - ra_idx)); -} - -void -install_chm_ops (void) -{ - INSTALL_UNOP (op_transpose, octave_char_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_char_matrix, transpose); - - INSTALL_CATOP (octave_char_matrix, octave_char_matrix, chm_chm); - INSTALL_CATOP (octave_char_matrix, octave_scalar, chm_s); - INSTALL_CATOP (octave_char_matrix, octave_matrix, chm_m); - INSTALL_CATOP (octave_scalar, octave_char_matrix, s_chm); - INSTALL_CATOP (octave_matrix, octave_char_matrix, m_chm); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-class.cc --- a/src/OPERATORS/op-class.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,161 +0,0 @@ -/* - -Copyright (C) 2007-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "oct-time.h" - -#include "gripes.h" -#include "load-path.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-class.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "symtab.h" -#include "parse.h" - -// class ops. - -#define DEF_CLASS_UNOP(name) \ - static octave_value \ - oct_unop_ ## name (const octave_value& a) \ - { \ - octave_value retval; \ - \ - std::string class_name = a.class_name (); \ - \ - octave_value meth = symbol_table::find_method (#name, class_name); \ - \ - if (meth.is_defined ()) \ - { \ - octave_value_list args; \ - \ - args(0) = a; \ - \ - octave_value_list tmp = feval (meth.function_value (), args, 1); \ - \ - if (tmp.length () > 0) \ - retval = tmp(0); \ - } \ - else \ - error ("%s method not defined for %s class", \ - #name, class_name.c_str ()); \ - \ - return retval; \ - } - -DEF_CLASS_UNOP (not) -DEF_CLASS_UNOP (uplus) -DEF_CLASS_UNOP (uminus) -DEF_CLASS_UNOP (transpose) -DEF_CLASS_UNOP (ctranspose) - -// FIXME -- we need to handle precedence in the binop function. - -#define DEF_CLASS_BINOP(name) \ - static octave_value \ - oct_binop_ ## name (const octave_value& a1, const octave_value& a2) \ - { \ - octave_value retval; \ - \ - std::string dispatch_type \ - = a1.is_object () ? a1.class_name () : a2.class_name (); \ - \ - octave_value meth = symbol_table::find_method (#name, dispatch_type); \ - \ - if (meth.is_defined ()) \ - { \ - octave_value_list args; \ - \ - args(1) = a2; \ - args(0) = a1; \ - \ - octave_value_list tmp = feval (meth.function_value (), args, 1); \ - \ - if (tmp.length () > 0) \ - retval = tmp(0); \ - } \ - else \ - error ("%s method not defined for %s class", \ - #name, dispatch_type.c_str ()); \ - \ - return retval; \ - } - -DEF_CLASS_BINOP (plus) -DEF_CLASS_BINOP (minus) -DEF_CLASS_BINOP (mtimes) -DEF_CLASS_BINOP (mrdivide) -DEF_CLASS_BINOP (mpower) -DEF_CLASS_BINOP (mldivide) -DEF_CLASS_BINOP (lt) -DEF_CLASS_BINOP (le) -DEF_CLASS_BINOP (eq) -DEF_CLASS_BINOP (ge) -DEF_CLASS_BINOP (gt) -DEF_CLASS_BINOP (ne) -DEF_CLASS_BINOP (times) -DEF_CLASS_BINOP (rdivide) -DEF_CLASS_BINOP (power) -DEF_CLASS_BINOP (ldivide) -DEF_CLASS_BINOP (and) -DEF_CLASS_BINOP (or) - -#define INSTALL_CLASS_UNOP(op, f) \ - octave_value_typeinfo::register_unary_class_op \ - (octave_value::op, oct_unop_ ## f) - -#define INSTALL_CLASS_BINOP(op, f) \ - octave_value_typeinfo::register_binary_class_op \ - (octave_value::op, oct_binop_ ## f) - -void -install_class_ops (void) -{ - INSTALL_CLASS_UNOP (op_not, not); - INSTALL_CLASS_UNOP (op_uplus, uplus); - INSTALL_CLASS_UNOP (op_uminus, uminus); - INSTALL_CLASS_UNOP (op_transpose, transpose); - INSTALL_CLASS_UNOP (op_hermitian, ctranspose); - - INSTALL_CLASS_BINOP (op_add, plus); - INSTALL_CLASS_BINOP (op_sub, minus); - INSTALL_CLASS_BINOP (op_mul, mtimes); - INSTALL_CLASS_BINOP (op_div, mrdivide); - INSTALL_CLASS_BINOP (op_pow, mpower); - INSTALL_CLASS_BINOP (op_ldiv, mldivide); - INSTALL_CLASS_BINOP (op_lt, lt); - INSTALL_CLASS_BINOP (op_le, le); - INSTALL_CLASS_BINOP (op_eq, eq); - INSTALL_CLASS_BINOP (op_ge, ge); - INSTALL_CLASS_BINOP (op_gt, gt); - INSTALL_CLASS_BINOP (op_ne, ne); - INSTALL_CLASS_BINOP (op_el_mul, times); - INSTALL_CLASS_BINOP (op_el_div, rdivide); - INSTALL_CLASS_BINOP (op_el_pow, power); - INSTALL_CLASS_BINOP (op_el_ldiv, ldivide); - INSTALL_CLASS_BINOP (op_el_and, and); - INSTALL_CLASS_BINOP (op_el_or, or); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cm-cdm.cc --- a/src/OPERATORS/op-cm-cdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-cx-mat.h" -#define RINCLUDE "ov-cx-diag.h" - -#define LMATRIX complex_matrix -#define RMATRIX complex_diag_matrix - -#define LSHORT cm -#define RSHORT cdm - -#define DEFINEDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cm-cm.cc --- a/src/OPERATORS/op-cm-cm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,260 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// unary complex matrix ops. - -DEFNDUNOP_OP (not, complex_matrix, complex_array, !) -DEFNDUNOP_OP (uplus, complex_matrix, complex_array, /* no-op */) -DEFNDUNOP_OP (uminus, complex_matrix, complex_array, -) - -DEFUNOP (transpose, complex_matrix) -{ - CAST_UNOP_ARG (const octave_complex_matrix&); - - if (v.ndims () > 2) - { - error ("transpose not defined for N-d objects"); - return octave_value (); - } - else - return octave_value (v.complex_matrix_value ().transpose ()); -} - -DEFUNOP (hermitian, complex_matrix) -{ - CAST_UNOP_ARG (const octave_complex_matrix&); - - if (v.ndims () > 2) - { - error ("complex-conjugate transpose not defined for N-d objects"); - return octave_value (); - } - else - return octave_value (v.complex_matrix_value ().hermitian ()); -} - -DEFNCUNOP_METHOD (incr, complex_matrix, increment) -DEFNCUNOP_METHOD (decr, complex_matrix, decrement) -DEFNCUNOP_METHOD (changesign, complex_matrix, changesign) - -// complex matrix by complex matrix ops. - -DEFNDBINOP_OP (add, complex_matrix, complex_matrix, complex_array, complex_array, +) -DEFNDBINOP_OP (sub, complex_matrix, complex_matrix, complex_array, complex_array, -) - -DEFBINOP_OP (mul, complex_matrix, complex_matrix, *) - -DEFBINOP (div, complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (v1.complex_matrix_value (), - v2.complex_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOPX (pow, complex_matrix, complex_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), - v2.complex_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP (trans_mul, complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); - return octave_value(xgemm (v1.complex_matrix_value (), - v2.complex_matrix_value (), - blas_trans, blas_no_trans)); -} - -DEFBINOP (mul_trans, complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); - return octave_value(xgemm (v1.complex_matrix_value (), - v2.complex_matrix_value (), - blas_no_trans, blas_trans)); -} - -DEFBINOP (herm_mul, complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); - return octave_value(xgemm (v1.complex_matrix_value (), - v2.complex_matrix_value (), - blas_conj_trans, blas_no_trans)); -} - -DEFBINOP (mul_herm, complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); - return octave_value(xgemm (v1.complex_matrix_value (), - v2.complex_matrix_value (), - blas_no_trans, blas_conj_trans)); -} - -DEFBINOP (trans_ldiv, complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), - v2.complex_matrix_value (), typ, blas_trans); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP (herm_ldiv, complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), - v2.complex_matrix_value (), typ, blas_conj_trans); - - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_ne) - -DEFNDBINOP_FN (el_mul, complex_matrix, complex_matrix, complex_array, complex_array, product) -DEFNDBINOP_FN (el_div, complex_matrix, complex_matrix, complex_array, complex_array, quotient) -DEFNDBINOP_FN (el_pow, complex_matrix, complex_matrix, complex_array, complex_array, elem_xpow) - -DEFBINOP (el_ldiv, complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); - - return octave_value (quotient (v2.complex_array_value (), v1.complex_array_value ())); -} - -DEFNDBINOP_FN (el_and, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_and) -DEFNDBINOP_FN (el_or, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_or) - -DEFNDCATOP_FN (cm_cm, complex_matrix, complex_matrix, complex_array, complex_array, concat) - -DEFNDASSIGNOP_FN (assign, complex_matrix, complex_matrix, complex_array, assign) - -DEFNULLASSIGNOP_FN (null_assign, complex_matrix, delete_elements) - -DEFNDASSIGNOP_OP (assign_add, complex_matrix, complex_matrix, complex_array, +=) -DEFNDASSIGNOP_OP (assign_sub, complex_matrix, complex_matrix, complex_array, -=) -DEFNDASSIGNOP_FNOP (assign_el_mul, complex_matrix, complex_matrix, complex_array, product_eq) -DEFNDASSIGNOP_FNOP (assign_el_div, complex_matrix, complex_matrix, complex_array, quotient_eq) - -CONVDECL (complex_matrix_to_float_complex_matrix) -{ - CAST_CONV_ARG (const octave_complex_matrix&); - - return new octave_float_complex_matrix (FloatComplexNDArray (v.complex_array_value ())); -} - -void -install_cm_cm_ops (void) -{ - INSTALL_UNOP (op_not, octave_complex_matrix, not); - INSTALL_UNOP (op_uplus, octave_complex_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_complex_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_complex_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_complex_matrix, hermitian); - - INSTALL_NCUNOP (op_incr, octave_complex_matrix, incr); - INSTALL_NCUNOP (op_decr, octave_complex_matrix, decr); - INSTALL_NCUNOP (op_uminus, octave_complex_matrix, changesign); - - INSTALL_BINOP (op_add, octave_complex_matrix, octave_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_complex_matrix, octave_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_complex_matrix, octave_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_complex_matrix, octave_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_complex_matrix, octave_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_complex_matrix, octave_complex_matrix, ldiv); - INSTALL_BINOP (op_trans_mul, octave_complex_matrix, octave_complex_matrix, trans_mul); - INSTALL_BINOP (op_mul_trans, octave_complex_matrix, octave_complex_matrix, mul_trans); - INSTALL_BINOP (op_herm_mul, octave_complex_matrix, octave_complex_matrix, herm_mul); - INSTALL_BINOP (op_mul_herm, octave_complex_matrix, octave_complex_matrix, mul_herm); - INSTALL_BINOP (op_trans_ldiv, octave_complex_matrix, octave_complex_matrix, trans_ldiv); - INSTALL_BINOP (op_herm_ldiv, octave_complex_matrix, octave_complex_matrix, herm_ldiv); - - INSTALL_BINOP (op_lt, octave_complex_matrix, octave_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_complex_matrix, octave_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_complex_matrix, octave_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_complex_matrix, octave_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_complex_matrix, octave_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_complex_matrix, octave_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_complex_matrix, octave_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_complex_matrix, octave_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_complex_matrix, octave_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, octave_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex_matrix, octave_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_complex_matrix, octave_complex_matrix, el_or); - - INSTALL_CATOP (octave_complex_matrix, octave_complex_matrix, cm_cm); - - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_complex_matrix, assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_null_matrix, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_null_str, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_null_sq_str, null_assign); - - INSTALL_ASSIGNOP (op_add_eq, octave_complex_matrix, octave_complex_matrix, assign_add); - INSTALL_ASSIGNOP (op_sub_eq, octave_complex_matrix, octave_complex_matrix, assign_sub); - INSTALL_ASSIGNOP (op_el_mul_eq, octave_complex_matrix, octave_complex_matrix, assign_el_mul); - INSTALL_ASSIGNOP (op_el_div_eq, octave_complex_matrix, octave_complex_matrix, assign_el_div); - - INSTALL_CONVOP (octave_complex_matrix, octave_float_complex_matrix, - complex_matrix_to_float_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cm-cs.cc --- a/src/OPERATORS/op-cm-cs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,145 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-complex.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex matrix by complex scalar ops. - -DEFNDBINOP_OP (add, complex_matrix, complex, complex_array, complex, +) -DEFNDBINOP_OP (sub, complex_matrix, complex, complex_array, complex, -) -DEFNDBINOP_OP (mul, complex_matrix, complex, complex_array, complex, *) - -DEFBINOP (div, complex_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); - - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.complex_array_value () / d); -} - -DEFBINOP_FN (pow, complex_matrix, complex, xpow) - -DEFBINOP (ldiv, complex_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); - - ComplexMatrix m1 = v1.complex_matrix_value (); - ComplexMatrix m2 = v2.complex_matrix_value (); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (m1, m2, typ); - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, complex_matrix, complex, complex_array, complex, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, complex_matrix, complex, complex_array, complex, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, complex_matrix, complex, complex_array, complex, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, complex_matrix, complex, complex_array, complex, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, complex_matrix, complex, complex_array, complex, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, complex_matrix, complex, complex_array, complex, mx_el_ne) - -DEFNDBINOP_OP (el_mul, complex_matrix, complex, complex_array, complex, *) - -DEFBINOP (el_div, complex_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); - - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.complex_array_value () / d); -} - -DEFNDBINOP_FN (el_pow, complex_matrix, complex, complex_array, complex, elem_xpow) - -DEFBINOP (el_ldiv, complex_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); - - return x_el_div (v2.complex_value (), v1.complex_array_value ()); -} - -DEFNDBINOP_FN (el_and, complex_matrix, complex, complex_array, complex, mx_el_and) -DEFNDBINOP_FN (el_or, complex_matrix, complex, complex_array, complex, mx_el_or) - -DEFNDCATOP_FN (cm_cs, complex_matrix, complex, complex_array, complex_array, concat) - -DEFNDASSIGNOP_FN (assign, complex_matrix, complex, complex, assign) -DEFNDASSIGNOP_FN (sgl_assign, float_complex_matrix, complex, float_complex, assign) - -DEFNDASSIGNOP_OP (assign_add, complex_matrix, complex_scalar, complex, +=) -DEFNDASSIGNOP_OP (assign_sub, complex_matrix, complex_scalar, complex, -=) -DEFNDASSIGNOP_OP (assign_mul, complex_matrix, complex_scalar, complex, *=) -DEFNDASSIGNOP_OP (assign_div, complex_matrix, complex_scalar, complex, /=) - -void -install_cm_cs_ops (void) -{ - INSTALL_BINOP (op_add, octave_complex_matrix, octave_complex, add); - INSTALL_BINOP (op_sub, octave_complex_matrix, octave_complex, sub); - INSTALL_BINOP (op_mul, octave_complex_matrix, octave_complex, mul); - INSTALL_BINOP (op_div, octave_complex_matrix, octave_complex, div); - INSTALL_BINOP (op_pow, octave_complex_matrix, octave_complex, pow); - INSTALL_BINOP (op_ldiv, octave_complex_matrix, octave_complex, ldiv); - INSTALL_BINOP (op_lt, octave_complex_matrix, octave_complex, lt); - INSTALL_BINOP (op_le, octave_complex_matrix, octave_complex, le); - INSTALL_BINOP (op_eq, octave_complex_matrix, octave_complex, eq); - INSTALL_BINOP (op_ge, octave_complex_matrix, octave_complex, ge); - INSTALL_BINOP (op_gt, octave_complex_matrix, octave_complex, gt); - INSTALL_BINOP (op_ne, octave_complex_matrix, octave_complex, ne); - INSTALL_BINOP (op_el_mul, octave_complex_matrix, octave_complex, el_mul); - INSTALL_BINOP (op_el_div, octave_complex_matrix, octave_complex, el_div); - INSTALL_BINOP (op_el_pow, octave_complex_matrix, octave_complex, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, octave_complex, el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex_matrix, octave_complex, el_and); - INSTALL_BINOP (op_el_or, octave_complex_matrix, octave_complex, el_or); - - INSTALL_CATOP (octave_complex_matrix, octave_complex, cm_cs); - - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_complex, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_complex, sgl_assign); - - INSTALL_ASSIGNOP (op_add_eq, octave_complex_matrix, octave_complex_scalar, assign_add); - INSTALL_ASSIGNOP (op_sub_eq, octave_complex_matrix, octave_complex_scalar, assign_sub); - INSTALL_ASSIGNOP (op_mul_eq, octave_complex_matrix, octave_complex_scalar, assign_mul); - INSTALL_ASSIGNOP (op_div_eq, octave_complex_matrix, octave_complex_scalar, assign_div); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cm-dm.cc --- a/src/OPERATORS/op-cm-dm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-cx-mat.h" -#define RINCLUDE "ov-re-diag.h" - -#define LMATRIX complex_matrix -#define RMATRIX diag_matrix - -#define LSHORT cm -#define RSHORT dm - -#define DEFINEDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cm-m.cc --- a/src/OPERATORS/op-cm-m.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,143 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-cm-m.h" -#include "mx-m-cm.h" -#include "mx-cnda-nda.h" -#include "mx-nda-cnda.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-cx-mat.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex matrix by matrix ops. - -DEFNDBINOP_OP (add, complex_matrix, matrix, complex_array, array, +) -DEFNDBINOP_OP (sub, complex_matrix, matrix, complex_array, array, -) - -DEFBINOP_OP (mul, complex_matrix, matrix, *) - -DEFBINOP (mul_trans, complex_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); - - ComplexMatrix m1 = v1.complex_matrix_value (); - Matrix m2 = v2.matrix_value (); - - return ComplexMatrix (xgemm (real (m1), m2, blas_no_trans, blas_trans), - xgemm (imag (m1), m2, blas_no_trans, blas_trans)); -} - -DEFBINOP (div, complex_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (v1.complex_matrix_value (), - v2.matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - - -DEFBINOPX (pow, complex_matrix, matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, complex_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), - v2.matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, complex_matrix, matrix, complex_array, array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, complex_matrix, matrix, complex_array, array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, complex_matrix, matrix, complex_array, array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, complex_matrix, matrix, complex_array, array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, complex_matrix, matrix, complex_array, array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, complex_matrix, matrix, complex_array, array, mx_el_ne) - -DEFNDBINOP_FN (el_mul, complex_matrix, matrix, complex_array, array, product) -DEFNDBINOP_FN (el_div, complex_matrix, matrix, complex_array, array, quotient) -DEFNDBINOP_FN (el_pow, complex_matrix, matrix, complex_array, array, elem_xpow) - -DEFBINOP (el_ldiv, complex_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); - - return quotient (v2.array_value (), v1.complex_array_value ()); -} - -DEFNDBINOP_FN (el_and, complex_matrix, matrix, complex_array, array, mx_el_and) -DEFNDBINOP_FN (el_or, complex_matrix, matrix, complex_array, array, mx_el_or) - -DEFNDCATOP_FN (cm_m, complex_matrix, matrix, complex_array, array, concat) - -DEFNDASSIGNOP_FN (assign, complex_matrix, matrix, complex_array, assign) - -void -install_cm_m_ops (void) -{ - INSTALL_BINOP (op_add, octave_complex_matrix, octave_matrix, add); - INSTALL_BINOP (op_sub, octave_complex_matrix, octave_matrix, sub); - INSTALL_BINOP (op_mul, octave_complex_matrix, octave_matrix, mul); - INSTALL_BINOP (op_div, octave_complex_matrix, octave_matrix, div); - INSTALL_BINOP (op_pow, octave_complex_matrix, octave_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_complex_matrix, octave_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_complex_matrix, octave_matrix, lt); - INSTALL_BINOP (op_le, octave_complex_matrix, octave_matrix, le); - INSTALL_BINOP (op_eq, octave_complex_matrix, octave_matrix, eq); - INSTALL_BINOP (op_ge, octave_complex_matrix, octave_matrix, ge); - INSTALL_BINOP (op_gt, octave_complex_matrix, octave_matrix, gt); - INSTALL_BINOP (op_ne, octave_complex_matrix, octave_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_complex_matrix, octave_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_complex_matrix, octave_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_complex_matrix, octave_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, octave_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex_matrix, octave_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_complex_matrix, octave_matrix, el_or); - INSTALL_BINOP (op_mul_trans, octave_complex_matrix, octave_matrix, mul_trans); - INSTALL_BINOP (op_mul_herm, octave_complex_matrix, octave_matrix, mul_trans); - - INSTALL_CATOP (octave_complex_matrix, octave_matrix, cm_m); - - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_matrix, assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cm-pm.cc --- a/src/OPERATORS/op-cm-pm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define MINCLUDE "ov-cx-mat.h" - -#define LMATRIX complex_matrix -#define RMATRIX perm_matrix - -#define LSHORT cm -#define RSHORT pm - -#define RIGHT - -#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cm-s.cc --- a/src/OPERATORS/op-cm-s.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,143 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-cm-s.h" -#include "mx-cnda-s.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-cx-mat.h" -#include "ov-re-mat.h" -#include "ov-scalar.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex matrix by scalar ops. - -DEFNDBINOP_OP (add, complex_matrix, scalar, complex_array, scalar, +) -DEFNDBINOP_OP (sub, complex_matrix, scalar, complex_array, scalar, -) -DEFNDBINOP_OP (mul, complex_matrix, scalar, complex_array, scalar, *) - -DEFBINOP (div, complex_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); - - double d = v2.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.complex_array_value () / d); -} - -DEFBINOP_FN (pow, complex_matrix, scalar, xpow) - -DEFBINOP (ldiv, complex_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); - - ComplexMatrix m1 = v1.complex_matrix_value (); - Matrix m2 = v2.matrix_value (); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (m1, m2, typ); - - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, complex_matrix, scalar, complex_array, scalar, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, complex_matrix, scalar, complex_array, scalar, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, complex_matrix, scalar, complex_array, scalar, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, complex_matrix, scalar, complex_array, scalar, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, complex_matrix, scalar, complex_array, scalar, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, complex_matrix, scalar, complex_array, scalar, mx_el_ne) - -DEFNDBINOP_OP (el_mul, complex_matrix, scalar, complex_array, scalar, *) - -DEFBINOP (el_div, complex_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); - - double d = v2.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.complex_array_value () / d); -} - -DEFNDBINOP_FN (el_pow, complex_matrix, scalar, complex_array, scalar, elem_xpow) - -DEFBINOP (el_ldiv, complex_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); - - return x_el_div (v2.double_value (), v1.complex_array_value ()); -} - -DEFNDBINOP_FN (el_and, complex_matrix, scalar, complex_array, scalar, mx_el_and) -DEFNDBINOP_FN (el_or, complex_matrix, scalar, complex_array, scalar, mx_el_or) - -DEFNDCATOP_FN (cm_s, complex_matrix, scalar, complex_array, array, concat) - -DEFNDASSIGNOP_FN (assign, complex_matrix, scalar, complex_array, assign) - -DEFNDASSIGNOP_OP (assign_mul, complex_matrix, scalar, scalar, *=) -DEFNDASSIGNOP_OP (assign_div, complex_matrix, scalar, scalar, /=) - -void -install_cm_s_ops (void) -{ - INSTALL_BINOP (op_add, octave_complex_matrix, octave_scalar, add); - INSTALL_BINOP (op_sub, octave_complex_matrix, octave_scalar, sub); - INSTALL_BINOP (op_mul, octave_complex_matrix, octave_scalar, mul); - INSTALL_BINOP (op_div, octave_complex_matrix, octave_scalar, div); - INSTALL_BINOP (op_pow, octave_complex_matrix, octave_scalar, pow); - INSTALL_BINOP (op_ldiv, octave_complex_matrix, octave_scalar, ldiv); - INSTALL_BINOP (op_lt, octave_complex_matrix, octave_scalar, lt); - INSTALL_BINOP (op_le, octave_complex_matrix, octave_scalar, le); - INSTALL_BINOP (op_eq, octave_complex_matrix, octave_scalar, eq); - INSTALL_BINOP (op_ge, octave_complex_matrix, octave_scalar, ge); - INSTALL_BINOP (op_gt, octave_complex_matrix, octave_scalar, gt); - INSTALL_BINOP (op_ne, octave_complex_matrix, octave_scalar, ne); - INSTALL_BINOP (op_el_mul, octave_complex_matrix, octave_scalar, el_mul); - INSTALL_BINOP (op_el_div, octave_complex_matrix, octave_scalar, el_div); - INSTALL_BINOP (op_el_pow, octave_complex_matrix, octave_scalar, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, octave_scalar, el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex_matrix, octave_scalar, el_and); - INSTALL_BINOP (op_el_or, octave_complex_matrix, octave_scalar, el_or); - - INSTALL_CATOP (octave_complex_matrix, octave_scalar, cm_s); - - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_scalar, assign); - - INSTALL_ASSIGNOP (op_mul_eq, octave_complex_matrix, octave_scalar, assign_mul); - INSTALL_ASSIGNOP (op_div_eq, octave_complex_matrix, octave_scalar, assign_div); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cm-scm.cc --- a/src/OPERATORS/op-cm-scm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,203 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-cx-mat.h" -#include "ops.h" -#include "xdiv.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "smx-scm-cm.h" -#include "smx-cm-scm.h" -#include "ov-cx-sparse.h" - -// complex matrix by sparse complex matrix ops. - -DEFBINOP_OP (add, complex_matrix, sparse_complex_matrix, +) -DEFBINOP_OP (sub, complex_matrix, sparse_complex_matrix, -) - -DEFBINOP_OP (mul, complex_matrix, sparse_complex_matrix, *) - -DEFBINOP (div, complex_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, - const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.complex_array_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (v1.complex_matrix_value (), - v2.sparse_complex_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOPX (pow, complex_matrix, sparse_complex_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, complex_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, - const octave_sparse_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), - v2.complex_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (mul_trans, complex_matrix, sparse_complex_matrix, mul_trans); -DEFBINOP_FN (mul_herm, complex_matrix, sparse_complex_matrix, mul_herm); - -DEFBINOP_FN (lt, complex_matrix, sparse_complex_matrix, mx_el_lt) -DEFBINOP_FN (le, complex_matrix, sparse_complex_matrix, mx_el_le) -DEFBINOP_FN (eq, complex_matrix, sparse_complex_matrix, mx_el_eq) -DEFBINOP_FN (ge, complex_matrix, sparse_complex_matrix, mx_el_ge) -DEFBINOP_FN (gt, complex_matrix, sparse_complex_matrix, mx_el_gt) -DEFBINOP_FN (ne, complex_matrix, sparse_complex_matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, complex_matrix, sparse_complex_matrix, product) -DEFBINOP_FN (el_div, complex_matrix, sparse_complex_matrix, quotient) - -DEFBINOP (el_pow, complex_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, - const octave_sparse_complex_matrix&); - - return octave_value - (elem_xpow (SparseComplexMatrix (v1.complex_matrix_value ()), - v2.sparse_complex_matrix_value ())); -} - -DEFBINOP (el_ldiv, sparse_complex_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, - const octave_sparse_complex_matrix&); - - return octave_value (quotient (v2.sparse_complex_matrix_value (), - v1.complex_matrix_value ())); -} - -DEFBINOP_FN (el_and, complex_matrix, sparse_complex_matrix, mx_el_and) -DEFBINOP_FN (el_or, complex_matrix, sparse_complex_matrix, mx_el_or) - -DEFCATOP (cm_scm, complex_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (octave_complex_matrix&, - const octave_sparse_complex_matrix&); - SparseComplexMatrix tmp (v1.complex_matrix_value ()); - return octave_value (tmp. concat (v2.sparse_complex_matrix_value (), - ra_idx)); -} - -DEFCONV (sparse_complex_matrix_conv, complex_matrix, - sparse_complex_matrix) -{ - CAST_CONV_ARG (const octave_complex_matrix&); - return new octave_sparse_complex_matrix - (SparseComplexMatrix (v.complex_matrix_value ())); -} - -DEFNDASSIGNOP_FN (assign, complex_matrix, sparse_complex_matrix, - complex_array, assign) - -void -install_cm_scm_ops (void) -{ - INSTALL_BINOP (op_add, octave_complex_matrix, - octave_sparse_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_complex_matrix, - octave_sparse_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_complex_matrix, - octave_sparse_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_complex_matrix, - octave_sparse_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_complex_matrix, - octave_sparse_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_complex_matrix, - octave_sparse_complex_matrix, ldiv); - INSTALL_BINOP (op_mul_trans, octave_complex_matrix, - octave_sparse_complex_matrix, mul_trans); - INSTALL_BINOP (op_mul_herm, octave_complex_matrix, - octave_sparse_complex_matrix, mul_herm); - INSTALL_BINOP (op_lt, octave_complex_matrix, - octave_sparse_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_complex_matrix, - octave_sparse_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_complex_matrix, - octave_sparse_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_complex_matrix, - octave_sparse_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_complex_matrix, - octave_sparse_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_complex_matrix, - octave_sparse_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_complex_matrix, - octave_sparse_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_complex_matrix, - octave_sparse_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_complex_matrix, - octave_sparse_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, - octave_sparse_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex_matrix, - octave_sparse_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_complex_matrix, - octave_sparse_complex_matrix, el_or); - - INSTALL_CATOP (octave_complex_matrix, - octave_sparse_complex_matrix, cm_scm); - - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, - octave_sparse_complex_matrix, assign) - INSTALL_ASSIGNCONV (octave_complex_matrix, octave_sparse_complex_matrix, - octave_complex_matrix); - - INSTALL_WIDENOP (octave_complex_matrix, octave_sparse_complex_matrix, - sparse_complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cm-sm.cc --- a/src/OPERATORS/op-cm-sm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,168 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-cx-mat.h" -#include "ops.h" -#include "xdiv.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "smx-sm-cm.h" -#include "smx-cm-sm.h" -#include "ov-re-sparse.h" - -// complex matrix by sparse matrix ops. - -DEFBINOP_OP (add, complex_matrix, sparse_matrix, +) -DEFBINOP_OP (sub, complex_matrix, sparse_matrix, -) - -DEFBINOP_OP (mul, complex_matrix, sparse_matrix, *) - -DEFBINOP (div, complex_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - double d = v2.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.complex_array_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (v1.complex_matrix_value (), - v2.sparse_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOPX (pow, complex_matrix, sparse_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, complex_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, - const octave_sparse_matrix&); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), - v2.matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (lt, complex_matrix, sparse_matrix, mx_el_lt) -DEFBINOP_FN (le, complex_matrix, sparse_matrix, mx_el_le) -DEFBINOP_FN (eq, complex_matrix, sparse_matrix, mx_el_eq) -DEFBINOP_FN (ge, complex_matrix, sparse_matrix, mx_el_ge) -DEFBINOP_FN (gt, complex_matrix, sparse_matrix, mx_el_gt) -DEFBINOP_FN (ne, complex_matrix, sparse_matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, complex_matrix, sparse_matrix, product) -DEFBINOP_FN (el_div, complex_matrix, sparse_matrix, quotient) - -DEFBINOP (el_pow, complex_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, - const octave_sparse_matrix&); - - return octave_value - (elem_xpow ( SparseComplexMatrix (v1.complex_matrix_value ()), - v2.sparse_matrix_value ())); -} - -DEFBINOP (el_ldiv, complex_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_matrix&, - const octave_sparse_matrix&); - return octave_value - (quotient (v2.sparse_matrix_value (), v1.complex_matrix_value ())); -} - -DEFBINOP_FN (el_and, complex_matrix, sparse_matrix, mx_el_and) -DEFBINOP_FN (el_or, complex_matrix, sparse_matrix, mx_el_or) - -DEFCATOP (cm_sm, complex_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (octave_complex_matrix&, const octave_sparse_matrix&); - SparseComplexMatrix tmp (v1.complex_matrix_value ()); - return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); -} - -DEFNDASSIGNOP_FN (assign, complex_matrix, sparse_matrix, complex_array, assign) - -void -install_cm_sm_ops (void) -{ - INSTALL_BINOP (op_add, octave_complex_matrix, octave_sparse_matrix, add); - INSTALL_BINOP (op_sub, octave_complex_matrix, octave_sparse_matrix, sub); - INSTALL_BINOP (op_mul, octave_complex_matrix, octave_sparse_matrix, mul); - INSTALL_BINOP (op_div, octave_complex_matrix, octave_sparse_matrix, div); - INSTALL_BINOP (op_pow, octave_complex_matrix, octave_sparse_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_complex_matrix, octave_sparse_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_complex_matrix, octave_sparse_matrix, lt); - INSTALL_BINOP (op_le, octave_complex_matrix, octave_sparse_matrix, le); - INSTALL_BINOP (op_eq, octave_complex_matrix, octave_sparse_matrix, eq); - INSTALL_BINOP (op_ge, octave_complex_matrix, octave_sparse_matrix, ge); - INSTALL_BINOP (op_gt, octave_complex_matrix, octave_sparse_matrix, gt); - INSTALL_BINOP (op_ne, octave_complex_matrix, octave_sparse_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_complex_matrix, octave_sparse_matrix, - el_mul); - INSTALL_BINOP (op_el_div, octave_complex_matrix, octave_sparse_matrix, - el_div); - INSTALL_BINOP (op_el_pow, octave_complex_matrix, octave_sparse_matrix, - el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, octave_sparse_matrix, - el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex_matrix, octave_sparse_matrix, - el_and); - INSTALL_BINOP (op_el_or, octave_complex_matrix, octave_sparse_matrix, - el_or); - - INSTALL_CATOP (octave_complex_matrix, octave_sparse_matrix, cm_sm); - - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_sparse_matrix, - assign); - INSTALL_ASSIGNCONV (octave_complex_matrix, octave_sparse_matrix, - octave_complex_matrix) - -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cs-cm.cc --- a/src/OPERATORS/op-cs-cm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,133 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-complex.h" -#include "ov-cx-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex scalar by complex matrix ops. - -DEFNDBINOP_OP (add, complex, complex_matrix, complex, complex_array, +) -DEFNDBINOP_OP (sub, complex, complex_matrix, complex, complex_array, -) -DEFNDBINOP_OP (mul, complex, complex_matrix, complex, complex_array, *) - -DEFBINOP (div, complex, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); - - ComplexMatrix m1 = v1.complex_matrix_value (); - ComplexMatrix m2 = v2.complex_matrix_value (); - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (m1, m2, typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (pow, complex, complex_matrix, xpow) - -DEFBINOP (ldiv, complex, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); - - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.complex_array_value () / d); -} - -DEFNDCMPLXCMPOP_FN (lt, complex, complex_matrix, complex, complex_array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, complex, complex_matrix, complex, complex_array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, complex, complex_matrix, complex, complex_array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, complex, complex_matrix, complex, complex_array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, complex, complex_matrix, complex, complex_array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, complex, complex_matrix, complex, complex_array, mx_el_ne) - -DEFNDBINOP_OP (el_mul, complex, complex_matrix, complex, complex_array, *) -DEFNDBINOP_FN (el_div, complex, complex_matrix, complex, complex_array, x_el_div) -DEFNDBINOP_FN (el_pow, complex, complex_matrix, complex, complex_array, elem_xpow) - -DEFBINOP (el_ldiv, complex, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); - - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.complex_array_value () / d); -} - -DEFNDBINOP_FN (el_and, complex, complex_matrix, complex, complex_array, mx_el_and) -DEFNDBINOP_FN (el_or, complex, complex_matrix, complex, complex_array, mx_el_or) - -DEFNDCATOP_FN (cs_cm, complex, complex_matrix, complex_array, complex_array, concat) - -DEFCONV (complex_matrix_conv, complex, complex_matrix) -{ - CAST_CONV_ARG (const octave_complex&); - - return new octave_complex_matrix (v.complex_matrix_value ()); -} - -void -install_cs_cm_ops (void) -{ - INSTALL_BINOP (op_add, octave_complex, octave_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_complex, octave_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_complex, octave_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_complex, octave_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_complex, octave_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_complex, octave_complex_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_complex, octave_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_complex, octave_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_complex, octave_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_complex, octave_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_complex, octave_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_complex, octave_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_complex, octave_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_complex, octave_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_complex, octave_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex, octave_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex, octave_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_complex, octave_complex_matrix, el_or); - - INSTALL_CATOP (octave_complex, octave_complex_matrix, cs_cm); - - INSTALL_ASSIGNCONV (octave_complex, octave_complex_matrix, octave_complex_matrix); - - INSTALL_WIDENOP (octave_complex, octave_complex_matrix, complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cs-cs.cc --- a/src/OPERATORS/op-cs-cs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,197 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "Array-util.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// unary complex scalar ops. - -DEFUNOP (not, complex) -{ - CAST_UNOP_ARG (const octave_complex&); - Complex x = v.complex_value (); - if (xisnan (x)) - gripe_nan_to_logical_conversion (); - return octave_value (x == 0.0); -} - -DEFUNOP_OP (uplus, complex, /* no-op */) -DEFUNOP_OP (uminus, complex, -) -DEFUNOP_OP (transpose, complex, /* no-op */) - -DEFUNOP (hermitian, complex) -{ - CAST_UNOP_ARG (const octave_complex&); - - return octave_value (conj (v.complex_value ())); -} - -DEFNCUNOP_METHOD (incr, complex, increment) -DEFNCUNOP_METHOD (decr, complex, decrement) - -// complex scalar by complex scalar ops. - -DEFBINOP_OP (add, complex, complex, +) -DEFBINOP_OP (sub, complex, complex, -) -DEFBINOP_OP (mul, complex, complex, *) - -DEFBINOP (div, complex, complex) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); - - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.complex_value () / d); -} - -DEFBINOP_FN (pow, complex, complex, xpow) - -DEFBINOP (ldiv, complex, complex) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); - - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.complex_value () / d); -} - -DEFCMPLXCMPOP_OP (lt, complex, complex, <) -DEFCMPLXCMPOP_OP (le, complex, complex, <=) -DEFCMPLXCMPOP_OP (eq, complex, complex, ==) -DEFCMPLXCMPOP_OP (ge, complex, complex, >=) -DEFCMPLXCMPOP_OP (gt, complex, complex, >) -DEFCMPLXCMPOP_OP (ne, complex, complex, !=) - -DEFBINOP_OP (el_mul, complex, complex, *) - -DEFBINOP (el_div, complex, complex) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); - - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.complex_value () / d); -} - -DEFBINOP_FN (el_pow, complex, complex, xpow) - -DEFBINOP (el_ldiv, complex, complex) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); - - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.complex_value () / d); -} - -DEFBINOP (el_and, complex, complex) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); - - return v1.complex_value () != 0.0 && v2.complex_value () != 0.0; -} - -DEFBINOP (el_or, complex, complex) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); - - return v1.complex_value () != 0.0 || v2.complex_value () != 0.0; -} - -DEFNDCATOP_FN (cs_cs, complex, complex, complex_array, complex_array, concat) - -CONVDECL (complex_to_float_complex) -{ - CAST_CONV_ARG (const octave_complex&); - - return new octave_float_complex_matrix (FloatComplexMatrix (1, 1, static_cast(v.complex_value ()))); -} - -void -install_cs_cs_ops (void) -{ - INSTALL_UNOP (op_not, octave_complex, not); - INSTALL_UNOP (op_uplus, octave_complex, uplus); - INSTALL_UNOP (op_uminus, octave_complex, uminus); - INSTALL_UNOP (op_transpose, octave_complex, transpose); - INSTALL_UNOP (op_hermitian, octave_complex, hermitian); - - INSTALL_NCUNOP (op_incr, octave_complex, incr); - INSTALL_NCUNOP (op_decr, octave_complex, decr); - - INSTALL_BINOP (op_add, octave_complex, octave_complex, add); - INSTALL_BINOP (op_sub, octave_complex, octave_complex, sub); - INSTALL_BINOP (op_mul, octave_complex, octave_complex, mul); - INSTALL_BINOP (op_div, octave_complex, octave_complex, div); - INSTALL_BINOP (op_pow, octave_complex, octave_complex, pow); - INSTALL_BINOP (op_ldiv, octave_complex, octave_complex, ldiv); - INSTALL_BINOP (op_lt, octave_complex, octave_complex, lt); - INSTALL_BINOP (op_le, octave_complex, octave_complex, le); - INSTALL_BINOP (op_eq, octave_complex, octave_complex, eq); - INSTALL_BINOP (op_ge, octave_complex, octave_complex, ge); - INSTALL_BINOP (op_gt, octave_complex, octave_complex, gt); - INSTALL_BINOP (op_ne, octave_complex, octave_complex, ne); - INSTALL_BINOP (op_el_mul, octave_complex, octave_complex, el_mul); - INSTALL_BINOP (op_el_div, octave_complex, octave_complex, el_div); - INSTALL_BINOP (op_el_pow, octave_complex, octave_complex, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex, octave_complex, el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex, octave_complex, el_and); - INSTALL_BINOP (op_el_or, octave_complex, octave_complex, el_or); - - INSTALL_CATOP (octave_complex, octave_complex, cs_cs); - - INSTALL_ASSIGNCONV (octave_complex, octave_complex, octave_complex_matrix); - - INSTALL_ASSIGNCONV (octave_complex, octave_null_matrix, octave_complex_matrix); - INSTALL_ASSIGNCONV (octave_complex, octave_null_str, octave_complex_matrix); - INSTALL_ASSIGNCONV (octave_complex, octave_null_sq_str, octave_complex_matrix); - - INSTALL_CONVOP (octave_complex, octave_float_complex_matrix, - complex_to_float_complex); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cs-m.cc --- a/src/OPERATORS/op-cs-m.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,130 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-cs-nda.h" -#include "mx-nda-cs.h" -#include "mx-cs-nda.h" -#include "mx-nda-cs.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-complex.h" -#include "ov-cx-mat.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex scalar by matrix ops. - -DEFNDBINOP_OP (add, complex, matrix, complex, array, +) -DEFNDBINOP_OP (sub, complex, matrix, complex, array, -) -DEFNDBINOP_OP (mul, complex, matrix, complex, array, *) - -DEFBINOP (div, complex, matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); - - ComplexMatrix m1 = v1.complex_matrix_value (); - Matrix m2 = v2.matrix_value (); - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (m1, m2, typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (pow, complex, matrix, xpow) - -DEFBINOP (ldiv, complex, matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); - - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.array_value () / d); -} - -DEFNDCMPLXCMPOP_FN (lt, complex, matrix, complex, array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, complex, matrix, complex, array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, complex, matrix, complex, array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, complex, matrix, complex, array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, complex, matrix, complex, array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, complex, matrix, complex, array, mx_el_ne) - -DEFNDBINOP_OP (el_mul, complex, matrix, complex, array, *) -DEFNDBINOP_FN (el_div, complex, matrix, complex, array, x_el_div) -DEFNDBINOP_FN (el_pow, complex, matrix, complex, array, elem_xpow) - -DEFBINOP (el_ldiv, complex, matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); - - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.array_value () / d); -} - -DEFNDBINOP_FN (el_and, complex, matrix, complex, array, mx_el_and) -DEFNDBINOP_FN (el_or, complex, matrix, complex, array, mx_el_or) - -DEFNDCATOP_FN (cs_m, complex, matrix, complex_array, array, concat) - -void -install_cs_m_ops (void) -{ - INSTALL_BINOP (op_add, octave_complex, octave_matrix, add); - INSTALL_BINOP (op_sub, octave_complex, octave_matrix, sub); - INSTALL_BINOP (op_mul, octave_complex, octave_matrix, mul); - INSTALL_BINOP (op_div, octave_complex, octave_matrix, div); - INSTALL_BINOP (op_pow, octave_complex, octave_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_complex, octave_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_complex, octave_matrix, lt); - INSTALL_BINOP (op_le, octave_complex, octave_matrix, le); - INSTALL_BINOP (op_eq, octave_complex, octave_matrix, eq); - INSTALL_BINOP (op_ge, octave_complex, octave_matrix, ge); - INSTALL_BINOP (op_gt, octave_complex, octave_matrix, gt); - INSTALL_BINOP (op_ne, octave_complex, octave_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_complex, octave_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_complex, octave_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_complex, octave_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex, octave_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex, octave_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_complex, octave_matrix, el_or); - - INSTALL_CATOP (octave_complex, octave_matrix, cs_m); - - INSTALL_ASSIGNCONV (octave_complex, octave_matrix, octave_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cs-s.cc --- a/src/OPERATORS/op-cs-s.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,146 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-complex.h" -#include "ov-cx-mat.h" -#include "ov-scalar.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex scalar by scalar ops. - -DEFBINOP_OP (add, complex, scalar, +) -DEFBINOP_OP (sub, complex, scalar, -) -DEFBINOP_OP (mul, complex, scalar, *) - -DEFBINOP (div, complex, scalar) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); - - double d = v2.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.complex_value () / d); -} - -DEFBINOP_FN (pow, complex, scalar, xpow) - -DEFBINOP (ldiv, complex, scalar) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); - - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.double_value () / d); -} - -DEFCMPLXCMPOP_OP (lt, complex, scalar, <) -DEFCMPLXCMPOP_OP (le, complex, scalar, <=) -DEFCMPLXCMPOP_OP (eq, complex, scalar, ==) -DEFCMPLXCMPOP_OP (ge, complex, scalar, >=) -DEFCMPLXCMPOP_OP (gt, complex, scalar, >) -DEFCMPLXCMPOP_OP (ne, complex, scalar, !=) - -DEFBINOP_OP (el_mul, complex, scalar, *) - -DEFBINOP (el_div, complex, scalar) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); - - double d = v2.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.complex_value () / d); -} - -DEFBINOP_FN (el_pow, complex, scalar, xpow) - -DEFBINOP (el_ldiv, complex, scalar) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); - - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.double_value () / d); -} - -DEFBINOP (el_and, complex, scalar) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); - - return v1.complex_value () != 0.0 && v2.double_value (); -} - -DEFBINOP (el_or, complex, scalar) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); - - return v1.complex_value () != 0.0 || v2.double_value (); -} - -DEFNDCATOP_FN (cs_s, complex, scalar, complex_array, array, concat) - -void -install_cs_s_ops (void) -{ - INSTALL_BINOP (op_add, octave_complex, octave_scalar, add); - INSTALL_BINOP (op_sub, octave_complex, octave_scalar, sub); - INSTALL_BINOP (op_mul, octave_complex, octave_scalar, mul); - INSTALL_BINOP (op_div, octave_complex, octave_scalar, div); - INSTALL_BINOP (op_pow, octave_complex, octave_scalar, pow); - INSTALL_BINOP (op_ldiv, octave_complex, octave_scalar, ldiv); - INSTALL_BINOP (op_lt, octave_complex, octave_scalar, lt); - INSTALL_BINOP (op_le, octave_complex, octave_scalar, le); - INSTALL_BINOP (op_eq, octave_complex, octave_scalar, eq); - INSTALL_BINOP (op_ge, octave_complex, octave_scalar, ge); - INSTALL_BINOP (op_gt, octave_complex, octave_scalar, gt); - INSTALL_BINOP (op_ne, octave_complex, octave_scalar, ne); - INSTALL_BINOP (op_el_mul, octave_complex, octave_scalar, el_mul); - INSTALL_BINOP (op_el_div, octave_complex, octave_scalar, el_div); - INSTALL_BINOP (op_el_pow, octave_complex, octave_scalar, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex, octave_scalar, el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex, octave_scalar, el_and); - INSTALL_BINOP (op_el_or, octave_complex, octave_scalar, el_or); - - INSTALL_CATOP (octave_complex, octave_scalar, cs_s); - - INSTALL_ASSIGNCONV (octave_complex, octave_scalar, octave_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cs-scm.cc --- a/src/OPERATORS/op-cs-scm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,172 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-cx-mat.h" -#include "ov-complex.h" -#include "ops.h" -#include "xpow.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "ov-cx-sparse.h" - -// complex scalar by sparse complex matrix ops. - -DEFBINOP_OP (add, complex, sparse_complex_matrix, +) -DEFBINOP_OP (sub, complex, sparse_complex_matrix, -) -DEFBINOP_OP (mul, complex, sparse_complex_matrix, *) - -DEFBINOP (div, complex, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (SparseComplexMatrix (1, 1, v1.complex_value () / d)); - } - else - { - MatrixType typ = v2.matrix_type (); - ComplexMatrix m1 = ComplexMatrix (1, 1, v1.complex_value ()); - SparseComplexMatrix m2 = v2.sparse_complex_matrix_value (); - ComplexMatrix ret = xdiv (m1, m2, typ); - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOP (pow, complex, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, - const octave_sparse_complex_matrix&); - return xpow (v1.complex_value (), v2.complex_matrix_value ()); -} - -DEFBINOP (ldiv, complex, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_complex_matrix&); - - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.sparse_complex_matrix_value () / d); -} - -DEFBINOP_FN (lt, complex, sparse_complex_matrix, mx_el_lt) -DEFBINOP_FN (le, complex, sparse_complex_matrix, mx_el_le) -DEFBINOP_FN (eq, complex, sparse_complex_matrix, mx_el_eq) -DEFBINOP_FN (ge, complex, sparse_complex_matrix, mx_el_ge) -DEFBINOP_FN (gt, complex, sparse_complex_matrix, mx_el_gt) -DEFBINOP_FN (ne, complex, sparse_complex_matrix, mx_el_ne) - -DEFBINOP_OP (el_mul, complex, sparse_complex_matrix, *) -DEFBINOP_FN (el_div, complex, sparse_complex_matrix, x_el_div) - -DEFBINOP_FN (el_pow, complex, sparse_complex_matrix, elem_xpow) - -DEFBINOP (el_ldiv, complex, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_complex_matrix&); - - Complex d = v1.complex_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v2.sparse_complex_matrix_value () / d); - - return retval; -} - -DEFBINOP_FN (el_and, complex, sparse_complex_matrix, mx_el_and) -DEFBINOP_FN (el_or, complex, sparse_complex_matrix, mx_el_or) - -DEFCATOP (cs_scm, complex, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (octave_complex&, const octave_sparse_complex_matrix&); - SparseComplexMatrix tmp (1, 1, v1.complex_value ()); - return octave_value (tmp. concat (v2.sparse_complex_matrix_value (), - ra_idx)); -} - -DEFCONV (sparse_complex_matrix_conv, complex, sparse_complex_matrix) -{ - CAST_CONV_ARG (const octave_complex&); - - return new octave_sparse_complex_matrix - (SparseComplexMatrix (v.complex_matrix_value ())); -} - -void -install_cs_scm_ops (void) -{ - INSTALL_BINOP (op_add, octave_complex, octave_sparse_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_complex, octave_sparse_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_complex, octave_sparse_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_complex, octave_sparse_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_complex, octave_sparse_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_complex, octave_sparse_complex_matrix, - ldiv); - INSTALL_BINOP (op_lt, octave_complex, octave_sparse_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_complex, octave_sparse_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_complex, octave_sparse_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_complex, octave_sparse_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_complex, octave_sparse_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_complex, octave_sparse_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_complex, octave_sparse_complex_matrix, - el_mul); - INSTALL_BINOP (op_el_div, octave_complex, octave_sparse_complex_matrix, - el_div); - INSTALL_BINOP (op_el_pow, octave_complex, octave_sparse_complex_matrix, - el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex, octave_sparse_complex_matrix, - el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex, octave_sparse_complex_matrix, - el_and); - INSTALL_BINOP (op_el_or, octave_complex, octave_sparse_complex_matrix, - el_or); - - INSTALL_CATOP (octave_complex, octave_sparse_complex_matrix, cs_scm); - - INSTALL_ASSIGNCONV (octave_complex, octave_sparse_complex_matrix, - octave_complex_matrix); - - INSTALL_WIDENOP (octave_complex, octave_sparse_complex_matrix, - sparse_complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-cs-sm.cc --- a/src/OPERATORS/op-cs-sm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,166 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-complex.h" -#include "ops.h" -#include "xpow.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "smx-cs-sm.h" -#include "smx-sm-cs.h" - -// complex by sparse matrix ops. - -DEFBINOP_OP (add, complex, sparse_matrix, +) -DEFBINOP_OP (sub, complex, sparse_matrix, -) -DEFBINOP_OP (mul, complex, sparse_matrix, *) - -DEFBINOP (div, complex, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - double d = v2.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (SparseComplexMatrix (1, 1, v1.complex_value () / d)); - } - else - { - MatrixType typ = v2.matrix_type (); - ComplexMatrix m1 = ComplexMatrix (1, 1, v1.complex_value ()); - SparseMatrix m2 = v2.sparse_matrix_value (); - ComplexMatrix ret = xdiv (m1, m2, typ); - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOP (pow, complex, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_matrix&); - return xpow (v1.complex_value (), v2.matrix_value ()); -} - -DEFBINOP (ldiv, complex, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_matrix&); - - Complex d = v1.complex_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v2.sparse_matrix_value () / d); - - return retval; -} - -DEFBINOP_FN (lt, complex, sparse_matrix, mx_el_lt) -DEFBINOP_FN (le, complex, sparse_matrix, mx_el_le) -DEFBINOP_FN (eq, complex, sparse_matrix, mx_el_eq) -DEFBINOP_FN (ge, complex, sparse_matrix, mx_el_ge) -DEFBINOP_FN (gt, complex, sparse_matrix, mx_el_gt) -DEFBINOP_FN (ne, complex, sparse_matrix, mx_el_ne) - -DEFBINOP_OP (el_mul, complex, sparse_matrix, *) -DEFBINOP_FN (el_div, complex, sparse_matrix, x_el_div) -DEFBINOP_FN (el_pow, complex, sparse_matrix, elem_xpow) - -DEFBINOP (el_ldiv, complex, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_matrix&); - - Complex d = v1.complex_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v2.sparse_matrix_value () / d); - - return retval; -} - -DEFBINOP_FN (el_and, complex, sparse_matrix, mx_el_and) -DEFBINOP_FN (el_or, complex, sparse_matrix, mx_el_or) - -DEFCATOP (cs_sm, sparse_matrix, complex) -{ - CAST_BINOP_ARGS (octave_complex&, const octave_sparse_matrix&); - SparseComplexMatrix tmp (1, 1, v1.complex_value ()); - return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); -} - -DEFCONV (sparse_matrix_conv, complex, sparse_matrix) -{ - CAST_CONV_ARG (const octave_complex&); - - return new octave_sparse_matrix - (SparseMatrix (v.matrix_value ())); -} - -void -install_cs_sm_ops (void) -{ - INSTALL_BINOP (op_add, octave_complex, octave_sparse_matrix, add); - INSTALL_BINOP (op_sub, octave_complex, octave_sparse_matrix, sub); - INSTALL_BINOP (op_mul, octave_complex, octave_sparse_matrix, mul); - INSTALL_BINOP (op_div, octave_complex, octave_sparse_matrix, div); - INSTALL_BINOP (op_pow, octave_complex, octave_sparse_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_complex, octave_sparse_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_complex, octave_sparse_matrix, lt); - INSTALL_BINOP (op_le, octave_complex, octave_sparse_matrix, le); - INSTALL_BINOP (op_eq, octave_complex, octave_sparse_matrix, eq); - INSTALL_BINOP (op_ge, octave_complex, octave_sparse_matrix, ge); - INSTALL_BINOP (op_gt, octave_complex, octave_sparse_matrix, gt); - INSTALL_BINOP (op_ne, octave_complex, octave_sparse_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_complex, octave_sparse_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_complex, octave_sparse_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_complex, octave_sparse_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_complex, octave_sparse_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_complex, octave_sparse_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_complex, octave_sparse_matrix, el_or); - - INSTALL_CATOP (octave_complex, octave_sparse_matrix, cs_sm); - - INSTALL_ASSIGNCONV (octave_complex, octave_sparse_matrix, - octave_complex_matrix); - - INSTALL_WIDENOP (octave_complex, octave_sparse_matrix, sparse_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-dm-cdm.cc --- a/src/OPERATORS/op-dm-cdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-re-diag.h" -#define RINCLUDE "ov-cx-diag.h" - -#define LMATRIX diag_matrix -#define RMATRIX complex_diag_matrix -#define LDMATRIX RMATRIX - -#define LSHORT dm -#define RSHORT cdm - -#define DEFINEDIV -#define DEFINELDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-dm-cm.cc --- a/src/OPERATORS/op-dm-cm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-re-diag.h" -#define RINCLUDE "ov-cx-mat.h" - -#define LMATRIX diag_matrix -#define RMATRIX complex_matrix - -#define LSHORT dm -#define RSHORT cm - -#define DEFINELDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-dm-cs.cc --- a/src/OPERATORS/op-dm-cs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define SINCLUDE "ov-complex.h" -#define MINCLUDE "ov-re-diag.h" - -#define SCALAR complex -#define MATRIX diag_matrix -#define MATRIXV complex_diag_matrix - -#define SSHORT cs -#define MSHORT dm - -#include "op-dms-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-dm-dm.cc --- a/src/OPERATORS/op-dm-dm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,103 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-re-mat.h" -#include "ov-re-diag.h" -#include "ov-flt-re-diag.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix unary ops. - -DEFUNOP_OP (uplus, diag_matrix, /* no-op */) -DEFUNOP_OP (uminus, diag_matrix, -) - -DEFUNOP (transpose, diag_matrix) -{ - CAST_UNOP_ARG (const octave_diag_matrix&); - return octave_value (v.diag_matrix_value ().transpose ()); -} - -// matrix by matrix ops. - -DEFBINOP_OP (add, diag_matrix, diag_matrix, +) -DEFBINOP_OP (sub, diag_matrix, diag_matrix, -) -DEFBINOP_OP (mul, diag_matrix, diag_matrix, *) - -DEFBINOP (div, diag_matrix, diag_matrix) -{ - CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_diag_matrix&); - - return xdiv (v1.diag_matrix_value (), - v2.diag_matrix_value ()); -} - -DEFBINOP (ldiv, diag_matrix, diag_matrix) -{ - CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_diag_matrix&); - - return xleftdiv (v1.diag_matrix_value (), - v2.diag_matrix_value ()); -} - -CONVDECL (diag_matrix_to_matrix) -{ - CAST_CONV_ARG (const octave_diag_matrix&); - - return new octave_matrix (v.matrix_value ()); -} - -CONVDECL (diag_matrix_to_float_diag_matrix) -{ - CAST_CONV_ARG (const octave_diag_matrix&); - - return new octave_float_diag_matrix (v.float_diag_matrix_value ()); -} - -void -install_dm_dm_ops (void) -{ - INSTALL_UNOP (op_uplus, octave_diag_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_diag_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_diag_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_diag_matrix, transpose); - - INSTALL_BINOP (op_add, octave_diag_matrix, octave_diag_matrix, add); - INSTALL_BINOP (op_sub, octave_diag_matrix, octave_diag_matrix, sub); - INSTALL_BINOP (op_mul, octave_diag_matrix, octave_diag_matrix, mul); - INSTALL_BINOP (op_div, octave_diag_matrix, octave_diag_matrix, div); - INSTALL_BINOP (op_ldiv, octave_diag_matrix, octave_diag_matrix, ldiv); - - INSTALL_CONVOP (octave_diag_matrix, octave_matrix, diag_matrix_to_matrix); - INSTALL_CONVOP (octave_diag_matrix, octave_float_diag_matrix, diag_matrix_to_float_diag_matrix); - INSTALL_ASSIGNCONV (octave_diag_matrix, octave_matrix, octave_matrix); - INSTALL_WIDENOP (octave_diag_matrix, octave_matrix, diag_matrix_to_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-dm-m.cc --- a/src/OPERATORS/op-dm-m.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-re-diag.h" -#define RINCLUDE "ov-re-mat.h" - -#define LMATRIX diag_matrix -#define LDMATRIX matrix -#define RMATRIX matrix - -#define LSHORT dm -#define RSHORT m - -#define DEFINELDIV -#define DEFINENULLASSIGNCONV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-dm-s.cc --- a/src/OPERATORS/op-dm-s.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define SINCLUDE "ov-scalar.h" -#define MINCLUDE "ov-re-diag.h" - -#define SCALAR scalar -#define MATRIX diag_matrix - -#define SSHORT s -#define MSHORT dm - -#include "op-dms-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-dm-scm.cc --- a/src/OPERATORS/op-dm-scm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,511 +0,0 @@ -/* - -Copyright (C) 2009-2012 Jason Riedy, Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ops.h" - -#include "ov-re-diag.h" -#include "ov-cx-diag.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -#include "sparse-xdiv.h" - -// diagonal matrix by sparse matrix ops - -DEFBINOP (mul_dm_scm, diag_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v2.complex_value (); - - return octave_value (v1.diag_matrix_value () * d); - } - else - { - MatrixType typ = v2.matrix_type (); - SparseComplexMatrix ret = v1.diag_matrix_value () * v2.sparse_complex_matrix_value (); - octave_value out = octave_value (ret); - typ.mark_as_unsymmetric (); - out.matrix_type (typ); - return out; - } -} - -DEFBINOP (mul_cdm_sm, complex_diag_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v2.scalar_value (); - - return octave_value (v1.complex_diag_matrix_value () * d); - } - else - { - MatrixType typ = v2.matrix_type (); - SparseComplexMatrix ret = v1.complex_diag_matrix_value () * v2.sparse_matrix_value (); - octave_value out = octave_value (ret); - typ.mark_as_unsymmetric (); - out.matrix_type (typ); - return out; - } -} - -DEFBINOP (mul_cdm_scm, complex_diag_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v2.complex_value (); - - return octave_value (v1.complex_diag_matrix_value () * d); - } - else - { - MatrixType typ = v2.matrix_type (); - SparseComplexMatrix ret = v1.complex_diag_matrix_value () * v2.sparse_complex_matrix_value (); - octave_value out = octave_value (ret); - typ.mark_as_unsymmetric (); - out.matrix_type (typ); - return out; - } -} - -DEFBINOP (ldiv_dm_scm, diag_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_diag_matrix&, - const octave_sparse_complex_matrix&); - - MatrixType typ = v2.matrix_type (); - return xleftdiv (v1.diag_matrix_value (), v2.sparse_complex_matrix_value (), - typ); -} - -DEFBINOP (ldiv_cdm_sm, complex_diag_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_diag_matrix&, - const octave_sparse_matrix&); - - MatrixType typ = v2.matrix_type (); - return xleftdiv (v1.complex_diag_matrix_value (), v2.sparse_matrix_value (), - typ); -} - -DEFBINOP (ldiv_cdm_scm, complex_diag_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_diag_matrix&, - const octave_sparse_complex_matrix&); - - MatrixType typ = v2.matrix_type (); - return xleftdiv (v1.complex_diag_matrix_value (), v2.sparse_complex_matrix_value (), - typ); -} - -DEFBINOP (add_dm_scm, diag_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v2.complex_value (); - - return octave_value (v1.matrix_value () + d); - } - else - return v1.diag_matrix_value () + v2.sparse_complex_matrix_value (); -} - -DEFBINOP (add_cdm_sm, complex_diag_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - double d = v2.scalar_value (); - - return octave_value (v1.complex_matrix_value () + d); - } - else - return v1.complex_diag_matrix_value () + v2.sparse_matrix_value (); -} - -DEFBINOP (add_cdm_scm, complex_diag_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v2.complex_value (); - - return octave_value (v1.complex_matrix_value () + d); - } - else - return v1.complex_diag_matrix_value () + v2.sparse_complex_matrix_value (); -} - -DEFBINOP (sub_dm_scm, diag_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v2.complex_value (); - - return octave_value (v1.matrix_value () + (-d)); - } - else - return v1.diag_matrix_value () - v2.sparse_complex_matrix_value (); -} - -DEFBINOP (sub_cdm_sm, complex_diag_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - double d = v2.scalar_value (); - - return octave_value (v1.complex_matrix_value () + (-d)); - } - else - return v1.complex_diag_matrix_value () - v2.sparse_matrix_value (); -} - -DEFBINOP (sub_cdm_scm, complex_diag_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v2.complex_value (); - - return octave_value (v1.complex_matrix_value () + (-d)); - } - else - return v1.complex_diag_matrix_value () - v2.sparse_complex_matrix_value (); -} - -// sparse matrix by diagonal matrix ops - -DEFBINOP (mul_scm_dm, sparse_complex_matrix, diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_diag_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - // If v1 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v1.complex_value (); - - return octave_value (d * v2.diag_matrix_value ()); - } - else - { - MatrixType typ = v1.matrix_type (); - SparseComplexMatrix ret = v1.sparse_complex_matrix_value () * v2.diag_matrix_value (); - octave_value out = octave_value (ret); - typ.mark_as_unsymmetric (); - out.matrix_type (typ); - return out; - } -} - -DEFBINOP (mul_sm_cdm, sparse_matrix, complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_diag_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - // If v1 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v1.complex_value (); - - return octave_value (d * v2.complex_diag_matrix_value ()); - } - else - { - MatrixType typ = v1.matrix_type (); - SparseComplexMatrix ret = v1.sparse_matrix_value () * v2.complex_diag_matrix_value (); - octave_value out = octave_value (ret); - typ.mark_as_unsymmetric (); - out.matrix_type (typ); - return out; - } -} - -DEFBINOP (mul_scm_cdm, sparse_complex_matrix, complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_diag_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - // If v1 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v1.complex_value (); - - return octave_value (d * v2.complex_diag_matrix_value ()); - } - else if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, don't bother with further dispatching. - { - std::complex d = v2.complex_value (); - - return octave_value (v1.sparse_complex_matrix_value () * d); - } - else - { - MatrixType typ = v1.matrix_type (); - SparseComplexMatrix ret = v1.sparse_complex_matrix_value () * v2.complex_diag_matrix_value (); - octave_value out = octave_value (ret); - typ.mark_as_unsymmetric (); - out.matrix_type (typ); - return out; - } -} - -DEFBINOP (div_scm_dm, sparse_complex_matrix, diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_diag_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - double d = v2.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.sparse_complex_matrix_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - return xdiv (v1.sparse_complex_matrix_value (), v2.diag_matrix_value (), typ); - } -} - -DEFBINOP (div_sm_cdm, sparse_matrix, complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_diag_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - std::complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.sparse_matrix_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - return xdiv (v1.sparse_matrix_value (), v2.complex_diag_matrix_value (), typ); - } -} - -DEFBINOP (div_scm_cdm, sparse_complex_matrix, complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_diag_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - std::complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.sparse_complex_matrix_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - return xdiv (v1.sparse_complex_matrix_value (), v2.complex_diag_matrix_value (), typ); - } -} - -DEFBINOP (add_sm_cdm, sparse_matrix, complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_diag_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v2.complex_value (); - - return octave_value (v1.sparse_matrix_value () + d); - } - else - return v1.sparse_matrix_value () + v2.complex_diag_matrix_value (); -} - -DEFBINOP (add_scm_dm, sparse_complex_matrix, diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_diag_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - double d = v2.scalar_value (); - - return octave_value (v1.sparse_complex_matrix_value () + d); - } - else - return v1.sparse_complex_matrix_value () + v2.diag_matrix_value (); -} - -DEFBINOP (add_scm_cdm, sparse_complex_matrix, complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_diag_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v2.complex_value (); - - return octave_value (v1.sparse_complex_matrix_value () + d); - } - else - return v1.sparse_complex_matrix_value () + v2.complex_diag_matrix_value (); -} - -DEFBINOP (sub_sm_cdm, sparse_matrix, complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_diag_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v2.complex_value (); - - return octave_value (v1.sparse_matrix_value () + (-d)); - } - else - return v1.sparse_matrix_value () - v2.complex_diag_matrix_value (); -} - -DEFBINOP (sub_scm_dm, sparse_complex_matrix, diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_diag_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - double d = v2.scalar_value (); - - return octave_value (v1.sparse_complex_matrix_value () + (-d)); - } - else - return v1.sparse_complex_matrix_value () - v2.diag_matrix_value (); -} - -DEFBINOP (sub_scm_cdm, sparse_complex_matrix, complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_diag_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - std::complex d = v2.complex_value (); - - return octave_value (v1.sparse_complex_matrix_value () + (-d)); - } - else - return v1.sparse_complex_matrix_value () - v2.complex_diag_matrix_value (); -} - -void -install_dm_scm_ops (void) -{ - INSTALL_BINOP (op_mul, octave_diag_matrix, octave_sparse_complex_matrix, - mul_dm_scm); - INSTALL_BINOP (op_mul, octave_complex_diag_matrix, octave_sparse_matrix, - mul_cdm_sm); - INSTALL_BINOP (op_mul, octave_complex_diag_matrix, octave_sparse_complex_matrix, - mul_cdm_scm); - INSTALL_BINOP (op_ldiv, octave_diag_matrix, octave_sparse_complex_matrix, ldiv_dm_scm); - INSTALL_BINOP (op_ldiv, octave_complex_diag_matrix, octave_sparse_matrix, ldiv_cdm_sm); - INSTALL_BINOP (op_ldiv, octave_complex_diag_matrix, octave_sparse_complex_matrix, - ldiv_cdm_scm); - - INSTALL_BINOP (op_add, octave_diag_matrix, octave_sparse_complex_matrix, add_dm_scm); - INSTALL_BINOP (op_add, octave_complex_diag_matrix, octave_sparse_matrix, add_cdm_sm); - INSTALL_BINOP (op_add, octave_complex_diag_matrix, octave_sparse_complex_matrix, - add_cdm_scm); - INSTALL_BINOP (op_sub, octave_diag_matrix, octave_sparse_complex_matrix, sub_dm_scm); - INSTALL_BINOP (op_sub, octave_complex_diag_matrix, octave_sparse_matrix, sub_cdm_sm); - INSTALL_BINOP (op_sub, octave_complex_diag_matrix, octave_sparse_complex_matrix, - sub_cdm_scm); - - INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_diag_matrix, - mul_scm_dm); - INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_complex_diag_matrix, - mul_sm_cdm); - INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_complex_diag_matrix, - mul_scm_cdm); - - INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_diag_matrix, div_scm_dm); - INSTALL_BINOP (op_div, octave_sparse_matrix, octave_complex_diag_matrix, div_sm_cdm); - INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_complex_diag_matrix, div_scm_cdm); - - INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_diag_matrix, add_scm_dm); - INSTALL_BINOP (op_add, octave_sparse_matrix, octave_complex_diag_matrix, add_sm_cdm); - INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_complex_diag_matrix, add_scm_cdm); - INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_diag_matrix, sub_scm_dm); - INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_complex_diag_matrix, sub_sm_cdm); - INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_complex_diag_matrix, sub_scm_cdm); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-dm-sm.cc --- a/src/OPERATORS/op-dm-sm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,196 +0,0 @@ -/* - -Copyright (C) 2009-2012 Jason Riedy, Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ops.h" - -#include "ov-re-diag.h" -#include "ov-re-sparse.h" - -#include "sparse-xdiv.h" - -// diagonal matrix by sparse matrix ops - -DEFBINOP (mul_dm_sm, diag_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - double d = v2.scalar_value (); - - return octave_value (v1.diag_matrix_value () * d); - } - else - { - MatrixType typ = v2.matrix_type (); - SparseMatrix ret = v1.diag_matrix_value () * v2.sparse_matrix_value (); - octave_value out = octave_value (ret); - typ.mark_as_unsymmetric (); - out.matrix_type (typ); - return out; - } -} - -DEFBINOP (ldiv_dm_sm, diag_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_matrix&); - - MatrixType typ = v2.matrix_type (); - return xleftdiv (v1.diag_matrix_value (), v2.sparse_matrix_value (), typ); -} - -DEFBINOP (add_dm_sm, diag_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - double d = v2.scalar_value (); - - return octave_value (v1.matrix_value () + d); - } - else - return v1.diag_matrix_value () + v2.sparse_matrix_value (); -} - -DEFBINOP (sub_dm_sm, diag_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - // If v2 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - double d = v2.scalar_value (); - - return octave_value (v1.matrix_value () - d); - } - else - return v1.diag_matrix_value () - v2.sparse_matrix_value (); -} - -// sparse matrix by diagonal matrix ops - -DEFBINOP (mul_sm_dm, sparse_matrix, diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_diag_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - // If v1 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - double d = v1.scalar_value (); - - return octave_value (d * v2.diag_matrix_value ()); - } - else - { - MatrixType typ = v1.matrix_type (); - SparseMatrix ret = v1.sparse_matrix_value () * v2.diag_matrix_value (); - octave_value out = octave_value (ret); - typ.mark_as_unsymmetric (); - out.matrix_type (typ); - return out; - } -} - -DEFBINOP (div_sm_dm, sparse_matrix, diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_diag_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - double d = v2.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.sparse_matrix_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - return xdiv (v1.sparse_matrix_value (), v2.diag_matrix_value (), typ); - } -} - -DEFBINOP (add_sm_dm, sparse_matrix, diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_diag_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - // If v1 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - double d = v1.scalar_value (); - - return octave_value (d + v2.matrix_value ()); - } - else - return v1.sparse_matrix_value () + v2.diag_matrix_value (); -} - -DEFBINOP (sub_sm_dm, sparse_matrix, diag_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_diag_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - // If v1 is a scalar in disguise, return a diagonal matrix rather than - // a sparse matrix. - { - double d = v1.scalar_value (); - - return octave_value (d - v2.matrix_value ()); - } - else - return v1.sparse_matrix_value () - v2.diag_matrix_value (); -} - -void -install_dm_sm_ops (void) -{ - INSTALL_BINOP (op_mul, octave_diag_matrix, octave_sparse_matrix, - mul_dm_sm); - - INSTALL_BINOP (op_add, octave_diag_matrix, octave_sparse_matrix, add_dm_sm); - INSTALL_BINOP (op_sub, octave_diag_matrix, octave_sparse_matrix, sub_dm_sm); - INSTALL_BINOP (op_ldiv, octave_diag_matrix, octave_sparse_matrix, ldiv_dm_sm); - - INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_diag_matrix, - mul_sm_dm); - - INSTALL_BINOP (op_add, octave_sparse_matrix, octave_diag_matrix, add_sm_dm); - INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_diag_matrix, sub_sm_dm); - INSTALL_BINOP (op_div, octave_sparse_matrix, octave_diag_matrix, div_sm_dm); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-dm-template.cc --- a/src/OPERATORS/op-dm-template.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,95 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "ops.h" -#include "xdiv.h" -#include LINCLUDE -#include RINCLUDE -#ifdef DEFINENULLASSIGNCONV -#include "ov-null-mat.h" -#endif - -// matrix by diag matrix ops. - -DEFBINOP_OP (add, LMATRIX, RMATRIX, +) -DEFBINOP_OP (sub, LMATRIX, RMATRIX, -) -DEFBINOP_OP (mul, LMATRIX, RMATRIX, *) - -#ifndef LDMATRIX -#define LDMATRIX LMATRIX -#endif - -#ifndef RDMATRIX -#define RDMATRIX RMATRIX -#endif - -#define OCTAVE_LMATRIX CONCAT2(octave_, LMATRIX) -#define OCTAVE_LDMATRIX CONCAT2(octave_, LDMATRIX) -#define OCTAVE_RMATRIX CONCAT2(octave_, RMATRIX) -#define LMATRIX_VALUE CONCAT2(LMATRIX, _value) -#define RMATRIX_VALUE CONCAT2(RMATRIX, _value) -#define LDMATRIX_VALUE CONCAT2(LDMATRIX, _value) -#define RDMATRIX_VALUE CONCAT2(RDMATRIX, _value) - -#ifdef DEFINEDIV -DEFBINOP (div, LMATRIX, RMATRIX) -{ - CAST_BINOP_ARGS (const OCTAVE_LMATRIX&, const OCTAVE_RMATRIX&); - - return xdiv (v1.LDMATRIX_VALUE (), v2.RMATRIX_VALUE ()); -} -#endif - -#ifdef DEFINELDIV -DEFBINOP (ldiv, LMATRIX, RMATRIX) -{ - CAST_BINOP_ARGS (const OCTAVE_LMATRIX&, const OCTAVE_RMATRIX&); - - return xleftdiv (v1.LMATRIX_VALUE (), v2.RDMATRIX_VALUE ()); -} -#endif - -#define SHORT_NAME CONCAT3(LSHORT, _, RSHORT) -#define INST_NAME CONCAT3(install_, SHORT_NAME, _ops) - -void -INST_NAME (void) -{ - INSTALL_BINOP (op_add, OCTAVE_LMATRIX, OCTAVE_RMATRIX, add); - INSTALL_BINOP (op_sub, OCTAVE_LMATRIX, OCTAVE_RMATRIX, sub); - INSTALL_BINOP (op_mul, OCTAVE_LMATRIX, OCTAVE_RMATRIX, mul); -#ifdef DEFINEDIV - INSTALL_BINOP (op_div, OCTAVE_LMATRIX, OCTAVE_RMATRIX, div); -#endif -#ifdef DEFINELDIV - INSTALL_BINOP (op_ldiv, OCTAVE_LMATRIX, OCTAVE_RMATRIX, ldiv); -#endif -#ifdef DEFINENULLASSIGNCONV - INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_matrix, OCTAVE_LDMATRIX); - INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_str, OCTAVE_LDMATRIX); - INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_sq_str, OCTAVE_LDMATRIX); -#endif -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-dms-template.cc --- a/src/OPERATORS/op-dms-template.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,92 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "ops.h" -#include "gripes.h" -#include "xpow.h" -#include SINCLUDE -#include MINCLUDE - -// matrix by diag matrix ops. - -#ifndef SCALARV -#define SCALARV SCALAR -#endif - -#ifndef MATRIXV -#define MATRIXV MATRIX -#endif - -DEFNDBINOP_OP (sdmmul, SCALAR, MATRIX, SCALARV, MATRIXV, *) -DEFNDBINOP_OP (dmsmul, MATRIX, SCALAR, MATRIXV, SCALARV, *) - -#define OCTAVE_MATRIX CONCAT2(octave_, MATRIX) -#define OCTAVE_SCALAR CONCAT2(octave_, SCALAR) -#define MATRIX_VALUE CONCAT2(MATRIXV, _value) -#define SCALAR_VALUE CONCAT2(SCALARV, _value) - -template -static T -gripe_if_zero (T x) -{ - if (x == T ()) - gripe_divide_by_zero (); - return x; -} - -DEFBINOP (dmsdiv, MATRIX, SCALAR) -{ - CAST_BINOP_ARGS (const OCTAVE_MATRIX&, const OCTAVE_SCALAR&); - - return v1.MATRIX_VALUE () / gripe_if_zero (v2.SCALAR_VALUE ()); -} - -DEFBINOP (sdmldiv, SCALAR, MATRIX) -{ - CAST_BINOP_ARGS (const OCTAVE_SCALAR&, const OCTAVE_MATRIX&); - - return v2.MATRIX_VALUE () / gripe_if_zero (v1.SCALAR_VALUE ()); -} - -DEFBINOP (dmspow, MATRIX, SCALAR) -{ - CAST_BINOP_ARGS (const OCTAVE_MATRIX&, const OCTAVE_SCALAR&); - - return xpow (v1.MATRIX_VALUE (), v2.SCALAR_VALUE ()); -} - -#define SHORT_NAME CONCAT3(MSHORT, _, SSHORT) -#define INST_NAME CONCAT3(install_, SHORT_NAME, _ops) - -void -INST_NAME (void) -{ - INSTALL_BINOP (op_mul, OCTAVE_MATRIX, OCTAVE_SCALAR, dmsmul); - INSTALL_BINOP (op_div, OCTAVE_MATRIX, OCTAVE_SCALAR, dmsdiv); - INSTALL_BINOP (op_mul, OCTAVE_SCALAR, OCTAVE_MATRIX, sdmmul); - INSTALL_BINOP (op_ldiv, OCTAVE_SCALAR, OCTAVE_MATRIX, sdmldiv); - INSTALL_BINOP (op_pow, OCTAVE_MATRIX, OCTAVE_SCALAR, dmspow); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-double-conv.cc --- a/src/OPERATORS/op-double-conv.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,119 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int8.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-uint8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-re-sparse.h" -#include "ov-bool-sparse.h" -#include "ov-range.h" -#include "ov-scalar.h" -#include "ov-re-mat.h" -#include "ov-str-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" - -// conversion ops - -DEFDBLCONVFN (int8_matrix_to_double_matrix, int8_matrix, int8_array) -DEFDBLCONVFN (int16_matrix_to_double_matrix, int16_matrix, int16_array) -DEFDBLCONVFN (int32_matrix_to_double_matrix, int32_matrix, int32_array) -DEFDBLCONVFN (int64_matrix_to_double_matrix, int64_matrix, int64_array) - -DEFDBLCONVFN (uint8_matrix_to_double_matrix, uint8_matrix, uint8_array) -DEFDBLCONVFN (uint16_matrix_to_double_matrix, uint16_matrix, uint16_array) -DEFDBLCONVFN (uint32_matrix_to_double_matrix, uint32_matrix, uint32_array) -DEFDBLCONVFN (uint64_matrix_to_double_matrix, uint64_matrix, uint64_array) - -DEFDBLCONVFN (int8_scalar_to_double_matrix, int8_scalar, int8_array) -DEFDBLCONVFN (int16_scalar_to_double_matrix, int16_scalar, int16_array) -DEFDBLCONVFN (int32_scalar_to_double_matrix, int32_scalar, int32_array) -DEFDBLCONVFN (int64_scalar_to_double_matrix, int64_scalar, int64_array) - -DEFDBLCONVFN (uint8_scalar_to_double_matrix, uint8_scalar, uint8_array) -DEFDBLCONVFN (uint16_scalar_to_double_matrix, uint16_scalar, uint16_array) -DEFDBLCONVFN (uint32_scalar_to_double_matrix, uint32_scalar, uint32_array) -DEFDBLCONVFN (uint64_scalar_to_double_matrix, uint64_scalar, uint64_array) - -DEFDBLCONVFN (bool_matrix_to_double_matrix, bool_matrix, bool_array) -DEFDBLCONVFN (bool_scalar_to_double_matrix, bool, bool_array) - -DEFDBLCONVFN (sparse_matrix_to_double_matrix, sparse_matrix, array) -DEFDBLCONVFN (sparse_bool_matrix_to_double_matrix, sparse_bool_matrix, array) - -DEFDBLCONVFN (range_to_double_matrix, range, array) - -DEFSTRDBLCONVFN(char_matrix_str_to_double_matrix, char_matrix_str) -DEFSTRDBLCONVFN(char_matrix_sq_str_to_double_matrix, char_matrix_sq_str) - -DEFDBLCONVFN (double_scalar_to_double_matrix, scalar, array) - -void -install_double_conv_ops (void) -{ - INSTALL_CONVOP (octave_int8_matrix, octave_matrix, int8_matrix_to_double_matrix); - INSTALL_CONVOP (octave_int16_matrix, octave_matrix, int16_matrix_to_double_matrix); - INSTALL_CONVOP (octave_int32_matrix, octave_matrix, int32_matrix_to_double_matrix); - INSTALL_CONVOP (octave_int64_matrix, octave_matrix, int64_matrix_to_double_matrix); - - INSTALL_CONVOP (octave_uint8_matrix, octave_matrix, uint8_matrix_to_double_matrix); - INSTALL_CONVOP (octave_uint16_matrix, octave_matrix, uint16_matrix_to_double_matrix); - INSTALL_CONVOP (octave_uint32_matrix, octave_matrix, uint32_matrix_to_double_matrix); - INSTALL_CONVOP (octave_uint64_matrix, octave_matrix, uint64_matrix_to_double_matrix); - - INSTALL_CONVOP (octave_int8_scalar, octave_matrix, int8_scalar_to_double_matrix); - INSTALL_CONVOP (octave_int16_scalar, octave_matrix, int16_scalar_to_double_matrix); - INSTALL_CONVOP (octave_int32_scalar, octave_matrix, int32_scalar_to_double_matrix); - INSTALL_CONVOP (octave_int64_scalar, octave_matrix, int64_scalar_to_double_matrix); - - INSTALL_CONVOP (octave_uint8_scalar, octave_matrix, uint8_scalar_to_double_matrix); - INSTALL_CONVOP (octave_uint16_scalar, octave_matrix, uint16_scalar_to_double_matrix); - INSTALL_CONVOP (octave_uint32_scalar, octave_matrix, uint32_scalar_to_double_matrix); - INSTALL_CONVOP (octave_uint64_scalar, octave_matrix, uint64_scalar_to_double_matrix); - - INSTALL_CONVOP (octave_bool_matrix, octave_matrix, bool_matrix_to_double_matrix); - INSTALL_CONVOP (octave_bool, octave_matrix, bool_scalar_to_double_matrix); - - INSTALL_CONVOP (octave_sparse_matrix, octave_matrix, sparse_matrix_to_double_matrix); - INSTALL_CONVOP (octave_sparse_bool_matrix, octave_matrix, sparse_bool_matrix_to_double_matrix); - - INSTALL_CONVOP (octave_range, octave_matrix, range_to_double_matrix); - - INSTALL_CONVOP (octave_char_matrix_str, octave_matrix, char_matrix_str_to_double_matrix); - INSTALL_CONVOP (octave_char_matrix_sq_str, octave_matrix, char_matrix_sq_str_to_double_matrix); - - INSTALL_CONVOP (octave_scalar, octave_matrix, double_scalar_to_double_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcdm-fcdm.cc --- a/src/OPERATORS/op-fcdm-fcdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,112 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-flt-cx-mat.h" -#include "ov-flt-cx-diag.h" -#include "ov-cx-diag.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix unary ops. - -DEFUNOP_OP (uplus, float_complex_diag_matrix, /* no-op */) -DEFUNOP_OP (uminus, float_complex_diag_matrix, -) - -DEFUNOP (transpose, float_complex_diag_matrix) -{ - CAST_UNOP_ARG (const octave_float_complex_diag_matrix&); - return octave_value (v.float_complex_diag_matrix_value ().transpose ()); -} - -DEFUNOP (hermitian, float_complex_diag_matrix) -{ - CAST_UNOP_ARG (const octave_float_complex_diag_matrix&); - return octave_value (v.float_complex_diag_matrix_value ().hermitian ()); -} - -// matrix by matrix ops. - -DEFBINOP_OP (add, float_complex_diag_matrix, float_complex_diag_matrix, +) -DEFBINOP_OP (sub, float_complex_diag_matrix, float_complex_diag_matrix, -) -DEFBINOP_OP (mul, float_complex_diag_matrix, float_complex_diag_matrix, *) - -DEFBINOP (div, float_complex_diag_matrix, float_complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_diag_matrix&, const octave_float_complex_diag_matrix&); - - return xdiv (v1.float_complex_diag_matrix_value (), - v2.float_complex_diag_matrix_value ()); -} - -DEFBINOP (ldiv, float_complex_diag_matrix, float_complex_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_diag_matrix&, const octave_float_complex_diag_matrix&); - - return xleftdiv (v1.float_complex_diag_matrix_value (), - v2.float_complex_diag_matrix_value ()); -} - -CONVDECL (float_complex_diag_matrix_to_float_complex_matrix) -{ - CAST_CONV_ARG (const octave_float_complex_diag_matrix&); - - return new octave_float_complex_matrix (v.float_complex_matrix_value ()); -} - -CONVDECL (float_complex_diag_matrix_to_complex_diag_matrix) -{ - CAST_CONV_ARG (const octave_float_complex_diag_matrix&); - - return new octave_complex_diag_matrix (v.complex_diag_matrix_value ()); -} - -void -install_fcdm_fcdm_ops (void) -{ - INSTALL_UNOP (op_uplus, octave_float_complex_diag_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_float_complex_diag_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_float_complex_diag_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_float_complex_diag_matrix, hermitian); - - INSTALL_BINOP (op_add, octave_float_complex_diag_matrix, octave_float_complex_diag_matrix, add); - INSTALL_BINOP (op_sub, octave_float_complex_diag_matrix, octave_float_complex_diag_matrix, sub); - INSTALL_BINOP (op_mul, octave_float_complex_diag_matrix, octave_float_complex_diag_matrix, mul); - INSTALL_BINOP (op_div, octave_float_complex_diag_matrix, octave_float_complex_diag_matrix, div); - INSTALL_BINOP (op_ldiv, octave_float_complex_diag_matrix, octave_float_complex_diag_matrix, ldiv); - - INSTALL_CONVOP (octave_float_complex_diag_matrix, octave_complex_diag_matrix, - float_complex_diag_matrix_to_complex_diag_matrix); - INSTALL_CONVOP (octave_float_complex_diag_matrix, octave_float_complex_matrix, - float_complex_diag_matrix_to_float_complex_matrix); - INSTALL_ASSIGNCONV (octave_float_complex_diag_matrix, octave_float_complex_matrix, octave_float_complex_matrix); - INSTALL_WIDENOP (octave_float_complex_diag_matrix, octave_complex_diag_matrix, - float_complex_diag_matrix_to_complex_diag_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcdm-fcm.cc --- a/src/OPERATORS/op-fcdm-fcm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-flt-cx-diag.h" -#define RINCLUDE "ov-flt-cx-mat.h" - -#define LMATRIX float_complex_diag_matrix -#define RMATRIX float_complex_matrix - -#define LSHORT fcdm -#define RSHORT fcm - -#define DEFINELDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcdm-fcs.cc --- a/src/OPERATORS/op-fcdm-fcs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define SINCLUDE "ov-flt-complex.h" -#define MINCLUDE "ov-flt-cx-diag.h" - -#define SCALAR float_complex -#define MATRIX float_complex_diag_matrix - -#define SSHORT fcs -#define MSHORT fcdm - -#include "op-dms-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcdm-fdm.cc --- a/src/OPERATORS/op-fcdm-fdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,51 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-flt-cx-diag.h" -#include "ov-flt-re-diag.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -#define LINCLUDE "ov-flt-cx-diag.h" -#define RINCLUDE "ov-flt-re-diag.h" - -#define LMATRIX float_complex_diag_matrix -#define RMATRIX float_diag_matrix -#define RDMATRIX LMATRIX - -#define LSHORT fcdm -#define RSHORT fdm - -#define DEFINEDIV -#define DEFINELDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcdm-fm.cc --- a/src/OPERATORS/op-fcdm-fm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-flt-cx-diag.h" -#define RINCLUDE "ov-flt-re-mat.h" - -#define LMATRIX float_complex_diag_matrix -#define RMATRIX float_matrix -#define RDMATRIX float_complex_matrix - -#define LSHORT fcdm -#define RSHORT fm - -#define DEFINELDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcdm-fs.cc --- a/src/OPERATORS/op-fcdm-fs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define SINCLUDE "ov-float.h" -#define MINCLUDE "ov-flt-cx-diag.h" - -#define SCALAR float_scalar -#define SCALARV float_complex -#define MATRIX float_complex_diag_matrix - -#define SSHORT fs -#define MSHORT fcdm - -#include "op-dms-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcm-fcdm.cc --- a/src/OPERATORS/op-fcm-fcdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-flt-cx-mat.h" -#define RINCLUDE "ov-flt-cx-diag.h" - -#define LMATRIX float_complex_matrix -#define RMATRIX float_complex_diag_matrix - -#define LSHORT fcm -#define RSHORT fcdm - -#define DEFINEDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcm-fcm.cc --- a/src/OPERATORS/op-fcm-fcm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,335 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// unary complex matrix ops. - -DEFNDUNOP_OP (not, float_complex_matrix, float_complex_array, !) -DEFNDUNOP_OP (uplus, float_complex_matrix, float_complex_array, /* no-op */) -DEFNDUNOP_OP (uminus, float_complex_matrix, float_complex_array, -) - -DEFUNOP (transpose, float_complex_matrix) -{ - CAST_UNOP_ARG (const octave_float_complex_matrix&); - - if (v.ndims () > 2) - { - error ("transpose not defined for N-d objects"); - return octave_value (); - } - else - return octave_value (v.float_complex_matrix_value ().transpose ()); -} - -DEFUNOP (hermitian, float_complex_matrix) -{ - CAST_UNOP_ARG (const octave_float_complex_matrix&); - - if (v.ndims () > 2) - { - error ("complex-conjugate transpose not defined for N-d objects"); - return octave_value (); - } - else - return octave_value (v.float_complex_matrix_value ().hermitian ()); -} - -DEFNCUNOP_METHOD (incr, float_complex_matrix, increment) -DEFNCUNOP_METHOD (decr, float_complex_matrix, decrement) -DEFNCUNOP_METHOD (changesign, float_complex_matrix, changesign) - -// complex matrix by complex matrix ops. - -DEFNDBINOP_OP (add, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, +) -DEFNDBINOP_OP (sub, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, -) - -DEFBINOP_OP (mul, float_complex_matrix, float_complex_matrix, *) - -DEFBINOP (div, float_complex_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_complex_matrix&); - MatrixType typ = v2.matrix_type (); - - FloatComplexMatrix ret = xdiv (v1.float_complex_matrix_value (), - v2.float_complex_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOPX (pow, float_complex_matrix, float_complex_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, float_complex_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - FloatComplexMatrix ret = xleftdiv (v1.float_complex_matrix_value (), - v2.float_complex_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP (trans_mul, float_complex_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_complex_matrix&); - return octave_value(xgemm (v1.float_complex_matrix_value (), - v2.float_complex_matrix_value (), - blas_trans, blas_no_trans)); -} - -DEFBINOP (mul_trans, float_complex_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_complex_matrix&); - return octave_value(xgemm (v1.float_complex_matrix_value (), - v2.float_complex_matrix_value (), - blas_no_trans, blas_trans)); -} - -DEFBINOP (herm_mul, float_complex_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_complex_matrix&); - return octave_value(xgemm (v1.float_complex_matrix_value (), - v2.float_complex_matrix_value (), - blas_conj_trans, blas_no_trans)); -} - -DEFBINOP (mul_herm, float_complex_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_complex_matrix&); - return octave_value(xgemm (v1.float_complex_matrix_value (), - v2.float_complex_matrix_value (), - blas_no_trans, blas_conj_trans)); -} - -DEFBINOP (trans_ldiv, float_complex_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - FloatComplexMatrix ret = xleftdiv (v1.float_complex_matrix_value (), - v2.float_complex_matrix_value (), typ, blas_trans); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP (herm_ldiv, float_complex_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - FloatComplexMatrix ret = xleftdiv (v1.float_complex_matrix_value (), - v2.float_complex_matrix_value (), typ, blas_conj_trans); - - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, mx_el_ne) - -DEFNDBINOP_FN (el_mul, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, product) -DEFNDBINOP_FN (el_div, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, quotient) -DEFNDBINOP_FN (el_pow, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, elem_xpow) - -DEFBINOP (el_ldiv, float_complex_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_complex_matrix&); - - return octave_value (quotient (v2.float_complex_array_value (), v1.float_complex_array_value ())); -} - -DEFNDBINOP_FN (el_and, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, mx_el_and) -DEFNDBINOP_FN (el_or, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, mx_el_or) - -DEFNDCATOP_FN (fcm_fcm, float_complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, concat) - -DEFNDCATOP_FN (cm_fcm, complex_matrix, float_complex_matrix, - float_complex_array, float_complex_array, concat) - -DEFNDCATOP_FN (fcm_cm, float_complex_matrix, complex_matrix, - float_complex_array, float_complex_array, concat) - -DEFNDASSIGNOP_FN (assign, float_complex_matrix, float_complex_matrix, - float_complex_array, assign) -DEFNDASSIGNOP_FN (dbl_clx_assign, float_complex_matrix, complex_matrix, - float_complex_array, assign) -DEFNDASSIGNOP_FN (dbl_assign, float_complex_matrix, matrix, - float_complex_array, assign) - -DEFNULLASSIGNOP_FN (null_assign, float_complex_matrix, delete_elements) - -DEFNDASSIGNOP_OP (assign_add, float_complex_matrix, - float_complex_matrix, float_complex_array, +=) -DEFNDASSIGNOP_OP (assign_sub, float_complex_matrix, - float_complex_matrix, float_complex_array, -=) -DEFNDASSIGNOP_FNOP (assign_el_mul, float_complex_matrix, float_complex_matrix, - float_complex_array, product_eq) -DEFNDASSIGNOP_FNOP (assign_el_div, float_complex_matrix, float_complex_matrix, - float_complex_array, quotient_eq) - -CONVDECL (float_complex_matrix_to_complex_matrix) -{ - CAST_CONV_ARG (const octave_float_complex_matrix&); - - return new octave_complex_matrix (ComplexNDArray (v.float_complex_array_value ())); -} - -void -install_fcm_fcm_ops (void) -{ - INSTALL_UNOP (op_not, octave_float_complex_matrix, not); - INSTALL_UNOP (op_uplus, octave_float_complex_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_float_complex_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_float_complex_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_float_complex_matrix, hermitian); - - INSTALL_NCUNOP (op_incr, octave_float_complex_matrix, incr); - INSTALL_NCUNOP (op_decr, octave_float_complex_matrix, decr); - INSTALL_NCUNOP (op_uminus, octave_float_complex_matrix, changesign); - - INSTALL_BINOP (op_add, octave_float_complex_matrix, - octave_float_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_float_complex_matrix, - octave_float_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_float_complex_matrix, - octave_float_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_float_complex_matrix, - octave_float_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_float_complex_matrix, - octave_float_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_float_complex_matrix, - octave_float_complex_matrix, ldiv); - INSTALL_BINOP (op_trans_mul, octave_float_complex_matrix, - octave_float_complex_matrix, trans_mul); - INSTALL_BINOP (op_mul_trans, octave_float_complex_matrix, - octave_float_complex_matrix, mul_trans); - INSTALL_BINOP (op_herm_mul, octave_float_complex_matrix, - octave_float_complex_matrix, herm_mul); - INSTALL_BINOP (op_mul_herm, octave_float_complex_matrix, - octave_float_complex_matrix, mul_herm); - INSTALL_BINOP (op_trans_ldiv, octave_float_complex_matrix, - octave_float_complex_matrix, trans_ldiv); - INSTALL_BINOP (op_herm_ldiv, octave_float_complex_matrix, - octave_float_complex_matrix, herm_ldiv); - - INSTALL_BINOP (op_lt, octave_float_complex_matrix, - octave_float_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_float_complex_matrix, - octave_float_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_float_complex_matrix, - octave_float_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_float_complex_matrix, - octave_float_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_float_complex_matrix, - octave_float_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_float_complex_matrix, - octave_float_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_float_complex_matrix, - octave_float_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_float_complex_matrix, - octave_float_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_float_complex_matrix, - octave_float_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_complex_matrix, - octave_float_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_complex_matrix, - octave_float_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_float_complex_matrix, - octave_float_complex_matrix, el_or); - - INSTALL_CATOP (octave_float_complex_matrix, - octave_float_complex_matrix, fcm_fcm); - INSTALL_CATOP (octave_complex_matrix, - octave_float_complex_matrix, cm_fcm); - INSTALL_CATOP (octave_float_complex_matrix, - octave_complex_matrix, fcm_cm); - - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, - octave_float_complex_matrix, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, - octave_complex_matrix, dbl_clx_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, - octave_matrix, dbl_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, - octave_null_matrix, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, - octave_null_str, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, - octave_null_sq_str, null_assign); - - INSTALL_ASSIGNOP (op_add_eq, octave_float_complex_matrix, - octave_float_complex_matrix, assign_add); - INSTALL_ASSIGNOP (op_sub_eq, octave_float_complex_matrix, - octave_float_complex_matrix, assign_sub); - INSTALL_ASSIGNOP (op_el_mul_eq, octave_float_complex_matrix, - octave_float_complex_matrix, assign_el_mul); - INSTALL_ASSIGNOP (op_el_div_eq, octave_float_complex_matrix, - octave_float_complex_matrix, assign_el_div); - - INSTALL_CONVOP (octave_float_complex_matrix, octave_complex_matrix, - float_complex_matrix_to_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcm-fcs.cc --- a/src/OPERATORS/op-fcm-fcs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,196 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-flt-complex.h" -#include "ov-complex.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex matrix by complex scalar ops. - -DEFNDBINOP_OP (add, float_complex_matrix, float_complex, - float_complex_array, float_complex, +) -DEFNDBINOP_OP (sub, float_complex_matrix, float_complex, - float_complex_array, float_complex, -) -DEFNDBINOP_OP (mul, float_complex_matrix, float_complex, - float_complex_array, float_complex, *) - -DEFBINOP (div, float_complex_matrix, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_complex&); - - FloatComplex d = v2.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v1.float_complex_array_value () / d); -} - -DEFBINOP_FN (pow, float_complex_matrix, float_complex, xpow) - -DEFBINOP (ldiv, float_complex_matrix, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_complex&); - - FloatComplexMatrix m1 = v1.float_complex_matrix_value (); - FloatComplexMatrix m2 = v2.float_complex_matrix_value (); - MatrixType typ = v1.matrix_type (); - - FloatComplexMatrix ret = xleftdiv (m1, m2, typ); - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, float_complex_matrix, float_complex, - float_complex_array, float_complex, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, float_complex_matrix, float_complex, - float_complex_array, float_complex, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, float_complex_matrix, float_complex, - float_complex_array, float_complex, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, float_complex_matrix, float_complex, - float_complex_array, float_complex, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, float_complex_matrix, float_complex, - float_complex_array, float_complex, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, float_complex_matrix, float_complex, - float_complex_array, float_complex, mx_el_ne) - -DEFNDBINOP_OP (el_mul, float_complex_matrix, float_complex, - float_complex_array, float_complex, *) - -DEFBINOP (el_div, float_complex_matrix, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_complex&); - - FloatComplex d = v2.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v1.float_complex_array_value () / d); -} - -DEFNDBINOP_FN (el_pow, float_complex_matrix, float_complex, - float_complex_array, float_complex, elem_xpow) - -DEFBINOP (el_ldiv, float_complex_matrix, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_complex&); - - return x_el_div (v2.float_complex_value (), v1.float_complex_array_value ()); -} - -DEFNDBINOP_FN (el_and, float_complex_matrix, float_complex, - float_complex_array, float_complex, mx_el_and) -DEFNDBINOP_FN (el_or, float_complex_matrix, float_complex, - float_complex_array, float_complex, mx_el_or) - -DEFNDCATOP_FN (fcm_fcs, float_complex_matrix, float_complex, - float_complex_array, float_complex_array, concat) - -DEFNDCATOP_FN (cm_fcs, complex_matrix, float_complex, - float_complex_array, float_complex_array, concat) - -DEFNDCATOP_FN (fcm_cs, float_complex_matrix, complex, - float_complex_array, float_complex_array, concat) - -DEFNDASSIGNOP_FN (assign, float_complex_matrix, float_complex, - float_complex, assign) -DEFNDASSIGNOP_FN (dbl_assign, complex_matrix, float_complex, - complex, assign) - -DEFNDASSIGNOP_OP (assign_add, float_complex_matrix, float_complex_scalar, - float_complex, +=) -DEFNDASSIGNOP_OP (assign_sub, float_complex_matrix, float_complex_scalar, - float_complex, -=) -DEFNDASSIGNOP_OP (assign_mul, float_complex_matrix, float_complex_scalar, - float_complex, *=) -DEFNDASSIGNOP_OP (assign_div, float_complex_matrix, float_complex_scalar, - float_complex, /=) - -void -install_fcm_fcs_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_complex_matrix, - octave_float_complex, add); - INSTALL_BINOP (op_sub, octave_float_complex_matrix, - octave_float_complex, sub); - INSTALL_BINOP (op_mul, octave_float_complex_matrix, - octave_float_complex, mul); - INSTALL_BINOP (op_div, octave_float_complex_matrix, - octave_float_complex, div); - INSTALL_BINOP (op_pow, octave_float_complex_matrix, - octave_float_complex, pow); - INSTALL_BINOP (op_ldiv, octave_float_complex_matrix, - octave_float_complex, ldiv); - INSTALL_BINOP (op_lt, octave_float_complex_matrix, octave_float_complex, lt); - INSTALL_BINOP (op_le, octave_float_complex_matrix, octave_float_complex, le); - INSTALL_BINOP (op_eq, octave_float_complex_matrix, octave_float_complex, eq); - INSTALL_BINOP (op_ge, octave_float_complex_matrix, octave_float_complex, ge); - INSTALL_BINOP (op_gt, octave_float_complex_matrix, octave_float_complex, gt); - INSTALL_BINOP (op_ne, octave_float_complex_matrix, octave_float_complex, ne); - INSTALL_BINOP (op_el_mul, octave_float_complex_matrix, - octave_float_complex, el_mul); - INSTALL_BINOP (op_el_div, octave_float_complex_matrix, - octave_float_complex, el_div); - INSTALL_BINOP (op_el_pow, octave_float_complex_matrix, - octave_float_complex, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_complex_matrix, - octave_float_complex, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_complex_matrix, - octave_float_complex, el_and); - INSTALL_BINOP (op_el_or, octave_float_complex_matrix, - octave_float_complex, el_or); - - INSTALL_CATOP (octave_float_complex_matrix, octave_float_complex, fcm_fcs); - INSTALL_CATOP (octave_complex_matrix, octave_float_complex, cm_fcs); - INSTALL_CATOP (octave_float_complex_matrix, octave_complex, fcm_cs); - - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, - octave_float_complex, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, - octave_float_complex, dbl_assign); - - INSTALL_ASSIGNOP (op_add_eq, octave_float_complex_matrix, - octave_float_complex_scalar, assign_add); - INSTALL_ASSIGNOP (op_sub_eq, octave_float_complex_matrix, - octave_float_complex_scalar, assign_sub); - INSTALL_ASSIGNOP (op_mul_eq, octave_float_complex_matrix, - octave_float_complex_scalar, assign_mul); - INSTALL_ASSIGNOP (op_div_eq, octave_float_complex_matrix, - octave_float_complex_scalar, assign_div); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcm-fdm.cc --- a/src/OPERATORS/op-fcm-fdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-flt-cx-mat.h" -#define RINCLUDE "ov-flt-re-diag.h" - -#define LMATRIX float_complex_matrix -#define RMATRIX float_diag_matrix - -#define LSHORT fcm -#define RSHORT fdm - -#define DEFINEDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcm-fm.cc --- a/src/OPERATORS/op-fcm-fm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,183 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-fcm-fm.h" -#include "mx-fm-fcm.h" -#include "mx-fcnda-fnda.h" -#include "mx-fnda-fcnda.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex matrix by matrix ops. - -DEFNDBINOP_OP (add, float_complex_matrix, float_matrix, float_complex_array, float_array, +) -DEFNDBINOP_OP (sub, float_complex_matrix, float_matrix, float_complex_array, float_array, -) - -DEFBINOP_OP (mul, float_complex_matrix, float_matrix, *) - -DEFBINOP (mul_trans, float_complex_matrix, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_matrix&); - - FloatComplexMatrix m1 = v1.float_complex_matrix_value (); - FloatMatrix m2 = v2.float_matrix_value (); - - return FloatComplexMatrix (xgemm (real (m1), m2, blas_no_trans, blas_trans), - xgemm (imag (m1), m2, blas_no_trans, blas_trans)); -} - -DEFBINOP (div, float_complex_matrix, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_matrix&); - MatrixType typ = v2.matrix_type (); - - FloatComplexMatrix ret = xdiv (v1.float_complex_matrix_value (), - v2.float_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - - -DEFBINOPX (pow, float_complex_matrix, float_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, float_complex_matrix, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_matrix&); - MatrixType typ = v1.matrix_type (); - - FloatComplexMatrix ret = xleftdiv (v1.float_complex_matrix_value (), - v2.float_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, float_complex_matrix, float_matrix, - float_complex_array, float_array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, float_complex_matrix, float_matrix, - float_complex_array, float_array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, float_complex_matrix, float_matrix, - float_complex_array, float_array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, float_complex_matrix, float_matrix, - float_complex_array, float_array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, float_complex_matrix, float_matrix, - float_complex_array, float_array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, float_complex_matrix, float_matrix, - float_complex_array, float_array, mx_el_ne) - -DEFNDBINOP_FN (el_mul, float_complex_matrix, float_matrix, - float_complex_array, float_array, product) -DEFNDBINOP_FN (el_div, float_complex_matrix, float_matrix, - float_complex_array, float_array, quotient) -DEFNDBINOP_FN (el_pow, float_complex_matrix, float_matrix, - float_complex_array, float_array, elem_xpow) - -DEFBINOP (el_ldiv, float_complex_matrix, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, - const octave_float_matrix&); - - return quotient (v2.float_array_value (), v1.float_complex_array_value ()); -} - -DEFNDBINOP_FN (el_and, float_complex_matrix, float_matrix, - float_complex_array, float_array, mx_el_and) -DEFNDBINOP_FN (el_or, float_complex_matrix, float_matrix, - float_complex_array, float_array, mx_el_or) - -DEFNDCATOP_FN (fcm_fm, float_complex_matrix, float_matrix, - float_complex_array, float_array, concat) - -DEFNDCATOP_FN (cm_fm, complex_matrix, float_matrix, - float_complex_array, float_array, concat) - -DEFNDCATOP_FN (fcm_m, float_complex_matrix, matrix, - float_complex_array, float_array, concat) - -DEFNDASSIGNOP_FN (assign, float_complex_matrix, float_matrix, - float_complex_array, assign) -DEFNDASSIGNOP_FN (dbl_assign, complex_matrix, float_matrix, - complex_array, assign) - -void -install_fcm_fm_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_complex_matrix, octave_float_matrix, add); - INSTALL_BINOP (op_sub, octave_float_complex_matrix, octave_float_matrix, sub); - INSTALL_BINOP (op_mul, octave_float_complex_matrix, octave_float_matrix, mul); - INSTALL_BINOP (op_div, octave_float_complex_matrix, octave_float_matrix, div); - INSTALL_BINOP (op_pow, octave_float_complex_matrix, octave_float_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_float_complex_matrix, - octave_float_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_float_complex_matrix, octave_float_matrix, lt); - INSTALL_BINOP (op_le, octave_float_complex_matrix, octave_float_matrix, le); - INSTALL_BINOP (op_eq, octave_float_complex_matrix, octave_float_matrix, eq); - INSTALL_BINOP (op_ge, octave_float_complex_matrix, octave_float_matrix, ge); - INSTALL_BINOP (op_gt, octave_float_complex_matrix, octave_float_matrix, gt); - INSTALL_BINOP (op_ne, octave_float_complex_matrix, octave_float_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_float_complex_matrix, - octave_float_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_float_complex_matrix, - octave_float_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_float_complex_matrix, - octave_float_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_complex_matrix, - octave_float_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_complex_matrix, - octave_float_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_float_complex_matrix, - octave_float_matrix, el_or); - INSTALL_BINOP (op_mul_trans, octave_float_complex_matrix, - octave_float_matrix, mul_trans); - INSTALL_BINOP (op_mul_herm, octave_float_complex_matrix, - octave_float_matrix, mul_trans); - - INSTALL_CATOP (octave_float_complex_matrix, octave_float_matrix, fcm_fm); - INSTALL_CATOP (octave_complex_matrix, octave_float_matrix, cm_fm); - INSTALL_CATOP (octave_float_complex_matrix, octave_matrix, fcm_m); - - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, - octave_float_matrix, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, - octave_float_matrix, dbl_assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcm-fs.cc --- a/src/OPERATORS/op-fcm-fs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,172 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-cm-s.h" -#include "mx-cnda-s.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-float.h" -#include "ov-scalar.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex matrix by scalar ops. - -DEFNDBINOP_OP (add, float_complex_matrix, float_scalar, float_complex_array, float_scalar, +) -DEFNDBINOP_OP (sub, float_complex_matrix, float_scalar, float_complex_array, float_scalar, -) -DEFNDBINOP_OP (mul, float_complex_matrix, float_scalar, float_complex_array, float_scalar, *) - -DEFBINOP (div, float_complex_matrix, float) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_scalar&); - - float d = v2.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.float_complex_array_value () / d); -} - -DEFBINOP_FN (pow, float_complex_matrix, float_scalar, xpow) - -DEFBINOP (ldiv, float_complex_matrix, float) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_scalar&); - - FloatComplexMatrix m1 = v1.float_complex_matrix_value (); - FloatMatrix m2 = v2.float_matrix_value (); - MatrixType typ = v1.matrix_type (); - - FloatComplexMatrix ret = xleftdiv (m1, m2, typ); - - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, float_complex_matrix, float_scalar, float_complex_array, - float_scalar, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, float_complex_matrix, float_scalar, float_complex_array, - float_scalar, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, float_complex_matrix, float_scalar, float_complex_array, - float_scalar, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, float_complex_matrix, float_scalar, float_complex_array, - float_scalar, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, float_complex_matrix, float_scalar, float_complex_array, - float_scalar, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, float_complex_matrix, float_scalar, float_complex_array, - float_scalar, mx_el_ne) - -DEFNDBINOP_OP (el_mul, float_complex_matrix, float_scalar, float_complex_array, - float_scalar, *) - -DEFBINOP (el_div, float_complex_matrix, float) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_scalar&); - - float d = v2.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.float_complex_array_value () / d); -} - -DEFNDBINOP_FN (el_pow, float_complex_matrix, float_scalar, float_complex_array, - float_scalar, elem_xpow) - -DEFBINOP (el_ldiv, float_complex_matrix, float) -{ - CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_scalar&); - - return x_el_div (v2.float_value (), v1.float_complex_array_value ()); -} - -DEFNDBINOP_FN (el_and, float_complex_matrix, float_scalar, float_complex_array, - float_scalar, mx_el_and) -DEFNDBINOP_FN (el_or, float_complex_matrix, float_scalar, float_complex_array, - float_scalar, mx_el_or) - -DEFNDCATOP_FN (fcm_fs, float_complex_matrix, float_scalar, float_complex_array, - float_array, concat) - -DEFNDCATOP_FN (cm_fs, complex_matrix, float_scalar, float_complex_array, - float_array, concat) - -DEFNDCATOP_FN (fcm_s, float_complex_matrix, scalar, float_complex_array, - float_array, concat) - -DEFNDASSIGNOP_FN (assign, float_complex_matrix, float_scalar, float_complex_array, assign) -DEFNDASSIGNOP_FN (dbl_assign, complex_matrix, float_scalar, complex_array, assign) - -DEFNDASSIGNOP_OP (assign_mul, float_complex_matrix, float_scalar, - float_scalar, *=) -DEFNDASSIGNOP_OP (assign_div, float_complex_matrix, float_scalar, - float_scalar, /=) - -void -install_fcm_fs_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_complex_matrix, octave_float_scalar, add); - INSTALL_BINOP (op_sub, octave_float_complex_matrix, octave_float_scalar, sub); - INSTALL_BINOP (op_mul, octave_float_complex_matrix, octave_float_scalar, mul); - INSTALL_BINOP (op_div, octave_float_complex_matrix, octave_float_scalar, div); - INSTALL_BINOP (op_pow, octave_float_complex_matrix, octave_float_scalar, pow); - INSTALL_BINOP (op_ldiv, octave_float_complex_matrix, octave_float_scalar, ldiv); - INSTALL_BINOP (op_lt, octave_float_complex_matrix, octave_float_scalar, lt); - INSTALL_BINOP (op_le, octave_float_complex_matrix, octave_float_scalar, le); - INSTALL_BINOP (op_eq, octave_float_complex_matrix, octave_float_scalar, eq); - INSTALL_BINOP (op_ge, octave_float_complex_matrix, octave_float_scalar, ge); - INSTALL_BINOP (op_gt, octave_float_complex_matrix, octave_float_scalar, gt); - INSTALL_BINOP (op_ne, octave_float_complex_matrix, octave_float_scalar, ne); - INSTALL_BINOP (op_el_mul, octave_float_complex_matrix, octave_float_scalar, el_mul); - INSTALL_BINOP (op_el_div, octave_float_complex_matrix, octave_float_scalar, el_div); - INSTALL_BINOP (op_el_pow, octave_float_complex_matrix, octave_float_scalar, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_complex_matrix, octave_float_scalar, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_complex_matrix, octave_float_scalar, el_and); - INSTALL_BINOP (op_el_or, octave_float_complex_matrix, octave_float_scalar, el_or); - - INSTALL_CATOP (octave_float_complex_matrix, octave_float_scalar, fcm_fs); - INSTALL_CATOP (octave_complex_matrix, octave_float_scalar, cm_fs); - INSTALL_CATOP (octave_float_complex_matrix, octave_scalar, fcm_s); - - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, - octave_float_scalar, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, - octave_float_scalar, dbl_assign); - - INSTALL_ASSIGNOP (op_mul_eq, octave_float_complex_matrix, - octave_float_scalar, assign_mul); - INSTALL_ASSIGNOP (op_div_eq, octave_float_complex_matrix, - octave_float_scalar, assign_div); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcm-pm.cc --- a/src/OPERATORS/op-fcm-pm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define MINCLUDE "ov-flt-cx-mat.h" - -#define LMATRIX float_complex_matrix -#define RMATRIX perm_matrix - -#define LSHORT fcm -#define RSHORT pm - -#define RIGHT - -#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcn.cc --- a/src/OPERATORS/op-fcn.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -/* - -Copyright (C) 2010-2012 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-fcn-handle.h" -#include "ov-scalar.h" -#include "ov-typeinfo.h" -#include "ops.h" - -DEFBINOP (eq, fcn_handle, fcn_handle) -{ - CAST_BINOP_ARGS (const octave_fcn_handle&, const octave_fcn_handle&); - - return v1.is_equal_to (v2); -} - -DEFBINOP (ne, fcn_handle, fcn_handle) -{ - CAST_BINOP_ARGS (const octave_fcn_handle&, const octave_fcn_handle&); - - return ! v1.is_equal_to (v2); -} - -void -install_fcn_ops (void) -{ - INSTALL_BINOP (op_eq, octave_fcn_handle, octave_fcn_handle, eq); - INSTALL_BINOP (op_ne, octave_fcn_handle, octave_fcn_handle, ne); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcs-fcm.cc --- a/src/OPERATORS/op-fcs-fcm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,152 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex scalar by complex matrix ops. - -DEFNDBINOP_OP (add, float_complex, float_complex_matrix, float_complex, float_complex_array, +) -DEFNDBINOP_OP (sub, float_complex, float_complex_matrix, float_complex, float_complex_array, -) -DEFNDBINOP_OP (mul, float_complex, float_complex_matrix, float_complex, float_complex_array, *) - -DEFBINOP (div, float_complex, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex_matrix&); - - FloatComplexMatrix m1 = v1.float_complex_matrix_value (); - FloatComplexMatrix m2 = v2.float_complex_matrix_value (); - MatrixType typ = v2.matrix_type (); - - FloatComplexMatrix ret = xdiv (m1, m2, typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (pow, float_complex, float_complex_matrix, xpow) - -DEFBINOP (ldiv, float_complex, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex_matrix&); - - FloatComplex d = v1.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v2.float_complex_array_value () / d); -} - -DEFNDCMPLXCMPOP_FN (lt, float_complex, float_complex_matrix, float_complex, - float_complex_array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, float_complex, float_complex_matrix, float_complex, - float_complex_array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, float_complex, float_complex_matrix, float_complex, - float_complex_array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, float_complex, float_complex_matrix, float_complex, - float_complex_array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, float_complex, float_complex_matrix, float_complex, - float_complex_array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, float_complex, float_complex_matrix, float_complex, - float_complex_array, mx_el_ne) - -DEFNDBINOP_OP (el_mul, float_complex, float_complex_matrix, float_complex, - float_complex_array, *) -DEFNDBINOP_FN (el_div, float_complex, float_complex_matrix, float_complex, - float_complex_array, x_el_div) -DEFNDBINOP_FN (el_pow, float_complex, float_complex_matrix, float_complex, - float_complex_array, elem_xpow) - -DEFBINOP (el_ldiv, float_complex, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex_matrix&); - - FloatComplex d = v1.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v2.float_complex_array_value () / d); -} - -DEFNDBINOP_FN (el_and, float_complex, float_complex_matrix, float_complex, float_complex_array, mx_el_and) -DEFNDBINOP_FN (el_or, float_complex, float_complex_matrix, float_complex, float_complex_array, mx_el_or) - -DEFNDCATOP_FN (fcs_fcm, float_complex, float_complex_matrix, float_complex_array, float_complex_array, concat) - -DEFNDCATOP_FN (cs_fcm, complex, float_complex_matrix, float_complex_array, float_complex_array, concat) - -DEFNDCATOP_FN (fcs_cm, float_complex, complex_matrix, float_complex_array, float_complex_array, concat) - -DEFCONV (float_complex_matrix_conv, float_complex, float_complex_matrix) -{ - CAST_CONV_ARG (const octave_float_complex&); - - return new octave_float_complex_matrix (v.float_complex_matrix_value ()); -} - -void -install_fcs_fcm_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_complex, octave_float_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_float_complex, octave_float_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_float_complex, octave_float_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_float_complex, octave_float_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_float_complex, octave_float_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_float_complex, octave_float_complex_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_float_complex, octave_float_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_float_complex, octave_float_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_float_complex, octave_float_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_float_complex, octave_float_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_float_complex, octave_float_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_float_complex, octave_float_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_float_complex, octave_float_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_float_complex, octave_float_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_float_complex, octave_float_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_complex, octave_float_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_complex, octave_float_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_float_complex, octave_float_complex_matrix, el_or); - - INSTALL_CATOP (octave_float_complex, octave_float_complex_matrix, fcs_fcm); - INSTALL_CATOP (octave_complex, octave_float_complex_matrix, cs_fcm); - INSTALL_CATOP (octave_float_complex, octave_complex_matrix, fcs_cm); - - INSTALL_ASSIGNCONV (octave_float_complex, octave_float_complex_matrix, octave_float_complex_matrix); - - INSTALL_ASSIGNCONV (octave_complex, octave_float_complex_matrix, octave_complex_matrix); - - INSTALL_WIDENOP (octave_float_complex, octave_float_complex_matrix, float_complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcs-fcs.cc --- a/src/OPERATORS/op-fcs-fcs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,208 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// unary complex scalar ops. - -DEFUNOP (not, float_complex) -{ - CAST_UNOP_ARG (const octave_float_complex&); - FloatComplex x = v.float_complex_value (); - if (xisnan (x)) - gripe_nan_to_logical_conversion (); - return octave_value (x == 0.0f); -} - -DEFUNOP_OP (uplus, float_complex, /* no-op */) -DEFUNOP_OP (uminus, float_complex, -) -DEFUNOP_OP (transpose, float_complex, /* no-op */) - -DEFUNOP (hermitian, float_complex) -{ - CAST_UNOP_ARG (const octave_float_complex&); - - return octave_value (conj (v.float_complex_value ())); -} - -DEFNCUNOP_METHOD (incr, float_complex, increment) -DEFNCUNOP_METHOD (decr, float_complex, decrement) - -// complex scalar by complex scalar ops. - -DEFBINOP_OP (add, float_complex, float_complex, +) -DEFBINOP_OP (sub, float_complex, float_complex, -) -DEFBINOP_OP (mul, float_complex, float_complex, *) - -DEFBINOP (div, float_complex, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); - - FloatComplex d = v2.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v1.float_complex_value () / d); -} - -DEFBINOP_FN (pow, float_complex, float_complex, xpow) - -DEFBINOP (ldiv, float_complex, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); - - FloatComplex d = v1.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v2.float_complex_value () / d); -} - -DEFCMPLXCMPOP_OP (lt, float_complex, float_complex, <) -DEFCMPLXCMPOP_OP (le, float_complex, float_complex, <=) -DEFCMPLXCMPOP_OP (eq, float_complex, float_complex, ==) -DEFCMPLXCMPOP_OP (ge, float_complex, float_complex, >=) -DEFCMPLXCMPOP_OP (gt, float_complex, float_complex, >) -DEFCMPLXCMPOP_OP (ne, float_complex, float_complex, !=) - -DEFBINOP_OP (el_mul, float_complex, float_complex, *) - -DEFBINOP (el_div, float_complex, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); - - FloatComplex d = v2.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v1.float_complex_value () / d); -} - -DEFBINOP_FN (el_pow, float_complex, float_complex, xpow) - -DEFBINOP (el_ldiv, float_complex, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); - - FloatComplex d = v1.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v2.float_complex_value () / d); -} - -DEFBINOP (el_and, float_complex, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); - - return (v1.float_complex_value () != static_cast(0.0) && - v2.float_complex_value () != static_cast(0.0)); -} - -DEFBINOP (el_or, float_complex, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); - - return (v1.float_complex_value () != static_cast(0.0) || - v2.float_complex_value () != static_cast(0.0)); -} - -DEFNDCATOP_FN (fcs_fcs, float_complex, float_complex, float_complex_array, - float_complex_array, concat) - -DEFNDCATOP_FN (cs_fcs, complex, float_complex, float_complex_array, - float_complex_array, concat) - -DEFNDCATOP_FN (fcs_cs, float_complex, complex, float_complex_array, - float_complex_array, concat) - -CONVDECL (float_complex_to_complex) -{ - CAST_CONV_ARG (const octave_float_complex&); - - return new octave_complex_matrix (ComplexMatrix (1, 1, static_cast(v.float_complex_value ()))); -} - -void -install_fcs_fcs_ops (void) -{ - INSTALL_UNOP (op_not, octave_float_complex, not); - INSTALL_UNOP (op_uplus, octave_float_complex, uplus); - INSTALL_UNOP (op_uminus, octave_float_complex, uminus); - INSTALL_UNOP (op_transpose, octave_float_complex, transpose); - INSTALL_UNOP (op_hermitian, octave_float_complex, hermitian); - - INSTALL_NCUNOP (op_incr, octave_float_complex, incr); - INSTALL_NCUNOP (op_decr, octave_float_complex, decr); - - INSTALL_BINOP (op_add, octave_float_complex, octave_float_complex, add); - INSTALL_BINOP (op_sub, octave_float_complex, octave_float_complex, sub); - INSTALL_BINOP (op_mul, octave_float_complex, octave_float_complex, mul); - INSTALL_BINOP (op_div, octave_float_complex, octave_float_complex, div); - INSTALL_BINOP (op_pow, octave_float_complex, octave_float_complex, pow); - INSTALL_BINOP (op_ldiv, octave_float_complex, octave_float_complex, ldiv); - INSTALL_BINOP (op_lt, octave_float_complex, octave_float_complex, lt); - INSTALL_BINOP (op_le, octave_float_complex, octave_float_complex, le); - INSTALL_BINOP (op_eq, octave_float_complex, octave_float_complex, eq); - INSTALL_BINOP (op_ge, octave_float_complex, octave_float_complex, ge); - INSTALL_BINOP (op_gt, octave_float_complex, octave_float_complex, gt); - INSTALL_BINOP (op_ne, octave_float_complex, octave_float_complex, ne); - INSTALL_BINOP (op_el_mul, octave_float_complex, octave_float_complex, el_mul); - INSTALL_BINOP (op_el_div, octave_float_complex, octave_float_complex, el_div); - INSTALL_BINOP (op_el_pow, octave_float_complex, octave_float_complex, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_complex, octave_float_complex, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_complex, octave_float_complex, el_and); - INSTALL_BINOP (op_el_or, octave_float_complex, octave_float_complex, el_or); - - INSTALL_CATOP (octave_float_complex, octave_float_complex, fcs_fcs); - INSTALL_CATOP (octave_complex, octave_float_complex, cs_fcs); - INSTALL_CATOP (octave_float_complex, octave_complex, fcs_cs); - - INSTALL_ASSIGNCONV (octave_float_complex, octave_float_complex, octave_float_complex_matrix); - - INSTALL_ASSIGNCONV (octave_complex, octave_float_complex, octave_complex_matrix); - - INSTALL_ASSIGNCONV (octave_float_complex, octave_null_matrix, octave_float_complex_matrix); - INSTALL_ASSIGNCONV (octave_float_complex, octave_null_str, octave_float_complex_matrix); - INSTALL_ASSIGNCONV (octave_float_complex, octave_null_sq_str, octave_float_complex_matrix); - - INSTALL_CONVOP (octave_float_complex, octave_complex_matrix, - float_complex_to_complex); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcs-fm.cc --- a/src/OPERATORS/op-fcs-fm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,156 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-cs-nda.h" -#include "mx-nda-cs.h" -#include "mx-cs-nda.h" -#include "mx-nda-cs.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex scalar by matrix ops. - -DEFNDBINOP_OP (add, float_complex, float_matrix, float_complex, float_array, +) -DEFNDBINOP_OP (sub, float_complex, float_matrix, float_complex, float_array, -) -DEFNDBINOP_OP (mul, float_complex, float_matrix, float_complex, float_array, *) - -DEFBINOP (div, float_complex, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_matrix&); - - FloatComplexMatrix m1 = v1.float_complex_matrix_value (); - FloatMatrix m2 = v2.float_matrix_value (); - MatrixType typ = v2.matrix_type (); - - FloatComplexMatrix ret = xdiv (m1, m2, typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (pow, float_complex, float_matrix, xpow) - -DEFBINOP (ldiv, float_complex, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_matrix&); - - FloatComplex d = v1.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v2.float_array_value () / d); -} - -DEFNDCMPLXCMPOP_FN (lt, float_complex, float_matrix, float_complex, - float_array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, float_complex, float_matrix, float_complex, - float_array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, float_complex, float_matrix, float_complex, - float_array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, float_complex, float_matrix, float_complex, - float_array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, float_complex, float_matrix, float_complex, - float_array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, float_complex, float_matrix, float_complex, - float_array, mx_el_ne) - -DEFNDBINOP_OP (el_mul, float_complex, float_matrix, float_complex, - float_array, *) -DEFNDBINOP_FN (el_div, float_complex, float_matrix, float_complex, - float_array, x_el_div) -DEFNDBINOP_FN (el_pow, float_complex, float_matrix, float_complex, - float_array, elem_xpow) - -DEFBINOP (el_ldiv, float_complex, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_matrix&); - - FloatComplex d = v1.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v2.float_array_value () / d); -} - -DEFNDBINOP_FN (el_and, float_complex, float_matrix, float_complex, - float_array, mx_el_and) -DEFNDBINOP_FN (el_or, float_complex, float_matrix, float_complex, - float_array, mx_el_or) - -DEFNDCATOP_FN (fcs_fm, float_complex, float_matrix, float_complex_array, - float_array, concat) - -DEFNDCATOP_FN (cs_fm, complex, float_matrix, float_complex_array, - float_array, concat) - -DEFNDCATOP_FN (fcs_m, float_complex, matrix, float_complex_array, - float_array, concat) - -void -install_fcs_fm_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_complex, octave_float_matrix, add); - INSTALL_BINOP (op_sub, octave_float_complex, octave_float_matrix, sub); - INSTALL_BINOP (op_mul, octave_float_complex, octave_float_matrix, mul); - INSTALL_BINOP (op_div, octave_float_complex, octave_float_matrix, div); - INSTALL_BINOP (op_pow, octave_float_complex, octave_float_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_float_complex, octave_float_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_float_complex, octave_float_matrix, lt); - INSTALL_BINOP (op_le, octave_float_complex, octave_float_matrix, le); - INSTALL_BINOP (op_eq, octave_float_complex, octave_float_matrix, eq); - INSTALL_BINOP (op_ge, octave_float_complex, octave_float_matrix, ge); - INSTALL_BINOP (op_gt, octave_float_complex, octave_float_matrix, gt); - INSTALL_BINOP (op_ne, octave_float_complex, octave_float_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_float_complex, octave_float_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_float_complex, octave_float_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_float_complex, octave_float_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_complex, octave_float_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_complex, octave_float_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_float_complex, octave_float_matrix, el_or); - - INSTALL_CATOP (octave_float_complex, octave_float_matrix, fcs_fm); - INSTALL_CATOP (octave_complex, octave_float_matrix, cs_fm); - INSTALL_CATOP (octave_float_complex, octave_matrix, fcs_m); - - INSTALL_ASSIGNCONV (octave_float_complex, octave_float_matrix, - octave_float_complex_matrix); - INSTALL_ASSIGNCONV (octave_complex, octave_float_matrix, - octave_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fcs-fs.cc --- a/src/OPERATORS/op-fcs-fs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,163 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-float.h" -#include "ov-scalar.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// complex scalar by scalar ops. - -DEFBINOP_OP (add, float_complex, float_scalar, +) -DEFBINOP_OP (sub, float_complex, float_scalar, -) -DEFBINOP_OP (mul, float_complex, float_scalar, *) - -DEFBINOP (div, float_complex, float) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); - - float d = v2.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.float_complex_value () / d); -} - -DEFBINOP_FN (pow, float_complex, float_scalar, xpow) - -DEFBINOP (ldiv, float_complex, float) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); - - FloatComplex d = v1.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v2.float_value () / d); -} - -DEFCMPLXCMPOP_OP (lt, float_complex, float_scalar, <) -DEFCMPLXCMPOP_OP (le, float_complex, float_scalar, <=) -DEFCMPLXCMPOP_OP (eq, float_complex, float_scalar, ==) -DEFCMPLXCMPOP_OP (ge, float_complex, float_scalar, >=) -DEFCMPLXCMPOP_OP (gt, float_complex, float_scalar, >) -DEFCMPLXCMPOP_OP (ne, float_complex, float_scalar, !=) - -DEFBINOP_OP (el_mul, float_complex, float_scalar, *) - -DEFBINOP (el_div, float_complex, float) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); - - float d = v2.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.float_complex_value () / d); -} - -DEFBINOP_FN (el_pow, float_complex, float_scalar, xpow) - -DEFBINOP (el_ldiv, float_complex, float) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); - - FloatComplex d = v1.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v2.float_value () / d); -} - -DEFBINOP (el_and, float_complex, float) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); - - return (v1.float_complex_value () != static_cast(0.0) && - v2.float_value ()); -} - -DEFBINOP (el_or, float_complex, float) -{ - CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); - - return (v1.float_complex_value () != static_cast(0.0) || - v2.float_value ()); -} - -DEFNDCATOP_FN (fcs_fs, float_complex, float_scalar, float_complex_array, - float_array, concat) - -DEFNDCATOP_FN (cs_fs, complex, float_scalar, float_complex_array, - float_array, concat) - -DEFNDCATOP_FN (fcs_s, float_complex, scalar, float_complex_array, - float_array, concat) - -void -install_fcs_fs_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_complex, octave_float_scalar, add); - INSTALL_BINOP (op_sub, octave_float_complex, octave_float_scalar, sub); - INSTALL_BINOP (op_mul, octave_float_complex, octave_float_scalar, mul); - INSTALL_BINOP (op_div, octave_float_complex, octave_float_scalar, div); - INSTALL_BINOP (op_pow, octave_float_complex, octave_float_scalar, pow); - INSTALL_BINOP (op_ldiv, octave_float_complex, octave_float_scalar, ldiv); - INSTALL_BINOP (op_lt, octave_float_complex, octave_float_scalar, lt); - INSTALL_BINOP (op_le, octave_float_complex, octave_float_scalar, le); - INSTALL_BINOP (op_eq, octave_float_complex, octave_float_scalar, eq); - INSTALL_BINOP (op_ge, octave_float_complex, octave_float_scalar, ge); - INSTALL_BINOP (op_gt, octave_float_complex, octave_float_scalar, gt); - INSTALL_BINOP (op_ne, octave_float_complex, octave_float_scalar, ne); - INSTALL_BINOP (op_el_mul, octave_float_complex, octave_float_scalar, el_mul); - INSTALL_BINOP (op_el_div, octave_float_complex, octave_float_scalar, el_div); - INSTALL_BINOP (op_el_pow, octave_float_complex, octave_float_scalar, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_complex, octave_float_scalar, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_complex, octave_float_scalar, el_and); - INSTALL_BINOP (op_el_or, octave_float_complex, octave_float_scalar, el_or); - - INSTALL_CATOP (octave_float_complex, octave_float_scalar, fcs_fs); - INSTALL_CATOP (octave_complex, octave_float_scalar, cs_fs); - INSTALL_CATOP (octave_float_complex, octave_scalar, fcs_s); - - INSTALL_ASSIGNCONV (octave_float_complex, octave_float_scalar, - octave_float_complex_matrix); - INSTALL_ASSIGNCONV (octave_complex, octave_float_scalar, - octave_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fdm-fcdm.cc --- a/src/OPERATORS/op-fdm-fcdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-flt-re-diag.h" -#define RINCLUDE "ov-flt-cx-diag.h" - -#define LMATRIX float_diag_matrix -#define RMATRIX float_complex_diag_matrix -#define LDMATRIX RMATRIX - -#define LSHORT fdm -#define RSHORT fcdm - -#define DEFINEDIV -#define DEFINELDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fdm-fcm.cc --- a/src/OPERATORS/op-fdm-fcm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-flt-re-diag.h" -#define RINCLUDE "ov-flt-cx-mat.h" - -#define LMATRIX float_diag_matrix -#define RMATRIX float_complex_matrix - -#define LSHORT fdm -#define RSHORT fcm - -#define DEFINELDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fdm-fcs.cc --- a/src/OPERATORS/op-fdm-fcs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define SINCLUDE "ov-flt-complex.h" -#define MINCLUDE "ov-flt-re-diag.h" - -#define SCALAR float_complex -#define MATRIX float_diag_matrix -#define MATRIXV float_complex_diag_matrix - -#define SSHORT fcs -#define MSHORT fdm - -#include "op-dms-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fdm-fdm.cc --- a/src/OPERATORS/op-fdm-fdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,103 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-flt-re-mat.h" -#include "ov-flt-re-diag.h" -#include "ov-re-diag.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix unary ops. - -DEFUNOP_OP (uplus, float_diag_matrix, /* no-op */) -DEFUNOP_OP (uminus, float_diag_matrix, -) - -DEFUNOP (transpose, float_diag_matrix) -{ - CAST_UNOP_ARG (const octave_float_diag_matrix&); - return octave_value (v.float_diag_matrix_value ().transpose ()); -} - -// matrix by matrix ops. - -DEFBINOP_OP (add, float_diag_matrix, float_diag_matrix, +) -DEFBINOP_OP (sub, float_diag_matrix, float_diag_matrix, -) -DEFBINOP_OP (mul, float_diag_matrix, float_diag_matrix, *) - -DEFBINOP (div, float_diag_matrix, float_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_float_diag_matrix&, const octave_float_diag_matrix&); - - return xdiv (v1.float_diag_matrix_value (), - v2.float_diag_matrix_value ()); -} - -DEFBINOP (ldiv, float_diag_matrix, float_diag_matrix) -{ - CAST_BINOP_ARGS (const octave_float_diag_matrix&, const octave_float_diag_matrix&); - - return xleftdiv (v1.float_diag_matrix_value (), - v2.float_diag_matrix_value ()); -} - -CONVDECL (float_diag_matrix_to_diag_matrix) -{ - CAST_CONV_ARG (const octave_float_diag_matrix&); - - return new octave_diag_matrix (v.diag_matrix_value ()); -} - -CONVDECL (float_diag_matrix_to_float_matrix) -{ - CAST_CONV_ARG (const octave_float_diag_matrix&); - - return new octave_float_matrix (v.float_matrix_value ()); -} - -void -install_fdm_fdm_ops (void) -{ - INSTALL_UNOP (op_uplus, octave_float_diag_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_float_diag_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_float_diag_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_float_diag_matrix, transpose); - - INSTALL_BINOP (op_add, octave_float_diag_matrix, octave_float_diag_matrix, add); - INSTALL_BINOP (op_sub, octave_float_diag_matrix, octave_float_diag_matrix, sub); - INSTALL_BINOP (op_mul, octave_float_diag_matrix, octave_float_diag_matrix, mul); - INSTALL_BINOP (op_div, octave_float_diag_matrix, octave_float_diag_matrix, div); - INSTALL_BINOP (op_ldiv, octave_float_diag_matrix, octave_float_diag_matrix, ldiv); - - INSTALL_CONVOP (octave_float_diag_matrix, octave_float_matrix, float_diag_matrix_to_float_matrix); - INSTALL_CONVOP (octave_float_diag_matrix, octave_diag_matrix, float_diag_matrix_to_diag_matrix); - INSTALL_ASSIGNCONV (octave_float_diag_matrix, octave_float_matrix, octave_float_matrix); - INSTALL_WIDENOP (octave_float_diag_matrix, octave_float_matrix, float_diag_matrix_to_float_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fdm-fm.cc --- a/src/OPERATORS/op-fdm-fm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-flt-re-diag.h" -#define RINCLUDE "ov-flt-re-mat.h" - -#define LMATRIX float_diag_matrix -#define RMATRIX float_matrix - -#define LSHORT fdm -#define RSHORT fm - -#define DEFINELDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fdm-fs.cc --- a/src/OPERATORS/op-fdm-fs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define SINCLUDE "ov-float.h" -#define MINCLUDE "ov-flt-re-diag.h" - -#define SCALAR float_scalar -#define MATRIX float_diag_matrix - -#define SSHORT fs -#define MSHORT fdm - -#include "op-dms-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-float-conv.cc --- a/src/OPERATORS/op-float-conv.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,111 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int8.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-uint8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-range.h" -#include "ov-float.h" -#include "ov-flt-re-mat.h" -#include "ov-str-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" - -// conversion ops - -DEFFLTCONVFN (int8_matrix_to_float_matrix, int8_matrix, int8_array) -DEFFLTCONVFN (int16_matrix_to_float_matrix, int16_matrix, int16_array) -DEFFLTCONVFN (int32_matrix_to_float_matrix, int32_matrix, int32_array) -DEFFLTCONVFN (int64_matrix_to_float_matrix, int64_matrix, int64_array) - -DEFFLTCONVFN (uint8_matrix_to_float_matrix, uint8_matrix, uint8_array) -DEFFLTCONVFN (uint16_matrix_to_float_matrix, uint16_matrix, uint16_array) -DEFFLTCONVFN (uint32_matrix_to_float_matrix, uint32_matrix, uint32_array) -DEFFLTCONVFN (uint64_matrix_to_float_matrix, uint64_matrix, uint64_array) - -DEFFLTCONVFN (int8_scalar_to_float_matrix, int8_scalar, int8_array) -DEFFLTCONVFN (int16_scalar_to_float_matrix, int16_scalar, int16_array) -DEFFLTCONVFN (int32_scalar_to_float_matrix, int32_scalar, int32_array) -DEFFLTCONVFN (int64_scalar_to_float_matrix, int64_scalar, int64_array) - -DEFFLTCONVFN (uint8_scalar_to_float_matrix, uint8_scalar, uint8_array) -DEFFLTCONVFN (uint16_scalar_to_float_matrix, uint16_scalar, uint16_array) -DEFFLTCONVFN (uint32_scalar_to_float_matrix, uint32_scalar, uint32_array) -DEFFLTCONVFN (uint64_scalar_to_float_matrix, uint64_scalar, uint64_array) - -DEFFLTCONVFN (bool_matrix_to_float_matrix, bool_matrix, bool_array) -DEFFLTCONVFN (bool_scalar_to_float_matrix, bool, bool_array) - -DEFFLTCONVFN (range_to_float_matrix, range, array) - -DEFSTRFLTCONVFN(char_matrix_str_to_float_matrix, char_matrix_str) -DEFSTRFLTCONVFN(char_matrix_sq_str_to_float_matrix, char_matrix_sq_str) - -DEFFLTCONVFN (float_scalar_to_float_matrix, scalar, array) - -void -install_float_conv_ops (void) -{ - INSTALL_CONVOP (octave_int8_matrix, octave_float_matrix, int8_matrix_to_float_matrix); - INSTALL_CONVOP (octave_int16_matrix, octave_float_matrix, int16_matrix_to_float_matrix); - INSTALL_CONVOP (octave_int32_matrix, octave_float_matrix, int32_matrix_to_float_matrix); - INSTALL_CONVOP (octave_int64_matrix, octave_float_matrix, int64_matrix_to_float_matrix); - - INSTALL_CONVOP (octave_uint8_matrix, octave_float_matrix, uint8_matrix_to_float_matrix); - INSTALL_CONVOP (octave_uint16_matrix, octave_float_matrix, uint16_matrix_to_float_matrix); - INSTALL_CONVOP (octave_uint32_matrix, octave_float_matrix, uint32_matrix_to_float_matrix); - INSTALL_CONVOP (octave_uint64_matrix, octave_float_matrix, uint64_matrix_to_float_matrix); - - INSTALL_CONVOP (octave_int8_scalar, octave_float_matrix, int8_scalar_to_float_matrix); - INSTALL_CONVOP (octave_int16_scalar, octave_float_matrix, int16_scalar_to_float_matrix); - INSTALL_CONVOP (octave_int32_scalar, octave_float_matrix, int32_scalar_to_float_matrix); - INSTALL_CONVOP (octave_int64_scalar, octave_float_matrix, int64_scalar_to_float_matrix); - - INSTALL_CONVOP (octave_uint8_scalar, octave_float_matrix, uint8_scalar_to_float_matrix); - INSTALL_CONVOP (octave_uint16_scalar, octave_float_matrix, uint16_scalar_to_float_matrix); - INSTALL_CONVOP (octave_uint32_scalar, octave_float_matrix, uint32_scalar_to_float_matrix); - INSTALL_CONVOP (octave_uint64_scalar, octave_float_matrix, uint64_scalar_to_float_matrix); - - INSTALL_CONVOP (octave_bool_matrix, octave_float_matrix, bool_matrix_to_float_matrix); - INSTALL_CONVOP (octave_bool, octave_float_matrix, bool_scalar_to_float_matrix); - - INSTALL_CONVOP (octave_range, octave_float_matrix, range_to_float_matrix); - - INSTALL_CONVOP (octave_char_matrix_str, octave_float_matrix, char_matrix_str_to_float_matrix); - INSTALL_CONVOP (octave_char_matrix_sq_str, octave_float_matrix, char_matrix_sq_str_to_float_matrix); - - INSTALL_CONVOP (octave_scalar, octave_float_matrix, float_scalar_to_float_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fm-fcdm.cc --- a/src/OPERATORS/op-fm-fcdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-flt-re-mat.h" -#define RINCLUDE "ov-flt-cx-diag.h" - -#define LMATRIX float_matrix -#define RMATRIX float_complex_diag_matrix -#define LDMATRIX float_complex_matrix - -#define LSHORT fm -#define RSHORT fcdm - -#define DEFINEDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fm-fcm.cc --- a/src/OPERATORS/op-fm-fcm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,206 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-fm-fcm.h" -#include "mx-fcm-fm.h" -#include "mx-fnda-fcnda.h" -#include "mx-fcnda-fnda.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix by complex matrix ops. - -DEFNDBINOP_OP (add, float_matrix, float_complex_matrix, float_array, - float_complex_array, +) -DEFNDBINOP_OP (sub, float_matrix, float_complex_matrix, float_array, - float_complex_array, -) - -DEFBINOP_OP (mul, float_matrix, float_complex_matrix, *) - -DEFBINOP (trans_mul, float_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_complex_matrix&); - - FloatMatrix m1 = v1.float_matrix_value (); - FloatComplexMatrix m2 = v2.float_complex_matrix_value (); - - return FloatComplexMatrix (xgemm (m1, real (m2), blas_trans, blas_no_trans), - xgemm (m1, imag (m2), blas_trans, blas_no_trans)); -} - -DEFBINOP (div, float_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, - const octave_float_complex_matrix&); - MatrixType typ = v2.matrix_type (); - - FloatComplexMatrix ret = xdiv (v1.float_matrix_value (), - v2.float_complex_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOPX (pow, float_matrix, float_complex_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, float_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, - const octave_float_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - FloatComplexMatrix ret = xleftdiv (v1.float_matrix_value (), - v2.float_complex_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP (trans_ldiv, float_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, - const octave_float_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - FloatComplexMatrix ret = xleftdiv (v1.float_matrix_value (), - v2.float_complex_matrix_value (), typ, blas_trans); - - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, float_matrix, float_complex_matrix, float_array, - float_complex_array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, float_matrix, float_complex_matrix, float_array, - float_complex_array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, float_matrix, float_complex_matrix, float_array, - float_complex_array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, float_matrix, float_complex_matrix, float_array, - float_complex_array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, float_matrix, float_complex_matrix, float_array, - float_complex_array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, float_matrix, float_complex_matrix, float_array, - float_complex_array, mx_el_ne) - -DEFNDBINOP_FN (el_mul, float_matrix, float_complex_matrix, float_array, - float_complex_array, product) -DEFNDBINOP_FN (el_div, float_matrix, float_complex_matrix, float_array, - float_complex_array, quotient) -DEFNDBINOP_FN (el_pow, float_matrix, float_complex_matrix, float_array, - float_complex_array, elem_xpow) - -DEFBINOP (el_ldiv, float_matrix, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, - const octave_float_complex_matrix&); - - return quotient (v2.float_complex_array_value (), v1.float_array_value ()); -} - -DEFNDBINOP_FN (el_and, float_matrix, float_complex_matrix, float_array, - float_complex_array, mx_el_and) -DEFNDBINOP_FN (el_or, float_matrix, float_complex_matrix, float_array, - float_complex_array, mx_el_or) - -DEFNDCATOP_FN (fm_fcm, float_matrix, float_complex_matrix, float_array, - float_complex_array, concat) - -DEFNDCATOP_FN (m_fcm, matrix, float_complex_matrix, float_array, - float_complex_array, concat) - -DEFNDCATOP_FN (fm_cm, float_matrix, complex_matrix, float_array, - float_complex_array, concat) - -DEFCONV (float_complex_matrix_conv, float_matrix, float_complex_matrix) -{ - CAST_CONV_ARG (const octave_float_matrix&); - - return new octave_float_complex_matrix (FloatComplexNDArray (v.float_array_value ())); -} - -void -install_fm_fcm_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_matrix, octave_float_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_float_matrix, octave_float_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_float_matrix, octave_float_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_float_matrix, octave_float_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_float_matrix, octave_float_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_float_matrix, - octave_float_complex_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_float_matrix, octave_float_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_float_matrix, octave_float_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_float_matrix, octave_float_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_float_matrix, octave_float_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_float_matrix, octave_float_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_float_matrix, octave_float_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_float_matrix, - octave_float_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_float_matrix, - octave_float_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_float_matrix, - octave_float_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_matrix, - octave_float_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_matrix, - octave_float_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_float_matrix, - octave_float_complex_matrix, el_or); - INSTALL_BINOP (op_trans_mul, octave_float_matrix, - octave_float_complex_matrix, trans_mul); - INSTALL_BINOP (op_herm_mul, octave_float_matrix, - octave_float_complex_matrix, trans_mul); - INSTALL_BINOP (op_trans_ldiv, octave_float_matrix, - octave_float_complex_matrix, trans_ldiv); - INSTALL_BINOP (op_herm_ldiv, octave_float_matrix, - octave_float_complex_matrix, trans_ldiv); - - INSTALL_CATOP (octave_float_matrix, octave_float_complex_matrix, fm_fcm); - INSTALL_CATOP (octave_matrix, octave_float_complex_matrix, m_fcm); - INSTALL_CATOP (octave_float_matrix, octave_complex_matrix, fm_cm); - - INSTALL_ASSIGNCONV (octave_float_matrix, octave_float_complex_matrix, - octave_float_complex_matrix); - INSTALL_ASSIGNCONV (octave_matrix, octave_float_complex_matrix, - octave_complex_matrix); - - INSTALL_WIDENOP (octave_float_matrix, octave_float_complex_matrix, - float_complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fm-fcs.cc --- a/src/OPERATORS/op-fm-fcs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,162 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-fm-fcs.h" -#include "mx-fcs-fm.h" -#include "mx-fnda-fcs.h" -#include "mx-fcs-fnda.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-flt-complex.h" -#include "ov-complex.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix by complex scalar ops. - -DEFNDBINOP_OP (add, float_matrix, float_complex, float_array, float_complex, +) -DEFNDBINOP_OP (sub, float_matrix, float_complex, float_array, float_complex, -) -DEFNDBINOP_OP (mul, float_matrix, float_complex, float_array, float_complex, *) - -DEFBINOP (div, float_matrix, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_complex&); - - FloatComplex d = v2.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v1.float_array_value () / d); -} - -DEFBINOP_FN (pow, float_matrix, float_complex, xpow) - -DEFBINOP (ldiv, float_matrix, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_complex&); - - FloatMatrix m1 = v1.float_matrix_value (); - FloatComplexMatrix m2 = v2.float_complex_matrix_value (); - MatrixType typ = v1.matrix_type (); - - FloatComplexMatrix ret = xleftdiv (m1, m2, typ); - - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, float_matrix, float_complex, float_array, - float_complex, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, float_matrix, float_complex, float_array, - float_complex, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, float_matrix, float_complex, float_array, - float_complex, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, float_matrix, float_complex, float_array, - float_complex, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, float_matrix, float_complex, float_array, - float_complex, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, float_matrix, float_complex, float_array, - float_complex, mx_el_ne) - -DEFNDBINOP_OP (el_mul, float_matrix, float_complex, float_array, - float_complex, *) - -DEFBINOP (el_div, float_matrix, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_complex&); - - FloatComplex d = v2.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v1.float_array_value () / d); -} - -DEFNDBINOP_FN (el_pow, float_matrix, float_complex, float_array, - float_complex, elem_xpow) - -DEFBINOP (el_ldiv, float_matrix, flaot_complex) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_complex&); - - return x_el_div (v2.float_complex_value (), v1.float_array_value ()); -} - -DEFNDBINOP_FN (el_and, float_matrix, float_complex, float_array, - float_complex, mx_el_and) -DEFNDBINOP_FN (el_or, float_matrix, float_complex, float_array, - float_complex, mx_el_or) - -DEFNDCATOP_FN (fm_fcs, float_matrix, float_complex, float_array, - float_complex_array, concat) - -DEFNDCATOP_FN (m_fcs, matrix, float_complex, float_array, - float_complex_array, concat) - -DEFNDCATOP_FN (fm_cs, float_matrix, complex, float_array, - float_complex_array, concat) - -void -install_fm_fcs_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_matrix, octave_float_complex, add); - INSTALL_BINOP (op_sub, octave_float_matrix, octave_float_complex, sub); - INSTALL_BINOP (op_mul, octave_float_matrix, octave_float_complex, mul); - INSTALL_BINOP (op_div, octave_float_matrix, octave_float_complex, div); - INSTALL_BINOP (op_pow, octave_float_matrix, octave_float_complex, pow); - INSTALL_BINOP (op_ldiv, octave_float_matrix, octave_float_complex, ldiv); - INSTALL_BINOP (op_lt, octave_float_matrix, octave_float_complex, lt); - INSTALL_BINOP (op_le, octave_float_matrix, octave_float_complex, le); - INSTALL_BINOP (op_eq, octave_float_matrix, octave_float_complex, eq); - INSTALL_BINOP (op_ge, octave_float_matrix, octave_float_complex, ge); - INSTALL_BINOP (op_gt, octave_float_matrix, octave_float_complex, gt); - INSTALL_BINOP (op_ne, octave_float_matrix, octave_float_complex, ne); - INSTALL_BINOP (op_el_mul, octave_float_matrix, octave_float_complex, el_mul); - INSTALL_BINOP (op_el_div, octave_float_matrix, octave_float_complex, el_div); - INSTALL_BINOP (op_el_pow, octave_float_matrix, octave_float_complex, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_matrix, octave_float_complex, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_matrix, octave_float_complex, el_and); - INSTALL_BINOP (op_el_or, octave_float_matrix, octave_float_complex, el_or); - - INSTALL_CATOP (octave_float_matrix, octave_float_complex, fm_fcs); - INSTALL_CATOP (octave_matrix, octave_float_complex, m_fcs); - INSTALL_CATOP (octave_float_matrix, octave_complex, fm_cs); - - INSTALL_ASSIGNCONV (octave_float_matrix, octave_float_complex, - octave_float_complex_matrix); - INSTALL_ASSIGNCONV (octave_matrix, octave_float_complex, - octave_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fm-fdm.cc --- a/src/OPERATORS/op-fm-fdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-flt-re-mat.h" -#define RINCLUDE "ov-flt-re-diag.h" - -#define LMATRIX float_matrix -#define RMATRIX float_diag_matrix - -#define LSHORT fm -#define RSHORT fdm - -#define DEFINEDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fm-fm.cc --- a/src/OPERATORS/op-fm-fm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,255 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix unary ops. - -DEFNDUNOP_OP (not, float_matrix, float_array, !) -DEFNDUNOP_OP (uplus, float_matrix, float_array, /* no-op */) -DEFNDUNOP_OP (uminus, float_matrix, float_array, -) - -DEFUNOP (transpose, float_matrix) -{ - CAST_UNOP_ARG (const octave_float_matrix&); - - if (v.ndims () > 2) - { - error ("transpose not defined for N-d objects"); - return octave_value (); - } - else - return octave_value (v.float_matrix_value ().transpose ()); -} - -DEFNCUNOP_METHOD (incr, float_matrix, increment) -DEFNCUNOP_METHOD (decr, float_matrix, decrement) -DEFNCUNOP_METHOD (changesign, float_matrix, changesign) - -// matrix by matrix ops. - -DEFNDBINOP_OP (add, float_matrix, float_matrix, float_array, float_array, +) -DEFNDBINOP_OP (sub, float_matrix, float_matrix, float_array, float_array, -) - -DEFBINOP_OP (mul, float_matrix, float_matrix, *) - -DEFBINOP (div, float_matrix, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); - MatrixType typ = v2.matrix_type (); - - FloatMatrix ret = xdiv (v1.float_matrix_value (), - v2.float_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOPX (pow, float_matrix, float_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, float_matrix, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); - MatrixType typ = v1.matrix_type (); - - FloatMatrix ret = xleftdiv (v1.float_matrix_value (), - v2.float_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP (trans_mul, float_matrix, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); - return octave_value(xgemm (v1.float_matrix_value (), - v2.float_matrix_value (), - blas_trans, blas_no_trans)); -} - -DEFBINOP (mul_trans, float_matrix, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); - return octave_value(xgemm (v1.float_matrix_value (), - v2.float_matrix_value (), - blas_no_trans, blas_trans)); -} - -DEFBINOP (trans_ldiv, float_matrix, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); - MatrixType typ = v1.matrix_type (); - - FloatMatrix ret = xleftdiv (v1.float_matrix_value (), - v2.float_matrix_value (), typ, blas_trans); - - v1.matrix_type (typ); - return ret; -} - -DEFNDBINOP_FN (lt, float_matrix, float_matrix, float_array, - float_array, mx_el_lt) -DEFNDBINOP_FN (le, float_matrix, float_matrix, float_array, - float_array, mx_el_le) -DEFNDBINOP_FN (eq, float_matrix, float_matrix, float_array, - float_array, mx_el_eq) -DEFNDBINOP_FN (ge, float_matrix, float_matrix, float_array, - float_array, mx_el_ge) -DEFNDBINOP_FN (gt, float_matrix, float_matrix, float_array, - float_array, mx_el_gt) -DEFNDBINOP_FN (ne, float_matrix, float_matrix, float_array, - float_array, mx_el_ne) - -DEFNDBINOP_FN (el_mul, float_matrix, float_matrix, float_array, - float_array, product) -DEFNDBINOP_FN (el_div, float_matrix, float_matrix, float_array, - float_array, quotient) -DEFNDBINOP_FN (el_pow, float_matrix, float_matrix, float_array, - float_array, elem_xpow) - -DEFBINOP (el_ldiv, float_matrix, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); - - return octave_value (quotient (v2.float_array_value (), - v1.float_array_value ())); -} - -DEFNDBINOP_FN (el_and, float_matrix, float_matrix, float_array, - float_array, mx_el_and) -DEFNDBINOP_FN (el_or, float_matrix, float_matrix, float_array, - float_array, mx_el_or) -DEFNDBINOP_FN (el_not_and, float_matrix, float_matrix, float_array, - float_array, mx_el_not_and) -DEFNDBINOP_FN (el_not_or, float_matrix, float_matrix, float_array, - float_array, mx_el_not_or) -DEFNDBINOP_FN (el_and_not, float_matrix, float_matrix, float_array, - float_array, mx_el_and_not) -DEFNDBINOP_FN (el_or_not, float_matrix, float_matrix, float_array, - float_array, mx_el_or_not) - - - -DEFNDCATOP_FN (fm_fm, float_matrix, float_matrix, float_array, - float_array, concat) - -DEFNDCATOP_FN (m_fm, matrix, float_matrix, float_array, float_array, concat) - -DEFNDCATOP_FN (fm_m, float_matrix, matrix, float_array, float_array, concat) - -DEFNDASSIGNOP_FN (assign, float_matrix, float_matrix, float_array, assign) - -DEFNDASSIGNOP_FN (dbl_assign, matrix, float_matrix, array, assign) - -DEFNULLASSIGNOP_FN (null_assign, float_matrix, delete_elements) - -DEFNDASSIGNOP_OP (assign_add, float_matrix, float_matrix, float_array, +=) -DEFNDASSIGNOP_OP (assign_sub, float_matrix, float_matrix, float_array, -=) -DEFNDASSIGNOP_FNOP (assign_el_mul, float_matrix, float_matrix, float_array, product_eq) -DEFNDASSIGNOP_FNOP (assign_el_div, float_matrix, float_matrix, float_array, quotient_eq) - -CONVDECL (float_matrix_to_matrix) -{ - CAST_CONV_ARG (const octave_float_matrix&); - - return new octave_matrix (v.array_value ()); -} - -void -install_fm_fm_ops (void) -{ - INSTALL_UNOP (op_not, octave_float_matrix, not); - INSTALL_UNOP (op_uplus, octave_float_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_float_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_float_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_float_matrix, transpose); - - INSTALL_NCUNOP (op_incr, octave_float_matrix, incr); - INSTALL_NCUNOP (op_decr, octave_float_matrix, decr); - INSTALL_NCUNOP (op_uminus, octave_float_matrix, changesign); - - INSTALL_BINOP (op_add, octave_float_matrix, octave_float_matrix, add); - INSTALL_BINOP (op_sub, octave_float_matrix, octave_float_matrix, sub); - INSTALL_BINOP (op_mul, octave_float_matrix, octave_float_matrix, mul); - INSTALL_BINOP (op_div, octave_float_matrix, octave_float_matrix, div); - INSTALL_BINOP (op_pow, octave_float_matrix, octave_float_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_float_matrix, octave_float_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_float_matrix, octave_float_matrix, lt); - INSTALL_BINOP (op_le, octave_float_matrix, octave_float_matrix, le); - INSTALL_BINOP (op_eq, octave_float_matrix, octave_float_matrix, eq); - INSTALL_BINOP (op_ge, octave_float_matrix, octave_float_matrix, ge); - INSTALL_BINOP (op_gt, octave_float_matrix, octave_float_matrix, gt); - INSTALL_BINOP (op_ne, octave_float_matrix, octave_float_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_float_matrix, octave_float_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_float_matrix, octave_float_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_float_matrix, octave_float_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_matrix, octave_float_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_matrix, octave_float_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_float_matrix, octave_float_matrix, el_or); - INSTALL_BINOP (op_el_and_not, octave_float_matrix, octave_float_matrix, el_and_not); - INSTALL_BINOP (op_el_or_not, octave_float_matrix, octave_float_matrix, el_or_not); - INSTALL_BINOP (op_el_not_and, octave_float_matrix, octave_float_matrix, el_not_and); - INSTALL_BINOP (op_el_not_or, octave_float_matrix, octave_float_matrix, el_not_or); - INSTALL_BINOP (op_trans_mul, octave_float_matrix, octave_float_matrix, trans_mul); - INSTALL_BINOP (op_mul_trans, octave_float_matrix, octave_float_matrix, mul_trans); - INSTALL_BINOP (op_herm_mul, octave_float_matrix, octave_float_matrix, trans_mul); - INSTALL_BINOP (op_mul_herm, octave_float_matrix, octave_float_matrix, mul_trans); - INSTALL_BINOP (op_trans_ldiv, octave_float_matrix, octave_float_matrix, trans_ldiv); - INSTALL_BINOP (op_herm_ldiv, octave_float_matrix, octave_float_matrix, trans_ldiv); - - INSTALL_CATOP (octave_float_matrix, octave_float_matrix, fm_fm); - INSTALL_CATOP (octave_matrix, octave_float_matrix, m_fm); - INSTALL_CATOP (octave_float_matrix, octave_matrix, fm_m); - - INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, - octave_float_matrix, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, - octave_float_matrix, dbl_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_null_matrix, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_null_str, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_null_sq_str, null_assign); - - INSTALL_ASSIGNOP (op_add_eq, octave_float_matrix, octave_float_matrix, assign_add); - INSTALL_ASSIGNOP (op_sub_eq, octave_float_matrix, octave_float_matrix, assign_sub); - INSTALL_ASSIGNOP (op_el_mul_eq, octave_float_matrix, octave_float_matrix, assign_el_mul); - INSTALL_ASSIGNOP (op_el_div_eq, octave_float_matrix, octave_float_matrix, assign_el_div); - - INSTALL_CONVOP (octave_float_matrix, octave_matrix, float_matrix_to_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fm-fs.cc --- a/src/OPERATORS/op-fm-fs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,162 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-flt-re-mat.h" -#include "ov-float.h" -#include "ov-scalar.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix by scalar ops. - -DEFNDBINOP_OP (add, float_matrix, float_scalar, float_array, float_scalar, +) -DEFNDBINOP_OP (sub, float_matrix, float_scalar, float_array, float_scalar, -) -DEFNDBINOP_OP (mul, float_matrix, float_scalar, float_array, float_scalar, *) - -DEFBINOP (div, float_matrix, float) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_scalar&); - - float d = v2.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.float_array_value () / d); -} - -DEFBINOP_FN (pow, float_matrix, float_scalar, xpow) - -DEFBINOP (ldiv, float_matrix, float) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_scalar&); - - FloatMatrix m1 = v1.float_matrix_value (); - FloatMatrix m2 = v2.float_matrix_value (); - MatrixType typ = v1.matrix_type (); - - FloatMatrix ret = xleftdiv (m1, m2, typ); - - v1.matrix_type (typ); - return ret; -} - -DEFNDBINOP_FN (lt, float_matrix, float_scalar, float_array, - float_scalar, mx_el_lt) -DEFNDBINOP_FN (le, float_matrix, float_scalar, float_array, - float_scalar, mx_el_le) -DEFNDBINOP_FN (eq, float_matrix, float_scalar, float_array, - float_scalar, mx_el_eq) -DEFNDBINOP_FN (ge, float_matrix, float_scalar, float_array, - float_scalar, mx_el_ge) -DEFNDBINOP_FN (gt, float_matrix, float_scalar, float_array, - float_scalar, mx_el_gt) -DEFNDBINOP_FN (ne, float_matrix, float_scalar, float_array, - float_scalar, mx_el_ne) - -DEFNDBINOP_OP (el_mul, float_matrix, float_scalar, float_array, float_scalar, *) - -DEFBINOP (el_div, float_matrix, float) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_scalar&); - - float d = v2.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.float_array_value () / d); -} - -DEFNDBINOP_FN (el_pow, float_matrix, float_scalar, float_array, - float_scalar, elem_xpow) - -DEFBINOP (el_ldiv, float_matrix, float) -{ - CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_scalar&); - - return x_el_div (v2.float_value (), v1.float_array_value ()); -} - -DEFNDBINOP_FN (el_and, float_matrix, float_scalar, float_array, - float_scalar, mx_el_and) -DEFNDBINOP_FN (el_or, float_matrix, float_scalar, float_array, - float_scalar, mx_el_or) - -DEFNDCATOP_FN (fm_fs, float_matrix, float_scalar, float_array, - float_array, concat) - -DEFNDCATOP_FN (m_fs, matrix, float_scalar, float_array, float_array, concat) - -DEFNDCATOP_FN (fm_s, float_matrix, scalar, float_array, float_array, concat) - -DEFNDASSIGNOP_FN (assign, float_matrix, float_scalar, float_scalar, assign) -DEFNDASSIGNOP_FN (dbl_assign, matrix, float_scalar, scalar, assign) - -DEFNDASSIGNOP_OP (assign_add, float_matrix, float_scalar, float_scalar, +=) -DEFNDASSIGNOP_OP (assign_sub, float_matrix, float_scalar, float_scalar, -=) -DEFNDASSIGNOP_OP (assign_mul, float_matrix, float_scalar, float_scalar, *=) -DEFNDASSIGNOP_OP (assign_div, float_matrix, float_scalar, float_scalar, /=) - -void -install_fm_fs_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_matrix, octave_float_scalar, add); - INSTALL_BINOP (op_sub, octave_float_matrix, octave_float_scalar, sub); - INSTALL_BINOP (op_mul, octave_float_matrix, octave_float_scalar, mul); - INSTALL_BINOP (op_div, octave_float_matrix, octave_float_scalar, div); - INSTALL_BINOP (op_pow, octave_float_matrix, octave_float_scalar, pow); - INSTALL_BINOP (op_ldiv, octave_float_matrix, octave_float_scalar, ldiv); - INSTALL_BINOP (op_lt, octave_float_matrix, octave_float_scalar, lt); - INSTALL_BINOP (op_le, octave_float_matrix, octave_float_scalar, le); - INSTALL_BINOP (op_eq, octave_float_matrix, octave_float_scalar, eq); - INSTALL_BINOP (op_ge, octave_float_matrix, octave_float_scalar, ge); - INSTALL_BINOP (op_gt, octave_float_matrix, octave_float_scalar, gt); - INSTALL_BINOP (op_ne, octave_float_matrix, octave_float_scalar, ne); - INSTALL_BINOP (op_el_mul, octave_float_matrix, octave_float_scalar, el_mul); - INSTALL_BINOP (op_el_div, octave_float_matrix, octave_float_scalar, el_div); - INSTALL_BINOP (op_el_pow, octave_float_matrix, octave_float_scalar, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_matrix, octave_float_scalar, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_matrix, octave_float_scalar, el_and); - INSTALL_BINOP (op_el_or, octave_float_matrix, octave_float_scalar, el_or); - - INSTALL_CATOP (octave_float_matrix, octave_float_scalar, fm_fs); - INSTALL_CATOP (octave_matrix, octave_float_scalar, m_fs); - INSTALL_CATOP (octave_float_matrix, octave_scalar, fm_s); - - INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_float_scalar, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_float_scalar, dbl_assign); - - INSTALL_ASSIGNOP (op_add_eq, octave_float_matrix, octave_float_scalar, assign_add); - INSTALL_ASSIGNOP (op_sub_eq, octave_float_matrix, octave_float_scalar, assign_sub); - INSTALL_ASSIGNOP (op_mul_eq, octave_float_matrix, octave_float_scalar, assign_mul); - INSTALL_ASSIGNOP (op_div_eq, octave_float_matrix, octave_float_scalar, assign_div); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fm-pm.cc --- a/src/OPERATORS/op-fm-pm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define MINCLUDE "ov-flt-re-mat.h" - -#define LMATRIX float_matrix -#define RMATRIX perm_matrix - -#define LSHORT fm -#define RSHORT pm - -#define RIGHT - -#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fs-fcm.cc --- a/src/OPERATORS/op-fs-fcm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,178 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-fs-fcm.h" -#include "mx-fcm-fs.h" -#include "mx-fs-fcnda.h" -#include "mx-fcnda-fs.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// scalar by complex matrix ops. - -DEFNDBINOP_OP (add, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, +) -DEFNDBINOP_OP (sub, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, -) -DEFNDBINOP_OP (mul, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, *) - -DEFBINOP (div, float_scalar, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, - const octave_float_complex_matrix&); - - FloatMatrix m1 = v1.float_matrix_value (); - FloatComplexMatrix m2 = v2.float_complex_matrix_value (); - MatrixType typ = v2.matrix_type (); - - FloatComplexMatrix ret = xdiv (m1, m2, typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (pow, float_scalar, float_complex_matrix, xpow) - -DEFBINOP (ldiv, float_scalar, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, - const octave_float_complex_matrix&); - - float d = v1.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.float_complex_array_value () / d); -} - -DEFNDCMPLXCMPOP_FN (lt, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, mx_el_ne) - -DEFNDBINOP_OP (el_mul, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, *) -DEFNDBINOP_FN (el_div, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, x_el_div) -DEFNDBINOP_FN (el_pow, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, elem_xpow) - -DEFBINOP (el_ldiv, float_scalar, float_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, - const octave_float_complex_matrix&); - - float d = v1.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.float_complex_array_value () / d); -} - -DEFNDBINOP_FN (el_and, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, mx_el_and) -DEFNDBINOP_FN (el_or, float_scalar, float_complex_matrix, float_scalar, - float_complex_array, mx_el_or) - -DEFNDCATOP_FN (fs_fcm, float_scalar, float_complex_matrix, float_array, - float_complex_array, concat) - -DEFNDCATOP_FN (s_fcm, scalar, float_complex_matrix, float_array, - float_complex_array, concat) - -DEFNDCATOP_FN (fs_cm, float_scalar, complex_matrix, float_array, - float_complex_array, concat) - -DEFCONV (float_complex_matrix_conv, float_scalar, float_complex_matrix) -{ - CAST_CONV_ARG (const octave_float_scalar&); - - return new octave_float_complex_matrix (FloatComplexMatrix (v.float_matrix_value ())); -} - -void -install_fs_fcm_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_scalar, octave_float_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_float_scalar, octave_float_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_float_scalar, octave_float_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_float_scalar, octave_float_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_float_scalar, octave_float_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_float_scalar, - octave_float_complex_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_float_scalar, octave_float_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_float_scalar, octave_float_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_float_scalar, octave_float_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_float_scalar, octave_float_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_float_scalar, octave_float_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_float_scalar, octave_float_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_float_scalar, - octave_float_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_float_scalar, - octave_float_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_float_scalar, - octave_float_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_scalar, - octave_float_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_scalar, - octave_float_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_float_scalar, - octave_float_complex_matrix, el_or); - - INSTALL_CATOP (octave_float_scalar, octave_float_complex_matrix, fs_fcm); - INSTALL_CATOP (octave_scalar, octave_float_complex_matrix, s_fcm); - INSTALL_CATOP (octave_float_scalar, octave_complex_matrix, fs_cm); - - INSTALL_ASSIGNCONV (octave_float_scalar, octave_float_complex_matrix, - octave_float_complex_matrix); - INSTALL_ASSIGNCONV (octave_scalar, octave_float_complex_matrix, - octave_complex_matrix); - - INSTALL_WIDENOP (octave_float_scalar, octave_float_complex_matrix, - float_complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fs-fcs.cc --- a/src/OPERATORS/op-fs-fcs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,161 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-flt-complex.h" -#include "ov-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// scalar by complex scalar ops. - -DEFBINOP_OP (add, float_scalar, float_complex, +) -DEFBINOP_OP (sub, float_scalar, float_complex, -) -DEFBINOP_OP (mul, float_scalar, float_complex, *) - -DEFBINOP (div, float_scalar, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); - - FloatComplex d = v2.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v1.float_value () / d); -} - -DEFBINOP_FN (pow, float_scalar, float_complex, xpow) - -DEFBINOP (ldiv, float_scalar, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); - - float d = v1.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.float_complex_value () / d); -} - -DEFCMPLXCMPOP_OP (lt, float_scalar, float_complex, <) -DEFCMPLXCMPOP_OP (le, float_scalar, float_complex, <=) -DEFCMPLXCMPOP_OP (eq, float_scalar, float_complex, ==) -DEFCMPLXCMPOP_OP (ge, float_scalar, float_complex, >=) -DEFCMPLXCMPOP_OP (gt, float_scalar, float_complex, >) -DEFCMPLXCMPOP_OP (ne, float_scalar, float_complex, !=) - -DEFBINOP_OP (el_mul, float_scalar, float_complex, *) - -DEFBINOP (el_div, float_scalar, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); - - FloatComplex d = v2.float_complex_value (); - - if (d == static_cast(0.0)) - gripe_divide_by_zero (); - - return octave_value (v1.float_value () / d); -} - -DEFBINOP_FN (el_pow, float_scalar, float_complex, xpow) - -DEFBINOP (el_ldiv, float_scalar, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); - - float d = v1.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.float_complex_value () / d); -} - -DEFBINOP (el_and, float_scalar, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); - - return octave_value (v1.float_scalar_value () && (v2.float_complex_value () != static_cast(0.0))); -} - -DEFBINOP (el_or, float_scalar, float_complex) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); - - return octave_value (v1.float_scalar_value () || (v2.float_complex_value () != static_cast(0.0))); -} - -DEFNDCATOP_FN (fs_fcs, float_scalar, float_complex, float_array, - float_complex_array, concat) - -DEFNDCATOP_FN (s_fcs, scalar, float_complex, float_array, - float_complex_array, concat) - -DEFNDCATOP_FN (fs_cs, float_scalar, complex, float_array, - float_complex_array, concat) - -void -install_fs_fcs_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_scalar, octave_float_complex, add); - INSTALL_BINOP (op_sub, octave_float_scalar, octave_float_complex, sub); - INSTALL_BINOP (op_mul, octave_float_scalar, octave_float_complex, mul); - INSTALL_BINOP (op_div, octave_float_scalar, octave_float_complex, div); - INSTALL_BINOP (op_pow, octave_float_scalar, octave_float_complex, pow); - INSTALL_BINOP (op_ldiv, octave_float_scalar, octave_float_complex, ldiv); - INSTALL_BINOP (op_lt, octave_float_scalar, octave_float_complex, lt); - INSTALL_BINOP (op_le, octave_float_scalar, octave_float_complex, le); - INSTALL_BINOP (op_eq, octave_float_scalar, octave_float_complex, eq); - INSTALL_BINOP (op_ge, octave_float_scalar, octave_float_complex, ge); - INSTALL_BINOP (op_gt, octave_float_scalar, octave_float_complex, gt); - INSTALL_BINOP (op_ne, octave_float_scalar, octave_float_complex, ne); - INSTALL_BINOP (op_el_mul, octave_float_scalar, octave_float_complex, el_mul); - INSTALL_BINOP (op_el_div, octave_float_scalar, octave_float_complex, el_div); - INSTALL_BINOP (op_el_pow, octave_float_scalar, octave_float_complex, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_scalar, octave_float_complex, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_scalar, octave_float_complex, el_and); - INSTALL_BINOP (op_el_or, octave_float_scalar, octave_float_complex, el_or); - - INSTALL_CATOP (octave_float_scalar, octave_float_complex, fs_fcs); - INSTALL_CATOP (octave_scalar, octave_float_complex, s_fcs); - INSTALL_CATOP (octave_float_scalar, octave_complex, fs_cs); - - INSTALL_ASSIGNCONV (octave_float_scalar, octave_float_complex, - octave_float_complex_matrix); - INSTALL_ASSIGNCONV (octave_scalar, octave_float_complex, - octave_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fs-fm.cc --- a/src/OPERATORS/op-fs-fm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,154 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// scalar by matrix ops. - -DEFNDBINOP_OP (add, float_scalar, float_matrix, float_scalar, float_array, +) -DEFNDBINOP_OP (sub, float_scalar, float_matrix, float_scalar, float_array, -) -DEFNDBINOP_OP (mul, float_scalar, float_matrix, float_scalar, float_array, *) - -DEFBINOP (div, float_scalar, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_matrix&); - - FloatMatrix m1 = v1.float_matrix_value (); - FloatMatrix m2 = v2.float_matrix_value (); - MatrixType typ = v2.matrix_type (); - - FloatMatrix ret = xdiv (m1, m2, typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (pow, float_scalar, float_matrix, xpow) - -DEFBINOP (ldiv, float_scalar, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_matrix&); - - float d = v1.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.float_array_value () / d); -} - -DEFNDBINOP_FN (lt, float_scalar, float_matrix, float_scalar, - float_array, mx_el_lt) -DEFNDBINOP_FN (le, float_scalar, float_matrix, float_scalar, - float_array, mx_el_le) -DEFNDBINOP_FN (eq, float_scalar, float_matrix, float_scalar, - float_array, mx_el_eq) -DEFNDBINOP_FN (ge, float_scalar, float_matrix, float_scalar, - float_array, mx_el_ge) -DEFNDBINOP_FN (gt, float_scalar, float_matrix, float_scalar, -float_array, mx_el_gt) -DEFNDBINOP_FN (ne, float_scalar, float_matrix, float_scalar, - float_array, mx_el_ne) - -DEFNDBINOP_OP (el_mul, float_scalar, float_matrix, float_scalar, - float_array, *) -DEFNDBINOP_FN (el_div, float_scalar, float_matrix, float_scalar, - float_array, x_el_div) -DEFNDBINOP_FN (el_pow, float_scalar, float_matrix, float_scalar, - float_array, elem_xpow) - -DEFBINOP (el_ldiv, float_scalar, float_matrix) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_matrix&); - - float d = v1.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.float_array_value () / d); -} - -DEFNDBINOP_FN (el_and, float_scalar, float_matrix, float_scalar, - float_array, mx_el_and) -DEFNDBINOP_FN (el_or, float_scalar, float_matrix, float_scalar, - float_array, mx_el_or) - -DEFNDCATOP_FN (fs_fm, float_scalar, float_matrix, float_array, - float_array, concat) - -DEFNDCATOP_FN (s_fm, scalar, float_matrix, float_array, float_array, concat) - -DEFNDCATOP_FN (fs_m, float_scalar, matrix, float_array, float_array, concat) - -DEFCONV (matrix_conv, float_scalar, float_matrix) -{ - CAST_CONV_ARG (const octave_float_scalar&); - - return new octave_float_matrix (v.float_matrix_value ()); -} - -void -install_fs_fm_ops (void) -{ - INSTALL_BINOP (op_add, octave_float_scalar, octave_float_matrix, add); - INSTALL_BINOP (op_sub, octave_float_scalar, octave_float_matrix, sub); - INSTALL_BINOP (op_mul, octave_float_scalar, octave_float_matrix, mul); - INSTALL_BINOP (op_div, octave_float_scalar, octave_float_matrix, div); - INSTALL_BINOP (op_pow, octave_float_scalar, octave_float_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_float_scalar, octave_float_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_float_scalar, octave_float_matrix, lt); - INSTALL_BINOP (op_le, octave_float_scalar, octave_float_matrix, le); - INSTALL_BINOP (op_eq, octave_float_scalar, octave_float_matrix, eq); - INSTALL_BINOP (op_ge, octave_float_scalar, octave_float_matrix, ge); - INSTALL_BINOP (op_gt, octave_float_scalar, octave_float_matrix, gt); - INSTALL_BINOP (op_ne, octave_float_scalar, octave_float_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_float_scalar, octave_float_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_float_scalar, octave_float_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_float_scalar, octave_float_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_scalar, octave_float_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_scalar, octave_float_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_float_scalar, octave_float_matrix, el_or); - - INSTALL_CATOP (octave_float_scalar, octave_float_matrix, fs_fm); - INSTALL_CATOP (octave_scalar, octave_float_matrix, s_fm); - INSTALL_CATOP (octave_float_scalar, octave_matrix, fs_m); - - INSTALL_ASSIGNCONV (octave_float_scalar, octave_float_matrix, octave_float_matrix); - INSTALL_ASSIGNCONV (octave_scalar, octave_float_matrix, octave_matrix); - - INSTALL_WIDENOP (octave_float_scalar, octave_float_matrix, matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-fs-fs.cc --- a/src/OPERATORS/op-fs-fs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,184 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "Array-util.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-flt-re-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// scalar unary ops. - -DEFUNOP (not, float_scalar) -{ - CAST_UNOP_ARG (const octave_float_scalar&); - float x = v.float_value (); - if (xisnan (x)) - gripe_nan_to_logical_conversion (); - return octave_value (x == 0.0f); -} - -DEFUNOP_OP (uplus, float_scalar, /* no-op */) -DEFUNOP_OP (uminus, float_scalar, -) -DEFUNOP_OP (transpose, float_scalar, /* no-op */) -DEFUNOP_OP (hermitian, float_scalar, /* no-op */) - -DEFNCUNOP_METHOD (incr, float_scalar, increment) -DEFNCUNOP_METHOD (decr, float_scalar, decrement) - -// float by float ops. - -DEFBINOP_OP (add, float_scalar, float_scalar, +) -DEFBINOP_OP (sub, float_scalar, float_scalar, -) -DEFBINOP_OP (mul, float_scalar, float_scalar, *) - -DEFBINOP (div, float_scalar, float_scalar) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_scalar&); - - float d = v2.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.float_value () / d); -} - -DEFBINOP_FN (pow, float_scalar, float_scalar, xpow) - -DEFBINOP (ldiv, float_scalar, float_scalar) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_scalar&); - - float d = v1.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.float_value () / d); -} - -DEFBINOP_OP (lt, float_scalar, float_scalar, <) -DEFBINOP_OP (le, float_scalar, float_scalar, <=) -DEFBINOP_OP (eq, float_scalar, float_scalar, ==) -DEFBINOP_OP (ge, float_scalar, float_scalar, >=) -DEFBINOP_OP (gt, float_scalar, float_scalar, >) -DEFBINOP_OP (ne, float_scalar, float_scalar, !=) - -DEFBINOP_OP (el_mul, float_scalar, float_scalar, *) - -DEFBINOP (el_div, float_scalar, float_scalar) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_scalar&); - - float d = v2.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.float_value () / d); -} - -DEFBINOP_FN (el_pow, float_scalar, float_scalar, xpow) - -DEFBINOP (el_ldiv, float_scalar, float_scalar) -{ - CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_scalar&); - - float d = v1.float_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.float_value () / d); -} - -DEFSCALARBOOLOP_OP (el_and, float_scalar, float_scalar, &&) -DEFSCALARBOOLOP_OP (el_or, float_scalar, float_scalar, ||) - -DEFNDCATOP_FN (fs_fs, float_scalar, float_scalar, float_array, float_array, concat) -DEFNDCATOP_FN (s_fs, scalar, float_scalar, float_array, float_array, concat) -DEFNDCATOP_FN (fs_s, float_scalar, scalar, float_array, float_array, concat) - -CONVDECL (float_to_scalar) -{ - CAST_CONV_ARG (const octave_float_scalar&); - - return new octave_matrix (Matrix (1, 1, static_cast(v.float_value ()))); -} - -void -install_fs_fs_ops (void) -{ - INSTALL_UNOP (op_not, octave_float_scalar, not); - INSTALL_UNOP (op_uplus, octave_float_scalar, uplus); - INSTALL_UNOP (op_uminus, octave_float_scalar, uminus); - INSTALL_UNOP (op_transpose, octave_float_scalar, transpose); - INSTALL_UNOP (op_hermitian, octave_float_scalar, hermitian); - - INSTALL_NCUNOP (op_incr, octave_float_scalar, incr); - INSTALL_NCUNOP (op_decr, octave_float_scalar, decr); - - INSTALL_BINOP (op_add, octave_float_scalar, octave_float_scalar, add); - INSTALL_BINOP (op_sub, octave_float_scalar, octave_float_scalar, sub); - INSTALL_BINOP (op_mul, octave_float_scalar, octave_float_scalar, mul); - INSTALL_BINOP (op_div, octave_float_scalar, octave_float_scalar, div); - INSTALL_BINOP (op_pow, octave_float_scalar, octave_float_scalar, pow); - INSTALL_BINOP (op_ldiv, octave_float_scalar, octave_float_scalar, ldiv); - INSTALL_BINOP (op_lt, octave_float_scalar, octave_float_scalar, lt); - INSTALL_BINOP (op_le, octave_float_scalar, octave_float_scalar, le); - INSTALL_BINOP (op_eq, octave_float_scalar, octave_float_scalar, eq); - INSTALL_BINOP (op_ge, octave_float_scalar, octave_float_scalar, ge); - INSTALL_BINOP (op_gt, octave_float_scalar, octave_float_scalar, gt); - INSTALL_BINOP (op_ne, octave_float_scalar, octave_float_scalar, ne); - INSTALL_BINOP (op_el_mul, octave_float_scalar, octave_float_scalar, el_mul); - INSTALL_BINOP (op_el_div, octave_float_scalar, octave_float_scalar, el_div); - INSTALL_BINOP (op_el_pow, octave_float_scalar, octave_float_scalar, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_float_scalar, octave_float_scalar, el_ldiv); - INSTALL_BINOP (op_el_and, octave_float_scalar, octave_float_scalar, el_and); - INSTALL_BINOP (op_el_or, octave_float_scalar, octave_float_scalar, el_or); - - INSTALL_CATOP (octave_float_scalar, octave_float_scalar, fs_fs); - INSTALL_CATOP (octave_scalar, octave_float_scalar, s_fs); - INSTALL_CATOP (octave_float_scalar, octave_scalar, fs_s); - - INSTALL_ASSIGNCONV (octave_float_scalar, octave_float_scalar, octave_float_matrix); - INSTALL_ASSIGNCONV (octave_scalar, octave_float_scalar, octave_matrix); - - INSTALL_ASSIGNCONV (octave_float_scalar, octave_null_matrix, octave_float_matrix); - INSTALL_ASSIGNCONV (octave_float_scalar, octave_null_str, octave_float_matrix); - INSTALL_ASSIGNCONV (octave_float_scalar, octave_null_sq_str, octave_float_matrix); - - INSTALL_CONVOP (octave_float_scalar, octave_matrix, float_to_scalar); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-i16-i16.cc --- a/src/OPERATORS/op-i16-i16.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-i16nda-i8.h" -#include "mx-i16nda-ui8.h" -#include "mx-i16nda-ui16.h" -#include "mx-i16nda-i32.h" -#include "mx-i16nda-ui32.h" -#include "mx-i16nda-i64.h" -#include "mx-i16nda-ui64.h" - -#include "mx-i16nda-i8nda.h" -#include "mx-i16nda-ui8nda.h" -#include "mx-i16nda-ui16nda.h" -#include "mx-i16nda-i32nda.h" -#include "mx-i16nda-ui32nda.h" -#include "mx-i16nda-i64nda.h" -#include "mx-i16nda-ui64nda.h" - -#include "mx-i16-i8nda.h" -#include "mx-i16-ui8nda.h" -#include "mx-i16-ui16nda.h" -#include "mx-i16-i32nda.h" -#include "mx-i16-ui32nda.h" -#include "mx-i16-i64nda.h" -#include "mx-i16-ui64nda.h" - -#include "mx-i16nda-s.h" -#include "mx-s-i16nda.h" - -#include "mx-i16nda-nda.h" -#include "mx-nda-i16nda.h" - -#include "mx-i16-nda.h" -#include "mx-nda-i16.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-int8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-uint8.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -#include "op-int.h" - -OCTAVE_INT_OPS (int16) - -OCTAVE_MS_INT_ASSIGN_OPS (mi8, int16_, int8_, int8_) -OCTAVE_MS_INT_ASSIGN_OPS (mui8, int16_, uint8_, uint8_) -OCTAVE_MS_INT_ASSIGN_OPS (mui16, int16_, uint16_, uint16_) -OCTAVE_MS_INT_ASSIGN_OPS (mi32, int16_, int32_, int32_) -OCTAVE_MS_INT_ASSIGN_OPS (mui32, int16_, uint32_, uint32_) -OCTAVE_MS_INT_ASSIGN_OPS (mi64, int16_, int64_, int64_) -OCTAVE_MS_INT_ASSIGN_OPS (mui64, int16_, uint64_, uint64_) - -OCTAVE_MM_INT_ASSIGN_OPS (mmi8, int16_, int8_, int8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui8, int16_, uint8_, uint8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui16, int16_, uint16_, uint16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi32, int16_, int32_, int32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui32, int16_, uint32_, uint32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi64, int16_, int64_, int64_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui64, int16_, uint64_, uint64_) - -OCTAVE_MIXED_INT_CMP_OPS (int16, int8) -OCTAVE_MIXED_INT_CMP_OPS (int16, uint8) -OCTAVE_MIXED_INT_CMP_OPS (int16, uint16) -OCTAVE_MIXED_INT_CMP_OPS (int16, int32) -OCTAVE_MIXED_INT_CMP_OPS (int16, uint32) -OCTAVE_MIXED_INT_CMP_OPS (int16, int64) -OCTAVE_MIXED_INT_CMP_OPS (int16, uint64) - -void -install_i16_i16_ops (void) -{ - OCTAVE_INSTALL_INT_OPS (int16); - - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, int16_, int8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, int16_, uint8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, int16_, uint16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, int16_, int32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, int16_, uint32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, int16_, int64_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, int16_, uint64_); - - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, int16_, int8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, int16_, uint8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, int16_, uint16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, int16_, int32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, int16_, uint32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, int16_, int64_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, int16_, uint64_); - - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, int8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, uint8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, uint16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, int32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, uint32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, int64); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, uint64); - - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, int8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, uint8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, uint16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, int32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, uint32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, int64); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, uint64); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-i32-i32.cc --- a/src/OPERATORS/op-i32-i32.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-i32nda-i8.h" -#include "mx-i32nda-ui8.h" -#include "mx-i32nda-i16.h" -#include "mx-i32nda-ui16.h" -#include "mx-i32nda-ui32.h" -#include "mx-i32nda-i64.h" -#include "mx-i32nda-ui64.h" - -#include "mx-i32nda-i8nda.h" -#include "mx-i32nda-ui8nda.h" -#include "mx-i32nda-i16nda.h" -#include "mx-i32nda-ui16nda.h" -#include "mx-i32nda-ui32nda.h" -#include "mx-i32nda-i64nda.h" -#include "mx-i32nda-ui64nda.h" - -#include "mx-i32-i8nda.h" -#include "mx-i32-ui8nda.h" -#include "mx-i32-i16nda.h" -#include "mx-i32-ui16nda.h" -#include "mx-i32-ui32nda.h" -#include "mx-i32-i64nda.h" -#include "mx-i32-ui64nda.h" - -#include "mx-i32nda-s.h" -#include "mx-s-i32nda.h" - -#include "mx-i32nda-nda.h" -#include "mx-nda-i32nda.h" - -#include "mx-i32-nda.h" -#include "mx-nda-i32.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-int8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-uint8.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -#include "op-int.h" - -OCTAVE_INT_OPS (int32) - -OCTAVE_MS_INT_ASSIGN_OPS (mi8, int32_, int8_, int8_) -OCTAVE_MS_INT_ASSIGN_OPS (mui8, int32_, uint8_, uint8_) -OCTAVE_MS_INT_ASSIGN_OPS (mi16, int32_, int16_, int16_) -OCTAVE_MS_INT_ASSIGN_OPS (mui16, int32_, uint16_, uint16_) -OCTAVE_MS_INT_ASSIGN_OPS (mui32, int32_, uint32_, uint32_) -OCTAVE_MS_INT_ASSIGN_OPS (mi64, int32_, int64_, int64_) -OCTAVE_MS_INT_ASSIGN_OPS (mui64, int32_, uint64_, uint64_) - -OCTAVE_MM_INT_ASSIGN_OPS (mmi8, int32_, int8_, int8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui8, int32_, uint8_, uint8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi16, int32_, int16_, int16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui16, int32_, uint16_, uint16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui32, int32_, uint32_, uint32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi64, int32_, int64_, int64_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui64, int32_, uint64_, uint64_) - -OCTAVE_MIXED_INT_CMP_OPS (int32, int8) -OCTAVE_MIXED_INT_CMP_OPS (int32, uint8) -OCTAVE_MIXED_INT_CMP_OPS (int32, int16) -OCTAVE_MIXED_INT_CMP_OPS (int32, uint16) -OCTAVE_MIXED_INT_CMP_OPS (int32, uint32) -OCTAVE_MIXED_INT_CMP_OPS (int32, int64) -OCTAVE_MIXED_INT_CMP_OPS (int32, uint64) - -void -install_i32_i32_ops (void) -{ - OCTAVE_INSTALL_INT_OPS (int32); - - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, int32_, int8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, int32_, uint8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, int32_, int16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, int32_, uint16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, int32_, uint32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, int32_, int64_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, int32_, uint64_); - - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, int32_, int8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, int32_, uint8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, int32_, int16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, int32_, uint16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, int32_, uint32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, int32_, int64_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, int32_, uint64_); - - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, int8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, uint8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, int16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, uint16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, uint32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, int64); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, uint64); - - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, int8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, uint8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, int16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, uint16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, uint32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, int64); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, uint64); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-i64-i64.cc --- a/src/OPERATORS/op-i64-i64.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-i64nda-i8.h" -#include "mx-i64nda-ui8.h" -#include "mx-i64nda-i16.h" -#include "mx-i64nda-ui16.h" -#include "mx-i64nda-i32.h" -#include "mx-i64nda-ui32.h" -#include "mx-i64nda-ui64.h" - -#include "mx-i64nda-i8nda.h" -#include "mx-i64nda-ui8nda.h" -#include "mx-i64nda-i16nda.h" -#include "mx-i64nda-ui16nda.h" -#include "mx-i64nda-i32nda.h" -#include "mx-i64nda-ui32nda.h" -#include "mx-i64nda-ui64nda.h" - -#include "mx-i64-i8nda.h" -#include "mx-i64-ui8nda.h" -#include "mx-i64-i16nda.h" -#include "mx-i64-ui16nda.h" -#include "mx-i64-i32nda.h" -#include "mx-i64-ui32nda.h" -#include "mx-i64-ui64nda.h" - -#include "mx-i64nda-s.h" -#include "mx-s-i64nda.h" - -#include "mx-i64nda-nda.h" -#include "mx-nda-i64nda.h" - -#include "mx-i64-nda.h" -#include "mx-nda-i64.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-int8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-uint8.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -#include "op-int.h" - -OCTAVE_INT_OPS (int64) - -OCTAVE_MS_INT_ASSIGN_OPS (mi8, int64_, int8_, int8_) -OCTAVE_MS_INT_ASSIGN_OPS (mui8, int64_, uint8_, uint8_) -OCTAVE_MS_INT_ASSIGN_OPS (mi16, int64_, int16_, int16_) -OCTAVE_MS_INT_ASSIGN_OPS (mui16, int64_, uint16_, uint16_) -OCTAVE_MS_INT_ASSIGN_OPS (mi32, int64_, int32_, int32_) -OCTAVE_MS_INT_ASSIGN_OPS (mui32, int64_, uint32_, uint32_) -OCTAVE_MS_INT_ASSIGN_OPS (mui64, int64_, uint64_, uint64_) - -OCTAVE_MM_INT_ASSIGN_OPS (mmi8, int64_, int8_, int8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui8, int64_, uint8_, uint8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi16, int64_, int16_, int16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui16, int64_, uint16_, uint16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi32, int64_, int32_, int32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui32, int64_, uint32_, uint32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui64, int64_, uint64_, uint64_) - -OCTAVE_MIXED_INT_CMP_OPS (int64, int8) -OCTAVE_MIXED_INT_CMP_OPS (int64, uint8) -OCTAVE_MIXED_INT_CMP_OPS (int64, int16) -OCTAVE_MIXED_INT_CMP_OPS (int64, uint16) -OCTAVE_MIXED_INT_CMP_OPS (int64, int32) -OCTAVE_MIXED_INT_CMP_OPS (int64, uint32) -OCTAVE_MIXED_INT_CMP_OPS (int64, uint64) - -void -install_i64_i64_ops (void) -{ - OCTAVE_INSTALL_INT_OPS (int64); - - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, int64_, int8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, int64_, uint8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, int64_, int16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, int64_, uint16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, int64_, int32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, int64_, uint32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, int64_, uint64_); - - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, int64_, int8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, int64_, uint8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, int64_, int16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, int64_, uint16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, int64_, int32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, int64_, uint32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, int64_, uint64_); - - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, int8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, uint8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, int16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, uint16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, int32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, uint32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, uint64); - - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, int8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, uint8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, int16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, uint16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, int32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, uint32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, uint64); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-i8-i8.cc --- a/src/OPERATORS/op-i8-i8.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-i8nda-ui8.h" -#include "mx-i8nda-i16.h" -#include "mx-i8nda-ui16.h" -#include "mx-i8nda-i32.h" -#include "mx-i8nda-ui32.h" -#include "mx-i8nda-i64.h" -#include "mx-i8nda-ui64.h" - -#include "mx-i8nda-ui8nda.h" -#include "mx-i8nda-i16nda.h" -#include "mx-i8nda-ui16nda.h" -#include "mx-i8nda-i32nda.h" -#include "mx-i8nda-ui32nda.h" -#include "mx-i8nda-i64nda.h" -#include "mx-i8nda-ui64nda.h" - -#include "mx-i8-ui8nda.h" -#include "mx-i8-i16nda.h" -#include "mx-i8-ui16nda.h" -#include "mx-i8-i32nda.h" -#include "mx-i8-ui32nda.h" -#include "mx-i8-i64nda.h" -#include "mx-i8-ui64nda.h" - -#include "mx-i8nda-s.h" -#include "mx-s-i8nda.h" - -#include "mx-i8nda-nda.h" -#include "mx-nda-i8nda.h" - -#include "mx-i8-nda.h" -#include "mx-nda-i8.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-int8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-uint8.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -#include "op-int.h" - -OCTAVE_INT_OPS (int8) - -OCTAVE_MS_INT_ASSIGN_OPS (mui8, int8_, uint8_, uint8_) -OCTAVE_MS_INT_ASSIGN_OPS (mi16, int8_, int16_, int16_) -OCTAVE_MS_INT_ASSIGN_OPS (mui16, int8_, uint16_, uint16_) -OCTAVE_MS_INT_ASSIGN_OPS (mi32, int8_, int32_, int32_) -OCTAVE_MS_INT_ASSIGN_OPS (mui32, int8_, uint32_, uint32_) -OCTAVE_MS_INT_ASSIGN_OPS (mi64, int8_, int64_, int64_) -OCTAVE_MS_INT_ASSIGN_OPS (mui64, int8_, uint64_, uint64_) - -OCTAVE_MM_INT_ASSIGN_OPS (mmui8, int8_, uint8_, uint8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi16, int8_, int16_, int16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui16, int8_, uint16_, uint16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi32, int8_, int32_, int32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui32, int8_, uint32_, uint32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi64, int8_, int64_, int64_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui64, int8_, uint64_, uint64_) - -OCTAVE_MIXED_INT_CMP_OPS (int8, uint8) -OCTAVE_MIXED_INT_CMP_OPS (int8, int16) -OCTAVE_MIXED_INT_CMP_OPS (int8, uint16) -OCTAVE_MIXED_INT_CMP_OPS (int8, int32) -OCTAVE_MIXED_INT_CMP_OPS (int8, uint32) -OCTAVE_MIXED_INT_CMP_OPS (int8, int64) -OCTAVE_MIXED_INT_CMP_OPS (int8, uint64) - -void -install_i8_i8_ops (void) -{ - OCTAVE_INSTALL_INT_OPS (int8); - - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, int8_, uint8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, int8_, int16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, int8_, uint16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, int8_, int32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, int8_, uint32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, int8_, int64_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, int8_, uint64_); - - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, int8_, uint8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, int8_, int16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, int8_, uint16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, int8_, int32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, int8_, uint32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, int8_, int64_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, int8_, uint64_); - - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, uint8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, int16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, uint16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, int32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, uint32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, int64); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, uint64); - - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, uint8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, int16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, uint16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, int32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, uint32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, int64); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, uint64); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-int-concat.cc --- a/src/OPERATORS/op-int-concat.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,318 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int8.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-uint8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-range.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-str-mat.h" -#include "ov-typeinfo.h" -#include "op-int.h" -#include "ops.h" - -// Concatentation of mixed integer types: - -OCTAVE_CONCAT_FN2 (int8, int16) -OCTAVE_CONCAT_FN2 (int8, int32) -OCTAVE_CONCAT_FN2 (int8, int64) - -OCTAVE_CONCAT_FN2 (int8, uint8) -OCTAVE_CONCAT_FN2 (int8, uint16) -OCTAVE_CONCAT_FN2 (int8, uint32) -OCTAVE_CONCAT_FN2 (int8, uint64) - -OCTAVE_CONCAT_FN2 (int16, int8) -OCTAVE_CONCAT_FN2 (int16, int32) -OCTAVE_CONCAT_FN2 (int16, int64) - -OCTAVE_CONCAT_FN2 (int16, uint8) -OCTAVE_CONCAT_FN2 (int16, uint16) -OCTAVE_CONCAT_FN2 (int16, uint32) -OCTAVE_CONCAT_FN2 (int16, uint64) - -OCTAVE_CONCAT_FN2 (int32, int8) -OCTAVE_CONCAT_FN2 (int32, int16) -OCTAVE_CONCAT_FN2 (int32, int64) - -OCTAVE_CONCAT_FN2 (int32, uint8) -OCTAVE_CONCAT_FN2 (int32, uint16) -OCTAVE_CONCAT_FN2 (int32, uint32) -OCTAVE_CONCAT_FN2 (int32, uint64) - -OCTAVE_CONCAT_FN2 (int64, int8) -OCTAVE_CONCAT_FN2 (int64, int16) -OCTAVE_CONCAT_FN2 (int64, int32) - -OCTAVE_CONCAT_FN2 (int64, uint8) -OCTAVE_CONCAT_FN2 (int64, uint16) -OCTAVE_CONCAT_FN2 (int64, uint32) -OCTAVE_CONCAT_FN2 (int64, uint64) - -OCTAVE_CONCAT_FN2 (uint8, int8) -OCTAVE_CONCAT_FN2 (uint8, int16) -OCTAVE_CONCAT_FN2 (uint8, int32) -OCTAVE_CONCAT_FN2 (uint8, int64) - -OCTAVE_CONCAT_FN2 (uint8, uint16) -OCTAVE_CONCAT_FN2 (uint8, uint32) -OCTAVE_CONCAT_FN2 (uint8, uint64) - -OCTAVE_CONCAT_FN2 (uint16, int8) -OCTAVE_CONCAT_FN2 (uint16, int16) -OCTAVE_CONCAT_FN2 (uint16, int32) -OCTAVE_CONCAT_FN2 (uint16, int64) - -OCTAVE_CONCAT_FN2 (uint16, uint8) -OCTAVE_CONCAT_FN2 (uint16, uint32) -OCTAVE_CONCAT_FN2 (uint16, uint64) - -OCTAVE_CONCAT_FN2 (uint32, int8) -OCTAVE_CONCAT_FN2 (uint32, int16) -OCTAVE_CONCAT_FN2 (uint32, int32) -OCTAVE_CONCAT_FN2 (uint32, int64) - -OCTAVE_CONCAT_FN2 (uint32, uint8) -OCTAVE_CONCAT_FN2 (uint32, uint16) -OCTAVE_CONCAT_FN2 (uint32, uint64) - -OCTAVE_CONCAT_FN2 (uint64, int8) -OCTAVE_CONCAT_FN2 (uint64, int16) -OCTAVE_CONCAT_FN2 (uint64, int32) -OCTAVE_CONCAT_FN2 (uint64, int64) - -OCTAVE_CONCAT_FN2 (uint64, uint8) -OCTAVE_CONCAT_FN2 (uint64, uint16) -OCTAVE_CONCAT_FN2 (uint64, uint32) - -OCTAVE_INT_DOUBLE_CONCAT_FN (int8) -OCTAVE_INT_DOUBLE_CONCAT_FN (int16) -OCTAVE_INT_DOUBLE_CONCAT_FN (int32) -OCTAVE_INT_DOUBLE_CONCAT_FN (int64) - -OCTAVE_INT_DOUBLE_CONCAT_FN (uint8) -OCTAVE_INT_DOUBLE_CONCAT_FN (uint16) -OCTAVE_INT_DOUBLE_CONCAT_FN (uint32) -OCTAVE_INT_DOUBLE_CONCAT_FN (uint64) - -OCTAVE_DOUBLE_INT_CONCAT_FN (int8) -OCTAVE_DOUBLE_INT_CONCAT_FN (int16) -OCTAVE_DOUBLE_INT_CONCAT_FN (int32) -OCTAVE_DOUBLE_INT_CONCAT_FN (int64) - -OCTAVE_DOUBLE_INT_CONCAT_FN (uint8) -OCTAVE_DOUBLE_INT_CONCAT_FN (uint16) -OCTAVE_DOUBLE_INT_CONCAT_FN (uint32) -OCTAVE_DOUBLE_INT_CONCAT_FN (uint64) - -OCTAVE_INT_FLOAT_CONCAT_FN (int8) -OCTAVE_INT_FLOAT_CONCAT_FN (int16) -OCTAVE_INT_FLOAT_CONCAT_FN (int32) -OCTAVE_INT_FLOAT_CONCAT_FN (int64) - -OCTAVE_INT_FLOAT_CONCAT_FN (uint8) -OCTAVE_INT_FLOAT_CONCAT_FN (uint16) -OCTAVE_INT_FLOAT_CONCAT_FN (uint32) -OCTAVE_INT_FLOAT_CONCAT_FN (uint64) - -OCTAVE_FLOAT_INT_CONCAT_FN (int8) -OCTAVE_FLOAT_INT_CONCAT_FN (int16) -OCTAVE_FLOAT_INT_CONCAT_FN (int32) -OCTAVE_FLOAT_INT_CONCAT_FN (int64) - -OCTAVE_FLOAT_INT_CONCAT_FN (uint8) -OCTAVE_FLOAT_INT_CONCAT_FN (uint16) -OCTAVE_FLOAT_INT_CONCAT_FN (uint32) -OCTAVE_FLOAT_INT_CONCAT_FN (uint64) - -OCTAVE_INT_CHAR_CONCAT_FN (int8) -OCTAVE_INT_CHAR_CONCAT_FN (int16) -OCTAVE_INT_CHAR_CONCAT_FN (int32) -OCTAVE_INT_CHAR_CONCAT_FN (int64) - -OCTAVE_INT_CHAR_CONCAT_FN (uint8) -OCTAVE_INT_CHAR_CONCAT_FN (uint16) -OCTAVE_INT_CHAR_CONCAT_FN (uint32) -OCTAVE_INT_CHAR_CONCAT_FN (uint64) - -OCTAVE_CHAR_INT_CONCAT_FN (int8) -OCTAVE_CHAR_INT_CONCAT_FN (int16) -OCTAVE_CHAR_INT_CONCAT_FN (int32) -OCTAVE_CHAR_INT_CONCAT_FN (int64) - -OCTAVE_CHAR_INT_CONCAT_FN (uint8) -OCTAVE_CHAR_INT_CONCAT_FN (uint16) -OCTAVE_CHAR_INT_CONCAT_FN (uint32) -OCTAVE_CHAR_INT_CONCAT_FN (uint64) - -void -install_int_concat_ops (void) -{ - OCTAVE_INSTALL_CONCAT_FN2 (int8, int16); - OCTAVE_INSTALL_CONCAT_FN2 (int8, int32); - OCTAVE_INSTALL_CONCAT_FN2 (int8, int64); - - OCTAVE_INSTALL_CONCAT_FN2 (int8, uint8); - OCTAVE_INSTALL_CONCAT_FN2 (int8, uint16); - OCTAVE_INSTALL_CONCAT_FN2 (int8, uint32); - OCTAVE_INSTALL_CONCAT_FN2 (int8, uint64); - - OCTAVE_INSTALL_CONCAT_FN2 (int16, int8); - OCTAVE_INSTALL_CONCAT_FN2 (int16, int32); - OCTAVE_INSTALL_CONCAT_FN2 (int16, int64); - - OCTAVE_INSTALL_CONCAT_FN2 (int16, uint8); - OCTAVE_INSTALL_CONCAT_FN2 (int16, uint16); - OCTAVE_INSTALL_CONCAT_FN2 (int16, uint32); - OCTAVE_INSTALL_CONCAT_FN2 (int16, uint64); - - OCTAVE_INSTALL_CONCAT_FN2 (int32, int8); - OCTAVE_INSTALL_CONCAT_FN2 (int32, int16); - OCTAVE_INSTALL_CONCAT_FN2 (int32, int64); - - OCTAVE_INSTALL_CONCAT_FN2 (int32, uint8); - OCTAVE_INSTALL_CONCAT_FN2 (int32, uint16); - OCTAVE_INSTALL_CONCAT_FN2 (int32, uint32); - OCTAVE_INSTALL_CONCAT_FN2 (int32, uint64); - - OCTAVE_INSTALL_CONCAT_FN2 (int64, int8); - OCTAVE_INSTALL_CONCAT_FN2 (int64, int16); - OCTAVE_INSTALL_CONCAT_FN2 (int64, int32); - - OCTAVE_INSTALL_CONCAT_FN2 (int64, uint8); - OCTAVE_INSTALL_CONCAT_FN2 (int64, uint16); - OCTAVE_INSTALL_CONCAT_FN2 (int64, uint32); - OCTAVE_INSTALL_CONCAT_FN2 (int64, uint64); - - OCTAVE_INSTALL_CONCAT_FN2 (uint8, int8); - OCTAVE_INSTALL_CONCAT_FN2 (uint8, int16); - OCTAVE_INSTALL_CONCAT_FN2 (uint8, int32); - OCTAVE_INSTALL_CONCAT_FN2 (uint8, int64); - - OCTAVE_INSTALL_CONCAT_FN2 (uint8, uint16); - OCTAVE_INSTALL_CONCAT_FN2 (uint8, uint32); - OCTAVE_INSTALL_CONCAT_FN2 (uint8, uint64); - - OCTAVE_INSTALL_CONCAT_FN2 (uint16, int8); - OCTAVE_INSTALL_CONCAT_FN2 (uint16, int16); - OCTAVE_INSTALL_CONCAT_FN2 (uint16, int32); - OCTAVE_INSTALL_CONCAT_FN2 (uint16, int64); - - OCTAVE_INSTALL_CONCAT_FN2 (uint16, uint8); - OCTAVE_INSTALL_CONCAT_FN2 (uint16, uint32); - OCTAVE_INSTALL_CONCAT_FN2 (uint16, uint64); - - OCTAVE_INSTALL_CONCAT_FN2 (uint32, int8); - OCTAVE_INSTALL_CONCAT_FN2 (uint32, int16); - OCTAVE_INSTALL_CONCAT_FN2 (uint32, int32); - OCTAVE_INSTALL_CONCAT_FN2 (uint32, int64); - - OCTAVE_INSTALL_CONCAT_FN2 (uint32, uint8); - OCTAVE_INSTALL_CONCAT_FN2 (uint32, uint16); - OCTAVE_INSTALL_CONCAT_FN2 (uint32, uint64); - - OCTAVE_INSTALL_CONCAT_FN2 (uint64, int8); - OCTAVE_INSTALL_CONCAT_FN2 (uint64, int16); - OCTAVE_INSTALL_CONCAT_FN2 (uint64, int32); - OCTAVE_INSTALL_CONCAT_FN2 (uint64, int64); - - OCTAVE_INSTALL_CONCAT_FN2 (uint64, uint8); - OCTAVE_INSTALL_CONCAT_FN2 (uint64, uint16); - OCTAVE_INSTALL_CONCAT_FN2 (uint64, uint32); - - OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (int8); - OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (int16); - OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (int32); - OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (int64); - - OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (uint8); - OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (uint16); - OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (uint32); - OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (uint64); - - OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (int8); - OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (int16); - OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (int32); - OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (int64); - - OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (uint8); - OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (uint16); - OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (uint32); - OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (uint64); - - OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (int8); - OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (int16); - OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (int32); - OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (int64); - - OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (uint8); - OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (uint16); - OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (uint32); - OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (uint64); - - OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (int8); - OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (int16); - OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (int32); - OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (int64); - - OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (uint8); - OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (uint16); - OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (uint32); - OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (uint64); - - OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (int8); - OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (int16); - OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (int32); - OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (int64); - - OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (uint8); - OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (uint16); - OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (uint32); - OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (uint64); - - OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (int8); - OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (int16); - OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (int32); - OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (int64); - - OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (uint8); - OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (uint16); - OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (uint32); - OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (uint64); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-int-conv.cc --- a/src/OPERATORS/op-int-conv.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,235 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int8.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-uint8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-range.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-str-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" - -#define DEFINTCONVFN(name, tfrom, tto) \ - CONVDECL (name) \ - { \ - CAST_CONV_ARG (const octave_ ## tfrom&); \ - \ - octave_ ## tto ## _matrix v2 = v.tto ## _array_value (); \ - return new octave_ ## tto ## _matrix (v2); \ - } - -// conversion ops - -DEFINTCONVFN (scalar_to_int8, scalar, int8) -DEFINTCONVFN (scalar_to_int16, scalar, int16) -DEFINTCONVFN (scalar_to_int32, scalar, int32) -DEFINTCONVFN (scalar_to_int64, scalar, int64) - -DEFINTCONVFN (scalar_to_uint8, scalar, uint8) -DEFINTCONVFN (scalar_to_uint16, scalar, uint16) -DEFINTCONVFN (scalar_to_uint32, scalar, uint32) -DEFINTCONVFN (scalar_to_uint64, scalar, uint64) - -DEFINTCONVFN (matrix_to_int8, matrix, int8) -DEFINTCONVFN (matrix_to_int16, matrix, int16) -DEFINTCONVFN (matrix_to_int32, matrix, int32) -DEFINTCONVFN (matrix_to_int64, matrix, int64) - -DEFINTCONVFN (matrix_to_uint8, matrix, uint8) -DEFINTCONVFN (matrix_to_uint16, matrix, uint16) -DEFINTCONVFN (matrix_to_uint32, matrix, uint32) -DEFINTCONVFN (matrix_to_uint64, matrix, uint64) - -DEFINTCONVFN (float_scalar_to_int8, float_scalar, int8) -DEFINTCONVFN (float_scalar_to_int16, float_scalar, int16) -DEFINTCONVFN (float_scalar_to_int32, float_scalar, int32) -DEFINTCONVFN (float_scalar_to_int64, float_scalar, int64) - -DEFINTCONVFN (float_scalar_to_uint8, float_scalar, uint8) -DEFINTCONVFN (float_scalar_to_uint16, float_scalar, uint16) -DEFINTCONVFN (float_scalar_to_uint32, float_scalar, uint32) -DEFINTCONVFN (float_scalar_to_uint64, float_scalar, uint64) - -DEFINTCONVFN (float_matrix_to_int8, float_matrix, int8) -DEFINTCONVFN (float_matrix_to_int16, float_matrix, int16) -DEFINTCONVFN (float_matrix_to_int32, float_matrix, int32) -DEFINTCONVFN (float_matrix_to_int64, float_matrix, int64) - -DEFINTCONVFN (float_matrix_to_uint8, float_matrix, uint8) -DEFINTCONVFN (float_matrix_to_uint16, float_matrix, uint16) -DEFINTCONVFN (float_matrix_to_uint32, float_matrix, uint32) -DEFINTCONVFN (float_matrix_to_uint64, float_matrix, uint64) - -DEFCONVFN (bool_to_int8, bool, int8) -DEFCONVFN (bool_to_int16, bool, int16) -DEFCONVFN (bool_to_int32, bool, int32) -DEFCONVFN (bool_to_int64, bool, int64) - -DEFCONVFN (bool_to_uint8, bool, uint8) -DEFCONVFN (bool_to_uint16, bool, uint16) -DEFCONVFN (bool_to_uint32, bool, uint32) -DEFCONVFN (bool_to_uint64, bool, uint64) - -DEFCONVFN (bool_matrix_to_int8, bool_matrix, int8) -DEFCONVFN (bool_matrix_to_int16, bool_matrix, int16) -DEFCONVFN (bool_matrix_to_int32, bool_matrix, int32) -DEFCONVFN (bool_matrix_to_int64, bool_matrix, int64) - -DEFCONVFN (bool_matrix_to_uint8, bool_matrix, uint8) -DEFCONVFN (bool_matrix_to_uint16, bool_matrix, uint16) -DEFCONVFN (bool_matrix_to_uint32, bool_matrix, uint32) -DEFCONVFN (bool_matrix_to_uint64, bool_matrix, uint64) - -DEFSTRINTCONVFN (char_matrix_sq_str_to_int8, int8) -DEFSTRINTCONVFN (char_matrix_sq_str_to_int16, int16) -DEFSTRINTCONVFN (char_matrix_sq_str_to_int32, int32) -DEFSTRINTCONVFN (char_matrix_sq_str_to_int64, int64) - -DEFSTRINTCONVFN (char_matrix_sq_str_to_uint8, uint8) -DEFSTRINTCONVFN (char_matrix_sq_str_to_uint16, uint16) -DEFSTRINTCONVFN (char_matrix_sq_str_to_uint32, uint32) -DEFSTRINTCONVFN (char_matrix_sq_str_to_uint64, uint64) - -DEFSTRINTCONVFN (char_matrix_dq_str_to_int8, int8) -DEFSTRINTCONVFN (char_matrix_dq_str_to_int16, int16) -DEFSTRINTCONVFN (char_matrix_dq_str_to_int32, int32) -DEFSTRINTCONVFN (char_matrix_dq_str_to_int64, int64) - -DEFSTRINTCONVFN (char_matrix_dq_str_to_uint8, uint8) -DEFSTRINTCONVFN (char_matrix_dq_str_to_uint16, uint16) -DEFSTRINTCONVFN (char_matrix_dq_str_to_uint32, uint32) -DEFSTRINTCONVFN (char_matrix_dq_str_to_uint64, uint64) - -DEFINTCONVFN (range_to_int8, range, int8) -DEFINTCONVFN (range_to_int16, range, int16) -DEFINTCONVFN (range_to_int32, range, int32) -DEFINTCONVFN (range_to_int64, range, int64) - -DEFINTCONVFN (range_to_uint8, range, uint8) -DEFINTCONVFN (range_to_uint16, range, uint16) -DEFINTCONVFN (range_to_uint32, range, uint32) -DEFINTCONVFN (range_to_uint64, range, uint64) - -#define INT_CONV_FUNCTIONS(tfrom) \ - DEFCONVFN2 (tfrom ## _scalar_to_int8, tfrom, scalar, int8) \ - DEFCONVFN2 (tfrom ## _scalar_to_int16, tfrom, scalar, int16) \ - DEFCONVFN2 (tfrom ## _scalar_to_int32, tfrom, scalar, int32) \ - DEFCONVFN2 (tfrom ## _scalar_to_int64, tfrom, scalar, int64) \ - \ - DEFCONVFN2 (tfrom ## _scalar_to_uint8, tfrom, scalar, uint8) \ - DEFCONVFN2 (tfrom ## _scalar_to_uint16, tfrom, scalar, uint16) \ - DEFCONVFN2 (tfrom ## _scalar_to_uint32, tfrom, scalar, uint32) \ - DEFCONVFN2 (tfrom ## _scalar_to_uint64, tfrom, scalar, uint64) \ - \ - DEFCONVFN2 (tfrom ## _matrix_to_int8, tfrom, matrix, int8) \ - DEFCONVFN2 (tfrom ## _matrix_to_int16, tfrom, matrix, int16) \ - DEFCONVFN2 (tfrom ## _matrix_to_int32, tfrom, matrix, int32) \ - DEFCONVFN2 (tfrom ## _matrix_to_int64, tfrom, matrix, int64) \ - \ - DEFCONVFN2 (tfrom ## _matrix_to_uint8, tfrom, matrix, uint8) \ - DEFCONVFN2 (tfrom ## _matrix_to_uint16, tfrom, matrix, uint16) \ - DEFCONVFN2 (tfrom ## _matrix_to_uint32, tfrom, matrix, uint32) \ - DEFCONVFN2 (tfrom ## _matrix_to_uint64, tfrom, matrix, uint64) - -INT_CONV_FUNCTIONS (int8) -INT_CONV_FUNCTIONS (int16) -INT_CONV_FUNCTIONS (int32) -INT_CONV_FUNCTIONS (int64) - -INT_CONV_FUNCTIONS (uint8) -INT_CONV_FUNCTIONS (uint16) -INT_CONV_FUNCTIONS (uint32) -INT_CONV_FUNCTIONS (uint64) - -#define INSTALL_INT_CONV_FUNCTIONS(tfrom) \ - INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_int8_matrix, tfrom ## _scalar_to_int8) \ - INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_int16_matrix, tfrom ## _scalar_to_int16) \ - INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_int32_matrix, tfrom ## _scalar_to_int32) \ - INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_int64_matrix, tfrom ## _scalar_to_int64) \ - \ - INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_uint8_matrix, tfrom ## _scalar_to_uint8) \ - INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_uint16_matrix, tfrom ## _scalar_to_uint16) \ - INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_uint32_matrix, tfrom ## _scalar_to_uint32) \ - INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_uint64_matrix, tfrom ## _scalar_to_uint64) \ - \ - INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_int8_matrix, tfrom ## _matrix_to_int8) \ - INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_int16_matrix, tfrom ## _matrix_to_int16) \ - INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_int32_matrix, tfrom ## _matrix_to_int32) \ - INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_int64_matrix, tfrom ## _matrix_to_int64) \ - \ - INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_uint8_matrix, tfrom ## _matrix_to_uint8) \ - INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_uint16_matrix, tfrom ## _matrix_to_uint16) \ - INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_uint32_matrix, tfrom ## _matrix_to_uint32) \ - INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_uint64_matrix, tfrom ## _matrix_to_uint64) - -#define INSTALL_CONVOPS(tfrom) \ - INSTALL_CONVOP (octave_ ## tfrom, octave_int8_matrix, tfrom ## _to_int8) \ - INSTALL_CONVOP (octave_ ## tfrom, octave_int16_matrix, tfrom ## _to_int16) \ - INSTALL_CONVOP (octave_ ## tfrom, octave_int32_matrix, tfrom ## _to_int32) \ - INSTALL_CONVOP (octave_ ## tfrom, octave_int64_matrix, tfrom ## _to_int64) \ - \ - INSTALL_CONVOP (octave_ ## tfrom, octave_uint8_matrix, tfrom ## _to_uint8) \ - INSTALL_CONVOP (octave_ ## tfrom, octave_uint16_matrix, tfrom ## _to_uint16) \ - INSTALL_CONVOP (octave_ ## tfrom, octave_uint32_matrix, tfrom ## _to_uint32) \ - INSTALL_CONVOP (octave_ ## tfrom, octave_uint64_matrix, tfrom ## _to_uint64) - -void -install_int_conv_ops (void) -{ - INSTALL_CONVOPS (scalar) - INSTALL_CONVOPS (matrix) - INSTALL_CONVOPS (float_scalar) - INSTALL_CONVOPS (float_matrix) - INSTALL_CONVOPS (bool) - INSTALL_CONVOPS (bool_matrix) - INSTALL_CONVOPS (range) - INSTALL_CONVOPS (char_matrix_sq_str) - INSTALL_CONVOPS (char_matrix_dq_str) - - INSTALL_INT_CONV_FUNCTIONS (int8) - INSTALL_INT_CONV_FUNCTIONS (int16) - INSTALL_INT_CONV_FUNCTIONS (int32) - INSTALL_INT_CONV_FUNCTIONS (int64) - - INSTALL_INT_CONV_FUNCTIONS (uint8) - INSTALL_INT_CONV_FUNCTIONS (uint16) - INSTALL_INT_CONV_FUNCTIONS (uint32) - INSTALL_INT_CONV_FUNCTIONS (uint64) -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-int.h --- a/src/OPERATORS/op-int.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1191 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#include "quit.h" -#include "bsxfun.h" - -#define DEFINTBINOP_OP(name, t1, t2, op, t3) \ - BINOPDECL (name, a1, a2) \ - { \ - CAST_BINOP_ARGS (const octave_ ## t1&, const octave_ ## t2&); \ - octave_value retval = octave_value \ - (v1.t1 ## _value () op v2.t2 ## _value ()); \ - return retval; \ - } - -#define DEFINTNDBINOP_OP(name, t1, t2, e1, e2, op, t3) \ - BINOPDECL (name, a1, a2) \ - { \ - CAST_BINOP_ARGS (const octave_ ## t1&, const octave_ ## t2&); \ - octave_value retval = octave_value \ - (v1.e1 ## _value () op v2.e2 ## _value ()); \ - return retval; \ - } - -#define DEFINTBINOP_FN(name, t1, t2, f, t3, op) \ - BINOPDECL (name, a1, a2) \ - { \ - CAST_BINOP_ARGS (const octave_ ## t1&, const octave_ ## t2&); \ - octave_value retval = octave_value (f (v1.t1 ## _value (), v2.t2 ## _value ())); \ - return retval; \ - } - -#define DEFINTNDBINOP_FN(name, t1, t2, e1, e2, f, t3, op) \ - BINOPDECL (name, a1, a2) \ - { \ - CAST_BINOP_ARGS (const octave_ ## t1&, const octave_ ## t2&); \ - octave_value retval = octave_value (f (v1.e1 ## _value (), v2.e2 ## _value ())); \ - return retval; \ - } - -#define OCTAVE_CONCAT_FN2(T1, T2) \ - DEFNDCATOP_FN2 (T1 ## _ ## T2 ## _s_s, T1 ## _scalar, T2 ## _scalar, , T1 ## NDArray, T1 ## _array, T2 ## _array, concat) \ - DEFNDCATOP_FN2 (T1 ## _ ## T2 ## _s_m, T1 ## _scalar, T2 ## _matrix, , T1 ## NDArray, T1 ## _array, T2 ## _array, concat) \ - DEFNDCATOP_FN2 (T1 ## _ ## T2 ## _m_s, T1 ## _matrix, T2 ## _scalar, , T1 ## NDArray, T1 ## _array, T2 ## _array, concat) \ - DEFNDCATOP_FN2 (T1 ## _ ## T2 ## _m_m, T1 ## _matrix, T2 ## _matrix, , T1 ## NDArray, T1 ## _array, T2 ## _array, concat) - -#define OCTAVE_INSTALL_CONCAT_FN2(T1, T2) \ - INSTALL_CATOP (octave_ ## T1 ## _scalar, octave_ ## T2 ## _scalar, T1 ## _ ## T2 ## _s_s) \ - INSTALL_CATOP (octave_ ## T1 ## _scalar, octave_ ## T2 ## _matrix, T1 ## _ ## T2 ## _s_m) \ - INSTALL_CATOP (octave_ ## T1 ## _matrix, octave_ ## T2 ## _scalar, T1 ## _ ## T2 ## _m_s) \ - INSTALL_CATOP (octave_ ## T1 ## _matrix, octave_ ## T2 ## _matrix, T1 ## _ ## T2 ## _m_m) - -#define OCTAVE_DOUBLE_INT_CONCAT_FN(TYPE) \ - DEFNDCATOP_FN2 (double ## _ ## TYPE ## _s_s, scalar, TYPE ## _scalar, TYPE ## NDArray, , array, TYPE ## _array, concat) \ - DEFNDCATOP_FN2 (double ## _ ## TYPE ## _s_m, scalar, TYPE ## _matrix, TYPE ## NDArray, , array, TYPE ## _array, concat) \ - DEFNDCATOP_FN2 (double ## _ ## TYPE ## _m_s, matrix, TYPE ## _scalar, TYPE ## NDArray, , array, TYPE ## _array, concat) \ - DEFNDCATOP_FN2 (double ## _ ## TYPE ## _m_m, matrix, TYPE ## _matrix, TYPE ## NDArray, , array, TYPE ## _array, concat) - -#define OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN(TYPE) \ - INSTALL_CATOP (octave_scalar, octave_ ## TYPE ## _scalar, double ## _ ## TYPE ## _s_s) \ - INSTALL_CATOP (octave_scalar, octave_ ## TYPE ## _matrix, double ## _ ## TYPE ## _s_m) \ - INSTALL_CATOP (octave_matrix, octave_ ## TYPE ## _scalar, double ## _ ## TYPE ## _m_s) \ - INSTALL_CATOP (octave_matrix, octave_ ## TYPE ## _matrix, double ## _ ## TYPE ## _m_m) - -#define OCTAVE_INT_DOUBLE_CONCAT_FN(TYPE) \ - DEFNDCATOP_FN2 (TYPE ## _ ## double ## _s_s, TYPE ## _scalar, scalar, , TYPE ## NDArray, TYPE ## _array, array, concat) \ - DEFNDCATOP_FN2 (TYPE ## _ ## double ## _s_m, TYPE ## _scalar, matrix, , TYPE ## NDArray, TYPE ## _array, array, concat) \ - DEFNDCATOP_FN2 (TYPE ## _ ## double ## _m_s, TYPE ## _matrix, scalar, , TYPE ## NDArray, TYPE ## _array, array, concat) \ - DEFNDCATOP_FN2 (TYPE ## _ ## double ## _m_m, TYPE ## _matrix, matrix, , TYPE ## NDArray, TYPE ## _array, array, concat) - -#define OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN(TYPE) \ - INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_scalar, TYPE ## _ ## double ## _s_s) \ - INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_matrix, TYPE ## _ ## double ## _s_m) \ - INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_scalar, TYPE ## _ ## double ## _m_s) \ - INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_matrix, TYPE ## _ ## double ## _m_m) - -#define OCTAVE_FLOAT_INT_CONCAT_FN(TYPE) \ - DEFNDCATOP_FN2 (float ## _ ## TYPE ## _s_s, float_scalar, TYPE ## _scalar, TYPE ## NDArray, , float_array, TYPE ## _array, concat) \ - DEFNDCATOP_FN2 (float ## _ ## TYPE ## _s_m, float_scalar, TYPE ## _matrix, TYPE ## NDArray, , float_array, TYPE ## _array, concat) \ - DEFNDCATOP_FN2 (float ## _ ## TYPE ## _m_s, float_matrix, TYPE ## _scalar, TYPE ## NDArray, , float_array, TYPE ## _array, concat) \ - DEFNDCATOP_FN2 (float ## _ ## TYPE ## _m_m, float_matrix, TYPE ## _matrix, TYPE ## NDArray, , float_array, TYPE ## _array, concat) - -#define OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN(TYPE) \ - INSTALL_CATOP (octave_float_scalar, octave_ ## TYPE ## _scalar, float ## _ ## TYPE ## _s_s) \ - INSTALL_CATOP (octave_float_scalar, octave_ ## TYPE ## _matrix, float ## _ ## TYPE ## _s_m) \ - INSTALL_CATOP (octave_float_matrix, octave_ ## TYPE ## _scalar, float ## _ ## TYPE ## _m_s) \ - INSTALL_CATOP (octave_float_matrix, octave_ ## TYPE ## _matrix, float ## _ ## TYPE ## _m_m) - -#define OCTAVE_INT_FLOAT_CONCAT_FN(TYPE) \ - DEFNDCATOP_FN2 (TYPE ## _ ## float ## _s_s, TYPE ## _scalar, float_scalar, , TYPE ## NDArray, TYPE ## _array, float_array, concat) \ - DEFNDCATOP_FN2 (TYPE ## _ ## float ## _s_m, TYPE ## _scalar, float_matrix, , TYPE ## NDArray, TYPE ## _array, float_array, concat) \ - DEFNDCATOP_FN2 (TYPE ## _ ## float ## _m_s, TYPE ## _matrix, float_scalar, , TYPE ## NDArray, TYPE ## _array, float_array, concat) \ - DEFNDCATOP_FN2 (TYPE ## _ ## float ## _m_m, TYPE ## _matrix, float_matrix, , TYPE ## NDArray, TYPE ## _array, float_array, concat) - -#define OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN(TYPE) \ - INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_float_scalar, TYPE ## _ ## float ## _s_s) \ - INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_float_matrix, TYPE ## _ ## float ## _s_m) \ - INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_float_scalar, TYPE ## _ ## float ## _m_s) \ - INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_float_matrix, TYPE ## _ ## float ## _m_m) - -// For compatibility, concatenation with a character always returns a -// character. - -#define OCTAVE_CHAR_INT_CONCAT_FN(TYPE) \ - DEFNDCHARCATOP_FN (char ## _ ## TYPE ## _m_s, char_matrix, TYPE ## _scalar, concat) \ - DEFNDCHARCATOP_FN (char ## _ ## TYPE ## _m_m, char_matrix, TYPE ## _matrix, concat) - -#define OCTAVE_INSTALL_CHAR_INT_CONCAT_FN(TYPE) \ - INSTALL_CATOP (octave_char_matrix_str, octave_ ## TYPE ## _scalar, char ## _ ## TYPE ## _m_s) \ - INSTALL_CATOP (octave_char_matrix_str, octave_ ## TYPE ## _matrix, char ## _ ## TYPE ## _m_m) \ - INSTALL_CATOP (octave_char_matrix_sq_str, octave_ ## TYPE ## _scalar, char ## _ ## TYPE ## _m_s) \ - INSTALL_CATOP (octave_char_matrix_sq_str, octave_ ## TYPE ## _matrix, char ## _ ## TYPE ## _m_m) - -#define OCTAVE_INT_CHAR_CONCAT_FN(TYPE) \ - DEFNDCHARCATOP_FN (TYPE ## _ ## char ## _s_m, TYPE ## _scalar, char_matrix, concat) \ - DEFNDCHARCATOP_FN (TYPE ## _ ## char ## _m_m, TYPE ## _matrix, char_matrix, concat) - -#define OCTAVE_INSTALL_INT_CHAR_CONCAT_FN(TYPE) \ - INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_char_matrix_str, TYPE ## _ ## char ## _s_m) \ - INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_char_matrix_str, TYPE ## _ ## char ## _m_m) \ - INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_char_matrix_sq_str, TYPE ## _ ## char ## _s_m) \ - INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_char_matrix_sq_str, TYPE ## _ ## char ## _m_m) - -#define OCTAVE_CONCAT_FN(TYPE) \ - DEFNDCATOP_FN (TYPE ## _s_s, TYPE ## _scalar, TYPE ## _scalar, TYPE ## _array, TYPE ## _array, concat) \ - DEFNDCATOP_FN (TYPE ## _s_m, TYPE ## _scalar, TYPE ## _matrix, TYPE ## _array, TYPE ## _array, concat) \ - DEFNDCATOP_FN (TYPE ## _m_s, TYPE ## _matrix, TYPE ## _scalar, TYPE ## _array, TYPE ## _array, concat) \ - DEFNDCATOP_FN (TYPE ## _m_m, TYPE ## _matrix, TYPE ## _matrix, TYPE ## _array, TYPE ## _array, concat) - -#define OCTAVE_INSTALL_CONCAT_FN(TYPE) \ - INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _scalar, TYPE ## _s_s) \ - INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _matrix, TYPE ## _s_m) \ - INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_ ## TYPE ## _scalar, TYPE ## _m_s) \ - INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_ ## TYPE ## _matrix, TYPE ## _m_m) - -#define OCTAVE_S_INT_UNOPS(TYPE) \ - /* scalar unary ops. */ \ - \ - DEFUNOP_OP (s_not, TYPE ## _scalar, !) \ - DEFUNOP_OP (s_uplus, TYPE ## _scalar, /* no-op */) \ - DEFUNOP (s_uminus, TYPE ## _scalar) \ - { \ - CAST_UNOP_ARG (const octave_ ## TYPE ## _scalar &); \ - octave_value retval = octave_value (- v. TYPE ## _scalar_value ()); \ - return retval; \ - } \ - DEFUNOP_OP (s_transpose, TYPE ## _scalar, /* no-op */) \ - DEFUNOP_OP (s_hermitian, TYPE ## _scalar, /* no-op */) \ - \ - DEFNCUNOP_METHOD (s_incr, TYPE ## _scalar, increment) \ - DEFNCUNOP_METHOD (s_decr, TYPE ## _scalar, decrement) - -#define OCTAVE_SS_INT_ARITH_OPS(PFX, T1, T2, T3) \ - /* scalar by scalar ops. */ \ - \ - DEFINTBINOP_OP (PFX ## _add, T1 ## scalar, T2 ## scalar, +, T3) \ - DEFINTBINOP_OP (PFX ## _sub, T1 ## scalar, T2 ## scalar, -, T3) \ - DEFINTBINOP_OP (PFX ## _mul, T1 ## scalar, T2 ## scalar, *, T3) \ - \ - DEFBINOP (PFX ## _div, T1 ## scalar, T2 ## scalar) \ - { \ - CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ - \ - if (! v2.T2 ## scalar_value ()) \ - gripe_divide_by_zero (); \ - \ - octave_value retval = octave_value (v1.T1 ## scalar_value () / v2.T2 ## scalar_value ()); \ - return retval; \ - } \ - \ - DEFINTBINOP_FN (PFX ## _pow, T1 ## scalar, T2 ## scalar, xpow, T3, ^) \ - \ - DEFBINOP (PFX ## _ldiv, T1 ## scalar, T2 ## scalar) \ - { \ - CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ - \ - if (! v1.T1 ## scalar_value ()) \ - gripe_divide_by_zero (); \ - \ - octave_value retval = octave_value (v2.T2 ## scalar_value () / v1.T1 ## scalar_value ()); \ - return retval; \ - } \ - \ - DEFINTBINOP_OP (PFX ## _el_mul, T1 ## scalar, T2 ## scalar, *, T3) \ - \ - DEFBINOP (PFX ## _el_div, T1 ## scalar, T2 ## scalar) \ - { \ - CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ - \ - if (! v2.T2 ## scalar_value ()) \ - gripe_divide_by_zero (); \ - \ - octave_value retval = octave_value (v1.T1 ## scalar_value () / v2.T2 ## scalar_value ()); \ - return retval; \ - } \ - \ - DEFINTBINOP_FN (PFX ## _el_pow, T1 ## scalar, T2 ## scalar, xpow, T3, .^) \ - \ - DEFBINOP (PFX ## _el_ldiv, T1 ## scalar, T2 ## scalar) \ - { \ - CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ - \ - if (! v1.T1 ## scalar_value ()) \ - gripe_divide_by_zero (); \ - \ - octave_value retval = octave_value (v2.T2 ## scalar_value () / v1.T1 ## scalar_value ()); \ - return retval; \ - } \ - -#define OCTAVE_SS_INT_BOOL_OPS(PFX, T1, T2, Z1, Z2) \ - DEFBINOP (PFX ## _el_and, T2, T2) \ - { \ - CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ - \ - return v1.T1 ## scalar_value () != Z1 && v2.T2 ## scalar_value () != Z2; \ - } \ - \ - DEFBINOP (PFX ## _el_or, T1, T2) \ - { \ - CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ - \ - return v1.T1 ## scalar_value () != Z1 || v2.T2 ## scalar_value () != Z2; \ - } - -#define OCTAVE_SS_INT_CMP_OPS(PFX, T1, T2) \ - DEFBINOP_OP (PFX ## _lt, T1 ## scalar, T2 ## scalar, <) \ - DEFBINOP_OP (PFX ## _le, T1 ## scalar, T2 ## scalar, <=) \ - DEFBINOP_OP (PFX ## _eq, T1 ## scalar, T2 ## scalar, ==) \ - DEFBINOP_OP (PFX ## _ge, T1 ## scalar, T2 ## scalar, >=) \ - DEFBINOP_OP (PFX ## _gt, T1 ## scalar, T2 ## scalar, >) \ - DEFBINOP_OP (PFX ## _ne, T1 ## scalar, T2 ## scalar, !=) - -#define OCTAVE_SS_POW_OPS(T1, T2) \ - octave_value \ - xpow (const octave_ ## T1& a, const octave_ ## T2& b) \ - { \ - return pow (a, b); \ - } \ - \ - octave_value \ - xpow (const octave_ ## T1& a, double b) \ - { \ - return pow (a, b); \ - } \ - \ - octave_value \ - xpow (double a, const octave_ ## T1& b) \ - { \ - return pow (a, b); \ - } \ - \ - octave_value \ - xpow (const octave_ ## T1& a, float b) \ - { \ - return powf (a, b); \ - } \ - \ - octave_value \ - xpow (float a, const octave_ ## T1& b) \ - { \ - return powf (a, b); \ - } - -#define OCTAVE_SS_INT_OPS(TYPE) \ - OCTAVE_S_INT_UNOPS (TYPE) \ - OCTAVE_SS_POW_OPS (TYPE, TYPE) \ - OCTAVE_SS_INT_ARITH_OPS (ss, TYPE ## _, TYPE ## _, TYPE) \ - OCTAVE_SS_INT_ARITH_OPS (ssx, TYPE ## _, , TYPE) \ - OCTAVE_SS_INT_ARITH_OPS (sxs, , TYPE ## _, TYPE) \ - OCTAVE_SS_INT_ARITH_OPS (ssfx, TYPE ## _, float_, TYPE) \ - OCTAVE_SS_INT_ARITH_OPS (sfxs, float_, TYPE ## _, TYPE) \ - OCTAVE_SS_INT_CMP_OPS (ss, TYPE ## _, TYPE ## _) \ - OCTAVE_SS_INT_CMP_OPS (sx, TYPE ## _, ) \ - OCTAVE_SS_INT_CMP_OPS (xs, , TYPE ## _) \ - OCTAVE_SS_INT_CMP_OPS (sfx, TYPE ## _, float_) \ - OCTAVE_SS_INT_CMP_OPS (fxs, float_, TYPE ## _) \ - OCTAVE_SS_INT_BOOL_OPS (ss, TYPE ## _, TYPE ## _, octave_ ## TYPE (0), octave_ ## TYPE (0)) \ - OCTAVE_SS_INT_BOOL_OPS (sx, TYPE ## _, , octave_ ## TYPE (0), 0) \ - OCTAVE_SS_INT_BOOL_OPS (xs, , TYPE ## _, 0, octave_ ## TYPE (0)) \ - OCTAVE_SS_INT_BOOL_OPS (sfx, TYPE ## _, float_, octave_ ## TYPE (0), 0) \ - OCTAVE_SS_INT_BOOL_OPS (fxs, float_, TYPE ## _, 0, octave_ ## TYPE (0)) - -#define OCTAVE_SM_INT_ARITH_OPS(PFX, TS, TM, TI) \ - /* scalar by matrix ops. */ \ - \ - DEFINTNDBINOP_OP (PFX ## _add, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, +, TI) \ - DEFINTNDBINOP_OP (PFX ## _sub, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, -, TI) \ - DEFINTNDBINOP_OP (PFX ## _mul, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, *, TI) \ - \ - /* DEFBINOP (PFX ## _div, TS ## scalar, TM ## matrix) */ \ - /* { */ \ - /* CAST_BINOP_ARGS (const octave_ ## TS ## scalar&, const octave_ ## TM ## matrix&); */ \ - /* */ \ - /* Matrix m1 = v1.TM ## matrix_value (); */ \ - /* Matrix m2 = v2.TM ## matrix_value (); */ \ - /* */ \ - /* return octave_value (xdiv (m1, m2)); */ \ - /* } */ \ - \ - /* DEFBINOP_FN (PFX ## _pow, TS ## scalar, TM ## matrix, xpow) */ \ - \ - DEFBINOP (PFX ## _ldiv, TS ## scalar, TM ## matrix) \ - { \ - CAST_BINOP_ARGS (const octave_ ## TS ## scalar&, const octave_ ## TM ## matrix&); \ - \ - if (! v1.TS ## scalar_value ()) \ - gripe_divide_by_zero (); \ - \ - octave_value retval = octave_value (v2.TS ## scalar_value () / v1.TS ## scalar_value ()); \ - return retval; \ - } \ - \ - DEFINTNDBINOP_OP (PFX ## _el_mul, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, *, TI) \ - DEFBINOP (PFX ## _el_div, TS ## scalar, TM ## matrix) \ - { \ - CAST_BINOP_ARGS (const octave_ ## TS ## scalar&, const octave_ ## TM ## matrix&); \ - \ - octave_value retval = octave_value (v1.TS ## scalar_value () / v2.TM ## array_value ()); \ - return retval; \ - } \ - \ - DEFINTNDBINOP_FN (PFX ## _el_pow, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, elem_xpow, TI, .^) \ - \ - DEFBINOP (PFX ## _el_ldiv, TS ## scalar, TM ## matrix) \ - { \ - CAST_BINOP_ARGS (const octave_ ## TS ## scalar&, const octave_ ## TM ## matrix&); \ - \ - if (! v1.TS ## scalar_value ()) \ - gripe_divide_by_zero (); \ - \ - octave_value retval = octave_value (v2.TM ## array_value () / v1.TS ## scalar_value ()); \ - return retval; \ - } - -#define OCTAVE_SM_INT_CMP_OPS(PFX, TS, TM) \ - DEFNDBINOP_FN (PFX ## _lt, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_lt) \ - DEFNDBINOP_FN (PFX ## _le, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_le) \ - DEFNDBINOP_FN (PFX ## _eq, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_eq) \ - DEFNDBINOP_FN (PFX ## _ge, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_ge) \ - DEFNDBINOP_FN (PFX ## _gt, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_gt) \ - DEFNDBINOP_FN (PFX ## _ne, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_ne) - -#define OCTAVE_SM_INT_BOOL_OPS(PFX, TS, TM) \ - DEFNDBINOP_FN (PFX ## _el_and, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_and) \ - DEFNDBINOP_FN (PFX ## _el_or, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_or) \ - DEFNDBINOP_FN (PFX ## _el_and_not, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_and_not) \ - DEFNDBINOP_FN (PFX ## _el_or_not, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_or_not) - -#define OCTAVE_SM_POW_OPS(T1, T2) \ - octave_value \ - elem_xpow (const octave_ ## T1& a, const T2 ## NDArray& b) \ - { \ - T2 ## NDArray result (b.dims ()); \ - for (int i = 0; i < b.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = pow (a, b(i)); \ - } \ - return octave_value (result); \ - } \ -\ - octave_value \ - elem_xpow (const octave_ ## T1& a, const NDArray& b) \ - { \ - T1 ## NDArray result (b.dims ()); \ - for (int i = 0; i < b.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = pow (a, b(i)); \ - } \ - return octave_value (result); \ - } \ - \ - octave_value \ - elem_xpow (double a, const T2 ## NDArray& b) \ - { \ - T2 ## NDArray result (b.dims ()); \ - for (int i = 0; i < b.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = pow (a, b(i)); \ - } \ - return octave_value (result); \ - } \ -\ - octave_value \ - elem_xpow (const octave_ ## T1& a, const FloatNDArray& b) \ - { \ - T1 ## NDArray result (b.dims ()); \ - for (int i = 0; i < b.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = powf (a, b(i)); \ - } \ - return octave_value (result); \ - } \ - \ - octave_value \ - elem_xpow (float a, const T2 ## NDArray& b) \ - { \ - T2 ## NDArray result (b.dims ()); \ - for (int i = 0; i < b.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = powf (a, b(i)); \ - } \ - return octave_value (result); \ - } - - -#define OCTAVE_SM_CONV(TS, TM) \ - DEFCONV (TS ## s_ ## TM ## m_conv, TM ## scalar, TM ## matrix) \ - { \ - CAST_CONV_ARG (const octave_ ## TS ## scalar&); \ - \ - return new octave_ ## TM ## matrix (v.TM ## array_value ()); \ - } - -#define OCTAVE_SM_INT_OPS(TYPE) \ - OCTAVE_SM_POW_OPS (TYPE, TYPE) \ - OCTAVE_SM_INT_ARITH_OPS (sm, TYPE ## _, TYPE ## _, TYPE) \ - OCTAVE_SM_INT_ARITH_OPS (smx, TYPE ## _, , TYPE) \ - OCTAVE_SM_INT_ARITH_OPS (sxm, , TYPE ## _, TYPE) \ - OCTAVE_SM_INT_ARITH_OPS (smfx, TYPE ## _, float_, TYPE) \ - OCTAVE_SM_INT_ARITH_OPS (sfxm, float_, TYPE ## _, TYPE) \ - OCTAVE_SM_INT_CMP_OPS (sm, TYPE ## _, TYPE ## _) \ - OCTAVE_SM_INT_CMP_OPS (xm, , TYPE ## _) \ - OCTAVE_SM_INT_CMP_OPS (smx, TYPE ## _, ) \ - OCTAVE_SM_INT_CMP_OPS (fxm, float_, TYPE ## _) \ - OCTAVE_SM_INT_CMP_OPS (smfx, TYPE ## _, float_) \ - OCTAVE_SM_INT_BOOL_OPS (sm, TYPE ## _, TYPE ## _) \ - OCTAVE_SM_INT_BOOL_OPS (xm, , TYPE ## _) \ - OCTAVE_SM_INT_BOOL_OPS (smx, TYPE ## _, ) \ - OCTAVE_SM_INT_BOOL_OPS (fxm, float_, TYPE ## _) \ - OCTAVE_SM_INT_BOOL_OPS (smfx, TYPE ## _, float_) \ - OCTAVE_SM_CONV (TYPE ## _, TYPE ## _) \ - OCTAVE_SM_CONV (TYPE ## _, complex_) \ - OCTAVE_SM_CONV (TYPE ## _, float_complex_) - -#define OCTAVE_MS_INT_ARITH_OPS(PFX, TM, TS, TI) \ - /* matrix by scalar ops. */ \ - \ - DEFINTNDBINOP_OP (PFX ## _add, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, +, TI) \ - DEFINTNDBINOP_OP (PFX ## _sub, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, -, TI) \ - DEFINTNDBINOP_OP (PFX ## _mul, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, *, TI) \ - \ - DEFBINOP (PFX ## _div, TM ## matrix, TS ## scalar) \ - { \ - CAST_BINOP_ARGS (const octave_ ## TM ## matrix&, const octave_ ## TS ## scalar&); \ - \ - if (! v2.TS ## scalar_value ()) \ - gripe_divide_by_zero (); \ - \ - octave_value retval = octave_value (v1.TM ## array_value () / v2.TS ## scalar_value ()); \ - return retval; \ - } \ - \ - /* DEFBINOP_FN (PFX ## _pow, TM ## matrix, TS ## scalar, xpow) */ \ - \ - /* DEFBINOP (PFX ## _ldiv, TM ## matrix, TS ## scalar) */ \ - /* { */ \ - /* CAST_BINOP_ARGS (const octave_ ## TM ## matrix&, const octave_ ## TS ## scalar&); */ \ - /* */ \ - /* Matrix m1 = v1.TM ## matrix_value (); */ \ - /* Matrix m2 = v2.TM ## matrix_value (); */ \ - /* */ \ - /* return octave_value (xleftdiv (m1, m2)); */ \ - /* } */ \ - \ - DEFINTNDBINOP_OP (PFX ## _el_mul, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, *, TI) \ - \ - DEFBINOP (PFX ## _el_div, TM ## matrix, TS ## scalar) \ - { \ - CAST_BINOP_ARGS (const octave_ ## TM ## matrix&, const octave_ ## TS ## scalar&); \ - \ - if (! v2.TS ## scalar_value ()) \ - gripe_divide_by_zero (); \ - \ - octave_value retval = octave_value (v1.TM ## array_value () / v2.TS ## scalar_value ()); \ - return retval; \ - } \ - \ - DEFINTNDBINOP_FN (PFX ## _el_pow, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, elem_xpow, TI, .^) \ - \ - DEFBINOP (PFX ## _el_ldiv, TM ## matrix, TS ## scalar) \ - { \ - CAST_BINOP_ARGS (const octave_ ## TM ## matrix&, const octave_ ## TS ## scalar&); \ - \ - octave_value retval = v2.TS ## scalar_value () / v1.TM ## array_value (); \ - return retval; \ - } - -#define OCTAVE_MS_INT_CMP_OPS(PFX, TM, TS) \ - DEFNDBINOP_FN (PFX ## _lt, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_lt) \ - DEFNDBINOP_FN (PFX ## _le, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_le) \ - DEFNDBINOP_FN (PFX ## _eq, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_eq) \ - DEFNDBINOP_FN (PFX ## _ge, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_ge) \ - DEFNDBINOP_FN (PFX ## _gt, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_gt) \ - DEFNDBINOP_FN (PFX ## _ne, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_ne) - -#define OCTAVE_MS_INT_BOOL_OPS(PFX, TM, TS) \ - DEFNDBINOP_FN (PFX ## _el_and, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_and) \ - DEFNDBINOP_FN (PFX ## _el_or, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_or) \ - DEFNDBINOP_FN (PFX ## _el_not_and, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_not_and) \ - DEFNDBINOP_FN (PFX ## _el_not_or, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_not_or) - -#define OCTAVE_MS_INT_ASSIGN_OPS(PFX, TM, TS, TE) \ - DEFNDASSIGNOP_FN (PFX ## _assign, TM ## matrix, TS ## scalar, TM ## scalar, assign) - -#define OCTAVE_MS_INT_ASSIGNEQ_OPS(PFX, TM) \ - DEFNDASSIGNOP_OP (PFX ## _assign_add, TM ## matrix, TM ## scalar, TM ## scalar, +=) \ - DEFNDASSIGNOP_OP (PFX ## _assign_sub, TM ## matrix, TM ## scalar, TM ## scalar, -=) \ - DEFNDASSIGNOP_OP (PFX ## _assign_mul, TM ## matrix, TM ## scalar, TM ## scalar, *=) \ - DEFNDASSIGNOP_OP (PFX ## _assign_div, TM ## matrix, TM ## scalar, TM ## scalar, /=) - -#define OCTAVE_MS_POW_OPS(T1, T2) \ -octave_value elem_xpow (T1 ## NDArray a, octave_ ## T2 b) \ -{ \ - T1 ## NDArray result (a.dims ()); \ - for (int i = 0; i < a.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = pow (a(i), b); \ - } \ - return octave_value (result); \ -} \ -\ -octave_value elem_xpow (T1 ## NDArray a, double b) \ -{ \ - T1 ## NDArray result (a.dims ()); \ - for (int i = 0; i < a.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = pow (a(i), b); \ - } \ - return octave_value (result); \ -} \ -\ -octave_value elem_xpow (NDArray a, octave_ ## T2 b) \ -{ \ - T2 ## NDArray result (a.dims ()); \ - for (int i = 0; i < a.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = pow (a(i), b); \ - } \ - return octave_value (result); \ -} \ -\ -octave_value elem_xpow (T1 ## NDArray a, float b) \ -{ \ - T1 ## NDArray result (a.dims ()); \ - for (int i = 0; i < a.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = powf (a(i), b); \ - } \ - return octave_value (result); \ -} \ -\ -octave_value elem_xpow (FloatNDArray a, octave_ ## T2 b) \ -{ \ - T2 ## NDArray result (a.dims ()); \ - for (int i = 0; i < a.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = powf (a(i), b); \ - } \ - return octave_value (result); \ -} - - -#define OCTAVE_MS_INT_OPS(TYPE) \ - OCTAVE_MS_POW_OPS (TYPE, TYPE) \ - OCTAVE_MS_INT_ARITH_OPS (ms, TYPE ## _, TYPE ## _, TYPE) \ - OCTAVE_MS_INT_ARITH_OPS (msx, TYPE ## _, , TYPE) \ - OCTAVE_MS_INT_ARITH_OPS (mxs, , TYPE ## _, TYPE) \ - OCTAVE_MS_INT_ARITH_OPS (msfx, TYPE ## _, float_, TYPE) \ - OCTAVE_MS_INT_ARITH_OPS (mfxs, float_, TYPE ## _, TYPE) \ - OCTAVE_MS_INT_CMP_OPS (ms, TYPE ## _, TYPE ## _) \ - OCTAVE_MS_INT_CMP_OPS (mx, TYPE ## _, ) \ - OCTAVE_MS_INT_CMP_OPS (mxs, , TYPE ## _) \ - OCTAVE_MS_INT_CMP_OPS (mfx, TYPE ## _, float_) \ - OCTAVE_MS_INT_CMP_OPS (mfxs, float_, TYPE ## _) \ - OCTAVE_MS_INT_BOOL_OPS (ms, TYPE ## _, TYPE ## _) \ - OCTAVE_MS_INT_BOOL_OPS (mx, TYPE ## _, ) \ - OCTAVE_MS_INT_BOOL_OPS (mxs, , TYPE ## _) \ - OCTAVE_MS_INT_BOOL_OPS (mfx, TYPE ## _, float_) \ - OCTAVE_MS_INT_BOOL_OPS (mfxs, float_, TYPE ## _) \ - OCTAVE_MS_INT_ASSIGN_OPS (ms, TYPE ## _, TYPE ## _, TYPE ## _) \ - OCTAVE_MS_INT_ASSIGNEQ_OPS (mse, TYPE ## _) \ - OCTAVE_MS_INT_ASSIGN_OPS (mx, TYPE ## _, , ) \ - OCTAVE_MS_INT_ASSIGN_OPS (mfx, TYPE ## _, float_, float_) - -#define OCTAVE_M_INT_UNOPS(TYPE) \ - /* matrix unary ops. */ \ - \ - DEFNDUNOP_OP (m_not, TYPE ## _matrix, TYPE ## _array, !) \ - DEFNDUNOP_OP (m_uplus, TYPE ## _matrix, TYPE ## _array, /* no-op */) \ - DEFUNOP (m_uminus, TYPE ## _matrix) \ - { \ - CAST_UNOP_ARG (const octave_ ## TYPE ## _matrix &); \ - octave_value retval = octave_value (- v. TYPE ## _array_value ()); \ - return retval; \ - } \ - \ - DEFUNOP (m_transpose, TYPE ## _matrix) \ - { \ - CAST_UNOP_ARG (const octave_ ## TYPE ## _matrix&); \ - \ - if (v.ndims () > 2) \ - { \ - error ("transpose not defined for N-d objects"); \ - return octave_value (); \ - } \ - else \ - return octave_value (v.TYPE ## _array_value ().transpose ()); \ - } \ - \ - DEFNCUNOP_METHOD (m_incr, TYPE ## _matrix, increment) \ - DEFNCUNOP_METHOD (m_decr, TYPE ## _matrix, decrement) \ - DEFNCUNOP_METHOD (m_changesign, TYPE ## _matrix, changesign) - -#define OCTAVE_MM_INT_ARITH_OPS(PFX, T1, T2, T3) \ - /* matrix by matrix ops. */ \ - \ - DEFINTNDBINOP_OP (PFX ## _add, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, +, T3) \ - DEFINTNDBINOP_OP (PFX ## _sub, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, -, T3) \ - \ - /* DEFBINOP_OP (PFX ## _mul, T1 ## matrix, T2 ## matrix, *) */ \ - /* DEFBINOP_FN (PFX ## _div, T1 ## matrix, T2 ## matrix, xdiv) */ \ - \ - DEFBINOPX (PFX ## _pow, T1 ## matrix, T2 ## matrix) \ - { \ - error ("can't do A ^ B for A and B both matrices"); \ - return octave_value (); \ - } \ - \ - /* DEFBINOP_FN (PFX ## _ldiv, T1 ## matrix, T2 ## matrix, xleftdiv) */ \ - \ - DEFINTNDBINOP_FN (PFX ## _el_mul, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, product, T3, .*) \ - \ - DEFINTNDBINOP_FN (PFX ## _el_div, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, quotient, T3, ./) \ - \ - DEFINTNDBINOP_FN (PFX ## _el_pow, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, elem_xpow, T3, .^) \ - \ - DEFBINOP (PFX ## _el_ldiv, T1 ## matrix, T2 ## matrix) \ - { \ - CAST_BINOP_ARGS (const octave_ ## T1 ## matrix&, const octave_ ## T2 ## matrix&); \ - \ - octave_value retval = octave_value (quotient (v2.T2 ## array_value (), v1.T1 ## array_value ())); \ - return retval; \ - } - -#define OCTAVE_MM_INT_CMP_OPS(PFX, T1, T2) \ - DEFNDBINOP_FN (PFX ## _lt, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_lt) \ - DEFNDBINOP_FN (PFX ## _le, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_le) \ - DEFNDBINOP_FN (PFX ## _eq, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_eq) \ - DEFNDBINOP_FN (PFX ## _ge, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_ge) \ - DEFNDBINOP_FN (PFX ## _gt, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_gt) \ - DEFNDBINOP_FN (PFX ## _ne, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_ne) - -#define OCTAVE_MM_INT_BOOL_OPS(PFX, T1, T2) \ - DEFNDBINOP_FN (PFX ## _el_and, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_and) \ - DEFNDBINOP_FN (PFX ## _el_or, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_or) \ - DEFNDBINOP_FN (PFX ## _el_not_and, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_not_and) \ - DEFNDBINOP_FN (PFX ## _el_not_or, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_not_or) \ - DEFNDBINOP_FN (PFX ## _el_and_not, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_and_not) \ - DEFNDBINOP_FN (PFX ## _el_or_not, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_or_not) - -#define OCTAVE_MM_INT_ASSIGN_OPS(PFX, TLHS, TRHS, TE) \ - DEFNDASSIGNOP_FN (PFX ## _assign, TLHS ## matrix, TRHS ## matrix, TLHS ## array, assign) - -#define OCTAVE_MM_INT_ASSIGNEQ_OPS(PFX, TM) \ - DEFNDASSIGNOP_OP (PFX ## _assign_add, TM ## matrix, TM ## matrix, TM ## array, +=) \ - DEFNDASSIGNOP_OP (PFX ## _assign_sub, TM ## matrix, TM ## matrix, TM ## array, -=) \ - DEFNDASSIGNOP_FNOP (PFX ## _assign_el_mul, TM ## matrix, TM ## matrix, TM ## array, product_eq) \ - DEFNDASSIGNOP_FNOP (PFX ## _assign_el_div, TM ## matrix, TM ## matrix, TM ## array, quotient_eq) - -#define OCTAVE_MM_POW_OPS(T1, T2) \ - octave_value \ - elem_xpow (const T1 ## NDArray& a, const T2 ## NDArray& b) \ - { \ - dim_vector a_dims = a.dims (); \ - dim_vector b_dims = b.dims (); \ - if (a_dims != b_dims) \ - { \ - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ - { \ - return bsxfun_pow (a, b); \ - } \ - else \ - { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ - } \ - } \ - T1 ## NDArray result (a_dims); \ - for (int i = 0; i < a.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = pow (a(i), b(i)); \ - } \ - return octave_value (result); \ - } \ -\ - octave_value \ - elem_xpow (const T1 ## NDArray& a, const NDArray& b) \ - { \ - dim_vector a_dims = a.dims (); \ - dim_vector b_dims = b.dims (); \ - if (a_dims != b_dims) \ - { \ - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ - { \ - return bsxfun_pow (a, b); \ - } \ - else \ - { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ - } \ - } \ - T1 ## NDArray result (a_dims); \ - for (int i = 0; i < a.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = pow (a(i), b(i)); \ - } \ - return octave_value (result); \ - } \ -\ - octave_value \ - elem_xpow (const NDArray& a, const T2 ## NDArray& b) \ - { \ - dim_vector a_dims = a.dims (); \ - dim_vector b_dims = b.dims (); \ - if (a_dims != b_dims) \ - { \ - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ - { \ - return bsxfun_pow (a, b); \ - } \ - else \ - { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ - } \ - } \ - T2 ## NDArray result (a_dims); \ - for (int i = 0; i < a.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = pow (a(i), b(i)); \ - } \ - return octave_value (result); \ - } \ -\ - octave_value \ - elem_xpow (const T1 ## NDArray& a, const FloatNDArray& b) \ - { \ - dim_vector a_dims = a.dims (); \ - dim_vector b_dims = b.dims (); \ - if (a_dims != b_dims) \ - { \ - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ - { \ - return bsxfun_pow (a, b); \ - } \ - else \ - { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ - } \ - } \ - T1 ## NDArray result (a_dims); \ - for (int i = 0; i < a.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = powf (a(i), b(i)); \ - } \ - return octave_value (result); \ - } \ -\ - octave_value \ - elem_xpow (const FloatNDArray& a, const T2 ## NDArray& b) \ - { \ - dim_vector a_dims = a.dims (); \ - dim_vector b_dims = b.dims (); \ - if (a_dims != b_dims) \ - { \ - if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ - { \ - return bsxfun_pow (a, b); \ - } \ - else \ - { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ - } \ - } \ - T2 ## NDArray result (a_dims); \ - for (int i = 0; i < a.length (); i++) \ - { \ - OCTAVE_QUIT; \ - result (i) = powf (a(i), b(i)); \ - } \ - return octave_value (result); \ - } - - -#define OCTAVE_MM_CONV(T1, T2) \ - DEFCONV (T1 ## m_ ## T2 ## m_conv, T1 ## matrix, T2 ## matrix) \ - { \ - CAST_CONV_ARG (const octave_ ## T1 ## matrix&); \ - \ - return new octave_ ## T2 ## matrix (v.T2 ## array_value ()); \ - } - -#define OCTAVE_MM_INT_OPS(TYPE) \ - OCTAVE_M_INT_UNOPS (TYPE) \ - OCTAVE_MM_POW_OPS (TYPE, TYPE) \ - OCTAVE_MM_INT_ARITH_OPS (mm, TYPE ## _, TYPE ## _, TYPE) \ - OCTAVE_MM_INT_ARITH_OPS (mmx, TYPE ## _, , TYPE) \ - OCTAVE_MM_INT_ARITH_OPS (mxm, , TYPE ## _, TYPE) \ - OCTAVE_MM_INT_ARITH_OPS (mmfx, TYPE ## _, float_, TYPE) \ - OCTAVE_MM_INT_ARITH_OPS (mfxm, float_, TYPE ## _, TYPE) \ - OCTAVE_MM_INT_CMP_OPS (mm, TYPE ## _, TYPE ## _) \ - OCTAVE_MM_INT_CMP_OPS (mmx, TYPE ## _, ) \ - OCTAVE_MM_INT_CMP_OPS (mfxm, float_, TYPE ## _) \ - OCTAVE_MM_INT_CMP_OPS (mmfx, TYPE ## _, float_) \ - OCTAVE_MM_INT_CMP_OPS (mxm, , TYPE ## _) \ - OCTAVE_MM_INT_BOOL_OPS (mm, TYPE ## _, TYPE ## _) \ - OCTAVE_MM_INT_BOOL_OPS (mmx, TYPE ## _, ) \ - OCTAVE_MM_INT_BOOL_OPS (mxm, , TYPE ## _) \ - OCTAVE_MM_INT_BOOL_OPS (mmfx, TYPE ## _, float_) \ - OCTAVE_MM_INT_BOOL_OPS (mfxm, float_, TYPE ## _) \ - OCTAVE_MM_INT_ASSIGN_OPS (mm, TYPE ## _, TYPE ## _, TYPE ## _) \ - OCTAVE_MM_INT_ASSIGNEQ_OPS (mme, TYPE ## _) \ - OCTAVE_MM_INT_ASSIGN_OPS (mmx, TYPE ## _, , ) \ - OCTAVE_MM_INT_ASSIGN_OPS (mmfx, TYPE ## _, float_, float_) \ - OCTAVE_MM_CONV(TYPE ## _, complex_) \ - OCTAVE_MM_CONV(TYPE ## _, float_complex_) - -#define OCTAVE_RE_INT_ASSIGN_OPS(TYPE) \ - DEFNDASSIGNOP_FN (TYPE ## ms_assign, matrix, TYPE ## _scalar, array, assign) \ - DEFNDASSIGNOP_FN (TYPE ## mm_assign, matrix, TYPE ## _matrix, array, assign) - -#define OCTAVE_FLT_RE_INT_ASSIGN_OPS(TYPE) \ - DEFNDASSIGNOP_FN (TYPE ## fms_assign, float_matrix, TYPE ## _scalar, float_array, assign) \ - DEFNDASSIGNOP_FN (TYPE ## fmm_assign, float_matrix, TYPE ## _matrix, float_array, assign) - -#define OCTAVE_CX_INT_ASSIGN_OPS(TYPE) \ - DEFNDASSIGNOP_FN (TYPE ## cms_assign, complex_matrix, TYPE ## _scalar, complex_array, assign) \ - DEFNDASSIGNOP_FN (TYPE ## cmm_assign, complex_matrix, TYPE ## _matrix, complex_array, assign) - -#define OCTAVE_FLT_CX_INT_ASSIGN_OPS(TYPE) \ - DEFNDASSIGNOP_FN (TYPE ## fcms_assign, float_complex_matrix, TYPE ## _scalar, float_complex_array, assign) \ - DEFNDASSIGNOP_FN (TYPE ## fcmm_assign, float_complex_matrix, TYPE ## _matrix, float_complex_array, assign) - -#define OCTAVE_INT_NULL_ASSIGN_OPS(TYPE) \ - DEFNULLASSIGNOP_FN (TYPE ## null_assign, TYPE ## _matrix, delete_elements) - -#define OCTAVE_INT_OPS(TYPE) \ - OCTAVE_SS_INT_OPS (TYPE) \ - OCTAVE_SM_INT_OPS (TYPE) \ - OCTAVE_MS_INT_OPS (TYPE) \ - OCTAVE_MM_INT_OPS (TYPE) \ - OCTAVE_CONCAT_FN (TYPE) \ - OCTAVE_RE_INT_ASSIGN_OPS (TYPE) \ - OCTAVE_FLT_RE_INT_ASSIGN_OPS (TYPE) \ - OCTAVE_CX_INT_ASSIGN_OPS (TYPE) \ - OCTAVE_FLT_CX_INT_ASSIGN_OPS (TYPE) \ - OCTAVE_INT_NULL_ASSIGN_OPS(TYPE) - -#define OCTAVE_INSTALL_S_INT_UNOPS(TYPE) \ - INSTALL_UNOP (op_not, octave_ ## TYPE ## _scalar, s_not); \ - INSTALL_UNOP (op_uplus, octave_ ## TYPE ## _scalar, s_uplus); \ - INSTALL_UNOP (op_uminus, octave_ ## TYPE ## _scalar, s_uminus); \ - INSTALL_UNOP (op_transpose, octave_ ## TYPE ## _scalar, s_transpose); \ - INSTALL_UNOP (op_hermitian, octave_ ## TYPE ## _scalar, s_hermitian); \ - \ - INSTALL_NCUNOP (op_incr, octave_ ## TYPE ## _scalar, s_incr); \ - INSTALL_NCUNOP (op_decr, octave_ ## TYPE ## _scalar, s_decr); - -#define OCTAVE_INSTALL_SS_INT_ARITH_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_add, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _add); \ - INSTALL_BINOP (op_sub, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _sub); \ - INSTALL_BINOP (op_mul, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _mul); \ - INSTALL_BINOP (op_div, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _div); \ - INSTALL_BINOP (op_pow, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _pow); \ - INSTALL_BINOP (op_ldiv, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _ldiv); \ - INSTALL_BINOP (op_el_mul, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_mul); \ - INSTALL_BINOP (op_el_div, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_div); \ - INSTALL_BINOP (op_el_pow, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_pow); \ - INSTALL_BINOP (op_el_ldiv, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_ldiv); - -#define OCTAVE_INSTALL_SS_INT_CMP_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_lt, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _lt); \ - INSTALL_BINOP (op_le, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _le); \ - INSTALL_BINOP (op_eq, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _eq); \ - INSTALL_BINOP (op_ge, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _ge); \ - INSTALL_BINOP (op_gt, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _gt); \ - INSTALL_BINOP (op_ne, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _ne); - -#define OCTAVE_INSTALL_SS_INT_BOOL_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_el_and, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_and); \ - INSTALL_BINOP (op_el_or, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_or); - -#define OCTAVE_INSTALL_SS_INT_OPS(TYPE) \ - OCTAVE_INSTALL_S_INT_UNOPS (TYPE) \ - OCTAVE_INSTALL_SS_INT_ARITH_OPS (ss, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_SS_INT_ARITH_OPS (ssx, TYPE ## _, ) \ - OCTAVE_INSTALL_SS_INT_ARITH_OPS (sxs, , TYPE ## _) \ - OCTAVE_INSTALL_SS_INT_ARITH_OPS (ssfx, TYPE ## _, float_) \ - OCTAVE_INSTALL_SS_INT_ARITH_OPS (sfxs, float_, TYPE ## _) \ - OCTAVE_INSTALL_SS_INT_CMP_OPS (ss, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_SS_INT_CMP_OPS (sx, TYPE ## _, ) \ - OCTAVE_INSTALL_SS_INT_CMP_OPS (xs, , TYPE ## _) \ - OCTAVE_INSTALL_SS_INT_CMP_OPS (sfx, TYPE ## _, float_) \ - OCTAVE_INSTALL_SS_INT_CMP_OPS (fxs, float_, TYPE ## _) \ - OCTAVE_INSTALL_SS_INT_BOOL_OPS (ss, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_SS_INT_BOOL_OPS (sx, TYPE ## _, ) \ - OCTAVE_INSTALL_SS_INT_BOOL_OPS (xs, , TYPE ## _) \ - OCTAVE_INSTALL_SS_INT_BOOL_OPS (sfx, TYPE ## _, float_) \ - OCTAVE_INSTALL_SS_INT_BOOL_OPS (fxs, float_, TYPE ## _) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _matrix) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_scalar, octave_ ## TYPE ## _matrix) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_float_scalar, octave_ ## TYPE ## _matrix) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_complex_scalar, octave_complex_matrix) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_float_complex_scalar, octave_float_complex_matrix) - -#define OCTAVE_INSTALL_SM_INT_ARITH_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_add, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _add); \ - INSTALL_BINOP (op_sub, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _sub); \ - INSTALL_BINOP (op_mul, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _mul); \ - /* INSTALL_BINOP (op_div, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _div); */ \ - /* INSTALL_BINOP (op_pow, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _pow); */ \ - INSTALL_BINOP (op_ldiv, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _ldiv); \ - INSTALL_BINOP (op_el_mul, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_mul); \ - INSTALL_BINOP (op_el_div, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_div); \ - INSTALL_BINOP (op_el_pow, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_pow); \ - INSTALL_BINOP (op_el_ldiv, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_ldiv); - -#define OCTAVE_INSTALL_SM_INT_CMP_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_lt, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _lt); \ - INSTALL_BINOP (op_le, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _le); \ - INSTALL_BINOP (op_eq, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _eq); \ - INSTALL_BINOP (op_ge, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _ge); \ - INSTALL_BINOP (op_gt, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _gt); \ - INSTALL_BINOP (op_ne, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _ne); - -#define OCTAVE_INSTALL_SM_INT_BOOL_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_el_and, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_and); \ - INSTALL_BINOP (op_el_or, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_or); \ - INSTALL_BINOP (op_el_and_not, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_and_not); \ - INSTALL_BINOP (op_el_or_not, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_or_not); - -#define OCTAVE_INSTALL_SM_INT_OPS(TYPE) \ - OCTAVE_INSTALL_SM_INT_ARITH_OPS (sm, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_SM_INT_ARITH_OPS (smx, TYPE ## _, ) \ - OCTAVE_INSTALL_SM_INT_ARITH_OPS (sxm, , TYPE ## _) \ - OCTAVE_INSTALL_SM_INT_ARITH_OPS (smfx, TYPE ## _, float_) \ - OCTAVE_INSTALL_SM_INT_ARITH_OPS (sfxm, float_, TYPE ## _) \ - OCTAVE_INSTALL_SM_INT_CMP_OPS (sm, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_SM_INT_CMP_OPS (xm, , TYPE ## _) \ - OCTAVE_INSTALL_SM_INT_CMP_OPS (smx, TYPE ## _, ) \ - OCTAVE_INSTALL_SM_INT_CMP_OPS (fxm, float_, TYPE ## _) \ - OCTAVE_INSTALL_SM_INT_CMP_OPS (smfx, TYPE ## _, float_) \ - OCTAVE_INSTALL_SM_INT_BOOL_OPS (sm, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_SM_INT_BOOL_OPS (xm, , TYPE ## _) \ - OCTAVE_INSTALL_SM_INT_BOOL_OPS (smx, TYPE ## _, ) \ - OCTAVE_INSTALL_SM_INT_BOOL_OPS (fxm, float_, TYPE ## _) \ - OCTAVE_INSTALL_SM_INT_BOOL_OPS (smfx, TYPE ## _, float_) \ - INSTALL_WIDENOP (octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _matrix, TYPE ## _s_ ## TYPE ## _m_conv) \ - INSTALL_WIDENOP (octave_ ## TYPE ## _scalar, octave_complex_matrix, TYPE ## _s_complex_m_conv) \ - INSTALL_WIDENOP (octave_ ## TYPE ## _scalar, octave_float_complex_matrix, TYPE ## _s_float_complex_m_conv) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _matrix, octave_ ## TYPE ## _matrix) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_matrix, octave_ ## TYPE ## _matrix) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_float_matrix, octave_ ## TYPE ## _matrix) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_complex_matrix, octave_complex_matrix) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_float_complex_matrix, octave_float_complex_matrix) - -#define OCTAVE_INSTALL_MS_INT_ARITH_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_add, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _add); \ - INSTALL_BINOP (op_sub, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _sub); \ - INSTALL_BINOP (op_mul, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _mul); \ - INSTALL_BINOP (op_div, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _div); \ - /* INSTALL_BINOP (op_pow, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _pow); */ \ - /* INSTALL_BINOP (op_ldiv, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _ldiv); */ \ - \ - INSTALL_BINOP (op_el_mul, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_mul); \ - INSTALL_BINOP (op_el_div, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_div); \ - INSTALL_BINOP (op_el_pow, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_pow); \ - INSTALL_BINOP (op_el_ldiv, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_ldiv); - -#define OCTAVE_INSTALL_MS_INT_CMP_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_lt, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _lt); \ - INSTALL_BINOP (op_le, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _le); \ - INSTALL_BINOP (op_eq, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _eq); \ - INSTALL_BINOP (op_ge, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _ge); \ - INSTALL_BINOP (op_gt, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _gt); \ - INSTALL_BINOP (op_ne, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _ne); - -#define OCTAVE_INSTALL_MS_INT_BOOL_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_el_and, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_and); \ - INSTALL_BINOP (op_el_or, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_or); \ - INSTALL_BINOP (op_el_not_and, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_not_and); \ - INSTALL_BINOP (op_el_not_or, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_not_or); - -#define OCTAVE_INSTALL_MS_INT_ASSIGN_OPS(PFX, TLHS, TRHS) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## scalar, PFX ## _assign) - -#define OCTAVE_INSTALL_MS_INT_ASSIGNEQ_OPS(PFX, TLHS, TRHS) \ - INSTALL_ASSIGNOP (op_add_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## scalar, PFX ## _assign_add) \ - INSTALL_ASSIGNOP (op_sub_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## scalar, PFX ## _assign_sub) \ - INSTALL_ASSIGNOP (op_mul_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## scalar, PFX ## _assign_mul) \ - INSTALL_ASSIGNOP (op_div_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## scalar, PFX ## _assign_div) - -#define OCTAVE_INSTALL_MS_INT_OPS(TYPE) \ - OCTAVE_INSTALL_MS_INT_ARITH_OPS (ms, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_MS_INT_ARITH_OPS (msx, TYPE ## _, ) \ - OCTAVE_INSTALL_MS_INT_ARITH_OPS (mxs, , TYPE ## _) \ - OCTAVE_INSTALL_MS_INT_ARITH_OPS (msfx, TYPE ## _, float_) \ - OCTAVE_INSTALL_MS_INT_ARITH_OPS (mfxs, float_, TYPE ## _) \ - OCTAVE_INSTALL_MS_INT_CMP_OPS (ms, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_MS_INT_CMP_OPS (mx, TYPE ## _, ) \ - OCTAVE_INSTALL_MS_INT_CMP_OPS (mxs, , TYPE ## _) \ - OCTAVE_INSTALL_MS_INT_CMP_OPS (mfx, TYPE ## _, float_) \ - OCTAVE_INSTALL_MS_INT_CMP_OPS (mfxs, float_, TYPE ## _) \ - OCTAVE_INSTALL_MS_INT_BOOL_OPS (ms, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_MS_INT_BOOL_OPS (mx, TYPE ## _, ) \ - OCTAVE_INSTALL_MS_INT_BOOL_OPS (mxs, , TYPE ## _) \ - OCTAVE_INSTALL_MS_INT_BOOL_OPS (mfx, TYPE ## _, float_) \ - OCTAVE_INSTALL_MS_INT_BOOL_OPS (mfxs, float_, TYPE ## _) \ - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (ms, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_MS_INT_ASSIGNEQ_OPS (mse, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mx, TYPE ## _, ) \ - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mfx, TYPE ## _, float_) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _matrix, octave_complex_scalar, octave_complex_matrix) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _matrix, octave_float_complex_scalar, octave_float_complex_matrix) - -#define OCTAVE_INSTALL_M_INT_UNOPS(TYPE) \ - INSTALL_UNOP (op_not, octave_ ## TYPE ## _matrix, m_not); \ - INSTALL_UNOP (op_uplus, octave_ ## TYPE ## _matrix, m_uplus); \ - INSTALL_UNOP (op_uminus, octave_ ## TYPE ## _matrix, m_uminus); \ - INSTALL_UNOP (op_transpose, octave_ ## TYPE ## _matrix, m_transpose); \ - INSTALL_UNOP (op_hermitian, octave_ ## TYPE ## _matrix, m_transpose); \ - \ - INSTALL_NCUNOP (op_incr, octave_ ## TYPE ## _matrix, m_incr); \ - INSTALL_NCUNOP (op_decr, octave_ ## TYPE ## _matrix, m_decr); \ - INSTALL_NCUNOP (op_uminus, octave_ ## TYPE ## _matrix, m_changesign); - -#define OCTAVE_INSTALL_MM_INT_ARITH_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_add, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _add); \ - INSTALL_BINOP (op_sub, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _sub); \ - /* INSTALL_BINOP (op_mul, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _mul); */ \ - /* INSTALL_BINOP (op_div, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _div); */ \ - INSTALL_BINOP (op_pow, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _pow); \ - /* INSTALL_BINOP (op_ldiv, octave_ ## T1 ## _matrix, octave_ ## T2 ## _matrix, mm_ldiv); */ \ - INSTALL_BINOP (op_el_mul, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_mul); \ - INSTALL_BINOP (op_el_div, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_div); \ - INSTALL_BINOP (op_el_pow, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_pow); \ - INSTALL_BINOP (op_el_ldiv, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_ldiv); - -#define OCTAVE_INSTALL_MM_INT_CMP_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_lt, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _lt); \ - INSTALL_BINOP (op_le, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _le); \ - INSTALL_BINOP (op_eq, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _eq); \ - INSTALL_BINOP (op_ge, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _ge); \ - INSTALL_BINOP (op_gt, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _gt); \ - INSTALL_BINOP (op_ne, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _ne); - -#define OCTAVE_INSTALL_MM_INT_BOOL_OPS(PFX, T1, T2) \ - INSTALL_BINOP (op_el_and, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_and); \ - INSTALL_BINOP (op_el_or, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_or); \ - INSTALL_BINOP (op_el_not_and, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_not_and); \ - INSTALL_BINOP (op_el_not_or, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_not_or); \ - INSTALL_BINOP (op_el_and_not, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_and_not); \ - INSTALL_BINOP (op_el_or_not, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_or_not); - -#define OCTAVE_INSTALL_MM_INT_ASSIGN_OPS(PFX, TLHS, TRHS) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## matrix, PFX ## _assign) - -#define OCTAVE_INSTALL_MM_INT_ASSIGNEQ_OPS(PFX, TLHS, TRHS) \ - INSTALL_ASSIGNOP (op_add_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## matrix, PFX ## _assign_add) \ - INSTALL_ASSIGNOP (op_sub_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## matrix, PFX ## _assign_sub) \ - INSTALL_ASSIGNOP (op_el_mul_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## matrix, PFX ## _assign_el_mul) \ - INSTALL_ASSIGNOP (op_el_div_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## matrix, PFX ## _assign_el_div) - -#define OCTAVE_INSTALL_MM_INT_OPS(TYPE) \ - OCTAVE_INSTALL_M_INT_UNOPS (TYPE) \ - OCTAVE_INSTALL_MM_INT_ARITH_OPS (mm, TYPE ##_, TYPE ## _) \ - OCTAVE_INSTALL_MM_INT_ARITH_OPS (mmx, TYPE ##_, ) \ - OCTAVE_INSTALL_MM_INT_ARITH_OPS (mxm, , TYPE ##_) \ - OCTAVE_INSTALL_MM_INT_ARITH_OPS (mmfx, TYPE ##_, float_) \ - OCTAVE_INSTALL_MM_INT_ARITH_OPS (mfxm, float_, TYPE ##_) \ - OCTAVE_INSTALL_MM_INT_CMP_OPS (mm, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_MM_INT_CMP_OPS (mmx, TYPE ## _, ) \ - OCTAVE_INSTALL_MM_INT_CMP_OPS (mxm, , TYPE ## _) \ - OCTAVE_INSTALL_MM_INT_CMP_OPS (mmfx, TYPE ## _, float_) \ - OCTAVE_INSTALL_MM_INT_CMP_OPS (mfxm, float_, TYPE ## _) \ - OCTAVE_INSTALL_MM_INT_BOOL_OPS (mm, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_MM_INT_BOOL_OPS (mmx, TYPE ## _, ) \ - OCTAVE_INSTALL_MM_INT_BOOL_OPS (mxm, , TYPE ## _) \ - OCTAVE_INSTALL_MM_INT_BOOL_OPS (mmfx, TYPE ## _, float_) \ - OCTAVE_INSTALL_MM_INT_BOOL_OPS (mfxm, float_, TYPE ## _) \ - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mm, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_MM_INT_ASSIGNEQ_OPS (mme, TYPE ## _, TYPE ## _) \ - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmx, TYPE ## _, ) \ - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmfx, TYPE ## _, float_) \ - INSTALL_WIDENOP (octave_ ## TYPE ## _matrix, octave_complex_matrix, TYPE ## _m_complex_m_conv) \ - INSTALL_WIDENOP (octave_ ## TYPE ## _matrix, octave_float_complex_matrix, TYPE ## _m_float_complex_m_conv) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _matrix, octave_complex_matrix, octave_complex_matrix) \ - INSTALL_ASSIGNCONV (octave_ ## TYPE ## _matrix, octave_float_complex_matrix, octave_float_complex_matrix) - -#define OCTAVE_INSTALL_RE_INT_ASSIGN_OPS(TYPE) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_ ## TYPE ## _scalar, TYPE ## ms_assign) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_ ## TYPE ## _matrix, TYPE ## mm_assign) \ - INSTALL_ASSIGNCONV (octave_scalar, octave_ ## TYPE ## _scalar, octave_matrix) \ - INSTALL_ASSIGNCONV (octave_matrix, octave_ ## TYPE ## _matrix, octave_matrix) - -#define OCTAVE_INSTALL_FLT_RE_INT_ASSIGN_OPS(TYPE) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_ ## TYPE ## _scalar, TYPE ## fms_assign) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_ ## TYPE ## _matrix, TYPE ## fmm_assign) \ - INSTALL_ASSIGNCONV (octave_float_scalar, octave_ ## TYPE ## _scalar, octave_float_matrix) \ - INSTALL_ASSIGNCONV (octave_float_matrix, octave_ ## TYPE ## _matrix, octave_float_matrix) - -#define OCTAVE_INSTALL_CX_INT_ASSIGN_OPS(TYPE) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_ ## TYPE ## _scalar, TYPE ## cms_assign) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_ ## TYPE ## _matrix, TYPE ## cmm_assign) \ - INSTALL_ASSIGNCONV (octave_complex_scalar, octave_ ## TYPE ## _scalar, octave_complex_matrix) \ - INSTALL_ASSIGNCONV (octave_complex_matrix, octave_ ## TYPE ## _matrix, octave_complex_matrix) - -#define OCTAVE_INSTALL_FLT_CX_INT_ASSIGN_OPS(TYPE) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_ ## TYPE ## _scalar, TYPE ## fcms_assign) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_ ## TYPE ## _matrix, TYPE ## fcmm_assign) \ - INSTALL_ASSIGNCONV (octave_float_complex_scalar, octave_ ## TYPE ## _scalar, octave_complex_matrix) \ - INSTALL_ASSIGNCONV (octave_float_complex_matrix, octave_ ## TYPE ## _matrix, octave_complex_matrix) - -#define OCTAVE_INSTALL_INT_NULL_ASSIGN_OPS(TYPE) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_ ## TYPE ## _matrix, octave_null_matrix, TYPE ## null_assign) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_ ## TYPE ## _matrix, octave_null_str, TYPE ## null_assign) \ - INSTALL_ASSIGNOP (op_asn_eq, octave_ ## TYPE ## _matrix, octave_null_sq_str, TYPE ## null_assign) - -#define OCTAVE_INSTALL_INT_OPS(TYPE) \ - OCTAVE_INSTALL_SS_INT_OPS (TYPE) \ - OCTAVE_INSTALL_SM_INT_OPS (TYPE) \ - OCTAVE_INSTALL_MS_INT_OPS (TYPE) \ - OCTAVE_INSTALL_MM_INT_OPS (TYPE) \ - OCTAVE_INSTALL_CONCAT_FN (TYPE) \ - OCTAVE_INSTALL_RE_INT_ASSIGN_OPS (TYPE) \ - OCTAVE_INSTALL_FLT_RE_INT_ASSIGN_OPS (TYPE) \ - OCTAVE_INSTALL_CX_INT_ASSIGN_OPS (TYPE) \ - OCTAVE_INSTALL_FLT_CX_INT_ASSIGN_OPS (TYPE) \ - OCTAVE_INSTALL_INT_NULL_ASSIGN_OPS(TYPE) - -#define OCTAVE_INSTALL_SM_INT_ASSIGNCONV(TLHS, TRHS) \ - INSTALL_ASSIGNCONV (octave_ ## TLHS ## _scalar, octave_ ## TRHS ## _scalar, octave_ ## TLHS ## _matrix) \ - INSTALL_ASSIGNCONV (octave_ ## TLHS ## _scalar, octave_ ## TRHS ## _matrix, octave_ ## TLHS ## _matrix) - -#define OCTAVE_MIXED_INT_CMP_OPS(T1, T2) \ - OCTAVE_SS_INT_CMP_OPS (T1 ## _ ## T2 ## _ss, T1 ## _, T2 ## _) \ - OCTAVE_SM_INT_CMP_OPS (T1 ## _ ## T2 ## _sm, T1 ## _, T2 ## _) \ - OCTAVE_MS_INT_CMP_OPS (T1 ## _ ## T2 ## _ms, T1 ## _, T2 ## _) \ - OCTAVE_MM_INT_CMP_OPS (T1 ## _ ## T2 ## _mm, T1 ## _, T2 ## _) - -#define OCTAVE_INSTALL_MIXED_INT_CMP_OPS(T1, T2) \ - OCTAVE_INSTALL_SS_INT_CMP_OPS (T1 ## _ ## T2 ## _ss, T1 ## _, T2 ## _) \ - OCTAVE_INSTALL_SM_INT_CMP_OPS (T1 ## _ ## T2 ## _sm, T1 ## _, T2 ## _) \ - OCTAVE_INSTALL_MS_INT_CMP_OPS (T1 ## _ ## T2 ## _ms, T1 ## _, T2 ## _) \ - OCTAVE_INSTALL_MM_INT_CMP_OPS (T1 ## _ ## T2 ## _mm, T1 ## _, T2 ## _) diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-m-cdm.cc --- a/src/OPERATORS/op-m-cdm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-re-mat.h" -#define RINCLUDE "ov-cx-diag.h" - -#define LMATRIX matrix -#define RMATRIX complex_diag_matrix -#define LDMATRIX complex_matrix - -#define LSHORT m -#define RSHORT cdm - -#define DEFINEDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-m-cm.cc --- a/src/OPERATORS/op-m-cm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,166 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-m-cm.h" -#include "mx-cm-m.h" -#include "mx-nda-cnda.h" -#include "mx-cnda-nda.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix by complex matrix ops. - -DEFNDBINOP_OP (add, matrix, complex_matrix, array, complex_array, +) -DEFNDBINOP_OP (sub, matrix, complex_matrix, array, complex_array, -) - -DEFBINOP_OP (mul, matrix, complex_matrix, *) - -DEFBINOP (trans_mul, matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); - - Matrix m1 = v1.matrix_value (); - ComplexMatrix m2 = v2.complex_matrix_value (); - - return ComplexMatrix (xgemm (m1, real (m2), blas_trans, blas_no_trans), - xgemm (m1, imag (m2), blas_trans, blas_no_trans)); -} - -DEFBINOP (div, matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (v1.matrix_value (), - v2.complex_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOPX (pow, matrix, complex_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.matrix_value (), - v2.complex_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP (trans_ldiv, matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.matrix_value (), - v2.complex_matrix_value (), typ, blas_trans); - - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, matrix, complex_matrix, array, complex_array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, matrix, complex_matrix, array, complex_array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, matrix, complex_matrix, array, complex_array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, matrix, complex_matrix, array, complex_array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, matrix, complex_matrix, array, complex_array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, matrix, complex_matrix, array, complex_array, mx_el_ne) - -DEFNDBINOP_FN (el_mul, matrix, complex_matrix, array, complex_array, product) -DEFNDBINOP_FN (el_div, matrix, complex_matrix, array, complex_array, quotient) -DEFNDBINOP_FN (el_pow, matrix, complex_matrix, array, complex_array, elem_xpow) - -DEFBINOP (el_ldiv, matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); - - return quotient (v2.complex_array_value (), v1.array_value ()); -} - -DEFNDBINOP_FN (el_and, matrix, complex_matrix, array, complex_array, mx_el_and) -DEFNDBINOP_FN (el_or, matrix, complex_matrix, array, complex_array, mx_el_or) - -DEFNDCATOP_FN (m_cm, matrix, complex_matrix, array, complex_array, concat) - -DEFCONV (complex_matrix_conv, matrix, complex_matrix) -{ - CAST_CONV_ARG (const octave_matrix&); - - return new octave_complex_matrix (ComplexNDArray (v.array_value ())); -} - -void -install_m_cm_ops (void) -{ - INSTALL_BINOP (op_add, octave_matrix, octave_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_matrix, octave_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_matrix, octave_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_matrix, octave_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_matrix, octave_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_matrix, octave_complex_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_matrix, octave_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_matrix, octave_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_matrix, octave_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_matrix, octave_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_matrix, octave_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_matrix, octave_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_matrix, octave_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_matrix, octave_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_matrix, octave_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_matrix, octave_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_matrix, octave_complex_matrix, el_or); - INSTALL_BINOP (op_trans_mul, octave_matrix, octave_complex_matrix, trans_mul); - INSTALL_BINOP (op_herm_mul, octave_matrix, octave_complex_matrix, trans_mul); - INSTALL_BINOP (op_trans_ldiv, octave_matrix, octave_complex_matrix, trans_ldiv); - INSTALL_BINOP (op_herm_ldiv, octave_matrix, octave_complex_matrix, trans_ldiv); - - INSTALL_CATOP (octave_matrix, octave_complex_matrix, m_cm); - - INSTALL_ASSIGNCONV (octave_matrix, octave_complex_matrix, octave_complex_matrix); - INSTALL_ASSIGNCONV (octave_float_matrix, octave_complex_matrix, octave_float_complex_matrix); - - INSTALL_WIDENOP (octave_matrix, octave_complex_matrix, complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-m-cs.cc --- a/src/OPERATORS/op-m-cs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,140 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-m-cs.h" -#include "mx-cs-m.h" -#include "mx-nda-cs.h" -#include "mx-cs-nda.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-complex.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix by complex scalar ops. - -DEFNDBINOP_OP (add, matrix, complex, array, complex, +) -DEFNDBINOP_OP (sub, matrix, complex, array, complex, -) -DEFNDBINOP_OP (mul, matrix, complex, array, complex, *) - -DEFBINOP (div, matrix, complex) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); - - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.array_value () / d); -} - -DEFBINOP_FN (pow, matrix, complex, xpow) - -DEFBINOP (ldiv, matrix, complex) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); - - Matrix m1 = v1.matrix_value (); - ComplexMatrix m2 = v2.complex_matrix_value (); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (m1, m2, typ); - - v1.matrix_type (typ); - return ret; -} - -DEFNDCMPLXCMPOP_FN (lt, matrix, complex, array, complex, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, matrix, complex, array, complex, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, matrix, complex, array, complex, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, matrix, complex, array, complex, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, matrix, complex, array, complex, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, matrix, complex, array, complex, mx_el_ne) - -DEFNDBINOP_OP (el_mul, matrix, complex, array, complex, *) - -DEFBINOP (el_div, matrix, complex) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); - - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.array_value () / d); -} - -DEFNDBINOP_FN (el_pow, matrix, complex, array, complex, elem_xpow) - -DEFBINOP (el_ldiv, matrix, complex) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); - - return x_el_div (v2.complex_value (), v1.array_value ()); -} - -DEFNDBINOP_FN (el_and, matrix, complex, array, complex, mx_el_and) -DEFNDBINOP_FN (el_or, matrix, complex, array, complex, mx_el_or) - -DEFNDCATOP_FN (m_cs, matrix, complex, array, complex_array, concat) - -void -install_m_cs_ops (void) -{ - INSTALL_BINOP (op_add, octave_matrix, octave_complex, add); - INSTALL_BINOP (op_sub, octave_matrix, octave_complex, sub); - INSTALL_BINOP (op_mul, octave_matrix, octave_complex, mul); - INSTALL_BINOP (op_div, octave_matrix, octave_complex, div); - INSTALL_BINOP (op_pow, octave_matrix, octave_complex, pow); - INSTALL_BINOP (op_ldiv, octave_matrix, octave_complex, ldiv); - INSTALL_BINOP (op_lt, octave_matrix, octave_complex, lt); - INSTALL_BINOP (op_le, octave_matrix, octave_complex, le); - INSTALL_BINOP (op_eq, octave_matrix, octave_complex, eq); - INSTALL_BINOP (op_ge, octave_matrix, octave_complex, ge); - INSTALL_BINOP (op_gt, octave_matrix, octave_complex, gt); - INSTALL_BINOP (op_ne, octave_matrix, octave_complex, ne); - INSTALL_BINOP (op_el_mul, octave_matrix, octave_complex, el_mul); - INSTALL_BINOP (op_el_div, octave_matrix, octave_complex, el_div); - INSTALL_BINOP (op_el_pow, octave_matrix, octave_complex, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_complex, el_ldiv); - INSTALL_BINOP (op_el_and, octave_matrix, octave_complex, el_and); - INSTALL_BINOP (op_el_or, octave_matrix, octave_complex, el_or); - - INSTALL_CATOP (octave_matrix, octave_complex, m_cs); - - INSTALL_ASSIGNCONV (octave_matrix, octave_complex, octave_complex_matrix); - INSTALL_ASSIGNCONV (octave_float_matrix, octave_complex, octave_float_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-m-dm.cc --- a/src/OPERATORS/op-m-dm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define LINCLUDE "ov-re-mat.h" -#define RINCLUDE "ov-re-diag.h" - -#define LMATRIX matrix -#define RMATRIX diag_matrix - -#define LSHORT m -#define RSHORT dm - -#define DEFINEDIV - -#include "op-dm-template.cc" - diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-m-m.cc --- a/src/OPERATORS/op-m-m.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,223 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix unary ops. - -DEFNDUNOP_OP (not, matrix, array, !) -DEFNDUNOP_OP (uplus, matrix, array, /* no-op */) -DEFNDUNOP_OP (uminus, matrix, array, -) - -DEFUNOP (transpose, matrix) -{ - CAST_UNOP_ARG (const octave_matrix&); - - if (v.ndims () > 2) - { - error ("transpose not defined for N-d objects"); - return octave_value (); - } - else - return octave_value (v.matrix_value ().transpose ()); -} - -DEFNCUNOP_METHOD (incr, matrix, increment) -DEFNCUNOP_METHOD (decr, matrix, decrement) -DEFNCUNOP_METHOD (changesign, matrix, changesign) - -// matrix by matrix ops. - -DEFNDBINOP_OP (add, matrix, matrix, array, array, +) -DEFNDBINOP_OP (sub, matrix, matrix, array, array, -) - -DEFBINOP_OP (mul, matrix, matrix, *) - -DEFBINOP (div, matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); - MatrixType typ = v2.matrix_type (); - - Matrix ret = xdiv (v1.matrix_value (), v2.matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOPX (pow, matrix, matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); - MatrixType typ = v1.matrix_type (); - - Matrix ret = xleftdiv (v1.matrix_value (), v2.matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP (trans_mul, matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); - return octave_value(xgemm (v1.matrix_value (), v2.matrix_value (), - blas_trans, blas_no_trans)); -} - -DEFBINOP (mul_trans, matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); - return octave_value(xgemm (v1.matrix_value (), v2.matrix_value (), - blas_no_trans, blas_trans)); -} - -DEFBINOP (trans_ldiv, matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); - MatrixType typ = v1.matrix_type (); - - Matrix ret = xleftdiv (v1.matrix_value (), v2.matrix_value (), typ, blas_trans); - - v1.matrix_type (typ); - return ret; -} - -DEFNDBINOP_FN (lt, matrix, matrix, array, array, mx_el_lt) -DEFNDBINOP_FN (le, matrix, matrix, array, array, mx_el_le) -DEFNDBINOP_FN (eq, matrix, matrix, array, array, mx_el_eq) -DEFNDBINOP_FN (ge, matrix, matrix, array, array, mx_el_ge) -DEFNDBINOP_FN (gt, matrix, matrix, array, array, mx_el_gt) -DEFNDBINOP_FN (ne, matrix, matrix, array, array, mx_el_ne) - -DEFNDBINOP_FN (el_mul, matrix, matrix, array, array, product) -DEFNDBINOP_FN (el_div, matrix, matrix, array, array, quotient) -DEFNDBINOP_FN (el_pow, matrix, matrix, array, array, elem_xpow) - -DEFBINOP (el_ldiv, matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); - - return octave_value (quotient (v2.array_value (), v1.array_value ())); -} - -DEFNDBINOP_FN (el_and, matrix, matrix, array, array, mx_el_and) -DEFNDBINOP_FN (el_or, matrix, matrix, array, array, mx_el_or) -DEFNDBINOP_FN (el_not_and, matrix, matrix, array, array, mx_el_not_and) -DEFNDBINOP_FN (el_not_or, matrix, matrix, array, array, mx_el_not_or) -DEFNDBINOP_FN (el_and_not, matrix, matrix, array, array, mx_el_and_not) -DEFNDBINOP_FN (el_or_not, matrix, matrix, array, array, mx_el_or_not) - - -DEFNDCATOP_FN (m_m, matrix, matrix, array, array, concat) - -DEFNDASSIGNOP_FN (assign, matrix, matrix, array, assign) -DEFNDASSIGNOP_FN (sgl_assign, float_matrix, matrix, float_array, assign) - -DEFNULLASSIGNOP_FN (null_assign, matrix, delete_elements) - -DEFNDASSIGNOP_OP (assign_add, matrix, matrix, array, +=) -DEFNDASSIGNOP_OP (assign_sub, matrix, matrix, array, -=) -DEFNDASSIGNOP_FNOP (assign_el_mul, matrix, matrix, array, product_eq) -DEFNDASSIGNOP_FNOP (assign_el_div, matrix, matrix, array, quotient_eq) - -CONVDECL (matrix_to_float_matrix) -{ - CAST_CONV_ARG (const octave_matrix&); - - return new octave_float_matrix (FloatNDArray (v.array_value ())); -} - -void -install_m_m_ops (void) -{ - INSTALL_UNOP (op_not, octave_matrix, not); - INSTALL_UNOP (op_uplus, octave_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_matrix, transpose); - - INSTALL_NCUNOP (op_incr, octave_matrix, incr); - INSTALL_NCUNOP (op_decr, octave_matrix, decr); - INSTALL_NCUNOP (op_uminus, octave_matrix, changesign); - - INSTALL_BINOP (op_add, octave_matrix, octave_matrix, add); - INSTALL_BINOP (op_sub, octave_matrix, octave_matrix, sub); - INSTALL_BINOP (op_mul, octave_matrix, octave_matrix, mul); - INSTALL_BINOP (op_div, octave_matrix, octave_matrix, div); - INSTALL_BINOP (op_pow, octave_matrix, octave_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_matrix, octave_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_matrix, octave_matrix, lt); - INSTALL_BINOP (op_le, octave_matrix, octave_matrix, le); - INSTALL_BINOP (op_eq, octave_matrix, octave_matrix, eq); - INSTALL_BINOP (op_ge, octave_matrix, octave_matrix, ge); - INSTALL_BINOP (op_gt, octave_matrix, octave_matrix, gt); - INSTALL_BINOP (op_ne, octave_matrix, octave_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_matrix, octave_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_matrix, octave_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_matrix, octave_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_matrix, octave_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_matrix, octave_matrix, el_or); - INSTALL_BINOP (op_el_and_not, octave_matrix, octave_matrix, el_and_not); - INSTALL_BINOP (op_el_or_not, octave_matrix, octave_matrix, el_or_not); - INSTALL_BINOP (op_el_not_and, octave_matrix, octave_matrix, el_not_and); - INSTALL_BINOP (op_el_not_or, octave_matrix, octave_matrix, el_not_or); - INSTALL_BINOP (op_trans_mul, octave_matrix, octave_matrix, trans_mul); - INSTALL_BINOP (op_mul_trans, octave_matrix, octave_matrix, mul_trans); - INSTALL_BINOP (op_herm_mul, octave_matrix, octave_matrix, trans_mul); - INSTALL_BINOP (op_mul_herm, octave_matrix, octave_matrix, mul_trans); - INSTALL_BINOP (op_trans_ldiv, octave_matrix, octave_matrix, trans_ldiv); - INSTALL_BINOP (op_herm_ldiv, octave_matrix, octave_matrix, trans_ldiv); - - INSTALL_CATOP (octave_matrix, octave_matrix, m_m); - - INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_matrix, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_matrix, sgl_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_null_matrix, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_null_str, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_null_sq_str, null_assign); - - INSTALL_ASSIGNOP (op_add_eq, octave_matrix, octave_matrix, assign_add); - INSTALL_ASSIGNOP (op_sub_eq, octave_matrix, octave_matrix, assign_sub); - INSTALL_ASSIGNOP (op_el_mul_eq, octave_matrix, octave_matrix, assign_el_mul); - INSTALL_ASSIGNOP (op_el_div_eq, octave_matrix, octave_matrix, assign_el_div); - - INSTALL_CONVOP (octave_matrix, octave_float_matrix, matrix_to_float_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-m-pm.cc --- a/src/OPERATORS/op-m-pm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define MINCLUDE "ov-re-mat.h" - -#define LMATRIX matrix -#define RMATRIX perm_matrix - -#define LSHORT m -#define RSHORT pm - -#define RIGHT - -#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-m-s.cc --- a/src/OPERATORS/op-m-s.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,155 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-scalar.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// matrix by scalar ops. - -DEFNDBINOP_OP (add, matrix, scalar, array, scalar, +) -DEFNDBINOP_OP (sub, matrix, scalar, array, scalar, -) -DEFNDBINOP_OP (mul, matrix, scalar, array, scalar, *) - -DEFBINOP (div, matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); - - double d = v2.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.array_value () / d); -} - -DEFBINOP_FN (pow, matrix, scalar, xpow) - -DEFBINOP (ldiv, matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); - - Matrix m1 = v1.matrix_value (); - Matrix m2 = v2.matrix_value (); - MatrixType typ = v1.matrix_type (); - - Matrix ret = xleftdiv (m1, m2, typ); - - v1.matrix_type (typ); - return ret; -} - -DEFNDBINOP_FN (lt, matrix, scalar, array, scalar, mx_el_lt) -DEFNDBINOP_FN (le, matrix, scalar, array, scalar, mx_el_le) -DEFNDBINOP_FN (eq, matrix, scalar, array, scalar, mx_el_eq) -DEFNDBINOP_FN (ge, matrix, scalar, array, scalar, mx_el_ge) -DEFNDBINOP_FN (gt, matrix, scalar, array, scalar, mx_el_gt) -DEFNDBINOP_FN (ne, matrix, scalar, array, scalar, mx_el_ne) - -DEFNDBINOP_OP (el_mul, matrix, scalar, array, scalar, *) - -DEFBINOP (el_div, matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); - - double d = v2.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.array_value () / d); -} - -DEFNDBINOP_FN (el_pow, matrix, scalar, array, scalar, elem_xpow) - -DEFBINOP (el_ldiv, matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); - - return x_el_div (v2.double_value (), v1.array_value ()); -} - -DEFNDBINOP_FN (el_and, matrix, scalar, array, scalar, mx_el_and) -DEFNDBINOP_FN (el_or, matrix, scalar, array, scalar, mx_el_or) - -DEFNDCATOP_FN (m_s, matrix, scalar, array, array, concat) - -DEFNDASSIGNOP_FN (assign, matrix, scalar, scalar, assign) -DEFNDASSIGNOP_FN (sgl_assign, float_matrix, scalar, float_scalar, assign) -DEFNDASSIGNOP_FN (clx_sgl_assign, float_complex_matrix, scalar, float_complex, assign) - -DEFNDASSIGNOP_OP (assign_add, matrix, scalar, scalar, +=) -DEFNDASSIGNOP_OP (assign_sub, matrix, scalar, scalar, -=) -DEFNDASSIGNOP_OP (assign_mul, matrix, scalar, scalar, *=) -DEFNDASSIGNOP_OP (assign_div, matrix, scalar, scalar, /=) - -void -install_m_s_ops (void) -{ - INSTALL_BINOP (op_add, octave_matrix, octave_scalar, add); - INSTALL_BINOP (op_sub, octave_matrix, octave_scalar, sub); - INSTALL_BINOP (op_mul, octave_matrix, octave_scalar, mul); - INSTALL_BINOP (op_div, octave_matrix, octave_scalar, div); - INSTALL_BINOP (op_pow, octave_matrix, octave_scalar, pow); - INSTALL_BINOP (op_ldiv, octave_matrix, octave_scalar, ldiv); - - // INSTALL_BINOP (op_lt, octave_matrix, octave_scalar, lt); - - octave_value_typeinfo::register_binary_op - (octave_value::op_lt, octave_matrix::static_type_id (), - octave_scalar::static_type_id (), oct_binop_lt); - - INSTALL_BINOP (op_le, octave_matrix, octave_scalar, le); - INSTALL_BINOP (op_eq, octave_matrix, octave_scalar, eq); - INSTALL_BINOP (op_ge, octave_matrix, octave_scalar, ge); - INSTALL_BINOP (op_gt, octave_matrix, octave_scalar, gt); - INSTALL_BINOP (op_ne, octave_matrix, octave_scalar, ne); - INSTALL_BINOP (op_el_mul, octave_matrix, octave_scalar, el_mul); - INSTALL_BINOP (op_el_div, octave_matrix, octave_scalar, el_div); - INSTALL_BINOP (op_el_pow, octave_matrix, octave_scalar, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_scalar, el_ldiv); - INSTALL_BINOP (op_el_and, octave_matrix, octave_scalar, el_and); - INSTALL_BINOP (op_el_or, octave_matrix, octave_scalar, el_or); - - INSTALL_CATOP (octave_matrix, octave_scalar, m_s); - - INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_scalar, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_scalar, sgl_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_scalar, clx_sgl_assign); - - INSTALL_ASSIGNOP (op_add_eq, octave_matrix, octave_scalar, assign_add); - INSTALL_ASSIGNOP (op_sub_eq, octave_matrix, octave_scalar, assign_sub); - INSTALL_ASSIGNOP (op_mul_eq, octave_matrix, octave_scalar, assign_mul); - INSTALL_ASSIGNOP (op_div_eq, octave_matrix, octave_scalar, assign_div); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-m-scm.cc --- a/src/OPERATORS/op-m-scm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,175 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-re-mat.h" -#include "ov-cx-mat.h" -#include "ops.h" -#include "xdiv.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "smx-scm-m.h" -#include "smx-m-scm.h" -#include "ov-cx-sparse.h" - -// matrix by sparse complex matrix ops. - -DEFBINOP_OP (add, matrix, sparse_complex_matrix, +) -DEFBINOP_OP (sub, matrix, sparse_complex_matrix, -) - -DEFBINOP_OP (mul, matrix, sparse_complex_matrix, *) - -DEFBINOP (div, matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.array_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (v1.matrix_value (), - v2.sparse_complex_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOPX (pow, matrix, sparse_complex_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, - const octave_sparse_complex_matrix&); - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.matrix_value (), - v2.complex_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (lt, matrix, sparse_complex_matrix, mx_el_lt) -DEFBINOP_FN (le, matrix, sparse_complex_matrix, mx_el_le) -DEFBINOP_FN (eq, matrix, sparse_complex_matrix, mx_el_eq) -DEFBINOP_FN (ge, matrix, sparse_complex_matrix, mx_el_ge) -DEFBINOP_FN (gt, matrix, sparse_complex_matrix, mx_el_gt) -DEFBINOP_FN (ne, matrix, sparse_complex_matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, matrix, sparse_complex_matrix, product) -DEFBINOP_FN (el_div, matrix, sparse_complex_matrix, quotient) - -DEFBINOP (el_pow, matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, - const octave_sparse_complex_matrix&); - - return octave_value - (elem_xpow (SparseMatrix (v1.matrix_value ()), - v2.sparse_complex_matrix_value ())); -} - -DEFBINOP (el_ldiv, matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, - const octave_sparse_complex_matrix&); - return octave_value - (quotient (v2.sparse_complex_matrix_value (), v1.matrix_value ())); -} - -DEFBINOP_FN (el_and, matrix, sparse_complex_matrix, mx_el_and) -DEFBINOP_FN (el_or, matrix, sparse_complex_matrix, mx_el_or) - -DEFCATOP (m_scm, matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (octave_matrix&, const octave_sparse_complex_matrix&); - SparseMatrix tmp (v1.matrix_value ()); - return octave_value (tmp. concat (v2.sparse_complex_matrix_value (), - ra_idx)); -} - -DEFCONV (sparse_complex_matrix_conv, matrix, sparse_complex_matrix) -{ - CAST_CONV_ARG (const octave_matrix&); - return new octave_sparse_complex_matrix - (SparseComplexMatrix (v.complex_matrix_value ())); -} - -void -install_m_scm_ops (void) -{ - INSTALL_BINOP (op_add, octave_matrix, octave_sparse_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_matrix, octave_sparse_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_matrix, octave_sparse_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_matrix, octave_sparse_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_matrix, octave_sparse_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_matrix, octave_sparse_complex_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_matrix, octave_sparse_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_matrix, octave_sparse_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_matrix, octave_sparse_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_matrix, octave_sparse_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_matrix, octave_sparse_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_matrix, octave_sparse_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_matrix, octave_sparse_complex_matrix, - el_mul); - INSTALL_BINOP (op_el_div, octave_matrix, octave_sparse_complex_matrix, - el_div); - INSTALL_BINOP (op_el_pow, octave_matrix, octave_sparse_complex_matrix, - el_pow); - INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_sparse_complex_matrix, - el_ldiv); - INSTALL_BINOP (op_el_and, octave_matrix, octave_sparse_complex_matrix, - el_and); - INSTALL_BINOP (op_el_or, octave_matrix, octave_sparse_complex_matrix, - el_or); - - INSTALL_CATOP (octave_matrix, octave_sparse_complex_matrix, m_scm); - - INSTALL_ASSIGNCONV (octave_matrix, octave_sparse_complex_matrix, - octave_complex_matrix); - - INSTALL_WIDENOP (octave_matrix, octave_sparse_complex_matrix, - sparse_complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-m-sm.cc --- a/src/OPERATORS/op-m-sm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,167 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-re-mat.h" -#include "ops.h" -#include "xdiv.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "smx-sm-m.h" -#include "smx-m-sm.h" -#include "ov-re-sparse.h" - -// matrix by sparse matrix ops. - -DEFBINOP_OP (add, matrix, sparse_matrix, +) -DEFBINOP_OP (sub, matrix, sparse_matrix, -) - -DEFBINOP_OP (mul, matrix, sparse_matrix, *) - -DEFBINOP (div, matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - double d = v2.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.array_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - - Matrix ret = xdiv (v1.matrix_value (), v2.sparse_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOPX (pow, matrix, sparse_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_matrix&); - MatrixType typ = v1.matrix_type (); - - Matrix ret = xleftdiv (v1.matrix_value (), v2.matrix_value (), typ); - - v1.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (mul_trans, matrix, sparse_matrix, mul_trans); - -DEFBINOP_FN (lt, matrix, sparse_matrix, mx_el_lt) -DEFBINOP_FN (le, matrix, sparse_matrix, mx_el_le) -DEFBINOP_FN (eq, matrix, sparse_matrix, mx_el_eq) -DEFBINOP_FN (ge, matrix, sparse_matrix, mx_el_ge) -DEFBINOP_FN (gt, matrix, sparse_matrix, mx_el_gt) -DEFBINOP_FN (ne, matrix, sparse_matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, matrix, sparse_matrix, product) -DEFBINOP_FN (el_div, matrix, sparse_matrix, quotient) - -DEFBINOP (el_pow, matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_matrix&); - - return octave_value (elem_xpow (SparseMatrix (v1.matrix_value ()), - v2.sparse_matrix_value ())); -} - -DEFBINOP (el_ldiv, matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_matrix&); - - return octave_value - (quotient (v2.sparse_matrix_value (), v1.matrix_value ())); -} - -DEFBINOP_FN (el_and, matrix, sparse_matrix, mx_el_and) -DEFBINOP_FN (el_or, matrix, sparse_matrix, mx_el_or) - -DEFCATOP (m_sm, matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (octave_matrix&, const octave_sparse_matrix&); - SparseMatrix tmp (v1.matrix_value ()); - return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); -} - -DEFCONV (sparse_matrix_conv, matrix, sparse_matrix) -{ - CAST_CONV_ARG (const octave_matrix&); - return new octave_sparse_matrix (SparseMatrix (v.matrix_value ())); -} - -DEFNDASSIGNOP_FN (assign, matrix, sparse_matrix, array, assign) - -void -install_m_sm_ops (void) -{ - INSTALL_BINOP (op_add, octave_matrix, octave_sparse_matrix, add); - INSTALL_BINOP (op_sub, octave_matrix, octave_sparse_matrix, sub); - INSTALL_BINOP (op_mul, octave_matrix, octave_sparse_matrix, mul); - INSTALL_BINOP (op_div, octave_matrix, octave_sparse_matrix, div); - INSTALL_BINOP (op_pow, octave_matrix, octave_sparse_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_matrix, octave_sparse_matrix, ldiv); - INSTALL_BINOP (op_mul_trans, octave_matrix, octave_sparse_matrix, mul_trans); - INSTALL_BINOP (op_mul_herm, octave_matrix, octave_sparse_matrix, mul_trans); - INSTALL_BINOP (op_lt, octave_matrix, octave_sparse_matrix, lt); - INSTALL_BINOP (op_le, octave_matrix, octave_sparse_matrix, le); - INSTALL_BINOP (op_eq, octave_matrix, octave_sparse_matrix, eq); - INSTALL_BINOP (op_ge, octave_matrix, octave_sparse_matrix, ge); - INSTALL_BINOP (op_gt, octave_matrix, octave_sparse_matrix, gt); - INSTALL_BINOP (op_ne, octave_matrix, octave_sparse_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_matrix, octave_sparse_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_matrix, octave_sparse_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_matrix, octave_sparse_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_sparse_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_matrix, octave_sparse_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_matrix, octave_sparse_matrix, el_or); - - INSTALL_CATOP (octave_matrix, octave_sparse_matrix, m_sm); - - INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_sparse_matrix, assign) - INSTALL_ASSIGNCONV (octave_matrix, octave_sparse_matrix, octave_matrix) - - INSTALL_WIDENOP (octave_matrix, octave_sparse_matrix, - sparse_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-pm-cm.cc --- a/src/OPERATORS/op-pm-cm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define MINCLUDE "ov-cx-mat.h" - -#define LMATRIX perm_matrix -#define RMATRIX complex_matrix - -#define LSHORT pm -#define RSHORT cm - -#define LEFT - -#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-pm-fcm.cc --- a/src/OPERATORS/op-pm-fcm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define MINCLUDE "ov-flt-cx-mat.h" - -#define LMATRIX perm_matrix -#define RMATRIX float_complex_matrix - -#define LSHORT pm -#define RSHORT fcm - -#define LEFT - -#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-pm-fm.cc --- a/src/OPERATORS/op-pm-fm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define MINCLUDE "ov-flt-re-mat.h" - -#define LMATRIX perm_matrix -#define RMATRIX float_matrix - -#define LSHORT pm -#define RSHORT fm - -#define LEFT - -#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-pm-m.cc --- a/src/OPERATORS/op-pm-m.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#define MINCLUDE "ov-re-mat.h" - -#define LMATRIX perm_matrix -#define LDMATRIX matrix -#define RMATRIX matrix - -#define LSHORT pm -#define RSHORT m - -#define LEFT -#define DEFINENULLASSIGNCONV - -#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-pm-pm.cc --- a/src/OPERATORS/op-pm-pm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,87 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-perm.h" -#include "ov-re-mat.h" -#include "ov-scalar.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xpow.h" - -DEFUNOP (transpose, perm_matrix) -{ - CAST_UNOP_ARG (const octave_perm_matrix&); - return octave_value (v.perm_matrix_value ().transpose ()); -} - -DEFBINOP_OP (mul, perm_matrix, perm_matrix, *) - -DEFBINOP (div, perm_matrix, perm_matrix) -{ - CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); - - return (v1.perm_matrix_value () * v2.perm_matrix_value ().inverse ()); -} - -DEFBINOP (ldiv, perm_matrix, perm_matrix) -{ - CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); - - return (v1.perm_matrix_value ().inverse () * v2.perm_matrix_value ()); -} - -DEFBINOP (pow, perm_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_scalar&); - - return xpow (v1.perm_matrix_value (), v2.scalar_value ()); -} - -CONVDECL (perm_matrix_to_matrix) -{ - CAST_CONV_ARG (const octave_perm_matrix&); - - return new octave_matrix (v.matrix_value ()); -} - -void -install_pm_pm_ops (void) -{ - INSTALL_UNOP (op_transpose, octave_perm_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_perm_matrix, transpose); - - INSTALL_BINOP (op_mul, octave_perm_matrix, octave_perm_matrix, mul); - INSTALL_BINOP (op_div, octave_perm_matrix, octave_perm_matrix, div); - INSTALL_BINOP (op_ldiv, octave_perm_matrix, octave_perm_matrix, ldiv); - INSTALL_BINOP (op_pow, octave_perm_matrix, octave_scalar, pow); - - INSTALL_CONVOP (octave_perm_matrix, octave_matrix, perm_matrix_to_matrix); - INSTALL_ASSIGNCONV (octave_perm_matrix, octave_matrix, octave_matrix); - INSTALL_WIDENOP (octave_perm_matrix, octave_matrix, perm_matrix_to_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-pm-scm.cc --- a/src/OPERATORS/op-pm-scm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,97 +0,0 @@ -/* - -Copyright (C) 2009-2012 Jason Riedy - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ops.h" - -#include "ov-perm.h" -#include "ov-cx-sparse.h" - -// permutation matrix by sparse matrix ops - -DEFBINOP (mul_pm_scm, perm_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - std::complex d = v2.complex_value (); - - return octave_value (v1.sparse_matrix_value () * d); - } - else if (v1.rows () == 1 && v1.columns () == 1) - return octave_value (v2.sparse_complex_matrix_value ()); - else - return v1.perm_matrix_value () * v2.sparse_complex_matrix_value (); -} - -DEFBINOP (ldiv_pm_scm, perm_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_sparse_complex_matrix&); - - return v1.perm_matrix_value ().inverse () * v2.sparse_complex_matrix_value (); -} - -// sparse matrix by diagonal matrix ops - -DEFBINOP (mul_scm_pm, sparse_complex_matrix, perm_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_perm_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - std::complex d = v1.scalar_value (); - - return octave_value (d * v2.sparse_matrix_value ()); - } - else if (v2.rows () == 1 && v2.columns () == 1) - return octave_value (v1.sparse_complex_matrix_value ()); - else - return v1.sparse_complex_matrix_value () * v2.perm_matrix_value (); -} - -DEFBINOP (div_scm_pm, sparse_complex_matrix, perm_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_perm_matrix&); - - return v1.sparse_complex_matrix_value () * v2.perm_matrix_value ().inverse (); -} - -void -install_pm_scm_ops (void) -{ - INSTALL_BINOP (op_mul, octave_perm_matrix, octave_sparse_complex_matrix, - mul_pm_scm); - INSTALL_BINOP (op_ldiv, octave_perm_matrix, octave_sparse_complex_matrix, - ldiv_pm_scm); - INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_perm_matrix, - mul_scm_pm); - INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_perm_matrix, - div_scm_pm); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-pm-sm.cc --- a/src/OPERATORS/op-pm-sm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,150 +0,0 @@ -/* - -Copyright (C) 2009-2012 Jason Riedy - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ops.h" - -#include "ov-perm.h" -#include "ov-re-sparse.h" -#include "ov-bool-sparse.h" - -// Unary permutation ops, some cast to sparse - -//Avoid casting to a full matrix -DEFUNOP_OP (uplus, perm_matrix, /* no-op */) - -// Not calling standard CAST_UNOP_ARG for these next two because a -// dynamic_cast would fail. -DEFUNOP (not, perm_matrix) -{ - // Obviously negation of a permutation matrix destroys sparsity - return octave_value ( ! a.bool_array_value ()); -} - -DEFUNOP (uminus, perm_matrix) -{ - return octave_value ( - a.sparse_matrix_value ()); -} - -// Most other logical operations cast to SparseBoolMatrix -DEFBINOP (eq_pm, perm_matrix, perm_matrix) -{ - CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); - return v1.sparse_bool_matrix_value () == v2.sparse_bool_matrix_value (); -} -DEFBINOP (ne_pm, perm_matrix, perm_matrix) -{ - CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); - return v1.sparse_bool_matrix_value () != v2.sparse_bool_matrix_value (); -} -DEFBINOP (el_and_pm, perm_matrix, perm_matrix) -{ - CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); - return mx_el_and(v1.sparse_bool_matrix_value (), - v2.sparse_bool_matrix_value ()); -} -DEFBINOP (el_or_pm, perm_matrix, perm_matrix) -{ - CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); - return mx_el_or(v1.sparse_bool_matrix_value (), - v2.sparse_bool_matrix_value ()); -} - -// permutation matrix by sparse matrix ops - -DEFBINOP (mul_pm_sm, perm_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - double d = v2.scalar_value (); - - return octave_value (v1.sparse_matrix_value () * d); - } - else if (v1.rows () == 1 && v1.columns () == 1) - return octave_value (v2.sparse_matrix_value ()); - else - return v1.perm_matrix_value () * v2.sparse_matrix_value (); -} - -DEFBINOP (ldiv_pm_sm, perm_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_sparse_matrix&); - - return v1.perm_matrix_value ().inverse () * v2.sparse_matrix_value (); -} - -// sparse matrix by diagonal matrix ops - -DEFBINOP (mul_sm_pm, sparse_matrix, perm_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_perm_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - double d = v1.scalar_value (); - - return octave_value (d * v2.sparse_matrix_value ()); - } - else if (v2.rows () == 1 && v2.columns () == 1) - return octave_value (v1.sparse_matrix_value ()); - else - return v1.sparse_matrix_value () * v2.perm_matrix_value (); -} - -DEFBINOP (div_sm_pm, sparse_matrix, perm_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_perm_matrix&); - - return v1.sparse_matrix_value () * v2.perm_matrix_value ().inverse (); -} - -void -install_pm_sm_ops (void) -{ - INSTALL_UNOP (op_not, octave_perm_matrix, not); - INSTALL_UNOP (op_uplus, octave_perm_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_perm_matrix, uminus); - - - INSTALL_BINOP (op_mul, octave_perm_matrix, octave_sparse_matrix, - mul_pm_sm); - INSTALL_BINOP (op_ldiv, octave_perm_matrix, octave_sparse_matrix, - ldiv_pm_sm); - INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_perm_matrix, - mul_sm_pm); - INSTALL_BINOP (op_div, octave_sparse_matrix, octave_perm_matrix, - div_sm_pm); - - INSTALL_BINOP (op_eq, octave_perm_matrix, octave_perm_matrix, eq_pm); - INSTALL_BINOP (op_ne, octave_perm_matrix, octave_perm_matrix, ne_pm); - INSTALL_BINOP (op_el_and, octave_perm_matrix, octave_perm_matrix, el_and_pm); - INSTALL_BINOP (op_el_or, octave_perm_matrix, octave_perm_matrix, el_or_pm); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-pm-template.cc --- a/src/OPERATORS/op-pm-template.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,90 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "ov-perm.h" -#include MINCLUDE -#include "ops.h" -#ifdef DEFINENULLASSIGNCONV -#include "ov-null-mat.h" -#endif - -#ifndef LDMATRIX -#define LDMATRIX LMATRIX -#endif - -#define OCTAVE_LMATRIX CONCAT2(octave_, LMATRIX) -#define OCTAVE_LDMATRIX CONCAT2(octave_, LDMATRIX) -#define OCTAVE_RMATRIX CONCAT2(octave_, RMATRIX) -#ifdef LEFT -#define LMATRIX_VALUE perm_matrix_value -#define RMATRIX_VALUE CONCAT2(RMATRIX, _value) -#else -#define LMATRIX_VALUE CONCAT2(LMATRIX, _value) -#define RMATRIX_VALUE perm_matrix_value -#endif - -DEFBINOP (mul, LMATRIX, RMATRIX) -{ - CAST_BINOP_ARGS (const OCTAVE_LMATRIX&, const OCTAVE_RMATRIX&); - - return v1.LMATRIX_VALUE () * v2.RMATRIX_VALUE (); -} - -#ifdef LEFT -DEFBINOP (ldiv, LMATRIX, RMATRIX) -{ - CAST_BINOP_ARGS (const OCTAVE_LMATRIX&, const OCTAVE_RMATRIX&); - - return v1.perm_matrix_value ().inverse () * v2.RMATRIX_VALUE (); -} -#else -DEFBINOP (div, LMATRIX, RMATRIX) -{ - CAST_BINOP_ARGS (const OCTAVE_LMATRIX&, const OCTAVE_RMATRIX&); - - return v1.LMATRIX_VALUE () * v2.perm_matrix_value ().inverse (); -} -#endif - - -#define SHORT_NAME CONCAT3(LSHORT, _, RSHORT) -#define INST_NAME CONCAT3(install_, SHORT_NAME, _ops) - -void -INST_NAME (void) -{ - INSTALL_BINOP (op_mul, OCTAVE_LMATRIX, OCTAVE_RMATRIX, mul); -#ifdef LEFT - INSTALL_BINOP (op_ldiv, OCTAVE_LMATRIX, OCTAVE_RMATRIX, ldiv); -#else - INSTALL_BINOP (op_div, OCTAVE_LMATRIX, OCTAVE_RMATRIX, div); -#endif -#ifdef DEFINENULLASSIGNCONV - INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_matrix, OCTAVE_LDMATRIX); - INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_str, OCTAVE_LDMATRIX); - INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_sq_str, OCTAVE_LDMATRIX); -#endif -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-range.cc --- a/src/OPERATORS/op-range.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,142 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-range.h" -#include "ov-ch-mat.h" -#include "ov-scalar.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-complex.h" -#include "ov-cx-mat.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xpow.h" - -// range unary ops. - -DEFUNOP (not, range) -{ - CAST_UNOP_ARG (const octave_range&); - - return octave_value (! v.matrix_value ()); -} - -DEFUNOP_OP (uplus, range, /* no-op */) -DEFUNOP_OP (uminus, range, -) - -DEFUNOP (transpose, range) -{ - CAST_UNOP_ARG (const octave_range&); - - return octave_value (v.matrix_value ().transpose ()); -} - -DEFBINOP_OP (addrs, range, scalar, +) -DEFBINOP_OP (addsr, scalar, range, +) -DEFBINOP_OP (subrs, range, scalar, -) -DEFBINOP_OP (subsr, scalar, range, -) -DEFBINOP_OP (mulrs, range, scalar, *) -DEFBINOP_OP (mulsr, scalar, range, *) - -DEFBINOP_FN (el_powsr, scalar, range, elem_xpow) -DEFBINOP_FN (el_powcsr, complex, range, elem_xpow) - -DEFNDCATOP_FN (r_r, range, range, array, array, concat) -DEFNDCATOP_FN (r_s, range, scalar, array, array, concat) -DEFNDCATOP_FN (r_m, range, matrix, array, array, concat) -DEFNDCATOP_FN (r_cs, range, complex, array, complex_array, concat) -DEFNDCATOP_FN (r_cm, range, complex_matrix, array, complex_array, concat) -DEFNDCATOP_FN (r_b, range, bool, array, array, concat) -DEFNDCATOP_FN (r_bm, range, bool_matrix, array, array, concat) -DEFNDCATOP_FN (r_chm, range, char_matrix, array, char_array, concat) -DEFNDCATOP_FN (s_r, scalar, range, array, array, concat) -DEFNDCATOP_FN (m_r, matrix, range, array, array, concat) -DEFNDCATOP_FN (cs_r, complex, range, complex_array, array, concat) -DEFNDCATOP_FN (cm_r, complex_matrix, range, complex_array, array, concat) -DEFNDCATOP_FN (b_r, bool, range, array, array, concat) -DEFNDCATOP_FN (bm_r, bool_matrix, range, array, array, concat) -DEFNDCATOP_FN (chm_r, char_matrix, range, char_array, array, concat) - -CONVDECL (range_to_matrix) -{ - CAST_CONV_ARG (const octave_range&); - - return new octave_matrix (v.array_value ()); -} - -void -install_range_ops (void) -{ - INSTALL_UNOP (op_not, octave_range, not); - INSTALL_UNOP (op_uplus, octave_range, uplus); - INSTALL_UNOP (op_uminus, octave_range, uminus); - INSTALL_UNOP (op_transpose, octave_range, transpose); - INSTALL_UNOP (op_hermitian, octave_range, transpose); - - INSTALL_BINOP (op_add, octave_range, octave_scalar, addrs); - INSTALL_BINOP (op_add, octave_scalar, octave_range, addsr); - INSTALL_BINOP (op_sub, octave_range, octave_scalar, subrs); - INSTALL_BINOP (op_sub, octave_scalar, octave_range, subsr); - INSTALL_BINOP (op_mul, octave_range, octave_scalar, mulrs); - INSTALL_BINOP (op_mul, octave_scalar, octave_range, mulsr); - - INSTALL_BINOP (op_el_pow, octave_scalar, octave_range, el_powsr); - INSTALL_BINOP (op_el_pow, octave_complex, octave_range, el_powcsr); - - INSTALL_CATOP (octave_range, octave_range, r_r); - INSTALL_CATOP (octave_range, octave_scalar, r_s); - INSTALL_CATOP (octave_range, octave_matrix, r_m); - INSTALL_CATOP (octave_range, octave_complex, r_cs); - INSTALL_CATOP (octave_range, octave_complex_matrix, r_cm); - INSTALL_CATOP (octave_range, octave_bool, r_b); - INSTALL_CATOP (octave_range, octave_bool_matrix, r_bm); - INSTALL_CATOP (octave_range, octave_char_matrix, r_chm); - INSTALL_CATOP (octave_scalar, octave_range, s_r); - INSTALL_CATOP (octave_matrix, octave_range, m_r); - INSTALL_CATOP (octave_complex, octave_range, cs_r); - INSTALL_CATOP (octave_complex_matrix, octave_range, cm_r); - INSTALL_CATOP (octave_bool, octave_range, b_r); - INSTALL_CATOP (octave_bool_matrix, octave_range, bm_r); - INSTALL_CATOP (octave_char_matrix, octave_range, chm_r); - - // FIXME -- this would be unneccessary if - // octave_base_value::numeric_assign always tried converting lhs - // before rhs. - - INSTALL_ASSIGNCONV (octave_range, octave_null_matrix, octave_matrix); - INSTALL_ASSIGNCONV (octave_range, octave_null_str, octave_matrix); - INSTALL_ASSIGNCONV (octave_range, octave_null_sq_str, octave_matrix); - - // However, this should probably be here just in case we need it. - - INSTALL_WIDENOP (octave_range, octave_matrix, range_to_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-s-cm.cc --- a/src/OPERATORS/op-s-cm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,142 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-s-cm.h" -#include "mx-cm-s.h" -#include "mx-s-cnda.h" -#include "mx-cnda-s.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// scalar by complex matrix ops. - -DEFNDBINOP_OP (add, scalar, complex_matrix, scalar, complex_array, +) -DEFNDBINOP_OP (sub, scalar, complex_matrix, scalar, complex_array, -) -DEFNDBINOP_OP (mul, scalar, complex_matrix, scalar, complex_array, *) - -DEFBINOP (div, scalar, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); - - Matrix m1 = v1.matrix_value (); - ComplexMatrix m2 = v2.complex_matrix_value (); - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (m1, m2, typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (pow, scalar, complex_matrix, xpow) - -DEFBINOP (ldiv, scalar, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); - - double d = v1.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.complex_array_value () / d); -} - -DEFNDCMPLXCMPOP_FN (lt, scalar, complex_matrix, scalar, complex_array, mx_el_lt) -DEFNDCMPLXCMPOP_FN (le, scalar, complex_matrix, scalar, complex_array, mx_el_le) -DEFNDCMPLXCMPOP_FN (eq, scalar, complex_matrix, scalar, complex_array, mx_el_eq) -DEFNDCMPLXCMPOP_FN (ge, scalar, complex_matrix, scalar, complex_array, mx_el_ge) -DEFNDCMPLXCMPOP_FN (gt, scalar, complex_matrix, scalar, complex_array, mx_el_gt) -DEFNDCMPLXCMPOP_FN (ne, scalar, complex_matrix, scalar, complex_array, mx_el_ne) - -DEFNDBINOP_OP (el_mul, scalar, complex_matrix, scalar, complex_array, *) -DEFNDBINOP_FN (el_div, scalar, complex_matrix, scalar, complex_array, x_el_div) -DEFNDBINOP_FN (el_pow, scalar, complex_matrix, scalar, complex_array, elem_xpow) - -DEFBINOP (el_ldiv, scalar, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); - - double d = v1.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.complex_array_value () / d); -} - -DEFNDBINOP_FN (el_and, scalar, complex_matrix, scalar, complex_array, mx_el_and) -DEFNDBINOP_FN (el_or, scalar, complex_matrix, scalar, complex_array, mx_el_or) - -DEFNDCATOP_FN (s_cm, scalar, complex_matrix, array, complex_array, concat) - -DEFCONV (complex_matrix_conv, scalar, complex_matrix) -{ - CAST_CONV_ARG (const octave_scalar&); - - return new octave_complex_matrix (ComplexMatrix (v.matrix_value ())); -} - -void -install_s_cm_ops (void) -{ - INSTALL_BINOP (op_add, octave_scalar, octave_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_scalar, octave_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_scalar, octave_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_scalar, octave_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_scalar, octave_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_scalar, octave_complex_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_scalar, octave_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_scalar, octave_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_scalar, octave_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_scalar, octave_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_scalar, octave_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_scalar, octave_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_scalar, octave_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_scalar, octave_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_scalar, octave_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_scalar, octave_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_scalar, octave_complex_matrix, el_or); - - INSTALL_CATOP (octave_scalar, octave_complex_matrix, s_cm); - - INSTALL_ASSIGNCONV (octave_scalar, octave_complex_matrix, octave_complex_matrix); - INSTALL_ASSIGNCONV (octave_float_scalar, octave_complex_matrix, octave_float_complex_matrix); - - INSTALL_WIDENOP (octave_scalar, octave_complex_matrix, complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-s-cs.cc --- a/src/OPERATORS/op-s-cs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// scalar by complex scalar ops. - -DEFBINOP_OP (add, scalar, complex, +) -DEFBINOP_OP (sub, scalar, complex, -) -DEFBINOP_OP (mul, scalar, complex, *) - -DEFBINOP (div, scalar, complex) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); - - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.double_value () / d); -} - -DEFBINOP_FN (pow, scalar, complex, xpow) - -DEFBINOP (ldiv, scalar, complex) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); - - double d = v1.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.complex_value () / d); -} - -DEFCMPLXCMPOP_OP (lt, scalar, complex, <) -DEFCMPLXCMPOP_OP (le, scalar, complex, <=) -DEFCMPLXCMPOP_OP (eq, scalar, complex, ==) -DEFCMPLXCMPOP_OP (ge, scalar, complex, >=) -DEFCMPLXCMPOP_OP (gt, scalar, complex, >) -DEFCMPLXCMPOP_OP (ne, scalar, complex, !=) - -DEFBINOP_OP (el_mul, scalar, complex, *) - -DEFBINOP (el_div, scalar, complex) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); - - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.double_value () / d); -} - -DEFBINOP_FN (el_pow, scalar, complex, xpow) - -DEFBINOP (el_ldiv, scalar, complex) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); - - double d = v1.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.complex_value () / d); -} - -DEFBINOP (el_and, scalar, complex) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); - - return octave_value (v1.double_value () && (v2.complex_value () != 0.0)); -} - -DEFBINOP (el_or, scalar, complex) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); - - return octave_value (v1.double_value () || (v2.complex_value () != 0.0)); -} - -DEFNDCATOP_FN (s_cs, scalar, complex, array, complex_array, concat) - -void -install_s_cs_ops (void) -{ - INSTALL_BINOP (op_add, octave_scalar, octave_complex, add); - INSTALL_BINOP (op_sub, octave_scalar, octave_complex, sub); - INSTALL_BINOP (op_mul, octave_scalar, octave_complex, mul); - INSTALL_BINOP (op_div, octave_scalar, octave_complex, div); - INSTALL_BINOP (op_pow, octave_scalar, octave_complex, pow); - INSTALL_BINOP (op_ldiv, octave_scalar, octave_complex, ldiv); - INSTALL_BINOP (op_lt, octave_scalar, octave_complex, lt); - INSTALL_BINOP (op_le, octave_scalar, octave_complex, le); - INSTALL_BINOP (op_eq, octave_scalar, octave_complex, eq); - INSTALL_BINOP (op_ge, octave_scalar, octave_complex, ge); - INSTALL_BINOP (op_gt, octave_scalar, octave_complex, gt); - INSTALL_BINOP (op_ne, octave_scalar, octave_complex, ne); - INSTALL_BINOP (op_el_mul, octave_scalar, octave_complex, el_mul); - INSTALL_BINOP (op_el_div, octave_scalar, octave_complex, el_div); - INSTALL_BINOP (op_el_pow, octave_scalar, octave_complex, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_complex, el_ldiv); - INSTALL_BINOP (op_el_and, octave_scalar, octave_complex, el_and); - INSTALL_BINOP (op_el_or, octave_scalar, octave_complex, el_or); - - INSTALL_CATOP (octave_scalar, octave_complex, s_cs); - - INSTALL_ASSIGNCONV (octave_scalar, octave_complex, octave_complex_matrix); - INSTALL_ASSIGNCONV (octave_float_scalar, octave_complex, octave_float_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-s-m.cc --- a/src/OPERATORS/op-s-m.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,136 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// scalar by matrix ops. - -DEFNDBINOP_OP (add, scalar, matrix, scalar, array, +) -DEFNDBINOP_OP (sub, scalar, matrix, scalar, array, -) -DEFNDBINOP_OP (mul, scalar, matrix, scalar, array, *) - -DEFBINOP (div, scalar, matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); - - Matrix m1 = v1.matrix_value (); - Matrix m2 = v2.matrix_value (); - MatrixType typ = v2.matrix_type (); - - Matrix ret = xdiv (m1, m2, typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOP_FN (pow, scalar, matrix, xpow) - -DEFBINOP (ldiv, scalar, matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); - - double d = v1.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.array_value () / d); -} - -DEFNDBINOP_FN (lt, scalar, matrix, scalar, array, mx_el_lt) -DEFNDBINOP_FN (le, scalar, matrix, scalar, array, mx_el_le) -DEFNDBINOP_FN (eq, scalar, matrix, scalar, array, mx_el_eq) -DEFNDBINOP_FN (ge, scalar, matrix, scalar, array, mx_el_ge) -DEFNDBINOP_FN (gt, scalar, matrix, scalar, array, mx_el_gt) -DEFNDBINOP_FN (ne, scalar, matrix, scalar, array, mx_el_ne) - -DEFNDBINOP_OP (el_mul, scalar, matrix, scalar, array, *) -DEFNDBINOP_FN (el_div, scalar, matrix, scalar, array, x_el_div) -DEFNDBINOP_FN (el_pow, scalar, matrix, scalar, array, elem_xpow) - -DEFBINOP (el_ldiv, scalar, matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); - - double d = v1.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.array_value () / d); -} - -DEFNDBINOP_FN (el_and, scalar, matrix, scalar, array, mx_el_and) -DEFNDBINOP_FN (el_or, scalar, matrix, scalar, array, mx_el_or) - -DEFNDCATOP_FN (s_m, scalar, matrix, array, array, concat) - -DEFCONV (matrix_conv, scalar, matrix) -{ - CAST_CONV_ARG (const octave_scalar&); - - return new octave_matrix (v.matrix_value ()); -} - -void -install_s_m_ops (void) -{ - INSTALL_BINOP (op_add, octave_scalar, octave_matrix, add); - INSTALL_BINOP (op_sub, octave_scalar, octave_matrix, sub); - INSTALL_BINOP (op_mul, octave_scalar, octave_matrix, mul); - INSTALL_BINOP (op_div, octave_scalar, octave_matrix, div); - INSTALL_BINOP (op_pow, octave_scalar, octave_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_scalar, octave_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_scalar, octave_matrix, lt); - INSTALL_BINOP (op_le, octave_scalar, octave_matrix, le); - INSTALL_BINOP (op_eq, octave_scalar, octave_matrix, eq); - INSTALL_BINOP (op_ge, octave_scalar, octave_matrix, ge); - INSTALL_BINOP (op_gt, octave_scalar, octave_matrix, gt); - INSTALL_BINOP (op_ne, octave_scalar, octave_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_scalar, octave_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_scalar, octave_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_scalar, octave_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_scalar, octave_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_scalar, octave_matrix, el_or); - - INSTALL_CATOP (octave_scalar, octave_matrix, s_m); - - INSTALL_ASSIGNCONV (octave_scalar, octave_matrix, octave_matrix); - INSTALL_ASSIGNCONV (octave_float_scalar, octave_matrix, octave_float_matrix); - - INSTALL_WIDENOP (octave_scalar, octave_matrix, matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-s-s.cc --- a/src/OPERATORS/op-s-s.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,172 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "Array-util.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// scalar unary ops. - -DEFUNOP (not, scalar) -{ - CAST_UNOP_ARG (const octave_scalar&); - double x = v.scalar_value (); - if (xisnan (x)) - gripe_nan_to_logical_conversion (); - return octave_value (x == 0.0); -} - -DEFUNOP_OP (uplus, scalar, /* no-op */) -DEFUNOP_OP (uminus, scalar, -) -DEFUNOP_OP (transpose, scalar, /* no-op */) -DEFUNOP_OP (hermitian, scalar, /* no-op */) - -DEFNCUNOP_METHOD (incr, scalar, increment) -DEFNCUNOP_METHOD (decr, scalar, decrement) - -// scalar by scalar ops. - -DEFBINOP_OP (add, scalar, scalar, +) -DEFBINOP_OP (sub, scalar, scalar, -) -DEFBINOP_OP (mul, scalar, scalar, *) - -DEFBINOP (div, scalar, scalar) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); - - double d = v2.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.double_value () / d); -} - -DEFBINOP_FN (pow, scalar, scalar, xpow) - -DEFBINOP (ldiv, scalar, scalar) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); - - double d = v1.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.double_value () / d); -} - -DEFBINOP_OP (lt, scalar, scalar, <) -DEFBINOP_OP (le, scalar, scalar, <=) -DEFBINOP_OP (eq, scalar, scalar, ==) -DEFBINOP_OP (ge, scalar, scalar, >=) -DEFBINOP_OP (gt, scalar, scalar, >) -DEFBINOP_OP (ne, scalar, scalar, !=) - -DEFBINOP_OP (el_mul, scalar, scalar, *) - -DEFBINOP (el_div, scalar, scalar) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); - - double d = v2.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.double_value () / d); -} - -DEFBINOP_FN (el_pow, scalar, scalar, xpow) - -DEFBINOP (el_ldiv, scalar, scalar) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); - - double d = v1.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.double_value () / d); -} - -DEFSCALARBOOLOP_OP (el_and, scalar, scalar, &&) -DEFSCALARBOOLOP_OP (el_or, scalar, scalar, ||) - -DEFNDCATOP_FN (s_s, scalar, scalar, array, array, concat) - -void -install_s_s_ops (void) -{ - INSTALL_UNOP (op_not, octave_scalar, not); - INSTALL_UNOP (op_uplus, octave_scalar, uplus); - INSTALL_UNOP (op_uminus, octave_scalar, uminus); - INSTALL_UNOP (op_transpose, octave_scalar, transpose); - INSTALL_UNOP (op_hermitian, octave_scalar, hermitian); - - INSTALL_NCUNOP (op_incr, octave_scalar, incr); - INSTALL_NCUNOP (op_decr, octave_scalar, decr); - - INSTALL_BINOP (op_add, octave_scalar, octave_scalar, add); - INSTALL_BINOP (op_sub, octave_scalar, octave_scalar, sub); - INSTALL_BINOP (op_mul, octave_scalar, octave_scalar, mul); - INSTALL_BINOP (op_div, octave_scalar, octave_scalar, div); - INSTALL_BINOP (op_pow, octave_scalar, octave_scalar, pow); - INSTALL_BINOP (op_ldiv, octave_scalar, octave_scalar, ldiv); - INSTALL_BINOP (op_lt, octave_scalar, octave_scalar, lt); - INSTALL_BINOP (op_le, octave_scalar, octave_scalar, le); - INSTALL_BINOP (op_eq, octave_scalar, octave_scalar, eq); - INSTALL_BINOP (op_ge, octave_scalar, octave_scalar, ge); - INSTALL_BINOP (op_gt, octave_scalar, octave_scalar, gt); - INSTALL_BINOP (op_ne, octave_scalar, octave_scalar, ne); - INSTALL_BINOP (op_el_mul, octave_scalar, octave_scalar, el_mul); - INSTALL_BINOP (op_el_div, octave_scalar, octave_scalar, el_div); - INSTALL_BINOP (op_el_pow, octave_scalar, octave_scalar, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_scalar, el_ldiv); - INSTALL_BINOP (op_el_and, octave_scalar, octave_scalar, el_and); - INSTALL_BINOP (op_el_or, octave_scalar, octave_scalar, el_or); - - INSTALL_CATOP (octave_scalar, octave_scalar, s_s); - - INSTALL_ASSIGNCONV (octave_scalar, octave_scalar, octave_matrix); - INSTALL_ASSIGNCONV (octave_float_scalar, octave_scalar, octave_float_matrix); - - INSTALL_ASSIGNCONV (octave_scalar, octave_null_matrix, octave_matrix); - INSTALL_ASSIGNCONV (octave_scalar, octave_null_str, octave_matrix); - INSTALL_ASSIGNCONV (octave_scalar, octave_null_sq_str, octave_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-s-scm.cc --- a/src/OPERATORS/op-s-scm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,178 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-cx-mat.h" -#include "ov-scalar.h" -#include "ops.h" -#include "xpow.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "smx-s-scm.h" -#include "smx-scm-s.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -// scalar by sparse complex matrix ops. - -DEFBINOP_OP (add, scalar, sparse_complex_matrix, +) -DEFBINOP_OP (sub, scalar, sparse_complex_matrix, -) -DEFBINOP_OP (mul, scalar, sparse_complex_matrix, *) - -DEFBINOP (div, scalar, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (SparseComplexMatrix (1, 1, v1.scalar_value () / d)); - } - else - { - MatrixType typ = v2.matrix_type (); - Matrix m1 = Matrix (1, 1, v1.scalar_value ()); - SparseComplexMatrix m2 = v2.sparse_complex_matrix_value (); - ComplexMatrix ret = xdiv (m1, m2, typ); - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOP (pow, scalar, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, - const octave_sparse_complex_matrix&); - return xpow (v1.scalar_value (), v2.complex_matrix_value ()); -} - -DEFBINOP (ldiv, scalar, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, - const octave_sparse_complex_matrix&); - - double d = v1.double_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v2.sparse_complex_matrix_value () / d); - - return retval; -} - -DEFBINOP_FN (lt, scalar, sparse_complex_matrix, mx_el_lt) -DEFBINOP_FN (le, scalar, sparse_complex_matrix, mx_el_le) -DEFBINOP_FN (eq, scalar, sparse_complex_matrix, mx_el_eq) -DEFBINOP_FN (ge, scalar, sparse_complex_matrix, mx_el_ge) -DEFBINOP_FN (gt, scalar, sparse_complex_matrix, mx_el_gt) -DEFBINOP_FN (ne, scalar, sparse_complex_matrix, mx_el_ne) - -DEFBINOP_OP (el_mul, scalar, sparse_complex_matrix, *) -DEFBINOP_FN (el_div, scalar, sparse_complex_matrix, x_el_div) -DEFBINOP_FN (el_pow, scalar, sparse_complex_matrix, elem_xpow) - -DEFBINOP (el_ldiv, scalar, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, - const octave_sparse_complex_matrix&); - - double d = v1.double_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v2.sparse_complex_matrix_value () / d); - - return retval; -} - -DEFBINOP_FN (el_and, scalar, sparse_complex_matrix, mx_el_and) -DEFBINOP_FN (el_or, scalar, sparse_complex_matrix, mx_el_or) - -DEFCATOP (s_scm, scalar, sparse_compelx_matrix) -{ - CAST_BINOP_ARGS (octave_scalar&, const octave_sparse_complex_matrix&); - SparseMatrix tmp (1, 1, v1.scalar_value ()); - return octave_value - (tmp.concat (v2.sparse_complex_matrix_value (), ra_idx)); -} - -DEFCONV (sparse_complex_matrix_conv, scalar, sparse_complex_matrix) -{ - CAST_CONV_ARG (const octave_scalar&); - - return new octave_sparse_complex_matrix - (SparseComplexMatrix (v.complex_matrix_value ())); -} - -void -install_s_scm_ops (void) -{ - INSTALL_BINOP (op_add, octave_scalar, octave_sparse_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_scalar, octave_sparse_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_scalar, octave_sparse_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_scalar, octave_sparse_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_scalar, octave_sparse_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_scalar, octave_sparse_complex_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_scalar, octave_sparse_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_scalar, octave_sparse_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_scalar, octave_sparse_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_scalar, octave_sparse_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_scalar, octave_sparse_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_scalar, octave_sparse_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_scalar, octave_sparse_complex_matrix, - el_mul); - INSTALL_BINOP (op_el_div, octave_scalar, octave_sparse_complex_matrix, - el_div); - INSTALL_BINOP (op_el_pow, octave_scalar, octave_sparse_complex_matrix, - el_pow); - INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_sparse_complex_matrix, - el_ldiv); - INSTALL_BINOP (op_el_and, octave_scalar, octave_sparse_complex_matrix, - el_and); - INSTALL_BINOP (op_el_or, octave_scalar, octave_sparse_complex_matrix, - el_or); - - INSTALL_CATOP (octave_scalar, octave_sparse_complex_matrix, s_scm); - - INSTALL_ASSIGNCONV (octave_scalar, octave_sparse_complex_matrix, - octave_complex_matrix); - - INSTALL_WIDENOP (octave_scalar, octave_sparse_complex_matrix, - sparse_complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-s-sm.cc --- a/src/OPERATORS/op-s-sm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,161 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-scalar.h" -#include "ops.h" -#include "xpow.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "ov-re-sparse.h" - -// scalar by sparse matrix ops. - -DEFBINOP_OP (add, scalar, sparse_matrix, +) -DEFBINOP_OP (sub, scalar, sparse_matrix, -) -DEFBINOP_OP (mul, scalar, sparse_matrix, *) - -DEFBINOP (div, scalar, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - double d = v2.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (SparseMatrix (1, 1, v1.scalar_value () / d)); - } - else - { - MatrixType typ = v2.matrix_type (); - Matrix m1 = Matrix (1, 1, v1.double_value ()); - SparseMatrix m2 = v2.sparse_matrix_value (); - Matrix ret = xdiv (m1, m2, typ); - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOP (pow, scalar, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_matrix&); - return xpow (v1.scalar_value (), v2.matrix_value ()); -} - -DEFBINOP (ldiv, scalar, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_matrix&); - - double d = v1.double_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v2.sparse_matrix_value () / d); - - return retval; -} - -DEFBINOP_FN (lt, scalar, sparse_matrix, mx_el_lt) -DEFBINOP_FN (le, scalar, sparse_matrix, mx_el_le) -DEFBINOP_FN (eq, scalar, sparse_matrix, mx_el_eq) -DEFBINOP_FN (ge, scalar, sparse_matrix, mx_el_ge) -DEFBINOP_FN (gt, scalar, sparse_matrix, mx_el_gt) -DEFBINOP_FN (ne, scalar, sparse_matrix, mx_el_ne) - -DEFBINOP_OP (el_mul, scalar, sparse_matrix, *) -DEFBINOP_FN (el_div, scalar, sparse_matrix, x_el_div) -DEFBINOP_FN (el_pow, scalar, sparse_matrix, elem_xpow) - -DEFBINOP (el_ldiv, scalar, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_matrix&); - - double d = v1.double_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v2.sparse_matrix_value () / d); - - return retval; -} - -DEFBINOP_FN (el_and, scalar, sparse_matrix, mx_el_and) -DEFBINOP_FN (el_or, scalar, sparse_matrix, mx_el_or) - -DEFCATOP (s_sm, scalar, sparse_matrix) -{ - CAST_BINOP_ARGS (octave_scalar&, const octave_sparse_matrix&); - SparseMatrix tmp (1, 1, v1.scalar_value ()); - return octave_value (tmp.concat (v2.sparse_matrix_value (), ra_idx)); -} - -DEFCONV (sparse_matrix_conv, scalar, sparse_matrix) -{ - CAST_CONV_ARG (const octave_scalar&); - - return new octave_sparse_matrix (SparseMatrix (v.matrix_value ())); -} - -void -install_s_sm_ops (void) -{ - INSTALL_BINOP (op_add, octave_scalar, octave_sparse_matrix, add); - INSTALL_BINOP (op_sub, octave_scalar, octave_sparse_matrix, sub); - INSTALL_BINOP (op_mul, octave_scalar, octave_sparse_matrix, mul); - INSTALL_BINOP (op_div, octave_scalar, octave_sparse_matrix, div); - INSTALL_BINOP (op_pow, octave_scalar, octave_sparse_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_scalar, octave_sparse_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_scalar, octave_sparse_matrix, lt); - INSTALL_BINOP (op_le, octave_scalar, octave_sparse_matrix, le); - INSTALL_BINOP (op_eq, octave_scalar, octave_sparse_matrix, eq); - INSTALL_BINOP (op_ge, octave_scalar, octave_sparse_matrix, ge); - INSTALL_BINOP (op_gt, octave_scalar, octave_sparse_matrix, gt); - INSTALL_BINOP (op_ne, octave_scalar, octave_sparse_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_scalar, octave_sparse_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_scalar, octave_sparse_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_scalar, octave_sparse_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_sparse_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_scalar, octave_sparse_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_scalar, octave_sparse_matrix, el_or); - - INSTALL_CATOP (octave_scalar, octave_sparse_matrix, s_sm); - - INSTALL_ASSIGNCONV (octave_scalar, octave_sparse_matrix, octave_matrix); - - INSTALL_WIDENOP (octave_scalar, octave_sparse_matrix, sparse_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-sbm-b.cc --- a/src/OPERATORS/op-sbm-b.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,141 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-bool.h" -#include "ov-int8.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-uint8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-scalar.h" -#include "ops.h" - -#include "ov-re-sparse.h" -#include "ov-bool-sparse.h" - -// sparse bool matrix by bool ops. - -DEFBINOP_FN (ne, sparse_bool_matrix, bool, mx_el_ne) -DEFBINOP_FN (eq, sparse_bool_matrix, bool, mx_el_eq) - -DEFBINOP_FN (el_and, sparse_bool_matrix, bool, mx_el_and) -DEFBINOP_FN (el_or, sparse_bool_matrix, bool, mx_el_or) - -DEFCATOP (sbm_b, sparse_bool_matrix, bool) -{ - CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_bool&); - - SparseBoolMatrix tmp (1, 1, v2.bool_value ()); - return octave_value (v1.sparse_bool_matrix_value (). concat (tmp, ra_idx)); -} - -DEFCATOP (sm_b, sparse_matrix, bool) -{ - CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_bool&); - - SparseMatrix tmp (1, 1, v2.scalar_value ()); - return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); -} - -DEFCATOP (sbm_s, sparse_bool_matrix, scalar) -{ - CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_scalar&); - - SparseMatrix tmp (1, 1, v2.scalar_value ()); - return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); -} - -DEFASSIGNOP (assign, sparse_bool_matrix, bool) -{ - CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_bool&); - - SparseBoolMatrix tmp (1, 1, v2.bool_value ()); - v1.assign (idx, tmp); - return octave_value (); -} - -static octave_value -oct_assignop_conv_and_assign (octave_base_value& a1, - const octave_value_list& idx, - const octave_base_value& a2) -{ - octave_sparse_bool_matrix& v1 = dynamic_cast (a1); - - // FIXME -- perhaps add a warning for this conversion if the values - // are not all 0 or 1? - - SparseBoolMatrix v2 (1, 1, a2.bool_value ()); - - if (! error_state) - v1.assign (idx, v2); - - return octave_value (); -} - -void -install_sbm_b_ops (void) -{ - INSTALL_BINOP (op_eq, octave_sparse_bool_matrix, octave_bool, eq); - INSTALL_BINOP (op_ne, octave_sparse_bool_matrix, octave_bool, ne); - - INSTALL_BINOP (op_el_and, octave_sparse_bool_matrix, octave_bool, el_and); - INSTALL_BINOP (op_el_or, octave_sparse_bool_matrix, octave_bool, el_or); - - INSTALL_CATOP (octave_sparse_bool_matrix, octave_bool, sbm_b); - INSTALL_CATOP (octave_sparse_bool_matrix, octave_scalar, sbm_s); - INSTALL_CATOP (octave_sparse_matrix, octave_bool, sm_b); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_bool, assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_scalar, - conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int8_scalar, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int16_scalar, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int32_scalar, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int64_scalar, - conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint8_scalar, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint16_scalar, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint32_scalar, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint64_scalar, - conv_and_assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-sbm-bm.cc --- a/src/OPERATORS/op-sbm-bm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,167 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-bool-mat.h" -#include "boolMatrix.h" -#include "ov-int8.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-uint8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-range.h" -#include "ov-scalar.h" -#include "ov-str-mat.h" -#include "ops.h" -#include "ov-null-mat.h" -#include "ov-re-sparse.h" -#include "ov-bool-sparse.h" -#include "smx-bm-sbm.h" -#include "smx-sbm-bm.h" - -// sparse bool matrix by bool matrix ops. - -DEFBINOP_FN (eq, sparse_bool_matrix, bool_matrix, mx_el_eq) -DEFBINOP_FN (ne, sparse_bool_matrix, bool_matrix, mx_el_ne) - -DEFBINOP_FN (el_and, sparse_bool_matrix, bool_matrix, mx_el_and) -DEFBINOP_FN (el_or, sparse_bool_matrix, bool_matrix, mx_el_or) - -DEFCATOP (sbm_bm, sparse_bool_matrix, bool_matrix) -{ - CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_bool_matrix&); - - SparseBoolMatrix tmp (v2.bool_matrix_value ()); - return octave_value (v1.sparse_bool_matrix_value (). concat (tmp, ra_idx)); -} - -DEFCATOP (sbm_m, sparse_bool_matrix, matrix) -{ - CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_matrix&); - - SparseMatrix tmp (v2.matrix_value ()); - return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); -} - -DEFCATOP (sm_bm, sparse_matrix, bool_matrix) -{ - CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_bool_matrix&); - - SparseMatrix tmp (v2.matrix_value ()); - return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); -} - -DEFASSIGNOP (assign, sparse_bool_matrix, bool_matrix) -{ - CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_bool_matrix&); - - v1.assign (idx, SparseBoolMatrix (v2.bool_matrix_value ())); - return octave_value (); -} - -DEFNULLASSIGNOP_FN (null_assign, sparse_bool_matrix, delete_elements) - -static octave_value -oct_assignop_conv_and_assign (octave_base_value& a1, - const octave_value_list& idx, - const octave_base_value& a2) -{ - octave_sparse_bool_matrix& v1 = dynamic_cast (a1); - - // FIXME -- perhaps add a warning for this conversion if the values - // are not all 0 or 1? - - SparseBoolMatrix v2 (a2.bool_array_value ()); - - if (! error_state) - v1.assign (idx, v2); - - return octave_value (); -} - -void -install_sbm_bm_ops (void) -{ - INSTALL_BINOP (op_eq, octave_sparse_bool_matrix, octave_bool_matrix, eq); - INSTALL_BINOP (op_ne, octave_sparse_bool_matrix, octave_bool_matrix, ne); - - INSTALL_BINOP (op_el_and, octave_sparse_bool_matrix, octave_bool_matrix, - el_and); - INSTALL_BINOP (op_el_or, octave_sparse_bool_matrix, octave_bool_matrix, - el_or); - - INSTALL_CATOP (octave_sparse_bool_matrix, octave_bool_matrix, sbm_bm); - INSTALL_CATOP (octave_sparse_matrix, octave_bool_matrix, sm_bm); - INSTALL_CATOP (octave_sparse_bool_matrix, octave_matrix, sbm_m); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, - octave_bool_matrix, assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_matrix, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, - octave_char_matrix_str, conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, - octave_char_matrix_sq_str, conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_range, - conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_sparse_matrix, - conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int8_matrix, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int16_matrix, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int32_matrix, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int64_matrix, - conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint8_matrix, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint16_matrix, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint32_matrix, - conv_and_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint64_matrix, - conv_and_assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_null_matrix, - null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_null_str, - null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_null_sq_str, - null_assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-sbm-sbm.cc --- a/src/OPERATORS/op-sbm-sbm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,114 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-bool-mat.h" -#include "ov-scalar.h" -#include "ops.h" - -#include "ov-re-sparse.h" -#include "ov-bool-sparse.h" - -// unary sparse bool matrix ops. - -DEFUNOP_OP (not, sparse_bool_matrix, !) - -DEFUNOP (uplus, sparse_bool_matrix) -{ - CAST_UNOP_ARG (const octave_sparse_bool_matrix&); - return octave_value (v.sparse_matrix_value ()); -} - -DEFUNOP (uminus, sparse_bool_matrix) -{ - CAST_UNOP_ARG (const octave_sparse_bool_matrix&); - return octave_value ( - v.sparse_matrix_value ()); -} - -DEFUNOP (transpose, sparse_bool_matrix) -{ - CAST_UNOP_ARG (const octave_sparse_bool_matrix&); - return octave_value (v.sparse_bool_matrix_value ().transpose ()); -} - -// sparse bool matrix by sparse bool matrix ops. - -DEFBINOP_FN (eq, sparse_bool_matrix, sparse_bool_matrix, mx_el_eq) -DEFBINOP_FN (ne, sparse_bool_matrix, sparse_bool_matrix, mx_el_ne) -DEFBINOP_FN (el_and, sparse_bool_matrix, sparse_bool_matrix, mx_el_and) -DEFBINOP_FN (el_or, sparse_bool_matrix, sparse_bool_matrix, mx_el_or) - -DEFNDCATOP_FN (sbm_sbm, sparse_bool_matrix, sparse_bool_matrix, - sparse_bool_matrix, sparse_bool_matrix, concat) -DEFNDCATOP_FN (sbm_sm, sparse_bool_matrix, sparse_matrix, sparse_matrix, - sparse_matrix, concat) -DEFNDCATOP_FN (sm_sbm, sparse_matrix, sparse_bool_matrix, sparse_matrix, - sparse_matrix, concat) - -DEFASSIGNOP_FN (assign, sparse_bool_matrix, sparse_bool_matrix, - assign) - -CONVDECL (bool_matrix_to_double_matrix) -{ - CAST_CONV_ARG (const octave_sparse_bool_matrix&); - - return new octave_sparse_matrix (SparseMatrix (v.sparse_bool_matrix_value ())); -} - -void -install_sbm_sbm_ops (void) -{ - INSTALL_UNOP (op_not, octave_sparse_bool_matrix, not); - INSTALL_UNOP (op_uplus, octave_sparse_bool_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_sparse_bool_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_sparse_bool_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_sparse_bool_matrix, transpose); - - INSTALL_BINOP (op_eq, octave_sparse_bool_matrix, - octave_sparse_bool_matrix, eq); - INSTALL_BINOP (op_ne, octave_sparse_bool_matrix, - octave_sparse_bool_matrix, ne); - - INSTALL_BINOP (op_el_and, octave_sparse_bool_matrix, - octave_sparse_bool_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_sparse_bool_matrix, - octave_sparse_bool_matrix, el_or); - - INSTALL_CATOP (octave_sparse_bool_matrix, octave_sparse_bool_matrix, - sbm_sbm); - INSTALL_CATOP (octave_sparse_bool_matrix, octave_sparse_matrix, sbm_sm); - INSTALL_CATOP (octave_sparse_matrix, octave_sparse_bool_matrix, sm_sbm); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, - octave_sparse_bool_matrix, assign); - - INSTALL_CONVOP (octave_sparse_bool_matrix, octave_sparse_matrix, - bool_matrix_to_double_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-scm-cm.cc --- a/src/OPERATORS/op-scm-cm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,196 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-cx-mat.h" -#include "ops.h" -#include "xdiv.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "smx-scm-cm.h" -#include "smx-cm-scm.h" -#include "ov-cx-sparse.h" - -// sparse complex matrix by complex matrix ops. - -DEFBINOP_OP (add, sparse_complex_matrix, complex_matrix, +) -DEFBINOP_OP (sub, sparse_complex_matrix, complex_matrix, -) - -DEFBINOP_OP (mul, sparse_complex_matrix, complex_matrix, *) - -DEFBINOP (div, sparse_complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_complex_matrix&); - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (v1.complex_matrix_value (), - v2.complex_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOPX (pow, sparse_complex_matrix, complex_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, sparse_complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.complex_array_value () / d); - } - else - { - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.sparse_complex_matrix_value (), - v2.complex_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (trans_mul, sparse_complex_matrix, complex_matrix, trans_mul); -DEFBINOP_FN (herm_mul, sparse_complex_matrix, complex_matrix, herm_mul); - -DEFBINOP_FN (lt, sparse_complex_matrix, complex_matrix, mx_el_lt) -DEFBINOP_FN (le, sparse_complex_matrix, complex_matrix, mx_el_le) -DEFBINOP_FN (eq, sparse_complex_matrix, complex_matrix, mx_el_eq) -DEFBINOP_FN (ge, sparse_complex_matrix, complex_matrix, mx_el_ge) -DEFBINOP_FN (gt, sparse_complex_matrix, complex_matrix, mx_el_gt) -DEFBINOP_FN (ne, sparse_complex_matrix, complex_matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, sparse_complex_matrix, complex_matrix, product) -DEFBINOP_FN (el_div, sparse_complex_matrix, complex_matrix, quotient) - -DEFBINOP (el_pow, sparse_complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_complex_matrix&); - - return octave_value - (elem_xpow (v1.sparse_complex_matrix_value (), SparseComplexMatrix - (v2.complex_matrix_value ()))); -} - -DEFBINOP (el_ldiv, sparse_complex_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_complex_matrix&); - - return octave_value (quotient (v2.complex_matrix_value (), - v1.sparse_complex_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_complex_matrix, complex_matrix, mx_el_and) -DEFBINOP_FN (el_or, sparse_complex_matrix, complex_matrix, mx_el_or) - -DEFCATOP (scm_cm, sparse_complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (octave_sparse_complex_matrix&, - const octave_complex_matrix&); - SparseComplexMatrix tmp (v2.complex_matrix_value ()); - return octave_value - (v1.sparse_complex_matrix_value (). concat (tmp, ra_idx)); -} - -DEFASSIGNOP (assign, sparse_complex_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (octave_sparse_complex_matrix&, - const octave_complex_matrix&); - - SparseComplexMatrix tmp (v2.complex_matrix_value ()); - v1.assign (idx, tmp); - return octave_value (); -} - -void -install_scm_cm_ops (void) -{ - INSTALL_BINOP (op_add, octave_sparse_complex_matrix, - octave_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, - octave_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, - octave_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_sparse_complex_matrix, - octave_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, - octave_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, - octave_complex_matrix, ldiv); - INSTALL_BINOP (op_trans_mul, octave_sparse_complex_matrix, - octave_complex_matrix, trans_mul); - INSTALL_BINOP (op_herm_mul, octave_sparse_complex_matrix, - octave_complex_matrix, herm_mul); - INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, - octave_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_sparse_complex_matrix, - octave_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, - octave_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, - octave_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, - octave_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, - octave_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, - octave_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, - octave_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, - octave_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, - octave_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, - octave_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, - octave_complex_matrix, el_or); - - INSTALL_CATOP (octave_sparse_complex_matrix, - octave_complex_matrix, scm_cm); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, - octave_complex_matrix, assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-scm-cs.cc --- a/src/OPERATORS/op-scm-cs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,184 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-cx-mat.h" -#include "ov-complex.h" -#include "ops.h" -#include "xpow.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "ov-cx-sparse.h" - -// sparse complex matrix by complex scalar ops. - -DEFBINOP_OP (add, sparse_complex_matrix, complex, +) -DEFBINOP_OP (sub, sparse_complex_matrix, complex, -) -DEFBINOP_OP (mul, sparse_complex_matrix, complex, *) - -DEFBINOP (div, sparse_complex_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_complex&); - - Complex d = v2.complex_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v1.sparse_complex_matrix_value () / d); - - return retval; -} - -DEFBINOP (pow, sparse_complex_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_complex&); - return xpow (v1.complex_matrix_value (), v2.complex_value ()); -} - -DEFBINOP (ldiv, sparse_complex_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (SparseComplexMatrix (1, 1, v2.complex_value () / d)); - } - else - { - MatrixType typ = v1.matrix_type (); - SparseComplexMatrix m1 = v1.sparse_complex_matrix_value (); - ComplexMatrix m2 = ComplexMatrix (1, 1, v2.complex_value ()); - ComplexMatrix ret = xleftdiv (m1, m2, typ); - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (lt, sparse_complex_matrix, complex, mx_el_lt) -DEFBINOP_FN (le, sparse_complex_matrix, complex, mx_el_le) -DEFBINOP_FN (eq, sparse_complex_matrix, complex, mx_el_eq) -DEFBINOP_FN (ge, sparse_complex_matrix, complex, mx_el_ge) -DEFBINOP_FN (gt, sparse_complex_matrix, complex, mx_el_gt) -DEFBINOP_FN (ne, sparse_complex_matrix, complex, mx_el_ne) - -DEFBINOP_OP (el_mul, sparse_complex_matrix, complex, *) - -DEFBINOP (el_div, sparse_complex_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_complex&); - - octave_value retval; - - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v1.sparse_complex_matrix_value () / d); - - return retval; -} - -DEFBINOP_FN (el_pow, sparse_complex_matrix, complex, elem_xpow) - -DEFBINOP (el_ldiv, sparse_complex_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_complex&); - - return octave_value - (x_el_div (v2.complex_value (), v1.sparse_complex_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_complex_matrix, complex, mx_el_and) -DEFBINOP_FN (el_or, sparse_complex_matrix, complex, mx_el_or) - -DEFCATOP (scm_cs, sparse_complex_matrix, complex) -{ - CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_complex&); - SparseComplexMatrix tmp (1, 1, v2.complex_value ()); - return octave_value - (v1.sparse_complex_matrix_value (). concat (tmp, ra_idx)); -} - -DEFASSIGNOP (assign, sparse_complex_matrix, complex) -{ - CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_complex&); - - SparseComplexMatrix tmp (1, 1, v2.complex_value ()); - v1.assign (idx, tmp); - return octave_value (); -} - -void -install_scm_cs_ops (void) -{ - INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_complex, add); - INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_complex, sub); - INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_complex, mul); - INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_complex, div); - INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, octave_complex, pow); - INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, octave_complex, - ldiv); - INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, octave_complex, lt); - INSTALL_BINOP (op_le, octave_sparse_complex_matrix, octave_complex, le); - INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, octave_complex, eq); - INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, octave_complex, ge); - INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, octave_complex, gt); - INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, octave_complex, ne); - INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, octave_complex, - el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, octave_complex, - el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, octave_complex, - el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, octave_complex, - el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, octave_complex, - el_and); - INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, octave_complex, - el_or); - - INSTALL_CATOP (octave_sparse_complex_matrix, octave_complex, scm_cs); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, octave_complex, - assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-scm-m.cc --- a/src/OPERATORS/op-scm-m.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,175 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-re-mat.h" -#include "ov-cx-mat.h" -#include "ops.h" -#include "xdiv.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "smx-scm-m.h" -#include "smx-m-scm.h" -#include "ov-cx-sparse.h" - -// sparse complex matrix by matrix ops. - -DEFBINOP_OP (add, sparse_complex_matrix, matrix, +) -DEFBINOP_OP (sub, sparse_complex_matrix, matrix, -) - -DEFBINOP_OP (mul, sparse_complex_matrix, matrix, *) - -DEFBINOP (div, sparse_complex_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_matrix&); - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (v1.complex_matrix_value (), - v2.matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOPX (pow, sparse_complex_matrix, matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, sparse_complex_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.array_value () / d); - } - else - { - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.sparse_complex_matrix_value (), - v2.matrix_value (), typ); - - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (lt, sparse_complex_matrix, matrix, mx_el_lt) -DEFBINOP_FN (le, sparse_complex_matrix, matrix, mx_el_le) -DEFBINOP_FN (eq, sparse_complex_matrix, matrix, mx_el_eq) -DEFBINOP_FN (ge, sparse_complex_matrix, matrix, mx_el_ge) -DEFBINOP_FN (gt, sparse_complex_matrix, matrix, mx_el_gt) -DEFBINOP_FN (ne, sparse_complex_matrix, matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, sparse_complex_matrix, matrix, product) -DEFBINOP_FN (el_div, sparse_complex_matrix, matrix, quotient) - -DEFBINOP (el_pow, sparse_complex_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_matrix&); - - return octave_value - (elem_xpow (v1.sparse_complex_matrix_value (), SparseMatrix - (v2.matrix_value ()))); -} - -DEFBINOP (el_ldiv, sparse_complex_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_matrix&); - - return octave_value - (quotient (v2.matrix_value (), v1.sparse_complex_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_complex_matrix, matrix, mx_el_and) -DEFBINOP_FN (el_or, sparse_complex_matrix, matrix, mx_el_or) - -DEFCATOP (scm_m, sparse_complex_matrix, matrix) -{ - CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_matrix&); - SparseMatrix tmp (v2.matrix_value ()); - return octave_value - (v1.sparse_complex_matrix_value (). concat (tmp, ra_idx)); -} - -DEFASSIGNOP (assign, sparse_complex_matrix, matrix) -{ - CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_matrix&); - - SparseComplexMatrix tmp (v2.complex_matrix_value ()); - v1.assign (idx, tmp); - return octave_value (); -} - -void -install_scm_m_ops (void) -{ - INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_matrix, add); - INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_matrix, sub); - INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_matrix, mul); - INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_matrix, div); - INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, octave_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, octave_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, octave_matrix, lt); - INSTALL_BINOP (op_le, octave_sparse_complex_matrix, octave_matrix, le); - INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, octave_matrix, eq); - INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, octave_matrix, ge); - INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, octave_matrix, gt); - INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, octave_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, octave_matrix, - el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, octave_matrix, - el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, octave_matrix, - el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, octave_matrix, - el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, octave_matrix, - el_and); - INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, octave_matrix, - el_or); - - INSTALL_CATOP (octave_sparse_complex_matrix, octave_matrix, scm_m); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, octave_matrix, - assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-scm-s.cc --- a/src/OPERATORS/op-scm-s.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,189 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-cx-mat.h" -#include "ov-scalar.h" -#include "ops.h" -#include "xpow.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "smx-scm-s.h" -#include "smx-s-scm.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -// sparse complex matrix by scalar ops. - -DEFBINOP_OP (add, sparse_complex_matrix, scalar, +) -DEFBINOP_OP (sub, sparse_complex_matrix, scalar, -) -DEFBINOP_OP (mul, sparse_complex_matrix, scalar, *) - -DEFBINOP (div, sparse_complex_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_scalar&); - - double d = v2.double_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v1.sparse_complex_matrix_value () / d); - - return retval; -} - -DEFBINOP (pow, sparse_complex_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_scalar&); - - double tmp = v2.scalar_value (); - if (static_cast (tmp) == tmp) - return xpow (v1.sparse_complex_matrix_value (), tmp); - else - return xpow (v1.complex_matrix_value (), tmp); -} - -DEFBINOP (ldiv, sparse_complex_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_scalar&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (SparseComplexMatrix (1, 1, v2.scalar_value () / d)); - } - else - { - MatrixType typ = v1.matrix_type (); - SparseComplexMatrix m1 = v1.sparse_complex_matrix_value (); - Matrix m2 = Matrix (1, 1, v2.scalar_value ()); - ComplexMatrix ret = xleftdiv (m1, m2, typ); - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (lt, sparse_complex_matrix, scalar, mx_el_lt) -DEFBINOP_FN (le, sparse_complex_matrix, scalar, mx_el_le) -DEFBINOP_FN (eq, sparse_complex_matrix, scalar, mx_el_eq) -DEFBINOP_FN (ge, sparse_complex_matrix, scalar, mx_el_ge) -DEFBINOP_FN (gt, sparse_complex_matrix, scalar, mx_el_gt) -DEFBINOP_FN (ne, sparse_complex_matrix, scalar, mx_el_ne) - -DEFBINOP_OP (el_mul, sparse_complex_matrix, scalar, *) - -DEFBINOP (el_div, sparse_complex_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_scalar&); - - double d = v2.double_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v1.sparse_complex_matrix_value () / d); - - return retval; -} - -DEFBINOP_FN (el_pow, sparse_complex_matrix, scalar, elem_xpow) - -DEFBINOP (el_ldiv, sparse_complex_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_scalar&); - - return octave_value - (x_el_div (v2.double_value (), v1.sparse_complex_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_complex_matrix, scalar, mx_el_and) -DEFBINOP_FN (el_or, sparse_complex_matrix, scalar, mx_el_or) - -DEFCATOP (scm_s, sparse_complex_matrix, scalar) -{ - CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_scalar&); - SparseComplexMatrix tmp (1, 1, v2.complex_value ()); - return octave_value - (v1.sparse_complex_matrix_value (). concat (tmp, ra_idx)); -} - -DEFASSIGNOP (assign, sparse_complex_matrix, scalar) -{ - CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_scalar&); - - SparseComplexMatrix tmp (1, 1, v2.complex_value ()); - v1.assign (idx, tmp); - return octave_value (); -} - -void -install_scm_s_ops (void) -{ - INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_scalar, add); - INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_scalar, sub); - INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_scalar, mul); - INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_scalar, div); - INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, octave_scalar, pow); - INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, octave_scalar, ldiv); - INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, octave_scalar, lt); - INSTALL_BINOP (op_le, octave_sparse_complex_matrix, octave_scalar, le); - INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, octave_scalar, eq); - INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, octave_scalar, ge); - INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, octave_scalar, gt); - INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, octave_scalar, ne); - INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, octave_scalar, - el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, octave_scalar, - el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, octave_scalar, - el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, octave_scalar, - el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, octave_scalar, - el_and); - INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, octave_scalar, - el_or); - - INSTALL_CATOP (octave_sparse_complex_matrix, octave_scalar, scm_s); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, octave_scalar, - assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-scm-scm.cc --- a/src/OPERATORS/op-scm-scm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,248 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" - -#include "sparse-xdiv.h" -#include "sparse-xpow.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-cx-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -// unary sparse complex matrix ops. - -DEFUNOP_OP (not, sparse_complex_matrix, !) -DEFUNOP_OP (uplus, sparse_complex_matrix, /* no-op */) -DEFUNOP_OP (uminus, sparse_complex_matrix, -) - -DEFUNOP (transpose, sparse_complex_matrix) -{ - CAST_UNOP_ARG (const octave_sparse_complex_matrix&); - return octave_value - (v.sparse_complex_matrix_value ().transpose (), - v.matrix_type ().transpose ()); -} - -DEFUNOP (hermitian, sparse_complex_matrix) -{ - CAST_UNOP_ARG (const octave_sparse_complex_matrix&); - return octave_value - (v.sparse_complex_matrix_value ().hermitian (), - v.matrix_type ().transpose ()); -} - -#if 0 -DEFUNOP (incr, sparse_complex_matrix) -{ - CAST_UNOP_ARG (const octave_sparse_complex_matrix&); - - return octave_value (v.complex_matrix_value () .increment ()); -} - -DEFUNOP (decr, sparse_complex_matrix) -{ - CAST_UNOP_ARG (const octave_sparse_complex_matrix&); - - return octave_value (v.complex_matrix_value () .decrement ()); -} -#endif - -// complex matrix by complex matrix ops. - -DEFBINOP_OP (add, sparse_complex_matrix, sparse_complex_matrix, +) -DEFBINOP_OP (sub, sparse_complex_matrix, sparse_complex_matrix, -) - -DEFBINOP_OP (mul, sparse_complex_matrix, sparse_complex_matrix, *) - -DEFBINOP (div, sparse_complex_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.sparse_complex_matrix_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - SparseComplexMatrix ret = xdiv (v1.sparse_complex_matrix_value (), - v2.sparse_complex_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOPX (pow, sparse_complex_matrix, sparse_complex_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, sparse_complex_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_sparse_complex_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.sparse_complex_matrix_value () / d); - } - else - { - MatrixType typ = v1.matrix_type (); - - SparseComplexMatrix ret = - xleftdiv (v1.sparse_complex_matrix_value (), - v2.sparse_complex_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (lt, sparse_complex_matrix, sparse_complex_matrix, mx_el_lt) -DEFBINOP_FN (le, sparse_complex_matrix, sparse_complex_matrix, mx_el_le) -DEFBINOP_FN (eq, sparse_complex_matrix, sparse_complex_matrix, mx_el_eq) -DEFBINOP_FN (ge, sparse_complex_matrix, sparse_complex_matrix, mx_el_ge) -DEFBINOP_FN (gt, sparse_complex_matrix, sparse_complex_matrix, mx_el_gt) -DEFBINOP_FN (ne, sparse_complex_matrix, sparse_complex_matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, sparse_complex_matrix, sparse_complex_matrix, product) -DEFBINOP_FN (el_div, sparse_complex_matrix, sparse_complex_matrix, quotient) -DEFBINOP_FN (el_pow, sparse_complex_matrix, sparse_complex_matrix, elem_xpow) - -DEFBINOP (el_ldiv, sparse_complex_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_sparse_complex_matrix&); - - return octave_value (quotient (v2.sparse_complex_matrix_value (), - v1.sparse_complex_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_complex_matrix, sparse_complex_matrix, mx_el_and) -DEFBINOP_FN (el_or, sparse_complex_matrix, sparse_complex_matrix, mx_el_or) - -DEFCATOP_FN (scm_scm, sparse_complex_matrix, sparse_complex_matrix, concat) - -DEFASSIGNOP_FN (assign, sparse_complex_matrix, sparse_complex_matrix, assign) - -DEFNULLASSIGNOP_FN (null_assign, sparse_complex_matrix, delete_elements) - -void -install_scm_scm_ops (void) -{ - INSTALL_UNOP (op_not, octave_sparse_complex_matrix, not); - INSTALL_UNOP (op_uplus, octave_sparse_complex_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_sparse_complex_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_sparse_complex_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_sparse_complex_matrix, hermitian); - -#if 0 - INSTALL_NCUNOP (op_incr, octave_sparse_complex_matrix, incr); - INSTALL_NCUNOP (op_decr, octave_sparse_complex_matrix, decr); -#endif - - INSTALL_BINOP (op_add, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, el_or); - - INSTALL_CATOP (octave_sparse_complex_matrix, - octave_sparse_complex_matrix, scm_scm); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, - octave_sparse_complex_matrix, assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, - octave_null_matrix, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, - octave_null_str, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, - octave_null_sq_str, null_assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-scm-sm.cc --- a/src/OPERATORS/op-scm-sm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,174 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ops.h" - -#include "sparse-xdiv.h" -#include "sparse-xpow.h" -#include "smx-sm-scm.h" -#include "smx-scm-sm.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -// sparse complex matrix by sparse matrix ops. - -DEFBINOP_OP (add, sparse_complex_matrix, sparse_matrix, +) -DEFBINOP_OP (sub, sparse_complex_matrix, sparse_matrix, -) - -DEFBINOP_OP (mul, sparse_complex_matrix, sparse_matrix, *) - -DEFBINOP (div, sparse_complex_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - double d = v2.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.sparse_complex_matrix_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - SparseComplexMatrix ret = xdiv (v1.sparse_complex_matrix_value (), - v2.sparse_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOPX (pow, sparse_complex_matrix, sparse_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, sparse_complex_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_sparse_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - Complex d = v1.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.sparse_matrix_value () / d); - } - else - { - MatrixType typ = v1.matrix_type (); - - SparseComplexMatrix ret = xleftdiv (v1.sparse_complex_matrix_value (), - v2.sparse_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (lt, sparse_complex_matrix, sparse_matrix, mx_el_lt) -DEFBINOP_FN (le, sparse_complex_matrix, sparse_matrix, mx_el_le) -DEFBINOP_FN (eq, sparse_complex_matrix, sparse_matrix, mx_el_eq) -DEFBINOP_FN (ge, sparse_complex_matrix, sparse_matrix, mx_el_ge) -DEFBINOP_FN (gt, sparse_complex_matrix, sparse_matrix, mx_el_gt) -DEFBINOP_FN (ne, sparse_complex_matrix, sparse_matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, sparse_complex_matrix, sparse_matrix, product) -DEFBINOP_FN (el_div, sparse_complex_matrix, sparse_matrix, quotient) -DEFBINOP_FN (el_pow, sparse_complex_matrix, sparse_matrix, elem_xpow) - -DEFBINOP (el_ldiv, sparse_complex_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, - const octave_sparse_matrix&); - - return octave_value - (quotient (v2.sparse_matrix_value (), v1.sparse_complex_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_complex_matrix, sparse_matrix, mx_el_and) -DEFBINOP_FN (el_or, sparse_complex_matrix, sparse_matrix, mx_el_or) - -DEFCATOP_FN (scm_sm, sparse_complex_matrix, sparse_matrix, concat) - -DEFASSIGNOP_FN (assign, sparse_complex_matrix, sparse_matrix, assign) - -void -install_scm_sm_ops (void) -{ - INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_sparse_matrix, - add); - INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_sparse_matrix, - sub); - INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_sparse_matrix, - mul); - INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_sparse_matrix, - div); - INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, octave_sparse_matrix, - pow); - INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, octave_sparse_matrix, - ldiv); - INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, octave_sparse_matrix, - lt); - INSTALL_BINOP (op_le, octave_sparse_complex_matrix, octave_sparse_matrix, - le); - INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, octave_sparse_matrix, - eq); - INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, octave_sparse_matrix, - ge); - INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, octave_sparse_matrix, - gt); - INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, octave_sparse_matrix, - ne); - INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, - octave_sparse_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, - octave_sparse_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, - octave_sparse_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, - octave_sparse_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, - octave_sparse_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, - octave_sparse_matrix, el_or); - - INSTALL_CATOP (octave_sparse_complex_matrix, octave_sparse_matrix, scm_sm); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, - octave_sparse_matrix, assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-sm-cm.cc --- a/src/OPERATORS/op-sm-cm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,173 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-cx-mat.h" -#include "ops.h" -#include "xdiv.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "smx-sm-cm.h" -#include "smx-cm-sm.h" -#include "ov-re-sparse.h" - -// sparse matrix by complex matrix ops. - -DEFBINOP_OP (add, sparse_matrix, complex_matrix, +) -DEFBINOP_OP (sub, sparse_matrix, complex_matrix, -) - -DEFBINOP_OP (mul, sparse_matrix, complex_matrix, *) - -DEFBINOP (div, sparse_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, - const octave_complex_matrix&); - MatrixType typ = v2.matrix_type (); - - ComplexMatrix ret = xdiv (v1.matrix_value (), - v2.complex_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOPX (pow, sparse_matrix, complex_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, sparse_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - double d = v1.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.complex_array_value () / d); - } - else - { - MatrixType typ = v1.matrix_type (); - - ComplexMatrix ret = xleftdiv (v1.sparse_matrix_value (), - v2.complex_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (lt, sparse_matrix, complex_matrix, mx_el_lt) -DEFBINOP_FN (le, sparse_matrix, complex_matrix, mx_el_le) -DEFBINOP_FN (eq, sparse_matrix, complex_matrix, mx_el_eq) -DEFBINOP_FN (ge, sparse_matrix, complex_matrix, mx_el_ge) -DEFBINOP_FN (gt, sparse_matrix, complex_matrix, mx_el_gt) -DEFBINOP_FN (ne, sparse_matrix, complex_matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, sparse_matrix, complex_matrix, product) -DEFBINOP_FN (el_div, sparse_matrix, complex_matrix, quotient) - -DEFBINOP (el_pow, sparse_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, - const octave_complex_matrix&); - - return octave_value - (elem_xpow (v1.sparse_matrix_value (), SparseComplexMatrix - (v2.complex_matrix_value ()))); -} - -DEFBINOP (el_ldiv, sparse_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, - const octave_complex_matrix&); - - return octave_value - (quotient (v2.complex_matrix_value (), v1.sparse_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_matrix, complex_matrix, mx_el_and) -DEFBINOP_FN (el_or, sparse_matrix, complex_matrix, mx_el_or) - -DEFCATOP (sm_cm, sparse_matrix, complex_matrix) -{ - CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_complex_matrix&); - SparseComplexMatrix tmp (v2.complex_matrix_value ()); - return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); -} - -DEFCONV (sparse_complex_matrix_conv, sparse_matrix, sparse_complex_matrix) -{ - CAST_CONV_ARG (const octave_sparse_matrix&); - return new octave_complex_matrix (v.complex_matrix_value ()); -} - -void -install_sm_cm_ops (void) -{ - INSTALL_BINOP (op_add, octave_sparse_matrix, octave_complex_matrix, add); - INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_complex_matrix, sub); - INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_complex_matrix, mul); - INSTALL_BINOP (op_div, octave_sparse_matrix, octave_complex_matrix, div); - INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_complex_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_complex_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_complex_matrix, lt); - INSTALL_BINOP (op_le, octave_sparse_matrix, octave_complex_matrix, le); - INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_complex_matrix, eq); - INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_complex_matrix, ge); - INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_complex_matrix, gt); - INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_complex_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_sparse_matrix, octave_complex_matrix, - el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_matrix, octave_complex_matrix, - el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_matrix, octave_complex_matrix, - el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, octave_complex_matrix, - el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_matrix, octave_complex_matrix, - el_and); - INSTALL_BINOP (op_el_or, octave_sparse_matrix, octave_complex_matrix, - el_or); - - INSTALL_CATOP (octave_sparse_matrix, octave_complex_matrix, sm_cm); - - INSTALL_ASSIGNCONV (octave_sparse_matrix, octave_complex_matrix, - octave_sparse_complex_matrix); - - INSTALL_WIDENOP (octave_sparse_matrix, octave_complex_matrix, - sparse_complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-sm-cs.cc --- a/src/OPERATORS/op-sm-cs.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,165 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-complex.h" -#include "ops.h" -#include "xpow.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "smx-sm-cs.h" -#include "smx-cs-sm.h" - -// sparse matrix by scalar ops. - -DEFBINOP_OP (add, sparse_matrix, complex, +) -DEFBINOP_OP (sub, sparse_matrix, complex, -) -DEFBINOP_OP (mul, sparse_matrix, complex, *) - -DEFBINOP (div, sparse_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex&); - - Complex d = v2.complex_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v1.sparse_matrix_value () / d); - - return retval; -} - -DEFBINOP (pow, sparse_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex&); - return xpow (v1.matrix_value (), v2.complex_value ()); -} - -DEFBINOP (ldiv, sparse_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - double d = v1.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (SparseComplexMatrix (1, 1, v2.complex_value () / d)); - } - else - { - MatrixType typ = v1.matrix_type (); - SparseMatrix m1 = v1.sparse_matrix_value (); - ComplexMatrix m2 = ComplexMatrix (1, 1, v2.complex_value ()); - ComplexMatrix ret = xleftdiv (m1, m2, typ); - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (lt, sparse_matrix, complex, mx_el_lt) -DEFBINOP_FN (le, sparse_matrix, complex, mx_el_le) -DEFBINOP_FN (eq, sparse_matrix, complex, mx_el_eq) -DEFBINOP_FN (ge, sparse_matrix, complex, mx_el_ge) -DEFBINOP_FN (gt, sparse_matrix, complex, mx_el_gt) -DEFBINOP_FN (ne, sparse_matrix, complex, mx_el_ne) - -DEFBINOP_OP (el_mul, sparse_matrix, complex, *) - -DEFBINOP (el_div, sparse_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex&); - - Complex d = v2.complex_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v1.sparse_matrix_value () / d); - - return retval; -} - -DEFBINOP_FN (el_pow, sparse_matrix, complex, elem_xpow) - -DEFBINOP (el_ldiv, sparse_matrix, complex) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex&); - - return octave_value (x_el_div (v2.complex_value (), - v1.sparse_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_matrix, complex, mx_el_and) -DEFBINOP_FN (el_or, sparse_matrix, complex, mx_el_or) - -DEFCATOP (sm_cs, sparse_matrix, complex) -{ - CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_complex&); - SparseComplexMatrix tmp (1, 1, v2.complex_value ()); - return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); -} - -void -install_sm_cs_ops (void) -{ - INSTALL_BINOP (op_add, octave_sparse_matrix, octave_complex, add); - INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_complex, sub); - INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_complex, mul); - INSTALL_BINOP (op_div, octave_sparse_matrix, octave_complex, div); - INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_complex, pow); - INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_complex, ldiv); - - INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_complex, lt); - INSTALL_BINOP (op_le, octave_sparse_matrix, octave_complex, le); - INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_complex, eq); - INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_complex, ge); - INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_complex, gt); - INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_complex, ne); - INSTALL_BINOP (op_el_mul, octave_sparse_matrix, octave_complex, el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_matrix, octave_complex, el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_matrix, octave_complex, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, octave_complex, el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_matrix, octave_complex, el_and); - INSTALL_BINOP (op_el_or, octave_sparse_matrix, octave_complex, el_or); - - INSTALL_CATOP (octave_sparse_matrix, octave_complex, sm_cs); - - INSTALL_ASSIGNCONV (octave_sparse_matrix, octave_complex, - octave_sparse_complex_matrix); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-sm-m.cc --- a/src/OPERATORS/op-sm-m.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,165 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-re-mat.h" -#include "ops.h" -#include "xdiv.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "smx-sm-m.h" -#include "smx-m-sm.h" -#include "ov-re-sparse.h" - -// sparse matrix by matrix ops. - -DEFBINOP_OP (add, sparse_matrix, matrix, +) -DEFBINOP_OP (sub, sparse_matrix, matrix, -) - -DEFBINOP_OP (mul, sparse_matrix, matrix, *) - -DEFBINOP (div, sparse_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_matrix&); - MatrixType typ = v2.matrix_type (); - - Matrix ret = xdiv (v1.matrix_value (), v2.matrix_value (), typ); - - v2.matrix_type (typ); - return ret; -} - -DEFBINOPX (pow, sparse_matrix, matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, sparse_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - double d = v1.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.array_value () / d); - } - else - { - MatrixType typ = v1.matrix_type (); - - Matrix ret = xleftdiv (v1.sparse_matrix_value (), - v2.matrix_value (), typ); - - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (trans_mul, sparse_matrix, matrix, trans_mul); - -DEFBINOP_FN (lt, sparse_matrix, matrix, mx_el_lt) -DEFBINOP_FN (le, sparse_matrix, matrix, mx_el_le) -DEFBINOP_FN (eq, sparse_matrix, matrix, mx_el_eq) -DEFBINOP_FN (ge, sparse_matrix, matrix, mx_el_ge) -DEFBINOP_FN (gt, sparse_matrix, matrix, mx_el_gt) -DEFBINOP_FN (ne, sparse_matrix, matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, sparse_matrix, matrix, product) -DEFBINOP_FN (el_div, sparse_matrix, matrix, quotient) - -DEFBINOP (el_pow, sparse_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_matrix&); - - return octave_value (elem_xpow (v1.sparse_matrix_value (), - SparseMatrix (v2.matrix_value ()))); -} - -DEFBINOP (el_ldiv, sparse_matrix, matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_matrix&); - - return octave_value - (quotient (v2.matrix_value (), v1.sparse_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_matrix, matrix, mx_el_and) -DEFBINOP_FN (el_or, sparse_matrix, matrix, mx_el_or) - -DEFCATOP (sm_m, sparse_matrix, matrix) -{ - CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_matrix&); - SparseMatrix tmp (v2.matrix_value ()); - return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); -} - -DEFASSIGNOP (assign, sparse_matrix, matrix) -{ - CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_matrix&); - - SparseMatrix tmp (v2.matrix_value ()); - v1.assign (idx, tmp); - return octave_value (); -} - -void -install_sm_m_ops (void) -{ - INSTALL_BINOP (op_add, octave_sparse_matrix, octave_matrix, add); - INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_matrix, sub); - INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_matrix, mul); - INSTALL_BINOP (op_div, octave_sparse_matrix, octave_matrix, div); - INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_matrix, ldiv); - INSTALL_BINOP (op_trans_mul, octave_sparse_matrix, octave_matrix, trans_mul); - INSTALL_BINOP (op_herm_mul, octave_sparse_matrix, octave_matrix, trans_mul); - INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_matrix, lt); - INSTALL_BINOP (op_le, octave_sparse_matrix, octave_matrix, le); - INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_matrix, eq); - INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_matrix, ge); - INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_matrix, gt); - INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_sparse_matrix, octave_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_matrix, octave_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_matrix, octave_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, octave_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_matrix, octave_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_sparse_matrix, octave_matrix, el_or); - - INSTALL_CATOP (octave_sparse_matrix, octave_matrix, sm_m); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_matrix, assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-sm-s.cc --- a/src/OPERATORS/op-sm-s.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,175 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-scalar.h" -#include "ops.h" -#include "xpow.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "ov-re-sparse.h" - -// sparse matrix by scalar ops. - -DEFBINOP_OP (add, sparse_matrix, scalar, +) -DEFBINOP_OP (sub, sparse_matrix, scalar, -) -DEFBINOP_OP (mul, sparse_matrix, scalar, *) - -DEFBINOP (div, sparse_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_scalar&); - - double d = v2.double_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v1.sparse_matrix_value () / d); - - return retval; -} - -DEFBINOP (pow, sparse_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_scalar&); - - double tmp = v2.scalar_value (); - if (static_cast (tmp) == tmp) - return xpow (v1.sparse_matrix_value (), tmp); - else - return xpow (v1.matrix_value (), tmp); -} - -DEFBINOP (ldiv, sparse_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_scalar&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - double d = v1.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (SparseMatrix(1, 1, v2.scalar_value () / d)); - } - else - { - MatrixType typ = v1.matrix_type (); - SparseMatrix m1 = v1.sparse_matrix_value (); - Matrix m2 = Matrix (1, 1, v2.scalar_value ()); - Matrix ret = xleftdiv (m1, m2, typ); - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (lt, sparse_matrix, scalar, mx_el_lt) -DEFBINOP_FN (le, sparse_matrix, scalar, mx_el_le) -DEFBINOP_FN (eq, sparse_matrix, scalar, mx_el_eq) -DEFBINOP_FN (ge, sparse_matrix, scalar, mx_el_ge) -DEFBINOP_FN (gt, sparse_matrix, scalar, mx_el_gt) -DEFBINOP_FN (ne, sparse_matrix, scalar, mx_el_ne) - -DEFBINOP_OP (el_mul, sparse_matrix, scalar, *) - -DEFBINOP (el_div, sparse_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_scalar&); - - double d = v2.double_value (); - octave_value retval; - - if (d == 0.0) - gripe_divide_by_zero (); - - retval = octave_value (v1.sparse_matrix_value () / d); - - return retval; -} - -DEFBINOP_FN (el_pow, sparse_matrix, scalar, elem_xpow) - -DEFBINOP (el_ldiv, sparse_matrix, scalar) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_scalar&); - - return octave_value - (x_el_div (v2.complex_value (), v1.sparse_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_matrix, scalar, mx_el_and) -DEFBINOP_FN (el_or, sparse_matrix, scalar, mx_el_or) - -DEFCATOP (sm_s, sparse_matrix, scalar) -{ - CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_scalar&); - SparseMatrix tmp (1, 1, v2.scalar_value ()); - return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); -} - -DEFASSIGNOP (assign, sparse_matrix, scalar) -{ - CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_scalar&); - - SparseMatrix tmp (1, 1, v2.scalar_value ()); - v1.assign (idx, tmp); - return octave_value (); -} - -void -install_sm_s_ops (void) -{ - INSTALL_BINOP (op_add, octave_sparse_matrix, octave_scalar, add); - INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_scalar, sub); - INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_scalar, mul); - INSTALL_BINOP (op_div, octave_sparse_matrix, octave_scalar, div); - INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_scalar, pow); - INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_scalar, ldiv); - - INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_scalar, lt); - INSTALL_BINOP (op_le, octave_sparse_matrix, octave_scalar, le); - INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_scalar, eq); - INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_scalar, ge); - INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_scalar, gt); - INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_scalar, ne); - INSTALL_BINOP (op_el_mul, octave_sparse_matrix, octave_scalar, el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_matrix, octave_scalar, el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_matrix, octave_scalar, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, octave_scalar, el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_matrix, octave_scalar, el_and); - INSTALL_BINOP (op_el_or, octave_sparse_matrix, octave_scalar, el_or); - - INSTALL_CATOP (octave_sparse_matrix, octave_scalar, sm_s); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_scalar, assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-sm-scm.cc --- a/src/OPERATORS/op-sm-scm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,182 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ops.h" - -#include "sparse-xdiv.h" -#include "sparse-xpow.h" -#include "smx-sm-scm.h" -#include "smx-scm-sm.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -// sparse matrix by sparse complex matrix ops. - -DEFBINOP_OP (add, sparse_matrix, sparse_complex_matrix, +) -DEFBINOP_OP (sub, sparse_matrix, sparse_complex_matrix, -) - -DEFBINOP_OP (mul, sparse_matrix, sparse_complex_matrix, *) - -DEFBINOP (div, sparse_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_complex_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - Complex d = v2.complex_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.sparse_matrix_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - SparseComplexMatrix ret = xdiv (v1.sparse_matrix_value (), - v2.sparse_complex_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOPX (pow, sparse_matrix, sparse_complex_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, sparse_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_complex_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - double d = v1.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.sparse_complex_matrix_value () / d); - } - else - { - MatrixType typ = v1.matrix_type (); - - SparseComplexMatrix ret = - xleftdiv (v1.sparse_matrix_value (), - v2.sparse_complex_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (lt, sparse_matrix, sparse_complex_matrix, mx_el_lt) -DEFBINOP_FN (le, sparse_matrix, sparse_complex_matrix, mx_el_le) -DEFBINOP_FN (eq, sparse_matrix, sparse_complex_matrix, mx_el_eq) -DEFBINOP_FN (ge, sparse_matrix, sparse_complex_matrix, mx_el_ge) -DEFBINOP_FN (gt, sparse_matrix, sparse_complex_matrix, mx_el_gt) -DEFBINOP_FN (ne, sparse_matrix, sparse_complex_matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, sparse_matrix, sparse_complex_matrix, product) -DEFBINOP_FN (el_div, sparse_matrix, sparse_complex_matrix, quotient) -DEFBINOP_FN (el_pow, sparse_matrix, sparse_complex_matrix, elem_xpow) - -DEFBINOP (el_ldiv, sparse_matrix, sparse_complex_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, - const octave_sparse_complex_matrix&); - - return octave_value - (quotient (v2.sparse_complex_matrix_value (), v1.sparse_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_matrix, sparse_complex_matrix, mx_el_and) -DEFBINOP_FN (el_or, sparse_matrix, sparse_complex_matrix, mx_el_or) - -DEFCATOP_FN (sm_scm, sparse_matrix, sparse_complex_matrix, concat) - -DEFCONV (sparse_complex_matrix_conv, sparse_matrix, sparse_complex_matrix) -{ - CAST_CONV_ARG (const octave_sparse_matrix&); - return new octave_sparse_complex_matrix (v.sparse_complex_matrix_value ()); -} - -void -install_sm_scm_ops (void) -{ - INSTALL_BINOP (op_add, octave_sparse_matrix, octave_sparse_complex_matrix, - add); - INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_sparse_complex_matrix, - sub); - INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_sparse_complex_matrix, - mul); - INSTALL_BINOP (op_div, octave_sparse_matrix, octave_sparse_complex_matrix, - div); - INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_sparse_complex_matrix, - pow); - INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_sparse_complex_matrix, - ldiv); - INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_sparse_complex_matrix, - lt); - INSTALL_BINOP (op_le, octave_sparse_matrix, octave_sparse_complex_matrix, - le); - INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_sparse_complex_matrix, - eq); - INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_sparse_complex_matrix, - ge); - INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_sparse_complex_matrix, - gt); - INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_sparse_complex_matrix, - ne); - INSTALL_BINOP (op_el_mul, octave_sparse_matrix, - octave_sparse_complex_matrix, el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_matrix, - octave_sparse_complex_matrix, el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_matrix, - octave_sparse_complex_matrix, el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, - octave_sparse_complex_matrix, el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_matrix, - octave_sparse_complex_matrix, el_and); - INSTALL_BINOP (op_el_or, octave_sparse_matrix, - octave_sparse_complex_matrix, el_or); - - INSTALL_CATOP (octave_sparse_matrix, octave_sparse_complex_matrix, sm_scm); - - INSTALL_ASSIGNCONV (octave_sparse_matrix, octave_sparse_complex_matrix, - octave_sparse_complex_matrix); - - INSTALL_WIDENOP (octave_sparse_matrix, octave_sparse_complex_matrix, - sparse_complex_matrix_conv); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-sm-sm.cc --- a/src/OPERATORS/op-sm-sm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,196 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-typeinfo.h" -#include "ov-re-mat.h" -#include "ov-null-mat.h" -#include "ops.h" - -#include "sparse-xpow.h" -#include "sparse-xdiv.h" -#include "ov-re-sparse.h" - -// sparse matrix unary ops. - -DEFUNOP_OP (not, sparse_matrix, !) -DEFUNOP_OP (uplus, sparse_matrix, /* no-op */) -DEFUNOP_OP (uminus, sparse_matrix, -) - -DEFUNOP (transpose, sparse_matrix) -{ - CAST_UNOP_ARG (const octave_sparse_matrix&); - return octave_value (v.sparse_matrix_value ().transpose (), - v.matrix_type ().transpose ()); -} - -// sparse matrix by sparse matrix ops. - -DEFBINOP_OP (add, sparse_matrix, sparse_matrix, +) - -// DEFBINOP_OP (sub, sparse_matrix, sparse_matrix, -) - - static octave_value - oct_binop_sub (const octave_base_value& a1, const octave_base_value& a2) - { - const octave_sparse_matrix& v1 = dynamic_cast (a1); - const octave_sparse_matrix& v2 = dynamic_cast (a2); - SparseMatrix m = v1.sparse_matrix_value () - v2.sparse_matrix_value (); - - return octave_value (m); - } - -DEFBINOP_OP (mul, sparse_matrix, sparse_matrix, *) - -DEFBINOP (div, sparse_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_matrix&); - - if (v2.rows () == 1 && v2.columns () == 1) - { - double d = v2.scalar_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v1.sparse_matrix_value () / d); - } - else - { - MatrixType typ = v2.matrix_type (); - SparseMatrix ret = xdiv (v1.sparse_matrix_value (), - v2.sparse_matrix_value (), typ); - - v2.matrix_type (typ); - return ret; - } -} - -DEFBINOPX (pow, sparse_matrix, sparse_matrix) -{ - error ("can't do A ^ B for A and B both matrices"); - return octave_value (); -} - -DEFBINOP (ldiv, sparse_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_matrix&); - - if (v1.rows () == 1 && v1.columns () == 1) - { - double d = v1.double_value (); - - if (d == 0.0) - gripe_divide_by_zero (); - - return octave_value (v2.sparse_matrix_value () / d); - } - else - { - MatrixType typ = v1.matrix_type (); - - SparseMatrix ret = xleftdiv (v1.sparse_matrix_value (), - v2.sparse_matrix_value (), typ); - - v1.matrix_type (typ); - return ret; - } -} - -DEFBINOP_FN (lt, sparse_matrix, sparse_matrix, mx_el_lt) -DEFBINOP_FN (le, sparse_matrix, sparse_matrix, mx_el_le) -DEFBINOP_FN (eq, sparse_matrix, sparse_matrix, mx_el_eq) -DEFBINOP_FN (ge, sparse_matrix, sparse_matrix, mx_el_ge) -DEFBINOP_FN (gt, sparse_matrix, sparse_matrix, mx_el_gt) -DEFBINOP_FN (ne, sparse_matrix, sparse_matrix, mx_el_ne) - -DEFBINOP_FN (el_mul, sparse_matrix, sparse_matrix, product) -DEFBINOP_FN (el_div, sparse_matrix, sparse_matrix, quotient) - -DEFBINOP_FN (el_pow, sparse_matrix, sparse_matrix, elem_xpow) - -DEFBINOP (el_ldiv, sparse_matrix, sparse_matrix) -{ - CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_matrix&); - return octave_value - (quotient (v2.sparse_matrix_value (), v1.sparse_matrix_value ())); -} - -DEFBINOP_FN (el_and, sparse_matrix, sparse_matrix, mx_el_and) -DEFBINOP_FN (el_or, sparse_matrix, sparse_matrix, mx_el_or) - -DEFCATOP_FN (sm_sm, sparse_matrix, sparse_matrix, concat) - -DEFASSIGNOP_FN (assign, sparse_matrix, sparse_matrix, assign) - -DEFNULLASSIGNOP_FN (null_assign, sparse_matrix, delete_elements) - -void -install_sm_sm_ops (void) -{ - INSTALL_UNOP (op_not, octave_sparse_matrix, not); - INSTALL_UNOP (op_uplus, octave_sparse_matrix, uplus); - INSTALL_UNOP (op_uminus, octave_sparse_matrix, uminus); - INSTALL_UNOP (op_transpose, octave_sparse_matrix, transpose); - INSTALL_UNOP (op_hermitian, octave_sparse_matrix, transpose); - - INSTALL_BINOP (op_add, octave_sparse_matrix, octave_sparse_matrix, add); - INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_sparse_matrix, sub); - INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_sparse_matrix, mul); - INSTALL_BINOP (op_div, octave_sparse_matrix, octave_sparse_matrix, div); - INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_sparse_matrix, pow); - INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_sparse_matrix, ldiv); - INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_sparse_matrix, lt); - INSTALL_BINOP (op_le, octave_sparse_matrix, octave_sparse_matrix, le); - INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_sparse_matrix, eq); - INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_sparse_matrix, ge); - INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_sparse_matrix, gt); - INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_sparse_matrix, ne); - INSTALL_BINOP (op_el_mul, octave_sparse_matrix, octave_sparse_matrix, - el_mul); - INSTALL_BINOP (op_el_div, octave_sparse_matrix, octave_sparse_matrix, - el_div); - INSTALL_BINOP (op_el_pow, octave_sparse_matrix, octave_sparse_matrix, - el_pow); - INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, octave_sparse_matrix, - el_ldiv); - INSTALL_BINOP (op_el_and, octave_sparse_matrix, octave_sparse_matrix, - el_and); - INSTALL_BINOP (op_el_or, octave_sparse_matrix, octave_sparse_matrix, - el_or); - - INSTALL_CATOP (octave_sparse_matrix, octave_sparse_matrix, sm_sm); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_sparse_matrix, - assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_null_matrix, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_null_str, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_null_sq_str, null_assign); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-str-m.cc --- a/src/OPERATORS/op-str-m.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,64 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-re-mat.h" -#include "ov-str-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" - -DEFASSIGNOP (assign, char_matrix_str, octave_matrix) -{ - CAST_BINOP_ARGS (octave_char_matrix_str&, const octave_matrix&); - - octave_value tmp - = v2.convert_to_str_internal (false, false, - a1.is_sq_string () ? '\'' : '"'); - - if (! error_state) - v1.assign (idx, tmp.char_array_value ()); - - return octave_value (); -} - -DEFNDCHARCATOP_FN (str_m, char_matrix_str, matrix, concat) - -DEFNDCHARCATOP_FN (m_str, matrix, char_matrix_str, concat) - -void -install_str_m_ops (void) -{ - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_matrix, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_matrix, assign); - - INSTALL_CATOP (octave_char_matrix_str, octave_matrix, str_m); - INSTALL_CATOP (octave_char_matrix_sq_str, octave_matrix, str_m); - - INSTALL_CATOP (octave_matrix, octave_char_matrix_str, m_str); - INSTALL_CATOP (octave_matrix, octave_char_matrix_sq_str, m_str); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-str-s.cc --- a/src/OPERATORS/op-str-s.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,64 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-scalar.h" -#include "ov-str-mat.h" -#include "ov-typeinfo.h" -#include "ops.h" - -DEFASSIGNOP (assign, char_matrix_str, octave_scalar) -{ - CAST_BINOP_ARGS (octave_char_matrix_str&, const octave_scalar&); - - octave_value tmp - = v2.convert_to_str_internal (false, false, - a1.is_sq_string () ? '\'' : '"'); - - if (! error_state) - v1.assign (idx, tmp.char_array_value ()); - - return octave_value (); -} - -DEFNDCHARCATOP_FN (str_s, char_matrix_str, scalar, concat) - -DEFNDCHARCATOP_FN (s_str, scalar, char_matrix_str, concat) - -void -install_str_s_ops (void) -{ - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_scalar, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_scalar, assign); - - INSTALL_CATOP (octave_char_matrix_str, octave_scalar, str_s); - INSTALL_CATOP (octave_char_matrix_sq_str, octave_scalar, str_s); - - INSTALL_CATOP (octave_scalar, octave_char_matrix_str, s_str); - INSTALL_CATOP (octave_scalar, octave_char_matrix_sq_str, s_str); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-str-str.cc --- a/src/OPERATORS/op-str-str.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,155 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-str-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" - -// string unary ops. - -DEFUNOP (transpose, char_matrix_str) -{ - CAST_UNOP_ARG (const octave_char_matrix_str&); - - if (v.ndims () > 2) - { - error ("transpose not defined for N-d objects"); - return octave_value (); - } - else - return octave_value (v.char_matrix_value ().transpose (), - a.is_sq_string () ? '\'' : '"'); -} - -// string by string ops. - -#define DEFCHARNDBINOP_FN(name, op, t1, t2, e1, e2, f) \ - BINOPDECL (name, a1, a2) \ - { \ - dim_vector a1_dims = a1.dims (); \ - dim_vector a2_dims = a2.dims (); \ - \ - bool a1_is_scalar = a1_dims.all_ones (); \ - bool a2_is_scalar = a2_dims.all_ones (); \ - \ - CAST_BINOP_ARGS (const octave_ ## t1&, const octave_ ## t2&); \ - \ - if (a1_is_scalar) \ - { \ - if (a2_is_scalar) \ - return octave_value ((v1.e1 ## _value ())(0) op (v2.e2 ## _value ())(0)); \ - else \ - return octave_value (f ((v1.e1 ## _value ())(0), v2.e2 ## _value ())); \ - } \ - else \ - { \ - if (a2_is_scalar) \ - return octave_value (f (v1.e1 ## _value (), (v2.e2 ## _value ())(0))); \ - else \ - return octave_value (f (v1.e1 ## _value (), v2.e2 ## _value ())); \ - } \ - } - -DEFCHARNDBINOP_FN (lt, <, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_lt) -DEFCHARNDBINOP_FN (le, <=, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_le) -DEFCHARNDBINOP_FN (eq, ==, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_eq) -DEFCHARNDBINOP_FN (ge, >=, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_ge) -DEFCHARNDBINOP_FN (gt, >, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_gt) -DEFCHARNDBINOP_FN (ne, !=, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_ne) - -DEFASSIGNOP (assign, char_matrix_str, char_matrix_str) -{ - CAST_BINOP_ARGS (octave_char_matrix_str&, const octave_char_matrix_str&); - - v1.assign (idx, v2.char_array_value ()); - return octave_value (); -} - -DEFNULLASSIGNOP_FN (null_assign, char_matrix_str, delete_elements) - -DEFNDCHARCATOP_FN (str_str, char_matrix_str, char_matrix_str, concat) - -void -install_str_str_ops (void) -{ - INSTALL_UNOP (op_transpose, octave_char_matrix_str, transpose); - INSTALL_UNOP (op_transpose, octave_char_matrix_sq_str, transpose); - - INSTALL_UNOP (op_hermitian, octave_char_matrix_str, transpose); - INSTALL_UNOP (op_hermitian, octave_char_matrix_sq_str, transpose); - - INSTALL_BINOP (op_lt, octave_char_matrix_str, octave_char_matrix_str, lt); - INSTALL_BINOP (op_lt, octave_char_matrix_str, octave_char_matrix_sq_str, lt); - INSTALL_BINOP (op_lt, octave_char_matrix_sq_str, octave_char_matrix_str, lt); - INSTALL_BINOP (op_lt, octave_char_matrix_sq_str, octave_char_matrix_sq_str, lt); - - INSTALL_BINOP (op_le, octave_char_matrix_str, octave_char_matrix_str, le); - INSTALL_BINOP (op_le, octave_char_matrix_str, octave_char_matrix_sq_str, le); - INSTALL_BINOP (op_le, octave_char_matrix_sq_str, octave_char_matrix_str, le); - INSTALL_BINOP (op_le, octave_char_matrix_sq_str, octave_char_matrix_sq_str, le); - - INSTALL_BINOP (op_eq, octave_char_matrix_str, octave_char_matrix_str, eq); - INSTALL_BINOP (op_eq, octave_char_matrix_str, octave_char_matrix_sq_str, eq); - INSTALL_BINOP (op_eq, octave_char_matrix_sq_str, octave_char_matrix_str, eq); - INSTALL_BINOP (op_eq, octave_char_matrix_sq_str, octave_char_matrix_sq_str, eq); - - INSTALL_BINOP (op_ge, octave_char_matrix_str, octave_char_matrix_str, ge); - INSTALL_BINOP (op_ge, octave_char_matrix_str, octave_char_matrix_sq_str, ge); - INSTALL_BINOP (op_ge, octave_char_matrix_sq_str, octave_char_matrix_str, ge); - INSTALL_BINOP (op_ge, octave_char_matrix_sq_str, octave_char_matrix_sq_str, ge); - - INSTALL_BINOP (op_gt, octave_char_matrix_str, octave_char_matrix_str, gt); - INSTALL_BINOP (op_gt, octave_char_matrix_str, octave_char_matrix_sq_str, gt); - INSTALL_BINOP (op_gt, octave_char_matrix_sq_str, octave_char_matrix_str, gt); - INSTALL_BINOP (op_gt, octave_char_matrix_sq_str, octave_char_matrix_sq_str, gt); - - INSTALL_BINOP (op_ne, octave_char_matrix_str, octave_char_matrix_str, ne); - INSTALL_BINOP (op_ne, octave_char_matrix_str, octave_char_matrix_sq_str, ne); - INSTALL_BINOP (op_ne, octave_char_matrix_sq_str, octave_char_matrix_str, ne); - INSTALL_BINOP (op_ne, octave_char_matrix_sq_str, octave_char_matrix_sq_str, ne); - - INSTALL_CATOP (octave_char_matrix_str, octave_char_matrix_str, str_str); - INSTALL_CATOP (octave_char_matrix_str, octave_char_matrix_sq_str, str_str); - INSTALL_CATOP (octave_char_matrix_sq_str, octave_char_matrix_str, str_str); - INSTALL_CATOP (octave_char_matrix_sq_str, octave_char_matrix_sq_str, str_str); - - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_char_matrix_str, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_char_matrix_sq_str, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_char_matrix_str, assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_char_matrix_sq_str, assign); - - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_null_matrix, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_null_str, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_null_sq_str, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_null_matrix, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_null_str, null_assign); - INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_null_sq_str, null_assign); - -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-struct.cc --- a/src/OPERATORS/op-struct.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,108 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-re-mat.h" -#include "ov-struct.h" -#include "ov-typeinfo.h" -#include "ops.h" - -// struct ops. - -DEFUNOP (transpose, struct) -{ - CAST_UNOP_ARG (const octave_struct&); - - if (v.ndims () > 2) - { - error ("transpose not defined for N-d objects"); - return octave_value (); - } - else - return octave_value (v.map_value ().transpose ()); -} - -DEFUNOP (scalar_transpose, scalar_struct) -{ - CAST_UNOP_ARG (const octave_scalar_struct&); - - return octave_value (v.scalar_map_value ()); -} - -DEFNDCATOP_FN (s_s_concat, struct, struct, map, map, concat) -DEFNDCATOP_FN (s_ss_concat, struct, scalar_struct, map, map, concat) -DEFNDCATOP_FN (ss_s_concat, scalar_struct, struct, map, map, concat) -DEFNDCATOP_FN (ss_ss_concat, scalar_struct, scalar_struct, map, map, concat) - -static octave_value -oct_catop_struct_matrix (octave_base_value& a1, const octave_base_value& a2, - const Array&) -{ - octave_value retval; - CAST_BINOP_ARGS (const octave_struct&, const octave_matrix&); - NDArray tmp = v2.array_value (); - dim_vector dv = tmp.dims (); - if (dv.all_zero ()) - retval = octave_value (v1.map_value ()); - else - error ("invalid concatenation of structure with matrix"); - return retval; -} - -static octave_value -oct_catop_matrix_struct (octave_base_value& a1, const octave_base_value& a2, - const Array&) -{ - octave_value retval; - CAST_BINOP_ARGS (const octave_matrix&, const octave_struct&); - NDArray tmp = v1.array_value (); - dim_vector dv = tmp.dims (); - if (dv.all_zero ()) - retval = octave_value (v2.map_value ()); - else - error ("invalid concatenation of structure with matrix"); - return retval; -} - -void -install_struct_ops (void) -{ - INSTALL_UNOP (op_transpose, octave_struct, transpose); - INSTALL_UNOP (op_hermitian, octave_struct, transpose); - - INSTALL_UNOP (op_transpose, octave_scalar_struct, scalar_transpose); - INSTALL_UNOP (op_hermitian, octave_scalar_struct, scalar_transpose); - - INSTALL_CATOP (octave_struct, octave_struct, s_s_concat); - INSTALL_CATOP (octave_struct, octave_scalar_struct, s_ss_concat) - INSTALL_CATOP (octave_scalar_struct, octave_struct, ss_s_concat) - INSTALL_CATOP (octave_scalar_struct, octave_scalar_struct, ss_ss_concat) - - INSTALL_CATOP (octave_struct, octave_matrix, struct_matrix); - INSTALL_CATOP (octave_matrix, octave_struct, matrix_struct); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-ui16-ui16.cc --- a/src/OPERATORS/op-ui16-ui16.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-ui16nda-i8.h" -#include "mx-ui16nda-ui8.h" -#include "mx-ui16nda-i16.h" -#include "mx-ui16nda-i32.h" -#include "mx-ui16nda-ui32.h" -#include "mx-ui16nda-i64.h" -#include "mx-ui16nda-ui64.h" - -#include "mx-ui16nda-i8nda.h" -#include "mx-ui16nda-ui8nda.h" -#include "mx-ui16nda-i16nda.h" -#include "mx-ui16nda-i32nda.h" -#include "mx-ui16nda-ui32nda.h" -#include "mx-ui16nda-i64nda.h" -#include "mx-ui16nda-ui64nda.h" - -#include "mx-ui16-i8nda.h" -#include "mx-ui16-ui8nda.h" -#include "mx-ui16-i16nda.h" -#include "mx-ui16-i32nda.h" -#include "mx-ui16-ui32nda.h" -#include "mx-ui16-i64nda.h" -#include "mx-ui16-ui64nda.h" - -#include "mx-ui16nda-s.h" -#include "mx-s-ui16nda.h" - -#include "mx-ui16nda-nda.h" -#include "mx-nda-ui16nda.h" - -#include "mx-ui16-nda.h" -#include "mx-nda-ui16.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-int8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-uint8.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -#include "op-int.h" - -OCTAVE_INT_OPS (uint16) - -OCTAVE_MS_INT_ASSIGN_OPS (mi8, uint16_, int8_, int8_) -OCTAVE_MS_INT_ASSIGN_OPS (mui8, uint16_, uint8_, uint8_) -OCTAVE_MS_INT_ASSIGN_OPS (mi16, uint16_, int16_, int16_) -OCTAVE_MS_INT_ASSIGN_OPS (mi32, uint16_, int32_, int32_) -OCTAVE_MS_INT_ASSIGN_OPS (mui32, uint16_, uint32_, uint32_) -OCTAVE_MS_INT_ASSIGN_OPS (mi64, uint16_, int64_, int64_) -OCTAVE_MS_INT_ASSIGN_OPS (mui64, uint16_, uint64_, uint64_) - -OCTAVE_MM_INT_ASSIGN_OPS (mmi8, uint16_, int8_, int8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui8, uint16_, uint8_, uint8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi16, uint16_, int16_, int16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi32, uint16_, int32_, int32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui32, uint16_, uint32_, uint32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi64, uint16_, int64_, int64_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui64, uint16_, uint64_, uint64_) - -OCTAVE_MIXED_INT_CMP_OPS (uint16, int8) -OCTAVE_MIXED_INT_CMP_OPS (uint16, uint8) -OCTAVE_MIXED_INT_CMP_OPS (uint16, int16) -OCTAVE_MIXED_INT_CMP_OPS (uint16, int32) -OCTAVE_MIXED_INT_CMP_OPS (uint16, uint32) -OCTAVE_MIXED_INT_CMP_OPS (uint16, int64) -OCTAVE_MIXED_INT_CMP_OPS (uint16, uint64) - -void -install_ui16_ui16_ops (void) -{ - OCTAVE_INSTALL_INT_OPS (uint16); - - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, uint16_, int8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, uint16_, uint8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, uint16_, int16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, uint16_, int32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, uint16_, uint32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, uint16_, int64_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, uint16_, uint64_); - - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, uint16_, int8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, uint16_, uint8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, uint16_, int16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, uint16_, int32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, uint16_, uint32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, uint16_, int64_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, uint16_, uint64_); - - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, int8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, uint8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, int16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, int32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, uint32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, int64); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, uint64); - - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, int8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, uint8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, int16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, int32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, uint32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, int64); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, uint64); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-ui32-ui32.cc --- a/src/OPERATORS/op-ui32-ui32.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,148 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-ui32nda-i8.h" -#include "mx-ui32nda-ui8.h" -#include "mx-ui32nda-i16.h" -#include "mx-ui32nda-ui16.h" -#include "mx-ui32nda-i32.h" -#include "mx-ui32nda-i64.h" -#include "mx-ui32nda-ui64.h" - -#include "mx-ui32nda-i8nda.h" -#include "mx-ui32nda-ui8nda.h" -#include "mx-ui32nda-i16nda.h" -#include "mx-ui32nda-ui16nda.h" -#include "mx-ui32nda-i32nda.h" -#include "mx-ui32nda-i64nda.h" -#include "mx-ui32nda-ui64nda.h" - -#include "mx-ui32-i8nda.h" -#include "mx-ui32-ui8nda.h" -#include "mx-ui32-i16nda.h" -#include "mx-ui32-ui16nda.h" -#include "mx-ui32-i32nda.h" -#include "mx-ui32-i64nda.h" -#include "mx-ui32-ui64nda.h" - -#include "mx-ui32nda-s.h" -#include "mx-s-ui32nda.h" - -#include "mx-ui32nda-nda.h" -#include "mx-nda-ui32nda.h" - -#include "mx-ui32-nda.h" -#include "mx-nda-ui32.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-int8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-uint8.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -#include "op-int.h" - -OCTAVE_INT_OPS (uint32) - -OCTAVE_MS_INT_ASSIGN_OPS (mi8, uint32_, int8_, int8_) -OCTAVE_MS_INT_ASSIGN_OPS (mui8, uint32_, uint8_, uint8_) -OCTAVE_MS_INT_ASSIGN_OPS (mi16, uint32_, int16_, int16_) -OCTAVE_MS_INT_ASSIGN_OPS (mui16, uint32_, uint16_, uint16_) -OCTAVE_MS_INT_ASSIGN_OPS (mi32, uint32_, int32_, int32_) -OCTAVE_MS_INT_ASSIGN_OPS (mi64, uint32_, int64_, int64_) -OCTAVE_MS_INT_ASSIGN_OPS (mui64, uint32_, uint64_, uint64_) - -OCTAVE_MM_INT_ASSIGN_OPS (mmi8, uint32_, int8_, int8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui8, uint32_, uint8_, uint8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi16, uint32_, int16_, int16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui16, uint32_, uint16_, uint16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi32, uint32_, int32_, int32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi64, uint32_, int64_, int64_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui64, uint32_, uint64_, uint64_) - -OCTAVE_MIXED_INT_CMP_OPS (uint32, int8) -OCTAVE_MIXED_INT_CMP_OPS (uint32, uint8) -OCTAVE_MIXED_INT_CMP_OPS (uint32, int16) -OCTAVE_MIXED_INT_CMP_OPS (uint32, uint16) -OCTAVE_MIXED_INT_CMP_OPS (uint32, int32) -OCTAVE_MIXED_INT_CMP_OPS (uint32, int64) -OCTAVE_MIXED_INT_CMP_OPS (uint32, uint64) -void -install_ui32_ui32_ops (void) -{ - OCTAVE_INSTALL_INT_OPS (uint32); - - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, uint32_, int8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, uint32_, uint8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, uint32_, int16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, uint32_, uint16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, uint32_, int32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, uint32_, int64_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, uint32_, uint64_); - - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, uint32_, int8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, uint32_, uint8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, uint32_, int16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, uint32_, uint16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, uint32_, int32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, uint32_, int64_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, uint32_, uint64_); - - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, int8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, uint8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, int16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, uint16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, int32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, int64); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, uint64); - - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, int8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, uint8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, int16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, uint16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, int32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, int64); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, uint64); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-ui64-ui64.cc --- a/src/OPERATORS/op-ui64-ui64.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-ui64nda-i8.h" -#include "mx-ui64nda-ui8.h" -#include "mx-ui64nda-i16.h" -#include "mx-ui64nda-ui16.h" -#include "mx-ui64nda-i32.h" -#include "mx-ui64nda-ui32.h" -#include "mx-ui64nda-i64.h" - -#include "mx-ui64nda-i8nda.h" -#include "mx-ui64nda-ui8nda.h" -#include "mx-ui64nda-i16nda.h" -#include "mx-ui64nda-ui16nda.h" -#include "mx-ui64nda-i32nda.h" -#include "mx-ui64nda-ui32nda.h" -#include "mx-ui64nda-i64nda.h" - -#include "mx-ui64-i8nda.h" -#include "mx-ui64-ui8nda.h" -#include "mx-ui64-i16nda.h" -#include "mx-ui64-ui16nda.h" -#include "mx-ui64-i32nda.h" -#include "mx-ui64-ui32nda.h" -#include "mx-ui64-i64nda.h" - -#include "mx-ui64nda-s.h" -#include "mx-s-ui64nda.h" - -#include "mx-ui64nda-nda.h" -#include "mx-nda-ui64nda.h" - -#include "mx-ui64-nda.h" -#include "mx-nda-ui64.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-int8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-uint8.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -#include "op-int.h" - -OCTAVE_INT_OPS (uint64) - -OCTAVE_MS_INT_ASSIGN_OPS (mi8, uint64_, int8_, int8_) -OCTAVE_MS_INT_ASSIGN_OPS (mui8, uint64_, uint8_, uint8_) -OCTAVE_MS_INT_ASSIGN_OPS (mi16, uint64_, int16_, int16_) -OCTAVE_MS_INT_ASSIGN_OPS (mui16, uint64_, uint16_, uint16_) -OCTAVE_MS_INT_ASSIGN_OPS (mi32, uint64_, int32_, int32_) -OCTAVE_MS_INT_ASSIGN_OPS (mui32, uint64_, uint32_, uint32_) -OCTAVE_MS_INT_ASSIGN_OPS (mi64, uint64_, int64_, int64_) - -OCTAVE_MM_INT_ASSIGN_OPS (mmi8, uint64_, int8_, int8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui8, uint64_, uint8_, uint8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi16, uint64_, int16_, int16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui16, uint64_, uint16_, uint16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi32, uint64_, int32_, int32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui32, uint64_, uint32_, uint32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi64, uint64_, int64_, int64_) - -OCTAVE_MIXED_INT_CMP_OPS (uint64, int8) -OCTAVE_MIXED_INT_CMP_OPS (uint64, uint8) -OCTAVE_MIXED_INT_CMP_OPS (uint64, int16) -OCTAVE_MIXED_INT_CMP_OPS (uint64, uint16) -OCTAVE_MIXED_INT_CMP_OPS (uint64, int32) -OCTAVE_MIXED_INT_CMP_OPS (uint64, uint32) -OCTAVE_MIXED_INT_CMP_OPS (uint64, int64) - -void -install_ui64_ui64_ops (void) -{ - OCTAVE_INSTALL_INT_OPS (uint64); - - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, uint64_, int8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, uint64_, uint8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, uint64_, int16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, uint64_, uint16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, uint64_, int32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, uint64_, uint32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, uint64_, int64_); - - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, uint64_, int8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, uint64_, uint8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, uint64_, int16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, uint64_, uint16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, uint64_, int32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, uint64_, uint32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, uint64_, int64_); - - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, int8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, uint8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, int16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, uint16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, int32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, uint32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, int64); - - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, int8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, uint8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, int16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, uint16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, int32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, uint32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, int64); -} diff -r d02b229ce693 -r a132d206a36a src/OPERATORS/op-ui8-ui8.cc --- a/src/OPERATORS/op-ui8-ui8.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "mx-ui8nda-i8.h" -#include "mx-ui8nda-i16.h" -#include "mx-ui8nda-ui16.h" -#include "mx-ui8nda-i32.h" -#include "mx-ui8nda-ui32.h" -#include "mx-ui8nda-i64.h" -#include "mx-ui8nda-ui64.h" - -#include "mx-ui8nda-i8nda.h" -#include "mx-ui8nda-i16nda.h" -#include "mx-ui8nda-ui16nda.h" -#include "mx-ui8nda-i32nda.h" -#include "mx-ui8nda-ui32nda.h" -#include "mx-ui8nda-i64nda.h" -#include "mx-ui8nda-ui64nda.h" - -#include "mx-ui8-i8nda.h" -#include "mx-ui8-i16nda.h" -#include "mx-ui8-ui16nda.h" -#include "mx-ui8-i32nda.h" -#include "mx-ui8-ui32nda.h" -#include "mx-ui8-i64nda.h" -#include "mx-ui8-ui64nda.h" - -#include "mx-ui8nda-s.h" -#include "mx-s-ui8nda.h" - -#include "mx-ui8nda-nda.h" -#include "mx-nda-ui8nda.h" - -#include "mx-ui8-nda.h" -#include "mx-nda-ui8.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-int8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-uint8.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ops.h" -#include "xdiv.h" -#include "xpow.h" - -#include "op-int.h" - -OCTAVE_INT_OPS (uint8) - -OCTAVE_MS_INT_ASSIGN_OPS (mi8, uint8_, int8_, int8_) -OCTAVE_MS_INT_ASSIGN_OPS (mi16, uint8_, int16_, int16_) -OCTAVE_MS_INT_ASSIGN_OPS (mui16, uint8_, uint16_, uint16_) -OCTAVE_MS_INT_ASSIGN_OPS (mi32, uint8_, int32_, int32_) -OCTAVE_MS_INT_ASSIGN_OPS (mui32, uint8_, uint32_, uint32_) -OCTAVE_MS_INT_ASSIGN_OPS (mi64, uint8_, int64_, int64_) -OCTAVE_MS_INT_ASSIGN_OPS (mui64, uint8_, uint64_, uint64_) - -OCTAVE_MM_INT_ASSIGN_OPS (mmi8, uint8_, int8_, int8_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi16, uint8_, int16_, int16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui16, uint8_, uint16_, uint16_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi32, uint8_, int32_, int32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui32, uint8_, uint32_, uint32_) -OCTAVE_MM_INT_ASSIGN_OPS (mmi64, uint8_, int64_, int64_) -OCTAVE_MM_INT_ASSIGN_OPS (mmui64, uint8_, uint64_, uint64_) - -OCTAVE_MIXED_INT_CMP_OPS (uint8, int8) -OCTAVE_MIXED_INT_CMP_OPS (uint8, int16) -OCTAVE_MIXED_INT_CMP_OPS (uint8, uint16) -OCTAVE_MIXED_INT_CMP_OPS (uint8, int32) -OCTAVE_MIXED_INT_CMP_OPS (uint8, uint32) -OCTAVE_MIXED_INT_CMP_OPS (uint8, int64) -OCTAVE_MIXED_INT_CMP_OPS (uint8, uint64) - -void -install_ui8_ui8_ops (void) -{ - OCTAVE_INSTALL_INT_OPS (uint8) - - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, uint8_, int8_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, uint8_, int16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, uint8_, uint16_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, uint8_, int32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, uint8_, uint32_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, uint8_, int64_); - OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, uint8_, uint64_); - - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, uint8_, int8_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, uint8_, int16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, uint8_, uint16_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, uint8_, int32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, uint8_, uint32_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, uint8_, int64_); - OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, uint8_, uint64_); - - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, int8); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, int16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, uint16); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, int32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, uint32); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, int64); - OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, uint64); - - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, int8); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, int16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, uint16); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, int32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, uint32); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, int64); - OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, uint64); -} diff -r d02b229ce693 -r a132d206a36a src/TEMPLATE-INST/Array-jit.cc --- a/src/TEMPLATE-INST/Array-jit.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -/* - -Copyright (C) 2012 Max Brister - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#ifdef HAVE_LLVM - -#include "Array.h" -#include "Array.cc" - -extern template class OCTAVE_API Array; - -#include "pt-jit.h" - -NO_INSTANTIATE_ARRAY_SORT (jit_function); - -INSTANTIATE_ARRAY (jit_function, OCTINTERP_API); - -#endif diff -r d02b229ce693 -r a132d206a36a src/TEMPLATE-INST/Array-os.cc --- a/src/TEMPLATE-INST/Array-os.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,47 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Instantiate Arrays of octave_stream objects. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "Array.h" -#include "Array.cc" - -extern template class OCTAVE_API Array; -extern template class OCTAVE_API Array; - -#include "oct-stream.h" - -typedef scanf_format_elt* scanf_format_elt_ptr; -typedef printf_format_elt* printf_format_elt_ptr; - -NO_INSTANTIATE_ARRAY_SORT (scanf_format_elt_ptr); -INSTANTIATE_ARRAY (scanf_format_elt_ptr, OCTINTERP_API); - -NO_INSTANTIATE_ARRAY_SORT (printf_format_elt_ptr); -INSTANTIATE_ARRAY (printf_format_elt_ptr, OCTINTERP_API); - -NO_INSTANTIATE_ARRAY_SORT (octave_stream); -INSTANTIATE_ARRAY (octave_stream, OCTINTERP_API); diff -r d02b229ce693 -r a132d206a36a src/TEMPLATE-INST/Array-sym.cc --- a/src/TEMPLATE-INST/Array-sym.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Instantiate Arrays of octave_child objects. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "Array.h" -#include "Array.cc" - -#include "oct-obj.h" -#include "symtab.h" - -typedef symbol_record* symbol_record_ptr; - -NO_INSTANTIATE_ARRAY_SORT (symbol_record_ptr); - -INSTANTIATE_ARRAY (symbol_record_ptr, OCTINTERP_API); diff -r d02b229ce693 -r a132d206a36a src/TEMPLATE-INST/Array-tc.cc --- a/src/TEMPLATE-INST/Array-tc.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Instantiate Arrays of octave_values. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "Array.h" -#include "Array.cc" - -#include "ov.h" - -#include "oct-sort.cc" - -NO_INSTANTIATE_ARRAY_SORT (octave_value); - -INSTANTIATE_ARRAY (octave_value, OCTINTERP_API); diff -r d02b229ce693 -r a132d206a36a src/TEMPLATE-INST/module.mk --- a/src/TEMPLATE-INST/module.mk Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -EXTRA_DIST += TEMPLATE-INST/module.mk - -TEMPLATE_INST_SRC = \ - TEMPLATE-INST/Array-os.cc \ - TEMPLATE-INST/Array-tc.cc \ - TEMPLATE-INST/Array-jit.cc diff -r d02b229ce693 -r a132d206a36a src/bitfcns.cc --- a/src/bitfcns.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,756 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "str-vec.h" -#include "quit.h" - -#include "defun.h" -#include "error.h" -#include "ov.h" -#include "ov-uint64.h" -#include "ov-uint32.h" -#include "ov-uint16.h" -#include "ov-uint8.h" -#include "ov-int64.h" -#include "ov-int32.h" -#include "ov-int16.h" -#include "ov-int8.h" -#include "ov-scalar.h" -#include "ov-re-mat.h" -#include "ov-bool.h" - -#include - -#if !defined (HAVE_CXX_BITWISE_OP_TEMPLATES) -namespace std -{ - template - struct bit_and - { - public: - T operator() (const T & op1, const T & op2) const { return (op1 & op2); } - }; - - template - struct bit_or - { - public: - T operator() (const T & op1, const T & op2) const { return (op1 | op2); } - }; - - template - struct bit_xor - { - public: - T operator() (const T & op1, const T & op2) const { return (op1 ^ op2); } - }; -} -#endif - -template -octave_value -bitopxx (const OP& op, const std::string& fname, - const Array& x, const Array& y) -{ - int nelx = x.numel (); - int nely = y.numel (); - - bool is_scalar_op = (nelx == 1 || nely == 1); - - dim_vector dvx = x.dims (); - dim_vector dvy = y.dims (); - - bool is_array_op = (dvx == dvy); - - octave_value retval; - if (is_array_op || is_scalar_op) - { - Array result; - - if (nelx != 1) - result.resize (dvx); - else - result.resize (dvy); - - for (int i = 0; i < nelx; i++) - if (is_scalar_op) - for (int k = 0; k < nely; k++) - result(i+k) = op (x(i), y(k)); - else - result(i) = op (x(i), y(i)); - - retval = result; - } - else - error ("%s: size of X and Y must match, or one operand must be a scalar", - fname.c_str ()); - - return retval; -} - -// Trampoline function, instantiates the proper template above, with -// reflective information hardwired. We can't hardwire this information -// in Fbitxxx DEFUNs below, because at that moment, we still don't have -// information about which integer types we need to instantiate. -template -octave_value -bitopx (const std::string& fname, const Array& x, const Array& y) -{ - if (fname == "bitand") - return bitopxx (std::bit_and(), fname, x, y); - if (fname == "bitor") - return bitopxx (std::bit_or(), fname, x, y); - - //else (fname == "bitxor") - return bitopxx (std::bit_xor(), fname, x, y); -} - -octave_value -bitop (const std::string& fname, const octave_value_list& args) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if ((args(0).class_name () == octave_scalar::static_class_name ()) - || (args(0).class_name () == octave_bool::static_class_name ()) - || (args(1).class_name () == octave_scalar::static_class_name ()) - || (args(1).class_name () == octave_bool::static_class_name ())) - { - bool arg0_is_int = (args(0).class_name () != - octave_scalar::static_class_name () && - args(0).class_name () != - octave_bool::static_class_name ()); - bool arg1_is_int = (args(1).class_name () != - octave_scalar::static_class_name () && - args(1).class_name () != - octave_bool::static_class_name ()); - - if (! (arg0_is_int || arg1_is_int)) - { - uint64NDArray x (args(0).array_value ()); - uint64NDArray y (args(1).array_value ()); - if (! error_state) - retval = bitopx (fname, x, y).array_value (); - } - else - { - int p = (arg0_is_int ? 1 : 0); - int q = (arg0_is_int ? 0 : 1); - - NDArray dx = args(p).array_value (); - - if (args(q).type_id () == octave_uint64_matrix::static_type_id () - || args(q).type_id () == octave_uint64_scalar::static_type_id ()) - { - uint64NDArray x (dx); - uint64NDArray y = args(q).uint64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_uint32_matrix::static_type_id () - || args(q).type_id () == octave_uint32_scalar::static_type_id ()) - { - uint32NDArray x (dx); - uint32NDArray y = args(q).uint32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_uint16_matrix::static_type_id () - || args(q).type_id () == octave_uint16_scalar::static_type_id ()) - { - uint16NDArray x (dx); - uint16NDArray y = args(q).uint16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_uint8_matrix::static_type_id () - || args(q).type_id () == octave_uint8_scalar::static_type_id ()) - { - uint8NDArray x (dx); - uint8NDArray y = args(q).uint8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int64_matrix::static_type_id () - || args(q).type_id () == octave_int64_scalar::static_type_id ()) - { - int64NDArray x (dx); - int64NDArray y = args(q).int64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int32_matrix::static_type_id () - || args(q).type_id () == octave_int32_scalar::static_type_id ()) - { - int32NDArray x (dx); - int32NDArray y = args(q).int32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int16_matrix::static_type_id () - || args(q).type_id () == octave_int16_scalar::static_type_id ()) - { - int16NDArray x (dx); - int16NDArray y = args(q).int16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int8_matrix::static_type_id () - || args(q).type_id () == octave_int8_scalar::static_type_id ()) - { - int8NDArray x (dx); - int8NDArray y = args(q).int8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else - error ("%s: invalid operand type", fname.c_str ()); - } - } - else if (args(0).class_name () == args(1).class_name ()) - { - if (args(0).type_id () == octave_uint64_matrix::static_type_id () - || args(0).type_id () == octave_uint64_scalar::static_type_id ()) - { - uint64NDArray x = args(0).uint64_array_value (); - uint64NDArray y = args(1).uint64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_uint32_matrix::static_type_id () - || args(0).type_id () == octave_uint32_scalar::static_type_id ()) - { - uint32NDArray x = args(0).uint32_array_value (); - uint32NDArray y = args(1).uint32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_uint16_matrix::static_type_id () - || args(0).type_id () == octave_uint16_scalar::static_type_id ()) - { - uint16NDArray x = args(0).uint16_array_value (); - uint16NDArray y = args(1).uint16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_uint8_matrix::static_type_id () - || args(0).type_id () == octave_uint8_scalar::static_type_id ()) - { - uint8NDArray x = args(0).uint8_array_value (); - uint8NDArray y = args(1).uint8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int64_matrix::static_type_id () - || args(0).type_id () == octave_int64_scalar::static_type_id ()) - { - int64NDArray x = args(0).int64_array_value (); - int64NDArray y = args(1).int64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int32_matrix::static_type_id () - || args(0).type_id () == octave_int32_scalar::static_type_id ()) - { - int32NDArray x = args(0).int32_array_value (); - int32NDArray y = args(1).int32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int16_matrix::static_type_id () - || args(0).type_id () == octave_int16_scalar::static_type_id ()) - { - int16NDArray x = args(0).int16_array_value (); - int16NDArray y = args(1).int16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int8_matrix::static_type_id () - || args(0).type_id () == octave_int8_scalar::static_type_id ()) - { - int8NDArray x = args(0).int8_array_value (); - int8NDArray y = args(1).int8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else - error ("%s: invalid operand type", fname.c_str ()); - } - else - error ("%s: must have matching operand types", fname.c_str ()); - } - else - print_usage (); - - return retval; -} - -DEFUN (bitand, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitand (@var{x}, @var{y})\n\ -Return the bitwise AND of non-negative integers.\n\ -@var{x}, @var{y} must be in the range [0,bitmax]\n\ -@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ -@end deftypefn") -{ - return bitop ("bitand", args); -} - -DEFUN (bitor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitor (@var{x}, @var{y})\n\ -Return the bitwise OR of non-negative integers.\n\ -@var{x}, @var{y} must be in the range [0,bitmax]\n\ -@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ -@end deftypefn") -{ - return bitop ("bitor", args); -} - -DEFUN (bitxor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitxor (@var{x}, @var{y})\n\ -Return the bitwise XOR of non-negative integers.\n\ -@var{x}, @var{y} must be in the range [0,bitmax]\n\ -@seealso{bitand, bitor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ -@end deftypefn") -{ - return bitop ("bitxor", args); -} - -static int64_t -bitshift (double a, int n, int64_t mask) -{ - // In the name of bug-for-bug compatibility. - if (a < 0) - return -bitshift (-a, n, mask); - - if (n > 0) - return (static_cast (a) << n) & mask; - else if (n < 0) - return (static_cast (a) >> -n) & mask; - else - return static_cast (a) & mask; -} - -static int64_t -bitshift (float a, int n, int64_t mask) -{ - // In the name of bug-for-bug compatibility. - if (a < 0) - return -bitshift (-a, n, mask); - - if (n > 0) - return (static_cast (a) << n) & mask; - else if (n < 0) - return (static_cast (a) >> -n) & mask; - else - return static_cast (a) & mask; -} - -// Note that the bitshift operators are undefined if shifted by more -// bits than in the type, so we need to test for the size of the -// shift. - -#define DO_BITSHIFT(T) \ - if (! error_state) \ - { \ - double d1, d2; \ - \ - if (n.all_integers (d1, d2)) \ - { \ - int m_nel = m.numel (); \ - int n_nel = n.numel (); \ - \ - bool is_scalar_op = (m_nel == 1 || n_nel == 1); \ - \ - dim_vector m_dv = m.dims (); \ - dim_vector n_dv = n.dims (); \ - \ - bool is_array_op = (m_dv == n_dv); \ - \ - if (is_array_op || is_scalar_op) \ - { \ - T ## NDArray result; \ - \ - if (m_nel != 1) \ - result.resize (m_dv); \ - else \ - result.resize (n_dv); \ - \ - for (int i = 0; i < m_nel; i++) \ - if (is_scalar_op) \ - for (int k = 0; k < n_nel; k++) \ - if (static_cast (n(k)) >= bits_in_type) \ - result(i+k) = 0; \ - else \ - result(i+k) = bitshift (m(i), static_cast (n(k)), mask); \ - else \ - if (static_cast (n(i)) >= bits_in_type) \ - result(i) = 0; \ - else \ - result(i) = bitshift (m(i), static_cast (n(i)), mask); \ - \ - retval = result; \ - } \ - else \ - error ("bitshift: size of A and N must match, or one operand must be a scalar"); \ - } \ - else \ - error ("bitshift: expecting integer as second argument"); \ - } - -#define DO_UBITSHIFT(T, N) \ - do \ - { \ - int bits_in_type = octave_ ## T :: nbits (); \ - T ## NDArray m = m_arg.T ## _array_value (); \ - octave_ ## T mask = octave_ ## T::max (); \ - if ((N) < bits_in_type) \ - mask = bitshift (mask, (N) - bits_in_type); \ - else if ((N) < 1) \ - mask = 0; \ - DO_BITSHIFT (T); \ - } \ - while (0) - -#define DO_SBITSHIFT(T, N) \ - do \ - { \ - int bits_in_type = octave_ ## T :: nbits (); \ - T ## NDArray m = m_arg.T ## _array_value (); \ - octave_ ## T mask = octave_ ## T::max (); \ - if ((N) < bits_in_type) \ - mask = bitshift (mask, (N) - bits_in_type); \ - else if ((N) < 1) \ - mask = 0; \ - mask = mask | octave_ ## T :: min (); /* FIXME: 2's complement only? */ \ - DO_BITSHIFT (T); \ - } \ - while (0) - -DEFUN (bitshift, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitshift (@var{a}, @var{k})\n\ -@deftypefnx {Built-in Function} {} bitshift (@var{a}, @var{k}, @var{n})\n\ -Return a @var{k} bit shift of @var{n}-digit unsigned\n\ -integers in @var{a}. A positive @var{k} leads to a left shift;\n\ -A negative value to a right shift. If @var{n} is omitted it defaults\n\ -to log2(bitmax)+1.\n\ -@var{n} must be in the range [1,log2(bitmax)+1] usually [1,33].\n\ -\n\ -@example\n\ -@group\n\ -bitshift (eye (3), 1)\n\ -@result{}\n\ -@group\n\ -2 0 0\n\ -0 2 0\n\ -0 0 2\n\ -@end group\n\ -\n\ -bitshift (10, [-2, -1, 0, 1, 2])\n\ -@result{} 2 5 10 20 40\n\ -@c FIXME -- restore this example when third arg is allowed to be an array.\n\ -@c\n\ -@c\n\ -@c bitshift ([1, 10], 2, [3,4])\n\ -@c @result{} 4 8\n\ -@end group\n\ -@end example\n\ -@seealso{bitand, bitor, bitxor, bitset, bitget, bitcmp, bitmax}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - int nbits = 64; - - NDArray n = args(1).array_value (); - - if (error_state) - error ("bitshift: expecting integer as second argument"); - else - { - if (nargin == 3) - { - // FIXME -- for compatibility, we should accept an array - // or a scalar as the third argument. - if (args(2).numel () > 1) - error ("bitshift: N must be a scalar integer"); - else - { - nbits = args(2).int_value (); - - if (error_state) - error ("bitshift: N must be an integer"); - else if (nbits < 0) - error ("bitshift: N must be positive"); - } - } - } - - if (error_state) - return retval; - - octave_value m_arg = args(0); - std::string cname = m_arg.class_name (); - - if (cname == "uint8") - DO_UBITSHIFT (uint8, nbits < 8 ? nbits : 8); - else if (cname == "uint16") - DO_UBITSHIFT (uint16, nbits < 16 ? nbits : 16); - else if (cname == "uint32") - DO_UBITSHIFT (uint32, nbits < 32 ? nbits : 32); - else if (cname == "uint64") - DO_UBITSHIFT (uint64, nbits < 64 ? nbits : 64); - else if (cname == "int8") - DO_SBITSHIFT (int8, nbits < 8 ? nbits : 8); - else if (cname == "int16") - DO_SBITSHIFT (int16, nbits < 16 ? nbits : 16); - else if (cname == "int32") - DO_SBITSHIFT (int32, nbits < 32 ? nbits : 32); - else if (cname == "int64") - DO_SBITSHIFT (int64, nbits < 64 ? nbits : 64); - else if (cname == "double") - { - nbits = (nbits < 53 ? nbits : 53); - int64_t mask = 0x1FFFFFFFFFFFFFLL; - if (nbits < 53) - mask = mask >> (53 - nbits); - else if (nbits < 1) - mask = 0; - int bits_in_type = 64; - NDArray m = m_arg.array_value (); - DO_BITSHIFT ( ); - } - else - error ("bitshift: not defined for %s objects", cname.c_str ()); - } - else - print_usage (); - - return retval; -} - -DEFUN (bitmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitmax ()\n\ -@deftypefnx {Built-in Function} {} bitmax (\"double\")\n\ -@deftypefnx {Built-in Function} {} bitmax (\"single\")\n\ -Return the largest integer that can be represented within a floating point\n\ -value. The default class is \"double\", but \"single\" is a valid option.\n\ -On IEEE-754 compatible systems, @code{bitmax} is @w{@math{2^{53} - 1}}.\n\ -@end deftypefn") -{ - octave_value retval; - std::string cname = "double"; - int nargin = args.length (); - - if (nargin == 1 && args(0).is_string ()) - cname = args(0).string_value (); - else if (nargin != 0) - { - print_usage (); - return retval; - } - - if (cname == "double") - retval = (static_cast (0x1FFFFFFFFFFFFFLL)); - else if (cname == "single") - retval = (static_cast (0xFFFFFFL)); - else - error ("bitmax: not defined for class '%s'", cname.c_str ()); - - return retval; -} - -DEFUN (intmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} intmax (@var{type})\n\ -Return the largest integer that can be represented in an integer type.\n\ -The variable @var{type} can be\n\ -\n\ -@table @code\n\ -@item int8\n\ -signed 8-bit integer.\n\ -\n\ -@item int16\n\ -signed 16-bit integer.\n\ -\n\ -@item int32\n\ -signed 32-bit integer.\n\ -\n\ -@item int64\n\ -signed 64-bit integer.\n\ -\n\ -@item uint8\n\ -unsigned 8-bit integer.\n\ -\n\ -@item uint16\n\ -unsigned 16-bit integer.\n\ -\n\ -@item uint32\n\ -unsigned 32-bit integer.\n\ -\n\ -@item uint64\n\ -unsigned 64-bit integer.\n\ -@end table\n\ -\n\ -The default for @var{type} is @code{uint32}.\n\ -@seealso{intmin, bitmax}\n\ -@end deftypefn") -{ - octave_value retval; - std::string cname = "int32"; - int nargin = args.length (); - - if (nargin == 1 && args(0).is_string ()) - cname = args(0).string_value (); - else if (nargin != 0) - { - print_usage (); - return retval; - } - - if (cname == "uint8") - retval = octave_uint8 (std::numeric_limits::max ()); - else if (cname == "uint16") - retval = octave_uint16 (std::numeric_limits::max ()); - else if (cname == "uint32") - retval = octave_uint32 (std::numeric_limits::max ()); - else if (cname == "uint64") - retval = octave_uint64 (std::numeric_limits::max ()); - else if (cname == "int8") - retval = octave_int8 (std::numeric_limits::max ()); - else if (cname == "int16") - retval = octave_int16 (std::numeric_limits::max ()); - else if (cname == "int32") - retval = octave_int32 (std::numeric_limits::max ()); - else if (cname == "int64") - retval = octave_int64 (std::numeric_limits::max ()); - else - error ("intmax: not defined for '%s' objects", cname.c_str ()); - - return retval; -} - -DEFUN (intmin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} intmin (@var{type})\n\ -Return the smallest integer that can be represented in an integer type.\n\ -The variable @var{type} can be\n\ -\n\ -@table @code\n\ -@item int8\n\ -signed 8-bit integer.\n\ -\n\ -@item int16\n\ -signed 16-bit integer.\n\ -\n\ -@item int32\n\ -signed 32-bit integer.\n\ -\n\ -@item int64\n\ -signed 64-bit integer.\n\ -\n\ -@item uint8\n\ -unsigned 8-bit integer.\n\ -\n\ -@item uint16\n\ -unsigned 16-bit integer.\n\ -\n\ -@item uint32\n\ -unsigned 32-bit integer.\n\ -\n\ -@item uint64\n\ -unsigned 64-bit integer.\n\ -@end table\n\ -\n\ -The default for @var{type} is @code{uint32}.\n\ -@seealso{intmax, bitmax}\n\ -@end deftypefn") -{ - octave_value retval; - std::string cname = "int32"; - int nargin = args.length (); - - if (nargin == 1 && args(0).is_string ()) - cname = args(0).string_value (); - else if (nargin != 0) - { - print_usage (); - return retval; - } - - if (cname == "uint8") - retval = octave_uint8 (std::numeric_limits::min ()); - else if (cname == "uint16") - retval = octave_uint16 (std::numeric_limits::min ()); - else if (cname == "uint32") - retval = octave_uint32 (std::numeric_limits::min ()); - else if (cname == "uint64") - retval = octave_uint64 (std::numeric_limits::min ()); - else if (cname == "int8") - retval = octave_int8 (std::numeric_limits::min ()); - else if (cname == "int16") - retval = octave_int16 (std::numeric_limits::min ()); - else if (cname == "int32") - retval = octave_int32 (std::numeric_limits::min ()); - else if (cname == "int64") - retval = octave_int64 (std::numeric_limits::min ()); - else - error ("intmin: not defined for '%s' objects", cname.c_str ()); - - return retval; -} - -DEFUN (sizemax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sizemax ()\n\ -Return the largest value allowed for the size of an array.\n\ -If Octave is compiled with 64-bit indexing, the result is of class int64,\n\ -otherwise it is of class int32. The maximum array size is slightly\n\ -smaller than the maximum value allowable for the relevant class as reported\n\ -by @code{intmax}.\n\ -@seealso{intmax}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = octave_int (dim_vector::dim_max ()); - else - print_usage (); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/corefcn/bitfcns.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/bitfcns.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,756 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "str-vec.h" +#include "quit.h" + +#include "defun.h" +#include "error.h" +#include "ov.h" +#include "ov-uint64.h" +#include "ov-uint32.h" +#include "ov-uint16.h" +#include "ov-uint8.h" +#include "ov-int64.h" +#include "ov-int32.h" +#include "ov-int16.h" +#include "ov-int8.h" +#include "ov-scalar.h" +#include "ov-re-mat.h" +#include "ov-bool.h" + +#include + +#if !defined (HAVE_CXX_BITWISE_OP_TEMPLATES) +namespace std +{ + template + struct bit_and + { + public: + T operator() (const T & op1, const T & op2) const { return (op1 & op2); } + }; + + template + struct bit_or + { + public: + T operator() (const T & op1, const T & op2) const { return (op1 | op2); } + }; + + template + struct bit_xor + { + public: + T operator() (const T & op1, const T & op2) const { return (op1 ^ op2); } + }; +} +#endif + +template +octave_value +bitopxx (const OP& op, const std::string& fname, + const Array& x, const Array& y) +{ + int nelx = x.numel (); + int nely = y.numel (); + + bool is_scalar_op = (nelx == 1 || nely == 1); + + dim_vector dvx = x.dims (); + dim_vector dvy = y.dims (); + + bool is_array_op = (dvx == dvy); + + octave_value retval; + if (is_array_op || is_scalar_op) + { + Array result; + + if (nelx != 1) + result.resize (dvx); + else + result.resize (dvy); + + for (int i = 0; i < nelx; i++) + if (is_scalar_op) + for (int k = 0; k < nely; k++) + result(i+k) = op (x(i), y(k)); + else + result(i) = op (x(i), y(i)); + + retval = result; + } + else + error ("%s: size of X and Y must match, or one operand must be a scalar", + fname.c_str ()); + + return retval; +} + +// Trampoline function, instantiates the proper template above, with +// reflective information hardwired. We can't hardwire this information +// in Fbitxxx DEFUNs below, because at that moment, we still don't have +// information about which integer types we need to instantiate. +template +octave_value +bitopx (const std::string& fname, const Array& x, const Array& y) +{ + if (fname == "bitand") + return bitopxx (std::bit_and(), fname, x, y); + if (fname == "bitor") + return bitopxx (std::bit_or(), fname, x, y); + + //else (fname == "bitxor") + return bitopxx (std::bit_xor(), fname, x, y); +} + +octave_value +bitop (const std::string& fname, const octave_value_list& args) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if ((args(0).class_name () == octave_scalar::static_class_name ()) + || (args(0).class_name () == octave_bool::static_class_name ()) + || (args(1).class_name () == octave_scalar::static_class_name ()) + || (args(1).class_name () == octave_bool::static_class_name ())) + { + bool arg0_is_int = (args(0).class_name () != + octave_scalar::static_class_name () && + args(0).class_name () != + octave_bool::static_class_name ()); + bool arg1_is_int = (args(1).class_name () != + octave_scalar::static_class_name () && + args(1).class_name () != + octave_bool::static_class_name ()); + + if (! (arg0_is_int || arg1_is_int)) + { + uint64NDArray x (args(0).array_value ()); + uint64NDArray y (args(1).array_value ()); + if (! error_state) + retval = bitopx (fname, x, y).array_value (); + } + else + { + int p = (arg0_is_int ? 1 : 0); + int q = (arg0_is_int ? 0 : 1); + + NDArray dx = args(p).array_value (); + + if (args(q).type_id () == octave_uint64_matrix::static_type_id () + || args(q).type_id () == octave_uint64_scalar::static_type_id ()) + { + uint64NDArray x (dx); + uint64NDArray y = args(q).uint64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_uint32_matrix::static_type_id () + || args(q).type_id () == octave_uint32_scalar::static_type_id ()) + { + uint32NDArray x (dx); + uint32NDArray y = args(q).uint32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_uint16_matrix::static_type_id () + || args(q).type_id () == octave_uint16_scalar::static_type_id ()) + { + uint16NDArray x (dx); + uint16NDArray y = args(q).uint16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_uint8_matrix::static_type_id () + || args(q).type_id () == octave_uint8_scalar::static_type_id ()) + { + uint8NDArray x (dx); + uint8NDArray y = args(q).uint8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int64_matrix::static_type_id () + || args(q).type_id () == octave_int64_scalar::static_type_id ()) + { + int64NDArray x (dx); + int64NDArray y = args(q).int64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int32_matrix::static_type_id () + || args(q).type_id () == octave_int32_scalar::static_type_id ()) + { + int32NDArray x (dx); + int32NDArray y = args(q).int32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int16_matrix::static_type_id () + || args(q).type_id () == octave_int16_scalar::static_type_id ()) + { + int16NDArray x (dx); + int16NDArray y = args(q).int16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int8_matrix::static_type_id () + || args(q).type_id () == octave_int8_scalar::static_type_id ()) + { + int8NDArray x (dx); + int8NDArray y = args(q).int8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else + error ("%s: invalid operand type", fname.c_str ()); + } + } + else if (args(0).class_name () == args(1).class_name ()) + { + if (args(0).type_id () == octave_uint64_matrix::static_type_id () + || args(0).type_id () == octave_uint64_scalar::static_type_id ()) + { + uint64NDArray x = args(0).uint64_array_value (); + uint64NDArray y = args(1).uint64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_uint32_matrix::static_type_id () + || args(0).type_id () == octave_uint32_scalar::static_type_id ()) + { + uint32NDArray x = args(0).uint32_array_value (); + uint32NDArray y = args(1).uint32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_uint16_matrix::static_type_id () + || args(0).type_id () == octave_uint16_scalar::static_type_id ()) + { + uint16NDArray x = args(0).uint16_array_value (); + uint16NDArray y = args(1).uint16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_uint8_matrix::static_type_id () + || args(0).type_id () == octave_uint8_scalar::static_type_id ()) + { + uint8NDArray x = args(0).uint8_array_value (); + uint8NDArray y = args(1).uint8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int64_matrix::static_type_id () + || args(0).type_id () == octave_int64_scalar::static_type_id ()) + { + int64NDArray x = args(0).int64_array_value (); + int64NDArray y = args(1).int64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int32_matrix::static_type_id () + || args(0).type_id () == octave_int32_scalar::static_type_id ()) + { + int32NDArray x = args(0).int32_array_value (); + int32NDArray y = args(1).int32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int16_matrix::static_type_id () + || args(0).type_id () == octave_int16_scalar::static_type_id ()) + { + int16NDArray x = args(0).int16_array_value (); + int16NDArray y = args(1).int16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int8_matrix::static_type_id () + || args(0).type_id () == octave_int8_scalar::static_type_id ()) + { + int8NDArray x = args(0).int8_array_value (); + int8NDArray y = args(1).int8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else + error ("%s: invalid operand type", fname.c_str ()); + } + else + error ("%s: must have matching operand types", fname.c_str ()); + } + else + print_usage (); + + return retval; +} + +DEFUN (bitand, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitand (@var{x}, @var{y})\n\ +Return the bitwise AND of non-negative integers.\n\ +@var{x}, @var{y} must be in the range [0,bitmax]\n\ +@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ +@end deftypefn") +{ + return bitop ("bitand", args); +} + +DEFUN (bitor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitor (@var{x}, @var{y})\n\ +Return the bitwise OR of non-negative integers.\n\ +@var{x}, @var{y} must be in the range [0,bitmax]\n\ +@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ +@end deftypefn") +{ + return bitop ("bitor", args); +} + +DEFUN (bitxor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitxor (@var{x}, @var{y})\n\ +Return the bitwise XOR of non-negative integers.\n\ +@var{x}, @var{y} must be in the range [0,bitmax]\n\ +@seealso{bitand, bitor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ +@end deftypefn") +{ + return bitop ("bitxor", args); +} + +static int64_t +bitshift (double a, int n, int64_t mask) +{ + // In the name of bug-for-bug compatibility. + if (a < 0) + return -bitshift (-a, n, mask); + + if (n > 0) + return (static_cast (a) << n) & mask; + else if (n < 0) + return (static_cast (a) >> -n) & mask; + else + return static_cast (a) & mask; +} + +static int64_t +bitshift (float a, int n, int64_t mask) +{ + // In the name of bug-for-bug compatibility. + if (a < 0) + return -bitshift (-a, n, mask); + + if (n > 0) + return (static_cast (a) << n) & mask; + else if (n < 0) + return (static_cast (a) >> -n) & mask; + else + return static_cast (a) & mask; +} + +// Note that the bitshift operators are undefined if shifted by more +// bits than in the type, so we need to test for the size of the +// shift. + +#define DO_BITSHIFT(T) \ + if (! error_state) \ + { \ + double d1, d2; \ + \ + if (n.all_integers (d1, d2)) \ + { \ + int m_nel = m.numel (); \ + int n_nel = n.numel (); \ + \ + bool is_scalar_op = (m_nel == 1 || n_nel == 1); \ + \ + dim_vector m_dv = m.dims (); \ + dim_vector n_dv = n.dims (); \ + \ + bool is_array_op = (m_dv == n_dv); \ + \ + if (is_array_op || is_scalar_op) \ + { \ + T ## NDArray result; \ + \ + if (m_nel != 1) \ + result.resize (m_dv); \ + else \ + result.resize (n_dv); \ + \ + for (int i = 0; i < m_nel; i++) \ + if (is_scalar_op) \ + for (int k = 0; k < n_nel; k++) \ + if (static_cast (n(k)) >= bits_in_type) \ + result(i+k) = 0; \ + else \ + result(i+k) = bitshift (m(i), static_cast (n(k)), mask); \ + else \ + if (static_cast (n(i)) >= bits_in_type) \ + result(i) = 0; \ + else \ + result(i) = bitshift (m(i), static_cast (n(i)), mask); \ + \ + retval = result; \ + } \ + else \ + error ("bitshift: size of A and N must match, or one operand must be a scalar"); \ + } \ + else \ + error ("bitshift: expecting integer as second argument"); \ + } + +#define DO_UBITSHIFT(T, N) \ + do \ + { \ + int bits_in_type = octave_ ## T :: nbits (); \ + T ## NDArray m = m_arg.T ## _array_value (); \ + octave_ ## T mask = octave_ ## T::max (); \ + if ((N) < bits_in_type) \ + mask = bitshift (mask, (N) - bits_in_type); \ + else if ((N) < 1) \ + mask = 0; \ + DO_BITSHIFT (T); \ + } \ + while (0) + +#define DO_SBITSHIFT(T, N) \ + do \ + { \ + int bits_in_type = octave_ ## T :: nbits (); \ + T ## NDArray m = m_arg.T ## _array_value (); \ + octave_ ## T mask = octave_ ## T::max (); \ + if ((N) < bits_in_type) \ + mask = bitshift (mask, (N) - bits_in_type); \ + else if ((N) < 1) \ + mask = 0; \ + mask = mask | octave_ ## T :: min (); /* FIXME: 2's complement only? */ \ + DO_BITSHIFT (T); \ + } \ + while (0) + +DEFUN (bitshift, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitshift (@var{a}, @var{k})\n\ +@deftypefnx {Built-in Function} {} bitshift (@var{a}, @var{k}, @var{n})\n\ +Return a @var{k} bit shift of @var{n}-digit unsigned\n\ +integers in @var{a}. A positive @var{k} leads to a left shift;\n\ +A negative value to a right shift. If @var{n} is omitted it defaults\n\ +to log2(bitmax)+1.\n\ +@var{n} must be in the range [1,log2(bitmax)+1] usually [1,33].\n\ +\n\ +@example\n\ +@group\n\ +bitshift (eye (3), 1)\n\ +@result{}\n\ +@group\n\ +2 0 0\n\ +0 2 0\n\ +0 0 2\n\ +@end group\n\ +\n\ +bitshift (10, [-2, -1, 0, 1, 2])\n\ +@result{} 2 5 10 20 40\n\ +@c FIXME -- restore this example when third arg is allowed to be an array.\n\ +@c\n\ +@c\n\ +@c bitshift ([1, 10], 2, [3,4])\n\ +@c @result{} 4 8\n\ +@end group\n\ +@end example\n\ +@seealso{bitand, bitor, bitxor, bitset, bitget, bitcmp, bitmax}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + int nbits = 64; + + NDArray n = args(1).array_value (); + + if (error_state) + error ("bitshift: expecting integer as second argument"); + else + { + if (nargin == 3) + { + // FIXME -- for compatibility, we should accept an array + // or a scalar as the third argument. + if (args(2).numel () > 1) + error ("bitshift: N must be a scalar integer"); + else + { + nbits = args(2).int_value (); + + if (error_state) + error ("bitshift: N must be an integer"); + else if (nbits < 0) + error ("bitshift: N must be positive"); + } + } + } + + if (error_state) + return retval; + + octave_value m_arg = args(0); + std::string cname = m_arg.class_name (); + + if (cname == "uint8") + DO_UBITSHIFT (uint8, nbits < 8 ? nbits : 8); + else if (cname == "uint16") + DO_UBITSHIFT (uint16, nbits < 16 ? nbits : 16); + else if (cname == "uint32") + DO_UBITSHIFT (uint32, nbits < 32 ? nbits : 32); + else if (cname == "uint64") + DO_UBITSHIFT (uint64, nbits < 64 ? nbits : 64); + else if (cname == "int8") + DO_SBITSHIFT (int8, nbits < 8 ? nbits : 8); + else if (cname == "int16") + DO_SBITSHIFT (int16, nbits < 16 ? nbits : 16); + else if (cname == "int32") + DO_SBITSHIFT (int32, nbits < 32 ? nbits : 32); + else if (cname == "int64") + DO_SBITSHIFT (int64, nbits < 64 ? nbits : 64); + else if (cname == "double") + { + nbits = (nbits < 53 ? nbits : 53); + int64_t mask = 0x1FFFFFFFFFFFFFLL; + if (nbits < 53) + mask = mask >> (53 - nbits); + else if (nbits < 1) + mask = 0; + int bits_in_type = 64; + NDArray m = m_arg.array_value (); + DO_BITSHIFT ( ); + } + else + error ("bitshift: not defined for %s objects", cname.c_str ()); + } + else + print_usage (); + + return retval; +} + +DEFUN (bitmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitmax ()\n\ +@deftypefnx {Built-in Function} {} bitmax (\"double\")\n\ +@deftypefnx {Built-in Function} {} bitmax (\"single\")\n\ +Return the largest integer that can be represented within a floating point\n\ +value. The default class is \"double\", but \"single\" is a valid option.\n\ +On IEEE-754 compatible systems, @code{bitmax} is @w{@math{2^{53} - 1}}.\n\ +@end deftypefn") +{ + octave_value retval; + std::string cname = "double"; + int nargin = args.length (); + + if (nargin == 1 && args(0).is_string ()) + cname = args(0).string_value (); + else if (nargin != 0) + { + print_usage (); + return retval; + } + + if (cname == "double") + retval = (static_cast (0x1FFFFFFFFFFFFFLL)); + else if (cname == "single") + retval = (static_cast (0xFFFFFFL)); + else + error ("bitmax: not defined for class '%s'", cname.c_str ()); + + return retval; +} + +DEFUN (intmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} intmax (@var{type})\n\ +Return the largest integer that can be represented in an integer type.\n\ +The variable @var{type} can be\n\ +\n\ +@table @code\n\ +@item int8\n\ +signed 8-bit integer.\n\ +\n\ +@item int16\n\ +signed 16-bit integer.\n\ +\n\ +@item int32\n\ +signed 32-bit integer.\n\ +\n\ +@item int64\n\ +signed 64-bit integer.\n\ +\n\ +@item uint8\n\ +unsigned 8-bit integer.\n\ +\n\ +@item uint16\n\ +unsigned 16-bit integer.\n\ +\n\ +@item uint32\n\ +unsigned 32-bit integer.\n\ +\n\ +@item uint64\n\ +unsigned 64-bit integer.\n\ +@end table\n\ +\n\ +The default for @var{type} is @code{uint32}.\n\ +@seealso{intmin, bitmax}\n\ +@end deftypefn") +{ + octave_value retval; + std::string cname = "int32"; + int nargin = args.length (); + + if (nargin == 1 && args(0).is_string ()) + cname = args(0).string_value (); + else if (nargin != 0) + { + print_usage (); + return retval; + } + + if (cname == "uint8") + retval = octave_uint8 (std::numeric_limits::max ()); + else if (cname == "uint16") + retval = octave_uint16 (std::numeric_limits::max ()); + else if (cname == "uint32") + retval = octave_uint32 (std::numeric_limits::max ()); + else if (cname == "uint64") + retval = octave_uint64 (std::numeric_limits::max ()); + else if (cname == "int8") + retval = octave_int8 (std::numeric_limits::max ()); + else if (cname == "int16") + retval = octave_int16 (std::numeric_limits::max ()); + else if (cname == "int32") + retval = octave_int32 (std::numeric_limits::max ()); + else if (cname == "int64") + retval = octave_int64 (std::numeric_limits::max ()); + else + error ("intmax: not defined for '%s' objects", cname.c_str ()); + + return retval; +} + +DEFUN (intmin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} intmin (@var{type})\n\ +Return the smallest integer that can be represented in an integer type.\n\ +The variable @var{type} can be\n\ +\n\ +@table @code\n\ +@item int8\n\ +signed 8-bit integer.\n\ +\n\ +@item int16\n\ +signed 16-bit integer.\n\ +\n\ +@item int32\n\ +signed 32-bit integer.\n\ +\n\ +@item int64\n\ +signed 64-bit integer.\n\ +\n\ +@item uint8\n\ +unsigned 8-bit integer.\n\ +\n\ +@item uint16\n\ +unsigned 16-bit integer.\n\ +\n\ +@item uint32\n\ +unsigned 32-bit integer.\n\ +\n\ +@item uint64\n\ +unsigned 64-bit integer.\n\ +@end table\n\ +\n\ +The default for @var{type} is @code{uint32}.\n\ +@seealso{intmax, bitmax}\n\ +@end deftypefn") +{ + octave_value retval; + std::string cname = "int32"; + int nargin = args.length (); + + if (nargin == 1 && args(0).is_string ()) + cname = args(0).string_value (); + else if (nargin != 0) + { + print_usage (); + return retval; + } + + if (cname == "uint8") + retval = octave_uint8 (std::numeric_limits::min ()); + else if (cname == "uint16") + retval = octave_uint16 (std::numeric_limits::min ()); + else if (cname == "uint32") + retval = octave_uint32 (std::numeric_limits::min ()); + else if (cname == "uint64") + retval = octave_uint64 (std::numeric_limits::min ()); + else if (cname == "int8") + retval = octave_int8 (std::numeric_limits::min ()); + else if (cname == "int16") + retval = octave_int16 (std::numeric_limits::min ()); + else if (cname == "int32") + retval = octave_int32 (std::numeric_limits::min ()); + else if (cname == "int64") + retval = octave_int64 (std::numeric_limits::min ()); + else + error ("intmin: not defined for '%s' objects", cname.c_str ()); + + return retval; +} + +DEFUN (sizemax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sizemax ()\n\ +Return the largest value allowed for the size of an array.\n\ +If Octave is compiled with 64-bit indexing, the result is of class int64,\n\ +otherwise it is of class int32. The maximum array size is slightly\n\ +smaller than the maximum value allowable for the relevant class as reported\n\ +by @code{intmax}.\n\ +@seealso{intmax}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = octave_int (dim_vector::dim_max ()); + else + print_usage (); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/corefcn/mappers.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/mappers.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,2087 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "lo-ieee.h" +#include "lo-specfun.h" +#include "lo-mappers.h" + +#include "defun.h" +#include "error.h" +#include "variables.h" + +DEFUN (abs, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} abs (@var{z})\n\ +Compute the magnitude of @var{z}, defined as\n\ +@tex\n\ +$|z| = \\sqrt{x^2 + y^2}$.\n\ +@end tex\n\ +@ifnottex\n\ +|@var{z}| = @code{sqrt (x^2 + y^2)}.\n\ +@end ifnottex\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +abs (3 + 4i)\n\ + @result{} 5\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).abs (); + else + print_usage (); + + return retval; +} + +/* +%!assert (abs (1), 1) +%!assert (abs (-3.5), 3.5) +%!assert (abs (3+4i), 5) +%!assert (abs (3-4i), 5) +%!assert (abs ([1.1, 3i; 3+4i, -3-4i]), [1.1, 3; 5, 5]) + +%!assert (abs (single (1)), single (1)) +%!assert (abs (single (-3.5)), single (3.5)) +%!assert (abs (single (3+4i)), single (5)) +%!assert (abs (single (3-4i)), single (5)) +%!assert (abs (single ([1.1, 3i; 3+4i, -3-4i])), single ([1.1, 3; 5, 5])) + +%!error abs () +%!error abs (1, 2) +*/ + +DEFUN (acos, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} acos (@var{x})\n\ +Compute the inverse cosine in radians for each element of @var{x}.\n\ +@seealso{cos, acosd}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).acos (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; +%! v = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! assert (acos (x), v, sqrt (eps)); + +%!test +%! x = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); +%! v = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! assert (acos (x), v, sqrt (eps ("single"))); + +%!error acos () +%!error acos (1, 2) +*/ + +DEFUN (acosh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} acosh (@var{x})\n\ +Compute the inverse hyperbolic cosine for each element of @var{x}.\n\ +@seealso{cosh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).acosh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [1, 0, -1, 0]; +%! v = [0, pi/2*i, pi*i, pi/2*i]; +%! assert (acosh (x), v, sqrt (eps)); + +%!test +%! x = single ([1, 0, -1, 0]); +%! v = single ([0, pi/2*i, pi*i, pi/2*i]); +%! assert (acosh (x), v, sqrt (eps ("single"))); + +%!error acosh () +%!error acosh (1, 2) +*/ + +DEFUN (angle, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} angle (@var{z})\n\ +See arg.\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).arg (); + else + print_usage (); + + return retval; +} + +DEFUN (arg, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} arg (@var{z})\n\ +@deftypefnx {Mapping Function} {} angle (@var{z})\n\ +Compute the argument of @var{z}, defined as,\n\ +@tex\n\ +$\\theta = atan2 (y, x),$\n\ +@end tex\n\ +@ifnottex\n\ +@var{theta} = @code{atan2 (@var{y}, @var{x})},\n\ +@end ifnottex\n\ +in radians.\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +arg (3 + 4i)\n\ + @result{} 0.92730\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).arg (); + else + print_usage (); + + return retval; +} + +/* +%!assert (arg (1), 0) +%!assert (arg (i), pi/2) +%!assert (arg (-1), pi) +%!assert (arg (-i), -pi/2) +%!assert (arg ([1, i; -1, -i]), [0, pi/2; pi, -pi/2]) + +%!assert (arg (single (1)), single (0)) +%!assert (arg (single (i)), single (pi/2)) +%!test +%! if (ismac ()) +%! ## Avoid failing for a MacOS feature +%! assert (arg (single (-1)), single (pi), 2*eps (single (1))); +%! else +%! assert (arg (single (-1)), single (pi)); +%! endif +%!assert (arg (single (-i)), single (-pi/2)) +%!assert (arg (single ([1, i; -1, -i])), single ([0, pi/2; pi, -pi/2]), 2e1*eps ("single")) + +%!error arg () +%!error arg (1, 2) +*/ + +DEFUN (asin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} asin (@var{x})\n\ +Compute the inverse sine in radians for each element of @var{x}.\n\ +@seealso{sin, asind}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).asin (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! x = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; +%! v = [0, pi/6, pi/4, pi/3, pi/2, pi/3, pi/4, pi/6, 0]; +%! assert (all (abs (asin (x) - v) < sqrt (eps))); + +%!error asin () +%!error asin (1, 2) +*/ + +DEFUN (asinh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} asinh (@var{x})\n\ +Compute the inverse hyperbolic sine for each element of @var{x}.\n\ +@seealso{sinh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).asinh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! v = [0, pi/2*i, 0, -pi/2*i]; +%! x = [0, i, 0, -i]; +%! assert (asinh (x), v, sqrt (eps)); + +%!test +%! v = single ([0, pi/2*i, 0, -pi/2*i]); +%! x = single ([0, i, 0, -i]); +%! assert (asinh (x), v, sqrt (eps ("single"))); + +%!error asinh () +%!error asinh (1, 2) +*/ + +DEFUN (atan, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} atan (@var{x})\n\ +Compute the inverse tangent in radians for each element of @var{x}.\n\ +@seealso{tan, atand}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).atan (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; +%! x = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; +%! assert (atan (x), v, sqrt (eps)); + +%!test +%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); +%! x = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); +%! assert (atan (x), v, sqrt (eps ("single"))); + +%!error atan () +%!error atan (1, 2) +*/ + +DEFUN (atanh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} atanh (@var{x})\n\ +Compute the inverse hyperbolic tangent for each element of @var{x}.\n\ +@seealso{tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).atanh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! v = [0, 0]; +%! x = [0, 0]; +%! assert (atanh (x), v, sqrt (eps)); + +%!test +%! v = single ([0, 0]); +%! x = single ([0, 0]); +%! assert (atanh (x), v, sqrt (eps ("single"))); + +%!error atanh () +%!error atanh (1, 2) +*/ + +DEFUN (cbrt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} cbrt (@var{x})\n\ +Compute the real cube root of each element of @var{x}.\n\ +Unlike @code{@var{x}^(1/3)}, the result will be negative if @var{x} is\n\ +negative.\n\ +@seealso{nthroot}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).cbrt (); + else + print_usage (); + + return retval; +} + +/* +%!assert (cbrt (64), 4) +%!assert (cbrt (-125), -5) +%!assert (cbrt (0), 0) +%!assert (cbrt (Inf), Inf) +%!assert (cbrt (-Inf), -Inf) +%!assert (cbrt (NaN), NaN) +%!assert (cbrt (2^300), 2^100) +%!assert (cbrt (125*2^300), 5*2^100) + +%!error cbrt () +%!error cbrt (1, 2) +*/ + +DEFUN (ceil, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} ceil (@var{x})\n\ +Return the smallest integer not less than @var{x}. This is equivalent to\n\ +rounding towards positive infinity. If @var{x} is\n\ +complex, return @code{ceil (real (@var{x})) + ceil (imag (@var{x})) * I}.\n\ +\n\ +@example\n\ +@group\n\ +ceil ([-2.7, 2.7])\n\ + @result{} -2 3\n\ +@end group\n\ +@end example\n\ +@seealso{floor, round, fix}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).ceil (); + else + print_usage (); + + return retval; +} + +/* +## double precision +%!assert (ceil ([2, 1.1, -1.1, -1]), [2, 2, -1, -1]) + +## complex double precison +%!assert (ceil ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 2+2i, -1-i, -1-i]) + +## single precision +%!assert (ceil (single ([2, 1.1, -1.1, -1])), single ([2, 2, -1, -1])) + +## complex single precision +%!assert (ceil (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 2+2i, -1-i, -1-i])) + +%!error ceil () +%!error ceil (1, 2) +*/ + +DEFUN (conj, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} conj (@var{z})\n\ +Return the complex conjugate of @var{z}, defined as\n\ +@tex\n\ +$\\bar{z} = x - iy$.\n\ +@end tex\n\ +@ifnottex\n\ +@code{conj (@var{z})} = @var{x} - @var{i}@var{y}.\n\ +@end ifnottex\n\ +@seealso{real, imag}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).conj (); + else + print_usage (); + + return retval; +} + +/* +%!assert (conj (1), 1) +%!assert (conj (i), -i) +%!assert (conj (1+i), 1-i) +%!assert (conj (1-i), 1+i) +%!assert (conj ([-1, -i; -1+i, -1-i]), [-1, i; -1-i, -1+i]) + +%!assert (conj (single (1)), single (1)) +%!assert (conj (single (i)), single (-i)) +%!assert (conj (single (1+i)), single (1-i)) +%!assert (conj (single (1-i)), single (1+i)) +%!assert (conj (single ([-1, -i; -1+i, -1-i])), single ([-1, i; -1-i, -1+i])) + +%!error conj () +%!error conj (1, 2) +*/ + +DEFUN (cos, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} cos (@var{x})\n\ +Compute the cosine for each element of @var{x} in radians.\n\ +@seealso{acos, cosd, cosh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).cos (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; +%! assert (cos (x), v, sqrt (eps)); + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); +%! assert (cos (x), v, sqrt (eps ("single"))); + +%!error cos () +%!error cos (1, 2) +*/ + +DEFUN (cosh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} cosh (@var{x})\n\ +Compute the hyperbolic cosine for each element of @var{x}.\n\ +@seealso{acosh, sinh, tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).cosh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; +%! v = [1, 0, -1, 0]; +%! assert (cosh (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); +%! v = single ([1, 0, -1, 0]); +%! assert (cosh (x), v, sqrt (eps ("single"))); + +%!error cosh () +%!error cosh (1, 2) +*/ + +DEFUN (erf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erf (@var{z})\n\ +Compute the error function,\n\ +@tex\n\ +$$\n\ + {\\rm erf} (z) = {2 \\over \\sqrt{\\pi}}\\int_0^z e^{-t^2} dt\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@group\n\ + z\n\ + 2 /\n\ +erf (z) = --------- * | e^(-t^2) dt\n\ + sqrt (pi) /\n\ + t=0\n\ +@end group\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +@seealso{erfc, erfcx, erfinv, erfcinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erf (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (erf (a), erf (real (a))); + +%!test +%! x = [0,.5,1]; +%! v = [0, .520499877813047, .842700792949715]; +%! assert (erf (x), v, 1.e-10); +%! assert (erf (-x), -v, 1.e-10); +%! assert (erfc (x), 1-v, 1.e-10); +%! assert (erfinv (v), x, 1.e-10); + +%!test +%! a = -1i*sqrt (single (-1/(6.4187*6.4187))); +%! assert (erf (a), erf (real (a))); + +%!test +%! x = single ([0,.5,1]); +%! v = single ([0, .520499877813047, .842700792949715]); +%! assert (erf (x), v, 1.e-6); +%! assert (erf (-x), -v, 1.e-6); +%! assert (erfc (x), 1-v, 1.e-6); +%! assert (erfinv (v), x, 1.e-6); + +%!error erf () +%!error erf (1, 2) +*/ + +DEFUN (erfinv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfinv (@var{x})\n\ +Compute the inverse error function, i.e., @var{y} such that\n\ +\n\ +@example\n\ +erf (@var{y}) == @var{x}\n\ +@end example\n\ +@seealso{erf, erfc, erfcx, erfcinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfinv (); + else + print_usage (); + + return retval; +} + +/* +## middle region +%!assert (erf (erfinv ([-0.9 -0.3 0 0.4 0.8])), [-0.9 -0.3 0 0.4 0.8], eps) +%!assert (erf (erfinv (single ([-0.9 -0.3 0 0.4 0.8]))), single ([-0.9 -0.3 0 0.4 0.8]), eps ("single")) +## tail region +%!assert (erf (erfinv ([-0.999 -0.99 0.9999 0.99999])), [-0.999 -0.99 0.9999 0.99999], eps) +%!assert (erf (erfinv (single ([-0.999 -0.99 0.9999 0.99999]))), single ([-0.999 -0.99 0.9999 0.99999]), eps ("single")) +## backward - loss of accuracy +%!assert (erfinv (erf ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) +%!assert (erfinv (erf (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) +## exceptional +%!assert (erfinv ([-1, 1, 1.1, -2.1]), [-Inf, Inf, NaN, NaN]) +%!error erfinv (1+2i) + +%!error erfinv () +%!error erfinv (1, 2) +*/ + +DEFUN (erfcinv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfcinv (@var{x})\n\ +Compute the inverse complementary error function, i.e., @var{y} such that\n\ +\n\ +@example\n\ +erfc (@var{y}) == @var{x}\n\ +@end example\n\ +@seealso{erfc, erf, erfcx, erfinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfcinv (); + else + print_usage (); + + return retval; +} + +/* +## middle region +%!assert (erfc (erfcinv ([1.9 1.3 1 0.6 0.2])), [1.9 1.3 1 0.6 0.2], eps) +%!assert (erfc (erfcinv (single ([1.9 1.3 1 0.6 0.2]))), single ([1.9 1.3 1 0.6 0.2]), eps ("single")) +## tail region +%!assert (erfc (erfcinv ([0.001 0.01 1.9999 1.99999])), [0.001 0.01 1.9999 1.99999], eps) +%!assert (erfc (erfcinv (single ([0.001 0.01 1.9999 1.99999]))), single ([0.001 0.01 1.9999 1.99999]), eps ("single")) +## backward - loss of accuracy +%!assert (erfcinv (erfc ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) +%!assert (erfcinv (erfc (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) +## exceptional +%!assert (erfcinv ([2, 0, -0.1, 2.1]), [-Inf, Inf, NaN, NaN]) +%!error erfcinv (1+2i) + +%!error erfcinv () +%!error erfcinv (1, 2) +*/ + +DEFUN (erfc, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfc (@var{z})\n\ +Compute the complementary error function,\n\ +@tex\n\ +$1 - {\\rm erf} (z)$.\n\ +@end tex\n\ +@ifnottex\n\ +@w{@code{1 - erf (@var{z})}}.\n\ +@end ifnottex\n\ +@seealso{erfcinv, erfcx, erf, erfinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfc (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (erfc (a), erfc (real (a))); + +%!error erfc () +%!error erfc (1, 2) +*/ + +DEFUN (erfcx, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfcx (@var{z})\n\ +Compute the scaled complementary error function,\n\ +@tex\n\ +$$\n\ + e^{z^2} {\\rm erfc} (z) \\equiv e^{z^2} (1 - {\\rm erf} (z))\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +exp (z^2) * erfc (x)\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +@seealso{erfc, erf, erfinv, erfcinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfcx (); + else + print_usage (); + + return retval; +} + +/* +## FIXME: Need a test for erfcx + +%!error erfcx () +%!error erfcx (1, 2) +*/ + +DEFUN (exp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} exp (@var{x})\n\ +Compute\n\ +@tex\n\ +$e^{x}$\n\ +@end tex\n\ +@ifnottex\n\ +@code{e^x}\n\ +@end ifnottex\n\ +for each element of @var{x}. To compute the matrix\n\ +exponential, see @ref{Linear Algebra}.\n\ +@seealso{log}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).exp (); + else + print_usage (); + + return retval; +} + +/* +%!assert (exp ([0, 1, -1, -1000]), [1, e, 1/e, 0], sqrt (eps)) +%!assert (exp (1+i), e * (cos (1) + sin (1) * i), sqrt (eps)) +%!assert (exp (single ([0, 1, -1, -1000])), single ([1, e, 1/e, 0]), sqrt (eps ("single"))) +%!assert (exp (single (1+i)), single (e * (cos (1) + sin (1) * i)), sqrt (eps ("single"))) + +%!assert (exp ([Inf, -Inf, NaN]), [Inf 0 NaN]) +%!assert (exp (single ([Inf, -Inf, NaN])), single ([Inf 0 NaN])) + +%!error exp () +%!error exp (1, 2) +*/ + +DEFUN (expm1, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} expm1 (@var{x})\n\ +Compute\n\ +@tex\n\ +$ e^{x} - 1 $\n\ +@end tex\n\ +@ifnottex\n\ +@code{exp (@var{x}) - 1}\n\ +@end ifnottex\n\ +accurately in the neighborhood of zero.\n\ +@seealso{exp}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).expm1 (); + else + print_usage (); + + return retval; +} + +/* +%!assert (expm1 (2*eps), 2*eps, 1e-29) + +%!assert (expm1 ([Inf, -Inf, NaN]), [Inf -1 NaN]) +%!assert (expm1 (single ([Inf, -Inf, NaN])), single ([Inf -1 NaN])) + +%!error expm1 () +%!error expm1 (1, 2) +*/ + +DEFUN (isfinite, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isfinite (@var{x})\n\ +@deftypefnx {Mapping Function} {} finite (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +finite values and false where they are not.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +finite ([13, Inf, NA, NaN])\n\ + @result{} [ 1, 0, 0, 0 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isinf, isnan, isna}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).finite (); + else + print_usage (); + + return retval; +} + +/* +%!assert (!finite (Inf)) +%!assert (!finite (NaN)) +%!assert (finite (rand (1,10))) + +%!assert (!finite (single (Inf))) +%!assert (!finite (single (NaN))) +%!assert (finite (single (rand (1,10)))) + +%!error finite () +%!error finite (1, 2) +*/ + +DEFUN (fix, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} fix (@var{x})\n\ +Truncate fractional portion of @var{x} and return the integer portion. This\n\ +is equivalent to rounding towards zero. If @var{x} is complex, return\n\ +@code{fix (real (@var{x})) + fix (imag (@var{x})) * I}.\n\ +\n\ +@example\n\ +@group\n\ +fix ([-2.7, 2.7])\n\ + @result{} -2 2\n\ +@end group\n\ +@end example\n\ +@seealso{ceil, floor, round}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).fix (); + else + print_usage (); + + return retval; +} + +/* +%!assert (fix ([1.1, 1, -1.1, -1]), [1, 1, -1, -1]) +%!assert (fix ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i]), [1+i, 1+i, -1-i, -1-i]) +%!assert (fix (single ([1.1, 1, -1.1, -1])), single ([1, 1, -1, -1])) +%!assert (fix (single ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i])), single ([1+i, 1+i, -1-i, -1-i])) + +%!error fix () +%!error fix (1, 2) +*/ + +DEFUN (floor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} floor (@var{x})\n\ +Return the largest integer not greater than @var{x}. This is equivalent to\n\ +rounding towards negative infinity. If @var{x} is\n\ +complex, return @code{floor (real (@var{x})) + floor (imag (@var{x})) * I}.\n\ +\n\ +@example\n\ +@group\n\ +floor ([-2.7, 2.7])\n\ + @result{} -3 2\n\ +@end group\n\ +@end example\n\ +@seealso{ceil, round, fix}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).floor (); + else + print_usage (); + + return retval; +} + +/* +%!assert (floor ([2, 1.1, -1.1, -1]), [2, 1, -2, -1]) +%!assert (floor ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 1+i, -2-2i, -1-i]) +%!assert (floor (single ([2, 1.1, -1.1, -1])), single ([2, 1, -2, -1])) +%!assert (floor (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 1+i, -2-2i, -1-i])) + +%!error floor () +%!error floor (1, 2) +*/ + +DEFUN (gamma, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} gamma (@var{z})\n\ +Compute the Gamma function,\n\ +@tex\n\ +$$\n\ + \\Gamma (z) = \\int_0^\\infty t^{z-1} e^{-t} dt.\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@group\n\ + infinity\n\ + /\n\ +gamma (z) = | t^(z-1) exp (-t) dt.\n\ + /\n\ + t=0\n\ +@end group\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +@seealso{gammainc, lgamma}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).gamma (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (gamma (a), gamma (real (a))); + +%!test +%! x = [.5, 1, 1.5, 2, 3, 4, 5]; +%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; +%! assert (gamma (x), v, sqrt (eps)); + +%!test +%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); +%! assert (gamma (a), gamma (real (a))); + +%!test +%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); +%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); +%! assert (gamma (x), v, sqrt (eps ("single"))); + +%!test +%! x = [-1, 0, 1, Inf]; +%! v = [Inf, Inf, 1, Inf]; +%! assert (gamma (x), v); +%! assert (gamma (single (x)), single (v)); + +%!error gamma () +%!error gamma (1, 2) +*/ + +DEFUN (imag, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} imag (@var{z})\n\ +Return the imaginary part of @var{z} as a real number.\n\ +@seealso{real, conj}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).imag (); + else + print_usage (); + + return retval; +} + +/* +%!assert (imag (1), 0) +%!assert (imag (i), 1) +%!assert (imag (1+i), 1) +%!assert (imag ([i, 1; 1, i]), full (eye (2))) + +%!assert (imag (single (1)), single (0)) +%!assert (imag (single (i)), single (1)) +%!assert (imag (single (1+i)), single (1)) +%!assert (imag (single ([i, 1; 1, i])), full (eye (2,"single"))) + +%!error imag () +%!error imag (1, 2) +*/ + +DEFUNX ("isalnum", Fisalnum, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isalnum (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +letters or digits and false where they are not. This is equivalent to\n\ +(@code{isalpha (@var{s}) | isdigit (@var{s})}).\n\ +@seealso{isalpha, isdigit, ispunct, isspace, iscntrl}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisalnum (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! result(toascii ("0":"9") + 1) = true; +%! result(toascii ("a":"z") + 1) = true; +%! assert (isalnum (charset), result); + +%!error isalnum () +%!error isalnum (1, 2) +*/ + +DEFUNX ("isalpha", Fisalpha, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isalpha (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +letters and false where they are not. This is equivalent to\n\ +(@code{islower (@var{s}) | isupper (@var{s})}).\n\ +@seealso{isdigit, ispunct, isspace, iscntrl, isalnum, islower, isupper}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisalpha (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! result(toascii ("a":"z") + 1) = true; +%! assert (isalpha (charset), result); + +%!error isalpha () +%!error isalpha (1, 2) +*/ + +DEFUNX ("isascii", Fisascii, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isascii (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +ASCII characters (in the range 0 to 127 decimal) and false where they are\n\ +not.\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisascii (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = true (1, 128); +%! assert (isascii (charset), result); + +%!error isascii () +%!error isascii (1, 2) +*/ + +DEFUNX ("iscntrl", Fiscntrl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} iscntrl (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +control characters and false where they are not.\n\ +@seealso{ispunct, isspace, isalpha, isdigit}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xiscntrl (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(1:32) = true; +%! result(128) = true; +%! assert (iscntrl (charset), result); + +%!error iscntrl () +%!error iscntrl (1, 2) +*/ + +DEFUNX ("isdigit", Fisdigit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isdigit (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +decimal digits (0-9) and false where they are not.\n\ +@seealso{isxdigit, isalpha, isletter, ispunct, isspace, iscntrl}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisdigit (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("0":"9") + 1) = true; +%! assert (isdigit (charset), result); + +%!error isdigit () +%!error isdigit (1, 2) +*/ + +DEFUN (isinf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isinf (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +are infinite and false where they are not.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +isinf ([13, Inf, NA, NaN])\n\ + @result{} [ 0, 1, 0, 0 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isfinite, isnan, isna}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).isinf (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isinf (Inf)) +%!assert (!isinf (NaN)) +%!assert (!isinf (NA)) +%!assert (isinf (rand (1,10)), false (1,10)) +%!assert (isinf ([NaN -Inf -1 0 1 Inf NA]), [false, true, false, false, false, true, false]) + +%!assert (isinf (single (Inf))) +%!assert (!isinf (single (NaN))) +%!assert (!isinf (single (NA))) +%!assert (isinf (single (rand (1,10))), false (1,10)) +%!assert (isinf (single ([NaN -Inf -1 0 1 Inf NA])), [false, true, false, false, false, true, false]) + +%!error isinf () +%!error isinf (1, 2) +*/ + +DEFUNX ("isgraph", Fisgraph, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isgraph (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +printable characters (but not the space character) and false where they are\n\ +not.\n\ +@seealso{isprint}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisgraph (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(34:127) = true; +%! assert (isgraph (charset), result); + +%!error isgraph () +%!error isgraph (1, 2) +*/ + +DEFUNX ("islower", Fislower, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} islower (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +lowercase letters and false where they are not.\n\ +@seealso{isupper, isalpha, isletter, isalnum}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xislower (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("a":"z") + 1) = true; +%! assert (islower (charset), result); + +%!error islower () +%!error islower (1, 2) +*/ + +DEFUN (isna, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isna (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +NA (missing) values and false where they are not.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +isna ([13, Inf, NA, NaN])\n\ + @result{} [ 0, 0, 1, 0 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isnan, isinf, isfinite}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).isna (); + else + print_usage (); + + return retval; +} + +/* +%!assert (!isna (Inf)) +%!assert (!isna (NaN)) +%!assert (isna (NA)) +%!assert (isna (rand (1,10)), false (1,10)) +%!assert (isna ([NaN -Inf -1 0 1 Inf NA]), [false, false, false, false, false, false, true]) + +%!assert (!isna (single (Inf))) +%!assert (!isna (single (NaN))) +%!assert (isna (single (NA))) +%!assert (isna (single (rand (1,10))), false (1,10)) +%!assert (isna (single ([NaN -Inf -1 0 1 Inf NA])), [false, false, false, false, false, false, true]) + +%!error isna () +%!error isna (1, 2) +*/ + +DEFUN (isnan, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isnan (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +NaN values and false where they are not.\n\ +NA values are also considered NaN values. For example:\n\ +\n\ +@example\n\ +@group\n\ +isnan ([13, Inf, NA, NaN])\n\ + @result{} [ 0, 0, 1, 1 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isna, isinf, isfinite}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).isnan (); + else + print_usage (); + + return retval; +} + +/* +%!assert (!isnan (Inf)) +%!assert (isnan (NaN)) +%!assert (isnan (NA)) +%!assert (isnan (rand (1,10)), false (1,10)) +%!assert (isnan ([NaN -Inf -1 0 1 Inf NA]), [true, false, false, false, false, false, true]) + +%!assert (!isnan (single (Inf))) +%!assert (isnan (single (NaN))) +%!assert (isnan (single (NA))) +%!assert (isnan (single (rand (1,10))), false (1,10)) +%!assert (isnan (single ([NaN -Inf -1 0 1 Inf NA])), [true, false, false, false, false, false, true]) + +%!error isnan () +%!error isnan (1, 2) +*/ + +DEFUNX ("isprint", Fisprint, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isprint (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +printable characters (including the space character) and false where they\n\ +are not.\n\ +@seealso{isgraph}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisprint (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(33:127) = true; +%! assert (isprint (charset), result); + +%!error isprint () +%!error isprint (1, 2) +*/ + +DEFUNX ("ispunct", Fispunct, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} ispunct (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +punctuation characters and false where they are not.\n\ +@seealso{isalpha, isdigit, isspace, iscntrl}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xispunct (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(34:48) = true; +%! result(59:65) = true; +%! result(92:97) = true; +%! result(124:127) = true; +%! assert (ispunct (charset), result); + +%!error ispunct () +%!error ispunct (1, 2) +*/ + +DEFUNX ("isspace", Fisspace, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isspace (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +whitespace characters (space, formfeed, newline, carriage return, tab, and\n\ +vertical tab) and false where they are not.\n\ +@seealso{iscntrl, ispunct, isalpha, isdigit}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisspace (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii (" \f\n\r\t\v") + 1) = true; +%! assert (isspace (charset), result); + +%!error isspace () +%!error isspace (1, 2) +*/ + +DEFUNX ("isupper", Fisupper, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isupper (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +uppercase letters and false where they are not.\n\ +@seealso{islower, isalpha, isletter, isalnum}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisupper (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! assert (isupper (charset), result); + +%!error isupper () +%!error isupper (1, 2) +*/ + +DEFUNX ("isxdigit", Fisxdigit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isxdigit (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +hexadecimal digits (0-9 and @nospell{a-fA-F}).\n\ +@seealso{isdigit}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisxdigit (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"F") + 1) = true; +%! result(toascii ("0":"9") + 1) = true; +%! result(toascii ("a":"f") + 1) = true; +%! assert (isxdigit (charset), result); + +%!error isxdigit () +%!error isxdigit (1, 2) +*/ + +DEFUN (lgamma, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} lgamma (@var{x})\n\ +@deftypefnx {Mapping Function} {} gammaln (@var{x})\n\ +Return the natural logarithm of the gamma function of @var{x}.\n\ +@seealso{gamma, gammainc}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).lgamma (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (lgamma (a), lgamma (real (a))); + +%!test +%! x = [.5, 1, 1.5, 2, 3, 4, 5]; +%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; +%! assert (lgamma (x), log (v), sqrt (eps)) + +%!test +%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); +%! assert (lgamma (a), lgamma (real (a))); + +%!test +%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); +%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); +%! assert (lgamma (x), log (v), sqrt (eps ("single"))) + +%!test +%! x = [-1, 0, 1, Inf]; +%! v = [Inf, Inf, 0, Inf]; +%! assert (lgamma (x), v); +%! assert (lgamma (single (x)), single (v)); + +%!error lgamma () +%!error lgamma (1,2) +*/ + +DEFUN (log, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log (@var{x})\n\ +Compute the natural logarithm,\n\ +@tex\n\ +$\\ln{(x)},$\n\ +@end tex\n\ +@ifnottex\n\ +@code{ln (@var{x})},\n\ +@end ifnottex\n\ +for each element of @var{x}. To compute the\n\ +matrix logarithm, see @ref{Linear Algebra}.\n\ +@seealso{exp, log1p, log2, log10, logspace}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).log (); + else + print_usage (); + + return retval; +} + +/* +%!assert (log ([1, e, e^2]), [0, 1, 2], sqrt (eps)) +%!assert (log ([-0.5, -1.5, -2.5]), log ([0.5, 1.5, 2.5]) + pi*1i, sqrt (eps)) + +%!assert (log (single ([1, e, e^2])), single ([0, 1, 2]), sqrt (eps ("single"))) +%!assert (log (single ([-0.5, -1.5, -2.5])), single (log ([0.5, 1.5, 2.5]) + pi*1i), 4*eps ("single")) + +%!error log () +%!error log (1, 2) +*/ + +DEFUN (log10, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log10 (@var{x})\n\ +Compute the base-10 logarithm of each element of @var{x}.\n\ +@seealso{log, log2, logspace, exp}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).log10 (); + else + print_usage (); + + return retval; +} + +/* +%!assert (log10 ([0.01, 0.1, 1, 10, 100]), [-2, -1, 0, 1, 2], sqrt (eps)) +%!assert (log10 (single ([0.01, 0.1, 1, 10, 100])), single ([-2, -1, 0, 1, 2]), sqrt (eps ("single"))) + +%!error log10 () +%!error log10 (1, 2) +*/ + +DEFUN (log1p, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log1p (@var{x})\n\ +Compute\n\ +@tex\n\ +$\\ln{(1 + x)}$\n\ +@end tex\n\ +@ifnottex\n\ +@code{log (1 + @var{x})}\n\ +@end ifnottex\n\ +accurately in the neighborhood of zero.\n\ +@seealso{log, exp, expm1}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).log1p (); + else + print_usage (); + + return retval; +} + +/* +%!assert (log1p ([0, 2*eps, -2*eps]), [0, 2*eps, -2*eps], 1e-29) +%!assert (log1p (single ([0, 2*eps, -2*eps])), single ([0, 2*eps, -2*eps]), 1e-29) + +%!error log1p () +%!error log1p (1, 2) +*/ + +DEFUN (real, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} real (@var{z})\n\ +Return the real part of @var{z}.\n\ +@seealso{imag, conj}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).real (); + else + print_usage (); + + return retval; +} + +/* +%!assert (real (1), 1) +%!assert (real (i), 0) +%!assert (real (1+i), 1) +%!assert (real ([1, i; i, 1]), full (eye (2))) + +%!assert (real (single (1)), single (1)) +%!assert (real (single (i)), single (0)) +%!assert (real (single (1+i)), single (1)) +%!assert (real (single ([1, i; i, 1])), full (eye (2,"single"))) + +%!error real () +%!error real (1, 2) +*/ + +DEFUN (round, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} round (@var{x})\n\ +Return the integer nearest to @var{x}. If @var{x} is complex, return\n\ +@code{round (real (@var{x})) + round (imag (@var{x})) * I}. If there\n\ +are two nearest integers, return the one further away from zero.\n\ +\n\ +@example\n\ +@group\n\ +round ([-2.7, 2.7])\n\ + @result{} -3 3\n\ +@end group\n\ +@end example\n\ +@seealso{ceil, floor, fix, roundb}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).round (); + else + print_usage (); + + return retval; +} + +/* +%!assert (round (1), 1) +%!assert (round (1.1), 1) +%!assert (round (5.5), 6) +%!assert (round (i), i) +%!assert (round (2.5+3.5i), 3+4i) +%!assert (round (-2.6), -3) +%!assert (round ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) + +%!assert (round (single (1)), single (1)) +%!assert (round (single (1.1)), single (1)) +%!assert (round (single (5.5)), single (6)) +%!assert (round (single (i)), single (i)) +%!assert (round (single (2.5+3.5i)), single (3+4i)) +%!assert (round (single (-2.6)), single (-3)) +%!assert (round (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) + +%!error round () +%!error round (1, 2) +*/ + +DEFUN (roundb, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} roundb (@var{x})\n\ +Return the integer nearest to @var{x}. If there are two nearest\n\ +integers, return the even one (banker's rounding). If @var{x} is complex,\n\ +return @code{roundb (real (@var{x})) + roundb (imag (@var{x})) * I}.\n\ +@seealso{round}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).roundb (); + else + print_usage (); + + return retval; +} + +/* +%!assert (roundb (1), 1) +%!assert (roundb (1.1), 1) +%!assert (roundb (1.5), 2) +%!assert (roundb (4.5), 4) +%!assert (roundb (i), i) +%!assert (roundb (2.5+3.5i), 2+4i) +%!assert (roundb (-2.6), -3) +%!assert (roundb ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) + +%!assert (roundb (single (1)), single (1)) +%!assert (roundb (single (1.1)), single (1)) +%!assert (roundb (single (1.5)), single (2)) +%!assert (roundb (single (4.5)), single (4)) +%!assert (roundb (single (i)), single (i)) +%!assert (roundb (single (2.5+3.5i)), single (2+4i)) +%!assert (roundb (single (-2.6)), single (-3)) +%!assert (roundb (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) + +%!error roundb () +%!error roundb (1, 2) +*/ + +DEFUN (sign, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sign (@var{x})\n\ +Compute the @dfn{signum} function, which is defined as\n\ +@tex\n\ +$$\n\ +{\\rm sign} (@var{x}) = \\cases{1,&$x>0$;\\cr 0,&$x=0$;\\cr -1,&$x<0$.\\cr}\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@group\n\ + -1, x < 0;\n\ +sign (x) = 0, x = 0;\n\ + 1, x > 0.\n\ +@end group\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +\n\ +For complex arguments, @code{sign} returns @code{x ./ abs (@var{x})}.\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).signum (); + else + print_usage (); + + return retval; +} + +/* +%!assert (sign (-2) , -1) +%!assert (sign (0), 0) +%!assert (sign (3), 1) +%!assert (sign ([1, -pi; e, 0]), [1, -1; 1, 0]) + +%!assert (sign (single (-2)) , single (-1)) +%!assert (sign (single (0)), single (0)) +%!assert (sign (single (3)), single (1)) +%!assert (sign (single ([1, -pi; e, 0])), single ([1, -1; 1, 0])) + +%!error sign () +%!error sign (1, 2) +*/ + +DEFUN (sin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sin (@var{x})\n\ +Compute the sine for each element of @var{x} in radians.\n\ +@seealso{asin, sind, sinh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).sin (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; +%! assert (sin (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]); +%! assert (sin (x), v, sqrt (eps ("single"))); + +%!error sin () +%!error sin (1, 2) +*/ + +DEFUN (sinh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sinh (@var{x})\n\ +Compute the hyperbolic sine for each element of @var{x}.\n\ +@seealso{asinh, cosh, tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).sinh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; +%! v = [0, i, 0, -i]; +%! assert (sinh (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); +%! v = single ([0, i, 0, -i]); +%! assert (sinh (x), v, sqrt (eps ("single"))); + +%!error sinh () +%!error sinh (1, 2) +*/ + +DEFUN (sqrt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sqrt (@var{x})\n\ +Compute the square root of each element of @var{x}. If @var{x} is negative,\n\ +a complex result is returned. To compute the matrix square root, see\n\ +@ref{Linear Algebra}.\n\ +@seealso{realsqrt, nthroot}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).sqrt (); + else + print_usage (); + + return retval; +} + +/* +%!assert (sqrt (4), 2) +%!assert (sqrt (-1), i) +%!assert (sqrt (1+i), exp (0.5 * log (1+i)), sqrt (eps)) +%!assert (sqrt ([4, -4; i, 1-i]), [2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))], sqrt (eps)) + +%!assert (sqrt (single (4)), single (2)) +%!assert (sqrt (single (-1)), single (i)) +%!assert (sqrt (single (1+i)), single (exp (0.5 * log (1+i))), sqrt (eps ("single"))) +%!assert (sqrt (single ([4, -4; i, 1-i])), single ([2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))]), sqrt (eps ("single"))) + +%!error sqrt () +%!error sqrt (1, 2) +*/ + +DEFUN (tan, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} tan (@var{z})\n\ +Compute the tangent for each element of @var{x} in radians.\n\ +@seealso{atan, tand, tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).tan (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; +%! assert (tan (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); +%! assert (tan (x), v, sqrt (eps ("single"))); + +%!error tan () +%!error tan (1, 2) +*/ + +DEFUN (tanh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} tanh (@var{x})\n\ +Compute hyperbolic tangent for each element of @var{x}.\n\ +@seealso{atanh, sinh, cosh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).tanh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [0, pi*i]; +%! v = [0, 0]; +%! assert (tanh (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi*i]); +%! v = single ([0, 0]); +%! assert (tanh (x), v, sqrt (eps ("single"))); + +%!error tanh () +%!error tanh (1, 2) +*/ + +DEFUNX ("toascii", Ftoascii, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} toascii (@var{s})\n\ +Return ASCII representation of @var{s} in a matrix. For example:\n\ +\n\ +@example\n\ +@group\n\ +toascii (\"ASCII\")\n\ + @result{} [ 65, 83, 67, 73, 73 ]\n\ +@end group\n\ +\n\ +@end example\n\ +@seealso{char}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xtoascii (); + else + print_usage (); + + return retval; +} + +/* +%!assert (toascii (char (0:127)), 0:127) +%!assert (toascii (" ":"@"), 32:64) +%!assert (toascii ("A":"Z"), 65:90) +%!assert (toascii ("[":"`"), 91:96) +%!assert (toascii ("a":"z"), 97:122) +%!assert (toascii ("{":"~"), 123:126) + +%!error toascii () +%!error toascii (1, 2) +*/ + +DEFUNX ("tolower", Ftolower, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} tolower (@var{s})\n\ +@deftypefnx {Mapping Function} {} lower (@var{s})\n\ +Return a copy of the string or cell string @var{s}, with each uppercase\n\ +character replaced by the corresponding lowercase one; non-alphabetic\n\ +characters are left unchanged. For example:\n\ +\n\ +@example\n\ +@group\n\ +tolower (\"MiXeD cAsE 123\")\n\ + @result{} \"mixed case 123\"\n\ +@end group\n\ +@end example\n\ +@seealso{toupper}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xtolower (); + else + print_usage (); + + return retval; +} + +DEFALIAS (lower, tolower); + +/* +%!assert (tolower ("OCTAVE"), "octave") +%!assert (tolower ("123OCTave!_&"), "123octave!_&") +%!assert (tolower ({"ABC", "DEF", {"GHI", {"JKL"}}}), {"abc", "def", {"ghi", {"jkl"}}}) +%!assert (tolower (["ABC"; "DEF"]), ["abc"; "def"]) +%!assert (tolower ({["ABC"; "DEF"]}), {["abc";"def"]}) +%!assert (tolower (68), "d") +%!assert (tolower ({[68, 68; 68, 68]}), {["dd";"dd"]}) +%!test +%! a(3,3,3,3) = "D"; +%! assert (tolower (a)(3,3,3,3), "d"); + +%!test +%! charset = char (0:127); +%! result = charset; +%! result (toascii ("A":"Z") + 1) = result (toascii ("a":"z") + 1); +%! assert (tolower (charset), result); + +%!error lower () +%!error tolower () +%!error tolower (1, 2) +*/ + +DEFUNX ("toupper", Ftoupper, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} toupper (@var{s})\n\ +@deftypefnx {Mapping Function} {} upper (@var{s})\n\ +Return a copy of the string or cell string @var{s}, with each lowercase\n\ +character replaced by the corresponding uppercase one; non-alphabetic\n\ +characters are left unchanged. For example:\n\ +\n\ +@example\n\ +@group\n\ +toupper (\"MiXeD cAsE 123\")\n\ + @result{} \"MIXED CASE 123\"\n\ +@end group\n\ +@end example\n\ +@seealso{tolower}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xtoupper (); + else + print_usage (); + + return retval; +} + +DEFALIAS (upper, toupper); + +/* +%!assert (toupper ("octave"), "OCTAVE") +%!assert (toupper ("123OCTave!_&"), "123OCTAVE!_&") +%!assert (toupper ({"abc", "def", {"ghi", {"jkl"}}}), {"ABC", "DEF", {"GHI", {"JKL"}}}) +%!assert (toupper (["abc"; "def"]), ["ABC"; "DEF"]) +%!assert (toupper ({["abc"; "def"]}), {["ABC";"DEF"]}) +%!assert (toupper (100), "D") +%!assert (toupper ({[100, 100; 100, 100]}), {["DD";"DD"]}) +%!test +%! a(3,3,3,3) = "d"; +%! assert (toupper (a)(3,3,3,3), "D"); +%!test +%! charset = char (0:127); +%! result = charset; +%! result (toascii ("a":"z") + 1) = result (toascii ("A":"Z") + 1); +%! assert (toupper (charset), result); + +%!error toupper () +%!error upper () +%!error toupper (1, 2) +*/ + +DEFALIAS (gammaln, lgamma); + +DEFALIAS (finite, isfinite); diff -r d02b229ce693 -r a132d206a36a src/corefcn/module.mk --- a/src/corefcn/module.mk Thu Aug 02 12:12:00 2012 +0200 +++ b/src/corefcn/module.mk Fri Aug 03 14:59:40 2012 -0400 @@ -1,7 +1,30 @@ EXTRA_DIST += \ corefcn/module.mk -corefcn_SRC = \ +## Options functions for Fortran packages like LSODE, DASPK. +## These are generated automagically by configure and Perl. +OPT_HANDLERS = \ + corefcn/DASPK-opts.cc \ + corefcn/DASRT-opts.cc \ + corefcn/DASSL-opts.cc \ + corefcn/LSODE-opts.cc \ + corefcn/Quad-opts.cc + +OPT_INC = \ + $(top_builddir)/liboctave/DASPK-opts.h \ + $(top_builddir)/liboctave/DASRT-opts.h \ + $(top_builddir)/liboctave/DASSL-opts.h \ + $(top_builddir)/liboctave/LSODE-opts.h \ + $(top_builddir)/liboctave/Quad-opts.h + +$(OPT_HANDLERS): corefcn/%.cc : $(top_builddir)/liboctave/%.in + $(PERL) $(top_srcdir)/build-aux/mk-opts.pl --opt-handler-fcns $< > $@-t + mv $@-t $@ + +$(OPT_INC) : %.h : %.in + $(MAKE) -C $(top_builddir)/liboctave $(@F) + +COREFCN_SRC = \ corefcn/__contourc__.cc \ corefcn/__dispatch__.cc \ corefcn/__lin_interpn__.cc \ @@ -10,6 +33,7 @@ corefcn/balance.cc \ corefcn/besselj.cc \ corefcn/betainc.cc \ + corefcn/bitfcns.cc \ corefcn/bsxfun.cc \ corefcn/cellfun.cc \ corefcn/colloc.cc \ @@ -40,6 +64,7 @@ corefcn/lsode.cc \ corefcn/lu.cc \ corefcn/luinc.cc \ + corefcn/mappers.cc \ corefcn/matrix_type.cc \ corefcn/max.cc \ corefcn/md5sum.cc \ @@ -53,18 +78,21 @@ corefcn/rcond.cc \ corefcn/regexp.cc \ corefcn/schur.cc \ + corefcn/sparse.cc \ corefcn/spparms.cc \ corefcn/sqrtm.cc \ corefcn/str2double.cc \ corefcn/strfind.cc \ + corefcn/strfns.cc \ corefcn/sub2ind.cc \ corefcn/svd.cc \ corefcn/syl.cc \ + corefcn/syscalls.cc \ corefcn/time.cc \ corefcn/tril.cc \ corefcn/typecast.cc noinst_LTLIBRARIES += corefcn/libcorefcn.la -corefcn_libcorefcn_la_SOURCES = $(corefcn_SRC) +corefcn_libcorefcn_la_SOURCES = $(COREFCN_SRC) diff -r d02b229ce693 -r a132d206a36a src/corefcn/sparse.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/sparse.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,268 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "variables.h" +#include "utils.h" +#include "pager.h" +#include "defun.h" +#include "gripes.h" +#include "quit.h" +#include "unwind-prot.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "ov-bool-sparse.h" + +DEFUN (issparse, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} issparse (@var{x})\n\ +Return true if @var{x} is a sparse matrix.\n\ +@seealso{ismatrix}\n\ +@end deftypefn") +{ + if (args.length () != 1) + { + print_usage (); + return octave_value (); + } + else + return octave_value (args(0).is_sparse_type ()); +} + +DEFUN (sparse, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{s} =} sparse (@var{a})\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv}, @var{m}, @var{n}, @var{nzmax})\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv})\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{s}, @var{m}, @var{n}, \"unique\")\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{m}, @var{n})\n\ +Create a sparse matrix from the full matrix or row, column, value triplets.\n\ +If @var{a} is a full matrix, convert it to a sparse matrix representation,\n\ +removing all zero values in the process.\n\ +\n\ +Given the integer index vectors @var{i} and @var{j}, a 1-by-@code{nnz} vector\n\ +of real of complex values @var{sv}, overall dimensions @var{m} and @var{n}\n\ +of the sparse matrix. The argument @code{nzmax} is ignored but accepted for\n\ +compatibility with @sc{matlab}. If @var{m} or @var{n} are not specified\n\ +their values are derived from the maximum index in the vectors @var{i} and\n\ +@var{j} as given by @code{@var{m} = max (@var{i})},\n\ +@code{@var{n} = max (@var{j})}.\n\ +\n\ +@strong{Note}: if multiple values are specified with the same\n\ +@var{i}, @var{j} indices, the corresponding values in @var{s} will\n\ +be added. See @code{accumarray} for an example of how to produce different\n\ +behavior, such as taking the minimum instead.\n\ +\n\ +The following are all equivalent:\n\ +\n\ +@example\n\ +@group\n\ +s = sparse (i, j, s, m, n)\n\ +s = sparse (i, j, s, m, n, \"summation\")\n\ +s = sparse (i, j, s, m, n, \"sum\")\n\ +@end group\n\ +@end example\n\ +\n\ +Given the option \"unique\". if more than two values are specified for the\n\ +same @var{i}, @var{j} indices, the last specified value will be used.\n\ +\n\ +@code{sparse (@var{m}, @var{n})} is equivalent to\n\ +@code{sparse ([], [], [], @var{m}, @var{n}, 0)}\n\ +\n\ +If any of @var{sv}, @var{i} or @var{j} are scalars, they are expanded\n\ +to have a common size.\n\ +@seealso{full, accumarray}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + // Temporarily disable sparse_auto_mutate if set (it's obsolete anyway). + unwind_protect frame; + frame.protect_var (Vsparse_auto_mutate); + Vsparse_auto_mutate = false; + + if (nargin == 1) + { + octave_value arg = args (0); + if (arg.is_bool_type ()) + retval = arg.sparse_bool_matrix_value (); + else if (arg.is_complex_type ()) + retval = arg.sparse_complex_matrix_value (); + else if (arg.is_numeric_type ()) + retval = arg.sparse_matrix_value (); + else + gripe_wrong_type_arg ("sparse", arg); + } + else if (nargin == 2) + { + octave_idx_type m = 0, n = 0; + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + { + m = args(0).idx_type_value (); + n = args(1).idx_type_value (); + } + else + error ("sparse: dimensions M,N must be scalar"); + + if (! error_state) + { + if (m >= 0 && n >= 0) + retval = SparseMatrix (m, n); + else + error ("sparse: dimensions M,N must be positive or zero"); + } + } + else if (nargin >= 3) + { + bool summation = true; + if (nargin > 3 && args(nargin-1).is_string ()) + { + std::string opt = args(nargin-1).string_value (); + if (opt == "unique") + summation = false; + else if (opt == "sum" || opt == "summation") + summation = true; + else + error ("sparse: invalid option: %s", opt.c_str ()); + + nargin -= 1; + } + + if (! error_state) + { + octave_idx_type m = -1, n = -1, nzmax = -1; + if (nargin == 6) + { + nzmax = args(5).idx_type_value (); + nargin --; + } + + if (nargin == 5) + { + if (args(3).is_scalar_type () && args(4).is_scalar_type ()) + { + m = args(3).idx_type_value (); + n = args(4).idx_type_value (); + } + else + error ("sparse: expecting scalar dimensions"); + + + if (! error_state && (m < 0 || n < 0)) + error ("sparse: dimensions must be non-negative"); + } + else if (nargin != 3) + print_usage (); + + if (! error_state) + { + idx_vector i = args(0).index_vector (); + idx_vector j = args(1).index_vector (); + + if (args(2).is_bool_type ()) + retval = SparseBoolMatrix (args(2).bool_array_value (), i, j, + m, n, summation, nzmax); + else if (args(2).is_complex_type ()) + retval = SparseComplexMatrix (args(2).complex_array_value (), + i, j, m, n, summation, nzmax); + else if (args(2).is_numeric_type ()) + retval = SparseMatrix (args(2).array_value (), i, j, + m, n, summation, nzmax); + else + gripe_wrong_type_arg ("sparse", args(2)); + } + + } + } + + return retval; +} + +DEFUN (spalloc, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{s} =} spalloc (@var{m}, @var{n}, @var{nz})\n\ +Create an @var{m}-by-@var{n} sparse matrix with pre-allocated space for at\n\ +most @var{nz} nonzero elements. This is useful for building the matrix\n\ +incrementally by a sequence of indexed assignments. Subsequent indexed\n\ +assignments will reuse the pre-allocated memory, provided they are of one of\n\ +the simple forms\n\ +\n\ +@itemize\n\ +@item @code{@var{s}(I:J) = @var{x}}\n\ +\n\ +@item @code{@var{s}(:,I:J) = @var{x}}\n\ +\n\ +@item @code{@var{s}(K:L,I:J) = @var{x}}\n\ +@end itemize\n\ +\n\ +@b{and} that the following conditions are met:\n\ +\n\ +@itemize\n\ +@item the assignment does not decrease nnz (@var{S}).\n\ +\n\ +@item after the assignment, nnz (@var{S}) does not exceed @var{nz}.\n\ +\n\ +@item no index is out of bounds.\n\ +@end itemize\n\ +\n\ +Partial movement of data may still occur, but in general the assignment will\n\ +be more memory and time-efficient under these circumstances. In particular,\n\ +it is possible to efficiently build a pre-allocated sparse matrix from\n\ +contiguous block of columns.\n\ +\n\ +The amount of pre-allocated memory for a given matrix may be queried using\n\ +the function @code{nzmax}.\n\ +@seealso{nzmax, sparse}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + octave_idx_type m = args(0).idx_type_value (); + octave_idx_type n = args(1).idx_type_value (); + octave_idx_type nz = 0; + if (nargin == 3) + nz = args(2).idx_type_value (); + if (error_state) + ; + else if (m >= 0 && n >= 0 && nz >= 0) + retval = SparseMatrix (dim_vector (m, n), nz); + else + error ("spalloc: M,N,NZ must be non-negative"); + } + else + print_usage (); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/corefcn/strfns.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/strfns.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,973 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "dMatrix.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "ov.h" +#include "oct-obj.h" +#include "unwind-prot.h" +#include "utils.h" + +DEFUN (char, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} char (@var{x})\n\ +@deftypefnx {Built-in Function} {} char (@var{x}, @dots{})\n\ +@deftypefnx {Built-in Function} {} char (@var{s1}, @var{s2}, @dots{})\n\ +@deftypefnx {Built-in Function} {} char (@var{cell_array})\n\ +Create a string array from one or more numeric matrices, character\n\ +matrices, or cell arrays. Arguments are concatenated vertically.\n\ +The returned values are padded with blanks as needed to make each row\n\ +of the string array have the same length. Empty input strings are\n\ +significant and will concatenated in the output.\n\ +\n\ +For numerical input, each element is converted\n\ +to the corresponding ASCII character. A range error results if an input\n\ +is outside the ASCII range (0-255).\n\ +\n\ +For cell arrays, each element is concatenated separately. Cell arrays\n\ +converted through\n\ +@code{char} can mostly be converted back with @code{cellstr}.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +char ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ + @result{} [\"abc \"\n\ + \" \"\n\ + \"98 \"\n\ + \"99 \"\n\ + \"d \"\n\ + \"str1 \"\n\ + \"half \"]\n\ +@end group\n\ +@end example\n\ +@seealso{strvcat, cellstr}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = ""; + else if (nargin == 1) + retval = args(0).convert_to_str (true, true, + args(0).is_dq_string () ? '"' : '\''); + else + { + int n_elts = 0; + + int max_len = 0; + + std::queue args_as_strings; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args(i).all_strings (); + + if (error_state) + { + error ("char: unable to convert some args to strings"); + return retval; + } + + if (s.length () > 0) + n_elts += s.length (); + else + n_elts += 1; + + int s_max_len = s.max_length (); + + if (s_max_len > max_len) + max_len = s_max_len; + + args_as_strings.push (s); + } + + string_vector result (n_elts); + + int k = 0; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args_as_strings.front (); + args_as_strings.pop (); + + int n = s.length (); + + if (n > 0) + { + for (int j = 0; j < n; j++) + { + std::string t = s[j]; + int t_len = t.length (); + + if (max_len > t_len) + t += std::string (max_len - t_len, ' '); + + result[k++] = t; + } + } + else + result[k++] = std::string (max_len, ' '); + } + + retval = octave_value (result, '\''); + } + + return retval; +} + +/* +%!assert (char (), ''); +%!assert (char (100), "d"); +%!assert (char (100,100), ["d";"d"]) +%!assert (char ({100,100}), ["d";"d"]) +%!assert (char ([100,100]), ["dd"]) +%!assert (char ({100,{100}}), ["d";"d"]) +%!assert (char (100, [], 100), ["d";" ";"d"]) +%!assert (char ({100, [], 100}), ["d";" ";"d"]) +%!assert (char ({100,{100, {""}}}), ["d";"d";" "]) +%!assert (char (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) +%!assert (char ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) +%!assert (char ([65, 83, 67, 73, 73]), "ASCII") + +%!test +%! x = char ("foo", "bar", "foobar"); +%! assert (x(1,:), "foo "); +%! assert (x(2,:), "bar "); +%! assert (x(3,:), "foobar"); +*/ + +DEFUN (strvcat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strvcat (@var{x})\n\ +@deftypefnx {Built-in Function} {} strvcat (@var{x}, @dots{})\n\ +@deftypefnx {Built-in Function} {} strvcat (@var{s1}, @var{s2}, @dots{})\n\ +@deftypefnx {Built-in Function} {} strvcat (@var{cell_array})\n\ +Create a character array from one or more numeric matrices, character\n\ +matrices, or cell arrays. Arguments are concatenated vertically.\n\ +The returned values are padded with blanks as needed to make each row\n\ +of the string array have the same length. Unlike @code{char}, empty\n\ +strings are removed and will not appear in the output.\n\ +\n\ +For numerical input, each element is converted\n\ +to the corresponding ASCII character. A range error results if an input\n\ +is outside the ASCII range (0-255).\n\ +\n\ +For cell arrays, each element is concatenated separately. Cell arrays\n\ +converted through\n\ +@code{strvcat} can mostly be converted back with @code{cellstr}.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +strvcat ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ + @result{} [\"abc \"\n\ + \"98 \"\n\ + \"99 \"\n\ + \"d \"\n\ + \"str1 \"\n\ + \"half \"]\n\ +@end group\n\ +@end example\n\ +@seealso{char, strcat, cstrcat}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin > 0) + { + int n_elts = 0; + + size_t max_len = 0; + + std::queue args_as_strings; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args(i).all_strings (); + + if (error_state) + { + error ("strvcat: unable to convert some args to strings"); + return retval; + } + + size_t n = s.length (); + + // do not count empty strings in calculation of number of elements + if (n > 0) + { + for (size_t j = 0; j < n; j++) + { + if (s[j].length () > 0) + n_elts++; + } + } + + size_t s_max_len = s.max_length (); + + if (s_max_len > max_len) + max_len = s_max_len; + + args_as_strings.push (s); + } + + string_vector result (n_elts); + + octave_idx_type k = 0; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args_as_strings.front (); + args_as_strings.pop (); + + size_t n = s.length (); + + if (n > 0) + { + for (size_t j = 0; j < n; j++) + { + std::string t = s[j]; + if (t.length () > 0) + { + size_t t_len = t.length (); + + if (max_len > t_len) + t += std::string (max_len - t_len, ' '); + + result[k++] = t; + } + } + } + } + + retval = octave_value (result, '\''); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strvcat (""), ""); +%!assert (strvcat (100) == "d"); +%!assert (strvcat (100,100), ["d";"d"]) +%!assert (strvcat ({100,100}), ["d";"d"]) +%!assert (strvcat ([100,100]), ["dd"]) +%!assert (strvcat ({100,{100}}), ["d";"d"]) +%!assert (strvcat (100, [], 100), ["d";"d"]) +%!assert (strvcat ({100, [], 100}), ["d";"d"]) +%!assert (strvcat ({100,{100, {""}}}), ["d";"d"]) +%!assert (strvcat (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) +%!assert (strvcat ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) + +%!error strvcat () +*/ + + +DEFUN (ischar, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ischar (@var{x})\n\ +Return true if @var{x} is a character array.\n\ +@seealso{isfloat, isinteger, islogical, isnumeric, iscellstr, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 && args(0).is_defined ()) + retval = args(0).is_string (); + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar ("a"), true) +%!assert (ischar (["ab";"cd"]), true) +%!assert (ischar ({"ab"}), false) +%!assert (ischar (1), false) +%!assert (ischar ([1, 2]), false) +%!assert (ischar ([]), false) +%!assert (ischar ([1, 2; 3, 4]), false) +%!assert (ischar (""), true) +%!assert (ischar ("test"), true) +%!assert (ischar (["test"; "ing"]), true) +%!assert (ischar (struct ("foo", "bar")), false) + +%!error ischar () +%!error ischar ("test", 1) +*/ + +static octave_value +do_strcmp_fun (const octave_value& arg0, const octave_value& arg1, + octave_idx_type n, const char *fcn_name, + bool (*array_op) (const charNDArray&, const charNDArray&, octave_idx_type), + bool (*str_op) (const std::string&, const std::string&, octave_idx_type)) + +{ + octave_value retval; + + bool s1_string = arg0.is_string (); + bool s1_cell = arg0.is_cell (); + bool s2_string = arg1.is_string (); + bool s2_cell = arg1.is_cell (); + + if (s1_string && s2_string) + retval = array_op (arg0.char_array_value (), arg1.char_array_value (), n); + else if ((s1_string && s2_cell) || (s1_cell && s2_string)) + { + octave_value str_val, cell_val; + + if (s1_string) + { + str_val = arg0; + cell_val = arg1; + } + else + { + str_val = arg1; + cell_val = arg0; + } + + const Cell cell = cell_val.cell_value (); + const string_vector str = str_val.all_strings (); + octave_idx_type r = str.length (); + + if (r == 0 || r == 1) + { + // Broadcast the string. + + boolNDArray output (cell_val.dims (), false); + + std::string s = r == 0 ? std::string () : str[0]; + + if (cell_val.is_cellstr ()) + { + const Array cellstr = cell_val.cellstr_value (); + for (octave_idx_type i = 0; i < cellstr.length (); i++) + output(i) = str_op (cellstr(i), s, n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < cell.length (); i++) + { + if (cell(i).is_string ()) + output(i) = str_op (cell(i).string_value (), s, n); + } + } + + retval = output; + } + else if (r > 1) + { + if (cell.length () == 1) + { + // Broadcast the cell. + + const dim_vector dv (r, 1); + boolNDArray output (dv, false); + + if (cell(0).is_string ()) + { + const std::string str2 = cell(0).string_value (); + + for (octave_idx_type i = 0; i < r; i++) + output(i) = str_op (str[i], str2, n); + } + + retval = output; + } + else + { + // Must match in all dimensions. + + boolNDArray output (cell.dims (), false); + + if (cell.length () == r) + { + if (cell_val.is_cellstr ()) + { + const Array cellstr = cell_val.cellstr_value (); + for (octave_idx_type i = 0; i < cellstr.length (); i++) + output(i) = str_op (str[i], cellstr(i), n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < r; i++) + { + if (cell(i).is_string ()) + output(i) = str_op (str[i], cell(i).string_value (), n); + } + } + + retval = output; + } + else + retval = false; + } + } + } + else if (s1_cell && s2_cell) + { + octave_value cell1_val, cell2_val; + octave_idx_type r1 = arg0.numel (), r2; + + if (r1 == 1) + { + // Make the singleton cell2. + + cell1_val = arg1; + cell2_val = arg0; + } + else + { + cell1_val = arg0; + cell2_val = arg1; + } + + const Cell cell1 = cell1_val.cell_value (); + const Cell cell2 = cell2_val.cell_value (); + r1 = cell1.numel (); + r2 = cell2.numel (); + + const dim_vector size1 = cell1.dims (); + const dim_vector size2 = cell2.dims (); + + boolNDArray output (size1, false); + + if (r2 == 1) + { + // Broadcast cell2. + + if (cell2(0).is_string ()) + { + const std::string str2 = cell2(0).string_value (); + + if (cell1_val.is_cellstr ()) + { + const Array cellstr = cell1_val.cellstr_value (); + for (octave_idx_type i = 0; i < cellstr.length (); i++) + output(i) = str_op (cellstr(i), str2, n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < r1; i++) + { + if (cell1(i).is_string ()) + { + const std::string str1 = cell1(i).string_value (); + output(i) = str_op (str1, str2, n); + } + } + } + } + } + else + { + if (size1 != size2) + { + error ("%s: nonconformant cell arrays", fcn_name); + return retval; + } + + if (cell1.is_cellstr () && cell2.is_cellstr ()) + { + const Array cellstr1 = cell1_val.cellstr_value (); + const Array cellstr2 = cell2_val.cellstr_value (); + for (octave_idx_type i = 0; i < r1; i++) + output (i) = str_op (cellstr1(i), cellstr2(i), n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < r1; i++) + { + if (cell1(i).is_string () && cell2(i).is_string ()) + { + const std::string str1 = cell1(i).string_value (); + const std::string str2 = cell2(i).string_value (); + output(i) = str_op (str1, str2, n); + } + } + } + } + + retval = output; + } + else + retval = false; + + return retval; +} + +// If both args are arrays, dimensions may be significant. +static bool +strcmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) +{ + return (s1.dims () == s2.dims () + && std::equal (s1.data (), s1.data () + s1.numel (), s2.data ())); +} + +// Otherwise, just use strings. +static bool +strcmp_str_op (const std::string& s1, const std::string& s2, + octave_idx_type) +{ + return s1 == s2; +} + +DEFUN (strcmp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strcmp (@var{s1}, @var{s2})\n\ +Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ +and 0 otherwise.\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +@seealso{strcmpi, strncmp, strncmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + retval = do_strcmp_fun (args (0), args (1), 0, + "strcmp", strcmp_array_op, strcmp_str_op); + } + else + print_usage (); + + return retval; +} + +/* +%!shared x +%! x = char (zeros (0, 2)); +%!assert (strcmp ("", x), false) +%!assert (strcmp (x, ""), false) +%!assert (strcmp (x, x), true) +## %!assert (strcmp ({""}, x), true) +## %!assert (strcmp ({x}, ""), false) +## %!assert (strcmp ({x}, x), true) +## %!assert (strcmp ("", {x}), false) +## %!assert (strcmp (x, {""}), false) +## %!assert (strcmp (x, {x}), true) +## %!assert (strcmp ({x; x}, ""), [false; false]) +## %!assert (strcmp ({x; x}, {""}), [false; false]) +## %!assert (strcmp ("", {x; x}), [false; false]) +## %!assert (strcmp ({""}, {x; x}), [false; false]) +%!assert (strcmp ({"foo"}, x), false) +%!assert (strcmp ({"foo"}, "foo"), true) +%!assert (strcmp ({"foo"}, x), false) +%!assert (strcmp (x, {"foo"}), false) +%!assert (strcmp ("foo", {"foo"}), true) +%!assert (strcmp (x, {"foo"}), false) +%!shared y +%! y = char (zeros (2, 0)); +%!assert (strcmp ("", y), false) +%!assert (strcmp (y, ""), false) +%!assert (strcmp (y, y), true) +%!assert (strcmp ({""}, y), [true; true]) +%!assert (strcmp ({y}, ""), true) +%!assert (strcmp ({y}, y), [true; true]) +%!assert (strcmp ("", {y}), true) +%!assert (strcmp (y, {""}), [true; true]) +%!assert (strcmp (y, {y}), [true; true]) +%!assert (strcmp ({y; y}, ""), [true; true]) +%!assert (strcmp ({y; y}, {""}), [true; true]) +%!assert (strcmp ("", {y; y}), [true; true]) +%!assert (strcmp ({""}, {y; y}), [true; true]) +%!assert (strcmp ({"foo"}, y), [false; false]) +%!assert (strcmp ({"foo"}, y), [false; false]) +%!assert (strcmp (y, {"foo"}), [false; false]) +%!assert (strcmp (y, {"foo"}), [false; false]) +%!assert (strcmp ("foobar", "foobar"), true) +%!assert (strcmp ("fooba", "foobar"), false) + +%!error strcmp () +%!error strcmp ("foo", "bar", 3) +*/ + +// Apparently, Matlab ignores the dims with strncmp. It also +static bool +strncmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.numel (), l2 = s2.numel (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data ())); +} + +// Otherwise, just use strings. Note that we neither extract substrings (which +// would mean a copy, at least in GCC), nor use string::compare (which is a +// 3-way compare). +static bool +strncmp_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.length (), l2 = s2.length (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data ())); +} + +DEFUN (strncmp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strncmp (@var{s1}, @var{s2}, @var{n})\n\ +Return 1 if the first @var{n} characters of strings @var{s1} and @var{s2} are\n\ +the same, and 0 otherwise.\n\ +\n\ +@example\n\ +@group\n\ +strncmp (\"abce\", \"abcd\", 3)\n\ + @result{} 1\n\ +@end group\n\ +@end example\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@example\n\ +@group\n\ +strncmp (\"abce\", @{\"abcd\", \"bca\", \"abc\"@}, 3)\n\ + @result{} [1, 0, 1]\n\ +@end group\n\ +@end example\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmp\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +@seealso{strncmpi, strcmp, strcmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 3) + { + octave_idx_type n = args(2).idx_type_value (); + + if (! error_state) + { + if (n > 0) + { + retval = do_strcmp_fun (args(0), args(1), n, "strncmp", + strncmp_array_op, strncmp_str_op); + } + else + error ("strncmp: N must be greater than 0"); + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strncmp ("abce", "abc", 3), true) +%!assert (strncmp (100, 100, 1), false) +%!assert (strncmp ("abce", {"abcd", "bca", "abc"}, 3), logical ([1, 0, 1])) +%!assert (strncmp ("abc", {"abcd", "bca", "abc"}, 4), logical ([0, 0, 0])) +%!assert (strncmp ({"abcd", "bca", "abc"},"abce", 3), logical ([1, 0, 1])) +%!assert (strncmp ({"abcd", "bca", "abc"},{"abcd", "bca", "abe"}, 3), logical ([1, 1, 0])) +%!assert (strncmp ("abc", {"abcd", 10}, 2), logical ([1, 0])) + +%!error strncmp () +%!error strncmp ("abc", "def") +*/ + +// case-insensitive character equality functor +struct icmp_char_eq : public std::binary_function +{ + bool operator () (char x, char y) const + { return std::toupper (x) == std::toupper (y); } +}; + +// strcmpi is equivalent to strcmp in that it checks all dims. +static bool +strcmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) +{ + return (s1.dims () == s2.dims () + && std::equal (s1.data (), s1.data () + s1.numel (), s2.data (), + icmp_char_eq ())); +} + +// Ditto for string. +static bool +strcmpi_str_op (const std::string& s1, const std::string& s2, + octave_idx_type) +{ + return (s1.size () == s2.size () + && std::equal (s1.data (), s1.data () + s1.size (), s2.data (), + icmp_char_eq ())); +} + +DEFUNX ("strcmpi", Fstrcmpi, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strcmpi (@var{s1}, @var{s2})\n\ +Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ +disregarding case of alphabetic characters, and 0 otherwise.\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +\n\ +@strong{Caution:} National alphabets are not supported.\n\ +@seealso{strcmp, strncmp, strncmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + retval = do_strcmp_fun (args (0), args (1), 0, + "strcmpi", strcmpi_array_op, strcmpi_str_op); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strcmpi ("abc123", "ABC123"), true) +*/ + +// Like strncmp. +static bool +strncmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.numel (), l2 = s2.numel (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data (), + icmp_char_eq ())); +} + +// Ditto. +static bool +strncmpi_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.length (), l2 = s2.length (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data (), + icmp_char_eq ())); +} + +DEFUNX ("strncmpi", Fstrncmpi, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strncmpi (@var{s1}, @var{s2}, @var{n})\n\ +Return 1 if the first @var{n} character of @var{s1} and @var{s2} are the\n\ +same, disregarding case of alphabetic characters, and 0 otherwise.\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmpi\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +\n\ +@strong{Caution:} National alphabets are not supported.\n\ +@seealso{strncmp, strcmp, strcmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 3) + { + octave_idx_type n = args(2).idx_type_value (); + + if (! error_state) + { + if (n > 0) + { + retval = do_strcmp_fun (args(0), args(1), n, "strncmpi", + strncmpi_array_op, strncmpi_str_op); + } + else + error ("strncmpi: N must be greater than 0"); + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strncmpi ("abc123", "ABC456", 3), true) +*/ + +DEFUN (list_in_columns, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} list_in_columns (@var{arg}, @var{width}, @var{prefix})\n\ +Return a string containing the elements of @var{arg} listed in\n\ +columns with an overall maximum width of @var{width} and optional\n\ +prefix @var{prefix}. The argument @var{arg} must be a cell array\n\ +of character strings or a character array. If @var{width} is not\n\ +specified or is an empty matrix, or less than or equal to zero,\n\ +the width of the terminal screen is used.\n\ +Newline characters are used to break the lines in the output string.\n\ +For example:\n\ +@c Set example in small font to prevent overfull line\n\ +\n\ +@smallexample\n\ +@group\n\ +list_in_columns (@{\"abc\", \"def\", \"ghijkl\", \"mnop\", \"qrs\", \"tuv\"@}, 20)\n\ + @result{} abc mnop\n\ + def qrs\n\ + ghijkl tuv\n\ +\n\ +whos ans\n\ + @result{}\n\ + Variables in the current scope:\n\ +\n\ + Attr Name Size Bytes Class\n\ + ==== ==== ==== ===== =====\n\ + ans 1x37 37 char\n\ +\n\ + Total is 37 elements using 37 bytes\n\ +@end group\n\ +@end smallexample\n\ +\n\ +@seealso{terminal_size}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 3) + { + print_usage (); + return retval; + } + + string_vector s = args(0).all_strings (); + + if (error_state) + { + error ("list_in_columns: expecting cellstr or char array"); + return retval; + } + + int width = -1; + + if (nargin > 1 && ! args(1).is_empty ()) + { + width = args(1).int_value (); + + if (error_state) + { + error ("list_in_columns: WIDTH must be an integer"); + return retval; + } + } + + std::string prefix; + + if (nargin > 2) + { + if (args(2).is_string ()) + { + prefix = args(2).string_value (); + + if (error_state) + { + error ("list_in_columns: PREFIX must be a character string"); + return retval; + } + } + else + { + error ("list_in_columns: PREFIX must be a character string"); + return retval; + } + } + + std::ostringstream buf; + + s.list_in_columns (buf, width, prefix); + + retval = buf.str (); + + return retval; +} + +/* +%!test +%! input = {"abc", "def", "ghijkl", "mnop", "qrs", "tuv"}; +%! result = "abc mnop\ndef qrs\nghijkl tuv\n"; +%! assert (list_in_columns (input, 20), result); +%!test +%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; +%! result = "abc mnop \ndef qrs \nghijkl tuv \n"; +%! assert (list_in_columns (input, 20), result); +%!test +%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; +%! result = " abc mnop \n def qrs \n ghijkl tuv \n"; +%! assert (list_in_columns (input, 20, " "), result); + +%!error list_in_columns () +%!error list_in_columns (["abc", "def"], 20, 2) +%!error list_in_columns (["abc", "def"], 20, " ", 3) +%!error list_in_columns (["abc", "def"], "a") +*/ diff -r d02b229ce693 -r a132d206a36a src/corefcn/syscalls.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/syscalls.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1943 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Thomas Baier added the original versions of +// the following functions: +// +// mkfifo unlink waitpid + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include + +#include + +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "oct-syscalls.h" +#include "oct-uname.h" + +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "lo-utils.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "oct-stdstrm.h" +#include "oct-stream.h" +#include "sysdep.h" +#include "utils.h" +#include "variables.h" +#include "input.h" + +static octave_scalar_map +mk_stat_map (const base_file_stat& fs) +{ + octave_scalar_map m; + + m.assign ("dev", static_cast (fs.dev ())); + m.assign ("ino", fs.ino ()); + m.assign ("mode", fs.mode ()); + m.assign ("modestr", fs.mode_as_string ()); + m.assign ("nlink", fs.nlink ()); + m.assign ("uid", fs.uid ()); + m.assign ("gid", fs.gid ()); +#if defined (HAVE_STRUCT_STAT_ST_RDEV) + m.assign ("rdev", static_cast (fs.rdev ())); +#endif + m.assign ("size", fs.size ()); + m.assign ("atime", fs.atime ()); + m.assign ("mtime", fs.mtime ()); + m.assign ("ctime", fs.ctime ()); +#if defined (HAVE_STRUCT_STAT_ST_BLKSIZE) + m.assign ("blksize", fs.blksize ()); +#endif +#if defined (HAVE_STRUCT_STAT_ST_BLOCKS) + m.assign ("blocks", fs.blocks ()); +#endif + + return m; +} + +static octave_value_list +mk_stat_result (const base_file_stat& fs) +{ + octave_value_list retval; + + if (fs) + { + retval(2) = std::string (); + retval(1) = 0; + retval(0) = octave_value (mk_stat_map (fs)); + } + else + { + retval(2) = fs.error (); + retval(1) = -1; + retval(0) = Matrix (); + } + + return retval; +} + +DEFUNX ("dup2", Fdup2, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} dup2 (@var{old}, @var{new})\n\ +Duplicate a file descriptor.\n\ +\n\ +If successful, @var{fid} is greater than zero and contains the new file\n\ +ID@. Otherwise, @var{fid} is negative and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + octave_stream old_stream + = octave_stream_list::lookup (args(0), "dup2"); + + if (! error_state) + { + octave_stream new_stream + = octave_stream_list::lookup (args(1), "dup2"); + + if (! error_state) + { + int i_old = old_stream.file_number (); + int i_new = new_stream.file_number (); + + if (i_old >= 0 && i_new >= 0) + { + std::string msg; + + int status = octave_syscalls::dup2 (i_old, i_new, msg); + + retval(1) = msg; + retval(0) = status; + } + } + } + else + error ("dup2: invalid stream"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("exec", Fexec, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} exec (@var{file}, @var{args})\n\ +Replace current process with a new process. Calling @code{exec} without\n\ +first calling @code{fork} will terminate your current Octave process and\n\ +replace it with the program named by @var{file}. For example,\n\ +\n\ +@example\n\ +exec (\"ls\" \"-l\")\n\ +@end example\n\ +\n\ +@noindent\n\ +will run @code{ls} and return you to your shell prompt.\n\ +\n\ +If successful, @code{exec} does not return. If @code{exec} does return,\n\ +@var{err} will be nonzero, and @var{msg} will contain a system-dependent\n\ +error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string exec_file = args(0).string_value (); + + if (! error_state) + { + string_vector exec_args; + + if (nargin == 2) + { + string_vector tmp = args(1).all_strings (); + + if (! error_state) + { + int len = tmp.length (); + + exec_args.resize (len + 1); + + exec_args[0] = exec_file; + + for (int i = 0; i < len; i++) + exec_args[i+1] = tmp[i]; + } + else + error ("exec: arguments must be character strings"); + } + else + { + exec_args.resize (1); + + exec_args[0] = exec_file; + } + + if (! error_state) + { + std::string msg; + + int status = octave_syscalls::execvp (exec_file, exec_args, msg); + + retval(1) = msg; + retval(0) = status; + } + } + else + error ("exec: FILE must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("popen2", Fpopen2, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{in}, @var{out}, @var{pid}] =} popen2 (@var{command}, @var{args})\n\ +Start a subprocess with two-way communication. The name of the process\n\ +is given by @var{command}, and @var{args} is an array of strings\n\ +containing options for the command. The file identifiers for the input\n\ +and output streams of the subprocess are returned in @var{in} and\n\ +@var{out}. If execution of the command is successful, @var{pid}\n\ +contains the process ID of the subprocess. Otherwise, @var{pid} is\n\ +@minus{}1.\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +[in, out, pid] = popen2 (\"sort\", \"-r\");\n\ +fputs (in, \"these\\nare\\nsome\\nstrings\\n\");\n\ +fclose (in);\n\ +EAGAIN = errno (\"EAGAIN\");\n\ +done = false;\n\ +do\n\ + s = fgets (out);\n\ + if (ischar (s))\n\ + fputs (stdout, s);\n\ + elseif (errno () == EAGAIN)\n\ + sleep (0.1);\n\ + fclear (out);\n\ + else\n\ + done = true;\n\ + endif\n\ +until (done)\n\ +fclose (out);\n\ +waitpid (pid);\n\ +\n\ + @print{} these\n\ + @print{} strings\n\ + @print{} some\n\ + @print{} are\n\ +@end example\n\ +\n\ +Note that @code{popen2}, unlike @code{popen}, will not \"reap\" the\n\ +child process. If you don't use @code{waitpid} to check the child's\n\ +exit status, it will linger until Octave exits.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = -1; + retval(1) = Matrix (); + retval(0) = Matrix (); + + int nargin = args.length (); + + if (nargin >= 1 && nargin <= 3) + { + std::string exec_file = args(0).string_value (); + + if (! error_state) + { + string_vector arg_list; + + if (nargin >= 2) + { + string_vector tmp = args(1).all_strings (); + + if (! error_state) + { + int len = tmp.length (); + + arg_list.resize (len + 1); + + arg_list[0] = exec_file; + + for (int i = 0; i < len; i++) + arg_list[i+1] = tmp[i]; + } + else + error ("popen2: arguments must be character strings"); + } + else + { + arg_list.resize (1); + + arg_list[0] = exec_file; + } + + if (! error_state) + { + bool sync_mode = (nargin == 3 ? args(2).bool_value () : false); + + if (! error_state) + { + int fildes[2]; + std::string msg; + pid_t pid; + + pid = octave_syscalls::popen2 (exec_file, arg_list, sync_mode, fildes, msg, interactive); + if (pid >= 0) + { + FILE *ifile = fdopen (fildes[1], "r"); + FILE *ofile = fdopen (fildes[0], "w"); + + std::string nm; + + octave_stream is = octave_stdiostream::create (nm, ifile, + std::ios::in); + + octave_stream os = octave_stdiostream::create (nm, ofile, + std::ios::out); + + Cell file_ids (1, 2); + + retval(2) = pid; + retval(1) = octave_stream_list::insert (is); + retval(0) = octave_stream_list::insert (os); + } + else + error (msg.c_str ()); + } + } + else + error ("popen2: arguments must be character strings"); + } + else + error ("popen2: COMMAND argument must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! if (isunix ()) +%! [in, out, pid] = popen2 ("sort", "-r"); +%! EAGAIN = errno ("EAGAIN"); +%! else +%! [in, out, pid] = popen2 ("sort", "/R"); +%! EAGAIN = errno ("EINVAL"); +%! endif +%! fputs (in, "these\nare\nsome\nstrings\n"); +%! fclose (in); +%! done = false; +%! str = {}; +%! idx = 0; +%! errs = 0; +%! do +%! if (!isunix ()) +%! errno (0); +%! endif +%! s = fgets (out); +%! if (ischar (s)) +%! idx++; +%! str{idx} = s; +%! elseif (errno () == EAGAIN) +%! fclear (out); +%! sleep (0.1); +%! if (++errs == 100) +%! done = true; +%! endif +%! else +%! done = true; +%! endif +%! until (done) +%! fclose (out); +%! if (isunix ()) +%! assert (str, {"these\n","strings\n","some\n","are\n"}); +%! else +%! assert (str, {"these\r\n","strings\r\n","some\r\n","are\r\n"}); +%! endif +*/ + +DEFUNX ("fcntl", Ffcntl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} fcntl (@var{fid}, @var{request}, @var{arg})\n\ +Change the properties of the open file @var{fid}. The following values\n\ +may be passed as @var{request}:\n\ +\n\ +@vtable @code\n\ +@item F_DUPFD\n\ +Return a duplicate file descriptor.\n\ +\n\ +@item F_GETFD\n\ +Return the file descriptor flags for @var{fid}.\n\ +\n\ +@item F_SETFD\n\ +Set the file descriptor flags for @var{fid}.\n\ +\n\ +@item F_GETFL\n\ +Return the file status flags for @var{fid}. The following codes may be\n\ +returned (some of the flags may be undefined on some systems).\n\ +\n\ +@vtable @code\n\ +@item O_RDONLY\n\ +Open for reading only.\n\ +\n\ +@item O_WRONLY\n\ +Open for writing only.\n\ +\n\ +@item O_RDWR\n\ +Open for reading and writing.\n\ +\n\ +@item O_APPEND\n\ +Append on each write.\n\ +\n\ +@item O_CREAT\n\ +Create the file if it does not exist.\n\ +\n\ +@item O_NONBLOCK\n\ +Non-blocking mode.\n\ +\n\ +@item O_SYNC\n\ +Wait for writes to complete.\n\ +\n\ +@item O_ASYNC\n\ +Asynchronous I/O.\n\ +@end vtable\n\ +\n\ +@item F_SETFL\n\ +Set the file status flags for @var{fid} to the value specified by\n\ +@var{arg}. The only flags that can be changed are @w{@code{O_APPEND}} and\n\ +@w{@code{O_NONBLOCK}}.\n\ +@end vtable\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 3) + { + octave_stream strm = octave_stream_list::lookup (args (0), "fcntl"); + + if (! error_state) + { + int fid = strm.file_number (); + + int req = args(1).int_value (true); + int arg = args(2).int_value (true); + + if (! error_state) + { + // FIXME -- Need better checking here? + if (fid < 0) + error ("fcntl: invalid file id"); + else + { + std::string msg; + + int status = octave_fcntl (fid, req, arg, msg); + + retval(1) = msg; + retval(0) = status; + } + } + } + else + error ("fcntl: FID, REQUEST, and ARG must be integers"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("fork", Ffork, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{pid}, @var{msg}] =} fork ()\n\ +Create a copy of the current process.\n\ +\n\ +Fork can return one of the following values:\n\ +\n\ +@table @asis\n\ +@item > 0\n\ +You are in the parent process. The value returned from @code{fork} is\n\ +the process id of the child process. You should probably arrange to\n\ +wait for any child processes to exit.\n\ +\n\ +@item 0\n\ +You are in the child process. You can call @code{exec} to start another\n\ +process. If that fails, you should probably call @code{exit}.\n\ +\n\ +@item < 0\n\ +The call to @code{fork} failed for some reason. You must take evasive\n\ +action. A system dependent error message will be waiting in @var{msg}.\n\ +@end table\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + std::string msg; + + pid_t pid = octave_syscalls::fork (msg); + + retval(1) = msg; + retval(0) = pid; + } + else + print_usage (); + + return retval; +} + +DEFUNX ("getpgrp", Fgetpgrp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {pgid =} getpgrp ()\n\ +Return the process group id of the current process.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + std::string msg; + + retval(1) = msg; + retval(0) = octave_syscalls::getpgrp (msg); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("getpid", Fgetpid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {pid =} getpid ()\n\ +Return the process id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getpid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getppid", Fgetppid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {pid =} getppid ()\n\ +Return the process id of the parent process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getppid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getegid", Fgetegid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {egid =} getegid ()\n\ +Return the effective group id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getegid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getgid", Fgetgid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {gid =} getgid ()\n\ +Return the real group id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getgid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("geteuid", Fgeteuid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {euid =} geteuid ()\n\ +Return the effective user id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::geteuid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getuid", Fgetuid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {uid =} getuid ()\n\ +Return the real user id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getuid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("kill", Fkill, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} kill (@var{pid}, @var{sig})\n\ +Send signal @var{sig} to process @var{pid}.\n\ +\n\ +If @var{pid} is positive, then signal @var{sig} is sent to @var{pid}.\n\ +\n\ +If @var{pid} is 0, then signal @var{sig} is sent to every process\n\ +in the process group of the current process.\n\ +\n\ +If @var{pid} is -1, then signal @var{sig} is sent to every process\n\ +except process 1.\n\ +\n\ +If @var{pid} is less than -1, then signal @var{sig} is sent to every\n\ +process in the process group @var{-pid}.\n\ +\n\ +If @var{sig} is 0, then no signal is sent, but error checking is still\n\ +performed.\n\ +\n\ +Return 0 if successful, otherwise return -1.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + if (args.length () == 2) + { + pid_t pid = args(0).int_value (true); + + if (! error_state) + { + int sig = args(1).int_value (true); + + if (! error_state) + { + std::string msg; + + int status = octave_syscalls::kill (pid, sig, msg); + + retval(1) = msg; + retval(0) = status; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("lstat", Flstat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{symlink})\n\ +Return a structure @var{info} containing information about the symbolic link\n\ +@var{symlink}. The function outputs are described in the documentation for\n\ +@code{stat}.\n\ +@seealso{stat}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + std::string fname = args(0).string_value (); + + if (! error_state) + { + file_stat fs (fname, false); + + retval = mk_stat_result (fs); + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("mkfifo", Fmkfifo, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} mkfifo (@var{name}, @var{mode})\n\ +Create a @var{fifo} special file named @var{name} with file mode @var{mode}\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + if (args(0).is_string ()) + { + std::string name = args(0).string_value (); + + if (args(1).is_scalar_type ()) + { + long mode = args(1).long_value (); + + if (! error_state) + { + std::string msg; + + int status = octave_mkfifo (name, mode, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + else + error ("mkfifo: invalid MODE"); + } + else + error ("mkfifo: MODE must be an integer"); + } + else + error ("mkfifo: FILE must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("pipe", Fpipe, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{read_fd}, @var{write_fd}, @var{err}, @var{msg}] =} pipe ()\n\ +Create a pipe and return the reading and writing ends of the pipe\n\ +into @var{read_fd} and @var{write_fd} respectively.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(3) = std::string (); + retval(2) = -1; + retval(1) = -1; + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + int fid[2]; + + std::string msg; + + int status = octave_syscalls::pipe (fid, msg); + + if (status < 0) + retval(3) = msg; + else + { + FILE *ifile = fdopen (fid[0], "r"); + FILE *ofile = fdopen (fid[1], "w"); + + std::string nm; + + octave_stream is = octave_stdiostream::create (nm, ifile, + std::ios::in); + + octave_stream os = octave_stdiostream::create (nm, ofile, + std::ios::out); + + retval(2) = status; + retval(1) = octave_stream_list::insert (os); + retval(0) = octave_stream_list::insert (is); + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("stat", Fstat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{file})\n\ +@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{fid})\n\ +@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{file})\n\ +@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{fid})\n\ +Return a structure @var{info} containing the following information about\n\ +@var{file} or file identifier @var{fid}.\n\ +\n\ +@table @code\n\ +@item dev\n\ +ID of device containing a directory entry for this file.\n\ +\n\ +@item ino\n\ +File number of the file.\n\ +\n\ +@item mode\n\ +File mode, as an integer. Use the functions @w{@code{S_ISREG}},\n\ +@w{@code{S_ISDIR}}, @w{@code{S_ISCHR}}, @w{@code{S_ISBLK}}, @w{@code{S_ISFIFO}},\n\ +@w{@code{S_ISLNK}}, or @w{@code{S_ISSOCK}} to extract information from this\n\ +value.\n\ +\n\ +@item modestr\n\ +File mode, as a string of ten letters or dashes as would be returned by\n\ +@kbd{ls -l}.\n\ +\n\ +@item nlink\n\ +Number of links.\n\ +\n\ +@item uid\n\ +User ID of file's owner.\n\ +\n\ +@item gid\n\ +Group ID of file's group.\n\ +\n\ +@item rdev\n\ +ID of device for block or character special files.\n\ +\n\ +@item size\n\ +Size in bytes.\n\ +\n\ +@item atime\n\ +Time of last access in the same form as time values returned from\n\ +@code{time}. @xref{Timing Utilities}.\n\ +\n\ +@item mtime\n\ +Time of last modification in the same form as time values returned from\n\ +@code{time}. @xref{Timing Utilities}.\n\ +\n\ +@item ctime\n\ +Time of last file status change in the same form as time values\n\ +returned from @code{time}. @xref{Timing Utilities}.\n\ +\n\ +@item blksize\n\ +Size of blocks in the file.\n\ +\n\ +@item blocks\n\ +Number of blocks allocated for file.\n\ +@end table\n\ +\n\ +If the call is successful @var{err} is 0 and @var{msg} is an empty\n\ +string. If the file does not exist, or some other error occurs, @var{info}\n\ +is an empty matrix, @var{err} is @minus{}1, and @var{msg} contains the\n\ +corresponding system error message.\n\ +\n\ +If @var{file} is a symbolic link, @code{stat} will return information\n\ +about the actual file that is referenced by the link. Use @code{lstat}\n\ +if you want information about the symbolic link itself.\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +[info, err, msg] = stat (\"/vmlinuz\")\n\ + @result{} info =\n\ + @{\n\ + atime = 855399756\n\ + rdev = 0\n\ + ctime = 847219094\n\ + uid = 0\n\ + size = 389218\n\ + blksize = 4096\n\ + mtime = 847219094\n\ + gid = 6\n\ + nlink = 1\n\ + blocks = 768\n\ + mode = -rw-r--r--\n\ + modestr = -rw-r--r--\n\ + ino = 9316\n\ + dev = 2049\n\ + @}\n\ + @result{} err = 0\n\ + @result{} msg =\n\ +@end example\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + if (args(0).is_scalar_type ()) + { + int fid = octave_stream_list::get_file_number (args(0)); + + if (! error_state) + { + file_fstat fs (fid); + + retval = mk_stat_result (fs); + } + } + else + { + std::string fname = args(0).string_value (); + + if (! error_state) + { + file_stat fs (fname); + + retval = mk_stat_result (fs); + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISREG", FS_ISREG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISREG (@var{mode})\n\ +Return true if @var{mode} corresponds to a regular file. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_reg (static_cast (mode)); + else + error ("S_ISREG: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISDIR", FS_ISDIR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISDIR (@var{mode})\n\ +Return true if @var{mode} corresponds to a directory. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_dir (static_cast (mode)); + else + error ("S_ISDIR: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISCHR", FS_ISCHR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISCHR (@var{mode})\n\ +Return true if @var{mode} corresponds to a character device. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_chr (static_cast (mode)); + else + error ("S_ISCHR: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISBLK", FS_ISBLK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISBLK (@var{mode})\n\ +Return true if @var{mode} corresponds to a block device. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_blk (static_cast (mode)); + else + error ("S_ISBLK: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISFIFO", FS_ISFIFO, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISFIFO (@var{mode})\n\ +Return true if @var{mode} corresponds to a fifo. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_fifo (static_cast (mode)); + else + error ("S_ISFIFO: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISLNK", FS_ISLNK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISLNK (@var{mode})\n\ +Return true if @var{mode} corresponds to a symbolic link. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_lnk (static_cast (mode)); + else + error ("S_ISLNK: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISSOCK", FS_ISSOCK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISSOCK (@var{mode})\n\ +Return true if @var{mode} corresponds to a socket. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_sock (static_cast (mode)); + else + error ("S_ISSOCK: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUN (gethostname, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} gethostname ()\n\ +Return the hostname of the system where Octave is running.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = octave_env::get_host_name (); + else + print_usage (); + + return retval; +} + +DEFUN (uname, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{uts}, @var{err}, @var{msg}] =} uname ()\n\ +Return system information in the structure. For example:\n\ +\n\ +@example\n\ +@group\n\ +uname ()\n\ + @result{} @{\n\ + sysname = x86_64\n\ + nodename = segfault\n\ + release = 2.6.15-1-amd64-k8-smp\n\ + version = Linux\n\ + machine = #2 SMP Thu Feb 23 04:57:49 UTC 2006\n\ + @}\n\ +@end group\n\ +@end example\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 0) + { + octave_uname sysinfo; + + octave_scalar_map m; + + m.assign ("sysname", sysinfo.sysname ()); + m.assign ("nodename", sysinfo.nodename ()); + m.assign ("release", sysinfo.release ()); + m.assign ("version", sysinfo.version ()); + m.assign ("machine", sysinfo.machine ()); + + retval(2) = sysinfo.message (); + retval(1) = sysinfo.error (); + retval(0) = m; + } + else + print_usage (); + + return retval; +} + +DEFUNX ("unlink", Funlink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} unlink (@var{file})\n\ +Delete the file named @var{file}.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + std::string name = args(0).string_value (); + + std::string msg; + + int status = octave_unlink (name, msg); + + retval(1) = msg; + retval(0) = status; + } + else + error ("unlink: FILE must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("waitpid", Fwaitpid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{pid}, @var{status}, @var{msg}] =} waitpid (@var{pid}, @var{options})\n\ +Wait for process @var{pid} to terminate. The @var{pid} argument can be:\n\ +\n\ +@table @asis\n\ +@item @minus{}1\n\ +Wait for any child process.\n\ +\n\ +@item 0\n\ +Wait for any child process whose process group ID is equal to that of\n\ +the Octave interpreter process.\n\ +\n\ +@item > 0\n\ +Wait for termination of the child process with ID @var{pid}.\n\ +@end table\n\ +\n\ +The @var{options} argument can be a bitwise OR of zero or more of\n\ +the following constants:\n\ +\n\ +@table @code\n\ +@item 0\n\ +Wait until signal is received or a child process exits (this is the\n\ +default if the @var{options} argument is missing).\n\ +\n\ +@item WNOHANG\n\ +Do not hang if status is not immediately available.\n\ +\n\ +@item WUNTRACED\n\ +Report the status of any child processes that are stopped, and whose\n\ +status has not yet been reported since they stopped.\n\ +\n\ +@item WCONTINUE\n\ +Return if a stopped child has been resumed by delivery of @code{SIGCONT}.\n\ +This value may not be meaningful on all systems.\n\ +@end table\n\ +\n\ +If the returned value of @var{pid} is greater than 0, it is the process\n\ +ID of the child process that exited. If an error occurs, @var{pid} will\n\ +be less than zero and @var{msg} will contain a system-dependent error\n\ +message. The value of @var{status} contains additional system-dependent\n\ +information about the subprocess that exited.\n\ +@seealso{WCONTINUE, WCOREDUMP, WEXITSTATUS, WIFCONTINUED, WIFSIGNALED, WIFSTOPPED, WNOHANG, WSTOPSIG, WTERMSIG, WUNTRACED}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = 0; + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + pid_t pid = args(0).int_value (true); + + if (! error_state) + { + int options = 0; + + if (args.length () == 2) + options = args(1).int_value (true); + + if (! error_state) + { + std::string msg; + + int status = 0; + + pid_t result = octave_syscalls::waitpid (pid, &status, options, msg); + + retval(2) = msg; + retval(1) = status; + retval(0) = result; + } + else + error ("waitpid: OPTIONS must be an integer"); + } + else + error ("waitpid: PID must be an integer value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("WIFEXITED", FWIFEXITED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFEXITED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child terminated normally.\n\ +@seealso{waitpid, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFEXITED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFEXITED (status); + else + error ("WIFEXITED: STATUS must be an integer"); + } +#else + warning ("WIFEXITED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WEXITSTATUS", FWEXITSTATUS, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WEXITSTATUS (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return the exit\n\ +status of the child. This function should only be employed if\n\ +@code{WIFEXITED} returned true.\n\ +@seealso{waitpid, WIFEXITED, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WEXITSTATUS) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WEXITSTATUS (status); + else + error ("WEXITSTATUS: STATUS must be an integer"); + } +#else + warning ("WEXITSTATUS always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WIFSIGNALED", FWIFSIGNALED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFSIGNALED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child process was terminated by a signal.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFSIGNALED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFSIGNALED (status); + else + error ("WIFSIGNALED: STATUS must be an integer"); + } +#else + warning ("WIFSIGNALED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WTERMSIG", FWTERMSIG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WTERMSIG (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return the number of\n\ +the signal that caused the child process to terminate. This function\n\ +should only be employed if @code{WIFSIGNALED} returned true.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WTERMSIG) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WTERMSIG (status); + else + error ("WTERMSIG: STATUS must be an integer"); + } +#else + warning ("WTERMSIG always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WCOREDUMP", FWCOREDUMP, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WCOREDUMP (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child produced a core dump. This function should only be employed if\n\ +@code{WIFSIGNALED} returned true. The macro used to implement this\n\ +function is not specified in POSIX.1-2001 and is not available on some\n\ +Unix implementations (e.g., AIX, SunOS).\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WCOREDUMP) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WCOREDUMP (status); + else + error ("WCOREDUMP: STATUS must be an integer"); + } +#else + warning ("WCOREDUMP always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WIFSTOPPED", FWIFSTOPPED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFSTOPPED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child process was stopped by delivery of a signal; this is only\n\ +possible if the call was done using @code{WUNTRACED} or when the child\n\ +is being traced (see ptrace(2)).\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFSTOPPED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFSTOPPED (status); + else + error ("WIFSTOPPED: STATUS must be an integer"); + } +#else + warning ("WIFSTOPPED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WSTOPSIG", FWSTOPSIG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WSTOPSIG (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return the number of\n\ +the signal which caused the child to stop. This function should only\n\ +be employed if @code{WIFSTOPPED} returned true.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WSTOPSIG) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WSTOPSIG (status); + else + error ("WSTOPSIG: STATUS must be an integer"); + } +#else + warning ("WSTOPSIG always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WIFCONTINUED", FWIFCONTINUED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFCONTINUED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child process was resumed by delivery of @code{SIGCONT}.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFCONTINUED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFCONTINUED (status); + else + error ("WIFCONTINUED: STATUS must be an integer"); + } +#else + warning ("WIFCONTINUED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("canonicalize_file_name", Fcanonicalize_file_name, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{cname}, @var{status}, @var{msg}] =} canonicalize_file_name (@var{fname})\n\ +Return the canonical name of file @var{fname}. If the file does not exist\n\ +the empty string (\"\") is returned.\n\ +@seealso{make_absolute_filename, is_absolute_filename, is_rooted_relative_filename}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + std::string msg; + + std::string result = octave_canonicalize_file_name (name, msg); + + retval(2) = msg; + retval(1) = msg.empty () ? 0 : -1; + retval(0) = result; + } + else + error ("canonicalize_file_name: NAME must be a character string"); + } + else + print_usage (); + + return retval; +} + +static octave_value +const_value (const octave_value_list& args, int val) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = val; + else + print_usage (); + + return retval; +} + +#if !defined (O_NONBLOCK) && defined (O_NDELAY) +#define O_NONBLOCK O_NDELAY +#endif + +DEFUNX ("F_DUPFD", FF_DUPFD, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_DUPFD ()\n\ +Return the numerical value to pass to @code{fcntl} to return a\n\ +duplicate file descriptor.\n\ +@seealso{fcntl, F_GETFD, F_GETFL, F_SETFD, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_DUPFD) + return const_value (args, F_DUPFD); +#else + error ("F_DUPFD: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_GETFD", FF_GETFD, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_GETFD ()\n\ +Return the numerical value to pass to @code{fcntl} to return the\n\ +file descriptor flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFL, F_SETFD, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_GETFD) + return const_value (args, F_GETFD); +#else + error ("F_GETFD: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_GETFL", FF_GETFL, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_GETFL ()\n\ +Return the numerical value to pass to @code{fcntl} to return the\n\ +file status flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFD, F_SETFD, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_GETFL) + return const_value (args, F_GETFL); +#else + error ("F_GETFL: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_SETFD", FF_SETFD, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_SETFD ()\n\ +Return the numerical value to pass to @code{fcntl} to set the file\n\ +descriptor flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_SETFD) + return const_value (args, F_SETFD); +#else + error ("F_SETFD: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_SETFL", FF_SETFL, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_SETFL ()\n\ +Return the numerical value to pass to @code{fcntl} to set the file\n\ +status flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFD}\n\ +@end deftypefn") +{ +#if defined (F_SETFL) + return const_value (args, F_SETFL); +#else + error ("F_SETFL: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_APPEND", FO_APPEND, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_APPEND ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate each write operation appends,\n\ +or that may be passed to @code{fcntl} to set the write mode to append.\n\ +@seealso{fcntl, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_APPEND) + return const_value (args, O_APPEND); +#else + error ("O_APPEND: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_ASYNC", FO_ASYNC, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_ASYNC ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate asynchronous I/O.\n\ +@seealso{fcntl, O_APPEND, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_ASYNC) + return const_value (args, O_ASYNC); +#else + error ("O_ASYNC: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_CREAT", FO_CREAT, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_CREAT ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file should be\n\ +created if it does not exist.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_CREAT) + return const_value (args, O_CREAT); +#else + error ("O_CREAT: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_EXCL", FO_EXCL, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_EXCL ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that file locking is used.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_EXCL) + return const_value (args, O_EXCL); +#else + error ("O_EXCL: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_NONBLOCK", FO_NONBLOCK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_NONBLOCK ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that non-blocking I/O is in use,\n\ +or that may be passsed to @code{fcntl} to set non-blocking I/O.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_NONBLOCK) + return const_value (args, O_NONBLOCK); +#else + error ("O_NONBLOCK: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_RDONLY", FO_RDONLY, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_RDONLY ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for\n\ +reading only.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_RDONLY) + return const_value (args, O_RDONLY); +#else + error ("O_RDONLY: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_RDWR", FO_RDWR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_RDWR ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for both\n\ +reading and writing.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_RDWR) + return const_value (args, O_RDWR); +#else + error ("O_RDWR: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_SYNC", FO_SYNC, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_SYNC ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for\n\ +synchronous I/O.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_SYNC) + return const_value (args, O_SYNC); +#else + error ("O_SYNC: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_TRUNC", FO_TRUNC, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} O_TRUNC ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that if file exists, it should\n\ +be truncated when writing.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_TRUNC) + return const_value (args, O_TRUNC); +#else + error ("O_TRUNC: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_WRONLY", FO_WRONLY, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_WRONLY ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for\n\ +writing only.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC}\n\ +@end deftypefn") +{ +#if defined (O_WRONLY) + return const_value (args, O_WRONLY); +#else + error ("O_WRONLY: not available on this system"); + return octave_value (); +#endif +} + +#if !defined (WNOHANG) +#define WNOHANG 0 +#endif + +DEFUNX ("WNOHANG", FWNOHANG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WNOHANG ()\n\ +Return the numerical value of the option argument that may be\n\ +passed to @code{waitpid} to indicate that it should return its\n\ +status immediately instead of waiting for a process to exit.\n\ +@seealso{waitpid, WUNTRACED, WCONTINUE}\n\ +@end deftypefn") +{ + return const_value (args, WNOHANG); +} + +#if !defined (WUNTRACED) +#define WUNTRACED 0 +#endif + +DEFUNX ("WUNTRACED", FWUNTRACED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WUNTRACED ()\n\ +Return the numerical value of the option argument that may be\n\ +passed to @code{waitpid} to indicate that it should also return\n\ +if the child process has stopped but is not traced via the\n\ +@code{ptrace} system call\n\ +@seealso{waitpid, WNOHANG, WCONTINUE}\n\ +@end deftypefn") +{ + return const_value (args, WUNTRACED); +} + +#if !defined (WCONTINUE) +#define WCONTINUE 0 +#endif + +DEFUNX ("WCONTINUE", FWCONTINUE, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WCONTINUE ()\n\ +Return the numerical value of the option argument that may be\n\ +passed to @code{waitpid} to indicate that it should also return\n\ +if a stopped child has been resumed by delivery of a @code{SIGCONT}\n\ +signal.\n\ +@seealso{waitpid, WNOHANG, WUNTRACED}\n\ +@end deftypefn") +{ + return const_value (args, WCONTINUE); +} diff -r d02b229ce693 -r a132d206a36a src/data.cc --- a/src/data.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7229 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton -Copyright (C) 2009 Jaroslav Hajek -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#ifdef HAVE_SYS_RESOURCE_H -#include -#endif - -#include -#include - -#include - -#include "lo-ieee.h" -#include "lo-math.h" -#include "oct-time.h" -#include "str-vec.h" -#include "quit.h" -#include "mx-base.h" -#include "oct-binmap.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-class.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-cx-sparse.h" -#include "parse.h" -#include "pt-mat.h" -#include "utils.h" -#include "variables.h" -#include "pager.h" -#include "xnorm.h" - -#if ! defined (CLOCKS_PER_SEC) -#if defined (CLK_TCK) -#define CLOCKS_PER_SEC CLK_TCK -#else -#error "no definition for CLOCKS_PER_SEC!" -#endif -#endif - -#if ! defined (HAVE_HYPOTF) && defined (HAVE__HYPOTF) -#define hypotf _hypotf -#define HAVE_HYPOTF 1 -#endif - -#define ANY_ALL(FCN) \ - \ - octave_value retval; \ - \ - int nargin = args.length (); \ - \ - if (nargin == 1 || nargin == 2) \ - { \ - int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ - \ - if (! error_state) \ - { \ - if (dim >= -1) \ - retval = args(0).FCN (dim); \ - else \ - error (#FCN ": invalid dimension argument = %d", dim + 1); \ - } \ - else \ - error (#FCN ": expecting dimension argument to be an integer"); \ - } \ - else \ - print_usage (); \ - \ - return retval - -DEFUN (all, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} all (@var{x})\n\ -@deftypefnx {Built-in Function} {} all (@var{x}, @var{dim})\n\ -For a vector argument, return true (logical 1) if all elements of the vector\n\ -are nonzero.\n\ -\n\ -For a matrix argument, return a row vector of logical ones and\n\ -zeros with each element indicating whether all of the elements of the\n\ -corresponding column of the matrix are nonzero. For example:\n\ -\n\ -@example\n\ -@group\n\ -all ([2, 3; 1, 0]))\n\ - @result{} [ 1, 0 ]\n\ -@end group\n\ -@end example\n\ -\n\ -If the optional argument @var{dim} is supplied, work along dimension\n\ -@var{dim}.\n\ -@seealso{any}\n\ -@end deftypefn") -{ - ANY_ALL (all); -} - -/* -%!test -%! x = ones (3); -%! x(1,1) = 0; -%! assert (all (all (rand (3) + 1) == [1, 1, 1]) == 1); -%! assert (all (all (x) == [0, 1, 1]) == 1); -%! assert (all (x, 1) == [0, 1, 1]); -%! assert (all (x, 2) == [0; 1; 1]); - -%!test -%! x = ones (3, "single"); -%! x(1,1) = 0; -%! assert (all (all (single (rand (3) + 1)) == [1, 1, 1]) == 1); -%! assert (all (all (x) == [0, 1, 1]) == 1); -%! assert (all (x, 1) == [0, 1, 1]); -%! assert (all (x, 2) == [0; 1; 1]); - -%!error all () -%!error all (1, 2, 3) -*/ - -DEFUN (any, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} any (@var{x})\n\ -@deftypefnx {Built-in Function} {} any (@var{x}, @var{dim})\n\ -For a vector argument, return true (logical 1) if any element of the vector\n\ -is nonzero.\n\ -\n\ -For a matrix argument, return a row vector of logical ones and\n\ -zeros with each element indicating whether any of the elements of the\n\ -corresponding column of the matrix are nonzero. For example:\n\ -\n\ -@example\n\ -@group\n\ -any (eye (2, 4))\n\ - @result{} [ 1, 1, 0, 0 ]\n\ -@end group\n\ -@end example\n\ -\n\ -If the optional argument @var{dim} is supplied, work along dimension\n\ -@var{dim}. For example:\n\ -\n\ -@example\n\ -@group\n\ -any (eye (2, 4), 2)\n\ - @result{} [ 1; 1 ]\n\ -@end group\n\ -@end example\n\ -@seealso{all}\n\ -@end deftypefn") -{ - ANY_ALL (any); -} - -/* -%!test -%! x = zeros (3); -%! x(3,3) = 1; -%! assert (all (any (x) == [0, 0, 1]) == 1); -%! assert (all (any (ones (3)) == [1, 1, 1]) == 1); -%! assert (any (x, 1) == [0, 0, 1]); -%! assert (any (x, 2) == [0; 0; 1]); - -%!test -%! x = zeros (3, "single"); -%! x(3,3) = 1; -%! assert (all (any (x) == [0, 0, 1]) == 1); -%! assert (all (any (ones (3, "single")) == [1, 1, 1]) == 1); -%! assert (any (x, 1) == [0, 0, 1]); -%! assert (any (x, 2) == [0; 0; 1]); - -%!error any () -%!error any (1, 2, 3) -*/ - -// These mapping functions may also be useful in other places, eh? - -DEFUN (atan2, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} atan2 (@var{y}, @var{x})\n\ -Compute atan (@var{y} / @var{x}) for corresponding elements of @var{y}\n\ -and @var{x}. Signal an error if @var{y} and @var{x} do not match in size\n\ -and orientation.\n\ -@seealso{tan, tand, tanh, atanh}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if (! args(0).is_numeric_type ()) - gripe_wrong_type_arg ("atan2", args(0)); - else if (! args(1).is_numeric_type ()) - gripe_wrong_type_arg ("atan2", args(1)); - else if (args(0).is_complex_type () || args(1).is_complex_type ()) - error ("atan2: not defined for complex numbers"); - else if (args(0).is_single_type () || args(1).is_single_type ()) - { - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - retval = atan2f (args(0).float_value (), args(1).float_value ()); - else - { - FloatNDArray a0 = args(0).float_array_value (); - FloatNDArray a1 = args(1).float_array_value (); - retval = binmap (a0, a1, ::atan2f, "atan2"); - } - } - else - { - bool a0_scalar = args(0).is_scalar_type (); - bool a1_scalar = args(1).is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = atan2 (args(0).scalar_value (), args(1).scalar_value ()); - else if ((a0_scalar || args(0).is_sparse_type ()) - && (a1_scalar || args(1).is_sparse_type ())) - { - SparseMatrix m0 = args(0).sparse_matrix_value (); - SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap (m0, m1, ::atan2, "atan2"); - } - else - { - NDArray a0 = args(0).array_value (); - NDArray a1 = args(1).array_value (); - retval = binmap (a0, a1, ::atan2, "atan2"); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (size (atan2 (zeros (0, 2), zeros (0, 2))), [0, 2]) -%!assert (size (atan2 (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) -%!assert (size (atan2 (rand (2, 3, 4), 1)), [2, 3, 4]) -%!assert (size (atan2 (1, rand (2, 3, 4))), [2, 3, 4]) -%!assert (size (atan2 (1, 2)), [1, 1]) - -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; -%! y = [0, rt3, 1, rt3, -rt3, -1, -rt3, 0]; -%! x = [1, 3, 1, 1, 1, 1, 3, 1]; -%! assert (atan2 (y, x), v, sqrt (eps)); - -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); -%! y = single ([0, rt3, 1, rt3, -rt3, -1, -rt3, 0]); -%! x = single ([1, 3, 1, 1, 1, 1, 3, 1]); -%! assert (atan2 (y, x), v, sqrt (eps ("single"))); - -%!error atan2 () -%!error atan2 (1, 2, 3) -*/ - - -static octave_value -do_hypot (const octave_value& x, const octave_value& y) -{ - octave_value retval; - - octave_value arg0 = x, arg1 = y; - if (! arg0.is_numeric_type ()) - gripe_wrong_type_arg ("hypot", arg0); - else if (! arg1.is_numeric_type ()) - gripe_wrong_type_arg ("hypot", arg1); - else - { - if (arg0.is_complex_type ()) - arg0 = arg0.abs (); - if (arg1.is_complex_type ()) - arg1 = arg1.abs (); - - if (arg0.is_single_type () || arg1.is_single_type ()) - { - if (arg0.is_scalar_type () && arg1.is_scalar_type ()) - retval = hypotf (arg0.float_value (), arg1.float_value ()); - else - { - FloatNDArray a0 = arg0.float_array_value (); - FloatNDArray a1 = arg1.float_array_value (); - retval = binmap (a0, a1, ::hypotf, "hypot"); - } - } - else - { - bool a0_scalar = arg0.is_scalar_type (); - bool a1_scalar = arg1.is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = hypot (arg0.scalar_value (), arg1.scalar_value ()); - else if ((a0_scalar || arg0.is_sparse_type ()) - && (a1_scalar || arg1.is_sparse_type ())) - { - SparseMatrix m0 = arg0.sparse_matrix_value (); - SparseMatrix m1 = arg1.sparse_matrix_value (); - retval = binmap (m0, m1, ::hypot, "hypot"); - } - else - { - NDArray a0 = arg0.array_value (); - NDArray a1 = arg1.array_value (); - retval = binmap (a0, a1, ::hypot, "hypot"); - } - } - } - - return retval; -} - -DEFUN (hypot, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} hypot (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} hypot (@var{x}, @var{y}, @var{z}, @dots{})\n\ -Compute the element-by-element square root of the sum of the squares of\n\ -@var{x} and @var{y}. This is equivalent to\n\ -@code{sqrt (@var{x}.^2 + @var{y}.^2)}, but calculated in a manner that\n\ -avoids overflows for large values of @var{x} or @var{y}.\n\ -@code{hypot} can also be called with more than 2 arguments; in this case,\n\ -the arguments are accumulated from left to right:\n\ -\n\ -@example\n\ -@group\n\ -hypot (hypot (@var{x}, @var{y}), @var{z})\n\ -hypot (hypot (hypot (@var{x}, @var{y}), @var{z}), @var{w}), etc.\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - retval = do_hypot (args(0), args(1)); - } - else if (nargin >= 3) - { - retval = args(0); - for (int i = 1; i < nargin && ! error_state; i++) - retval = do_hypot (retval, args(i)); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (size (hypot (zeros (0, 2), zeros (0, 2))), [0, 2]) -%!assert (size (hypot (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) -%!assert (size (hypot (rand (2, 3, 4), 1)), [2, 3, 4]) -%!assert (size (hypot (1, rand (2, 3, 4))), [2, 3, 4]) -%!assert (size (hypot (1, 2)), [1, 1]) -%!assert (hypot (1:10, 1:10), sqrt (2) * [1:10], 16*eps) -%!assert (hypot (single (1:10), single (1:10)), single (sqrt (2) * [1:10])) -*/ - -template -void -map_2_xlog2 (const Array& x, Array& f, Array& e) -{ - f = Array(x.dims ()); - e = Array(x.dims ()); - for (octave_idx_type i = 0; i < x.numel (); i++) - { - int exp; - f.xelem (i) = xlog2 (x(i), exp); - e.xelem (i) = exp; - } -} - -DEFUN (log2, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log2 (@var{x})\n\ -@deftypefnx {Mapping Function} {[@var{f}, @var{e}] =} log2 (@var{x})\n\ -Compute the base-2 logarithm of each element of @var{x}.\n\ -\n\ -If called with two output arguments, split @var{x} into\n\ -binary mantissa and exponent so that\n\ -@tex\n\ -${1 \\over 2} \\le \\left| f \\right| < 1$\n\ -@end tex\n\ -@ifnottex\n\ -@code{1/2 <= abs(f) < 1}\n\ -@end ifnottex\n\ -and @var{e} is an integer. If\n\ -@tex\n\ -$x = 0$, $f = e = 0$.\n\ -@end tex\n\ -@ifnottex\n\ -@code{x = 0}, @code{f = e = 0}.\n\ -@end ifnottex\n\ -@seealso{pow2, log, log10, exp}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - if (nargout < 2) - retval(0) = args(0).log2 (); - else if (args(0).is_single_type ()) - { - if (args(0).is_real_type ()) - { - FloatNDArray f; - FloatNDArray x = args(0).float_array_value (); - // FIXME -- should E be an int value? - FloatMatrix e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - else if (args(0).is_complex_type ()) - { - FloatComplexNDArray f; - FloatComplexNDArray x = args(0).float_complex_array_value (); - // FIXME -- should E be an int value? - FloatNDArray e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - } - else if (args(0).is_real_type ()) - { - NDArray f; - NDArray x = args(0).array_value (); - // FIXME -- should E be an int value? - Matrix e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - else if (args(0).is_complex_type ()) - { - ComplexNDArray f; - ComplexNDArray x = args(0).complex_array_value (); - // FIXME -- should E be an int value? - NDArray e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - else - gripe_wrong_type_arg ("log2", args(0)); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (log2 ([1/4, 1/2, 1, 2, 4]), [-2, -1, 0, 1, 2]) -%!assert (log2 (Inf), Inf) -%!assert (isnan (log2 (NaN))) -%!assert (log2 (4*i), 2 + log2 (1*i)) -%!assert (log2 (complex (0,Inf)), Inf + log2 (i)) - -%!test -%! [f, e] = log2 ([0,-1; 2,-4; Inf,-Inf]); -%! assert (f, [0,-0.5; 0.5,-0.5; Inf,-Inf]); -%! assert (e(1:2,:), [0,1;2,3]); - -%!test -%! [f, e] = log2 (complex (zeros (3, 2), [0,-1; 2,-4; Inf,-Inf])); -%! assert (f, complex (zeros (3, 2), [0,-0.5; 0.5,-0.5; Inf,-Inf])); -%! assert (e(1:2,:), [0,1; 2,3]); -*/ - -DEFUN (rem, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} rem (@var{x}, @var{y})\n\ -@deftypefnx {Mapping Function} {} fmod (@var{x}, @var{y})\n\ -Return the remainder of the division @code{@var{x} / @var{y}}, computed\n\ -using the expression\n\ -\n\ -@example\n\ -x - y .* fix (x ./ y)\n\ -@end example\n\ -\n\ -An error message is printed if the dimensions of the arguments do not\n\ -agree, or if either of the arguments is complex.\n\ -@seealso{mod}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if (! args(0).is_numeric_type ()) - gripe_wrong_type_arg ("rem", args(0)); - else if (! args(1).is_numeric_type ()) - gripe_wrong_type_arg ("rem", args(1)); - else if (args(0).is_complex_type () || args(1).is_complex_type ()) - error ("rem: not defined for complex numbers"); - else if (args(0).is_integer_type () || args(1).is_integer_type ()) - { - builtin_type_t btyp0 = args(0).builtin_type (); - builtin_type_t btyp1 = args(1).builtin_type (); - if (btyp0 == btyp_double || btyp0 == btyp_float) - btyp0 = btyp1; - if (btyp1 == btyp_double || btyp1 == btyp_float) - btyp1 = btyp0; - - if (btyp0 == btyp1) - { - switch (btyp0) - { -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - { \ - X##NDArray a0 = args(0).X##_array_value (); \ - X##NDArray a1 = args(1).X##_array_value (); \ - retval = binmap (a0, a1, rem, "rem"); \ - } \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - default: - panic_impossible (); - } - } - else - error ("rem: cannot combine %s and %d", - args(0).class_name ().c_str (), args(1).class_name ().c_str ()); - } - else if (args(0).is_single_type () || args(1).is_single_type ()) - { - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - retval = xrem (args(0).float_value (), args(1).float_value ()); - else - { - FloatNDArray a0 = args(0).float_array_value (); - FloatNDArray a1 = args(1).float_array_value (); - retval = binmap (a0, a1, xrem, "rem"); - } - } - else - { - bool a0_scalar = args(0).is_scalar_type (); - bool a1_scalar = args(1).is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = xrem (args(0).scalar_value (), args(1).scalar_value ()); - else if ((a0_scalar || args(0).is_sparse_type ()) - && (a1_scalar || args(1).is_sparse_type ())) - { - SparseMatrix m0 = args(0).sparse_matrix_value (); - SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap (m0, m1, xrem, "rem"); - } - else - { - NDArray a0 = args(0).array_value (); - NDArray a1 = args(1).array_value (); - retval = binmap (a0, a1, xrem, "rem"); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (rem ([1, 2, 3; -1, -2, -3], 2), [1, 0, 1; -1, 0, -1]) -%!assert (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3)),[1, 0, 1; -1, 0, -1]) -%!assert (rem (uint8 ([1, 2, 3; -1, -2, -3]), uint8 (2)), uint8 ([1, 0, 1; -1, 0, -1])) -%!assert (uint8 (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3))),uint8 ([1, 0, 1; -1, 0, -1])) - -%!error rem (uint (8), int8 (5)) -%!error rem (uint8 ([1, 2]), uint8 ([3, 4, 5])) -%!error rem () -%!error rem (1, 2, 3) -%!error rem ([1, 2], [3, 4, 5]) -%!error rem (i, 1) -*/ - -/* - -%!assert (size (fmod (zeros (0, 2), zeros (0, 2))), [0, 2]) -%!assert (size (fmod (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) -%!assert (size (fmod (rand (2, 3, 4), 1)), [2, 3, 4]) -%!assert (size (fmod (1, rand (2, 3, 4))), [2, 3, 4]) -%!assert (size (fmod (1, 2)), [1, 1]) -*/ - -DEFALIAS (fmod, rem) - -DEFUN (mod, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} mod (@var{x}, @var{y})\n\ -Compute the modulo of @var{x} and @var{y}. Conceptually this is given by\n\ -\n\ -@example\n\ -x - y .* floor (x ./ y)\n\ -@end example\n\ -\n\ -@noindent\n\ -and is written such that the correct modulus is returned for\n\ -integer types. This function handles negative values correctly. That\n\ -is, @code{mod (-1, 3)} is 2, not -1, as @code{rem (-1, 3)} returns.\n\ -@code{mod (@var{x}, 0)} returns @var{x}.\n\ -\n\ -An error results if the dimensions of the arguments do not agree, or if\n\ -either of the arguments is complex.\n\ -@seealso{rem}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if (! args(0).is_numeric_type ()) - gripe_wrong_type_arg ("mod", args(0)); - else if (! args(1).is_numeric_type ()) - gripe_wrong_type_arg ("mod", args(1)); - else if (args(0).is_complex_type () || args(1).is_complex_type ()) - error ("mod: not defined for complex numbers"); - else if (args(0).is_integer_type () || args(1).is_integer_type ()) - { - builtin_type_t btyp0 = args(0).builtin_type (); - builtin_type_t btyp1 = args(1).builtin_type (); - if (btyp0 == btyp_double || btyp0 == btyp_float) - btyp0 = btyp1; - if (btyp1 == btyp_double || btyp1 == btyp_float) - btyp1 = btyp0; - - if (btyp0 == btyp1) - { - switch (btyp0) - { -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - { \ - X##NDArray a0 = args(0).X##_array_value (); \ - X##NDArray a1 = args(1).X##_array_value (); \ - retval = binmap (a0, a1, mod, "mod"); \ - } \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - default: - panic_impossible (); - } - } - else - error ("mod: cannot combine %s and %d", - args(0).class_name ().c_str (), args(1).class_name ().c_str ()); - } - else if (args(0).is_single_type () || args(1).is_single_type ()) - { - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - retval = xmod (args(0).float_value (), args(1).float_value ()); - else - { - FloatNDArray a0 = args(0).float_array_value (); - FloatNDArray a1 = args(1).float_array_value (); - retval = binmap (a0, a1, xmod, "mod"); - } - } - else - { - bool a0_scalar = args(0).is_scalar_type (); - bool a1_scalar = args(1).is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = xmod (args(0).scalar_value (), args(1).scalar_value ()); - else if ((a0_scalar || args(0).is_sparse_type ()) - && (a1_scalar || args(1).is_sparse_type ())) - { - SparseMatrix m0 = args(0).sparse_matrix_value (); - SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap (m0, m1, xmod, "mod"); - } - else - { - NDArray a0 = args(0).array_value (); - NDArray a1 = args(1).array_value (); - retval = binmap (a0, a1, xmod, "mod"); - } - } - } - else - print_usage (); - - return retval; -} - -/* -## empty input test -%!assert (isempty (mod ([], []))) - -## x mod y, y != 0 tests -%!assert (mod (5, 3), 2) -%!assert (mod (-5, 3), 1) -%!assert (mod (0, 3), 0) -%!assert (mod ([-5, 5, 0], [3, 3, 3]), [1, 2, 0]) -%!assert (mod ([-5; 5; 0], [3; 3; 3]), [1; 2; 0]) -%!assert (mod ([-5, 5; 0, 3], [3, 3 ; 3, 1]), [1, 2 ; 0, 0]) - -## x mod 0 tests -%!assert (mod (5, 0), 5) -%!assert (mod (-5, 0), -5) -%!assert (mod ([-5, 5, 0], [3, 0, 3]), [1, 5, 0]) -%!assert (mod ([-5; 5; 0], [3; 0; 3]), [1; 5; 0]) -%!assert (mod ([-5, 5; 0, 3], [3, 0 ; 3, 1]), [1, 5 ; 0, 0]) -%!assert (mod ([-5, 5; 0, 3], [0, 0 ; 0, 0]), [-5, 5; 0, 3]) - -## mixed scalar/matrix tests -%!assert (mod ([-5, 5; 0, 3], 0), [-5, 5; 0, 3]) -%!assert (mod ([-5, 5; 0, 3], 3), [1, 2; 0, 0]) -%!assert (mod (-5, [0,0; 0,0]), [-5, -5; -5, -5]) -%!assert (mod (-5, [3,0; 3,1]), [1, -5; 1, 0]) -%!assert (mod (-5, [3,2; 3,1]), [1, 1; 1, 0]) - -## integer types -%!assert (mod (uint8 (5), uint8 (4)), uint8 (1)) -%!assert (mod (uint8 ([1:5]), uint8 (4)), uint8 ([1,2,3,0,1])) -%!assert (mod (uint8 ([1:5]), uint8 (0)), uint8 ([1:5])) -%!error (mod (uint8 (5), int8 (4))) - -## mixed integer/real types -%!assert (mod (uint8 (5), 4), uint8 (1)) -%!assert (mod (5, uint8 (4)), uint8 (1)) -%!assert (mod (uint8 ([1:5]), 4), uint8 ([1,2,3,0,1])) - -## non-integer real numbers -%!assert (mod (2.1, 0.1), 0) -%!assert (mod (2.1, 0.2), 0.1, eps) -*/ - -// FIXME: Need to convert the reduction functions of this file for single precision - -#define NATIVE_REDUCTION_1(FCN, TYPE, DIM) \ - (arg.is_ ## TYPE ## _type ()) \ - { \ - TYPE ## NDArray tmp = arg. TYPE ##_array_value (); \ - \ - if (! error_state) \ - { \ - retval = tmp.FCN (DIM); \ - } \ - } - -#define NATIVE_REDUCTION(FCN, BOOL_FCN) \ - \ - octave_value retval; \ - \ - int nargin = args.length (); \ - \ - bool isnative = false; \ - bool isdouble = false; \ - \ - if (nargin > 1 && args(nargin - 1).is_string ()) \ - { \ - std::string str = args(nargin - 1).string_value (); \ - \ - if (! error_state) \ - { \ - if (str == "native") \ - isnative = true; \ - else if (str == "double") \ - isdouble = true; \ - else \ - error ("sum: unrecognized string argument"); \ - nargin --; \ - } \ - } \ - \ - if (nargin == 1 || nargin == 2) \ - { \ - octave_value arg = args(0); \ - \ - int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ - \ - if (! error_state) \ - { \ - if (dim >= -1) \ - { \ - if (arg.is_sparse_type ()) \ - { \ - if (arg.is_real_type ()) \ - { \ - SparseMatrix tmp = arg.sparse_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else \ - { \ - if (isnative) \ - { \ - if NATIVE_REDUCTION_1 (FCN, uint8, dim) \ - else if NATIVE_REDUCTION_1 (FCN, uint16, dim) \ - else if NATIVE_REDUCTION_1 (FCN, uint32, dim) \ - else if NATIVE_REDUCTION_1 (FCN, uint64, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int8, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int16, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int32, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int64, dim) \ - else if (arg.is_bool_type ()) \ - { \ - boolNDArray tmp = arg.bool_array_value (); \ - if (! error_state) \ - retval = boolNDArray (tmp.BOOL_FCN (dim)); \ - } \ - else if (arg.is_char_matrix ()) \ - { \ - error (#FCN, ": invalid char type"); \ - } \ - else if (!isdouble && arg.is_single_type ()) \ - { \ - if (arg.is_complex_type ()) \ - { \ - FloatComplexNDArray tmp = \ - arg.float_complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_real_type ()) \ - { \ - FloatNDArray tmp = arg.float_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else if (arg.is_complex_type ()) \ - { \ - ComplexNDArray tmp = arg.complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_real_type ()) \ - { \ - NDArray tmp = arg.array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - gripe_wrong_type_arg (#FCN, arg); \ - return retval; \ - } \ - } \ - else if (arg.is_bool_type ()) \ - { \ - boolNDArray tmp = arg.bool_array_value (); \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (!isdouble && arg.is_single_type ()) \ - { \ - if (arg.is_real_type ()) \ - { \ - FloatNDArray tmp = arg.float_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_complex_type ()) \ - { \ - FloatComplexNDArray tmp = \ - arg.float_complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else if (arg.is_real_type ()) \ - { \ - NDArray tmp = arg.array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_complex_type ()) \ - { \ - ComplexNDArray tmp = arg.complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - gripe_wrong_type_arg (#FCN, arg); \ - return retval; \ - } \ - } \ - } \ - else \ - error (#FCN ": invalid dimension argument = %d", dim + 1); \ - } \ - \ - } \ - else \ - print_usage (); \ - \ - return retval - -#define DATA_REDUCTION(FCN) \ - \ - octave_value retval; \ - \ - int nargin = args.length (); \ - \ - if (nargin == 1 || nargin == 2) \ - { \ - octave_value arg = args(0); \ - \ - int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ - \ - if (! error_state) \ - { \ - if (dim >= -1) \ - { \ - if (arg.is_real_type ()) \ - { \ - if (arg.is_sparse_type ()) \ - { \ - SparseMatrix tmp = arg.sparse_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_single_type ()) \ - { \ - FloatNDArray tmp = arg.float_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - NDArray tmp = arg.array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else if (arg.is_complex_type ()) \ - { \ - if (arg.is_sparse_type ()) \ - { \ - SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_single_type ()) \ - { \ - FloatComplexNDArray tmp = arg.float_complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - ComplexNDArray tmp = arg.complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else \ - { \ - gripe_wrong_type_arg (#FCN, arg); \ - return retval; \ - } \ - } \ - else \ - error (#FCN ": invalid dimension argument = %d", dim + 1); \ - } \ - } \ - else \ - print_usage (); \ - \ - return retval - -DEFUN (cumprod, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cumprod (@var{x})\n\ -@deftypefnx {Built-in Function} {} cumprod (@var{x}, @var{dim})\n\ -Cumulative product of elements along dimension @var{dim}. If\n\ -@var{dim} is omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -@seealso{prod, cumsum}\n\ -@end deftypefn") -{ - DATA_REDUCTION (cumprod); -} - -/* -%!assert (cumprod ([1, 2, 3]), [1, 2, 6]) -%!assert (cumprod ([-1; -2; -3]), [-1; 2; -6]) -%!assert (cumprod ([i, 2+i, -3+2i, 4]), [i, -1+2i, -1-8i, -4-32i]) -%!assert (cumprod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i]) - -%!assert (cumprod (single ([1, 2, 3])), single ([1, 2, 6])) -%!assert (cumprod (single ([-1; -2; -3])), single ([-1; 2; -6])) -%!assert (cumprod (single ([i, 2+i, -3+2i, 4])), single ([i, -1+2i, -1-8i, -4-32i])) -%!assert (cumprod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i])) - -%!assert (cumprod ([2, 3; 4, 5], 1), [2, 3; 8, 15]) -%!assert (cumprod ([2, 3; 4, 5], 2), [2, 6; 4, 20]) - -%!assert (cumprod (single ([2, 3; 4, 5]), 1), single ([2, 3; 8, 15])) -%!assert (cumprod (single ([2, 3; 4, 5]), 2), single ([2, 6; 4, 20])) - -%!error cumprod () -*/ - -DEFUN (cumsum, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cumsum (@var{x})\n\ -@deftypefnx {Built-in Function} {} cumsum (@var{x}, @var{dim})\n\ -@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"native\")\n\ -@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"double\")\n\ -@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"extra\")\n\ -Cumulative sum of elements along dimension @var{dim}. If @var{dim}\n\ -is omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -See @code{sum} for an explanation of the optional parameters \"native\",\n\ -\"double\", and \"extra\".\n\ -@seealso{sum, cumprod}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - bool isnative = false; - bool isdouble = false; - - if (nargin > 1 && args(nargin - 1).is_string ()) - { - std::string str = args(nargin - 1).string_value (); - - if (! error_state) - { - if (str == "native") - isnative = true; - else if (str == "double") - isdouble = true; - else - error ("sum: unrecognized string argument"); - nargin --; - } - } - - if (error_state) - return retval; - - if (nargin == 1 || nargin == 2) - { - octave_value arg = args(0); - - int dim = -1; - if (nargin == 2) - { - dim = args(1).int_value () - 1; - if (dim < 0) - error ("cumsum: invalid dimension argument = %d", dim + 1); - } - - if (! error_state) - { - switch (arg.builtin_type ()) - { - case btyp_double: - if (arg.is_sparse_type ()) - retval = arg.sparse_matrix_value ().cumsum (dim); - else - retval = arg.array_value ().cumsum (dim); - break; - case btyp_complex: - if (arg.is_sparse_type ()) - retval = arg.sparse_complex_matrix_value ().cumsum (dim); - else - retval = arg.complex_array_value ().cumsum (dim); - break; - case btyp_float: - if (isdouble) - retval = arg.array_value ().cumsum (dim); - else - retval = arg.float_array_value ().cumsum (dim); - break; - case btyp_float_complex: - if (isdouble) - retval = arg.complex_array_value ().cumsum (dim); - else - retval = arg.float_complex_array_value ().cumsum (dim); - break; - -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - if (isnative) \ - retval = arg.X ## _array_value ().cumsum (dim); \ - else \ - retval = arg.array_value ().cumsum (dim); \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - - case btyp_bool: - if (arg.is_sparse_type ()) - { - SparseMatrix cs = arg.sparse_matrix_value ().cumsum (dim); - if (isnative) - retval = cs != 0.0; - else - retval = cs; - } - else - { - NDArray cs = arg.bool_array_value ().cumsum (dim); - if (isnative) - retval = cs != 0.0; - else - retval = cs; - } - break; - - default: - gripe_wrong_type_arg ("cumsum", arg); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (cumsum ([1, 2, 3]), [1, 3, 6]) -%!assert (cumsum ([-1; -2; -3]), [-1; -3; -6]) -%!assert (cumsum ([i, 2+i, -3+2i, 4]), [i, 2+2i, -1+4i, 3+4i]) -%!assert (cumsum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i]) - -%!assert (cumsum (single ([1, 2, 3])), single ([1, 3, 6])) -%!assert (cumsum (single ([-1; -2; -3])), single ([-1; -3; -6])) -%!assert (cumsum (single ([i, 2+i, -3+2i, 4])), single ([i, 2+2i, -1+4i, 3+4i])) -%!assert (cumsum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i])) - -%!assert (cumsum ([1, 2; 3, 4], 1), [1, 2; 4, 6]) -%!assert (cumsum ([1, 2; 3, 4], 2), [1, 3; 3, 7]) - -%!assert (cumsum (single ([1, 2; 3, 4]), 1), single ([1, 2; 4, 6])) -%!assert (cumsum (single ([1, 2; 3, 4]), 2), single ([1, 3; 3, 7])) - -%!error cumsum () -*/ - -DEFUN (diag, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{M} =} diag (@var{v})\n\ -@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{k})\n\ -@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M})\n\ -@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M}, @var{k})\n\ -Return a diagonal matrix with vector @var{v} on diagonal @var{k}. The\n\ -second argument is optional. If it is positive, the vector is placed on\n\ -the @var{k}-th super-diagonal. If it is negative, it is placed on the\n\ -@var{-k}-th sub-diagonal. The default value of @var{k} is 0, and the\n\ -vector is placed on the main diagonal. For example:\n\ -\n\ -@example\n\ -@group\n\ -diag ([1, 2, 3], 1)\n\ - @result{} 0 1 0 0\n\ - 0 0 2 0\n\ - 0 0 0 3\n\ - 0 0 0 0\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -The 3-input form returns a diagonal matrix with vector @var{v} on the main\n\ -diagonal and the resulting matrix being of size @var{m} rows x @var{n}\n\ -columns.\n\ -\n\ -Given a matrix argument, instead of a vector, @code{diag} extracts the\n\ -@var{k}-th diagonal of the matrix.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 && args(0).is_defined ()) - retval = args(0).diag (); - else if (nargin == 2 && args(0).is_defined () && args(1).is_defined ()) - { - octave_idx_type k = args(1).int_value (); - - if (error_state) - error ("diag: invalid argument K"); - else - retval = args(0).diag (k); - } - else if (nargin == 3) - { - octave_value arg0 = args(0); - - if (arg0.ndims () == 2 && (arg0.rows () == 1 || arg0.columns () == 1)) - { - octave_idx_type m = args(1).int_value (); - octave_idx_type n = args(2).int_value (); - - if (! error_state) - retval = arg0.diag (m, n); - else - error ("diag: invalid dimensions"); - } - else - error ("diag: V must be a vector"); - } - else - print_usage (); - - return retval; -} - -/* - -%!assert (full (diag ([1; 2; 3])), [1, 0, 0; 0, 2, 0; 0, 0, 3]) -%!assert (diag ([1; 2; 3], 1), [0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]) -%!assert (diag ([1; 2; 3], 2), [0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0]) -%!assert (diag ([1; 2; 3],-1), [0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]) -%!assert (diag ([1; 2; 3],-2), [0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0]) - -%!assert (diag ([1, 0, 0; 0, 2, 0; 0, 0, 3]), [1; 2; 3]) -%!assert (diag ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0], 1), [1; 2; 3]) -%!assert (diag ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0], -1), [1; 2; 3]) -%!assert (diag (ones (1, 0), 2), zeros (2)) -%!assert (diag (1:3, 4, 2), [1, 0; 0, 2; 0, 0; 0, 0]) - -%!assert (full (diag (single ([1; 2; 3]))), single ([1, 0, 0; 0, 2, 0; 0, 0, 3])) -%!assert (diag (single ([1; 2; 3]), 1), single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) -%!assert (diag (single ([1; 2; 3]), 2), single ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) -%!assert (diag (single ([1; 2; 3]),-1), single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) -%!assert (diag (single ([1; 2; 3]),-2), single ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) - -%!assert (diag (single ([1, 0, 0; 0, 2, 0; 0, 0, 3])), single ([1; 2; 3])) -%!assert (diag (single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), single ([1; 2; 3])) -%!assert (diag (single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), single ([1; 2; 3])) - -%!assert (diag (int8 ([1; 2; 3])), int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])) -%!assert (diag (int8 ([1; 2; 3]), 1), int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) -%!assert (diag (int8 ([1; 2; 3]), 2), int8 ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) -%!assert (diag (int8 ([1; 2; 3]),-1), int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) -%!assert (diag (int8 ([1; 2; 3]),-2), int8 ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) - -%!assert (diag (int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])), int8 ([1; 2; 3])) -%!assert (diag (int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), int8 ([1; 2; 3])) -%!assert (diag (int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), int8 ([1; 2; 3])) - -## Test non-square size -%!assert (diag ([1,2,3], 6, 3), [1 0 0; 0 2 0; 0 0 3; 0 0 0; 0 0 0; 0 0 0]) -%!assert (diag (1, 2, 3), [1,0,0; 0,0,0]); -%!assert (diag ({1}, 2, 3), {1,[],[]; [],[],[]}); -%!assert (diag ({1,2}, 3, 4), {1,[],[],[]; [],2,[],[]; [],[],[],[]}); - -%% Test input validation -%!error diag () -%!error diag (1,2,3,4) -%!error diag (ones (2), 3, 3) -%!error diag (1:3, -4, 3) - -%!assert (diag (1, 3, 3), diag ([1, 0, 0])) -%!assert (diag (i, 3, 3), diag ([i, 0, 0])) -%!assert (diag (single (1), 3, 3), diag ([single(1), 0, 0])) -%!assert (diag (single (i), 3, 3), diag ([single(i), 0, 0])) -%!assert (diag ([1, 2], 3, 3), diag ([1, 2, 0])) -%!assert (diag ([1, 2]*i, 3, 3), diag ([1, 2, 0]*i)) -%!assert (diag (single ([1, 2]), 3, 3), diag (single ([1, 2, 0]))) -%!assert (diag (single ([1, 2]*i), 3, 3), diag (single ([1, 2, 0]*i))) -*/ - -DEFUN (prod, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} prod (@var{x})\n\ -@deftypefnx {Built-in Function} {} prod (@var{x}, @var{dim})\n\ -Product of elements along dimension @var{dim}. If @var{dim} is\n\ -omitted, it defaults to the first non-singleton dimension.\n\ -@seealso{cumprod, sum}\n\ -@end deftypefn") -{ - DATA_REDUCTION (prod); -} - -/* -%!assert (prod ([1, 2, 3]), 6) -%!assert (prod ([-1; -2; -3]), -6) -%!assert (prod ([i, 2+i, -3+2i, 4]), -4 - 32i) -%!assert (prod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [-1+i, -8+8i, -27+27i]) - -%!assert (prod (single ([1, 2, 3])), single (6)) -%!assert (prod (single ([-1; -2; -3])), single (-6)) -%!assert (prod (single ([i, 2+i, -3+2i, 4])), single (-4 - 32i)) -%!assert (prod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([-1+i, -8+8i, -27+27i])) - -%!assert (prod ([1, 2; 3, 4], 1), [3, 8]) -%!assert (prod ([1, 2; 3, 4], 2), [2; 12]) -%!assert (prod (zeros (1, 0)), 1) -%!assert (prod (zeros (1, 0), 1), zeros (1, 0)) -%!assert (prod (zeros (1, 0), 2), 1) -%!assert (prod (zeros (0, 1)), 1) -%!assert (prod (zeros (0, 1), 1), 1) -%!assert (prod (zeros (0, 1), 2), zeros (0, 1)) -%!assert (prod (zeros (2, 0)), zeros (1, 0)) -%!assert (prod (zeros (2, 0), 1), zeros (1, 0)) -%!assert (prod (zeros (2, 0), 2), [1; 1]) -%!assert (prod (zeros (0, 2)), [1, 1]) -%!assert (prod (zeros (0, 2), 1), [1, 1]) -%!assert (prod (zeros (0, 2), 2), zeros (0, 1)) - -%!assert (prod (single ([1, 2; 3, 4]), 1), single ([3, 8])) -%!assert (prod (single ([1, 2; 3, 4]), 2), single ([2; 12])) -%!assert (prod (zeros (1, 0, "single")), single (1)) -%!assert (prod (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (prod (zeros (1, 0, "single"), 2), single (1)) -%!assert (prod (zeros (0, 1, "single")), single (1)) -%!assert (prod (zeros (0, 1, "single"), 1), single (1)) -%!assert (prod (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) -%!assert (prod (zeros (2, 0, "single")), zeros (1, 0, "single")) -%!assert (prod (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (prod (zeros (2, 0, "single"), 2), single ([1; 1])) -%!assert (prod (zeros (0, 2, "single")), single ([1, 1])) -%!assert (prod (zeros (0, 2, "single"), 1), single ([1, 1])) -%!assert (prod (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) - -%!error prod () -*/ - -static bool -all_scalar_1x1 (const octave_value_list& args) -{ - int n_args = args.length (); - for (int i = 0; i < n_args; i++) - if (args(i).numel () != 1) - return false; - - return true; -} - -template -static void -single_type_concat (Array& result, - const octave_value_list& args, - int dim) -{ - int n_args = args.length (); - if (! (equal_types::value - || equal_types::value) - && all_scalar_1x1 (args)) - { - // Optimize all scalars case. - dim_vector dv (1, 1); - if (dim == -1 || dim == -2) - dim = -dim - 1; - else if (dim >= 2) - dv.resize (dim+1, 1); - dv(dim) = n_args; - - result.clear (dv); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - result(j) = octave_value_extract (args(j)); - } - } - else - { - OCTAVE_LOCAL_BUFFER (Array, array_list, n_args); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - array_list[j] = octave_value_extract (args(j)); - } - - if (! error_state) - result = Array::cat (dim, n_args, array_list); - } -} - -template -static void -single_type_concat (Sparse& result, - const octave_value_list& args, - int dim) -{ - int n_args = args.length (); - OCTAVE_LOCAL_BUFFER (Sparse, sparse_list, n_args); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - sparse_list[j] = octave_value_extract (args(j)); - } - - if (! error_state) - result = Sparse::cat (dim, n_args, sparse_list); -} - -// Dispatcher. -template -static TYPE -do_single_type_concat (const octave_value_list& args, int dim) -{ - TYPE result; - - single_type_concat (result, args, dim); - - return result; -} - -template -static void -single_type_concat_map (octave_map& result, - const octave_value_list& args, - int dim) -{ - int n_args = args.length (); - OCTAVE_LOCAL_BUFFER (MAP, map_list, n_args); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - map_list[j] = octave_value_extract (args(j)); - } - - if (! error_state) - result = octave_map::cat (dim, n_args, map_list); -} - -static octave_map -do_single_type_concat_map (const octave_value_list& args, - int dim) -{ - octave_map result; - if (all_scalar_1x1 (args)) // optimize all scalars case. - single_type_concat_map (result, args, dim); - else - single_type_concat_map (result, args, dim); - - return result; -} - -static octave_value -attempt_type_conversion (const octave_value& ov, std::string dtype) -{ - octave_value retval; - - // First try to find function in the class of OV that can convert to - // the dispatch type dtype. It will have the name of the dispatch - // type. - - std::string cname = ov.class_name (); - - octave_value fcn = symbol_table::find_method (dtype, cname); - - if (fcn.is_defined ()) - { - octave_value_list result - = fcn.do_multi_index_op (1, octave_value_list (1, ov)); - - if (! error_state && result.length () > 0) - retval = result(0); - else - error ("conversion from %s to %s failed", dtype.c_str (), - cname.c_str ()); - } - else - { - // No conversion function available. Try the constructor for the - // dispatch type. - - fcn = symbol_table::find_method (dtype, dtype); - - if (fcn.is_defined ()) - { - octave_value_list result - = fcn.do_multi_index_op (1, octave_value_list (1, ov)); - - if (! error_state && result.length () > 0) - retval = result(0); - else - error ("%s constructor failed for %s argument", dtype.c_str (), - cname.c_str ()); - } - else - error ("no constructor for %s!", dtype.c_str ()); - } - - return retval; -} - -octave_value -do_class_concat (const octave_value_list& ovl, std::string cattype, int dim) -{ - octave_value retval; - - // Get dominant type for list - - std::string dtype = get_dispatch_type (ovl); - - octave_value fcn = symbol_table::find_method (cattype, dtype); - - if (fcn.is_defined ()) - { - // Have method for dominant type, so call it and let it handle - // conversions. - - octave_value_list tmp2 = fcn.do_multi_index_op (1, ovl); - - if (! error_state) - { - if (tmp2.length () > 0) - retval = tmp2(0); - else - { - error ("%s/%s method did not return a value", - dtype.c_str (), cattype.c_str ()); - goto done; - } - } - else - goto done; - } - else - { - // No method for dominant type, so attempt type conversions for - // all elements that are not of the dominant type, then do the - // default operation for octave_class values. - - octave_idx_type j = 0; - octave_idx_type len = ovl.length (); - octave_value_list tmp (len, octave_value ()); - for (octave_idx_type k = 0; k < len; k++) - { - octave_value elt = ovl(k); - - std::string t1_type = elt.class_name (); - - if (t1_type == dtype) - tmp(j++) = elt; - else if (elt.is_object () || ! elt.is_empty ()) - { - tmp(j++) = attempt_type_conversion (elt, dtype); - - if (error_state) - goto done; - } - } - - tmp.resize (j); - - octave_map m = do_single_type_concat_map (tmp, dim); - - std::string cname = tmp(0).class_name (); - std::list parents = tmp(0).parent_class_name_list (); - - retval = octave_value (new octave_class (m, cname, parents)); - } - - done: - return retval; -} - -static octave_value -do_cat (const octave_value_list& xargs, int dim, std::string fname) -{ - octave_value retval; - - // We may need to convert elements of the list to cells, so make a - // copy. This should be efficient, it is done mostly by incrementing - // reference counts. - octave_value_list args = xargs; - - int n_args = args.length (); - - if (n_args == 0) - retval = Matrix (); - else if (n_args == 1) - retval = args(0); - else if (n_args > 1) - { - std::string result_type; - - bool all_sq_strings_p = true; - bool all_dq_strings_p = true; - bool all_real_p = true; - bool all_cmplx_p = true; - bool any_sparse_p = false; - bool any_cell_p = false; - bool any_class_p = false; - - bool first_elem_is_struct = false; - - for (int i = 0; i < n_args; i++) - { - if (i == 0) - { - result_type = args(i).class_name (); - - first_elem_is_struct = args(i).is_map (); - } - else - result_type = get_concat_class (result_type, args(i).class_name ()); - - if (all_sq_strings_p && ! args(i).is_sq_string ()) - all_sq_strings_p = false; - if (all_dq_strings_p && ! args(i).is_dq_string ()) - all_dq_strings_p = false; - if (all_real_p && ! args(i).is_real_type ()) - all_real_p = false; - if (all_cmplx_p && ! (args(i).is_complex_type () || args(i).is_real_type ())) - all_cmplx_p = false; - if (!any_sparse_p && args(i).is_sparse_type ()) - any_sparse_p = true; - if (!any_cell_p && args(i).is_cell ()) - any_cell_p = true; - if (!any_class_p && args(i).is_object ()) - any_class_p = true; - } - - if (any_cell_p && ! any_class_p && ! first_elem_is_struct) - { - for (int i = 0; i < n_args; i++) - { - if (! args(i).is_cell ()) - args(i) = Cell (args(i)); - } - } - - if (any_class_p) - { - retval = do_class_concat (args, fname, dim); - } - else if (result_type == "double") - { - if (any_sparse_p) - { - if (all_real_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - else - { - if (all_real_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - } - else if (result_type == "single") - { - if (all_real_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - else if (result_type == "char") - { - char type = all_dq_strings_p ? '"' : '\''; - - maybe_warn_string_concat (all_dq_strings_p, all_sq_strings_p); - - charNDArray result = do_single_type_concat (args, dim); - - retval = octave_value (result, type); - } - else if (result_type == "logical") - { - if (any_sparse_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - else if (result_type == "int8") - retval = do_single_type_concat (args, dim); - else if (result_type == "int16") - retval = do_single_type_concat (args, dim); - else if (result_type == "int32") - retval = do_single_type_concat (args, dim); - else if (result_type == "int64") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint8") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint16") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint32") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint64") - retval = do_single_type_concat (args, dim); - else if (result_type == "cell") - retval = do_single_type_concat (args, dim); - else if (result_type == "struct") - retval = do_single_type_concat_map (args, dim); - else - { - dim_vector dv = args(0).dims (); - - // Default concatenation. - bool (dim_vector::*concat_rule) (const dim_vector&, int) = &dim_vector::concat; - - if (dim == -1 || dim == -2) - { - concat_rule = &dim_vector::hvcat; - dim = -dim - 1; - } - - for (int i = 1; i < args.length (); i++) - { - if (! (dv.*concat_rule) (args(i).dims (), dim)) - { - // Dimensions do not match. - error ("cat: dimension mismatch"); - return retval; - } - } - - // The lines below might seem crazy, since we take a copy - // of the first argument, resize it to be empty and then resize - // it to be full. This is done since it means that there is no - // recopying of data, as would happen if we used a single resize. - // It should be noted that resize operation is also significantly - // slower than the do_cat_op function, so it makes sense to have - // an empty matrix and copy all data. - // - // We might also start with a empty octave_value using - // tmp = octave_value_typeinfo::lookup_type - // (args(1).type_name()); - // and then directly resize. However, for some types there might - // be some additional setup needed, and so this should be avoided. - - octave_value tmp = args (0); - tmp = tmp.resize (dim_vector (0,0)).resize (dv); - - if (error_state) - return retval; - - int dv_len = dv.length (); - Array ra_idx (dim_vector (dv_len, 1), 0); - - for (int j = 0; j < n_args; j++) - { - // Can't fast return here to skip empty matrices as something - // like cat (1,[],single ([])) must return an empty matrix of - // the right type. - tmp = do_cat_op (tmp, args (j), ra_idx); - - if (error_state) - return retval; - - dim_vector dv_tmp = args (j).dims (); - - if (dim >= dv_len) - { - if (j > 1) - error ("%s: indexing error", fname.c_str ()); - break; - } - else - ra_idx (dim) += (dim < dv_tmp.length () ? - dv_tmp (dim) : 1); - } - retval = tmp; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (horzcat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} horzcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the horizontal concatenation of N-D array objects, @var{array1},\n\ -@var{array2}, @dots{}, @var{arrayN} along dimension 2.\n\ -\n\ -Arrays may also be concatenated horizontally using the syntax for creating\n\ -new matrices. For example:\n\ -\n\ -@example\n\ -@var{hcat} = [ @var{array1}, @var{array2}, @dots{} ]\n\ -@end example\n\ -@seealso{cat, vertcat}\n\ -@end deftypefn") -{ - return do_cat (args, -2, "horzcat"); -} - -/* -## Test concatenation with all zero matrices -%!assert (horzcat ("", 65*ones (1,10)), "AAAAAAAAAA"); -%!assert (horzcat (65*ones (1,10), ""), "AAAAAAAAAA"); - -%!assert (class (horzcat (int64 (1), int64 (1))), "int64") -%!assert (class (horzcat (int64 (1), int32 (1))), "int64") -%!assert (class (horzcat (int64 (1), int16 (1))), "int64") -%!assert (class (horzcat (int64 (1), int8 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint64 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint32 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint16 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint8 (1))), "int64") -%!assert (class (horzcat (int64 (1), single (1))), "int64") -%!assert (class (horzcat (int64 (1), double (1))), "int64") -%!assert (class (horzcat (int64 (1), cell (1))), "cell") -%!assert (class (horzcat (int64 (1), true)), "int64") -%!assert (class (horzcat (int64 (1), "a")), "char") - -%!assert (class (horzcat (int32 (1), int64 (1))), "int32") -%!assert (class (horzcat (int32 (1), int32 (1))), "int32") -%!assert (class (horzcat (int32 (1), int16 (1))), "int32") -%!assert (class (horzcat (int32 (1), int8 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint64 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint32 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint16 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint8 (1))), "int32") -%!assert (class (horzcat (int32 (1), single (1))), "int32") -%!assert (class (horzcat (int32 (1), double (1))), "int32") -%!assert (class (horzcat (int32 (1), cell (1))), "cell") -%!assert (class (horzcat (int32 (1), true)), "int32") -%!assert (class (horzcat (int32 (1), "a")), "char") - -%!assert (class (horzcat (int16 (1), int64 (1))), "int16") -%!assert (class (horzcat (int16 (1), int32 (1))), "int16") -%!assert (class (horzcat (int16 (1), int16 (1))), "int16") -%!assert (class (horzcat (int16 (1), int8 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint64 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint32 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint16 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint8 (1))), "int16") -%!assert (class (horzcat (int16 (1), single (1))), "int16") -%!assert (class (horzcat (int16 (1), double (1))), "int16") -%!assert (class (horzcat (int16 (1), cell (1))), "cell") -%!assert (class (horzcat (int16 (1), true)), "int16") -%!assert (class (horzcat (int16 (1), "a")), "char") - -%!assert (class (horzcat (int8 (1), int64 (1))), "int8") -%!assert (class (horzcat (int8 (1), int32 (1))), "int8") -%!assert (class (horzcat (int8 (1), int16 (1))), "int8") -%!assert (class (horzcat (int8 (1), int8 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint64 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint32 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint16 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint8 (1))), "int8") -%!assert (class (horzcat (int8 (1), single (1))), "int8") -%!assert (class (horzcat (int8 (1), double (1))), "int8") -%!assert (class (horzcat (int8 (1), cell (1))), "cell") -%!assert (class (horzcat (int8 (1), true)), "int8") -%!assert (class (horzcat (int8 (1), "a")), "char") - -%!assert (class (horzcat (uint64 (1), int64 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), int32 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), int16 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), int8 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint64 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint32 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint16 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint8 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), single (1))), "uint64") -%!assert (class (horzcat (uint64 (1), double (1))), "uint64") -%!assert (class (horzcat (uint64 (1), cell (1))), "cell") -%!assert (class (horzcat (uint64 (1), true)), "uint64") -%!assert (class (horzcat (uint64 (1), "a")), "char") - -%!assert (class (horzcat (uint32 (1), int64 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), int32 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), int16 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), int8 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint64 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint32 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint16 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint8 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), single (1))), "uint32") -%!assert (class (horzcat (uint32 (1), double (1))), "uint32") -%!assert (class (horzcat (uint32 (1), cell (1))), "cell") -%!assert (class (horzcat (uint32 (1), true)), "uint32") -%!assert (class (horzcat (uint32 (1), "a")), "char") - -%!assert (class (horzcat (uint16 (1), int64 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), int32 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), int16 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), int8 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint64 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint32 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint16 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint8 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), single (1))), "uint16") -%!assert (class (horzcat (uint16 (1), double (1))), "uint16") -%!assert (class (horzcat (uint16 (1), cell (1))), "cell") -%!assert (class (horzcat (uint16 (1), true)), "uint16") -%!assert (class (horzcat (uint16 (1), "a")), "char") - -%!assert (class (horzcat (uint8 (1), int64 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), int32 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), int16 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), int8 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint64 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint32 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint16 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint8 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), single (1))), "uint8") -%!assert (class (horzcat (uint8 (1), double (1))), "uint8") -%!assert (class (horzcat (uint8 (1), cell (1))), "cell") -%!assert (class (horzcat (uint8 (1), true)), "uint8") -%!assert (class (horzcat (uint8 (1), "a")), "char") - -%!assert (class (horzcat (single (1), int64 (1))), "int64") -%!assert (class (horzcat (single (1), int32 (1))), "int32") -%!assert (class (horzcat (single (1), int16 (1))), "int16") -%!assert (class (horzcat (single (1), int8 (1))), "int8") -%!assert (class (horzcat (single (1), uint64 (1))), "uint64") -%!assert (class (horzcat (single (1), uint32 (1))), "uint32") -%!assert (class (horzcat (single (1), uint16 (1))), "uint16") -%!assert (class (horzcat (single (1), uint8 (1))), "uint8") -%!assert (class (horzcat (single (1), single (1))), "single") -%!assert (class (horzcat (single (1), double (1))), "single") -%!assert (class (horzcat (single (1), cell (1))), "cell") -%!assert (class (horzcat (single (1), true)), "single") -%!assert (class (horzcat (single (1), "a")), "char") - -%!assert (class (horzcat (double (1), int64 (1))), "int64") -%!assert (class (horzcat (double (1), int32 (1))), "int32") -%!assert (class (horzcat (double (1), int16 (1))), "int16") -%!assert (class (horzcat (double (1), int8 (1))), "int8") -%!assert (class (horzcat (double (1), uint64 (1))), "uint64") -%!assert (class (horzcat (double (1), uint32 (1))), "uint32") -%!assert (class (horzcat (double (1), uint16 (1))), "uint16") -%!assert (class (horzcat (double (1), uint8 (1))), "uint8") -%!assert (class (horzcat (double (1), single (1))), "single") -%!assert (class (horzcat (double (1), double (1))), "double") -%!assert (class (horzcat (double (1), cell (1))), "cell") -%!assert (class (horzcat (double (1), true)), "double") -%!assert (class (horzcat (double (1), "a")), "char") - -%!assert (class (horzcat (cell (1), int64 (1))), "cell") -%!assert (class (horzcat (cell (1), int32 (1))), "cell") -%!assert (class (horzcat (cell (1), int16 (1))), "cell") -%!assert (class (horzcat (cell (1), int8 (1))), "cell") -%!assert (class (horzcat (cell (1), uint64 (1))), "cell") -%!assert (class (horzcat (cell (1), uint32 (1))), "cell") -%!assert (class (horzcat (cell (1), uint16 (1))), "cell") -%!assert (class (horzcat (cell (1), uint8 (1))), "cell") -%!assert (class (horzcat (cell (1), single (1))), "cell") -%!assert (class (horzcat (cell (1), double (1))), "cell") -%!assert (class (horzcat (cell (1), cell (1))), "cell") -%!assert (class (horzcat (cell (1), true)), "cell") -%!assert (class (horzcat (cell (1), "a")), "cell") - -%!assert (class (horzcat (true, int64 (1))), "int64") -%!assert (class (horzcat (true, int32 (1))), "int32") -%!assert (class (horzcat (true, int16 (1))), "int16") -%!assert (class (horzcat (true, int8 (1))), "int8") -%!assert (class (horzcat (true, uint64 (1))), "uint64") -%!assert (class (horzcat (true, uint32 (1))), "uint32") -%!assert (class (horzcat (true, uint16 (1))), "uint16") -%!assert (class (horzcat (true, uint8 (1))), "uint8") -%!assert (class (horzcat (true, single (1))), "single") -%!assert (class (horzcat (true, double (1))), "double") -%!assert (class (horzcat (true, cell (1))), "cell") -%!assert (class (horzcat (true, true)), "logical") -%!assert (class (horzcat (true, "a")), "char") - -%!assert (class (horzcat ("a", int64 (1))), "char") -%!assert (class (horzcat ("a", int32 (1))), "char") -%!assert (class (horzcat ("a", int16 (1))), "char") -%!assert (class (horzcat ("a", int8 (1))), "char") -%!assert (class (horzcat ("a", int64 (1))), "char") -%!assert (class (horzcat ("a", int32 (1))), "char") -%!assert (class (horzcat ("a", int16 (1))), "char") -%!assert (class (horzcat ("a", int8 (1))), "char") -%!assert (class (horzcat ("a", single (1))), "char") -%!assert (class (horzcat ("a", double (1))), "char") -%!assert (class (horzcat ("a", cell (1))), "cell") -%!assert (class (horzcat ("a", true)), "char") -%!assert (class (horzcat ("a", "a")), "char") - -%!assert (class (horzcat (cell (1), struct ("foo", "bar"))), "cell") - -%!error horzcat (struct ("foo", "bar"), cell (1)) -*/ - -DEFUN (vertcat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} vertcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the vertical concatenation of N-D array objects, @var{array1},\n\ -@var{array2}, @dots{}, @var{arrayN} along dimension 1.\n\ -\n\ -Arrays may also be concatenated vertically using the syntax for creating\n\ -new matrices. For example:\n\ -\n\ -@example\n\ -@var{vcat} = [ @var{array1}; @var{array2}; @dots{} ]\n\ -@end example\n\ -@seealso{cat, horzcat}\n\ -@end deftypefn") -{ - return do_cat (args, -1, "vertcat"); -} - -/* -%!test -%! c = {"foo"; "bar"; "bazoloa"}; -%! assert (vertcat (c, "a", "bc", "def"), {"foo"; "bar"; "bazoloa"; "a"; "bc"; "def"}); -*/ - -DEFUN (cat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cat (@var{dim}, @var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the concatenation of N-D array objects, @var{array1},\n\ -@var{array2}, @dots{}, @var{arrayN} along dimension @var{dim}.\n\ -\n\ -@example\n\ -@group\n\ -A = ones (2, 2);\n\ -B = zeros (2, 2);\n\ -cat (2, A, B)\n\ - @result{} 1 1 0 0\n\ - 1 1 0 0\n\ -@end group\n\ -@end example\n\ -\n\ -Alternatively, we can concatenate @var{A} and @var{B} along the\n\ -second dimension in the following way:\n\ -\n\ -@example\n\ -@group\n\ -[A, B]\n\ -@end group\n\ -@end example\n\ -\n\ -@var{dim} can be larger than the dimensions of the N-D array objects\n\ -and the result will thus have @var{dim} dimensions as the\n\ -following example shows:\n\ -\n\ -@example\n\ -@group\n\ -cat (4, ones (2, 2), zeros (2, 2))\n\ - @result{} ans(:,:,1,1) =\n\ -\n\ - 1 1\n\ - 1 1\n\ -\n\ - ans(:,:,1,2) =\n\ -\n\ - 0 0\n\ - 0 0\n\ -@end group\n\ -@end example\n\ -@seealso{horzcat, vertcat}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () > 0) - { - int dim = args(0).int_value () - 1; - - if (! error_state) - { - if (dim >= 0) - retval = do_cat (args.slice (1, args.length () - 1), dim, "cat"); - else - error ("cat: DIM must be a valid dimension"); - } - else - error ("cat: DIM must be an integer"); - } - else - print_usage (); - - return retval; -} - -/* -%!function ret = __testcat (t1, t2, tr, cmplx) -%! assert (cat (1, cast ([], t1), cast ([], t2)), cast ([], tr)); -%! -%! assert (cat (1, cast (1, t1), cast (2, t2)), cast ([1; 2], tr)); -%! assert (cat (1, cast (1, t1), cast ([2; 3], t2)), cast ([1; 2; 3], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast (3, t2)), cast ([1; 2; 3], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast ([3; 4], t2)), cast ([1; 2; 3; 4], tr)); -%! assert (cat (2, cast (1, t1), cast (2, t2)), cast ([1, 2], tr)); -%! assert (cat (2, cast (1, t1), cast ([2, 3], t2)), cast ([1, 2, 3], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast (3, t2)), cast ([1, 2, 3], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast ([3, 4], t2)), cast ([1, 2, 3, 4], tr)); -%! -%! assert ([cast(1, t1); cast(2, t2)], cast ([1; 2], tr)); -%! assert ([cast(1, t1); cast([2; 3], t2)], cast ([1; 2; 3], tr)); -%! assert ([cast([1; 2], t1); cast(3, t2)], cast ([1; 2; 3], tr)); -%! assert ([cast([1; 2], t1); cast([3; 4], t2)], cast ([1; 2; 3; 4], tr)); -%! assert ([cast(1, t1), cast(2, t2)], cast ([1, 2], tr)); -%! assert ([cast(1, t1), cast([2, 3], t2)], cast ([1, 2, 3], tr)); -%! assert ([cast([1, 2], t1), cast(3, t2)], cast ([1, 2, 3], tr)); -%! assert ([cast([1, 2], t1), cast([3, 4], t2)], cast ([1, 2, 3, 4], tr)); -%! -%! if (nargin == 3 || cmplx) -%! assert (cat (1, cast (1i, t1), cast (2, t2)), cast ([1i; 2], tr)); -%! assert (cat (1, cast (1i, t1), cast ([2; 3], t2)), cast ([1i; 2; 3], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast (3, t2)), cast ([1i; 2; 3], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast ([3; 4], t2)), cast ([1i; 2; 3; 4], tr)); -%! assert (cat (2, cast (1i, t1), cast (2, t2)), cast ([1i, 2], tr)); -%! assert (cat (2, cast (1i, t1), cast ([2, 3], t2)), cast ([1i, 2, 3], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast (3, t2)), cast ([1i, 2, 3], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast ([3, 4], t2)), cast ([1i, 2, 3, 4], tr)); -%! -%! assert ([cast(1i, t1); cast(2, t2)], cast ([1i; 2], tr)); -%! assert ([cast(1i, t1); cast([2; 3], t2)], cast ([1i; 2; 3], tr)); -%! assert ([cast([1i; 2], t1); cast(3, t2)], cast ([1i; 2; 3], tr)); -%! assert ([cast([1i; 2], t1); cast([3; 4], t2)], cast ([1i; 2; 3; 4], tr)); -%! assert ([cast(1i, t1), cast(2, t2)], cast ([1i, 2], tr)); -%! assert ([cast(1i, t1), cast([2, 3], t2)], cast ([1i, 2, 3], tr)); -%! assert ([cast([1i, 2], t1), cast(3, t2)], cast ([1i, 2, 3], tr)); -%! assert ([cast([1i, 2], t1), cast([3, 4], t2)], cast ([1i, 2, 3, 4], tr)); -%! -%! assert (cat (1, cast (1, t1), cast (2i, t2)), cast ([1; 2i], tr)); -%! assert (cat (1, cast (1, t1), cast ([2i; 3], t2)), cast ([1; 2i; 3], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast (3i, t2)), cast ([1; 2; 3i], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast ([3i; 4], t2)), cast ([1; 2; 3i; 4], tr)); -%! assert (cat (2, cast (1, t1), cast (2i, t2)), cast ([1, 2i], tr)); -%! assert (cat (2, cast (1, t1), cast ([2i, 3], t2)), cast ([1, 2i, 3], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast (3i, t2)), cast ([1, 2, 3i], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast ([3i, 4], t2)), cast ([1, 2, 3i, 4], tr)); -%! -%! assert ([cast(1, t1); cast(2i, t2)], cast ([1; 2i], tr)); -%! assert ([cast(1, t1); cast([2i; 3], t2)], cast ([1; 2i; 3], tr)); -%! assert ([cast([1; 2], t1); cast(3i, t2)], cast ([1; 2; 3i], tr)); -%! assert ([cast([1; 2], t1); cast([3i; 4], t2)], cast ([1; 2; 3i; 4], tr)); -%! assert ([cast(1, t1), cast(2i, t2)], cast ([1, 2i], tr)); -%! assert ([cast(1, t1), cast([2i, 3], t2)], cast ([1, 2i, 3], tr)); -%! assert ([cast([1, 2], t1), cast(3i, t2)], cast ([1, 2, 3i], tr)); -%! assert ([cast([1, 2], t1), cast([3i, 4], t2)], cast ([1, 2, 3i, 4], tr)); -%! -%! assert (cat (1, cast (1i, t1), cast (2i, t2)), cast ([1i; 2i], tr)); -%! assert (cat (1, cast (1i, t1), cast ([2i; 3], t2)), cast ([1i; 2i; 3], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast (3i, t2)), cast ([1i; 2; 3i], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast ([3i; 4], t2)), cast ([1i; 2; 3i; 4], tr)); -%! assert (cat (2, cast (1i, t1), cast (2i, t2)), cast ([1i, 2i], tr)); -%! assert (cat (2, cast (1i, t1), cast ([2i, 3], t2)), cast ([1i, 2i, 3], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast (3i, t2)), cast ([1i, 2, 3i], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast ([3i, 4], t2)), cast ([1i, 2, 3i, 4], tr)); -%! -%! assert ([cast(1i, t1); cast(2i, t2)], cast ([1i; 2i], tr)); -%! assert ([cast(1i, t1); cast([2i; 3], t2)], cast ([1i; 2i; 3], tr)); -%! assert ([cast([1i; 2], t1); cast(3i, t2)], cast ([1i; 2; 3i], tr)); -%! assert ([cast([1i; 2], t1); cast([3i; 4], t2)], cast ([1i; 2; 3i; 4], tr)); -%! assert ([cast(1i, t1), cast(2i, t2)], cast ([1i, 2i], tr)); -%! assert ([cast(1i, t1), cast([2i, 3], t2)], cast ([1i, 2i, 3], tr)); -%! assert ([cast([1i, 2], t1), cast(3i, t2)], cast ([1i, 2, 3i], tr)); -%! assert ([cast([1i, 2], t1), cast([3i, 4], t2)], cast ([1i, 2, 3i, 4], tr)); -%! endif -%! ret = true; -%!endfunction - -%!assert (__testcat ("double", "double", "double")) -%!assert (__testcat ("single", "double", "single")) -%!assert (__testcat ("double", "single", "single")) -%!assert (__testcat ("single", "single", "single")) - -%!assert (__testcat ("double", "int8", "int8", false)) -%!assert (__testcat ("int8", "double", "int8", false)) -%!assert (__testcat ("single", "int8", "int8", false)) -%!assert (__testcat ("int8", "single", "int8", false)) -%!assert (__testcat ("int8", "int8", "int8", false)) -%!assert (__testcat ("double", "int16", "int16", false)) -%!assert (__testcat ("int16", "double", "int16", false)) -%!assert (__testcat ("single", "int16", "int16", false)) -%!assert (__testcat ("int16", "single", "int16", false)) -%!assert (__testcat ("int16", "int16", "int16", false)) -%!assert (__testcat ("double", "int32", "int32", false)) -%!assert (__testcat ("int32", "double", "int32", false)) -%!assert (__testcat ("single", "int32", "int32", false)) -%!assert (__testcat ("int32", "single", "int32", false)) -%!assert (__testcat ("int32", "int32", "int32", false)) -%!assert (__testcat ("double", "int64", "int64", false)) -%!assert (__testcat ("int64", "double", "int64", false)) -%!assert (__testcat ("single", "int64", "int64", false)) -%!assert (__testcat ("int64", "single", "int64", false)) -%!assert (__testcat ("int64", "int64", "int64", false)) - -%!assert (__testcat ("double", "uint8", "uint8", false)) -%!assert (__testcat ("uint8", "double", "uint8", false)) -%!assert (__testcat ("single", "uint8", "uint8", false)) -%!assert (__testcat ("uint8", "single", "uint8", false)) -%!assert (__testcat ("uint8", "uint8", "uint8", false)) -%!assert (__testcat ("double", "uint16", "uint16", false)) -%!assert (__testcat ("uint16", "double", "uint16", false)) -%!assert (__testcat ("single", "uint16", "uint16", false)) -%!assert (__testcat ("uint16", "single", "uint16", false)) -%!assert (__testcat ("uint16", "uint16", "uint16", false)) -%!assert (__testcat ("double", "uint32", "uint32", false)) -%!assert (__testcat ("uint32", "double", "uint32", false)) -%!assert (__testcat ("single", "uint32", "uint32", false)) -%!assert (__testcat ("uint32", "single", "uint32", false)) -%!assert (__testcat ("uint32", "uint32", "uint32", false)) -%!assert (__testcat ("double", "uint64", "uint64", false)) -%!assert (__testcat ("uint64", "double", "uint64", false)) -%!assert (__testcat ("single", "uint64", "uint64", false)) -%!assert (__testcat ("uint64", "single", "uint64", false)) -%!assert (__testcat ("uint64", "uint64", "uint64", false)) - -%!assert (cat (3, [], [1,2;3,4]), [1,2;3,4]) -%!assert (cat (3, [1,2;3,4], []), [1,2;3,4]) -%!assert (cat (3, [], [1,2;3,4], []), [1,2;3,4]) -%!assert (cat (3, [], [], []), zeros (0, 0, 3)) - -%!assert (cat (3, [], [], 1, 2), cat (3, 1, 2)) -%!assert (cat (3, [], [], [1,2;3,4]), [1,2;3,4]) -%!assert (cat (4, [], [], [1,2;3,4]), [1,2;3,4]) - -%!assert ([zeros(3,2,2); ones(1,2,2)], repmat ([0;0;0;1],[1,2,2]) ) -%!assert ([zeros(3,2,2); ones(1,2,2)], vertcat (zeros (3,2,2), ones (1,2,2)) ) - -%!error cat (3, cat (3, [], []), [1,2;3,4]) -%!error cat (3, zeros (0, 0, 2), [1,2;3,4]) -*/ - -static octave_value -do_permute (const octave_value_list& args, bool inv) -{ - octave_value retval; - - if (args.length () == 2 && args(1).length () >= args(1).ndims ()) - { - Array vec = args(1).int_vector_value (); - - // FIXME -- maybe we should create an idx_vector object - // here and pass that to permute? - - int n = vec.length (); - - for (int i = 0; i < n; i++) - vec(i)--; - - octave_value ret = args(0).permute (vec, inv); - - if (! error_state) - retval = ret; - } - else - print_usage (); - - return retval; -} - -DEFUN (permute, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} permute (@var{A}, @var{perm})\n\ -Return the generalized transpose for an N-D array object @var{A}.\n\ -The permutation vector @var{perm} must contain the elements\n\ -@code{1:ndims (A)} (in any order, but each element must appear only once).\n\ -@seealso{ipermute}\n\ -@end deftypefn") -{ - return do_permute (args, false); -} - -DEFUN (ipermute, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ipermute (@var{A}, @var{iperm})\n\ -The inverse of the @code{permute} function. The expression\n\ -\n\ -@example\n\ -ipermute (permute (A, perm), perm)\n\ -@end example\n\ -\n\ -@noindent\n\ -returns the original array @var{A}.\n\ -@seealso{permute}\n\ -@end deftypefn") -{ - return do_permute (args, true); -} - -DEFUN (length, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} length (@var{a})\n\ -Return the \"length\" of the object @var{a}. For matrix objects, the\n\ -length is the number of rows or columns, whichever is greater (this\n\ -odd definition is used for compatibility with @sc{matlab}).\n\ -@seealso{size}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).length (); - else - print_usage (); - - return retval; -} - -DEFUN (ndims, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ndims (@var{a})\n\ -Return the number of dimensions of @var{a}.\n\ -For any array, the result will always be larger than or equal to 2.\n\ -Trailing singleton dimensions are not counted.\n\ -\n\ -@example\n\ -@group\n\ -ndims (ones (4, 1, 2, 1))\n\ - @result{} 3\n\ -@end group\n\ -@end example\n\ -@seealso{size}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).ndims (); - else - print_usage (); - - return retval; -} - -DEFUN (numel, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} numel (@var{a})\n\ -@deftypefnx {Built-in Function} {} numel (@var{a}, @var{idx1}, @var{idx2}, @dots{})\n\ -Return the number of elements in the object @var{a}.\n\ -Optionally, if indices @var{idx1}, @var{idx2}, @dots{} are supplied,\n\ -return the number of elements that would result from the indexing\n\ -\n\ -@example\n\ -@var{a}(@var{idx1}, @var{idx2}, @dots{})\n\ -@end example\n\ -\n\ -Note that the indices do not have to be numerical. For example,\n\ -\n\ -@example\n\ -@group\n\ -@var{a} = 1;\n\ -@var{b} = ones (2, 3);\n\ -numel (@var{a}, @var{b})\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -will return 6, as this is the number of ways to index with @var{b}.\n\ -\n\ -This method is also called when an object appears as lvalue with cs-list\n\ -indexing, i.e., @code{object@{@dots{}@}} or @code{object(@dots{}).field}.\n\ -@seealso{size}\n\ -@end deftypefn") -{ - octave_value retval; - octave_idx_type nargin = args.length (); - - if (nargin == 1) - retval = args(0).numel (); - else if (nargin > 1) - { - // Don't use numel (const octave_value_list&) here as that corresponds to - // an overloaded call, not to builtin! - retval = dims_to_numel (args(0).dims (), args.slice (1, nargin-1)); - } - else - print_usage (); - - return retval; -} - -DEFUN (size, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} size (@var{a})\n\ -@deftypefnx {Built-in Function} {} size (@var{a}, @var{dim})\n\ -Return the number of rows and columns of @var{a}.\n\ -\n\ -With one input argument and one output argument, the result is returned\n\ -in a row vector. If there are multiple output arguments, the number of\n\ -rows is assigned to the first, and the number of columns to the second,\n\ -etc. For example:\n\ -\n\ -@example\n\ -@group\n\ -size ([1, 2; 3, 4; 5, 6])\n\ - @result{} [ 3, 2 ]\n\ -\n\ -[nr, nc] = size ([1, 2; 3, 4; 5, 6])\n\ - @result{} nr = 3\n\ - @result{} nc = 2\n\ -@end group\n\ -@end example\n\ -\n\ -If given a second argument, @code{size} will return the size of the\n\ -corresponding dimension. For example,\n\ -\n\ -@example\n\ -@group\n\ -size ([1, 2; 3, 4; 5, 6], 2)\n\ - @result{} 2\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -returns the number of columns in the given matrix.\n\ -@seealso{numel, ndims, length, rows, columns}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1) - { - const dim_vector dimensions = args(0).dims (); - - if (nargout > 1) - { - const dim_vector rdims = dimensions.redim (nargout); - retval.resize (nargout); - for (int i = 0; i < nargout; i++) - retval(i) = rdims(i); - } - else - { - int ndims = dimensions.length (); - - NoAlias m (1, ndims); - - for (int i = 0; i < ndims; i++) - m(i) = dimensions(i); - - retval(0) = m; - } - } - else if (nargin == 2 && nargout < 2) - { - octave_idx_type nd = args(1).int_value (true); - - if (error_state) - error ("size: DIM must be a scalar"); - else - { - const dim_vector dv = args(0).dims (); - - if (nd > 0) - { - if (nd <= dv.length ()) - retval(0) = dv(nd-1); - else - retval(0) = 1; - } - else - error ("size: requested dimension DIM (= %d) out of range", nd); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (size_equal, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} size_equal (@var{a}, @var{b}, @dots{})\n\ -Return true if the dimensions of all arguments agree.\n\ -Trailing singleton dimensions are ignored.\n\ -Called with a single or no argument, size_equal returns true.\n\ -@seealso{size, numel, ndims}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - retval = true; - - if (nargin >= 1) - { - dim_vector a_dims = args(0).dims (); - - for (int i = 1; i < nargin; ++i) - { - dim_vector b_dims = args(i).dims (); - - if (a_dims != b_dims) - { - retval = false; - break; - } - } - } - - return retval; -} - -DEFUN (nnz, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{scalar} =} nnz (@var{a})\n\ -Return the number of non zero elements in @var{a}.\n\ -@seealso{sparse, nzmax}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).nnz (); - else - print_usage (); - - return retval; -} - -DEFUN (nzmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{scalar} =} nzmax (@var{SM})\n\ -Return the amount of storage allocated to the sparse matrix @var{SM}.\n\ -Note that Octave tends to crop unused memory at the first opportunity\n\ -for sparse objects. There are some cases of user created sparse objects\n\ -where the value returned by @dfn{nzmax} will not be the same as @dfn{nnz},\n\ -but in general they will give the same result.\n\ -@seealso{nnz, spalloc, sparse}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).nzmax (); - else - print_usage (); - - return retval; -} - -DEFUN (rows, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rows (@var{a})\n\ -Return the number of rows of @var{a}.\n\ -@seealso{columns, size, length, numel, isscalar, isvector, ismatrix}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).rows (); - else - print_usage (); - - return retval; -} - -DEFUN (columns, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} columns (@var{a})\n\ -Return the number of columns of @var{a}.\n\ -@seealso{rows, size, length, numel, isscalar, isvector, ismatrix}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).columns (); - else - print_usage (); - - return retval; -} - -DEFUN (sum, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sum (@var{x})\n\ -@deftypefnx {Built-in Function} {} sum (@var{x}, @var{dim})\n\ -@deftypefnx {Built-in Function} {} sum (@dots{}, \"native\")\n\ -@deftypefnx {Built-in Function} {} sum (@dots{}, \"double\")\n\ -@deftypefnx {Built-in Function} {} sum (@dots{}, \"extra\")\n\ -Sum of elements along dimension @var{dim}. If @var{dim} is\n\ -omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -If the optional argument \"native\" is given, then the sum is performed\n\ -in the same type as the original argument, rather than in the default\n\ -double type. For example:\n\ -\n\ -@example\n\ -@group\n\ -sum ([true, true])\n\ - @result{} 2\n\ -sum ([true, true], \"native\")\n\ - @result{} true\n\ -@end group\n\ -@end example\n\ -\n\ -On the contrary, if \"double\" is given, the sum is performed in double\n\ -precision even for single precision inputs.\n\ -\n\ -For double precision inputs, \"extra\" indicates that a more accurate\n\ -algorithm than straightforward summation is to be used. For single precision\n\ -inputs, \"extra\" is the same as \"double\". Otherwise, \"extra\" has no\n\ -effect.\n\ -@seealso{cumsum, sumsq, prod}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - bool isnative = false; - bool isdouble = false; - bool isextra = false; - - if (nargin > 1 && args(nargin - 1).is_string ()) - { - std::string str = args(nargin - 1).string_value (); - - if (! error_state) - { - if (str == "native") - isnative = true; - else if (str == "double") - isdouble = true; - else if (str == "extra") - isextra = true; - else - error ("sum: unrecognized string argument"); - nargin --; - } - } - - if (error_state) - return retval; - - if (nargin == 1 || nargin == 2) - { - octave_value arg = args(0); - - int dim = -1; - if (nargin == 2) - { - dim = args(1).int_value () - 1; - if (dim < 0) - error ("sum: invalid dimension DIM = %d", dim + 1); - } - - if (! error_state) - { - switch (arg.builtin_type ()) - { - case btyp_double: - if (arg.is_sparse_type ()) - { - if (isextra) - warning ("sum: 'extra' not yet implemented for sparse matrices"); - retval = arg.sparse_matrix_value ().sum (dim); - } - else if (isextra) - retval = arg.array_value ().xsum (dim); - else - retval = arg.array_value ().sum (dim); - break; - case btyp_complex: - if (arg.is_sparse_type ()) - { - if (isextra) - warning ("sum: 'extra' not yet implemented for sparse matrices"); - retval = arg.sparse_complex_matrix_value ().sum (dim); - } - else if (isextra) - retval = arg.complex_array_value ().xsum (dim); - else - retval = arg.complex_array_value ().sum (dim); - break; - case btyp_float: - if (isdouble || isextra) - retval = arg.float_array_value ().dsum (dim); - else - retval = arg.float_array_value ().sum (dim); - break; - case btyp_float_complex: - if (isdouble || isextra) - retval = arg.float_complex_array_value ().dsum (dim); - else - retval = arg.float_complex_array_value ().sum (dim); - break; - -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - if (isnative) \ - retval = arg.X ## _array_value ().sum (dim); \ - else \ - retval = arg.X ## _array_value ().dsum (dim); \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - - case btyp_bool: - if (arg.is_sparse_type ()) - { - if (isnative) - retval = arg.sparse_bool_matrix_value ().any (dim); - else - retval = arg.sparse_bool_matrix_value ().sum (dim); - } - else if (isnative) - retval = arg.bool_array_value ().any (dim); - else - retval = arg.bool_array_value ().sum (dim); - break; - - default: - gripe_wrong_type_arg ("sum", arg); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (sum ([true,true]), 2) -%!assert (sum ([true,true],"native"), true) -%!assert (sum (int8 ([127,10,-20])), 117) -%!assert (sum (int8 ([127,10,-20]),'native'), int8 (107)) - -%!assert (sum ([1, 2, 3]), 6) -%!assert (sum ([-1; -2; -3]), -6) -%!assert (sum ([i, 2+i, -3+2i, 4]), 3+4i) -%!assert (sum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [2+2i, 4+4i, 6+6i]) - -%!assert (sum (single ([1, 2, 3])), single (6)) -%!assert (sum (single ([-1; -2; -3])), single (-6)) -%!assert (sum (single ([i, 2+i, -3+2i, 4])), single (3+4i)) -%!assert (sum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([2+2i, 4+4i, 6+6i])) - -%!assert (sum ([1, 2; 3, 4], 1), [4, 6]) -%!assert (sum ([1, 2; 3, 4], 2), [3; 7]) -%!assert (sum (zeros (1, 0)), 0) -%!assert (sum (zeros (1, 0), 1), zeros (1, 0)) -%!assert (sum (zeros (1, 0), 2), 0) -%!assert (sum (zeros (0, 1)), 0) -%!assert (sum (zeros (0, 1), 1), 0) -%!assert (sum (zeros (0, 1), 2), zeros (0, 1)) -%!assert (sum (zeros (2, 0)), zeros (1, 0)) -%!assert (sum (zeros (2, 0), 1), zeros (1, 0)) -%!assert (sum (zeros (2, 0), 2), [0; 0]) -%!assert (sum (zeros (0, 2)), [0, 0]) -%!assert (sum (zeros (0, 2), 1), [0, 0]) -%!assert (sum (zeros (0, 2), 2), zeros (0, 1)) -%!assert (sum (zeros (2, 2, 0, 3)), zeros (1, 2, 0, 3)) -%!assert (sum (zeros (2, 2, 0, 3), 2), zeros (2, 1, 0, 3)) -%!assert (sum (zeros (2, 2, 0, 3), 3), zeros (2, 2, 1, 3)) -%!assert (sum (zeros (2, 2, 0, 3), 4), zeros (2, 2, 0)) -%!assert (sum (zeros (2, 2, 0, 3), 7), zeros (2, 2, 0, 3)) - -%!assert (sum (single ([1, 2; 3, 4]), 1), single ([4, 6])) -%!assert (sum (single ([1, 2; 3, 4]), 2), single ([3; 7])) -%!assert (sum (zeros (1, 0, "single")), single (0)) -%!assert (sum (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (sum (zeros (1, 0, "single"), 2), single (0)) -%!assert (sum (zeros (0, 1, "single")), single (0)) -%!assert (sum (zeros (0, 1, "single"), 1), single (0)) -%!assert (sum (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) -%!assert (sum (zeros (2, 0, "single")), zeros (1, 0, "single")) -%!assert (sum (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (sum (zeros (2, 0, "single"), 2), single ([0; 0])) -%!assert (sum (zeros (0, 2, "single")), single ([0, 0])) -%!assert (sum (zeros (0, 2, "single"), 1), single ([0, 0])) -%!assert (sum (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single")), zeros (1, 2, 0, 3, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 2), zeros (2, 1, 0, 3, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 3), zeros (2, 2, 1, 3, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 4), zeros (2, 2, 0, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 7), zeros (2, 2, 0, 3, "single")) - -%!error sum () -*/ - -DEFUN (sumsq, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sumsq (@var{x})\n\ -@deftypefnx {Built-in Function} {} sumsq (@var{x}, @var{dim})\n\ -Sum of squares of elements along dimension @var{dim}. If @var{dim}\n\ -is omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -This function is conceptually equivalent to computing\n\ -\n\ -@example\n\ -sum (x .* conj (x), dim)\n\ -@end example\n\ -\n\ -@noindent\n\ -but it uses less memory and avoids calling @code{conj} if @var{x} is real.\n\ -@seealso{sum, prod}\n\ -@end deftypefn") -{ - DATA_REDUCTION (sumsq); -} - -/* -%!assert (sumsq ([1, 2, 3]), 14) -%!assert (sumsq ([-1; -2; 4i]), 21) -%!assert (sumsq ([1, 2, 3; 2, 3, 4; 4i, 6i, 2]), [21, 49, 29]) - -%!assert (sumsq (single ([1, 2, 3])), single (14)) -%!assert (sumsq (single ([-1; -2; 4i])), single (21)) -%!assert (sumsq (single ([1, 2, 3; 2, 3, 4; 4i, 6i, 2])), single ([21, 49, 29])) - -%!assert (sumsq ([1, 2; 3, 4], 1), [10, 20]) -%!assert (sumsq ([1, 2; 3, 4], 2), [5; 25]) - -%!assert (sumsq (single ([1, 2; 3, 4]), 1), single ([10, 20])) -%!assert (sumsq (single ([1, 2; 3, 4]), 2), single ([5; 25])) - -%!error sumsq () -*/ - -DEFUN (islogical, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} islogical (@var{x})\n\ -@deftypefnx {Built-in Function} {} isbool (@var{x})\n\ -Return true if @var{x} is a logical object.\n\ -@seealso{isfloat, isinteger, ischar, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_bool_type (); - else - print_usage (); - - return retval; -} - -DEFALIAS (isbool, islogical); - -/* -%!assert (islogical (true), true) -%!assert (islogical (false), true) -%!assert (islogical ([true, false]), true) -%!assert (islogical (1), false) -%!assert (islogical (1i), false) -%!assert (islogical ([1,1]), false) -%!assert (islogical (single (1)), false) -%!assert (islogical (single (1i)), false) -%!assert (islogical (single ([1,1])), false) -%!assert (islogical (sparse ([true, false])), true) -%!assert (islogical (sparse ([1, 0])), false) -*/ - -DEFUN (isinteger, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isinteger (@var{x})\n\ -Return true if @var{x} is an integer object (int8, uint8, int16, etc.).\n\ -Note that @w{@code{isinteger (14)}} is false because numeric constants in\n\ -Octave are double precision floating point values.\n\ -@seealso{isfloat, ischar, islogical, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_integer_type (); - else - print_usage (); - - return retval; -} - -DEFUN (iscomplex, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} iscomplex (@var{x})\n\ -Return true if @var{x} is a complex-valued numeric object.\n\ -@seealso{isreal, isnumeric, islogical, ischar, isfloat, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_complex_type (); - else - print_usage (); - - return retval; -} - -DEFUN (isfloat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isfloat (@var{x})\n\ -Return true if @var{x} is a floating-point numeric object.\n\ -Objects of class double or single are floating-point objects.\n\ -@seealso{isinteger, ischar, islogical, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_float_type (); - else - print_usage (); - - return retval; -} - -// FIXME -- perhaps this should be implemented with an -// octave_value member function? - -DEFUN (complex, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} complex (@var{x})\n\ -@deftypefnx {Built-in Function} {} complex (@var{re}, @var{im})\n\ -Return a complex result from real arguments. With 1 real argument @var{x},\n\ -return the complex result @code{@var{x} + 0i}. With 2 real arguments,\n\ -return the complex result @code{@var{re} + @var{im}}. @code{complex} can\n\ -often be more convenient than expressions such as @code{a + i*b}.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -complex ([1, 2], [3, 4])\n\ - @result{} [ 1 + 3i 2 + 4i ]\n\ -@end group\n\ -@end example\n\ -@seealso{real, imag, iscomplex, abs, arg}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value arg = args(0); - - if (arg.is_complex_type ()) - retval = arg; - else - { - if (arg.is_sparse_type ()) - { - SparseComplexMatrix val = arg.sparse_complex_matrix_value (); - - if (! error_state) - retval = octave_value (new octave_sparse_complex_matrix (val)); - } - else if (arg.is_single_type ()) - { - if (arg.numel () == 1) - { - FloatComplex val = arg.float_complex_value (); - - if (! error_state) - retval = octave_value (new octave_float_complex (val)); - } - else - { - FloatComplexNDArray val = arg.float_complex_array_value (); - - if (! error_state) - retval = octave_value (new octave_float_complex_matrix (val)); - } - } - else - { - if (arg.numel () == 1) - { - Complex val = arg.complex_value (); - - if (! error_state) - retval = octave_value (new octave_complex (val)); - } - else - { - ComplexNDArray val = arg.complex_array_value (); - - if (! error_state) - retval = octave_value (new octave_complex_matrix (val)); - } - } - - if (error_state) - error ("complex: invalid conversion"); - } - } - else if (nargin == 2) - { - octave_value re = args(0); - octave_value im = args(1); - - if (re.is_sparse_type () && im.is_sparse_type ()) - { - const SparseMatrix re_val = re.sparse_matrix_value (); - const SparseMatrix im_val = im.sparse_matrix_value (); - - if (!error_state) - { - if (re.numel () == 1) - { - SparseComplexMatrix result; - if (re_val.nnz () == 0) - result = Complex (0, 1) * SparseComplexMatrix (im_val); - else - { - result = SparseComplexMatrix (im_val.dims (), re_val (0)); - octave_idx_type nr = im_val.rows (); - octave_idx_type nc = im_val.cols (); - - for (octave_idx_type j = 0; j < nc; j++) - { - octave_idx_type off = j * nr; - for (octave_idx_type i = im_val.cidx (j); - i < im_val.cidx (j + 1); i++) - result.data (im_val.ridx (i) + off) = - result.data (im_val.ridx (i) + off) + - Complex (0, im_val.data (i)); - } - } - retval = octave_value (new octave_sparse_complex_matrix (result)); - } - else if (im.numel () == 1) - { - SparseComplexMatrix result; - if (im_val.nnz () == 0) - result = SparseComplexMatrix (re_val); - else - { - result = SparseComplexMatrix (re_val.rows (), re_val.cols (), Complex (0, im_val (0))); - octave_idx_type nr = re_val.rows (); - octave_idx_type nc = re_val.cols (); - - for (octave_idx_type j = 0; j < nc; j++) - { - octave_idx_type off = j * nr; - for (octave_idx_type i = re_val.cidx (j); - i < re_val.cidx (j + 1); i++) - result.data (re_val.ridx (i) + off) = - result.data (re_val.ridx (i) + off) + - re_val.data (i); - } - } - retval = octave_value (new octave_sparse_complex_matrix (result)); - } - else - { - if (re_val.dims () == im_val.dims ()) - { - SparseComplexMatrix result = SparseComplexMatrix (re_val) - + Complex (0, 1) * SparseComplexMatrix (im_val); - retval = octave_value (new octave_sparse_complex_matrix (result)); - } - else - error ("complex: dimension mismatch"); - } - } - } - else if (re.is_single_type () || im.is_single_type ()) - { - if (re.numel () == 1) - { - float re_val = re.float_value (); - - if (im.numel () == 1) - { - float im_val = im.double_value (); - - if (! error_state) - retval = octave_value (new octave_float_complex (FloatComplex (re_val, im_val))); - } - else - { - const FloatNDArray im_val = im.float_array_value (); - - if (! error_state) - { - FloatComplexNDArray result (im_val.dims (), FloatComplex ()); - - for (octave_idx_type i = 0; i < im_val.numel (); i++) - result.xelem (i) = FloatComplex (re_val, im_val(i)); - - retval = octave_value (new octave_float_complex_matrix (result)); - } - } - } - else - { - const FloatNDArray re_val = re.float_array_value (); - - if (im.numel () == 1) - { - float im_val = im.float_value (); - - if (! error_state) - { - FloatComplexNDArray result (re_val.dims (), FloatComplex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = FloatComplex (re_val(i), im_val); - - retval = octave_value (new octave_float_complex_matrix (result)); - } - } - else - { - const FloatNDArray im_val = im.float_array_value (); - - if (! error_state) - { - if (re_val.dims () == im_val.dims ()) - { - FloatComplexNDArray result (re_val.dims (), FloatComplex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = FloatComplex (re_val(i), im_val(i)); - - retval = octave_value (new octave_float_complex_matrix (result)); - } - else - error ("complex: dimension mismatch"); - } - } - } - } - else if (re.numel () == 1) - { - double re_val = re.double_value (); - - if (im.numel () == 1) - { - double im_val = im.double_value (); - - if (! error_state) - retval = octave_value (new octave_complex (Complex (re_val, im_val))); - } - else - { - const NDArray im_val = im.array_value (); - - if (! error_state) - { - ComplexNDArray result (im_val.dims (), Complex ()); - - for (octave_idx_type i = 0; i < im_val.numel (); i++) - result.xelem (i) = Complex (re_val, im_val(i)); - - retval = octave_value (new octave_complex_matrix (result)); - } - } - } - else - { - const NDArray re_val = re.array_value (); - - if (im.numel () == 1) - { - double im_val = im.double_value (); - - if (! error_state) - { - ComplexNDArray result (re_val.dims (), Complex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = Complex (re_val(i), im_val); - - retval = octave_value (new octave_complex_matrix (result)); - } - } - else - { - const NDArray im_val = im.array_value (); - - if (! error_state) - { - if (re_val.dims () == im_val.dims ()) - { - ComplexNDArray result (re_val.dims (), Complex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = Complex (re_val(i), im_val(i)); - - retval = octave_value (new octave_complex_matrix (result)); - } - else - error ("complex: dimension mismatch"); - } - } - } - - if (error_state) - error ("complex: invalid conversion"); - } - else - print_usage (); - - return retval; -} - -DEFUN (isreal, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isreal (@var{x})\n\ -Return true if @var{x} is a non-complex matrix or scalar.\n\ -For compatibility with @sc{matlab}, this includes logical and character\n\ -matrices.\n\ -@seealso{iscomplex, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_real_type (); - else - print_usage (); - - return retval; -} - -DEFUN (isempty, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isempty (@var{a})\n\ -Return true if @var{a} is an empty matrix (any one of its dimensions is\n\ -zero). Otherwise, return false.\n\ -@seealso{isnull, isa}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - retval = args(0).is_empty (); - else - print_usage (); - - return retval; -} - -DEFUN (isnumeric, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isnumeric (@var{x})\n\ -Return true if @var{x} is a numeric object, i.e., an integer, real, or\n\ -complex array. Logical and character arrays are not considered to be\n\ -numeric.\n\ -@seealso{isinteger, isfloat, isreal, iscomplex, islogical, ischar, iscell, isstruct, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_numeric_type (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isnumeric (1), true) -%!assert (isnumeric (1i), true) -%!assert (isnumeric ([1,1]), true) -%!assert (isnumeric (single (1)), true) -%!assert (isnumeric (single (1i)), true) -%!assert (isnumeric (single ([1,1])), true) -%!assert (isnumeric (int8 (1)), true) -%!assert (isnumeric (uint8 ([1,1])), true) -%!assert (isnumeric ("Hello World"), false) -%!assert (isnumeric (true), false) -%!assert (isnumeric (false), false) -%!assert (isnumeric ([true, false]), false) -%!assert (isnumeric (sparse ([true, false])), false) -*/ - -DEFUN (ismatrix, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ismatrix (@var{a})\n\ -Return true if @var{a} is a numeric, logical, or character matrix.\n\ -Scalars (1x1 matrices) and vectors (@nospell{1xN} or @nospell{Nx1} matrices)\n\ -are subsets of the more general N-dimensional matrix and @code{ismatrix}\n\ -will return true for these objects as well.\n\ -@seealso{isscalar, isvector, iscell, isstruct, issparse, isa}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - octave_value arg = args(0); - - retval = arg.is_matrix_type () || arg.is_scalar_type () || arg.is_range (); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (ismatrix ([])) -%!assert (ismatrix (1)) -%!assert (ismatrix ([1, 2, 3])) -%!assert (ismatrix ([1, 2; 3, 4])) -%!assert (ismatrix (zeros (3, 2, 4))) - -%!assert (ismatrix (single ([]))) -%!assert (ismatrix (single (1))) -%!assert (ismatrix (single ([1, 2, 3]))) -%!assert (ismatrix (single ([1, 2; 3, 4]))) - -%!assert (ismatrix ("t")) -%!assert (ismatrix ("test")) -%!assert (ismatrix (["test"; "ing"])) - -%!test -%! s.a = 1; -%! assert (ismatrix (s), false); - -%!error ismatrix () -%!error ismatrix ([1, 2; 3, 4], 2) -*/ - -static octave_value -fill_matrix (const octave_value_list& args, int val, const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // FIXME -- perhaps this should be made extensible by - // using the class name to lookup a function to call to create - // the new value. - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_int8: - retval = int8NDArray (dims, val); - break; - - case oct_data_conv::dt_uint8: - retval = uint8NDArray (dims, val); - break; - - case oct_data_conv::dt_int16: - retval = int16NDArray (dims, val); - break; - - case oct_data_conv::dt_uint16: - retval = uint16NDArray (dims, val); - break; - - case oct_data_conv::dt_int32: - retval = int32NDArray (dims, val); - break; - - case oct_data_conv::dt_uint32: - retval = uint32NDArray (dims, val); - break; - - case oct_data_conv::dt_int64: - retval = int64NDArray (dims, val); - break; - - case oct_data_conv::dt_uint64: - retval = uint64NDArray (dims, val); - break; - - case oct_data_conv::dt_single: - retval = FloatNDArray (dims, val); - break; - - case oct_data_conv::dt_double: - { - if (val == 1 && dims.length () == 2 && dims (0) == 1) - retval = Range (1.0, 0.0, dims (1)); // packed form - else - retval = NDArray (dims, val); - } - break; - - case oct_data_conv::dt_logical: - retval = boolNDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, double val, float fval, - const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_single: - retval = FloatNDArray (dims, fval); - break; - - case oct_data_conv::dt_double: - retval = NDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, double val, const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_single: - retval = FloatNDArray (dims, static_cast (val)); - break; - - case oct_data_conv::dt_double: - retval = NDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, const Complex& val, - const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_single: - retval = FloatComplexNDArray (dims, static_cast (val)); - break; - - case oct_data_conv::dt_double: - retval = ComplexNDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, bool val, const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - dim_vector dims (1, 1); - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - retval = boolNDArray (dims, val); - } - - return retval; -} - -DEFUN (ones, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ones (@var{n})\n\ -@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} ones ([@var{m} @var{n} @dots{}])\n\ -@deftypefnx {Built-in Function} {} ones (@dots{}, @var{class})\n\ -Return a matrix or N-dimensional array whose elements are all 1.\n\ -If invoked with a single scalar integer argument @var{n}, return a square\n\ -@nospell{NxN} matrix. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -the given dimensions.\n\ -\n\ -If you need to create a matrix whose values are all the same, you should\n\ -use an expression like\n\ -\n\ -@example\n\ -val_matrix = val * ones (m, n)\n\ -@end example\n\ -\n\ -The optional argument @var{class} specifies the class of the return array\n\ -and defaults to double. For example:\n\ -\n\ -@example\n\ -val = ones (m,n, \"uint8\")\n\ -@end example\n\ -@seealso{zeros}\n\ -@end deftypefn") -{ - return fill_matrix (args, 1, "ones"); -} - -/* -%!assert (ones (3), [1, 1, 1; 1, 1, 1; 1, 1, 1]) -%!assert (ones (2, 3), [1, 1, 1; 1, 1, 1]) -%!assert (ones (3, 2), [1, 1; 1, 1; 1, 1]) -%!assert (size (ones (3, 4, 5)), [3, 4, 5]) - -%!assert (ones (3, "single"), single ([1, 1, 1; 1, 1, 1; 1, 1, 1])) -%!assert (ones (2, 3, "single"), single ([1, 1, 1; 1, 1, 1])) -%!assert (ones (3, 2, "single"), single ([1, 1; 1, 1; 1, 1])) -%!assert (size (ones (3, 4, 5, "single")), [3, 4, 5]) - -%!assert (ones (3, "int8"), int8 ([1, 1, 1; 1, 1, 1; 1, 1, 1])) -%!assert (ones (2, 3, "int8"), int8 ([1, 1, 1; 1, 1, 1])) -%!assert (ones (3, 2, "int8"), int8 ([1, 1; 1, 1; 1, 1])) -%!assert (size (ones (3, 4, 5, "int8")), [3, 4, 5]) -*/ - -DEFUN (zeros, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} zeros (@var{n})\n\ -@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} zeros ([@var{m} @var{n} @dots{}])\n\ -@deftypefnx {Built-in Function} {} zeros (@dots{}, @var{class})\n\ -Return a matrix or N-dimensional array whose elements are all 0.\n\ -If invoked with a single scalar integer argument, return a square\n\ -@nospell{NxN} matrix. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -the given dimensions.\n\ -\n\ -The optional argument @var{class} specifies the class of the return array\n\ -and defaults to double. For example:\n\ -\n\ -@example\n\ -val = zeros (m,n, \"uint8\")\n\ -@end example\n\ -@seealso{ones}\n\ -@end deftypefn") -{ - return fill_matrix (args, 0, "zeros"); -} - -/* -%!assert (zeros (3), [0, 0, 0; 0, 0, 0; 0, 0, 0]) -%!assert (zeros (2, 3), [0, 0, 0; 0, 0, 0]) -%!assert (zeros (3, 2), [0, 0; 0, 0; 0, 0]) -%!assert (size (zeros (3, 4, 5)), [3, 4, 5]) - -%!assert (zeros (3, "single"), single ([0, 0, 0; 0, 0, 0; 0, 0, 0])) -%!assert (zeros (2, 3, "single"), single ([0, 0, 0; 0, 0, 0])) -%!assert (zeros (3, 2, "single"), single ([0, 0; 0, 0; 0, 0])) -%!assert (size (zeros (3, 4, 5, "single")), [3, 4, 5]) - -%!assert (zeros (3, "int8"), int8 ([0, 0, 0; 0, 0, 0; 0, 0, 0])) -%!assert (zeros (2, 3, "int8"), int8 ([0, 0, 0; 0, 0, 0])) -%!assert (zeros (3, 2, "int8"), int8 ([0, 0; 0, 0; 0, 0])) -%!assert (size (zeros (3, 4, 5, "int8")), [3, 4, 5]) -*/ - -DEFUN (Inf, args, , - "-*- texinfo -*-\n\ -@c List other form of function in documentation index\n\ -@findex inf\n\ -\n\ -@deftypefn {Built-in Function} {} Inf\n\ -@deftypefnx {Built-in Function} {} Inf (@var{n})\n\ -@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} Inf (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ -to the IEEE representation for positive infinity.\n\ -\n\ -Infinity is produced when results are too large to be represented using the\n\ -the IEEE floating point format for numbers. Two common examples which\n\ -produce infinity are division by zero and overflow.\n\ -\n\ -@example\n\ -@group\n\ -[ 1/0 e^800 ]\n\ -@result{} Inf Inf\n\ -@end group\n\ -@end example\n\ -\n\ -When called with no arguments, return a scalar with the value @samp{Inf}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{isinf, NaN}\n\ -@end deftypefn") -{ - return fill_matrix (args, lo_ieee_inf_value (), - lo_ieee_float_inf_value (), "Inf"); -} - -DEFALIAS (inf, Inf); - -/* -%!assert (inf (3), [Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf]) -%!assert (inf (2, 3), [Inf, Inf, Inf; Inf, Inf, Inf]) -%!assert (inf (3, 2), [Inf, Inf; Inf, Inf; Inf, Inf]) -%!assert (size (inf (3, 4, 5)), [3, 4, 5]) - -%!assert (inf (3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf])) -%!assert (inf (2, 3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf])) -%!assert (inf (3, 2, "single"), single ([Inf, Inf; Inf, Inf; Inf, Inf])) -%!assert (size (inf (3, 4, 5, "single")), [3, 4, 5]) - -%!error (inf (3, "int8")) -%!error (inf (2, 3, "int8")) -%!error (inf (3, 2, "int8")) -%!error (inf (3, 4, 5, "int8")) -*/ - -DEFUN (NaN, args, , - "-*- texinfo -*-\n\ -@c List other form of function in documentation index\n\ -@findex nan\n\ -\n\ -@deftypefn {Built-in Function} {} NaN\n\ -@deftypefnx {Built-in Function} {} NaN (@var{n})\n\ -@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} NaN (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the IEEE symbol NaN (Not a Number).\n\ -NaN is the result of operations which do not produce a well defined numerical\n\ -result. Common operations which produce a NaN are arithmetic with infinity\n\ -@tex\n\ -($\\infty - \\infty$), zero divided by zero ($0/0$),\n\ -@end tex\n\ -@ifnottex\n\ -(Inf - Inf), zero divided by zero (0/0),\n\ -@end ifnottex\n\ -and any operation involving another NaN value (5 + NaN).\n\ -\n\ -Note that NaN always compares not equal to NaN (NaN != NaN). This behavior\n\ -is specified by the IEEE standard for floating point arithmetic. To\n\ -find NaN values, use the @code{isnan} function.\n\ -\n\ -When called with no arguments, return a scalar with the value @samp{NaN}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{isnan, Inf}\n\ -@end deftypefn") -{ - return fill_matrix (args, lo_ieee_nan_value (), - lo_ieee_float_nan_value (), "NaN"); -} - -DEFALIAS (nan, NaN); - -/* -%!assert (NaN (3), [NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN]) -%!assert (NaN (2, 3), [NaN, NaN, NaN; NaN, NaN, NaN]) -%!assert (NaN (3, 2), [NaN, NaN; NaN, NaN; NaN, NaN]) -%!assert (size (NaN (3, 4, 5)), [3, 4, 5]) - -%!assert (NaN (3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN])) -%!assert (NaN (2, 3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN])) -%!assert (NaN (3, 2, "single"), single ([NaN, NaN; NaN, NaN; NaN, NaN])) -%!assert (size (NaN (3, 4, 5, "single")), [3, 4, 5]) - -%!error (NaN (3, "int8")) -%!error (NaN (2, 3, "int8")) -%!error (NaN (3, 2, "int8")) -%!error (NaN (3, 4, 5, "int8")) -*/ - -DEFUN (e, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} e\n\ -@deftypefnx {Built-in Function} {} e (@var{n})\n\ -@deftypefnx {Built-in Function} {} e (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} e (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} e (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the base of natural logarithms. The constant\n\ -@tex\n\ -$e$ satisfies the equation $\\log (e) = 1$.\n\ -@end tex\n\ -@ifnottex\n\ -@samp{e} satisfies the equation @code{log} (e) = 1.\n\ -@end ifnottex\n\ -\n\ -When called with no arguments, return a scalar with the value @math{e}. When\n\ -called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{log, exp, pi, i, j}\n\ -@end deftypefn") -{ -#if defined (M_E) - double e_val = M_E; -#else - double e_val = exp (1.0); -#endif - - return fill_matrix (args, e_val, "e"); -} - -DEFUN (eps, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eps\n\ -@deftypefnx {Built-in Function} {} eps (@var{x})\n\ -@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} eps (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all eps,\n\ -the machine precision. More precisely, @code{eps} is the relative spacing\n\ -between any two adjacent numbers in the machine's floating point system.\n\ -This number is obviously system dependent. On machines that support IEEE\n\ -floating point arithmetic, @code{eps} is approximately\n\ -@tex\n\ -$2.2204\\times10^{-16}$ for double precision and $1.1921\\times10^{-7}$\n\ -@end tex\n\ -@ifnottex\n\ -2.2204e-16 for double precision and 1.1921e-07\n\ -@end ifnottex\n\ -for single precision.\n\ -\n\ -When called with no arguments, return a scalar with the value\n\ -@code{eps (1.0)}.\n\ -Given a single argument @var{x}, return the distance between @var{x} and\n\ -the next largest value.\n\ -When called with more than one argument the first two arguments are taken as\n\ -the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{realmax, realmin, intmax, bitmax}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value retval; - - if (nargin == 1 && ! args(0).is_string ()) - { - if (args(0).is_single_type ()) - { - float val = args(0).float_value (); - - if (! error_state) - { - val = ::fabsf (val); - if (xisnan (val) || xisinf (val)) - retval = fill_matrix (octave_value ("single"), - lo_ieee_nan_value (), - lo_ieee_float_nan_value (), "eps"); - else if (val < FLT_MIN) - retval = fill_matrix (octave_value ("single"), 0e0, - powf (2.0, -149e0), "eps"); - else - { - int expon; - frexpf (val, &expon); - val = std::pow (static_cast (2.0), - static_cast (expon - 24)); - retval = fill_matrix (octave_value ("single"), DBL_EPSILON, - val, "eps"); - } - } - } - else - { - double val = args(0).double_value (); - - if (! error_state) - { - val = ::fabs (val); - if (xisnan (val) || xisinf (val)) - retval = fill_matrix (octave_value_list (), - lo_ieee_nan_value (), - lo_ieee_float_nan_value (), "eps"); - else if (val < DBL_MIN) - retval = fill_matrix (octave_value_list (), - pow (2.0, -1074e0), 0e0, "eps"); - else - { - int expon; - frexp (val, &expon); - val = std::pow (static_cast (2.0), - static_cast (expon - 53)); - retval = fill_matrix (octave_value_list (), val, - FLT_EPSILON, "eps"); - } - } - } - } - else - retval = fill_matrix (args, DBL_EPSILON, FLT_EPSILON, "eps"); - - return retval; -} - -/* -%!assert (eps (1/2), 2^(-53)) -%!assert (eps (1), 2^(-52)) -%!assert (eps (2), 2^(-51)) -%!assert (eps (realmax), 2^971) -%!assert (eps (0), 2^(-1074)) -%!assert (eps (realmin/2), 2^(-1074)) -%!assert (eps (realmin/16), 2^(-1074)) -%!assert (eps (Inf), NaN) -%!assert (eps (NaN), NaN) -%!assert (eps (single (1/2)), single (2^(-24))) -%!assert (eps (single (1)), single (2^(-23))) -%!assert (eps (single (2)), single (2^(-22))) -%!assert (eps (realmax ("single")), single (2^104)) -%!assert (eps (single (0)), single (2^(-149))) -%!assert (eps (realmin ("single")/2), single (2^(-149))) -%!assert (eps (realmin ("single")/16), single (2^(-149))) -%!assert (eps (single (Inf)), single (NaN)) -%!assert (eps (single (NaN)), single (NaN)) -*/ - -DEFUN (pi, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pi\n\ -@deftypefnx {Built-in Function} {} pi (@var{n})\n\ -@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} pi (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the ratio of the circumference of a circle to its\n\ -@tex\n\ -diameter($\\pi$).\n\ -@end tex\n\ -@ifnottex\n\ -diameter.\n\ -@end ifnottex\n\ -Internally, @code{pi} is computed as @samp{4.0 * atan (1.0)}.\n\ -\n\ -When called with no arguments, return a scalar with the value of\n\ -@tex\n\ -$\\pi$.\n\ -@end tex\n\ -@ifnottex\n\ -pi.\n\ -@end ifnottex\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{e, i, j}\n\ -@end deftypefn") -{ -#if defined (M_PI) - double pi_val = M_PI; -#else - double pi_val = 4.0 * atan (1.0); -#endif - - return fill_matrix (args, pi_val, "pi"); -} - -DEFUN (realmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} realmax\n\ -@deftypefnx {Built-in Function} {} realmax (@var{n})\n\ -@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} realmax (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ -to the largest floating point number that is representable. The actual\n\ -value is system dependent. On machines that support IEEE\n\ -floating point arithmetic, @code{realmax} is approximately\n\ -@tex\n\ -$1.7977\\times10^{308}$ for double precision and $3.4028\\times10^{38}$\n\ -@end tex\n\ -@ifnottex\n\ -1.7977e+308 for double precision and 3.4028e+38\n\ -@end ifnottex\n\ -for single precision.\n\ -\n\ -When called with no arguments, return a scalar with the value\n\ -@code{realmax (\"double\")}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{realmin, intmax, bitmax, eps}\n\ -@end deftypefn") -{ - return fill_matrix (args, DBL_MAX, FLT_MAX, "realmax"); -} - -DEFUN (realmin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} realmin\n\ -@deftypefnx {Built-in Function} {} realmin (@var{n})\n\ -@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} realmin (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ -to the smallest normalized floating point number that is representable.\n\ -The actual value is system dependent. On machines that support\n\ -IEEE floating point arithmetic, @code{realmin} is approximately\n\ -@tex\n\ -$2.2251\\times10^{-308}$ for double precision and $1.1755\\times10^{-38}$\n\ -@end tex\n\ -@ifnottex\n\ -2.2251e-308 for double precision and 1.1755e-38\n\ -@end ifnottex\n\ -for single precision.\n\ -\n\ -When called with no arguments, return a scalar with the value\n\ -@code{realmin (\"double\")}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{realmax, intmin, eps}\n\ -@end deftypefn") -{ - return fill_matrix (args, DBL_MIN, FLT_MIN, "realmin"); -} - -DEFUN (I, args, , - "-*- texinfo -*-\n\ -@c List other forms of function in documentation index\n\ -@findex i\n\ -@findex j\n\ -@findex J\n\ -\n\ -@deftypefn {Built-in Function} {} I\n\ -@deftypefnx {Built-in Function} {} I (@var{n})\n\ -@deftypefnx {Built-in Function} {} I (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} I (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} I (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the pure imaginary unit, defined as\n\ -@tex\n\ -$\\sqrt{-1}$.\n\ -@end tex\n\ -@ifnottex\n\ -@code{sqrt (-1)}.\n\ -@end ifnottex\n\ -\n\ -I, and its equivalents i, j, and J, are functions so any of the names may\n\ -be reused for other purposes (such as i for a counter variable).\n\ -\n\ -When called with no arguments, return a scalar with the value @math{i}. When\n\ -called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{e, pi, log, exp, i, j, J}\n\ -@end deftypefn") -{ - return fill_matrix (args, Complex (0.0, 1.0), "I"); -} - -DEFALIAS (i, I); -DEFALIAS (J, I); -DEFALIAS (j, I); - -DEFUN (NA, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} NA\n\ -@deftypefnx {Built-in Function} {} NA (@var{n})\n\ -@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} NA (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the special constant used to designate missing values.\n\ -\n\ -Note that NA always compares not equal to NA (NA != NA).\n\ -To find NA values, use the @code{isna} function.\n\ -\n\ -When called with no arguments, return a scalar with the value @samp{NA}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{isna}\n\ -@end deftypefn") -{ - return fill_matrix (args, lo_ieee_na_value (), - lo_ieee_float_na_value (), "NA"); -} - -/* -%!assert (single (NA ("double")), NA ("single")) -%!assert (double (NA ("single")), NA ("double")) -*/ - -DEFUN (false, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} false (@var{x})\n\ -@deftypefnx {Built-in Function} {} false (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} false (@var{n}, @var{m}, @var{k}, @dots{})\n\ -Return a matrix or N-dimensional array whose elements are all logical 0.\n\ -If invoked with a single scalar integer argument, return a square\n\ -matrix of the specified size. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -given dimensions.\n\ -@seealso{true}\n\ -@end deftypefn") -{ - return fill_matrix (args, false, "false"); -} - -DEFUN (true, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} true (@var{x})\n\ -@deftypefnx {Built-in Function} {} true (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} true (@var{n}, @var{m}, @var{k}, @dots{})\n\ -Return a matrix or N-dimensional array whose elements are all logical 1.\n\ -If invoked with a single scalar integer argument, return a square\n\ -matrix of the specified size. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -given dimensions.\n\ -@seealso{false}\n\ -@end deftypefn") -{ - return fill_matrix (args, true, "true"); -} - -template -octave_value -identity_matrix (int nr, int nc) -{ - octave_value retval; - - typename MT::element_type one (1); - - if (nr == 1 && nc == 1) - retval = one; - else - { - dim_vector dims (nr, nc); - - typename MT::element_type zero (0); - - MT m (dims, zero); - - if (nr > 0 && nc > 0) - { - int n = std::min (nr, nc); - - for (int i = 0; i < n; i++) - m(i,i) = one; - } - - retval = m; - } - - return retval; -} - -#define INSTANTIATE_EYE(T) \ - template octave_value identity_matrix (int, int) - -INSTANTIATE_EYE (int8NDArray); -INSTANTIATE_EYE (uint8NDArray); -INSTANTIATE_EYE (int16NDArray); -INSTANTIATE_EYE (uint16NDArray); -INSTANTIATE_EYE (int32NDArray); -INSTANTIATE_EYE (uint32NDArray); -INSTANTIATE_EYE (int64NDArray); -INSTANTIATE_EYE (uint64NDArray); -INSTANTIATE_EYE (FloatNDArray); -INSTANTIATE_EYE (NDArray); -INSTANTIATE_EYE (boolNDArray); - -static octave_value -identity_matrix (int nr, int nc, oct_data_conv::data_type dt) -{ - octave_value retval; - - // FIXME -- perhaps this should be made extensible by using - // the class name to lookup a function to call to create the new - // value. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_int8: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint8: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_int16: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint16: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_int32: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint32: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_int64: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint64: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_single: - retval = FloatDiagMatrix (nr, nc, 1.0f); - break; - - case oct_data_conv::dt_double: - retval = DiagMatrix (nr, nc, 1.0); - break; - - case oct_data_conv::dt_logical: - retval = identity_matrix (nr, nc); - break; - - default: - error ("eye: invalid class name"); - break; - } - } - - return retval; -} - -#undef INT_EYE_MATRIX - -DEFUN (eye, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eye (@var{n})\n\ -@deftypefnx {Built-in Function} {} eye (@var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {} eye ([@var{m} @var{n}])\n\ -@deftypefnx {Built-in Function} {} eye (@dots{}, @var{class})\n\ -Return an identity matrix. If invoked with a single scalar argument @var{n},\n\ -return a square @nospell{NxN} identity matrix. If\n\ -supplied two scalar arguments (@var{m}, @var{n}), @code{eye} takes them to be\n\ -the number of rows and columns. If given a vector with two elements,\n\ -@code{eye} uses the values of the elements as the number of rows and columns,\n\ -respectively. For example:\n\ -\n\ -@example\n\ -@group\n\ -eye (3)\n\ - @result{} 1 0 0\n\ - 0 1 0\n\ - 0 0 1\n\ -@end group\n\ -@end example\n\ -\n\ -The following expressions all produce the same result:\n\ -\n\ -@example\n\ -@group\n\ -eye (2)\n\ -@equiv{}\n\ -eye (2, 2)\n\ -@equiv{}\n\ -eye (size ([1, 2; 3, 4])\n\ -@end group\n\ -@end example\n\ -\n\ -The optional argument @var{class}, allows @code{eye} to return an array of\n\ -the specified type, like\n\ -\n\ -@example\n\ -val = zeros (n,m, \"uint8\")\n\ -@end example\n\ -\n\ -Calling @code{eye} with no arguments is equivalent to calling it\n\ -with an argument of 1. Any negative dimensions are treated as zero. \n\ -These odd definitions are for compatibility with @sc{matlab}.\n\ -@seealso{speye, ones, zeros}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - // Check for type information. - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - retval = identity_matrix (1, 1, dt); - break; - - case 1: - { - octave_idx_type nr, nc; - get_dimensions (args(0), "eye", nr, nc); - - if (! error_state) - retval = identity_matrix (nr, nc, dt); - } - break; - - case 2: - { - octave_idx_type nr, nc; - get_dimensions (args(0), args(1), "eye", nr, nc); - - if (! error_state) - retval = identity_matrix (nr, nc, dt); - } - break; - - default: - print_usage (); - break; - } - - return retval; -} - -/* -%!assert (full (eye (3)), [1, 0, 0; 0, 1, 0; 0, 0, 1]) -%!assert (full (eye (2, 3)), [1, 0, 0; 0, 1, 0]) - -%!assert (full (eye (3,"single")), single ([1, 0, 0; 0, 1, 0; 0, 0, 1])) -%!assert (full (eye (2, 3,"single")), single ([1, 0, 0; 0, 1, 0])) - -%!assert (eye (3, "int8"), int8 ([1, 0, 0; 0, 1, 0; 0, 0, 1])) -%!assert (eye (2, 3, "int8"), int8 ([1, 0, 0; 0, 1, 0])) - -%!error eye (1, 2, 3) -*/ - -template -static octave_value -do_linspace (const octave_value& base, const octave_value& limit, - octave_idx_type n) -{ - typedef typename MT::column_vector_type CVT; - typedef typename MT::element_type T; - - octave_value retval; - - if (base.is_scalar_type ()) - { - T bs = octave_value_extract (base); - if (limit.is_scalar_type ()) - { - T ls = octave_value_extract (limit); - retval = linspace (bs, ls, n); - } - else - { - CVT lv = octave_value_extract (limit); - CVT bv (lv.length (), bs); - retval = linspace (bv, lv, n); - } - } - else - { - CVT bv = octave_value_extract (base); - if (limit.is_scalar_type ()) - { - T ls = octave_value_extract (limit); - CVT lv (bv.length (), ls); - retval = linspace (bv, lv, n); - } - else - { - CVT lv = octave_value_extract (limit); - retval = linspace (bv, lv, n); - } - } - - return retval; -} - -DEFUN (linspace, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} linspace (@var{base}, @var{limit})\n\ -@deftypefnx {Built-in Function} {} linspace (@var{base}, @var{limit}, @var{n})\n\ -Return a row vector with @var{n} linearly spaced elements between\n\ -@var{base} and @var{limit}. If the number of elements is greater than one,\n\ -then the endpoints @var{base} and @var{limit} are always included in\n\ -the range. If @var{base} is greater than @var{limit}, the elements are\n\ -stored in decreasing order. If the number of points is not specified, a\n\ -value of 100 is used.\n\ -\n\ -The @code{linspace} function always returns a row vector if both\n\ -@var{base} and @var{limit} are scalars. If one, or both, of them are column\n\ -vectors, @code{linspace} returns a matrix.\n\ -\n\ -For compatibility with @sc{matlab}, return the second argument (@var{limit})\n\ -if fewer than two values are requested.\n\ -@seealso{logspace}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - octave_idx_type npoints = 100; - - if (nargin != 2 && nargin != 3) - { - print_usage (); - return retval; - } - - if (nargin == 3) - npoints = args(2).idx_type_value (); - - if (! error_state) - { - octave_value arg_1 = args(0); - octave_value arg_2 = args(1); - - if (arg_1.is_single_type () || arg_2.is_single_type ()) - { - if (arg_1.is_complex_type () || arg_2.is_complex_type ()) - retval = do_linspace (arg_1, arg_2, npoints); - else - retval = do_linspace (arg_1, arg_2, npoints); - - } - else - { - if (arg_1.is_complex_type () || arg_2.is_complex_type ()) - retval = do_linspace (arg_1, arg_2, npoints); - else - retval = do_linspace (arg_1, arg_2, npoints); - } - } - else - error ("linspace: N must be an integer"); - - return retval; -} - - -/* -%!test -%! x1 = linspace (1, 2); -%! x2 = linspace (1, 2, 10); -%! x3 = linspace (1, -2, 10); -%! assert (size (x1) == [1, 100] && x1(1) == 1 && x1(100) == 2); -%! assert (size (x2) == [1, 10] && x2(1) == 1 && x2(10) == 2); -%! assert (size (x3) == [1, 10] && x3(1) == 1 && x3(10) == -2); - -%assert (linspace ([1, 2; 3, 4], 5, 6), linspace (1, 5, 6)) - -%!error linspace () -%!error linspace (1, 2, 3, 4) -*/ - -// FIXME -- should accept dimensions as separate args for N-d -// arrays as well as 1-d and 2-d arrays. - -DEFUN (resize, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} resize (@var{x}, @var{m})\n\ -@deftypefnx {Built-in Function} {} resize (@var{x}, @var{m}, @var{n}, @dots{})\n\ -@deftypefnx {Built-in Function} {} resize (@var{x}, [@var{m} @var{n} @dots{}])\n\ -Resize @var{x} cutting off elements as necessary.\n\ -\n\ -In the result, element with certain indices is equal to the corresponding\n\ -element of @var{x} if the indices are within the bounds of @var{x};\n\ -otherwise, the element is set to zero.\n\ -\n\ -In other words, the statement\n\ -\n\ -@example\n\ -y = resize (x, dv)\n\ -@end example\n\ -\n\ -@noindent\n\ -is equivalent to the following code:\n\ -\n\ -@example\n\ -@group\n\ -y = zeros (dv, class (x));\n\ -sz = min (dv, size (x));\n\ -for i = 1:length (sz)\n\ - idx@{i@} = 1:sz(i);\n\ -endfor\n\ -y(idx@{:@}) = x(idx@{:@});\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -but is performed more efficiently.\n\ -\n\ -If only @var{m} is supplied, and it is a scalar, the dimension of the\n\ -result is @var{m}-by-@var{m}.\n\ -If @var{m}, @var{n}, @dots{} are all scalars, then the dimensions of\n\ -the result are @var{m}-by-@var{n}-by-@dots{}.\n\ -If given a vector as input, then the\n\ -dimensions of the result are given by the elements of that vector.\n\ -\n\ -An object can be resized to more dimensions than it has;\n\ -in such case the missing dimensions are assumed to be 1.\n\ -Resizing an object to fewer dimensions is not possible.\n\ -@seealso{reshape, postpad, prepad, cat}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin == 2) - { - Array vec = args(1).vector_value (); - int ndim = vec.length (); - if (ndim == 1) - { - octave_idx_type m = static_cast (vec(0)); - retval = args(0); - retval = retval.resize (dim_vector (m, m), true); - } - else - { - dim_vector dv; - dv.resize (ndim); - for (int i = 0; i < ndim; i++) - dv(i) = static_cast (vec(i)); - retval = args(0); - retval = retval.resize (dv, true); - } - } - else if (nargin > 2) - { - dim_vector dv; - dv.resize (nargin - 1); - for (octave_idx_type i = 1; i < nargin; i++) - dv(i-1) = static_cast (args(i).scalar_value ()); - if (!error_state) - { - retval = args(0); - retval = retval.resize (dv, true); - } - - } - else - print_usage (); - return retval; -} - -// FIXME -- should use octave_idx_type for dimensions. - -DEFUN (reshape, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} reshape (@var{A}, @var{m}, @var{n}, @dots{})\n\ -@deftypefnx {Built-in Function} {} reshape (@var{A}, [@var{m} @var{n} @dots{}])\n\ -@deftypefnx {Built-in Function} {} reshape (@var{A}, @dots{}, [], @dots{})\n\ -@deftypefnx {Built-in Function} {} reshape (@var{A}, @var{size})\n\ -Return a matrix with the specified dimensions (@var{m}, @var{n}, @dots{})\n\ -whose elements are taken from the matrix @var{A}. The elements of the\n\ -matrix are accessed in column-major order (like Fortran arrays are stored).\n\ -\n\ -The following code demonstrates reshaping a 1x4 row vector into a 2x2 square\n\ -matrix.\n\ -\n\ -@example\n\ -@group\n\ -reshape ([1, 2, 3, 4], 2, 2)\n\ - @result{} 1 3\n\ - 2 4\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Note that the total number of elements in the original\n\ -matrix (@code{prod (size (@var{A}))}) must match the total number of elements\n\ -in the new matrix (@code{prod ([@var{m} @var{n} @dots{}])}).\n\ -\n\ -A single dimension of the return matrix may be left unspecified and Octave\n\ -will determine its size automatically. An empty matrix ([]) is used to flag\n\ -the unspecified dimension.\n\ -@seealso{resize, vec, postpad, cat, squeeze}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - dim_vector new_dims; - - if (nargin == 2) - { - Array new_size = args(1).octave_idx_type_vector_value (); - - new_dims = dim_vector::alloc (new_size.length ()); - - for (octave_idx_type i = 0; i < new_size.length (); i++) - { - if (new_size(i) < 0) - { - error ("reshape: SIZE must be non-negative"); - break; - } - else - new_dims(i) = new_size(i); - } - } - else if (nargin > 2) - { - new_dims = dim_vector::alloc (nargin-1); - int empty_dim = -1; - - for (int i = 1; i < nargin; i++) - { - if (args(i).is_empty ()) - { - if (empty_dim > 0) - { - error ("reshape: only a single dimension can be unknown"); - break; - } - else - { - empty_dim = i; - new_dims(i-1) = 1; - } - } - else - { - new_dims(i-1) = args(i).idx_type_value (); - - if (error_state) - break; - else if (new_dims(i-1) < 0) - { - error ("reshape: SIZE must be non-negative"); - break; - } - } - } - - if (! error_state && (empty_dim > 0)) - { - octave_idx_type nel = new_dims.numel (); - - if (nel == 0) - new_dims(empty_dim-1) = 0; - else - { - octave_idx_type a_nel = args(0).numel (); - octave_idx_type size_empty_dim = a_nel / nel; - - if (a_nel != size_empty_dim * nel) - error ("reshape: SIZE is not divisible by the product of known dimensions (= %d)", nel); - else - new_dims(empty_dim-1) = size_empty_dim; - } - } - } - else - { - print_usage (); - return retval; - } - - if (! error_state) - retval = args(0).reshape (new_dims); - - return retval; -} - -/* -%!assert (size (reshape (ones (4, 4), 2, 8)), [2, 8]) -%!assert (size (reshape (ones (4, 4), 8, 2)), [8, 2]) -%!assert (size (reshape (ones (15, 4), 1, 60)), [1, 60]) -%!assert (size (reshape (ones (15, 4), 60, 1)), [60, 1]) - -%!assert (size (reshape (ones (4, 4, "single"), 2, 8)), [2, 8]) -%!assert (size (reshape (ones (4, 4, "single"), 8, 2)), [8, 2]) -%!assert (size (reshape (ones (15, 4, "single"), 1, 60)), [1, 60]) -%!assert (size (reshape (ones (15, 4, "single"), 60, 1)), [60, 1]) - -%!test -%! s.a = 1; -%! fail ("reshape (s, 2, 3)"); - -%!error reshape () -%!error reshape (1, 2, 3, 4) -*/ - -DEFUN (vec, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{v} =} vec (@var{x})\n\ -@deftypefnx {Built-in Function} {@var{v} =} vec (@var{x}, @var{dim})\n\ -Return the vector obtained by stacking the columns of the matrix @var{x}\n\ -one above the other. Without @var{dim} this is equivalent to\n\ -@code{@var{x}(:)}. If @var{dim} is supplied, the dimensions of @var{v}\n\ -are set to @var{dim} with all elements along the last dimension.\n\ -This is equivalent to @code{shiftdim (@var{x}(:), 1-@var{dim})}.\n\ -@seealso{vech, resize, cat}\n\ -@end deftypefn") -{ - octave_value retval; - int dim = 1; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 2) - print_usage () ; - - if (! error_state && nargin == 2) - { - dim = args(1).idx_type_value (); - - if (dim < 1) - error ("vec: DIM must be greater than zero"); - } - - if (! error_state) - { - octave_value colon (octave_value::magic_colon_t); - octave_value arg = args(0); - retval = arg.single_subsref ("(", colon); - - - if (! error_state && dim > 1) - { - dim_vector new_dims = dim_vector::alloc (dim); - - for (int i = 0; i < dim-1; i++) - new_dims(i) = 1; - - new_dims(dim-1) = retval.numel (); - - retval = retval.reshape (new_dims); - } - } - - return retval; -} - -/* -%!assert (vec ([1, 2; 3, 4]), [1; 3; 2; 4]) -%!assert (vec ([1, 3, 2, 4]), [1; 3; 2; 4]) -%!assert (vec ([1, 2, 3, 4], 2), [1, 2, 3, 4]) -%!assert (vec ([1, 2; 3, 4]), vec ([1, 2; 3, 4], 1)) -%!assert (vec ([1, 2; 3, 4], 1), [1; 3; 2; 4]) -%!assert (vec ([1, 2; 3, 4], 2), [1, 3, 2, 4]) -%!assert (vec ([1, 3; 2, 4], 3), reshape ([1, 2, 3, 4], 1, 1, 4)) -%!assert (vec ([1, 3; 2, 4], 3), shiftdim (vec ([1, 3; 2, 4]), -2)) - -%!error vec () -%!error vec (1, 2, 3) -%!error vec ([1, 2; 3, 4], 0) -*/ - -DEFUN (squeeze, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} squeeze (@var{x})\n\ -Remove singleton dimensions from @var{x} and return the result.\n\ -Note that for compatibility with @sc{matlab}, all objects have\n\ -a minimum of two dimensions and row vectors are left unchanged.\n\ -@seealso{reshape}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).squeeze (); - else - print_usage (); - - return retval; -} - -DEFUN (full, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{FM} =} full (@var{SM})\n\ -Return a full storage matrix from a sparse, diagonal, permutation matrix\n\ -or a range.\n\ -@seealso{sparse}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).full_value (); - else - print_usage (); - - return retval; -} - -// Compute various norms of the vector X. - -DEFUN (norm, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} norm (@var{A})\n\ -@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p})\n\ -@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p}, @var{opt})\n\ -Compute the p-norm of the matrix @var{A}. If the second argument is\n\ -missing, @code{p = 2} is assumed.\n\ -\n\ -If @var{A} is a matrix (or sparse matrix):\n\ -\n\ -@table @asis\n\ -@item @var{p} = @code{1}\n\ -1-norm, the largest column sum of the absolute values of @var{A}.\n\ -\n\ -@item @var{p} = @code{2}\n\ -Largest singular value of @var{A}.\n\ -\n\ -@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ -@cindex infinity norm\n\ -Infinity norm, the largest row sum of the absolute values of @var{A}.\n\ -\n\ -@item @var{p} = @code{\"fro\"}\n\ -@cindex Frobenius norm\n\ -Frobenius norm of @var{A}, @code{sqrt (sum (diag (@var{A}' * @var{A})))}.\n\ -\n\ -@item other @var{p}, @code{@var{p} > 1}\n\ -@cindex general p-norm\n\ -maximum @code{norm (A*x, p)} such that @code{norm (x, p) == 1}\n\ -@end table\n\ -\n\ -If @var{A} is a vector or a scalar:\n\ -\n\ -@table @asis\n\ -@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ -@code{max (abs (@var{A}))}.\n\ -\n\ -@item @var{p} = @code{-Inf}\n\ -@code{min (abs (@var{A}))}.\n\ -\n\ -@item @var{p} = @code{\"fro\"}\n\ -Frobenius norm of @var{A}, @code{sqrt (sumsq (abs (A)))}.\n\ -\n\ -@item @var{p} = 0\n\ -Hamming norm - the number of nonzero elements.\n\ -\n\ -@item other @var{p}, @code{@var{p} > 1}\n\ -p-norm of @var{A}, @code{(sum (abs (@var{A}) .^ @var{p})) ^ (1/@var{p})}.\n\ -\n\ -@item other @var{p} @code{@var{p} < 1}\n\ -the p-pseudonorm defined as above.\n\ -@end table\n\ -\n\ -If @var{opt} is the value @code{\"rows\"}, treat each row as a vector and\n\ -compute its norm. The result is returned as a column vector.\n\ -Similarly, if @var{opt} is @code{\"columns\"} or @code{\"cols\"} then compute\n\ -the norms of each column and return a row vector.\n\ -@seealso{cond, svd}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin >= 1 && nargin <= 3) - { - octave_value x_arg = args(0); - - if (x_arg.ndims () == 2) - { - enum { sfmatrix, sfcols, sfrows, sffrob, sfinf } strflag = sfmatrix; - if (nargin > 1 && args(nargin-1).is_string ()) - { - std::string str = args(nargin-1).string_value (); - if (str == "cols" || str == "columns") - strflag = sfcols; - else if (str == "rows") - strflag = sfrows; - else if (str == "fro") - strflag = sffrob; - else if (str == "inf") - strflag = sfinf; - else - error ("norm: unrecognized option: %s", str.c_str ()); - // we've handled the last parameter, so act as if it was removed - nargin --; - } - else if (nargin > 1 && ! args(1).is_scalar_type ()) - gripe_wrong_type_arg ("norm", args(1), true); - - if (! error_state) - { - octave_value p_arg = (nargin > 1) ? args(1) : octave_value (2); - switch (strflag) - { - case sfmatrix: - retval(0) = xnorm (x_arg, p_arg); - break; - case sfcols: - retval(0) = xcolnorms (x_arg, p_arg); - break; - case sfrows: - retval(0) = xrownorms (x_arg, p_arg); - break; - case sffrob: - retval(0) = xfrobnorm (x_arg); - break; - case sfinf: - retval(0) = xnorm (x_arg, octave_Inf); - break; - } - } - } - else - error ("norm: only valid for 2-D objects"); - } - else - print_usage (); - - return retval; -} - -/* -%!shared x -%! x = [1, -3, 4, 5, -7]; -%!assert (norm (x,1), 20) -%!assert (norm (x,2), 10) -%!assert (norm (x,3), 8.24257059961711, -4*eps) -%!assert (norm (x,Inf), 7) -%!assert (norm (x,-Inf), 1) -%!assert (norm (x,"inf"), 7) -%!assert (norm (x,"fro"), 10, -eps) -%!assert (norm (x), 10) -%!assert (norm ([1e200, 1]), 1e200) -%!assert (norm ([3+4i, 3-4i, sqrt(31)]), 9, -4*eps) -%!shared m -%! m = magic (4); -%!assert (norm (m,1), 34) -%!assert (norm (m,2), 34, -eps) -%!assert (norm (m,Inf), 34) -%!assert (norm (m,"inf"), 34) -%!shared m2, flo, fhi -%! m2 = [1,2;3,4]; -%! flo = 1e-300; -%! fhi = 1e+300; -%!assert (norm (flo*m2,"fro"), sqrt (30)*flo, -eps) -%!assert (norm (fhi*m2,"fro"), sqrt (30)*fhi, -eps) - -%!shared x -%! x = single ([1, -3, 4, 5, -7]); -%!assert (norm (x,1), single (20)) -%!assert (norm (x,2), single (10)) -%!assert (norm (x,3), single (8.24257059961711), -4*eps ("single")) -%!assert (norm (x,Inf), single (7)) -%!assert (norm (x,-Inf), single (1)) -%!assert (norm (x,"inf"), single (7)) -%!assert (norm (x,"fro"), single (10), -eps ("single")) -%!assert (norm (x), single (10)) -%!assert (norm (single ([1e200, 1])), single (1e200)) -%!assert (norm (single ([3+4i, 3-4i, sqrt(31)])), single (9), -4*eps ("single")) -%!shared m -%! m = single (magic (4)); -%!assert (norm (m,1), single (34)) -%!assert (norm (m,2), single (34), -eps ("single")) -%!assert (norm (m,Inf), single (34)) -%!assert (norm (m,"inf"), single (34)) -%!shared m2, flo, fhi -%! m2 = single ([1,2;3,4]); -%! flo = single (1e-300); -%! fhi = single (1e+300); -%!assert (norm (flo*m2,"fro"), single (sqrt (30)*flo), -eps ("single")) -%!assert (norm (fhi*m2,"fro"), single (sqrt (30)*fhi), -eps ("single")) - -%!test -%! ## Test for norm returning NaN on sparse matrix (bug #30631) -%! A = sparse (2,2); -%! A(2,1) = 1; -%! assert (norm (A), 1); -*/ - -static octave_value -unary_op_defun_body (octave_value::unary_op op, - const octave_value_list& args) -{ - octave_value retval; - if (args.length () == 1) - retval = do_unary_op (op, args(0)); - else - print_usage (); - - return retval; -} - -DEFUN (not, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} not (@var{x})\n\ -Return the logical NOT of @var{x}. This function is equivalent to\n\ -@code{! x}.\n\ -@seealso{and, or, xor}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_not, args); -} - -DEFUN (uplus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} uplus (@var{x})\n\ -This function and @w{@xcode{+ x}} are equivalent.\n\ -@seealso{uminus, plus, minus}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_uplus, args); -} - -DEFUN (uminus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} uminus (@var{x})\n\ -This function and @w{@xcode{- x}} are equivalent.\n\ -@seealso{uplus, minus}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_uminus, args); -} - -DEFUN (transpose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} transpose (@var{x})\n\ -Return the transpose of @var{x}.\n\ -This function and @xcode{x.'} are equivalent.\n\ -@seealso{ctranspose}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_transpose, args); -} - -/* -%!assert (2.', 2) -%!assert (2i.', 2i) -%!assert ([1:4].', [1;2;3;4]) -%!assert ([1;2;3;4].', [1:4]) -%!assert ([1,2;3,4].', [1,3;2,4]) -%!assert ([1,2i;3,4].', [1,3;2i,4]) - -%!assert (transpose ([1,2;3,4]), [1,3;2,4]) - -%!assert (single (2).', single (2)) -%!assert (single (2i).', single (2i)) -%!assert (single ([1:4]).', single ([1;2;3;4])) -%!assert (single ([1;2;3;4]).', single ([1:4])) -%!assert (single ([1,2;3,4]).', single ([1,3;2,4])) -%!assert (single ([1,2i;3,4]).', single ([1,3;2i,4])) - -%!assert (transpose (single ([1,2;3,4])), single ([1,3;2,4])) -*/ - -DEFUN (ctranspose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ctranspose (@var{x})\n\ -Return the complex conjugate transpose of @var{x}.\n\ -This function and @xcode{x'} are equivalent.\n\ -@seealso{transpose}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_hermitian, args); -} - -/* -%!assert (2', 2) -%!assert (2i', -2i) -%!assert ([1:4]', [1;2;3;4]) -%!assert ([1;2;3;4]', [1:4]) -%!assert ([1,2;3,4]', [1,3;2,4]) -%!assert ([1,2i;3,4]', [1,3;-2i,4]) - -%!assert (ctranspose ([1,2i;3,4]), [1,3;-2i,4]) - -%!assert (single (2)', single (2)) -%!assert (single (2i)', single (-2i)) -%!assert (single ([1:4])', single ([1;2;3;4])) -%!assert (single ([1;2;3;4])', single ([1:4])) -%!assert (single ([1,2;3,4])', single ([1,3;2,4])) -%!assert (single ([1,2i;3,4])', single ([1,3;-2i,4])) - -%!assert (ctranspose (single ([1,2i;3,4])), single ([1,3;-2i,4])) -*/ - -static octave_value -binary_op_defun_body (octave_value::binary_op op, - const octave_value_list& args) -{ - octave_value retval; - - if (args.length () == 2) - retval = do_binary_op (op, args(0), args(1)); - else - print_usage (); - - return retval; -} - -static octave_value -binary_assoc_op_defun_body (octave_value::binary_op op, - octave_value::assign_op aop, - const octave_value_list& args) -{ - octave_value retval; - int nargin = args.length (); - - switch (nargin) - { - case 0: - print_usage (); - break; - case 1: - retval = args(0); - break; - case 2: - retval = do_binary_op (op, args(0), args(1)); - break; - default: - retval = do_binary_op (op, args(0), args(1)); - for (int i = 2; i < nargin; i++) - retval.assign (aop, args(i)); - break; - } - - return retval; -} - -DEFUN (plus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} plus (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} plus (@var{x1}, @var{x2}, @dots{})\n\ -This function and @w{@xcode{x + y}} are equivalent.\n\ -If more arguments are given, the summation is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 + x2) + x3) + @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{minus, uplus}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_add, - octave_value::op_add_eq, args); -} - -DEFUN (minus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} minus (@var{x}, @var{y})\n\ -This function and @w{@xcode{x - y}} are equivalent.\n\ -@seealso{plus, uminus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_sub, args); -} - -DEFUN (mtimes, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mtimes (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} mtimes (@var{x1}, @var{x2}, @dots{})\n\ -Return the matrix multiplication product of inputs.\n\ -This function and @w{@xcode{x * y}} are equivalent.\n\ -If more arguments are given, the multiplication is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 * x2) * x3) * @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{times, plus, minus, rdivide, mrdivide, mldivide, mpower}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_mul, - octave_value::op_mul_eq, args); -} - -DEFUN (mrdivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mrdivide (@var{x}, @var{y})\n\ -Return the matrix right division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x / y}} are equivalent.\n\ -@seealso{mldivide, rdivide, plus, minus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_div, args); -} - -DEFUN (mpower, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mpower (@var{x}, @var{y})\n\ -Return the matrix power operation of @var{x} raised to the @var{y} power.\n\ -This function and @w{@xcode{x ^ y}} are equivalent.\n\ -@seealso{power, mtimes, plus, minus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_pow, args); -} - -DEFUN (mldivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mldivide (@var{x}, @var{y})\n\ -Return the matrix left division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x @xbackslashchar{} y}} are equivalent.\n\ -@seealso{mrdivide, ldivide, rdivide}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_ldiv, args); -} - -DEFUN (lt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} lt (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x < y}}.\n\ -@seealso{le, eq, ge, gt, ne}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_lt, args); -} - -DEFUN (le, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} le (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x <= y}}.\n\ -@seealso{eq, ge, gt, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_le, args); -} - -DEFUN (eq, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eq (@var{x}, @var{y})\n\ -Return true if the two inputs are equal.\n\ -This function is equivalent to @w{@code{x == y}}.\n\ -@seealso{ne, isequal, le, ge, gt, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_eq, args); -} - -DEFUN (ge, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ge (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x >= y}}.\n\ -@seealso{le, eq, gt, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_ge, args); -} - -DEFUN (gt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} gt (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x > y}}.\n\ -@seealso{le, eq, ge, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_gt, args); -} - -DEFUN (ne, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ne (@var{x}, @var{y})\n\ -Return true if the two inputs are not equal.\n\ -This function is equivalent to @w{@code{x != y}}.\n\ -@seealso{eq, isequal, le, ge, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_ne, args); -} - -DEFUN (times, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} times (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} times (@var{x1}, @var{x2}, @dots{})\n\ -Return the element-by-element multiplication product of inputs.\n\ -This function and @w{@xcode{x .* y}} are equivalent.\n\ -If more arguments are given, the multiplication is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 .* x2) .* x3) .* @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{mtimes, rdivide}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_el_mul, - octave_value::op_el_mul_eq, args); -} - -DEFUN (rdivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rdivide (@var{x}, @var{y})\n\ -Return the element-by-element right division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x ./ y}} are equivalent.\n\ -@seealso{ldivide, mrdivide, times, plus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_el_div, args); -} - -DEFUN (power, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} power (@var{x}, @var{y})\n\ -Return the element-by-element operation of @var{x} raised to the\n\ -@var{y} power. If several complex results are possible,\n\ -returns the one with smallest non-negative argument (angle). Use\n\ -@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ -real result is preferred.\n\ -\n\ -This function and @w{@xcode{x .^ y}} are equivalent.\n\ -@seealso{mpower, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_el_pow, args); -} - -DEFUN (ldivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ldivide (@var{x}, @var{y})\n\ -Return the element-by-element left division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x .@xbackslashchar{} y}} are equivalent.\n\ -@seealso{rdivide, mldivide, times, plus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_el_ldiv, args); -} - -DEFUN (and, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} and (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} and (@var{x1}, @var{x2}, @dots{})\n\ -Return the logical AND of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x & y}}.\n\ -If more arguments are given, the logical and is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 & x2) & x3) & @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{or, not, xor}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_el_and, - octave_value::op_el_and_eq, args); -} - -DEFUN (or, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} or (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} or (@var{x1}, @var{x2}, @dots{})\n\ -Return the logical OR of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x | y}}.\n\ -If more arguments are given, the logical or is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 | x2) | x3) | @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{and, not, xor}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_el_or, - octave_value::op_el_or_eq, args); -} - -static double tic_toc_timestamp = -1.0; - -DEFUN (tic, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} tic ()\n\ -@deftypefnx {Built-in Function} {@var{id} =} tic ()\n\ -@deftypefnx {Built-in Function} {} toc ()\n\ -@deftypefnx {Built-in Function} {} toc (@var{id})\n\ -@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ -Set or check a wall-clock timer. Calling @code{tic} without an\n\ -output argument sets the internal timer state. Subsequent calls\n\ -to @code{toc} return the number of seconds since the timer was set.\n\ -For example,\n\ -\n\ -@example\n\ -@group\n\ -tic ();\n\ -# many computations later@dots{}\n\ -elapsed_time = toc ();\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -will set the variable @code{elapsed_time} to the number of seconds since\n\ -the most recent call to the function @code{tic}.\n\ -\n\ -If called with one output argument, @code{tic} returns a scalar\n\ -of type @code{uint64} that may be later passed to @code{toc}.\n\ -\n\ -@example\n\ -@group\n\ -id = tic; sleep (5); toc (id)\n\ - @result{} 5.0010\n\ -@end group\n\ -@end example\n\ -\n\ -Calling @code{tic} and @code{toc} this way allows nested timing calls.\n\ -\n\ -If you are more interested in the CPU time that your process used, you\n\ -should use the @code{cputime} function instead. The @code{tic} and\n\ -@code{toc} functions report the actual wall clock time that elapsed\n\ -between the calls. This may include time spent processing other jobs or\n\ -doing nothing at all.\n\ -@seealso{toc, cputime}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin != 0) - warning ("tic: ignoring extra arguments"); - - octave_time now; - - double tmp = now.double_value (); - - if (nargout > 0) - { - double ip = 0.0; - double frac = modf (tmp, &ip); - uint64_t microsecs = static_cast (CLOCKS_PER_SEC * frac); - microsecs += CLOCKS_PER_SEC * static_cast (ip); - retval = octave_uint64 (microsecs); - } - else - tic_toc_timestamp = tmp; - - return retval; -} - -DEFUN (toc, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} toc ()\n\ -@deftypefnx {Built-in Function} {} toc (@var{id})\n\ -@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ -@seealso{tic, cputime}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - double start_time = tic_toc_timestamp; - - if (nargin > 1) - print_usage (); - else - { - if (nargin == 1) - { - octave_uint64 id = args(0).uint64_scalar_value (); - - if (! error_state) - { - uint64_t val = id.value (); - - start_time - = (static_cast (val / CLOCKS_PER_SEC) - + static_cast (val % CLOCKS_PER_SEC) / CLOCKS_PER_SEC); - - // FIXME -- should we also check to see whether the start - // time is after the beginning of this Octave session? - } - else - error ("toc: invalid ID"); - } - - if (! error_state) - { - if (start_time < 0) - error ("toc called before timer set"); - else - { - octave_time now; - - double tmp = now.double_value () - start_time; - - if (nargout > 0) - retval = tmp; - else - octave_stdout << "Elapsed time is " << tmp << " seconds.\n"; - } - } - } - - return retval; -} - -/* -%!shared id -%! id = tic (); -%!assert (isa (id, "uint64")) -%!assert (isa (toc (id), "double")) -*/ - -DEFUN (cputime, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{total}, @var{user}, @var{system}] =} cputime ();\n\ -Return the CPU time used by your Octave session. The first output is\n\ -the total time spent executing your process and is equal to the sum of\n\ -second and third outputs, which are the number of CPU seconds spent\n\ -executing in user mode and the number of CPU seconds spent executing in\n\ -system mode, respectively. If your system does not have a way to report\n\ -CPU time usage, @code{cputime} returns 0 for each of its output values.\n\ -Note that because Octave used some CPU time to start, it is reasonable\n\ -to check to see if @code{cputime} works by checking to see if the total\n\ -CPU time used is nonzero.\n\ -@seealso{tic, toc}\n\ -@end deftypefn") -{ - octave_value_list retval; - int nargin = args.length (); - double usr = 0.0; - double sys = 0.0; - - if (nargin != 0) - warning ("tic: ignoring extra arguments"); - -#if defined (HAVE_GETRUSAGE) - - struct rusage ru; - - getrusage (RUSAGE_SELF, &ru); - - usr = static_cast (ru.ru_utime.tv_sec) + - static_cast (ru.ru_utime.tv_usec) * 1e-6; - - sys = static_cast (ru.ru_stime.tv_sec) + - static_cast (ru.ru_stime.tv_usec) * 1e-6; - -#else - - struct tms t; - - times (&t); - - unsigned long ticks; - unsigned long seconds; - unsigned long fraction; - - ticks = t.tms_utime + t.tms_cutime; - fraction = ticks % CLOCKS_PER_SEC; - seconds = ticks / CLOCKS_PER_SEC; - - usr = static_cast (seconds) + static_cast(fraction) / - static_cast(CLOCKS_PER_SEC); - - ticks = t.tms_stime + t.tms_cstime; - fraction = ticks % CLOCKS_PER_SEC; - seconds = ticks / CLOCKS_PER_SEC; - - sys = static_cast (seconds) + static_cast(fraction) / - static_cast(CLOCKS_PER_SEC); - -#endif - - retval(2) = sys; - retval(1) = usr; - retval(0) = sys + usr; - - return retval; -} - -DEFUN (sort, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x})\n\ -@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim})\n\ -@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{mode})\n\ -@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim}, @var{mode})\n\ -Return a copy of @var{x} with the elements arranged in increasing\n\ -order. For matrices, @code{sort} orders the elements within columns\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -sort ([1, 2; 2, 3; 3, 1])\n\ - @result{} 1 1\n\ - 2 2\n\ - 3 3\n\ -@end group\n\ -@end example\n\ -\n\ -If the optional argument @var{dim} is given, then the matrix is sorted\n\ -along the dimension defined by @var{dim}. The optional argument @code{mode}\n\ -defines the order in which the values will be sorted. Valid values of\n\ -@code{mode} are \"ascend\" or \"descend\".\n\ -\n\ -The @code{sort} function may also be used to produce a matrix\n\ -containing the original row indices of the elements in the sorted\n\ -matrix. For example:\n\ -\n\ -@example\n\ -@group\n\ -[s, i] = sort ([1, 2; 2, 3; 3, 1])\n\ - @result{} s = 1 1\n\ - 2 2\n\ - 3 3\n\ - @result{} i = 1 3\n\ - 2 1\n\ - 3 2\n\ -@end group\n\ -@end example\n\ -\n\ -For equal elements, the indices are such that equal elements are listed\n\ -in the order in which they appeared in the original list.\n\ -\n\ -Sorting of complex entries is done first by magnitude (@code{abs (@var{z})})\n\ -and for any ties by phase angle (@code{angle (z)}). For example:\n\ -\n\ -@example\n\ -@group\n\ -sort ([1+i; 1; 1-i])\n\ - @result{} 1 + 0i\n\ - 1 - 1i\n\ - 1 + 1i\n\ -@end group\n\ -@end example\n\ -\n\ -NaN values are treated as being greater than any other value and are sorted\n\ -to the end of the list.\n\ -\n\ -The @code{sort} function may also be used to sort strings and cell arrays\n\ -of strings, in which case ASCII dictionary order (uppercase 'A' precedes\n\ -lowercase 'a') of the strings is used.\n\ -\n\ -The algorithm used in @code{sort} is optimized for the sorting of partially\n\ -ordered lists.\n\ -@seealso{sortrows, issorted}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - sortmode smode = ASCENDING; - - if (nargin < 1 || nargin > 3) - { - print_usage (); - return retval; - } - - bool return_idx = nargout > 1; - - octave_value arg = args(0); - - int dim = 0; - if (nargin > 1) - { - if (args(1).is_string ()) - { - std::string mode = args(1).string_value (); - if (mode == "ascend") - smode = ASCENDING; - else if (mode == "descend") - smode = DESCENDING; - else - { - error ("sort: MODE must be either \"ascend\" or \"descend\""); - return retval; - } - } - else - dim = args(1).nint_value () - 1; - } - - if (nargin > 2) - { - if (args(1).is_string ()) - { - print_usage (); - return retval; - } - - if (! args(2).is_string ()) - { - error ("sort: MODE must be a string"); - return retval; - } - std::string mode = args(2).string_value (); - if (mode == "ascend") - smode = ASCENDING; - else if (mode == "descend") - smode = DESCENDING; - else - { - error ("sort: MODE must be either \"ascend\" or \"descend\""); - return retval; - } - } - - const dim_vector dv = arg.dims (); - if (nargin == 1 || args(1).is_string ()) - { - // Find first non singleton dimension - dim = dv.first_non_singleton (); - } - else - { - if (dim < 0) - { - error ("sort: DIM must be a valid dimension"); - return retval; - } - } - - if (return_idx) - { - retval.resize (2); - - Array sidx; - - retval(0) = arg.sort (sidx, dim, smode); - retval(1) = idx_vector (sidx, dv(dim)); // No checking, the extent is known. - } - else - retval(0) = arg.sort (dim, smode); - - return retval; -} - -/* -## Double -%!assert (sort ([NaN, 1, -1, 2, Inf]), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 1), [NaN, 1, -1, 2, Inf]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 2), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 3), [NaN, 1, -1, 2, Inf]) -%!assert (sort ([NaN, 1, -1, 2, Inf], "ascend"), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "ascend"), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], "descend"), [NaN, Inf, 2, 1, -1]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, 1, -1]) -%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4]), [3, 1, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 1), [3, 1, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 2), [1, 3, 5, 7; 2, 4, 6, 8]) -%!assert (sort (1), 1) - -%!test -%! [v, i] = sort ([NaN, 1, -1, Inf, 1]); -%! assert (v, [-1, 1, 1, Inf, NaN]); -%! assert (i, [3, 2, 5, 4, 1]); - -## Complex -%!assert (sort ([NaN, 1i, -1, 2, Inf]), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 1), [NaN, 1i, -1, 2, Inf]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 2), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 3), [NaN, 1i, -1, 2, Inf]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], "ascend"), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "ascend"), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], "descend"), [NaN, Inf, 2, -1, 1i]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, -1, 1i]) -%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4]), [3, 1i, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 1), [3, 1i, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 2), [1i, 3, 5, 7; 2, 4, 6, 8]) -%!assert (sort (1i), 1i) - -%!test -%! [v, i] = sort ([NaN, 1i, -1, Inf, 1, 1i]); -%! assert (v, [1, 1i, 1i, -1, Inf, NaN]); -%! assert (i, [5, 2, 6, 3, 4, 1]); - -## Single -%!assert (sort (single ([NaN, 1, -1, 2, Inf])), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 1), single ([NaN, 1, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 3), single ([NaN, 1, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "ascend"), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "ascend"), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, 1, -1])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, 1, -1])) -%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4])), single ([3, 1, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 2), single ([1, 3, 5, 7; 2, 4, 6, 8])) -%!assert (sort (single (1)), single (1)) - -%!test -%! [v, i] = sort (single ([NaN, 1, -1, Inf, 1])); -%! assert (v, single ([-1, 1, 1, Inf, NaN])); -%! assert (i, [3, 2, 5, 4, 1]); - -## Single Complex -%!assert (sort (single ([NaN, 1i, -1, 2, Inf])), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 1), single ([NaN, 1i, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 3), single ([NaN, 1i, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "ascend"), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "ascend"), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, -1, 1i])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, -1, 1i])) -%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4])), single ([3, 1i, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1i, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 2), single ([1i, 3, 5, 7; 2, 4, 6, 8])) -%!assert (sort (single (1i)), single (1i)) - -%!test -%! [v, i] = sort (single ([NaN, 1i, -1, Inf, 1, 1i])); -%! assert (v, single ([1, 1i, 1i, -1, Inf, NaN])); -%! assert (i, [5, 2, 6, 3, 4, 1]); - -## Bool -%!assert (sort ([true, false, true, false]), [false, false, true, true]) -%!assert (sort ([true, false, true, false], 1), [true, false, true, false]) -%!assert (sort ([true, false, true, false], 2), [false, false, true, true]) -%!assert (sort ([true, false, true, false], 3), [true, false, true, false]) -%!assert (sort ([true, false, true, false], "ascend"), [false, false, true, true]) -%!assert (sort ([true, false, true, false], 2, "ascend"), [false, false, true, true]) -%!assert (sort ([true, false, true, false], "descend"), [true, true, false, false]) -%!assert (sort ([true, false, true, false], 2, "descend"), [true, true, false, false]) -%!assert (sort (true), true) - -%!test -%! [v, i] = sort ([true, false, true, false]); -%! assert (v, [false, false, true, true]); -%! assert (i, [2, 4, 1, 3]); - -## Sparse Double -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf])), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) - -%!shared a -%! a = randn (10, 10); -%! a(a < 0) = 0; -%!assert (sort (sparse (a)), sparse (sort (a))) -%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) -%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) -%!test -%! [v, i] = sort (a); -%! [vs, is] = sort (sparse (a)); -%! assert (vs, sparse (v)); -%! assert (is, i); - -## Sparse Complex -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf])), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) - -%!shared a -%! a = randn (10, 10); -%! a(a < 0) = 0; -%! a = 1i * a; -%!assert (sort (sparse (a)), sparse (sort (a))) -%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) -%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) -%!test -%! [v, i] = sort (a); -%! [vs, is] = sort (sparse (a)); -%! assert (vs, sparse (v)); -%! assert (is, i); - -## Sparse Bool -%!assert (sort (sparse ([true, false, true, false])), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), 1), sparse ([true, false, true, false])) -%!assert (sort (sparse ([true, false, true, false]), 2), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), 3), sparse ([true, false, true, false])) -%!assert (sort (sparse ([true, false, true, false]), "ascend"), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), 2, "ascend"), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), "descend"), sparse ([true, true, false, false])) -%!assert (sort (sparse ([true, false, true, false]), 2, "descend"), sparse ([true, true, false, false])) - -%!test -%! [v, i] = sort (sparse ([true, false, true, false])); -%! assert (v, sparse ([false, false, true, true])); -%! assert (i, [2, 4, 1, 3]); - -## Cell string array -%!shared a, b, c -%! a = {"Alice", "Cecile", "Eric", "Barry", "David"}; -%! b = {"Alice", "Barry", "Cecile", "David", "Eric"}; -%! c = {"Eric", "David", "Cecile", "Barry", "Alice"}; -%!assert (sort (a), b) -%!assert (sort (a, 1), a) -%!assert (sort (a, 2), b) -%!assert (sort (a, 3), a) -%!assert (sort (a, "ascend"), b) -%!assert (sort (a, 2, "ascend"), b) -%!assert (sort (a, "descend"), c) -%!assert (sort (a, 2, "descend"), c) - -%!test -%! [v, i] = sort (a); -%! assert (i, [1, 4, 2, 5, 3]); - -%!error sort () -%!error sort (1, 2, 3, 4) -*/ - -// Sort the rows of the matrix @var{a} according to the order -// specified by @var{mode}, which can either be `ascend' or `descend' -// and return the index vector corresponding to the sort order. -// -// This function does not yet support sparse matrices. - -DEFUN (__sort_rows_idx__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __sort_rows_idx__ (@var{a}, @var{mode})\n\ -Undocumented internal function.\n\ -@end deftypefn\n") -{ - octave_value retval; - - int nargin = args.length (); - sortmode smode = ASCENDING; - - if (nargin < 1 || nargin > 2 || (nargin == 2 && ! args(1).is_string ())) - { - print_usage (); - return retval; - } - - if (nargin > 1) - { - std::string mode = args(1).string_value (); - if (mode == "ascend") - smode = ASCENDING; - else if (mode == "descend") - smode = DESCENDING; - else - { - error ("__sort_rows_idx__: MODE must be either \"ascend\" or \"descend\""); - return retval; - } - } - - octave_value arg = args(0); - - if (arg.is_sparse_type ()) - error ("__sort_rows_idx__: sparse matrices not yet supported"); - if (arg.ndims () == 2) - { - Array idx = arg.sort_rows_idx (smode); - - retval = octave_value (idx, true, true); - } - else - error ("__sort_rows_idx__: needs a 2-dimensional object"); - - return retval; -} - -static sortmode -get_sort_mode_option (const octave_value& arg, const char *argn) -{ - // FIXME -- we initialize to UNSORTED here to avoid a GCC warning - // about possibly using sortmode uninitialized. - // FIXME -- shouldn't these modes be scoped inside a class? - sortmode smode = UNSORTED; - - std::string mode = arg.string_value (); - - if (error_state) - error ("issorted: expecting %s argument to be a character string", argn); - else if (mode == "ascending") - smode = ASCENDING; - else if (mode == "descending") - smode = DESCENDING; - else if (mode == "either") - smode = UNSORTED; - else - error ("issorted: MODE must be \"ascending\", \"descending\", or \"either\""); - - return smode; -} - -DEFUN (issorted, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} issorted (@var{a})\n\ -@deftypefnx {Built-in Function} {} issorted (@var{a}, @var{mode})\n\ -@deftypefnx {Built-in Function} {} issorted (@var{a}, \"rows\", @var{mode})\n\ -Return true if the array is sorted according to @var{mode}, which\n\ -may be either \"ascending\", \"descending\", or \"either\". By default,\n\ - @var{mode} is \"ascending\". NaNs are treated in the same manner as\n\ -@code{sort}.\n\ -\n\ -If the optional argument \"rows\" is supplied, check whether\n\ -the array is sorted by rows as output by the function @code{sortrows}\n\ -(with no options).\n\ -\n\ -This function does not support sparse matrices.\n\ -@seealso{sort, sortrows}\n\ -@end deftypefn\n") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 3) - { - print_usage (); - return retval; - } - - bool by_rows = false; - - sortmode smode = ASCENDING; - - if (nargin > 1) - { - octave_value mode_arg; - - if (nargin == 3) - smode = get_sort_mode_option (args(2), "third"); - - std::string tmp = args(1).string_value (); - - if (! error_state) - { - if (tmp == "rows") - by_rows = true; - else - smode = get_sort_mode_option (args(1), "second"); - } - else - error ("expecting second argument to be character string"); - - if (error_state) - return retval; - } - - octave_value arg = args(0); - - if (by_rows) - { - if (arg.is_sparse_type ()) - error ("issorted: sparse matrices not yet supported"); - if (arg.ndims () == 2) - retval = arg.is_sorted_rows (smode) != UNSORTED; - else - error ("issorted: A must be a 2-dimensional object"); - } - else - { - if (arg.dims ().is_vector ()) - retval = args(0).is_sorted (smode) != UNSORTED; - else - error ("issorted: needs a vector"); - } - - return retval; -} - -/* -%!shared sm, um, sv, uv -%! sm = [1, 2; 3, 4]; -%! um = [3, 1; 2, 4]; -%! sv = [1, 2, 3, 4]; -%! uv = [2, 1, 4, 3]; -%!assert (issorted (sm, "rows")) -%!assert (!issorted (um, "rows")) -%!assert (issorted (sv)) -%!assert (!issorted (uv)) -%!assert (issorted (sv')) -%!assert (!issorted (uv')) -%!assert (issorted (sm, "rows", "ascending")) -%!assert (!issorted (um, "rows", "ascending")) -%!assert (issorted (sv, "ascending")) -%!assert (!issorted (uv, "ascending")) -%!assert (issorted (sv', "ascending")) -%!assert (!issorted (uv', "ascending")) -%!assert (!issorted (sm, "rows", "descending")) -%!assert (issorted (flipud (sm), "rows", "descending")) -%!assert (!issorted (sv, "descending")) -%!assert (issorted (fliplr (sv), "descending")) -%!assert (!issorted (sv', "descending")) -%!assert (issorted (fliplr (sv)', "descending")) -%!assert (!issorted (um, "rows", "either")) -%!assert (!issorted (uv, "either")) -%!assert (issorted (sm, "rows", "either")) -%!assert (issorted (flipud (sm), "rows", "either")) -%!assert (issorted (sv, "either")) -%!assert (issorted (fliplr (sv), "either")) -%!assert (issorted (sv', "either")) -%!assert (issorted (fliplr (sv)', "either")) -*/ - -DEFUN (nth_element, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} nth_element (@var{x}, @var{n})\n\ -@deftypefnx {Built-in Function} {} nth_element (@var{x}, @var{n}, @var{dim})\n\ -Select the n-th smallest element of a vector, using the ordering defined by\n\ -@code{sort}. In other words, the result is equivalent to\n\ -@code{sort(@var{x})(@var{n})}.\n\ -@var{n} can also be a contiguous range, either ascending @code{l:u}\n\ -or descending @code{u:-1:l}, in which case a range of elements is returned.\n\ -If @var{x} is an array, @code{nth_element} operates along the dimension\n\ -defined by @var{dim}, or the first non-singleton dimension if @var{dim} is\n\ -not given.\n\ -\n\ -nth_element encapsulates the C++ standard library algorithms nth_element and\n\ -partial_sort. On average, the complexity of the operation is O(M*log(K)),\n\ -where @w{@code{M = size (@var{x}, @var{dim})}} and\n\ -@w{@code{K = length (@var{n})}}.\n\ -This function is intended for cases where the ratio K/M is small; otherwise,\n\ -it may be better to use @code{sort}.\n\ -@seealso{sort, min, max}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - octave_value argx = args(0); - - int dim = -1; - if (nargin == 3) - { - dim = args(2).int_value (true) - 1; - if (dim < 0) - error ("nth_element: DIM must be a valid dimension"); - } - if (dim < 0) - dim = argx.dims ().first_non_singleton (); - - idx_vector n = args(1).index_vector (); - - if (error_state) - return retval; - - switch (argx.builtin_type ()) - { - case btyp_double: - retval = argx.array_value ().nth_element (n, dim); - break; - case btyp_float: - retval = argx.float_array_value ().nth_element (n, dim); - break; - case btyp_complex: - retval = argx.complex_array_value ().nth_element (n, dim); - break; - case btyp_float_complex: - retval = argx.float_complex_array_value ().nth_element (n, dim); - break; -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - retval = argx.X ## _array_value ().nth_element (n, dim); \ - break - - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - default: - if (argx.is_cellstr ()) - retval = argx.cellstr_value ().nth_element (n, dim); - else - gripe_wrong_type_arg ("nth_element", argx); - } - } - else - print_usage (); - - return retval; -} - -template -static NDT -do_accumarray_sum (const idx_vector& idx, const NDT& vals, - octave_idx_type n = -1) -{ - typedef typename NDT::element_type T; - if (n < 0) - n = idx.extent (0); - else if (idx.extent (n) > n) - error ("accumarray: index out of range"); - - NDT retval (dim_vector (n, 1), T ()); - - if (vals.numel () == 1) - retval.idx_add (idx, vals (0)); - else if (vals.numel () == idx.length (n)) - retval.idx_add (idx, vals); - else - error ("accumarray: dimensions mismatch"); - - return retval; -} - -DEFUN (__accumarray_sum__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumarray_sum__ (@var{idx}, @var{vals}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - if (nargin >= 2 && nargin <= 3 && args(0).is_numeric_type ()) - { - idx_vector idx = args(0).index_vector (); - octave_idx_type n = -1; - if (nargin == 3) - n = args(2).idx_type_value (true); - - if (! error_state) - { - octave_value vals = args(1); - if (vals.is_range ()) - { - Range r = vals.range_value (); - if (r.inc () == 0) - vals = r.base (); - } - - if (vals.is_single_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumarray_sum (idx, vals.float_complex_array_value (), n); - else - retval = do_accumarray_sum (idx, vals.float_array_value (), n); - } - else if (vals.is_numeric_type () || vals.is_bool_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumarray_sum (idx, vals.complex_array_value (), n); - else - retval = do_accumarray_sum (idx, vals.array_value (), n); - } - else - gripe_wrong_type_arg ("accumarray", vals); - } - } - else - print_usage (); - - return retval; -} - -template -static NDT -do_accumarray_minmax (const idx_vector& idx, const NDT& vals, - octave_idx_type n, bool ismin, - const typename NDT::element_type& zero_val) -{ - typedef typename NDT::element_type T; - if (n < 0) - n = idx.extent (0); - else if (idx.extent (n) > n) - error ("accumarray: index out of range"); - - NDT retval (dim_vector (n, 1), zero_val); - - // Pick minimizer or maximizer. - void (MArray::*op) (const idx_vector&, const MArray&) = - ismin ? (&MArray::idx_min) : (&MArray::idx_max); - - octave_idx_type l = idx.length (n); - if (vals.numel () == 1) - (retval.*op) (idx, NDT (dim_vector (l, 1), vals(0))); - else if (vals.numel () == l) - (retval.*op) (idx, vals); - else - error ("accumarray: dimensions mismatch"); - - return retval; -} - -static octave_value_list -do_accumarray_minmax_fun (const octave_value_list& args, - bool ismin) -{ - octave_value retval; - int nargin = args.length (); - if (nargin >= 3 && nargin <= 4 && args(0).is_numeric_type ()) - { - idx_vector idx = args(0).index_vector (); - octave_idx_type n = -1; - if (nargin == 4) - n = args(3).idx_type_value (true); - - if (! error_state) - { - octave_value vals = args(1), zero = args (2); - - switch (vals.builtin_type ()) - { - case btyp_double: - retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, - zero.double_value ()); - break; - case btyp_float: - retval = do_accumarray_minmax (idx, vals.float_array_value (), n, ismin, - zero.float_value ()); - break; - case btyp_complex: - retval = do_accumarray_minmax (idx, vals.complex_array_value (), n, ismin, - zero.complex_value ()); - break; - case btyp_float_complex: - retval = do_accumarray_minmax (idx, vals.float_complex_array_value (), n, ismin, - zero.float_complex_value ()); - break; -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - retval = do_accumarray_minmax (idx, vals.X ## _array_value (), n, ismin, \ - zero.X ## _scalar_value ()); \ - break - - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - case btyp_bool: - retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, - zero.bool_value ()); - break; - default: - gripe_wrong_type_arg ("accumarray", vals); - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (__accumarray_min__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumarray_min__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return do_accumarray_minmax_fun (args, true); -} - -DEFUN (__accumarray_max__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumarray_max__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return do_accumarray_minmax_fun (args, false); -} - -template -static NDT -do_accumdim_sum (const idx_vector& idx, const NDT& vals, - int dim = -1, octave_idx_type n = -1) -{ - typedef typename NDT::element_type T; - if (n < 0) - n = idx.extent (0); - else if (idx.extent (n) > n) - error ("accumdim: index out of range"); - - dim_vector vals_dim = vals.dims (), rdv = vals_dim; - - if (dim < 0) - dim = vals.dims ().first_non_singleton (); - else if (dim >= rdv.length ()) - rdv.resize (dim+1, 1); - - rdv(dim) = n; - - NDT retval (rdv, T ()); - - if (idx.length () != vals_dim(dim)) - error ("accumdim: dimension mismatch"); - - retval.idx_add_nd (idx, vals, dim); - - return retval; -} - -DEFUN (__accumdim_sum__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumdim_sum__ (@var{idx}, @var{vals}, @var{dim}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - if (nargin >= 2 && nargin <= 4 && args(0).is_numeric_type ()) - { - idx_vector idx = args(0).index_vector (); - int dim = -1; - if (nargin >= 3) - dim = args(2).int_value () - 1; - - octave_idx_type n = -1; - if (nargin == 4) - n = args(3).idx_type_value (true); - - if (! error_state) - { - octave_value vals = args(1); - - if (vals.is_single_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumdim_sum (idx, vals.float_complex_array_value (), dim, n); - else - retval = do_accumdim_sum (idx, vals.float_array_value (), dim, n); - } - else if (vals.is_numeric_type () || vals.is_bool_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumdim_sum (idx, vals.complex_array_value (), dim, n); - else - retval = do_accumdim_sum (idx, vals.array_value (), dim, n); - } - else - gripe_wrong_type_arg ("accumdim", vals); - } - } - else - print_usage (); - - return retval; -} - -template -static NDT -do_merge (const Array& mask, - const NDT& tval, const NDT& fval) -{ - typedef typename NDT::element_type T; - dim_vector dv = mask.dims (); - NDT retval (dv); - - bool tscl = tval.numel () == 1, fscl = fval.numel () == 1; - - if ((! tscl && tval.dims () != dv) - || (! fscl && fval.dims () != dv)) - error ("merge: MASK, TVAL, and FVAL dimensions must match"); - else - { - T *rv = retval.fortran_vec (); - octave_idx_type n = retval.numel (); - - const T *tv = tval.data (), *fv = fval.data (); - const bool *mv = mask.data (); - - if (tscl) - { - if (fscl) - { - T ts = tv[0], fs = fv[0]; - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? ts : fs; - } - else - { - T ts = tv[0]; - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? ts : fv[i]; - } - } - else - { - if (fscl) - { - T fs = fv[0]; - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? tv[i] : fs; - } - else - { - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? tv[i] : fv[i]; - } - } - } - - return retval; -} - -#define MAKE_INT_BRANCH(INTX) \ - else if (tval.is_ ## INTX ## _type () && fval.is_ ## INTX ## _type ()) \ - { \ - retval = do_merge (mask, \ - tval.INTX ## _array_value (), \ - fval.INTX ## _array_value ()); \ - } - -DEFUN (merge, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} merge (@var{mask}, @var{tval}, @var{fval})\n\ -@deftypefnx {Built-in Function} {} ifelse (@var{mask}, @var{tval}, @var{fval})\n\ -Merge elements of @var{true_val} and @var{false_val}, depending on the\n\ -value of @var{mask}. If @var{mask} is a logical scalar, the other two\n\ -arguments can be arbitrary values. Otherwise, @var{mask} must be a logical\n\ -array, and @var{tval}, @var{fval} should be arrays of matching class, or\n\ -cell arrays. In the scalar mask case, @var{tval} is returned if @var{mask}\n\ -is true, otherwise @var{fval} is returned.\n\ -\n\ -In the array mask case, both @var{tval} and @var{fval} must be either\n\ -scalars or arrays with dimensions equal to @var{mask}. The result is\n\ -constructed as follows:\n\ -\n\ -@example\n\ -@group\n\ -result(mask) = tval(mask);\n\ -result(! mask) = fval(! mask);\n\ -@end group\n\ -@end example\n\ -\n\ -@var{mask} can also be arbitrary numeric type, in which case\n\ -it is first converted to logical.\n\ -@seealso{logical, diff}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value retval; - - if (nargin == 3 && (args(0).is_bool_type () || args(0).is_numeric_type ())) - { - octave_value mask_val = args(0); - - if (mask_val.is_scalar_type ()) - retval = mask_val.is_true () ? args(1) : args(2); - else - { - boolNDArray mask = mask_val.bool_array_value (); - octave_value tval = args(1), fval = args(2); - if (tval.is_double_type () && fval.is_double_type ()) - { - if (tval.is_complex_type () || fval.is_complex_type ()) - retval = do_merge (mask, - tval.complex_array_value (), - fval.complex_array_value ()); - else - retval = do_merge (mask, - tval.array_value (), - fval.array_value ()); - } - else if (tval.is_single_type () && fval.is_single_type ()) - { - if (tval.is_complex_type () || fval.is_complex_type ()) - retval = do_merge (mask, - tval.float_complex_array_value (), - fval.float_complex_array_value ()); - else - retval = do_merge (mask, - tval.float_array_value (), - fval.float_array_value ()); - } - else if (tval.is_string () && fval.is_string ()) - { - bool sq_string = tval.is_sq_string () || fval.is_sq_string (); - retval = octave_value (do_merge (mask, - tval.char_array_value (), - fval.char_array_value ()), - sq_string ? '\'' : '"'); - } - else if (tval.is_cell () && fval.is_cell ()) - { - retval = do_merge (mask, - tval.cell_value (), - fval.cell_value ()); - } - - MAKE_INT_BRANCH (int8) - MAKE_INT_BRANCH (int16) - MAKE_INT_BRANCH (int32) - MAKE_INT_BRANCH (int64) - MAKE_INT_BRANCH (uint8) - MAKE_INT_BRANCH (uint16) - MAKE_INT_BRANCH (uint32) - MAKE_INT_BRANCH (uint64) - - else - error ("merge: cannot merge %s with %s with array mask", - tval.class_name ().c_str (), - fval.class_name ().c_str ()); - } - } - else - print_usage (); - - return retval; -} - -DEFALIAS (ifelse, merge); - -#undef MAKE_INT_BRANCH - -template -static SparseT -do_sparse_diff (const SparseT& array, octave_idx_type order, - int dim) -{ - SparseT retval = array; - if (dim == 1) - { - octave_idx_type k = retval.columns (); - while (order > 0 && k > 0) - { - idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); - retval = SparseT (retval.index (col1, sl1)) - SparseT (retval.index (col2, sl2)); - assert (retval.columns () == k-1); - order--; - k--; - } - } - else - { - octave_idx_type k = retval.rows (); - while (order > 0 && k > 0) - { - idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); - retval = SparseT (retval.index (sl1, col1)) - SparseT (retval.index (sl2, col2)); - assert (retval.rows () == k-1); - order--; - k--; - } - } - - return retval; -} - -static octave_value -do_diff (const octave_value& array, octave_idx_type order, - int dim = -1) -{ - octave_value retval; - - const dim_vector& dv = array.dims (); - if (dim == -1) - { - dim = array.dims ().first_non_singleton (); - - // Bother Matlab. This behavior is really wicked. - if (dv(dim) <= order) - { - if (dv(dim) == 1) - retval = array.resize (dim_vector (0, 0)); - else - { - retval = array; - while (order > 0) - { - if (dim == dv.length ()) - { - retval = do_diff (array, order, dim - 1); - order = 0; - } - else if (dv(dim) == 1) - dim++; - else - { - retval = do_diff (array, dv(dim) - 1, dim); - order -= dv(dim) - 1; - dim++; - } - } - } - - return retval; - } - } - - if (array.is_integer_type ()) - { - if (array.is_int8_type ()) - retval = array.int8_array_value ().diff (order, dim); - else if (array.is_int16_type ()) - retval = array.int16_array_value ().diff (order, dim); - else if (array.is_int32_type ()) - retval = array.int32_array_value ().diff (order, dim); - else if (array.is_int64_type ()) - retval = array.int64_array_value ().diff (order, dim); - else if (array.is_uint8_type ()) - retval = array.uint8_array_value ().diff (order, dim); - else if (array.is_uint16_type ()) - retval = array.uint16_array_value ().diff (order, dim); - else if (array.is_uint32_type ()) - retval = array.uint32_array_value ().diff (order, dim); - else if (array.is_uint64_type ()) - retval = array.uint64_array_value ().diff (order, dim); - else - panic_impossible (); - } - else if (array.is_sparse_type ()) - { - if (array.is_complex_type ()) - retval = do_sparse_diff (array.sparse_complex_matrix_value (), order, dim); - else - retval = do_sparse_diff (array.sparse_matrix_value (), order, dim); - } - else if (array.is_single_type ()) - { - if (array.is_complex_type ()) - retval = array.float_complex_array_value ().diff (order, dim); - else - retval = array.float_array_value ().diff (order, dim); - } - else - { - if (array.is_complex_type ()) - retval = array.complex_array_value ().diff (order, dim); - else - retval = array.array_value ().diff (order, dim); - } - - return retval; -} - -DEFUN (diff, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} diff (@var{x})\n\ -@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k})\n\ -@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k}, @var{dim})\n\ -If @var{x} is a vector of length @math{n}, @code{diff (@var{x})} is the\n\ -vector of first differences\n\ -@tex\n\ - $x_2 - x_1, \\ldots{}, x_n - x_{n-1}$.\n\ -@end tex\n\ -@ifnottex\n\ - @var{x}(2) - @var{x}(1), @dots{}, @var{x}(n) - @var{x}(n-1).\n\ -@end ifnottex\n\ -\n\ -If @var{x} is a matrix, @code{diff (@var{x})} is the matrix of column\n\ -differences along the first non-singleton dimension.\n\ -\n\ -The second argument is optional. If supplied, @code{diff (@var{x},\n\ -@var{k})}, where @var{k} is a non-negative integer, returns the\n\ -@var{k}-th differences. It is possible that @var{k} is larger than\n\ -the first non-singleton dimension of the matrix. In this case,\n\ -@code{diff} continues to take the differences along the next\n\ -non-singleton dimension.\n\ -\n\ -The dimension along which to take the difference can be explicitly\n\ -stated with the optional variable @var{dim}. In this case the\n\ -@var{k}-th order differences are calculated along this dimension.\n\ -In the case where @var{k} exceeds @code{size (@var{x}, @var{dim})}\n\ -an empty matrix is returned.\n\ -@seealso{sort, merge}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value retval; - - if (nargin < 1 || nargin > 3) - print_usage (); - else if (! (args(0).is_numeric_type () || args(0).is_bool_type ())) - error ("diff: X must be numeric or logical"); - - if (! error_state) - { - int dim = -1; - octave_idx_type order = 1; - if (nargin > 1) - { - if (args(1).is_scalar_type ()) - order = args(1).idx_type_value (true, false); - else if (! args(1).is_zero_by_zero ()) - error ("order K must be a scalar or []"); - if (! error_state && order < 0) - error ("order K must be non-negative"); - } - - if (nargin > 2) - { - dim = args(2).int_value (true, false); - if (! error_state && (dim < 1 || dim > args(0).ndims ())) - error ("DIM must be a valid dimension"); - else - dim -= 1; - } - - if (! error_state) - retval = do_diff (args(0), order, dim); - } - - return retval; -} - -/* -%!assert (diff ([1, 2, 3, 4]), [1, 1, 1]) -%!assert (diff ([1, 3, 7, 19], 2), [2, 8]) -%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1]), [4, 2; 3, 3; 1, -1; -6, -5]) -%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1], 3), [-1, -5; -5, 0]) -%!assert (isempty (diff (1))) - -%!error diff () -%!error diff (1, 2, 3, 4) -%!error diff ("foo") -%!error diff ([1, 2; 3, 4], -1) -*/ - -template -static Array -do_repelems (const Array& src, const Array& rep) -{ - Array retval; - - assert (rep.ndims () == 2 && rep.rows () == 2); - - octave_idx_type n = rep.columns (), l = 0; - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type k = rep(1, i); - if (k < 0) - { - error ("repelems: second row must contain non-negative numbers"); - return retval; - } - - l += k; - } - - retval.clear (1, l); - T *dest = retval.fortran_vec (); - l = 0; - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type k = rep(1, i); - std::fill_n (dest, k, src.checkelem (rep(0, i) - 1)); - dest += k; - } - - return retval; -} - -DEFUN (repelems, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} repelems (@var{x}, @var{r})\n\ -Construct a vector of repeated elements from @var{x}. @var{r}\n\ -is a 2x@var{N} integer matrix specifying which elements to repeat and\n\ -how often to repeat each element.\n\ -\n\ -Entries in the first row, @var{r}(1,j), select an element to repeat.\n\ -The corresponding entry in the second row, @var{r}(2,j), specifies\n\ -the repeat count. If @var{x} is a matrix then the columns of @var{x} are\n\ -imagined to be stacked on top of each other for purposes of the selection\n\ -index. A row vector is always returned.\n\ -\n\ -Conceptually the result is calculated as follows:\n\ -\n\ -@example\n\ -@group\n\ -y = [];\n\ -for i = 1:columns (@var{r})\n\ - y = [y, @var{x}(@var{r}(1,i)*ones(1, @var{r}(2,i)))];\n\ -endfor\n\ -@end group\n\ -@end example\n\ -@seealso{repmat, cat}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - octave_value x = args(0); - - const Matrix rm = args(1).matrix_value (); - if (error_state) - return retval; - else if (rm.rows () != 2 || rm.ndims () != 2) - { - error ("repelems: R must be a matrix with two rows"); - return retval; - } - else - { - NoAlias< Array > r (rm.dims ()); - - for (octave_idx_type i = 0; i < rm.numel (); i++) - { - octave_idx_type rx = rm(i); - if (static_cast (rx) != rm(i)) - { - error ("repelems: R must be a matrix of integers"); - return retval; - } - - r(i) = rx; - } - - switch (x.builtin_type ()) - { -#define BTYP_BRANCH(X, EX) \ - case btyp_ ## X: \ - retval = do_repelems (x.EX ## _value (), r); \ - break - - BTYP_BRANCH (double, array); - BTYP_BRANCH (float, float_array); - BTYP_BRANCH (complex, complex_array); - BTYP_BRANCH (float_complex, float_complex_array); - BTYP_BRANCH (bool, bool_array); - BTYP_BRANCH (char, char_array); - - BTYP_BRANCH (int8, int8_array); - BTYP_BRANCH (int16, int16_array); - BTYP_BRANCH (int32, int32_array); - BTYP_BRANCH (int64, int64_array); - BTYP_BRANCH (uint8, uint8_array); - BTYP_BRANCH (uint16, uint16_array); - BTYP_BRANCH (uint32, uint32_array); - BTYP_BRANCH (uint64, uint64_array); - - BTYP_BRANCH (cell, cell); - //BTYP_BRANCH (struct, map);//FIXME -#undef BTYP_BRANCH - - default: - gripe_wrong_type_arg ("repelems", x); - } - } - } - else - print_usage (); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/data.h --- a/src/data.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -/* - -Copyright (C) 2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_data_h) -#define octave_data_h 1 - -#include - -class octave_value; -class octave_value_list; - -extern OCTINTERP_API octave_value -do_class_concat (const octave_value_list& ovl, std::string cattype, int dim); - -#endif diff -r d02b229ce693 -r a132d206a36a src/debug.cc --- a/src/debug.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1268 +0,0 @@ -/* - -Copyright (C) 2001-2012 Ben Sapp -Copyright (C) 2007-2009 John Swensen - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include -#include - -#include "file-stat.h" -#include "singleton-cleanup.h" - -#include "defun.h" -#include "error.h" -#include "help.h" -#include "input.h" -#include "pager.h" -#include "oct-obj.h" -#include "utils.h" -#include "parse.h" -#include "symtab.h" -#include "gripes.h" -#include "ov.h" -#include "ov-usr-fcn.h" -#include "ov-fcn.h" -#include "ov-struct.h" -#include "pt-pr-code.h" -#include "pt-bp.h" -#include "pt-eval.h" -#include "pt-stmt.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "variables.h" - -#include "debug.h" - -// Initialize the singleton object -bp_table *bp_table::instance = 0; - -static std::string -snarf_file (const std::string& fname) -{ - std::string retval; - - file_stat fs (fname); - - if (fs) - { - size_t sz = fs.size (); - - std::ifstream file (fname.c_str (), std::ios::in|std::ios::binary); - - if (file) - { - std::string buf (sz+1, 0); - - file.read (&buf[0], sz+1); - - if (file.eof ()) - { - // Expected to read the entire file. - - retval = buf; - } - else - error ("error reading file %s", fname.c_str ()); - } - } - - return retval; -} - -static std::deque -get_line_offsets (const std::string& buf) -{ - // This could maybe be smarter. Is deque the right thing to use - // here? - - std::deque offsets; - - offsets.push_back (0); - - size_t len = buf.length (); - - for (size_t i = 0; i < len; i++) - { - char c = buf[i]; - - if (c == '\r' && ++i < len) - { - c = buf[i]; - - if (c == '\n') - offsets.push_back (i+1); - else - offsets.push_back (i); - } - else if (c == '\n') - offsets.push_back (i+1); - } - - offsets.push_back (len); - - return offsets; -} - -std::string -get_file_line (const std::string& fname, size_t line) -{ - std::string retval; - - static std::string last_fname; - - static std::string buf; - - static std::deque offsets; - - if (fname != last_fname) - { - buf = snarf_file (fname); - - offsets = get_line_offsets (buf); - } - - if (line > 0) - line--; - - if (line < offsets.size () - 1) - { - size_t bol = offsets[line]; - size_t eol = offsets[line+1]; - - while (eol > 0 && eol > bol && (buf[eol-1] == '\n' || buf[eol-1] == '\r')) - eol--; - - retval = buf.substr (bol, eol - bol); - } - - return retval; -} - -// Return a pointer to the user-defined function FNAME. If FNAME is -// empty, search backward for the first user-defined function in the -// current call stack. - -static octave_user_code * -get_user_code (const std::string& fname = std::string ()) -{ - octave_user_code *dbg_fcn = 0; - - if (fname.empty ()) - dbg_fcn = octave_call_stack::caller_user_code (); - else - { - octave_value fcn = symbol_table::find_function (fname); - - if (fcn.is_defined () && fcn.is_user_code ()) - dbg_fcn = fcn.user_code_value (); - } - - return dbg_fcn; -} - -static void -parse_dbfunction_params (const char *who, const octave_value_list& args, - std::string& symbol_name, bp_table::intmap& lines) -{ - int nargin = args.length (); - int idx = 0; - int list_idx = 0; - symbol_name = std::string (); - lines = bp_table::intmap (); - - if (args.length () == 0) - return; - - // If we are already in a debugging function. - if (octave_call_stack::caller_user_code ()) - { - idx = 0; - symbol_name = get_user_code ()->name (); - } - else if (args(0).is_map ()) - { - // Problem because parse_dbfunction_params() can only pass out a - // single function - } - else if (args(0).is_string ()) - { - symbol_name = args(0).string_value (); - if (error_state) - return; - idx = 1; - } - else - error ("%s: invalid parameter specified", who); - - for (int i = idx; i < nargin; i++ ) - { - if (args(i).is_string ()) - { - int line = atoi (args(i).string_value ().c_str ()); - if (error_state) - break; - lines[list_idx++] = line; - } - else if (args(i).is_map ()) - octave_stdout << who << ": accepting a struct" << std::endl; - else - { - const NDArray arg = args(i).array_value (); - - if (error_state) - break; - - for (octave_idx_type j = 0; j < arg.nelem (); j++) - { - int line = static_cast (arg.elem (j)); - if (error_state) - break; - lines[list_idx++] = line; - } - - if (error_state) - break; - } - } -} - -bool -bp_table::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new bp_table (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create breakpoint table!"); - retval = false; - } - - return retval; -} - -bp_table::intmap -bp_table::do_add_breakpoint (const std::string& fname, - const bp_table::intmap& line) -{ - intmap retval; - - octave_idx_type len = line.size (); - - octave_user_code *dbg_fcn = get_user_code (fname); - - if (dbg_fcn) - { - tree_statement_list *cmds = dbg_fcn->body (); - - if (cmds) - { - for (int i = 0; i < len; i++) - { - const_intmap_iterator p = line.find (i); - - if (p != line.end ()) - { - int lineno = p->second; - - retval[i] = cmds->set_breakpoint (lineno); - - if (retval[i] != 0) - { - bp_set.insert (fname); - } - } - } - } - } - else - error ("add_breakpoint: unable to find the requested function\n"); - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; - - return retval; -} - - -int -bp_table::do_remove_breakpoint (const std::string& fname, - const bp_table::intmap& line) -{ - int retval = 0; - - octave_idx_type len = line.size (); - - if (len == 0) - { - intmap results = remove_all_breakpoints_in_file (fname); - retval = results.size (); - } - else - { - octave_user_code *dbg_fcn = get_user_code (fname); - - if (dbg_fcn) - { - tree_statement_list *cmds = dbg_fcn->body (); - - if (cmds) - { - octave_value_list results = cmds->list_breakpoints (); - - if (results.length () > 0) - { - for (int i = 0; i < len; i++) - { - const_intmap_iterator p = line.find (i); - - if (p != line.end ()) - cmds->delete_breakpoint (p->second); - } - - results = cmds->list_breakpoints (); - - bp_set_iterator it = bp_set.find (fname); - if (results.length () == 0 && it != bp_set.end ()) - bp_set.erase (it); - - } - - retval = results.length (); - } - } - else - error ("remove_breakpoint: unable to find the requested function\n"); - } - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; - - return retval; -} - - -bp_table::intmap -bp_table::do_remove_all_breakpoints_in_file (const std::string& fname, - bool silent) -{ - intmap retval; - - octave_user_code *dbg_fcn = get_user_code (fname); - - if (dbg_fcn) - { - tree_statement_list *cmds = dbg_fcn->body (); - - if (cmds) - { - octave_value_list bkpts = cmds->list_breakpoints (); - - for (int i = 0; i < bkpts.length (); i++) - { - int lineno = static_cast (bkpts(i).int_value ()); - cmds->delete_breakpoint (lineno); - retval[i] = lineno; - } - - bp_set_iterator it = bp_set.find (fname); - if (it != bp_set.end ()) - bp_set.erase (it); - - } - } - else if (! silent) - error ("remove_all_breakpoint_in_file: " - "unable to find the requested function\n"); - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; - - return retval; -} - -void -bp_table::do_remove_all_breakpoints (void) -{ - for (const_bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) - remove_all_breakpoints_in_file (*it); - - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; -} - -std::string -do_find_bkpt_list (octave_value_list slist, - std::string match) -{ - std::string retval; - - for (int i = 0; i < slist.length (); i++) - { - if (slist (i).string_value () == match) - { - retval = slist(i).string_value (); - break; - } - } - - return retval; -} - - -bp_table::fname_line_map -bp_table::do_get_breakpoint_list (const octave_value_list& fname_list) -{ - fname_line_map retval; - - for (bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) - { - if (fname_list.length () == 0 - || do_find_bkpt_list (fname_list, *it) != "") - { - octave_user_code *f = get_user_code (*it); - - if (f) - { - tree_statement_list *cmds = f->body (); - - if (cmds) - { - octave_value_list bkpts = cmds->list_breakpoints (); - octave_idx_type len = bkpts.length (); - - if (len > 0) - { - bp_table::intmap bkpts_vec; - - for (int i = 0; i < len; i++) - bkpts_vec[i] = bkpts (i).double_value (); - - std::string symbol_name = f->name (); - - retval[symbol_name] = bkpts_vec; - } - } - } - } - } - - return retval; -} - -static octave_value -intmap_to_ov (const bp_table::intmap& line) -{ - int idx = 0; - - NDArray retval (dim_vector (1, line.size ())); - - for (size_t i = 0; i < line.size (); i++) - { - bp_table::const_intmap_iterator p = line.find (i); - - if (p != line.end ()) - { - int lineno = p->second; - retval(idx++) = lineno; - } - } - - retval.resize (dim_vector (1, idx)); - - return retval; -} - -DEFUN (dbstop, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\")\n\ -@deftypefnx {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\", @var{line}, @dots{})\n\ -Set a breakpoint in function @var{func}.\n\ -\n\ -Arguments are\n\ -\n\ -@table @var\n\ -@item func\n\ -Function name as a string variable. When already in debug\n\ -mode this should be left out and only the line should be given.\n\ -\n\ -@item line\n\ -Line number where the breakpoint should be set. Multiple\n\ -lines may be given as separate arguments or as a vector.\n\ -@end table\n\ -\n\ -When called with a single argument @var{func}, the breakpoint\n\ -is set at the first executable line in the named function.\n\ -\n\ -The optional output @var{rline} is the real line number where the\n\ -breakpoint was set. This can differ from specified line if\n\ -the line is not executable. For example, if a breakpoint attempted on a\n\ -blank line then Octave will set the real breakpoint at the\n\ -next executable line.\n\ -@seealso{dbclear, dbstatus, dbstep, debug_on_error, debug_on_warning, debug_on_interrupt}\n\ -@end deftypefn") -{ - bp_table::intmap retval; - std::string symbol_name; - bp_table::intmap lines; - - parse_dbfunction_params ("dbstop", args, symbol_name, lines); - - if (lines.size () == 0) - lines[0] = 1; - - if (! error_state) - retval = bp_table::add_breakpoint (symbol_name, lines); - - return intmap_to_ov (retval); -} - -DEFUN (dbclear, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbclear (\"@var{func}\")\n\ -@deftypefnx {Built-in Function} {} dbclear (\"@var{func}\", @var{line}, @dots{})\n\ -Delete a breakpoint in the function @var{func}.\n\ -\n\ -Arguments are\n\ -\n\ -@table @var\n\ -@item func\n\ -Function name as a string variable. When already in debug\n\ -mode this should be left out and only the line should be given.\n\ -\n\ -@item line\n\ -Line number from which to remove a breakpoint. Multiple\n\ -lines may be given as separate arguments or as a vector.\n\ -@end table\n\ -\n\ -When called without a line number specification all breakpoints\n\ -in the named function are cleared.\n\ -\n\ -If the requested line is not a breakpoint no action is performed.\n\ -@seealso{dbstop, dbstatus, dbwhere}\n\ -@end deftypefn") -{ - octave_value retval; - std::string symbol_name = ""; - bp_table::intmap lines; - - parse_dbfunction_params ("dbclear", args, symbol_name, lines); - - if (! error_state) - bp_table::remove_breakpoint (symbol_name, lines); - - return retval; -} - -DEFUN (dbstatus, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbstatus ()\n\ -@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus ()\n\ -@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus (\"@var{func}\")\n\ -Report the location of active breakpoints.\n\ -\n\ -When called with no input or output arguments, print the list of\n\ -all functions with breakpoints and the line numbers where those\n\ -breakpoints are set.\n\ -If a function name @var{func} is specified then only report breakpoints\n\ -for the named function.\n\ -\n\ -The optional return argument @var{brk_list} is a struct array with the\n\ -following fields.\n\ -\n\ -@table @asis\n\ -@item name\n\ -The name of the function with a breakpoint.\n\ -\n\ -@item file\n\ -The name of the m-file where the function code is located.\n\ -\n\ -@item line\n\ -A line number, or vector of line numbers, with a breakpoint.\n\ -@end table\n\ -\n\ -@seealso{dbclear, dbwhere}\n\ -@end deftypefn") -{ - octave_map retval; - int nargin = args.length (); - octave_value_list fcn_list; - bp_table::fname_line_map bp_list; - std::string symbol_name; - - if (nargin != 0 && nargin != 1) - { - error ("dbstatus: only zero or one arguments accepted\n"); - return octave_value (); - } - - if (nargin == 1) - { - if (args(0).is_string ()) - { - symbol_name = args(0).string_value (); - fcn_list(0) = symbol_name; - bp_list = bp_table::get_breakpoint_list (fcn_list); - } - else - gripe_wrong_type_arg ("dbstatus", args(0)); - } - else - { - octave_user_code *dbg_fcn = get_user_code (); - if (dbg_fcn) - { - symbol_name = dbg_fcn->name (); - fcn_list(0) = symbol_name; - } - - bp_list = bp_table::get_breakpoint_list (fcn_list); - } - - if (nargout == 0) - { - // Print out the breakpoint information. - - for (bp_table::fname_line_map_iterator it = bp_list.begin (); - it != bp_list.end (); it++) - { - bp_table::intmap m = it->second; - - size_t nel = m.size (); - - octave_stdout << "breakpoint in " << it->first; - if (nel > 1) - octave_stdout << " at lines "; - else - octave_stdout << " at line "; - - for (size_t j = 0; j < nel; j++) - octave_stdout << m[j] << ((j < nel - 1) ? ", " : "."); - - if (nel > 0) - octave_stdout << std::endl; - } - return octave_value (); - } - else - { - // Fill in an array for return. - - int i = 0; - Cell names (dim_vector (bp_list.size (), 1)); - Cell file (dim_vector (bp_list.size (), 1)); - Cell line (dim_vector (bp_list.size (), 1)); - - for (bp_table::const_fname_line_map_iterator it = bp_list.begin (); - it != bp_list.end (); it++) - { - names(i) = it->first; - line(i) = intmap_to_ov (it->second); - file(i) = do_which (it->first); - i++; - } - - retval.assign ("name", names); - retval.assign ("file", file); - retval.assign ("line", line); - - return octave_value (retval); - } -} - -DEFUN (dbwhere, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbwhere ()\n\ -In debugging mode, report the current file and line number where\n\ -execution is stopped.\n\ -@seealso{dbstatus, dbcont, dbstep, dbup}\n\ -@end deftypefn") -{ - octave_value retval; - - octave_user_code *dbg_fcn = get_user_code (); - - if (dbg_fcn) - { - bool have_file = true; - - std::string name = dbg_fcn->fcn_file_name (); - - if (name.empty ()) - { - have_file = false; - - name = dbg_fcn->name (); - } - - octave_stdout << "stopped in " << name << " at "; - - int l = octave_call_stack::caller_user_code_line (); - - if (l > 0) - { - octave_stdout << " line " << l << std::endl; - - if (have_file) - { - std::string line = get_file_line (name, l); - - if (! line.empty ()) - octave_stdout << l << ": " << line << std::endl; - } - } - else - octave_stdout << " " << std::endl; - } - else - error ("dbwhere: must be inside a user function to use dbwhere\n"); - - return retval; -} - -// Copied and modified from the do_type command in help.cc -// Maybe we could share some code? -void -do_dbtype (std::ostream& os, const std::string& name, int start, int end) -{ - std::string ff = fcn_file_in_path (name); - - if (! ff.empty ()) - { - std::ifstream fs (ff.c_str (), std::ios::in); - - if (fs) - { - char ch; - int line = 1; - - if (line >= start && line <= end) - os << line << "\t"; - - while (fs.get (ch)) - { - if (line >= start && line <= end) - { - os << ch; - } - - if (ch == '\n') - { - line++; - if (line >= start && line <= end) - os << line << "\t"; - } - } - } - else - os << "dbtype: unable to open `" << ff << "' for reading!\n"; - } - else - os << "dbtype: unknown function " << name << "\n"; - - os.flush (); -} - -DEFUN (dbtype, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbtype ()\n\ -@deftypefnx {Built-in Function} {} dbtype (\"startl:endl\")\n\ -@deftypefnx {Built-in Function} {} dbtype (\"startl:end\")\n\ -@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\")\n\ -@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl\")\n\ -@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl:endl\")\n\ -@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl:end\")\n\ -When in debugging mode and called with no arguments, list the script file\n\ -being debugged with line numbers. An optional range specification,\n\ -specified as a string, can be used to list only a portion of the file.\n\ -The special keyword \"end\" is a valid line number specification.\n\ -\n\ -When called with the name of a function, list that script file\n\ -with line numbers.\n\ -@seealso{dbstatus, dbstop}\n\ -@end deftypefn") -{ - octave_value retval; - octave_user_code *dbg_fcn; - - int nargin = args.length (); - string_vector argv = args.make_argv ("dbtype"); - - if (! error_state) - { - switch (nargin) - { - case 0: // dbtype - dbg_fcn = get_user_code (); - - if (dbg_fcn) - do_dbtype (octave_stdout, dbg_fcn->name (), 0, INT_MAX); - else - error ("dbtype: must be inside a user function to give no arguments to dbtype\n"); - break; - - case 1: // (dbtype func) || (dbtype start:end) - { - std::string arg = argv[1]; - - size_t ind = arg.find (':'); - - if (ind != std::string::npos) // (dbtype start:end) - { - dbg_fcn = get_user_code (); - - if (dbg_fcn) - { - std::string start_str = arg.substr (0, ind); - std::string end_str = arg.substr (ind + 1); - - int start, end; - start = atoi (start_str.c_str ()); - if (end_str == "end") - end = INT_MAX; - else - end = atoi (end_str.c_str ()); - - if (std::min (start, end) <= 0) - error ("dbtype: start and end lines must be >= 1\n"); - - if (start <= end) - do_dbtype (octave_stdout, dbg_fcn->name (), start, end); - else - error ("dbtype: start line must be less than end line\n"); - } - } - else // (dbtype func) - { - dbg_fcn = get_user_code (arg); - - if (dbg_fcn) - do_dbtype (octave_stdout, dbg_fcn->name (), 0, INT_MAX); - else - error ("dbtype: function <%s> not found\n", arg.c_str ()); - } - } - break; - - case 2: // (dbtype func start:end) , (dbtype func start) - dbg_fcn = get_user_code (argv[1]); - - if (dbg_fcn) - { - std::string arg = argv[2]; - int start, end; - size_t ind = arg.find (':'); - - if (ind != std::string::npos) - { - std::string start_str = arg.substr (0, ind); - std::string end_str = arg.substr (ind + 1); - - start = atoi (start_str.c_str ()); - if (end_str == "end") - end = INT_MAX; - else - end = atoi (end_str.c_str ()); - } - else - { - start = atoi (arg.c_str ()); - end = start; - } - - if (std::min (start, end) <= 0) - error ("dbtype: start and end lines must be >= 1\n"); - - if (start <= end) - do_dbtype (octave_stdout, dbg_fcn->name (), start, end); - else - error ("dbtype: start line must be less than end line\n"); - } - else - error ("dbtype: function <%s> not found\n", argv[1].c_str ()); - - break; - - default: - error ("dbtype: expecting zero, one, or two arguments\n"); - } - } - - return retval; -} - -static octave_value_list -do_dbstack (const octave_value_list& args, int nargout, std::ostream& os) -{ - octave_value_list retval; - - unwind_protect frame; - - octave_idx_type curr_frame = -1; - - size_t nskip = 0; - - if (args.length () == 1) - { - int n = 0; - - octave_value arg = args(0); - - if (arg.is_string ()) - { - std::string s_arg = arg.string_value (); - - n = atoi (s_arg.c_str ()); - } - else - n = args(0).int_value (); - - if (n > 0) - nskip = n; - else - error ("dbstack: N must be a non-negative integer"); - } - - if (! error_state) - { - octave_map stk = octave_call_stack::backtrace (nskip, curr_frame); - - if (nargout == 0) - { - octave_idx_type nframes_to_display = stk.numel (); - - if (nframes_to_display > 0) - { - os << "stopped in:\n\n"; - - Cell names = stk.contents ("name"); - Cell files = stk.contents ("file"); - Cell lines = stk.contents ("line"); - - bool show_top_level = true; - - size_t max_name_len = 0; - - for (octave_idx_type i = 0; i < nframes_to_display; i++) - { - std::string name = names(i).string_value (); - - max_name_len = std::max (name.length (), max_name_len); - } - - for (octave_idx_type i = 0; i < nframes_to_display; i++) - { - std::string name = names(i).string_value (); - std::string file = files(i).string_value (); - int line = lines(i).int_value (); - - if (show_top_level && i == curr_frame) - show_top_level = false; - - os << (i == curr_frame ? " --> " : " ") - << std::setw (max_name_len) << name - << " at line " << line - << " [" << file << "]" - << std::endl; - } - - if (show_top_level) - os << " --> top level" << std::endl; - } - } - else - { - retval(1) = curr_frame < 0 ? 1 : curr_frame + 1; - retval(0) = stk; - } - } - - return retval; -} - -// A function that can be easily called from a debugger print the Octave -// stack. This can be useful for finding what line of code the -// interpreter is currently executing when the debugger is stopped in -// some C++ function, for example. - -void -show_octave_dbstack (void) -{ - do_dbstack (octave_value_list (), 0, std::cerr); -} - -DEFUN (dbstack, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbstack ()\n\ -@deftypefnx {Built-in Function} {} dbstack (@var{n})\n\ -@deftypefnx {Built-in Function} {[@var{stack}, @var{idx}] =} dbstack (@dots{})\n\ -Display or return current debugging function stack information.\n\ -With optional argument @var{n}, omit the @var{n} innermost stack frames.\n\ -\n\ -The optional return argument @var{stack} is a struct array with the\n\ -following fields:\n\ -\n\ -@table @asis\n\ -@item file\n\ -The name of the m-file where the function code is located.\n\ -\n\ -@item name\n\ -The name of the function with a breakpoint.\n\ -\n\ -@item line\n\ -The line number of an active breakpoint.\n\ -\n\ -@item column\n\ -The column number of the line where the breakpoint begins.\n\ -\n\ -@item scope\n\ -Undocumented.\n\ -\n\ -@item context\n\ -Undocumented.\n\ -@end table\n\ -\n\ -The return argument @var{idx} specifies which element of the @var{stack}\n\ -struct array is currently active.\n\ -@seealso{dbup, dbdown, dbwhere, dbstatus}\n\ -@end deftypefn") -{ - return do_dbstack (args, nargout, octave_stdout); -} - -static void -do_dbupdown (const octave_value_list& args, const std::string& who) -{ - int n = 1; - - if (args.length () == 1) - { - octave_value arg = args(0); - - if (arg.is_string ()) - { - std::string s_arg = arg.string_value (); - - n = atoi (s_arg.c_str ()); - } - else - n = args(0).int_value (); - } - - if (! error_state) - { - if (who == "dbup") - n = -n; - - if (! octave_call_stack::goto_frame_relative (n, true)) - error ("%s: invalid stack frame", who.c_str ()); - } -} - -DEFUN (dbup, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbup\n\ -@deftypefnx {Built-in Function} {} dbup (@var{n})\n\ -In debugging mode, move up the execution stack @var{n} frames.\n\ -If @var{n} is omitted, move up one frame.\n\ -@seealso{dbstack, dbdown}\n\ -@end deftypefn") -{ - octave_value retval; - - do_dbupdown (args, "dbup"); - - return retval; -} - -DEFUN (dbdown, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbdown\n\ -@deftypefnx {Built-in Function} {} dbdown (@var{n})\n\ -In debugging mode, move down the execution stack @var{n} frames.\n\ -If @var{n} is omitted, move down one frame.\n\ -@seealso{dbstack, dbup}\n\ -@end deftypefn") -{ - octave_value retval; - - do_dbupdown (args, "dbdown"); - - return retval; -} - -DEFUN (dbstep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbstep\n\ -@deftypefnx {Command} {} dbstep @var{n}\n\ -@deftypefnx {Command} {} dbstep in\n\ -@deftypefnx {Command} {} dbstep out\n\ -@deftypefnx {Command} {} dbnext @dots{}\n\ -In debugging mode, execute the next @var{n} lines of code.\n\ -If @var{n} is omitted, execute the next single line of code.\n\ -If the next line of code is itself defined in terms of an m-file remain in\n\ -the existing function.\n\ -\n\ -Using @code{dbstep in} will cause execution of the next line to step into\n\ -any m-files defined on the next line. Using @code{dbstep out} will cause\n\ -execution to continue until the current function returns.\n\ -\n\ -@code{dbnext} is an alias for @code{dbstep}.\n\ -@seealso{dbcont, dbquit}\n\ -@end deftypefn") -{ - if (Vdebugging) - { - int nargin = args.length (); - - if (nargin > 1) - print_usage (); - else if (nargin == 1) - { - if (args(0).is_string ()) - { - std::string arg = args(0).string_value (); - - if (! error_state) - { - if (arg == "in") - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = -1; - } - else if (arg == "out") - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = -2; - } - else - { - int n = atoi (arg.c_str ()); - - if (n > 0) - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = n; - } - else - error ("dbstep: invalid argument"); - } - } - } - else - error ("dbstep: input argument must be a character string"); - } - else - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = 1; - } - } - else - error ("dbstep: can only be called in debug mode"); - - return octave_value_list (); -} - -DEFALIAS (dbnext, dbstep); - -DEFUN (dbcont, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbcont\n\ -Leave command-line debugging mode and continue code execution normally.\n\ -@seealso{dbstep, dbquit}\n\ -@end deftypefn") -{ - if (Vdebugging) - { - if (args.length () == 0) - { - Vdebugging = false; - - tree_evaluator::reset_debug_state (); - } - else - print_usage (); - } - else - error ("dbcont: can only be called in debug mode"); - - return octave_value_list (); -} - -DEFUN (dbquit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbquit\n\ -Quit debugging mode immediately without further code execution and\n\ -return to the Octave prompt.\n\ -@seealso{dbcont, dbstep}\n\ -@end deftypefn") -{ - if (Vdebugging) - { - if (args.length () == 0) - { - Vdebugging = false; - - tree_evaluator::reset_debug_state (); - - octave_throw_interrupt_exception (); - } - else - print_usage (); - } - else - error ("dbquit: can only be called in debug mode"); - - return octave_value_list (); -} - -DEFUN (isdebugmode, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isdebugmode ()\n\ -Return true if in debugging mode, otherwise false.\n\ -@seealso{dbwhere, dbstack, dbstatus}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = Vdebugging; - else - print_usage (); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/debug.h --- a/src/debug.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,134 +0,0 @@ -/* - -Copyright (C) 2001-2012 Ben Sapp - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_debug_h) -#define octave_debug_h 1 - -#include -#include -#include "ov.h" -#include "dRowVector.h" - -class octave_value_list; -class octave_user_code; - -// Interface to breakpoints,. - -class -OCTINTERP_API -bp_table -{ -private: - - bp_table (void) : bp_set () { } - - ~bp_table (void) { } - -public: - - typedef std::map intmap; - - typedef intmap::const_iterator const_intmap_iterator; - typedef intmap::iterator intmap_iterator; - - typedef std::map fname_line_map; - - typedef fname_line_map::const_iterator const_fname_line_map_iterator; - typedef fname_line_map::iterator fname_line_map_iterator; - - static bool instance_ok (void); - - // Add a breakpoint at the nearest executable line. - static intmap add_breakpoint (const std::string& fname = "", - const intmap& lines = intmap ()) - { - return instance_ok () - ? instance->do_add_breakpoint (fname, lines) : intmap (); - } - - // Remove a breakpoint from a line in file. - static int remove_breakpoint (const std::string& fname = "", - const intmap& lines = intmap ()) - { - return instance_ok () - ? instance->do_remove_breakpoint (fname, lines) : 0; - } - - // Remove all the breakpoints in a specified file. - static intmap remove_all_breakpoints_in_file (const std::string& fname, - bool silent = false) - { - return instance_ok () - ? instance->do_remove_all_breakpoints_in_file (fname, silent) : intmap (); - } - - // Remove all the breakpoints registered with octave. - static void remove_all_breakpoints (void) - { - if (instance_ok ()) - instance->do_remove_all_breakpoints (); - } - - // Return all breakpoints. Each element of the map is a vector - // containing the breakpoints corresponding to a given function name. - static fname_line_map - get_breakpoint_list (const octave_value_list& fname_list) - { - return instance_ok () - ? instance->do_get_breakpoint_list (fname_list) : fname_line_map (); - } - - static bool - have_breakpoints (void) - { - return instance_ok () ? instance->do_have_breakpoints () : 0; - } - -private: - - typedef std::set::const_iterator const_bp_set_iterator; - typedef std::set::iterator bp_set_iterator; - - // Set of function names containing at least one breakpoint. - std::set bp_set; - - static bp_table *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - intmap do_add_breakpoint (const std::string& fname, const intmap& lines); - - int do_remove_breakpoint (const std::string&, const intmap& lines); - - intmap do_remove_all_breakpoints_in_file (const std::string& fname, - bool silent); - - void do_remove_all_breakpoints (void); - - fname_line_map do_get_breakpoint_list (const octave_value_list& fname_list); - - bool do_have_breakpoints (void) { return (! bp_set.empty ()); } -}; - -std::string get_file_line (const std::string& fname, size_t line); - -#endif diff -r d02b229ce693 -r a132d206a36a src/defaults.cc --- a/src/defaults.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,557 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include -#include - -#include -#include - -#include "dir-ops.h" -#include "oct-env.h" -#include "file-stat.h" -#include "pathsearch.h" -#include "str-vec.h" - -#include -#include "defun.h" -#include "error.h" -#include "file-ops.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "load-path.h" -#include "oct-obj.h" -#include "ov.h" -#include "parse.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "variables.h" -#include - -std::string Voctave_home; - -std::string Vbin_dir; -std::string Vinfo_dir; -std::string Vdata_dir; -std::string Vlibexec_dir; -std::string Varch_lib_dir; -std::string Vlocal_arch_lib_dir; -std::string Vlocal_api_arch_lib_dir; -std::string Vlocal_ver_arch_lib_dir; - -std::string Vlocal_ver_oct_file_dir; -std::string Vlocal_api_oct_file_dir; -std::string Vlocal_oct_file_dir; - -std::string Vlocal_ver_fcn_file_dir; -std::string Vlocal_api_fcn_file_dir; -std::string Vlocal_fcn_file_dir; - -std::string Voct_file_dir; -std::string Vfcn_file_dir; - -std::string Vimage_dir; - -// The path that will be searched for programs that we execute. -// (--exec-path path) -static std::string VEXEC_PATH; - -// Name of the editor to be invoked by the edit_history command. -std::string VEDITOR; - -static std::string VIMAGE_PATH; - -std::string Vlocal_site_defaults_file; -std::string Vsite_defaults_file; - -std::string -subst_octave_home (const std::string& s) -{ - std::string retval; - - std::string prefix = OCTAVE_PREFIX; - - retval = s; - - if (Voctave_home != prefix) - { - octave_idx_type len = prefix.length (); - - if (s.substr (0, len) == prefix) - retval.replace (0, len, Voctave_home); - } - - if (file_ops::dir_sep_char () != '/') - std::replace (retval.begin (), retval.end (), '/', - file_ops::dir_sep_char ()); - - return retval; -} - -static void -set_octave_home (void) -{ - std::string oh = octave_env::getenv ("OCTAVE_HOME"); - - Voctave_home = oh.empty () ? std::string (OCTAVE_PREFIX) : oh; -} - -static void -set_default_info_dir (void) -{ - Vinfo_dir = subst_octave_home (OCTAVE_INFODIR); -} - -static void -set_default_data_dir (void) -{ - Vdata_dir = subst_octave_home (OCTAVE_DATADIR); -} - -static void -set_default_libexec_dir (void) -{ - Vlibexec_dir = subst_octave_home (OCTAVE_LIBEXECDIR); -} - -static void -set_default_arch_lib_dir (void) -{ - Varch_lib_dir = subst_octave_home (OCTAVE_ARCHLIBDIR); -} - -static void -set_default_local_arch_lib_dir (void) -{ - Vlocal_arch_lib_dir = subst_octave_home (OCTAVE_LOCALARCHLIBDIR); -} - -static void -set_default_local_api_arch_lib_dir (void) -{ - Vlocal_api_arch_lib_dir = subst_octave_home (OCTAVE_LOCALAPIARCHLIBDIR); -} - -static void -set_default_local_ver_arch_lib_dir (void) -{ - Vlocal_ver_arch_lib_dir = subst_octave_home (OCTAVE_LOCALVERARCHLIBDIR); -} - -static void -set_default_local_ver_oct_file_dir (void) -{ - Vlocal_ver_oct_file_dir = subst_octave_home (OCTAVE_LOCALVEROCTFILEDIR); -} - -static void -set_default_local_api_oct_file_dir (void) -{ - Vlocal_api_oct_file_dir = subst_octave_home (OCTAVE_LOCALAPIOCTFILEDIR); -} - -static void -set_default_local_oct_file_dir (void) -{ - Vlocal_oct_file_dir = subst_octave_home (OCTAVE_LOCALOCTFILEDIR); -} - -static void -set_default_local_ver_fcn_file_dir (void) -{ - Vlocal_ver_fcn_file_dir = subst_octave_home (OCTAVE_LOCALVERFCNFILEDIR); -} - -static void -set_default_local_api_fcn_file_dir (void) -{ - Vlocal_api_fcn_file_dir = subst_octave_home (OCTAVE_LOCALAPIFCNFILEDIR); -} - -static void -set_default_local_fcn_file_dir (void) -{ - Vlocal_fcn_file_dir = subst_octave_home (OCTAVE_LOCALFCNFILEDIR); -} - -static void -set_default_fcn_file_dir (void) -{ - Vfcn_file_dir = subst_octave_home (OCTAVE_FCNFILEDIR); -} - -static void -set_default_image_dir (void) -{ - Vimage_dir = subst_octave_home (OCTAVE_IMAGEDIR); -} - -static void -set_default_oct_file_dir (void) -{ - Voct_file_dir = subst_octave_home (OCTAVE_OCTFILEDIR); -} - -static void -set_default_bin_dir (void) -{ - Vbin_dir = subst_octave_home (OCTAVE_BINDIR); -} - -void -set_exec_path (const std::string& path_arg) -{ - std::string tpath = path_arg; - - if (tpath.empty ()) - tpath = octave_env::getenv ("OCTAVE_EXEC_PATH"); - - if (tpath.empty ()) - tpath = Vlocal_ver_arch_lib_dir + dir_path::path_sep_str () - + Vlocal_api_arch_lib_dir + dir_path::path_sep_str () - + Vlocal_arch_lib_dir + dir_path::path_sep_str () - + Varch_lib_dir + dir_path::path_sep_str () - + Vbin_dir; - - VEXEC_PATH = tpath; - - // FIXME -- should we really be modifying PATH in the environment? - // The way things are now, Octave will ignore directories set in the - // PATH with calls like - // - // setenv ("PATH", "/my/path"); - // - // To fix this, I think Octave should be searching the combination of - // PATH and EXEC_PATH for programs that it executes instead of setting - // the PATH in the environment and relying on the shell to do the - // searching. - - // This is static so that even if set_exec_path is called more than - // once, shell_path is the original PATH from the environment, - // before we start modifying it. - static std::string shell_path = octave_env::getenv ("PATH"); - - if (! shell_path.empty ()) - tpath = shell_path + dir_path::path_sep_str () + tpath; - - octave_env::putenv ("PATH", tpath); -} - -void -set_image_path (const std::string& path) -{ - VIMAGE_PATH = "."; - - std::string tpath = path; - - if (tpath.empty ()) - tpath = octave_env::getenv ("OCTAVE_IMAGE_PATH"); - - if (! tpath.empty ()) - VIMAGE_PATH += dir_path::path_sep_str () + tpath; - - tpath = genpath (Vimage_dir, ""); - - if (! tpath.empty ()) - VIMAGE_PATH += dir_path::path_sep_str () + tpath; -} - -static void -set_default_doc_cache_file (void) -{ - std::string def_file = subst_octave_home (OCTAVE_DOC_CACHE_FILE); - - std::string env_file = octave_env::getenv ("OCTAVE_DOC_CACHE_FILE"); - - Vdoc_cache_file = env_file.empty () ? def_file : env_file; -} - -static void -set_default_texi_macros_file (void) -{ - std::string def_file = subst_octave_home (OCTAVE_TEXI_MACROS_FILE); - - std::string env_file = octave_env::getenv ("OCTAVE_TEXI_MACROS_FILE"); - - Vtexi_macros_file = env_file.empty () ? def_file : env_file; -} - -static void -set_default_info_file (void) -{ - std::string std_info_file = subst_octave_home (OCTAVE_INFOFILE); - - std::string oct_info_file = octave_env::getenv ("OCTAVE_INFO_FILE"); - - Vinfo_file = oct_info_file.empty () ? std_info_file : oct_info_file; -} - -static void -set_default_info_prog (void) -{ - std::string oct_info_prog = octave_env::getenv ("OCTAVE_INFO_PROGRAM"); - - if (oct_info_prog.empty ()) - Vinfo_program = "info"; - else - Vinfo_program = std::string (oct_info_prog); -} - -static void -set_default_editor (void) -{ - VEDITOR = "emacs"; - - std::string env_editor = octave_env::getenv ("EDITOR"); - - if (! env_editor.empty ()) - VEDITOR = env_editor; -} - -static void -set_local_site_defaults_file (void) -{ - std::string lsf = octave_env::getenv ("OCTAVE_SITE_INITFILE"); - - if (lsf.empty ()) - { - Vlocal_site_defaults_file = subst_octave_home (OCTAVE_LOCALSTARTUPFILEDIR); - Vlocal_site_defaults_file.append ("/octaverc"); - } - else - Vlocal_site_defaults_file = lsf; -} - -static void -set_site_defaults_file (void) -{ - std::string sf = octave_env::getenv ("OCTAVE_VERSION_INITFILE"); - - if (sf.empty ()) - { - Vsite_defaults_file = subst_octave_home (OCTAVE_STARTUPFILEDIR); - Vsite_defaults_file.append ("/octaverc"); - } - else - Vsite_defaults_file = sf; -} - -void -install_defaults (void) -{ - // OCTAVE_HOME must be set first! - - set_octave_home (); - - set_default_info_dir (); - - set_default_data_dir (); - - set_default_libexec_dir (); - - set_default_arch_lib_dir (); - - set_default_local_ver_arch_lib_dir (); - set_default_local_api_arch_lib_dir (); - set_default_local_arch_lib_dir (); - - set_default_local_ver_oct_file_dir (); - set_default_local_api_oct_file_dir (); - set_default_local_oct_file_dir (); - - set_default_local_ver_fcn_file_dir (); - set_default_local_api_fcn_file_dir (); - set_default_local_fcn_file_dir (); - - set_default_fcn_file_dir (); - set_default_oct_file_dir (); - - set_default_image_dir (); - - set_default_bin_dir (); - - set_exec_path (); - - set_image_path (); - - set_default_doc_cache_file (); - - set_default_texi_macros_file (); - - set_default_info_file (); - - set_default_info_prog (); - - set_default_editor (); - - set_local_site_defaults_file (); - - set_site_defaults_file (); -} - -DEFUN (EDITOR, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} EDITOR ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} EDITOR (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} EDITOR (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the editor to\n\ -use with the @code{edit_history} command. The default value is taken from\n\ -the environment variable @w{@env{EDITOR}} when Octave starts. If the\n\ -environment variable is not initialized, @w{@env{EDITOR}} will be set to\n\ -@code{\"emacs\"}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{edit_history}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EDITOR); -} - -/* -%!test -%! orig_val = EDITOR (); -%! old_val = EDITOR ("X"); -%! assert (orig_val, old_val); -%! assert (EDITOR (), "X"); -%! EDITOR (orig_val); -%! assert (EDITOR (), orig_val); - -%!error (EDITOR (1, 2)) -*/ - -DEFUN (EXEC_PATH, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} EXEC_PATH ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} EXEC_PATH (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} EXEC_PATH (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies a colon separated\n\ -list of directories to append to the shell PATH when executing external\n\ -programs. The initial value of is taken from the environment variable\n\ -@w{@env{OCTAVE_EXEC_PATH}}, but that value can be overridden by\n\ -the command line argument @option{--exec-path PATH}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - octave_value retval = SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EXEC_PATH); - - if (args.length () > 0) - set_exec_path (VEXEC_PATH); - - return retval; -} - -/* -%!test -%! orig_val = EXEC_PATH (); -%! old_val = EXEC_PATH ("X"); -%! assert (orig_val, old_val); -%! assert (EXEC_PATH (), "X"); -%! EXEC_PATH (orig_val); -%! assert (EXEC_PATH (), orig_val); - -%!error (EXEC_PATH (1, 2)) -*/ - -DEFUN (IMAGE_PATH, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} IMAGE_PATH ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} IMAGE_PATH (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} IMAGE_PATH (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies a colon separated\n\ -list of directories in which to search for image files.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (IMAGE_PATH); -} - -/* -%!test -%! orig_val = IMAGE_PATH (); -%! old_val = IMAGE_PATH ("X"); -%! assert (orig_val, old_val); -%! assert (IMAGE_PATH (), "X"); -%! IMAGE_PATH (orig_val); -%! assert (IMAGE_PATH (), orig_val); - -%!error (IMAGE_PATH (1, 2)) -*/ - -DEFUN (OCTAVE_HOME, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} OCTAVE_HOME ()\n\ -Return the name of the top-level Octave installation directory.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = Voctave_home; - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar (OCTAVE_HOME ())) -%!error OCTAVE_HOME (1) -*/ - -DEFUNX ("OCTAVE_VERSION", FOCTAVE_VERSION, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} OCTAVE_VERSION ()\n\ -Return the version number of Octave, as a string.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = OCTAVE_VERSION; - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar (OCTAVE_VERSION ())) -%!error OCTAVE_VERSION (1) -*/ diff -r d02b229ce693 -r a132d206a36a src/defaults.in.h --- a/src/defaults.in.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,218 +0,0 @@ -// defaults.h.in -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_defaults_h) -#define octave_defaults_h 1 - -#include - -#include "pathsearch.h" - -#ifndef OCTAVE_CANONICAL_HOST_TYPE -#define OCTAVE_CANONICAL_HOST_TYPE %OCTAVE_CANONICAL_HOST_TYPE% -#endif - -#ifndef OCTAVE_DEFAULT_PAGER -#define OCTAVE_DEFAULT_PAGER %OCTAVE_DEFAULT_PAGER% -#endif - -#ifndef OCTAVE_ARCHLIBDIR -#define OCTAVE_ARCHLIBDIR %OCTAVE_ARCHLIBDIR% -#endif - -#ifndef OCTAVE_BINDIR -#define OCTAVE_BINDIR %OCTAVE_BINDIR% -#endif - -#ifndef OCTAVE_DATADIR -#define OCTAVE_DATADIR %OCTAVE_DATADIR% -#endif - -#ifndef OCTAVE_DATAROOTDIR -#define OCTAVE_DATAROOTDIR %OCTAVE_DATAROOTDIR% -#endif - -#ifndef OCTAVE_DOC_CACHE_FILE -#define OCTAVE_DOC_CACHE_FILE %OCTAVE_DOC_CACHE_FILE% -#endif - -#ifndef OCTAVE_TEXI_MACROS_FILE -#define OCTAVE_TEXI_MACROS_FILE %OCTAVE_TEXI_MACROS_FILE% -#endif - -#ifndef OCTAVE_EXEC_PREFIX -#define OCTAVE_EXEC_PREFIX %OCTAVE_EXEC_PREFIX% -#endif - -#ifndef OCTAVE_FCNFILEDIR -#define OCTAVE_FCNFILEDIR %OCTAVE_FCNFILEDIR% -#endif - -#ifndef OCTAVE_IMAGEDIR -#define OCTAVE_IMAGEDIR %OCTAVE_IMAGEDIR% -#endif - -#ifndef OCTAVE_INCLUDEDIR -#define OCTAVE_INCLUDEDIR %OCTAVE_INCLUDEDIR% -#endif - -#ifndef OCTAVE_INFODIR -#define OCTAVE_INFODIR %OCTAVE_INFODIR% -#endif - -#ifndef OCTAVE_INFOFILE -#define OCTAVE_INFOFILE %OCTAVE_INFOFILE% -#endif - -#ifndef OCTAVE_LIBDIR -#define OCTAVE_LIBDIR %OCTAVE_LIBDIR% -#endif - -#ifndef OCTAVE_LIBEXECDIR -#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% -#endif - -#ifndef OCTAVE_LIBEXECDIR -#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% -#endif - -#ifndef OCTAVE_LOCALAPIFCNFILEDIR -#define OCTAVE_LOCALAPIFCNFILEDIR %OCTAVE_LOCALAPIFCNFILEDIR% -#endif - -#ifndef OCTAVE_LOCALAPIOCTFILEDIR -#define OCTAVE_LOCALAPIOCTFILEDIR %OCTAVE_LOCALAPIOCTFILEDIR% -#endif - -#ifndef OCTAVE_LOCALARCHLIBDIR -#define OCTAVE_LOCALARCHLIBDIR %OCTAVE_LOCALARCHLIBDIR% -#endif - -#ifndef OCTAVE_LOCALFCNFILEDIR -#define OCTAVE_LOCALFCNFILEDIR %OCTAVE_LOCALFCNFILEDIR% -#endif - -#ifndef OCTAVE_LOCALOCTFILEDIR -#define OCTAVE_LOCALOCTFILEDIR %OCTAVE_LOCALOCTFILEDIR% -#endif - -#ifndef OCTAVE_LOCALSTARTUPFILEDIR -#define OCTAVE_LOCALSTARTUPFILEDIR %OCTAVE_LOCALSTARTUPFILEDIR% -#endif - -#ifndef OCTAVE_LOCALAPIARCHLIBDIR -#define OCTAVE_LOCALAPIARCHLIBDIR %OCTAVE_LOCALAPIARCHLIBDIR% -#endif - -#ifndef OCTAVE_LOCALVERARCHLIBDIR -#define OCTAVE_LOCALVERARCHLIBDIR %OCTAVE_LOCALVERARCHLIBDIR% -#endif - -#ifndef OCTAVE_LOCALVERFCNFILEDIR -#define OCTAVE_LOCALVERFCNFILEDIR %OCTAVE_LOCALVERFCNFILEDIR% -#endif - -#ifndef OCTAVE_LOCALVEROCTFILEDIR -#define OCTAVE_LOCALVEROCTFILEDIR %OCTAVE_LOCALVEROCTFILEDIR% -#endif - -#ifndef OCTAVE_MAN1DIR -#define OCTAVE_MAN1DIR %OCTAVE_MAN1DIR% -#endif - -#ifndef OCTAVE_MAN1EXT -#define OCTAVE_MAN1EXT %OCTAVE_MAN1EXT% -#endif - -#ifndef OCTAVE_MANDIR -#define OCTAVE_MANDIR %OCTAVE_MANDIR% -#endif - -#ifndef OCTAVE_OCTFILEDIR -#define OCTAVE_OCTFILEDIR %OCTAVE_OCTFILEDIR% -#endif - -#ifndef OCTAVE_OCTETCDIR -#define OCTAVE_OCTETCDIR %OCTAVE_OCTETCDIR% -#endif - -#ifndef OCTAVE_OCTINCLUDEDIR -#define OCTAVE_OCTINCLUDEDIR %OCTAVE_OCTINCLUDEDIR% -#endif - -#ifndef OCTAVE_OCTLIBDIR -#define OCTAVE_OCTLIBDIR %OCTAVE_OCTLIBDIR% -#endif - -#ifndef OCTAVE_PREFIX -#define OCTAVE_PREFIX %OCTAVE_PREFIX% -#endif - -#ifndef OCTAVE_STARTUPFILEDIR -#define OCTAVE_STARTUPFILEDIR %OCTAVE_STARTUPFILEDIR% -#endif - -#ifndef OCTAVE_RELEASE -#define OCTAVE_RELEASE %OCTAVE_RELEASE% -#endif - -extern std::string Voctave_home; - -extern std::string Vbin_dir; -extern std::string Vinfo_dir; -extern std::string Vdata_dir; -extern std::string Vlibexec_dir; -extern std::string Varch_lib_dir; -extern std::string Vlocal_arch_lib_dir; -extern std::string Vlocal_ver_arch_lib_dir; - -extern std::string Vlocal_ver_oct_file_dir; -extern std::string Vlocal_api_oct_file_dir; -extern std::string Vlocal_oct_file_dir; - -extern std::string Vlocal_ver_fcn_file_dir; -extern std::string Vlocal_api_fcn_file_dir; -extern std::string Vlocal_fcn_file_dir; - -extern std::string Voct_file_dir; -extern std::string Vfcn_file_dir; - -extern std::string Vimage_dir; - -// Name of the editor to be invoked by the edit_history command. -extern std::string VEDITOR; - -extern std::string Vlocal_site_defaults_file; -extern std::string Vsite_defaults_file; - -// Name of the FFTW wisdom program. -extern OCTINTERP_API std::string Vfftw_wisdom_program; - -extern std::string subst_octave_home (const std::string&); - -extern void install_defaults (void); - -extern void set_exec_path (const std::string& path = std::string ()); -extern void set_image_path (const std::string& path = std::string ()); - -#endif diff -r d02b229ce693 -r a132d206a36a src/defun.cc --- a/src/defun.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,200 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "defun.h" -#include "dynamic-ld.h" -#include "error.h" -#include "help.h" -#include "ov.h" -#include "ov-builtin.h" -#include "ov-dld-fcn.h" -#include "ov-fcn.h" -#include "ov-mex-fcn.h" -#include "ov-usr-fcn.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "pager.h" -#include "symtab.h" -#include "toplev.h" -#include "variables.h" -#include "parse.h" - -// Print the usage part of the doc string of FCN (user-defined or DEFUN). -void -print_usage (void) -{ - const octave_function *cur = octave_call_stack::current (); - if (cur) - print_usage (cur->name ()); - else - error ("print_usage: invalid function"); -} - -void -print_usage (const std::string& name) -{ - feval ("print_usage", octave_value (name), 0); -} - -void -check_version (const std::string& version, const std::string& fcn) -{ - if (version != OCTAVE_API_VERSION) - { - error ("API version %s found in .oct file function `%s'\n" - " does not match the running Octave (API version %s)\n" - " this can lead to incorrect results or other failures\n" - " you can fix this problem by recompiling this .oct file", - version.c_str (), fcn.c_str (), OCTAVE_API_VERSION); - } -} - -// Install variables and functions in the symbol tables. - -void -install_builtin_function (octave_builtin::fcn f, const std::string& name, - const std::string& file, const std::string& doc, - bool /* can_hide_function -- not yet implemented */) -{ - octave_value fcn (new octave_builtin (f, name, file, doc)); - - symbol_table::install_built_in_function (name, fcn); -} - -void -install_dld_function (octave_dld_function::fcn f, const std::string& name, - const octave_shlib& shl, const std::string& doc, - bool relative) -{ - octave_dld_function *fcn = new octave_dld_function (f, shl, name, doc); - - if (relative) - fcn->mark_relative (); - - octave_value fval (fcn); - - symbol_table::install_built_in_function (name, fval); -} - -void -install_mex_function (void *fptr, bool fmex, const std::string& name, - const octave_shlib& shl, bool relative) -{ - octave_mex_function *fcn = new octave_mex_function (fptr, fmex, shl, name); - - if (relative) - fcn->mark_relative (); - - octave_value fval (fcn); - - symbol_table::install_built_in_function (name, fval); -} - -void -alias_builtin (const std::string& alias, const std::string& name) -{ - symbol_table::alias_built_in_function (alias, name); -} - -octave_shlib -get_current_shlib (void) -{ - octave_shlib retval; - - octave_function *curr_fcn = octave_call_stack::current (); - if (curr_fcn) - { - if (curr_fcn->is_dld_function ()) - { - octave_dld_function *dld = dynamic_cast (curr_fcn); - retval = dld->get_shlib (); - } - else if (curr_fcn->is_mex_function ()) - { - octave_mex_function *mex = dynamic_cast (curr_fcn); - retval = mex->get_shlib (); - } - } - - return retval; -} - -bool defun_isargout (int nargout, int iout) -{ - const std::list *lvalue_list = octave_builtin::curr_lvalue_list; - if (iout >= std::max (nargout, 1)) - return false; - else if (lvalue_list) - { - int k = 0; - for (std::list::const_iterator p = lvalue_list->begin (); - p != lvalue_list->end (); p++) - { - if (k == iout) - return ! p->is_black_hole (); - k += p->numel (); - if (k > iout) - break; - } - - return true; - } - else - return true; -} - -void defun_isargout (int nargout, int nout, bool *isargout) -{ - const std::list *lvalue_list = octave_builtin::curr_lvalue_list; - if (lvalue_list) - { - int k = 0; - for (std::list::const_iterator p = lvalue_list->begin (); - p != lvalue_list->end () && k < nout; p++) - { - if (p->is_black_hole ()) - isargout[k++] = false; - else - { - int l = std::min (k + p->numel (), - static_cast (nout)); - while (k < l) - isargout[k++] = true; - } - } - } - else - for (int i = 0; i < nout; i++) - isargout[i] = true; - - for (int i = std::max (nargout, 1); i < nout; i++) - isargout[i] = false; -} - diff -r d02b229ce693 -r a132d206a36a src/defun.h --- a/src/defun.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,66 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_defun_h) -#define octave_defun_h 1 - -#if defined (octave_defun_dld_h) -#error defun.h and defun-dld.h both included in same file! -#endif - -#include "defun-int.h" - -// Define a builtin function. -// -// name is the name of the function, unqouted. -// -// args_name is the name of the octave_value_list variable used to pass -// the argument list to this function. -// -// nargout_name is the name of the int variable used to pass the -// number of output arguments this function is expected to produce. -// -// doc is the simple help text for the function. - -#define DEFUN(name, args_name, nargout_name, doc) \ - DEFUN_INTERNAL (name, args_name, nargout_name, doc) - -// This one can be used when `name' cannot be used directly (if it is -// already defined as a macro). In that case, name is already a -// quoted string, and the internal name of the function must be passed -// too (the convention is to use a prefix of "F", so "foo" becomes "Ffoo"). - -#define DEFUNX(name, fname, args_name, nargout_name, doc) \ - DEFUNX_INTERNAL (name, fname, args_name, nargout_name, doc) - -// This is a function with a name that can't be hidden by a variable. -#define DEFCONSTFUN(name, args_name, nargout_name, doc) \ - DEFCONSTFUN_INTERNAL (name, args_name, nargout_name, doc) - -// Make alias another name for the existing function name. This macro -// must be used in the same file where name is defined, after the -// definition for name. - -#define DEFALIAS(alias, name) \ - DEFALIAS_INTERNAL (alias, name) - -#endif diff -r d02b229ce693 -r a132d206a36a src/dirfns.cc --- a/src/dirfns.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,783 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include - -#include -#include - -#include -#include - -#include "file-ops.h" -#include "file-stat.h" -#include "glob-match.h" -#include "oct-env.h" -#include "pathsearch.h" -#include "str-vec.h" - -#include "Cell.h" -#include "defun.h" -#include "dir-ops.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "load-path.h" -#include "oct-obj.h" -#include "pager.h" -#include "procstream.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// TRUE means we ask for confirmation before recursively removing a -// directory tree. -static bool Vconfirm_recursive_rmdir = true; - -// The time we last time we changed directories. -octave_time Vlast_chdir_time = 0.0; - -static int -octave_change_to_directory (const std::string& newdir) -{ - int cd_ok = octave_env::chdir (file_ops::tilde_expand (newdir)); - - if (cd_ok) - { - Vlast_chdir_time.stamp (); - - // FIXME -- should this be handled as a list of functions - // to call so users can add their own chdir handlers? - - load_path::update (); - } - else - error ("%s: %s", newdir.c_str (), gnulib::strerror (errno)); - - return cd_ok; -} - -DEFUN (cd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} cd dir\n\ -@deftypefnx {Command} {} chdir dir\n\ -Change the current working directory to @var{dir}. If @var{dir} is\n\ -omitted, the current directory is changed to the user's home\n\ -directory. For example,\n\ -\n\ -@example\n\ -cd ~/octave\n\ -@end example\n\ -\n\ -@noindent\n\ -changes the current working directory to @file{~/octave}. If the\n\ -directory does not exist, an error message is printed and the working\n\ -directory is not changed.\n\ -@seealso{mkdir, rmdir, dir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("cd"); - - if (error_state) - return retval; - - if (argc > 1) - { - std::string dirname = argv[1]; - - if (dirname.length () > 0 - && ! octave_change_to_directory (dirname)) - { - return retval; - } - } - else - { - // Behave like Unixy shells for "cd" by itself, but be Matlab - // compatible if doing "current_dir = cd". - - if (nargout == 0) - { - std::string home_dir = octave_env::get_home_directory (); - - if (home_dir.empty () || ! octave_change_to_directory (home_dir)) - return retval; - } - else - retval = octave_value (octave_env::get_current_directory ()); - } - - return retval; -} - -DEFALIAS (chdir, cd); - -DEFUN (pwd, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pwd ()\n\ -Return the current working directory.\n\ -@seealso{dir, ls}\n\ -@end deftypefn") -{ - return octave_value (octave_env::get_current_directory ()); -} - -DEFUN (readdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{files}, @var{err}, @var{msg}] =} readdir (@var{dir})\n\ -Return names of the files in the directory @var{dir} as a cell array of\n\ -strings. If an error occurs, return an empty cell array in @var{files}.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{ls, dir, glob}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = -1.0; - retval(0) = Cell (); - - if (args.length () == 1) - { - std::string dirname = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("readdir", args(0)); - else - { - dir_entry dir (dirname); - - if (dir) - { - string_vector dirlist = dir.read (); - retval(1) = 0.0; - retval(0) = Cell (dirlist.sort ()); - } - else - { - retval(2) = dir.error (); - } - } - } - else - print_usage (); - - return retval; -} - -// FIXME -- should maybe also allow second arg to specify -// mode? OTOH, that might cause trouble with compatibility later... - -DEFUNX ("mkdir", Fmkdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{dir})\n\ -@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{parent}, @var{dir})\n\ -Create a directory named @var{dir} in the directory @var{parent}.\n\ -\n\ -If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ -character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ -system-dependent error message, and @var{msgid} contains a unique\n\ -message identifier.\n\ -@seealso{rmdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = std::string (); - retval(0) = false; - - int nargin = args.length (); - - std::string dirname; - - if (nargin == 2) - { - std::string parent = args(0).string_value (); - std::string dir = args(1).string_value (); - - if (error_state) - { - gripe_wrong_type_arg ("mkdir", args(0)); - return retval; - } - else - dirname = file_ops::concat (parent, dir); - } - else if (nargin == 1) - { - dirname = args(0).string_value (); - - if (error_state) - { - gripe_wrong_type_arg ("mkdir", args(0)); - return retval; - } - } - - if (nargin == 1 || nargin == 2) - { - std::string msg; - - dirname = file_ops::tilde_expand (dirname); - - file_stat fs (dirname); - - if (fs && fs.is_dir ()) - { - // For compatibility with Matlab, we return true when the - // directory already exists. - - retval(2) = "mkdir"; - retval(1) = "directory exists"; - retval(0) = true; - } - else - { - int status = octave_mkdir (dirname, 0777, msg); - - if (status < 0) - { - retval(2) = "mkdir"; - retval(1) = msg; - } - else - retval(0) = true; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("rmdir", Frmdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir})\n\ -@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir}, \"s\")\n\ -Remove the directory named @var{dir}.\n\ -\n\ -If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ -character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ -system-dependent error message, and @var{msgid} contains a unique\n\ -message identifier.\n\ -\n\ -If the optional second parameter is supplied with value @code{\"s\"},\n\ -recursively remove all subdirectories as well.\n\ -@seealso{mkdir, confirm_recursive_rmdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = std::string (); - retval(0) = false; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string dirname = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("rmdir", args(0)); - else - { - std::string fulldir = file_ops::tilde_expand (dirname); - int status = -1; - std::string msg; - - if (nargin == 2) - { - if (args(1).string_value () == "s") - { - bool doit = true; - - if (interactive && Vconfirm_recursive_rmdir) - { - std::string prompt - = "remove entire contents of " + fulldir + "? "; - - doit = octave_yes_or_no (prompt); - } - - if (doit) - status = octave_recursive_rmdir (fulldir, msg); - } - else - error ("rmdir: expecting second argument to be \"s\""); - } - else - status = octave_rmdir (fulldir, msg); - - if (status < 0) - { - retval(2) = "rmdir"; - retval(1) = msg; - } - else - retval(0) = true; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("link", Flink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} link (@var{old}, @var{new})\n\ -Create a new link (also known as a hard link) to an existing file.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{symlink}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1.0; - - if (args.length () == 2) - { - std::string from = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("link", args(0)); - else - { - std::string to = args(1).string_value (); - - if (error_state) - gripe_wrong_type_arg ("link", args(1)); - else - { - std::string msg; - - int status = octave_link (from, to, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("symlink", Fsymlink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} symlink (@var{old}, @var{new})\n\ -Create a symbolic link @var{new} which contains the string @var{old}.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{link, readlink}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1.0; - - if (args.length () == 2) - { - std::string from = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("symlink", args(0)); - else - { - std::string to = args(1).string_value (); - - if (error_state) - gripe_wrong_type_arg ("symlink", args(1)); - else - { - std::string msg; - - int status = octave_symlink (from, to, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("readlink", Freadlink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{result}, @var{err}, @var{msg}] =} readlink (@var{symlink})\n\ -Read the value of the symbolic link @var{symlink}.\n\ -\n\ -If successful, @var{result} contains the contents of the symbolic link\n\ -@var{symlink}, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{link, symlink}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = -1.0; - retval(0) = std::string (); - - if (args.length () == 1) - { - std::string symlink = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("readlink", args(0)); - else - { - std::string result; - std::string msg; - - int status = octave_readlink (symlink, result, msg); - - if (status < 0) - retval(2) = msg; - retval(1) = status; - retval(0) = result; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("rename", Frename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} rename (@var{old}, @var{new})\n\ -Change the name of file @var{old} to @var{new}.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{ls, dir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1.0; - - if (args.length () == 2) - { - std::string from = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("rename", args(0)); - else - { - std::string to = args(1).string_value (); - - if (error_state) - gripe_wrong_type_arg ("rename", args(1)); - else - { - std::string msg; - - int status = octave_rename (from, to, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (glob, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} glob (@var{pattern})\n\ -Given an array of pattern strings (as a char array or a cell array) in\n\ -@var{pattern}, return a cell array of file names that match any of\n\ -them, or an empty cell array if no patterns match. The pattern strings are\n\ -interpreted as filename globbing patterns (as they are used by Unix shells).\n\ -Within a pattern\n\ -\n\ -@table @code\n\ -@itemx *\n\ -matches any string, including the null string,\n\ -@itemx ?\n\ -matches any single character, and\n\ -\n\ -@item [@dots{}]\n\ -matches any of the enclosed characters.\n\ -@end table\n\ -\n\ -Tilde expansion\n\ -is performed on each of the patterns before looking for matching file\n\ -names. For example:\n\ -\n\ -@example\n\ -ls\n\ - @result{}\n\ - file1 file2 file3 myfile1 myfile1b\n\ -glob (\"*file1\")\n\ - @result{}\n\ - @{\n\ - [1,1] = file1\n\ - [2,1] = myfile1\n\ - @}\n\ -glob (\"myfile?\")\n\ - @result{}\n\ - @{\n\ - [1,1] = myfile1\n\ - @}\n\ -glob (\"file[12]\")\n\ - @result{}\n\ - @{\n\ - [1,1] = file1\n\ - [2,1] = file2\n\ - @}\n\ -@end example\n\ -@seealso{ls, dir, readdir}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - string_vector pat = args(0).all_strings (); - - if (error_state) - gripe_wrong_type_arg ("glob", args(0)); - else - { - glob_match pattern (file_ops::tilde_expand (pat)); - - retval = Cell (pattern.glob ()); - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! tmpdir = tmpnam; -%! filename = {"file1", "file2", "file3", "myfile1", "myfile1b"}; -%! if (mkdir (tmpdir)) -%! cwd = pwd; -%! cd (tmpdir); -%! if strcmp (canonicalize_file_name (pwd), canonicalize_file_name (tmpdir)) -%! a = 0; -%! for n = 1:5 -%! save (filename{n}, "a"); -%! endfor -%! else -%! rmdir (tmpdir); -%! error ("Couldn't change to temporary dir"); -%! endif -%! else -%! error ("Couldn't create temporary directory"); -%! endif -%! result1 = glob ("*file1"); -%! result2 = glob ("myfile?"); -%! result3 = glob ("file[12]"); -%! for n = 1:5 -%! delete (filename{n}); -%! endfor -%! cd (cwd); -%! rmdir (tmpdir); -%! assert (result1, {"file1"; "myfile1"}); -%! assert (result2, {"myfile1"}); -%! assert (result3, {"file1"; "file2"}); -*/ - -DEFUNX ("fnmatch", Ffnmatch, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fnmatch (@var{pattern}, @var{string})\n\ -Return 1 or zero for each element of @var{string} that matches any of\n\ -the elements of the string array @var{pattern}, using the rules of\n\ -filename pattern matching. For example:\n\ -\n\ -@example\n\ -@group\n\ -fnmatch (\"a*b\", @{\"ab\"; \"axyzb\"; \"xyzab\"@})\n\ - @result{} [ 1; 1; 0 ]\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - string_vector pat = args(0).all_strings (); - string_vector str = args(1).all_strings (); - - if (error_state) - gripe_wrong_type_arg ("fnmatch", args(0)); - else - { - glob_match pattern (file_ops::tilde_expand (pat)); - - retval = pattern.match (str); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (filesep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} filesep ()\n\ -@deftypefnx {Built-in Function} {} filesep (\"all\")\n\ -Return the system-dependent character used to separate directory names.\n\ -\n\ -If \"all\" is given, the function returns all valid file separators in\n\ -the form of a string. The list of file separators is system-dependent.\n\ -It is @samp{/} (forward slash) under UNIX or @w{Mac OS X}, @samp{/} and\n\ -@samp{\\} (forward and backward slashes) under Windows.\n\ -@seealso{pathsep}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = file_ops::dir_sep_str (); - else if (args.length () == 1) - { - std::string s = args(0).string_value (); - - if (! error_state) - { - if (s == "all") - retval = file_ops::dir_sep_chars (); - else - gripe_wrong_type_arg ("filesep", args(0)); - } - else - gripe_wrong_type_arg ("filesep", args(0)); - } - else - print_usage (); - - return retval; -} - -DEFUN (pathsep, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} pathsep ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} pathsep (@var{new_val})\n\ -Query or set the character used to separate directories in a path.\n\ -@seealso{filesep}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = dir_path::path_sep_str (); - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - switch (sval.length ()) - { - case 1: - dir_path::path_sep_char (sval[0]); - break; - - case 0: - dir_path::path_sep_char ('\0'); - break; - - default: - error ("pathsep: argument must be a single character"); - break; - } - } - else - error ("pathsep: argument must be a single character"); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -DEFUN (confirm_recursive_rmdir, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} confirm_recursive_rmdir ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} confirm_recursive_rmdir (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} confirm_recursive_rmdir (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave\n\ -will ask for confirmation before recursively removing a directory tree.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (confirm_recursive_rmdir); -} diff -r d02b229ce693 -r a132d206a36a src/dirfns.h --- a/src/dirfns.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_dirfns_h) -#define octave_dirfns_h 1 - -#include - -#include - -#include "oct-time.h" - -extern std::string polite_directory_format (const std::string&); -extern std::string base_pathname (const std::string&); -extern std::string make_absolute (const std::string&, const std::string&); -extern std::string get_working_directory (const std::string&); - -// The time we last time we changed directories. -extern octave_time Vlast_chdir_time; - -#endif diff -r d02b229ce693 -r a132d206a36a src/dldfcn/__delaunayn__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__delaunayn__.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,229 @@ +/* + +Copyright (C) 2000-2012 Kai Habel + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + 16. July 2000 - Kai Habel: first release + + 25. September 2002 - Changes by Rafael Laboissiere + + * Added Qbb option to normalize the input and avoid crashes in Octave. + * delaunayn accepts now a second (optional) argument that must be a string + containing extra options to the qhull command. + * Fixed doc string. The dimension of the result matrix is [m, dim+1], and + not [n, dim-1]. + + 6. June 2006: Changes by Alexander Barth + + * triangulate non-simplicial facets + * allow options to be specified as cell array of strings + * change the default options (for compatibility with matlab) +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "Cell.h" +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" +#include "unwind-prot.h" + +#if defined (HAVE_QHULL) +# include "oct-qhull.h" +# if defined (NEED_QHULL_VERSION) +char qh_version[] = "__delaunayn__.oct 2007-08-21"; +# endif +#endif + +static void +close_fcn (FILE *f) +{ + gnulib::fclose (f); +} + +DEFUN_DLD (__delaunayn__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts})\n\ +@deftypefnx {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts}, @var{options})\n\ +Undocumented internal function.\n\ +@end deftypefn") + +{ + octave_value_list retval; + +#if defined (HAVE_QHULL) + + retval(0) = 0.0; + + int nargin = args.length (); + if (nargin < 1 || nargin > 2) + { + print_usage (); + return retval; + } + + Matrix p (args(0).matrix_value ()); + const octave_idx_type dim = p.columns (); + const octave_idx_type n = p.rows (); + + // Default options + std::string options; + if (dim <= 3) + options = "Qt Qbb Qc Qz"; + else + options = "Qt Qbb Qc Qx"; + + if (nargin == 2) + { + if (args(1).is_string ()) + options = args(1).string_value (); + else if (args(1).is_empty ()) + ; // Use default options + else if (args(1).is_cellstr ()) + { + options = ""; + Array tmp = args(1).cellstr_value (); + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += tmp(i) + " "; + } + else + { + error ("__delaunayn__: OPTIONS argument must be a string, cell array of strings, or empty"); + return retval; + } + } + + if (n > dim + 1) + { + p = p.transpose (); + double *pt_array = p.fortran_vec (); + boolT ismalloc = false; + + // Qhull flags argument is not const char* + OCTAVE_LOCAL_BUFFER (char, flags, 9 + options.length ()); + + sprintf (flags, "qhull d %s", options.c_str ()); + + unwind_protect frame; + + // Replace the outfile pointer with stdout for debugging information. +#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) + FILE *outfile = gnulib::fopen ("NUL", "w"); +#else + FILE *outfile = gnulib::fopen ("/dev/null", "w"); +#endif + FILE *errfile = stderr; + + if (outfile) + frame.add_fcn (close_fcn, outfile); + else + { + error ("__delaunayn__: unable to create temporary file for output"); + return retval; + } + + int exitcode = qh_new_qhull (dim, n, pt_array, + ismalloc, flags, outfile, errfile); + if (! exitcode) + { + // triangulate non-simplicial facets + qh_triangulate (); + + facetT *facet; + vertexT *vertex, **vertexp; + octave_idx_type nf = 0, i = 0; + + FORALLfacets + { + if (! facet->upperdelaunay) + nf++; + + // Double check. Non-simplicial facets will cause segfault below + if (! facet->simplicial) + { + error ("__delaunayn__: Qhull returned non-simplicial facets -- try delaunayn with different options"); + exitcode = 1; + break; + } + } + + if (! exitcode) + { + Matrix simpl (nf, dim+1); + + FORALLfacets + { + if (! facet->upperdelaunay) + { + octave_idx_type j = 0; + + FOREACHvertex_ (facet->vertices) + { + simpl(i, j++) = 1 + qh_pointid(vertex->point); + } + i++; + } + } + + retval(0) = simpl; + } + } + else + error ("__delaunayn__: qhull failed"); + + // Free memory from Qhull + qh_freeqhull (! qh_ALL); + + int curlong, totlong; + qh_memfreeshort (&curlong, &totlong); + + if (curlong || totlong) + warning ("__delaunay__: did not free %d bytes of long memory (%d pieces)", + totlong, curlong); + } + else if (n == dim + 1) + { + // one should check if nx points span a simplex + // I will look at this later. + RowVector vec (n); + for (octave_idx_type i = 0; i < n; i++) + vec(i) = i + 1.0; + + retval(0) = vec; + } + +#else + error ("__delaunayn__: not available in this version of Octave"); +#endif + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ diff -r d02b229ce693 -r a132d206a36a src/dldfcn/__dsearchn__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__dsearchn__.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,115 @@ +/* + +Copyright (C) 2007-2012 David Bateman + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "lo-math.h" + +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" + +DEFUN_DLD (__dsearchn__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{idx}, @var{d}] =} dsearch (@var{x}, @var{xi})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value_list retval; + + if (nargin != 2) + { + print_usage (); + return retval; + } + + Matrix x = args(0).matrix_value ().transpose (); + Matrix xi = args(1).matrix_value ().transpose (); + + if (! error_state) + { + if (x.rows () != xi.rows () || x.columns () < 1) + error ("__dsearch__: number of rows of X and XI must match"); + else + { + octave_idx_type n = x.rows (); + octave_idx_type nx = x.columns (); + octave_idx_type nxi = xi.columns (); + + ColumnVector idx (nxi); + double *pidx = idx.fortran_vec (); + ColumnVector dist (nxi); + double *pdist = dist.fortran_vec (); + +#define DIST(dd, y, yi, m) \ + dd = 0.; \ + for (octave_idx_type k = 0; k < m; k++) \ + { \ + double yd = y[k] - yi[k]; \ + dd += yd * yd; \ + } \ + dd = sqrt (dd); + + const double *pxi = xi.fortran_vec (); + for (octave_idx_type i = 0; i < nxi; i++) + { + double d0; + const double *px = x.fortran_vec (); + DIST(d0, px, pxi, n); + *pidx = 1.; + for (octave_idx_type j = 1; j < nx; j++) + { + px += n; + double d; + DIST (d, px, pxi, n); + if (d < d0) + { + d0 = d; + *pidx = static_cast(j + 1); + } + OCTAVE_QUIT; + } + + *pdist++ = d0; + pidx++; + pxi += n; + } + + retval(1) = dist; + retval(0) = idx; + } + } + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ diff -r d02b229ce693 -r a132d206a36a src/dldfcn/__fltk_uigetfile__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__fltk_uigetfile__.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,142 @@ +/* + +Copyright (C) 2010-2012 Kai Habel + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#if defined (HAVE_FLTK) + +#ifdef WIN32 +#define WIN32_LEAN_AND_MEAN +#endif + +#include +#include + +// FLTK headers may include X11/X.h which defines Complex, and that +// conflicts with Octave's Complex typedef. We don't need the X11 +// Complex definition in this file, so remove it before including Octave +// headers which may require Octave's Complex typedef. +#undef Complex + +#include "defun-dld.h" +#include "file-ops.h" + +DEFUN_DLD (__fltk_uigetfile__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __fltk_uigetfile__ (@dots{})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + // Expected argument list: + // + // args(0) ... FileFilter in fltk format + // args(1) ... Title + // args(2) ... Default Filename + // args(3) ... PostionValue [x,y] + // args(4) ... SelectValue "on"/"off"/"dir"/"create" + + octave_value_list retval (3, octave_value (0)); + + std::string file_filter = args(0).string_value (); + std::string title = args(1).string_value (); + std::string default_name = args(2).string_value (); + Matrix pos = args(3).matrix_value (); + + int multi_type = Fl_File_Chooser::SINGLE; + std::string flabel = "Filename:"; + + std::string multi = args(4).string_value (); + if (multi == "on") + multi_type = Fl_File_Chooser::MULTI; + else if (multi == "dir") + { + multi_type = Fl_File_Chooser::DIRECTORY; + flabel = "Directory:"; + } + else if (multi == "create") + multi_type = Fl_File_Chooser::CREATE; + + Fl_File_Chooser::filename_label = flabel.c_str (); + + Fl_File_Chooser fc (default_name.c_str (), file_filter.c_str (), + multi_type, title.c_str ()); + + fc.preview (0); + + if (multi_type == Fl_File_Chooser::CREATE) + fc.ok_label ("Save"); + + fc.show (); + + while (fc.shown ()) + Fl::wait (); + + if (fc.value ()) + { + int file_count = fc.count (); + std::string fname; + + //fltk uses forward slash even for windows + std::string sep = "/"; + std::size_t idx; + + if (file_count == 1 && multi_type != Fl_File_Chooser::DIRECTORY) + { + fname = fc.value (); + idx = fname.find_last_of (sep); + retval(0) = fname.substr (idx + 1); + } + else + { + Cell file_cell = Cell (file_count, 1); + for (octave_idx_type n = 1; n <= file_count; n++) + { + fname = fc.value (n); + idx = fname.find_last_of (sep); + file_cell(n - 1) = fname.substr (idx + 1); + } + retval(0) = file_cell; + } + + if (multi_type == Fl_File_Chooser::DIRECTORY) + retval(0) = std::string (fc.value ()); + else + { + retval(1) = std::string (fc.directory ()) + sep; + retval(2) = fc.filter_value () + 1; + } + } + + fc.hide (); + Fl::flush (); + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ + +#endif diff -r d02b229ce693 -r a132d206a36a src/dldfcn/__glpk__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__glpk__.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,861 @@ +/* + +Copyright (C) 2005-2012 Nicolo' Giorgetti + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "lo-ieee.h" + +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "pager.h" + +#if defined (HAVE_GLPK) + +extern "C" +{ +#if defined (HAVE_GLPK_GLPK_H) +#include +#else +#include +#endif + +#if 0 +#ifdef GLPK_PRE_4_14 + +#ifndef _GLPLIB_H +#include +#endif +#ifndef lib_set_fault_hook +#define lib_set_fault_hook lib_fault_hook +#endif +#ifndef lib_set_print_hook +#define lib_set_print_hook lib_print_hook +#endif + +#else + +void _glp_lib_print_hook (int (*func)(void *info, char *buf), void *info); +void _glp_lib_fault_hook (int (*func)(void *info, char *buf), void *info); + +#endif +#endif +} + +#define NIntP 17 +#define NRealP 10 + +int lpxIntParam[NIntP] = { + 0, + 1, + 0, + 1, + 0, + -1, + 0, + 200, + 1, + 2, + 0, + 1, + 0, + 0, + 2, + 2, + 1 +}; + +int IParam[NIntP] = { + LPX_K_MSGLEV, + LPX_K_SCALE, + LPX_K_DUAL, + LPX_K_PRICE, + LPX_K_ROUND, + LPX_K_ITLIM, + LPX_K_ITCNT, + LPX_K_OUTFRQ, + LPX_K_MPSINFO, + LPX_K_MPSOBJ, + LPX_K_MPSORIG, + LPX_K_MPSWIDE, + LPX_K_MPSFREE, + LPX_K_MPSSKIP, + LPX_K_BRANCH, + LPX_K_BTRACK, + LPX_K_PRESOL +}; + + +double lpxRealParam[NRealP] = { + 0.07, + 1e-7, + 1e-7, + 1e-9, + -DBL_MAX, + DBL_MAX, + -1.0, + 0.0, + 1e-6, + 1e-7 +}; + +int RParam[NRealP] = { + LPX_K_RELAX, + LPX_K_TOLBND, + LPX_K_TOLDJ, + LPX_K_TOLPIV, + LPX_K_OBJLL, + LPX_K_OBJUL, + LPX_K_TMLIM, + LPX_K_OUTDLY, + LPX_K_TOLINT, + LPX_K_TOLOBJ +}; + +static jmp_buf mark; //-- Address for long jump to jump to + +#if 0 +int +glpk_fault_hook (void * /* info */, char *msg) +{ + error ("CRITICAL ERROR in GLPK: %s", msg); + longjmp (mark, -1); +} + +int +glpk_print_hook (void * /* info */, char *msg) +{ + message (0, "%s", msg); + return 1; +} +#endif + +int +glpk (int sense, int n, int m, double *c, int nz, int *rn, int *cn, + double *a, double *b, char *ctype, int *freeLB, double *lb, + int *freeUB, double *ub, int *vartype, int isMIP, int lpsolver, + int save_pb, double *xmin, double *fmin, double *status, + double *lambda, double *redcosts, double *time, double *mem) +{ + int errnum; + int typx = 0; + int method; + + clock_t t_start = clock (); + +#if 0 +#ifdef GLPK_PRE_4_14 + lib_set_fault_hook (0, glpk_fault_hook); +#else + _glp_lib_fault_hook (glpk_fault_hook, 0); +#endif + + if (lpxIntParam[0] > 1) +#ifdef GLPK_PRE_4_14 + lib_set_print_hook (0, glpk_print_hook); +#else + _glp_lib_print_hook (glpk_print_hook, 0); +#endif +#endif + + LPX *lp = lpx_create_prob (); + + + //-- Set the sense of optimization + if (sense == 1) + lpx_set_obj_dir (lp, LPX_MIN); + else + lpx_set_obj_dir (lp, LPX_MAX); + + //-- If the problem has integer structural variables switch to MIP + if (isMIP) + lpx_set_class (lp, LPX_MIP); + + lpx_add_cols (lp, n); + for (int i = 0; i < n; i++) + { + //-- Define type of the structural variables + if (! freeLB[i] && ! freeUB[i]) + { + if (lb[i] != ub[i]) + lpx_set_col_bnds (lp, i+1, LPX_DB, lb[i], ub[i]); + else + lpx_set_col_bnds (lp, i+1, LPX_FX, lb[i], ub[i]); + } + else + { + if (! freeLB[i] && freeUB[i]) + lpx_set_col_bnds (lp, i+1, LPX_LO, lb[i], ub[i]); + else + { + if (freeLB[i] && ! freeUB[i]) + lpx_set_col_bnds (lp, i+1, LPX_UP, lb[i], ub[i]); + else + lpx_set_col_bnds (lp, i+1, LPX_FR, lb[i], ub[i]); + } + } + + // -- Set the objective coefficient of the corresponding + // -- structural variable. No constant term is assumed. + lpx_set_obj_coef(lp,i+1,c[i]); + + if (isMIP) + lpx_set_col_kind (lp, i+1, vartype[i]); + } + + lpx_add_rows (lp, m); + + for (int i = 0; i < m; i++) + { + /* If the i-th row has no lower bound (types F,U), the + corrispondent parameter will be ignored. + If the i-th row has no upper bound (types F,L), the corrispondent + parameter will be ignored. + If the i-th row is of S type, the i-th LB is used, but + the i-th UB is ignored. + */ + + switch (ctype[i]) + { + case 'F': + typx = LPX_FR; + break; + + case 'U': + typx = LPX_UP; + break; + + case 'L': + typx = LPX_LO; + break; + + case 'S': + typx = LPX_FX; + break; + + case 'D': + typx = LPX_DB; + break; + } + + lpx_set_row_bnds (lp, i+1, typx, b[i], b[i]); + + } + + lpx_load_matrix (lp, nz, rn, cn, a); + + if (save_pb) + { + static char tmp[] = "outpb.lp"; + if (lpx_write_cpxlp (lp, tmp) != 0) + { + error ("__glpk__: unable to write problem"); + longjmp (mark, -1); + } + } + + //-- scale the problem data (if required) + //-- if (scale && (!presol || method == 1)) lpx_scale_prob (lp); + //-- LPX_K_SCALE=IParam[1] LPX_K_PRESOL=IParam[16] + if (lpxIntParam[1] && (! lpxIntParam[16] || lpsolver != 1)) + lpx_scale_prob (lp); + + //-- build advanced initial basis (if required) + if (lpsolver == 1 && ! lpxIntParam[16]) + lpx_adv_basis (lp); + + for (int i = 0; i < NIntP; i++) + lpx_set_int_parm (lp, IParam[i], lpxIntParam[i]); + + for (int i = 0; i < NRealP; i++) + lpx_set_real_parm (lp, RParam[i], lpxRealParam[i]); + + if (lpsolver == 1) + method = 'S'; + else + method = 'T'; + + switch (method) + { + case 'S': + { + if (isMIP) + { + method = 'I'; + errnum = lpx_simplex (lp); + errnum = lpx_integer (lp); + } + else + errnum = lpx_simplex (lp); + } + break; + + case 'T': + errnum = lpx_interior (lp); + break; + + default: + break; +#if 0 +#ifdef GLPK_PRE_4_14 + insist (method != method); +#else + static char tmp[] = "method != method"; + glpk_fault_hook (0, tmp); +#endif +#endif + } + + /* errnum assumes the following results: + errnum = 0 <=> No errors + errnum = 1 <=> Iteration limit exceeded. + errnum = 2 <=> Numerical problems with basis matrix. + */ + if (errnum == LPX_E_OK) + { + if (isMIP) + { + *status = lpx_mip_status (lp); + *fmin = lpx_mip_obj_val (lp); + } + else + { + if (lpsolver == 1) + { + *status = lpx_get_status (lp); + *fmin = lpx_get_obj_val (lp); + } + else + { + *status = lpx_ipt_status (lp); + *fmin = lpx_ipt_obj_val (lp); + } + } + + if (isMIP) + { + for (int i = 0; i < n; i++) + xmin[i] = lpx_mip_col_val (lp, i+1); + } + else + { + /* Primal values */ + for (int i = 0; i < n; i++) + { + if (lpsolver == 1) + xmin[i] = lpx_get_col_prim (lp, i+1); + else + xmin[i] = lpx_ipt_col_prim (lp, i+1); + } + + /* Dual values */ + for (int i = 0; i < m; i++) + { + if (lpsolver == 1) + lambda[i] = lpx_get_row_dual (lp, i+1); + else + lambda[i] = lpx_ipt_row_dual (lp, i+1); + } + + /* Reduced costs */ + for (int i = 0; i < lpx_get_num_cols (lp); i++) + { + if (lpsolver == 1) + redcosts[i] = lpx_get_col_dual (lp, i+1); + else + redcosts[i] = lpx_ipt_col_dual (lp, i+1); + } + } + + *time = (clock () - t_start) / CLOCKS_PER_SEC; + +#ifdef GLPK_PRE_4_14 + *mem = (lib_env_ptr () -> mem_tpeak); +#else + *mem = 0; +#endif + + lpx_delete_prob (lp); + return 0; + } + + lpx_delete_prob (lp); + + *status = errnum; + + return errnum; +} + +#endif + +#define OCTAVE_GLPK_GET_REAL_PARAM(NAME, IDX) \ + do \ + { \ + octave_value tmp = PARAM.getfield (NAME); \ + \ + if (tmp.is_defined ()) \ + { \ + if (! tmp.is_empty ()) \ + { \ + lpxRealParam[IDX] = tmp.scalar_value (); \ + \ + if (error_state) \ + { \ + error ("glpk: invalid value in PARAM." NAME); \ + return retval; \ + } \ + } \ + else \ + { \ + error ("glpk: invalid value in PARAM." NAME); \ + return retval; \ + } \ + } \ + } \ + while (0) + +#define OCTAVE_GLPK_GET_INT_PARAM(NAME, VAL) \ + do \ + { \ + octave_value tmp = PARAM.getfield (NAME); \ + \ + if (tmp.is_defined ()) \ + { \ + if (! tmp.is_empty ()) \ + { \ + VAL = tmp.int_value (); \ + \ + if (error_state) \ + { \ + error ("glpk: invalid value in PARAM." NAME); \ + return retval; \ + } \ + } \ + else \ + { \ + error ("glpk: invalid value in PARAM." NAME); \ + return retval; \ + } \ + } \ + } \ + while (0) + +DEFUN_DLD (__glpk__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{values}] =} __glpk__ (@var{args})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + // The list of values to return. See the declaration in oct-obj.h + octave_value_list retval; + +#if defined (HAVE_GLPK) + + int nrhs = args.length (); + + if (nrhs != 9) + { + print_usage (); + return retval; + } + + //-- 1nd Input. A column array containing the objective function + //-- coefficients. + volatile int mrowsc = args(0).rows (); + + Matrix C (args(0).matrix_value ()); + + if (error_state) + { + error ("__glpk__: invalid value of C"); + return retval; + } + + double *c = C.fortran_vec (); + Array rn; + Array cn; + ColumnVector a; + volatile int mrowsA; + volatile int nz = 0; + + //-- 2nd Input. A matrix containing the constraints coefficients. + // If matrix A is NOT a sparse matrix + if (args(1).is_sparse_type ()) + { + SparseMatrix A = args(1).sparse_matrix_value (); // get the sparse matrix + + if (error_state) + { + error ("__glpk__: invalid value of A"); + return retval; + } + + mrowsA = A.rows (); + octave_idx_type Anc = A.cols (); + octave_idx_type Anz = A.nnz (); + rn.resize (dim_vector (Anz+1, 1)); + cn.resize (dim_vector (Anz+1, 1)); + a.resize (Anz+1, 0.0); + + if (Anc != mrowsc) + { + error ("__glpk__: invalid value of A"); + return retval; + } + + for (octave_idx_type j = 0; j < Anc; j++) + for (octave_idx_type i = A.cidx (j); i < A.cidx (j+1); i++) + { + nz++; + rn(nz) = A.ridx (i) + 1; + cn(nz) = j + 1; + a(nz) = A.data(i); + } + } + else + { + Matrix A (args(1).matrix_value ()); // get the matrix + + if (error_state) + { + error ("__glpk__: invalid value of A"); + return retval; + } + + mrowsA = A.rows (); + rn.resize (dim_vector (mrowsA*mrowsc+1, 1)); + cn.resize (dim_vector (mrowsA*mrowsc+1, 1)); + a.resize (mrowsA*mrowsc+1, 0.0); + + for (int i = 0; i < mrowsA; i++) + { + for (int j = 0; j < mrowsc; j++) + { + if (A(i,j) != 0) + { + nz++; + rn(nz) = i + 1; + cn(nz) = j + 1; + a(nz) = A(i,j); + } + } + } + + } + + //-- 3rd Input. A column array containing the right-hand side value + // for each constraint in the constraint matrix. + Matrix B (args(2).matrix_value ()); + + if (error_state) + { + error ("__glpk__: invalid value of B"); + return retval; + } + + double *b = B.fortran_vec (); + + //-- 4th Input. An array of length mrowsc containing the lower + //-- bound on each of the variables. + Matrix LB (args(3).matrix_value ()); + + if (error_state || LB.length () < mrowsc) + { + error ("__glpk__: invalid value of LB"); + return retval; + } + + double *lb = LB.fortran_vec (); + + //-- LB argument, default: Free + Array freeLB (dim_vector (mrowsc, 1)); + for (int i = 0; i < mrowsc; i++) + { + if (xisinf (lb[i])) + { + freeLB(i) = 1; + lb[i] = -octave_Inf; + } + else + freeLB(i) = 0; + } + + //-- 5th Input. An array of at least length numcols containing the upper + //-- bound on each of the variables. + Matrix UB (args(4).matrix_value ()); + + if (error_state || UB.length () < mrowsc) + { + error ("__glpk__: invalid value of UB"); + return retval; + } + + double *ub = UB.fortran_vec (); + + Array freeUB (dim_vector (mrowsc, 1)); + for (int i = 0; i < mrowsc; i++) + { + if (xisinf (ub[i])) + { + freeUB(i) = 1; + ub[i] = octave_Inf; + } + else + freeUB(i) = 0; + } + + //-- 6th Input. A column array containing the sense of each constraint + //-- in the constraint matrix. + charMatrix CTYPE (args(5).char_matrix_value ()); + + if (error_state) + { + error ("__glpk__: invalid value of CTYPE"); + return retval; + } + + char *ctype = CTYPE.fortran_vec (); + + //-- 7th Input. A column array containing the types of the variables. + charMatrix VTYPE (args(6).char_matrix_value ()); + + if (error_state) + { + error ("__glpk__: invalid value of VARTYPE"); + return retval; + } + + Array vartype (dim_vector (mrowsc, 1)); + volatile int isMIP = 0; + for (int i = 0; i < mrowsc ; i++) + { + if (VTYPE(i,0) == 'I') + { + isMIP = 1; + vartype(i) = LPX_IV; + } + else + vartype(i) = LPX_CV; + } + + //-- 8th Input. Sense of optimization. + volatile int sense; + double SENSE = args(7).scalar_value (); + + if (error_state) + { + error ("__glpk__: invalid value of SENSE"); + return retval; + } + + if (SENSE >= 0) + sense = 1; + else + sense = -1; + + //-- 9th Input. A structure containing the control parameters. + octave_scalar_map PARAM = args(8).scalar_map_value (); + + if (error_state) + { + error ("__glpk__: invalid value of PARAM"); + return retval; + } + + //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + //-- Integer parameters + //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + //-- Level of messages output by the solver + OCTAVE_GLPK_GET_INT_PARAM ("msglev", lpxIntParam[0]); + if (lpxIntParam[0] < 0 || lpxIntParam[0] > 3) + { + error ("__glpk__: PARAM.msglev must be 0 (no output [default]) or 1 (error messages only) or 2 (normal output) or 3 (full output)"); + return retval; + } + + //-- scaling option + OCTAVE_GLPK_GET_INT_PARAM ("scale", lpxIntParam[1]); + if (lpxIntParam[1] < 0 || lpxIntParam[1] > 2) + { + error ("__glpk__: PARAM.scale must be 0 (no scaling) or 1 (equilibration scaling [default]) or 2 (geometric mean scaling)"); + return retval; + } + + //-- Dual dimplex option + OCTAVE_GLPK_GET_INT_PARAM ("dual", lpxIntParam[2]); + if (lpxIntParam[2] < 0 || lpxIntParam[2] > 1) + { + error ("__glpk__: PARAM.dual must be 0 (do NOT use dual simplex [default]) or 1 (use dual simplex)"); + return retval; + } + + //-- Pricing option + OCTAVE_GLPK_GET_INT_PARAM ("price", lpxIntParam[3]); + if (lpxIntParam[3] < 0 || lpxIntParam[3] > 1) + { + error ("__glpk__: PARAM.price must be 0 (textbook pricing) or 1 (steepest edge pricing [default])"); + return retval; + } + + //-- Solution rounding option + OCTAVE_GLPK_GET_INT_PARAM ("round", lpxIntParam[4]); + if (lpxIntParam[4] < 0 || lpxIntParam[4] > 1) + { + error ("__glpk__: PARAM.round must be 0 (report all primal and dual values [default]) or 1 (replace tiny primal and dual values by exact zero)"); + return retval; + } + + //-- Simplex iterations limit + OCTAVE_GLPK_GET_INT_PARAM ("itlim", lpxIntParam[5]); + + //-- Simplex iterations count + OCTAVE_GLPK_GET_INT_PARAM ("itcnt", lpxIntParam[6]); + + //-- Output frequency, in iterations + OCTAVE_GLPK_GET_INT_PARAM ("outfrq", lpxIntParam[7]); + + //-- Branching heuristic option + OCTAVE_GLPK_GET_INT_PARAM ("branch", lpxIntParam[14]); + if (lpxIntParam[14] < 0 || lpxIntParam[14] > 2) + { + error ("__glpk__: PARAM.branch must be (MIP only) 0 (branch on first variable) or 1 (branch on last variable) or 2 (branch using a heuristic by Driebeck and Tomlin [default]"); + return retval; + } + + //-- Backtracking heuristic option + OCTAVE_GLPK_GET_INT_PARAM ("btrack", lpxIntParam[15]); + if (lpxIntParam[15] < 0 || lpxIntParam[15] > 2) + { + error ("__glpk__: PARAM.btrack must be (MIP only) 0 (depth first search) or 1 (breadth first search) or 2 (backtrack using the best projection heuristic [default]"); + return retval; + } + + //-- Presolver option + OCTAVE_GLPK_GET_INT_PARAM ("presol", lpxIntParam[16]); + if (lpxIntParam[16] < 0 || lpxIntParam[16] > 1) + { + error ("__glpk__: PARAM.presol must be 0 (do NOT use LP presolver) or 1 (use LP presolver [default])"); + return retval; + } + + //-- LPsolver option + volatile int lpsolver = 1; + OCTAVE_GLPK_GET_INT_PARAM ("lpsolver", lpsolver); + if (lpsolver < 1 || lpsolver > 2) + { + error ("__glpk__: PARAM.lpsolver must be 1 (simplex method) or 2 (interior point method)"); + return retval; + } + + //-- Save option + volatile int save_pb = 0; + OCTAVE_GLPK_GET_INT_PARAM ("save", save_pb); + save_pb = save_pb != 0; + + //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + //-- Real parameters + //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + //-- Ratio test option + OCTAVE_GLPK_GET_REAL_PARAM ("relax", 0); + + //-- Relative tolerance used to check if the current basic solution + //-- is primal feasible + OCTAVE_GLPK_GET_REAL_PARAM ("tolbnd", 1); + + //-- Absolute tolerance used to check if the current basic solution + //-- is dual feasible + OCTAVE_GLPK_GET_REAL_PARAM ("toldj", 2); + + //-- Relative tolerance used to choose eligible pivotal elements of + //-- the simplex table in the ratio test + OCTAVE_GLPK_GET_REAL_PARAM ("tolpiv", 3); + + OCTAVE_GLPK_GET_REAL_PARAM ("objll", 4); + + OCTAVE_GLPK_GET_REAL_PARAM ("objul", 5); + + OCTAVE_GLPK_GET_REAL_PARAM ("tmlim", 6); + + OCTAVE_GLPK_GET_REAL_PARAM ("outdly", 7); + + OCTAVE_GLPK_GET_REAL_PARAM ("tolint", 8); + + OCTAVE_GLPK_GET_REAL_PARAM ("tolobj", 9); + + //-- Assign pointers to the output parameters + ColumnVector xmin (mrowsc, octave_NA); + double fmin = octave_NA; + double status; + ColumnVector lambda (mrowsA, octave_NA); + ColumnVector redcosts (mrowsc, octave_NA); + double time; + double mem; + + int jmpret = setjmp (mark); + + if (jmpret == 0) + glpk (sense, mrowsc, mrowsA, c, nz, rn.fortran_vec (), + cn.fortran_vec (), a.fortran_vec (), b, ctype, + freeLB.fortran_vec (), lb, freeUB.fortran_vec (), ub, + vartype.fortran_vec (), isMIP, lpsolver, save_pb, + xmin.fortran_vec (), &fmin, &status, lambda.fortran_vec (), + redcosts.fortran_vec (), &time, &mem); + + octave_scalar_map extra; + + if (! isMIP) + { + extra.assign ("lambda", lambda); + extra.assign ("redcosts", redcosts); + } + + extra.assign ("time", time); + extra.assign ("mem", mem); + + retval(3) = extra; + retval(2) = status; + retval(1) = fmin; + retval(0) = xmin; + +#else + + gripe_not_supported ("glpk"); + +#endif + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ diff -r d02b229ce693 -r a132d206a36a src/dldfcn/__init_fltk__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__init_fltk__.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,2129 @@ +/* + +Copyright (C) 2007-2012 Shai Ayal + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + +To initialize: + + graphics_toolkit ("fltk"); + plot (randn (1e3, 1)); + +*/ + +// PKG_ADD: register_graphics_toolkit ("fltk"); + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "defun-dld.h" +#include "error.h" + +#if defined (HAVE_FLTK) + +#include +#include +#include +#include + +#ifdef WIN32 +#define WIN32_LEAN_AND_MEAN +#endif + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +// FLTK headers may include X11/X.h which defines Complex, and that +// conflicts with Octave's Complex typedef. We don't need the X11 +// Complex definition in this file, so remove it before including Octave +// headers which may require Octave's Complex typedef. +#undef Complex + +#include "cmd-edit.h" +#include "lo-ieee.h" + +#include "file-ops.h" +#include "gl-render.h" +#include "gl2ps-renderer.h" +#include "graphics.h" +#include "parse.h" +#include "sysdep.h" +#include "toplev.h" +#include "variables.h" + +#define FLTK_GRAPHICS_TOOLKIT_NAME "fltk" + +// Give FLTK no more than 0.01 sec to do its stuff. +static double fltk_maxtime = 1e-2; + +const char* help_text = "\ +Keyboard Shortcuts\n\ +a - autoscale\n\ +p - pan/zoom\n\ +r - rotate\n\ +g - toggle grid\n\ +\n\ +Mouse\n\ +left drag - pan\n\ +mouse wheel - zoom\n\ +right drag - rectangle zoom\n\ +left double click - autoscale\n\ +"; + +class OpenGL_fltk : public Fl_Gl_Window +{ +public: + OpenGL_fltk (int xx, int yy, int ww, int hh, double num) + : Fl_Gl_Window (xx, yy, ww, hh, 0), number (num), renderer (), + in_zoom (false), zoom_box (), print_mode (false) + { + // Ask for double buffering and a depth buffer. + mode (FL_DEPTH | FL_DOUBLE); + } + + ~OpenGL_fltk (void) { } + + void zoom (bool z) + { + in_zoom = z; + if (! in_zoom) + hide_overlay (); + } + + bool zoom (void) { return in_zoom; } + void set_zoom_box (const Matrix& zb) { zoom_box = zb; } + + void print (const std::string& cmd, const std::string& term) + { + print_mode = true; + print_cmd = cmd; + print_term = term; + } + + void resize (int xx, int yy, int ww, int hh) + { + Fl_Gl_Window::resize (xx, yy, ww, hh); + setup_viewport (ww, hh); + redraw (); + } + + bool renumber (double new_number) + { + bool retval = false; + + if (number != new_number) + { + number = new_number; + retval = true; + } + + return retval; + } + +private: + double number; + opengl_renderer renderer; + bool in_zoom; + // (x1,y1,x2,y2) + Matrix zoom_box; + + bool print_mode; + std::string print_cmd; + std::string print_term; + + void setup_viewport (int ww, int hh) + { + glMatrixMode (GL_PROJECTION); + glLoadIdentity (); + glViewport (0, 0, ww, hh); + } + + void draw (void) + { + if (! valid ()) + { + valid (1); + setup_viewport (w (), h ()); + } + + if (print_mode) + { + FILE *fp = octave_popen (print_cmd.c_str (), "w"); + glps_renderer rend (fp, print_term); + + rend.draw (gh_manager::get_object (number)); + + octave_pclose (fp); + print_mode = false; + } + else + { + renderer.draw (gh_manager::get_object (number)); + + if (zoom ()) + overlay (); + } + } + + void zoom_box_vertex (void) + { + glVertex2d (zoom_box(0), h () - zoom_box(1)); + glVertex2d (zoom_box(0), h () - zoom_box(3)); + glVertex2d (zoom_box(2), h () - zoom_box(3)); + glVertex2d (zoom_box(2), h () - zoom_box(1)); + glVertex2d (zoom_box(0), h () - zoom_box(1)); + } + + void overlay (void) + { + glPushMatrix (); + + glMatrixMode (GL_MODELVIEW); + glLoadIdentity (); + + glMatrixMode (GL_PROJECTION); + glLoadIdentity (); + gluOrtho2D (0.0, w (), 0.0, h ()); + + glPushAttrib (GL_DEPTH_BUFFER_BIT | GL_CURRENT_BIT); + glDisable (GL_DEPTH_TEST); + + glBegin (GL_POLYGON); + glColor4f (0.45, 0.62, 0.81, 0.1); + zoom_box_vertex (); + glEnd (); + + glBegin (GL_LINE_STRIP); + glLineWidth (1.5); + glColor4f (0.45, 0.62, 0.81, 0.9); + zoom_box_vertex (); + glEnd (); + + glPopAttrib (); + glPopMatrix (); + } + + int handle (int event) + { + int retval = Fl_Gl_Window::handle (event); + + switch (event) + { + case FL_ENTER: + window ()->cursor (FL_CURSOR_CROSS); + return 1; + + case FL_LEAVE: + window ()->cursor (FL_CURSOR_DEFAULT); + return 1; + } + + return retval; + } +}; + +// Parameter controlling how fast we zoom when using the scrool wheel. +static double wheel_zoom_speed = 0.05; +// Parameter controlling the GUI mode. +static enum { pan_zoom, rotate_zoom, none } gui_mode; + +void script_cb (Fl_Widget*, void* data) + { + static_cast (data)->execute_callback (); + } + + +class fltk_uimenu +{ +public: + fltk_uimenu (int xx, int yy, int ww, int hh) + { + menubar = new + Fl_Menu_Bar (xx, yy, ww, hh); + } + + int items_to_show (void) + { + //returns the number of visible menu items + int len = menubar->size (); + int n = 0; + for (int t = 0; t < len; t++ ) + { + const Fl_Menu_Item *m = static_cast (&(menubar->menu ()[t])); + if ((m->label () != NULL) && m->visible ()) + n++; + } + + return n; + } + + void show (void) + { + menubar->show (); + } + + void hide (void) + { + menubar->hide (); + } + + bool is_visible (void) + { + return menubar->visible (); + } + + int find_index_by_name (const std::string& findname) + { + // This function is derived from Greg Ercolano's function + // int GetIndexByName(...), see: + // http://seriss.com/people/erco/fltk/#Menu_ChangeLabel + // He agreed via PM that it can be included in octave using GPLv3 + // Kai Habel (14.10.2010) + + std::string menupath; + for (int t = 0; t < menubar->size (); t++ ) + { + Fl_Menu_Item *m = const_cast (&(menubar->menu ()[t])); + if (m->submenu ()) + { + // item has submenu + if (!menupath.empty ()) + menupath += "/"; + menupath += m->label (); + + if (menupath.compare (findname) == 0 ) + return (t); + } + else + { + // End of submenu? Pop back one level. + if (m->label () == NULL) + { + std::size_t idx = menupath.find_last_of ("/"); + if (idx != std::string::npos) + menupath.erase (idx); + else + menupath.clear (); + continue; + } + // Menu item? + std::string itempath = menupath; + if (!itempath.empty ()) + itempath += "/"; + itempath += m->label (); + + if (itempath.compare (findname) == 0) + return (t); + } + } + return (-1); + } + + Matrix find_uimenu_children (uimenu::properties& uimenup) const + { + Matrix uimenu_childs = uimenup.get_all_children (); + Matrix retval = do_find_uimenu_children (uimenu_childs); + return retval; + } + + Matrix find_uimenu_children (figure::properties& figp) const + { + Matrix uimenu_childs = figp.get_all_children (); + Matrix retval = do_find_uimenu_children (uimenu_childs); + return retval; + } + + Matrix do_find_uimenu_children (Matrix uimenu_childs) const + { + octave_idx_type k = 0; + + + Matrix pos = Matrix (uimenu_childs.numel (), 1); + + for (octave_idx_type ii = 0; ii < uimenu_childs.numel (); ii++) + { + graphics_object kidgo = gh_manager::get_object (uimenu_childs (ii)); + + if (kidgo.valid_object () && kidgo.isa ("uimenu")) + { + uimenu_childs(k) = uimenu_childs(ii); + pos(k++) = + dynamic_cast (kidgo.get_properties ()).get_position (); + } + } + + uimenu_childs.resize (k, 1); + pos.resize (k, 1); + Matrix retval = Matrix (k, 1); + // Don't know if this is the best method to sort. + // Can we avoid the for loop? + Array sidx = pos.sort_rows_idx (DESCENDING); + for (octave_idx_type ii = 0; ii < k; ii++) + retval(ii) = uimenu_childs (sidx(ii)); + + return retval; + } + + void delete_entry (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + int idx = find_index_by_name (fltk_label.c_str ()); + + if (idx >= 0) + menubar->remove (idx); + } + + void update_accelerator (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); + if (item != NULL) + { + std::string acc = uimenup.get_accelerator (); + if (acc.length () > 0) + { + int key = FL_CTRL + acc[0]; + item->shortcut (key); + } + } + } + } + + void update_callback (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); + if (item != NULL) + { + if (!uimenup.get_callback ().is_empty ()) + item->callback (static_cast (script_cb), + static_cast (&uimenup)); + else + item->callback (NULL, static_cast (0)); + } + } + } + + void update_enable (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); + if (item != NULL) + { + if (uimenup.is_enable ()) + item->activate (); + else + item->deactivate (); + } + } + } + + void update_foregroundcolor (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); + if (item != NULL) + { + Matrix rgb = uimenup.get_foregroundcolor_rgb (); + + uchar r = static_cast (gnulib::floor (rgb (0) * 255)); + uchar g = static_cast (gnulib::floor (rgb (1) * 255)); + uchar b = static_cast (gnulib::floor (rgb (2) * 255)); + + item->labelcolor (fl_rgb_color (r, g, b)); + } + } + } + + void update_seperator (const uimenu::properties& uimenup) + { + // Matlab places the separator before the current + // menu entry, while fltk places it after. So we need to find + // the previous item in this menu/submenu. (Kai) + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + int itemflags = 0, idx; + int curr_idx = find_index_by_name (fltk_label.c_str ()); + + for (idx = curr_idx - 1; idx >= 0; idx--) + { + Fl_Menu_Item* item = const_cast (&menubar->menu () [idx]); + itemflags = item->flags; + if (item->label () != NULL) + break; + } + + if (idx >= 0 && idx < menubar->size ()) + { + if (uimenup.is_separator ()) + { + if (idx >= 0 && !(itemflags & FL_SUBMENU)) + menubar->mode (idx, itemflags | FL_MENU_DIVIDER); + } + else + menubar->mode (idx, itemflags & (~FL_MENU_DIVIDER)); + } + } + } + + void update_visible (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + Fl_Menu_Item* item + = const_cast (menubar->find_item (fltk_label.c_str ())); + if (item != NULL) + { + if (uimenup.is_visible ()) + item->show (); + else + item->hide (); + } + } + } + + void add_entry (uimenu::properties& uimenup) + { + + std::string fltk_label = uimenup.get_fltk_label (); + + if (!fltk_label.empty ()) + { + bool item_added = false; + do + { + const Fl_Menu_Item* item + = menubar->find_item (fltk_label.c_str ()); + + if (item == NULL) + { + Matrix uimenu_ch = find_uimenu_children (uimenup); + int len = uimenu_ch.numel (); + int flags = 0; + if (len > 0) + flags = FL_SUBMENU; + if (len == 0 && uimenup.is_checked ()) + flags += FL_MENU_TOGGLE + FL_MENU_VALUE; + menubar->add (fltk_label.c_str (), 0, 0, 0, flags); + item_added = true; + } + else + { + //avoid duplicate menulabels + std::size_t idx1 = fltk_label.find_last_of ("("); + std::size_t idx2 = fltk_label.find_last_of (")"); + int len = idx2 - idx1; + int val = 1; + if (len > 0) + { + std::string valstr = fltk_label.substr (idx1 + 1, len - 1); + fltk_label.erase (idx1, len + 1); + val = atoi (valstr.c_str ()); + if (val > 0 && val < 99) + val++; + } + std::ostringstream valstream; + valstream << val; + fltk_label += "(" + valstream.str () + ")"; + } + } + while (!item_added); + uimenup.set_fltk_label (fltk_label); + } + } + + void add_to_menu (uimenu::properties& uimenup) + { + Matrix kids = find_uimenu_children (uimenup); + int len = kids.length (); + std::string fltk_label = uimenup.get_fltk_label (); + + add_entry (uimenup); + update_foregroundcolor (uimenup); + update_callback (uimenup); + update_accelerator (uimenup); + update_enable (uimenup); + update_visible (uimenup); + update_seperator (uimenup); + + for (octave_idx_type ii = 0; ii < len; ii++) + { + graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); + if (kgo.valid_object ()) + { + uimenu::properties& kprop = dynamic_cast (kgo.get_properties ()); + add_to_menu (kprop); + } + } + } + + void add_to_menu (figure::properties& figp) + { + Matrix kids = find_uimenu_children (figp); + int len = kids.length (); + menubar->clear (); + for (octave_idx_type ii = 0; ii < len; ii++) + { + graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); + + if (kgo.valid_object ()) + { + uimenu::properties& kprop = dynamic_cast (kgo.get_properties ()); + add_to_menu (kprop); + } + } + } + + template + void remove_from_menu (T_prop& prop) + { + Matrix kids; + std::string type = prop.get_type (); + kids = find_uimenu_children (prop); + int len = kids.length (); + + for (octave_idx_type ii = 0; ii < len; ii++) + { + graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); + + if (kgo.valid_object ()) + { + uimenu::properties kprop = dynamic_cast (kgo.get_properties ()); + remove_from_menu (kprop); + } + } + + if (type.compare ("uimenu") == 0) + delete_entry (dynamic_cast (prop)); + else if (type.compare ("figure") == 0) + menubar->clear (); + } + + ~fltk_uimenu (void) + { + delete menubar; + } + +private: + + // No copying! + + fltk_uimenu (const fltk_uimenu&); + + fltk_uimenu operator = (const fltk_uimenu&); + + Fl_Menu_Bar* menubar; +}; + +class plot_window : public Fl_Window +{ + friend class fltk_uimenu; +public: + plot_window (int xx, int yy, int ww, int hh, figure::properties& xfp) + : Fl_Window (xx, yy, ww, hh, "octave"), window_label (), shift (0), + ndim (2), fp (xfp), canvas (0), autoscale (0), togglegrid (0), + panzoom (0), rotate (0), help (0), status (0), + ax_obj (), pos_x (0), pos_y (0) + { + callback (window_close, static_cast (this)); + size_range (4*status_h, 2*status_h); + + // FIXME: The function below is only available in FLTK >= 1.3 + // At some point support for FLTK 1.1 will be dropped in Octave. + // At that point this function should be uncommented. + // The current solution is to call xclass() before show() for each window. + // Set WM_CLASS which allows window managers to properly group related + // windows. Otherwise, the class is just "FLTK" + //default_xclass ("Octave"); + + begin (); + { + + canvas = new OpenGL_fltk (0, 0, ww, hh - status_h, number ()); + + uimenu = new fltk_uimenu (0, 0, ww, menu_h); + uimenu->hide (); + + bottom = new Fl_Box (0, hh - status_h, ww, status_h); + bottom->box (FL_FLAT_BOX); + + ndim = calc_dimensions (gh_manager::get_object (fp.get___myhandle__ ())); + + autoscale = new Fl_Button (0, hh - status_h, status_h, status_h, "A"); + autoscale->callback (button_callback, static_cast (this)); + autoscale->tooltip ("Autoscale"); + + togglegrid = new Fl_Button (status_h, hh - status_h, status_h, + status_h, "G"); + togglegrid->callback (button_callback, static_cast (this)); + togglegrid->tooltip ("Toggle Grid"); + + panzoom = new Fl_Button (2 * status_h, hh - status_h, status_h, + status_h, "P"); + panzoom->callback (button_callback, static_cast (this)); + panzoom->tooltip ("Mouse Pan/Zoom"); + + rotate = new Fl_Button (3 * status_h, hh - status_h, status_h, + status_h, "R"); + rotate->callback (button_callback, static_cast (this)); + rotate->tooltip ("Mouse Rotate"); + + if (ndim == 2) + rotate->deactivate (); + + help = new Fl_Button (4 * status_h, hh - status_h, status_h, + status_h, "?"); + help->callback (button_callback, static_cast (this)); + help->tooltip ("Help"); + + status = new Fl_Output (5 * status_h, hh - status_h, + ww > 2*status_h ? ww - status_h : 0, + status_h, ""); + + status->textcolor (FL_BLACK); + status->color (FL_GRAY); + status->textfont (FL_COURIER); + status->textsize (10); + status->box (FL_ENGRAVED_BOX); + + // This allows us to have a valid OpenGL context right away. + canvas->mode (FL_DEPTH | FL_DOUBLE ); + if (fp.is_visible ()) + { + // FIXME: This code should be removed when Octave drops support + // for FLTK 1.1. Search for default_xclass in this file to find + // code that should be uncommented to take its place. + // + // Set WM_CLASS which allows window managers to properly group + // related windows. Otherwise, the class is just "FLTK" + xclass ("Octave"); + show (); + if (fp.get_currentaxes ().ok ()) + show_canvas (); + else + hide_canvas (); + } + } + end (); + + status->show (); + autoscale->show (); + togglegrid->show (); + panzoom->show (); + rotate->show (); + + set_name (); + resizable (canvas); + gui_mode = (ndim == 3 ? rotate_zoom : pan_zoom); + uimenu->add_to_menu (fp); + if (uimenu->items_to_show ()) + show_menubar (); + else + hide_menubar (); + } + + ~plot_window (void) + { + canvas->hide (); + status->hide (); + uimenu->hide (); + this->hide (); + } + + double number (void) { return fp.get___myhandle__ ().value (); } + + void renumber (double new_number) + { + if (canvas) + { + if (canvas->renumber (new_number)) + mark_modified (); + } + else + error ("unable to renumber figure"); + } + + void print (const std::string& cmd, const std::string& term) + { + canvas->print (cmd, term); + + // Print immediately so the output file will exist when the drawnow + // command is done. + mark_modified (); + Fl::wait (fltk_maxtime); + } + + void show_menubar (void) + { + if (!uimenu->is_visible ()) + { + canvas->resize (canvas->x (), + canvas->y () + menu_h, + canvas->w (), + canvas->h () - menu_h); + uimenu->show (); + mark_modified (); + } + } + + void hide_menubar (void) + { + if (uimenu->is_visible ()) + { + canvas->resize (canvas->x (), + canvas->y () - menu_h, + canvas->w (), + canvas->h () + menu_h); + uimenu->hide (); + mark_modified (); + } + } + + void uimenu_update (const graphics_handle& gh, int id) + { + graphics_object uimenu_obj = gh_manager::get_object (gh); + + if (uimenu_obj.valid_object () && uimenu_obj.isa ("uimenu")) + { + uimenu::properties& uimenup = + dynamic_cast (uimenu_obj.get_properties ()); + std::string fltk_label = uimenup.get_fltk_label (); + graphics_object fig = uimenu_obj.get_ancestor ("figure"); + figure::properties& figp = + dynamic_cast (fig.get_properties ()); + + switch (id) + { + case base_properties::ID_BEINGDELETED: + uimenu->remove_from_menu (uimenup); + break; + + case base_properties::ID_VISIBLE: + uimenu->update_visible (uimenup); + break; + + case uimenu::properties::ID_ACCELERATOR: + uimenu->update_accelerator (uimenup); + break; + + case uimenu::properties::ID_CALLBACK: + uimenu->update_callback (uimenup); + break; + + case uimenu::properties::ID_CHECKED: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_ENABLE: + uimenu->update_enable (uimenup); + break; + + case uimenu::properties::ID_FOREGROUNDCOLOR: + uimenu->update_foregroundcolor (uimenup); + break; + + case uimenu::properties::ID_LABEL: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_POSITION: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_SEPARATOR: + uimenu->update_seperator (uimenup); + break; + } + + if (uimenu->items_to_show ()) + show_menubar (); + else + hide_menubar (); + + mark_modified (); + } + } + + void show_canvas (void) + { + if (fp.is_visible ()) + { + canvas->show (); + canvas->make_current (); + } + } + + void hide_canvas (void) + { + canvas->hide (); + } + + void mark_modified (void) + { + damage (FL_DAMAGE_ALL); + canvas->damage (FL_DAMAGE_ALL); + ndim = calc_dimensions (gh_manager::get_object (fp.get___myhandle__ ())); + + if (ndim == 3) + rotate->activate (); + else if (ndim == 2 && gui_mode == rotate_zoom) + { + rotate->deactivate (); + gui_mode = pan_zoom; + } + } + + void set_name (void) + { + window_label = fp.get_title (); + label (window_label.c_str ()); + } + +private: + + // No copying! + + plot_window (const plot_window&); + + plot_window& operator = (const plot_window&); + + // window name -- this must exists for the duration of the window's + // life + std::string window_label; + + // Mod keys status + int shift; + + // Number of dimensions, 2 or 3. + int ndim; + + // Figure properties. + figure::properties& fp; + + // Status area height. + static const int status_h = 20; + + // Menu height + static const int menu_h = 20; + + // Window callback. + static void window_close (Fl_Widget*, void* data) + { + octave_value_list args; + args(0) = static_cast (data)->number (); + feval ("close", args); + } + + // Button callbacks. + static void button_callback (Fl_Widget* ww, void* data) + { + static_cast (data)->button_press (ww, data); + } + + void button_press (Fl_Widget* widg, void*) + { + if (widg == autoscale) + axis_auto (); + + if (widg == togglegrid) + toggle_grid (); + + if (widg == panzoom) + gui_mode = pan_zoom; + + if (widg == rotate && ndim == 3) + gui_mode = rotate_zoom; + + if (widg == help) + fl_message ("%s", help_text); + } + + fltk_uimenu* uimenu; + OpenGL_fltk* canvas; + Fl_Box* bottom; + Fl_Button* autoscale; + Fl_Button* togglegrid; + Fl_Button* panzoom; + Fl_Button* rotate; + Fl_Button* help; + Fl_Output* status; + graphics_object ax_obj; + int pos_x; + int pos_y; + + void axis_auto (void) + { + octave_value_list args; + args(0) = fp.get_currentaxes ().as_octave_value (); + args(1) = "auto"; + feval ("axis", args); + mark_modified (); + } + + void toggle_grid (void) + { + octave_value_list args; + if (fp.get_currentaxes ().ok ()) + args(0) = fp.get_currentaxes ().as_octave_value (); + + feval ("grid", args); + mark_modified (); + } + + void pixel2pos (const graphics_handle& ax, int px, int py, double& xx, + double& yy) const + { + pixel2pos ( gh_manager::get_object (ax), px, py, xx, yy); + } + + void pixel2pos (graphics_object ax, int px, int py, double& xx, + double& yy) const + { + if (ax && ax.isa ("axes")) + { + axes::properties& ap = + dynamic_cast (ax.get_properties ()); + ColumnVector pp = ap.pixel2coord (px, py); + xx = pp(0); + yy = pp(1); + } + } + + graphics_handle pixel2axes_or_ca (int px, int py ) + { + Matrix kids = fp.get_children (); + int len = kids.length (); + + for (int k = 0; k < len; k++) + { + graphics_handle hnd = gh_manager::lookup (kids(k)); + + if (hnd.ok ()) + { + graphics_object kid = gh_manager::get_object (hnd); + + if (kid.valid_object () && kid.isa ("axes")) + { + Matrix bb = kid.get_properties ().get_boundingbox (true); + + if (bb(0) <= px && px < (bb(0)+bb(2)) + && bb(1) <= py && py < (bb(1)+bb(3))) + { + return hnd; + } + } + } + } + return fp.get_currentaxes (); + } + + void pixel2status (const graphics_handle& ax, int px0, int py0, + int px1 = -1, int py1 = -1) + { + pixel2status (gh_manager::get_object (ax), px0, py0, px1, py1); + } + + void pixel2status (graphics_object ax, int px0, int py0, + int px1 = -1, int py1 = -1) + { + double x0, y0, x1, y1; + std::stringstream cbuf; + cbuf.precision (4); + cbuf.width (6); + pixel2pos (ax, px0, py0, x0, y0); + cbuf << "[" << x0 << ", " << y0 << "]"; + if (px1 >= 0) + { + pixel2pos (ax, px1, py1, x1, y1); + cbuf << " -> ["<< x1 << ", " << y1 << "]"; + } + + status->value (cbuf.str ().c_str ()); + status->redraw (); + } + + void view2status (graphics_object ax) + { + if (ax && ax.isa ("axes")) + { + axes::properties& ap = + dynamic_cast (ax.get_properties ()); + std::stringstream cbuf; + cbuf.precision (4); + cbuf.width (6); + Matrix v (1,2,0); + v = ap.get ("view").matrix_value (); + cbuf << "[azimuth: " << v(0) << ", elevation: " << v(1) << "]"; + + status->value (cbuf.str ().c_str ()); + status->redraw (); + } + } + + void set_currentpoint (int px, int py) + { + if (!fp.is_beingdeleted ()) + { + Matrix pos (1,2,0); + pos(0) = px; + pos(1) = h () - status_h - menu_h - py; + fp.set_currentpoint (pos); + } + } + + void set_axes_currentpoint (graphics_object ax, int px, int py) + { + if (ax.valid_object ()) + { + axes::properties& ap = + dynamic_cast (ax.get_properties ()); + + double xx, yy; + pixel2pos (ax, px, py, xx, yy); + + Matrix pos (2,3,0); + pos(0,0) = xx; + pos(1,0) = yy; + pos(0,1) = xx; + pos(1,1) = yy; + + ap.set_currentpoint (pos); + } + } + + int key2shift (int key) + { + if (key == FL_Shift_L || key == FL_Shift_R) + return FL_SHIFT; + + if (key == FL_Control_L || key == FL_Control_R) + return FL_CTRL; + + if (key == FL_Alt_L || key == FL_Alt_R) + return FL_ALT; + + if (key == FL_Meta_L || key == FL_Meta_R) + return FL_META; + + return 0; + } + + int key2ascii (int key) + { + if (key < 256) return key; + if (key == FL_Tab) return '\t'; + if (key == FL_Enter) return 0x0a; + if (key == FL_BackSpace) return 0x08; + if (key == FL_Escape) return 0x1b; + + return 0; + } + + Cell modifier2cell () + { + string_vector mod; + + if (shift & FL_SHIFT) + mod.append (std::string ("shift")); + if (shift & FL_CTRL) + mod.append (std::string ("control")); + if (shift & FL_ALT || shift & FL_META) + mod.append (std::string ("alt")); + + return Cell (mod); + } + + void resize (int xx,int yy,int ww,int hh) + { + Fl_Window::resize (xx, yy, ww, hh); + + Matrix pos (1,4,0); + pos(0) = xx; + pos(1) = yy; + pos(2) = ww; + pos(3) = hh - status_h - menu_h; + + fp.set_boundingbox (pos, true); + } + + void draw (void) + { + Matrix pos = fp.get_boundingbox (true); + Fl_Window::resize (pos(0), pos(1), pos(2), pos(3) + status_h + menu_h); + + return Fl_Window::draw (); + } + + int handle (int event) + { + graphics_handle gh; + + graphics_object fig = gh_manager::get_object (fp.get___myhandle__ ()); + int retval = Fl_Window::handle (event); + + // We only handle events which are in the canvas area. + if (!Fl::event_inside (canvas)) + return retval; + + if (!fp.is_beingdeleted ()) + { + switch (event) + { + case FL_KEYDOWN: + { + int key = Fl::event_key (); + + shift |= key2shift (key); + int key_a = key2ascii (key); + if (key_a && fp.get_keypressfcn ().is_defined ()) + { + Octave_map evt; + evt.assign ("Character", octave_value (key_a)); + evt.assign ("Key", octave_value (std::tolower (key_a))); + evt.assign ("Modifier", octave_value (modifier2cell ())); + fp.execute_keypressfcn (evt); + } + switch (key) + { + case 'a': + case 'A': + axis_auto (); + break; + + case 'g': + case 'G': + toggle_grid (); + break; + + case 'p': + case 'P': + gui_mode = pan_zoom; + break; + + case 'r': + case 'R': + gui_mode = rotate_zoom; + break; + } + } + break; + + case FL_KEYUP: + { + int key = Fl::event_key (); + + shift &= (~key2shift (key)); + int key_a = key2ascii (key); + if (key_a && fp.get_keyreleasefcn ().is_defined ()) + { + Octave_map evt; + evt.assign ("Character", octave_value (key_a)); + evt.assign ("Key", octave_value (std::tolower (key_a))); + evt.assign ("Modifier", octave_value (modifier2cell ())); + fp.execute_keyreleasefcn (evt); + } + } + break; + + case FL_MOVE: + pixel2status (pixel2axes_or_ca (Fl::event_x (), Fl::event_y ()), + Fl::event_x (), Fl::event_y ()); + break; + + case FL_PUSH: + pos_x = Fl::event_x (); + pos_y = Fl::event_y (); + + set_currentpoint (Fl::event_x (), Fl::event_y ()); + + gh = pixel2axes_or_ca (pos_x, pos_y); + + if (gh.ok ()) + { + ax_obj = gh_manager::get_object (gh); + set_axes_currentpoint (ax_obj, pos_x, pos_y); + } + + fp.execute_windowbuttondownfcn (); + + if (Fl::event_button () == 1 || Fl::event_button () == 3) + return 1; + + break; + + case FL_DRAG: + if (fp.get_windowbuttonmotionfcn ().is_defined ()) + { + set_currentpoint (Fl::event_x (), Fl::event_y ()); + fp.execute_windowbuttonmotionfcn (); + } + + if (Fl::event_button () == 1) + { + if (ax_obj && ax_obj.isa ("axes")) + { + if (gui_mode == pan_zoom) + pixel2status (ax_obj, pos_x, pos_y, + Fl::event_x (), Fl::event_y ()); + else + view2status (ax_obj); + axes::properties& ap = + dynamic_cast (ax_obj.get_properties ()); + + double x0, y0, x1, y1; + Matrix pos = fp.get_boundingbox (true); + pixel2pos (ax_obj, pos_x, pos_y, x0, y0); + pixel2pos (ax_obj, Fl::event_x (), Fl::event_y (), x1, y1); + + if (gui_mode == pan_zoom) + ap.translate_view (x0, x1, y0, y1); + else if (gui_mode == rotate_zoom) + { + double daz, del; + daz = (Fl::event_x () - pos_x) / pos(2) * 360; + del = (Fl::event_y () - pos_y) / pos(3) * 360; + ap.rotate_view (del, daz); + } + + pos_x = Fl::event_x (); + pos_y = Fl::event_y (); + mark_modified (); + } + return 1; + } + else if (Fl::event_button () == 3) + { + pixel2status (ax_obj, pos_x, pos_y, + Fl::event_x (), Fl::event_y ()); + Matrix zoom_box (1,4,0); + zoom_box (0) = pos_x; + zoom_box (1) = pos_y; + zoom_box (2) = Fl::event_x (); + zoom_box (3) = Fl::event_y (); + canvas->set_zoom_box (zoom_box); + canvas->zoom (true); + canvas->redraw (); + } + + break; + + case FL_MOUSEWHEEL: + { + graphics_object ax = + gh_manager::get_object (pixel2axes_or_ca (Fl::event_x (), + Fl::event_y ())); + if (ax && ax.isa ("axes")) + { + axes::properties& ap = + dynamic_cast (ax.get_properties ()); + + // Determine if we're zooming in or out. + const double factor = + (Fl::event_dy () > 0) ? 1.0 + wheel_zoom_speed : 1.0 - wheel_zoom_speed; + + // Get the point we're zooming about. + double x1, y1; + pixel2pos (ax, Fl::event_x (), Fl::event_y (), x1, y1); + + ap.zoom_about_point (x1, y1, factor, false); + mark_modified (); + } + } + return 1; + + case FL_RELEASE: + if (fp.get_windowbuttonupfcn ().is_defined ()) + { + set_currentpoint (Fl::event_x (), Fl::event_y ()); + fp.execute_windowbuttonupfcn (); + } + + if (Fl::event_button () == 1) + { + if ( Fl::event_clicks () == 1) + { + if (ax_obj && ax_obj.isa ("axes")) + { + axes::properties& ap = + dynamic_cast (ax_obj.get_properties ()); + ap.set_xlimmode ("auto"); + ap.set_ylimmode ("auto"); + ap.set_zlimmode ("auto"); + mark_modified (); + } + } + } + if (Fl::event_button () == 3) + { + // End of drag -- zoom. + if (canvas->zoom ()) + { + canvas->zoom (false); + double x0,y0,x1,y1; + if (ax_obj && ax_obj.isa ("axes")) + { + axes::properties& ap = + dynamic_cast (ax_obj.get_properties ()); + pixel2pos (ax_obj, pos_x, pos_y, x0, y0); + int pos_x1 = Fl::event_x (); + int pos_y1 = Fl::event_y (); + pixel2pos (ax_obj, pos_x1, pos_y1, x1, y1); + Matrix xl (1,2,0); + Matrix yl (1,2,0); + int dx = abs (pos_x - pos_x1); + int dy = abs (pos_y - pos_y1); + // Smallest zoom box must be 4 pixels square + if ((dx > 4) && (dy > 4)) + { + if (x0 < x1) + { + xl(0) = x0; + xl(1) = x1; + } + else + { + xl(0) = x1; + xl(1) = x0; + } + if (y0 < y1) + { + yl(0) = y0; + yl(1) = y1; + } + else + { + yl(0) = y1; + yl(1) = y0; + } + ap.zoom (xl, yl); + } + mark_modified (); + } + } + } + break; + } + } + + return retval; + } +}; + +class figure_manager +{ +public: + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + instance = new figure_manager (); + + if (! instance) + { + ::error ("unable to create figure_manager object!"); + + retval = false; + } + + return retval; + } + + ~figure_manager (void) + { + close_all (); + } + + static void close_all (void) + { + if (instance_ok ()) + instance->do_close_all (); + } + + static void new_window (figure::properties& fp) + { + if (instance_ok ()) + instance->do_new_window (fp); + } + + static void delete_window (int idx) + { + if (instance_ok ()) + instance->do_delete_window (idx); + } + + static void delete_window (const std::string& idx_str) + { + delete_window (str2idx (idx_str)); + } + + static void renumber_figure (const std::string& idx_str, double new_number) + { + if (instance_ok ()) + instance->do_renumber_figure (str2idx (idx_str), new_number); + } + + static void toggle_window_visibility (int idx, bool is_visible) + { + if (instance_ok ()) + instance->do_toggle_window_visibility (idx, is_visible); + } + + static void toggle_window_visibility (const std::string& idx_str, + bool is_visible) + { + toggle_window_visibility (str2idx (idx_str), is_visible); + } + + static void mark_modified (int idx) + { + if (instance_ok ()) + instance->do_mark_modified (idx); + } + + static void mark_modified (const graphics_handle& gh) + { + mark_modified (hnd2idx (gh)); + } + + static void set_name (int idx) + { + if (instance_ok ()) + instance->do_set_name (idx); + } + + static void set_name (const std::string& idx_str) + { + set_name (str2idx (idx_str)); + } + + static Matrix get_size (int idx) + { + return instance_ok () ? instance->do_get_size (idx) : Matrix (); + } + + static Matrix get_size (const graphics_handle& gh) + { + return get_size (hnd2idx (gh)); + } + + static void print (const graphics_handle& gh, const std::string& cmd, + const std::string& term) + { + if (instance_ok ()) + instance->do_print (hnd2idx (gh), cmd, term); + } + + static void uimenu_update (const graphics_handle& figh, + const graphics_handle& uimenuh, int id) + { + if (instance_ok ()) + instance->do_uimenu_update (hnd2idx (figh), uimenuh, id); + } + + static void update_canvas (const graphics_handle& gh, + const graphics_handle& ca) + { + if (instance_ok ()) + instance->do_update_canvas (hnd2idx (gh), ca); + } + + static void toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) + { + if (instance_ok ()) + instance->do_toggle_menubar_visibility (fig_idx, menubar_is_figure); + } + + static void toggle_menubar_visibility (const std::string& fig_idx_str, + bool menubar_is_figure) + { + toggle_menubar_visibility (str2idx (fig_idx_str), menubar_is_figure); + } + +private: + + static figure_manager *instance; + + figure_manager (void) { } + + // No copying! + figure_manager (const figure_manager&); + figure_manager& operator = (const figure_manager&); + + // Singelton -- hide all of the above. + + static int curr_index; + typedef std::map window_map; + typedef window_map::iterator wm_iterator;; + window_map windows; + + static std::string fltk_idx_header; + + void do_close_all (void) + { + wm_iterator win; + for (win = windows.begin (); win != windows.end (); win++) + delete win->second; + windows.clear (); + } + + void do_new_window (figure::properties& fp) + { + int idx = figprops2idx (fp); + + if (idx >= 0 && windows.find (idx) == windows.end ()) + { + Matrix pos = fp.get_boundingbox (true); + + int x = pos(0); + int y = pos(1); + int w = pos(2); + int h = pos(3); + + idx2figprops (curr_index, fp); + + windows[curr_index++] = new plot_window (x, y, w, h, fp); + } + } + + void do_delete_window (int idx) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + { + delete win->second; + windows.erase (win); + } + } + + void do_renumber_figure (int idx, double new_number) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->renumber (new_number); + } + + void do_toggle_window_visibility (int idx, bool is_visible) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + { + if (is_visible) + win->second->show (); + else + win->second->hide (); + + win->second->redraw (); + } + } + + void do_toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) + { + wm_iterator win = windows.find (fig_idx); + + if (win != windows.end ()) + { + if (menubar_is_figure) + win->second->show_menubar (); + else + win->second->hide_menubar (); + + win->second->redraw (); + } + } + + void do_mark_modified (int idx) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->mark_modified (); + } + + void do_set_name (int idx) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->set_name (); + } + + Matrix do_get_size (int idx) + { + Matrix sz (1, 2, 0.0); + + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + { + sz(0) = win->second->w (); + sz(1) = win->second->h (); + } + + return sz; + } + + void do_print (int idx, const std::string& cmd, const std::string& term) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->print (cmd, term); + } + + void do_uimenu_update (int idx, const graphics_handle& gh, int id) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->uimenu_update (gh, id); + } + + void do_update_canvas (int idx, const graphics_handle& ca) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + { + if (ca.ok ()) + win->second->show_canvas (); + else + win->second->hide_canvas (); + } + } + + static int str2idx (const caseless_str& clstr) + { + int ind; + if (clstr.find (fltk_idx_header,0) == 0) + { + std::istringstream istr (clstr.substr (fltk_idx_header.size ())); + if (istr >> ind) + return ind; + } + error ("figure_manager: could not recognize fltk index"); + return -1; + } + + void idx2figprops (int idx, figure::properties& fp) + { + std::ostringstream ind_str; + ind_str << fltk_idx_header << idx; + fp.set___plot_stream__ (ind_str.str ()); + } + + static int figprops2idx (const figure::properties& fp) + { + if (fp.get___graphics_toolkit__ () == FLTK_GRAPHICS_TOOLKIT_NAME) + { + octave_value ps = fp.get___plot_stream__ (); + if (ps.is_string ()) + return str2idx (ps.string_value ()); + else + return 0; + } + error ("figure_manager: figure is not fltk"); + return -1; + } + + static int hnd2idx (double h) + { + graphics_object fobj = gh_manager::get_object (h); + if (fobj && fobj.isa ("figure")) + { + figure::properties& fp = + dynamic_cast (fobj.get_properties ()); + return figprops2idx (fp); + } + error ("figure_manager: H (= %g) is not a figure", h); + return -1; + } + + static int hnd2idx (const graphics_handle& fh) + { + return hnd2idx (fh.value ()); + } +}; + +figure_manager *figure_manager::instance = 0; + +std::string figure_manager::fltk_idx_header="fltk index="; +int figure_manager::curr_index = 1; + +static bool toolkit_loaded = false; + +static int +__fltk_redraw__ (void) +{ + if (toolkit_loaded) + { + // We scan all figures and add those which use FLTK. + graphics_object obj = gh_manager::get_object (0); + if (obj && obj.isa ("root")) + { + base_properties& props = obj.get_properties (); + Matrix children = props.get_all_children (); + + for (octave_idx_type n = 0; n < children.numel (); n++) + { + graphics_object fobj = gh_manager::get_object (children (n)); + if (fobj && fobj.isa ("figure")) + { + figure::properties& fp = + dynamic_cast (fobj.get_properties ()); + if (fp.get___graphics_toolkit__ () + == FLTK_GRAPHICS_TOOLKIT_NAME) + figure_manager::new_window (fp); + } + } + } + + // it seems that we have to call Fl::check twice to get everything drawn + Fl::check (); + Fl::check (); + } + + return 0; +} + +class fltk_graphics_toolkit : public base_graphics_toolkit +{ +public: + fltk_graphics_toolkit (void) + : base_graphics_toolkit (FLTK_GRAPHICS_TOOLKIT_NAME) { } + + ~fltk_graphics_toolkit (void) { } + + bool is_valid (void) const { return true; } + + bool initialize (const graphics_object& go) + { return go.isa ("figure"); } + + void finalize (const graphics_object& go) + { + if (go.isa ("figure")) + { + octave_value ov = go.get (caseless_str ("__plot_stream__")); + + if (! ov.is_empty ()) + figure_manager::delete_window (ov.string_value ()); + } + } + + void uimenu_set_fltk_label (graphics_object uimenu_obj) + { + if (uimenu_obj.valid_object ()) + { + uimenu::properties& uimenup = + dynamic_cast (uimenu_obj.get_properties ()); + std::string fltk_label = uimenup.get_label (); + graphics_object go = gh_manager::get_object (uimenu_obj.get_parent ()); + if (go.isa ("uimenu")) + fltk_label = dynamic_cast (go.get_properties ()).get_fltk_label () + + "/" + + fltk_label; + else if (go.isa ("figure")) + ; + else + error ("unexpected parent object\n"); + + uimenup.set_fltk_label (fltk_label); + } + } + + void update (const graphics_object& go, int id) + { + if (go.isa ("figure")) + { + octave_value ov = go.get (caseless_str ("__plot_stream__")); + + if (! ov.is_empty ()) + { + const figure::properties& fp = + dynamic_cast (go.get_properties ()); + + switch (id) + { + case base_properties::ID_VISIBLE: + figure_manager::toggle_window_visibility + (ov.string_value (), fp.is_visible ()); + break; + + case figure::properties::ID_MENUBAR: + figure_manager::toggle_menubar_visibility + (ov.string_value (), fp.menubar_is ("figure")); + break; + + case figure::properties::ID_CURRENTAXES: + figure_manager::update_canvas + (go.get_handle (), fp.get_currentaxes ()); + break; + + case figure::properties::ID_NAME: + case figure::properties::ID_NUMBERTITLE: + figure_manager::set_name (ov.string_value ()); + break; + + case figure::properties::ID_INTEGERHANDLE: + { + std::string tmp = ov.string_value (); + graphics_handle gh = fp.get___myhandle__ (); + figure_manager::renumber_figure (tmp, gh.value ()); + figure_manager::set_name (tmp); + } + break; + } + } + } + else if (go.isa ("uimenu")) + { + if (id == uimenu::properties::ID_LABEL) + uimenu_set_fltk_label (go); + + graphics_object fig = go.get_ancestor ("figure"); + figure_manager::uimenu_update (fig.get_handle (), go.get_handle (), id); + } + } + + void redraw_figure (const graphics_object& go) const + { + figure_manager::mark_modified (go.get_handle ()); + + __fltk_redraw__ (); + } + + void print_figure (const graphics_object& go, + const std::string& term, + const std::string& file_cmd, bool /*mono*/, + const std::string& /*debug_file*/) const + { + figure_manager::print (go.get_handle (), file_cmd, term); + redraw_figure (go); + } + + Matrix get_canvas_size (const graphics_handle& fh) const + { + return figure_manager::get_size (fh); + } + + double get_screen_resolution (void) const + { + // FLTK doesn't give this info. + return 72.0; + } + + Matrix get_screen_size (void) const + { + Matrix sz (1, 2, 0.0); + sz(0) = Fl::w (); + sz(1) = Fl::h (); + return sz; + } + + void close (void) + { + if (toolkit_loaded) + { + munlock ("__init_fltk__"); + + figure_manager::close_all (); + gtk_manager::unload_toolkit (FLTK_GRAPHICS_TOOLKIT_NAME); + toolkit_loaded = false; + + octave_value_list args; + args(0) = "__fltk_redraw__"; + feval ("remove_input_event_hook", args, 0); + + // FIXME ??? + Fl::wait (fltk_maxtime); + } + } +}; + +// Initialize the fltk graphics toolkit. + +DEFUN_DLD (__init_fltk__, , , "") +{ + if (! toolkit_loaded) + { + mlock (); + + graphics_toolkit tk (new fltk_graphics_toolkit ()); + gtk_manager::load_toolkit (tk); + toolkit_loaded = true; + + octave_value_list args; + args(0) = "__fltk_redraw__"; + feval ("add_input_event_hook", args, 0); + } + + octave_value retval; + return retval; +} + +DEFUN_DLD (__fltk_redraw__, , , "") +{ + __fltk_redraw__ (); + + return octave_value (); +} + +DEFUN_DLD (__fltk_maxtime__, args, ,"") +{ + octave_value retval = fltk_maxtime; + + if (args.length () == 1) + { + if (args(0).is_real_scalar ()) + fltk_maxtime = args(0).double_value (); + else + error ("argument must be a real scalar"); + } + + return retval; +} + +#endif + +// FIXME -- This function should be abstracted and made potentially +// available to all graphics toolkits. This suggests putting it in +// graphics.cc as is done for drawnow() and having the master +// mouse_wheel_zoom function call fltk_mouse_wheel_zoom. The same +// should be done for gui_mode and fltk_gui_mode. For now (2011.01.30), +// just changing function names and docstrings. + +DEFUN_DLD (mouse_wheel_zoom, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{speed} =} mouse_wheel_zoom ()\n\ +@deftypefnx {Built-in Function} {} mouse_wheel_zoom (@var{speed})\n\ +Query or set the mouse wheel zoom factor.\n\ +\n\ +This function is currently implemented only for the FLTK graphics toolkit.\n\ +@seealso{gui_mode}\n\ +@end deftypefn") +{ +#if defined (HAVE_FLTK) + octave_value retval = wheel_zoom_speed; + + if (args.length () == 1) + { + if (args(0).is_real_scalar ()) + wheel_zoom_speed = args(0).double_value (); + else + error ("mouse_wheel_zoom: SPEED must be a real scalar"); + } + + return retval; +#else + error ("mouse_wheel_zoom: not available without OpenGL and FLTK libraries"); + return octave_value (); +#endif +} + +DEFUN_DLD (gui_mode, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{mode} =} gui_mode ()\n\ +@deftypefnx {Built-in Function} {} gui_mode (@var{mode})\n\ +Query or set the GUI mode for the current graphics toolkit.\n\ +The @var{mode} argument can be one of the following strings:\n\ +\n\ +@table @asis\n\ +@item '2d'\n\ +Allows panning and zooming of current axes.\n\ +\n\ +@item '3d'\n\ +Allows rotating and zooming of current axes.\n\ +\n\ +@item 'none'\n\ +Mouse inputs have no effect.\n\ +@end table\n\ +\n\ +This function is currently implemented only for the FLTK graphics toolkit.\n\ +@seealso{mouse_wheel_zoom}\n\ +@end deftypefn") +{ +#if defined (HAVE_FLTK) + caseless_str mode_str; + + if (gui_mode == pan_zoom) + mode_str = "2d"; + else if (gui_mode == rotate_zoom) + mode_str = "3d"; + else + mode_str = "none"; + + bool failed = false; + + if (args.length () == 1) + { + if (args(0).is_string ()) + { + mode_str = args(0).string_value (); + + if (mode_str.compare ("2d")) + gui_mode = pan_zoom; + else if (mode_str.compare ("3d")) + gui_mode = rotate_zoom; + else if (mode_str.compare ("none")) + gui_mode = none; + else + failed = true; + } + else + failed = true; + } + + if (failed) + error ("MODE must be one of the strings: \"2D\", \"3D\", or \"none\""); + + return octave_value (mode_str); +#else + error ("mouse_wheel_zoom: not available without OpenGL and FLTK libraries"); + return octave_value (); +#endif +} + diff -r d02b229ce693 -r a132d206a36a src/dldfcn/__init_gnuplot__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__init_gnuplot__.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,193 @@ +/* + +Copyright (C) 2007-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + +To initialize: + + graphics_toolkit ("gnuplot"); + plot (randn (1e3, 1)); + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "defun-dld.h" +#include "error.h" +#include "graphics.h" +#include "parse.h" +#include "variables.h" + +// PKG_ADD: register_graphics_toolkit ("gnuplot"); + +static bool toolkit_loaded = false; + +class gnuplot_graphics_toolkit : public base_graphics_toolkit +{ +public: + gnuplot_graphics_toolkit (void) + : base_graphics_toolkit ("gnuplot") { } + + ~gnuplot_graphics_toolkit (void) { } + + bool is_valid (void) const { return true; } + + bool initialize (const graphics_object& go) + { + return go.isa ("figure"); + } + + void finalize (const graphics_object& go) + { + if (go.isa ("figure")) + { + const figure::properties& props = + dynamic_cast (go.get_properties ()); + + send_quit (props.get___plot_stream__ ()); + } + } + + void update (const graphics_object& go, int id) + { + if (go.isa ("figure")) + { + graphics_object obj (go); + + figure::properties& props = + dynamic_cast (obj.get_properties ()); + + switch (id) + { + case base_properties::ID_VISIBLE: + if (! props.is_visible ()) + { + send_quit (props.get___plot_stream__ ()); + props.set___plot_stream__ (Matrix ()); + props.set___enhanced__ (false); + } + break; + } + } + } + + void redraw_figure (const graphics_object& go) const + { + octave_value_list args; + args(0) = go.get_handle ().as_octave_value (); + feval ("__gnuplot_drawnow__", args); + } + + void print_figure (const graphics_object& go, const std::string& term, + const std::string& file, bool mono, + const std::string& debug_file) const + { + octave_value_list args; + if (! debug_file.empty ()) + args(4) = debug_file; + args(3) = mono; + args(2) = file; + args(1) = term; + args(0) = go.get_handle ().as_octave_value (); + feval ("__gnuplot_drawnow__", args); + } + + Matrix get_canvas_size (const graphics_handle&) const + { + Matrix sz (1, 2, 0.0); + return sz; + } + + double get_screen_resolution (void) const + { return 72.0; } + + Matrix get_screen_size (void) const + { return Matrix (1, 2, 0.0); } + + void close (void) + { + if (toolkit_loaded) + { + munlock ("__init_gnuplot__"); + + gtk_manager::unload_toolkit ("gnuplot"); + + toolkit_loaded = false; + } + } + +private: + + void send_quit (const octave_value& pstream) const + { + if (! pstream.is_empty ()) + { + octave_value_list args; + Matrix fids = pstream.matrix_value (); + + if (! error_state) + { + args(1) = "\nquit;\n"; + args(0) = fids(0); + feval ("fputs", args); + + args.resize (1); + feval ("fflush", args); + feval ("pclose", args); + + if (fids.numel () > 1) + { + args(0) = fids(1); + feval ("pclose", args); + + if (fids.numel () > 2) + { + args(0) = fids(2); + feval ("waitpid", args); + } + } + } + } + } +}; + +// Initialize the fltk graphics toolkit. + +DEFUN_DLD (__init_gnuplot__, , , "") +{ + octave_value retval; + + if (! toolkit_loaded) + { + mlock (); + + graphics_toolkit tk (new gnuplot_graphics_toolkit ()); + gtk_manager::load_toolkit (tk); + + toolkit_loaded = true; + } + + return retval; +} + diff -r d02b229ce693 -r a132d206a36a src/dldfcn/__magick_read__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__magick_read__.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1216 @@ +/* + +Copyright (C) 2002-2012 Andy Adler +Copyright (C) 2008 Thomas L. Scofield +Copyright (C) 2010 David Grundberg + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "file-stat.h" +#include "oct-env.h" +#include "oct-time.h" + +#include "defun-dld.h" +#include "error.h" +#include "ov-struct.h" + +#ifdef HAVE_MAGICK + +#include +#include + +octave_value_list +read_indexed_images (std::vector& imvec, + const Array& frameidx, bool wantalpha) +{ + octave_value_list output; + + int rows = imvec[0].baseRows (); + int columns = imvec[0].baseColumns (); + int nframes = frameidx.length (); + + dim_vector idim = dim_vector (); + idim.resize (4); + idim(0) = rows; + idim(1) = columns; + idim(2) = 1; + idim(3) = nframes; + + Array idx (dim_vector (4, 1)); + + Magick::ImageType type = imvec[0].type (); + + unsigned int mapsize = imvec[0].colorMapSize (); + unsigned int i = mapsize; + unsigned int depth = 0; + while (i >>= 1) + depth++; + i = 0; + depth--; + while (depth >>= 1) + i++; + depth = 1 << i; + + switch (depth) + { + case 1: + case 2: + case 4: + case 8: + { + uint8NDArray im = uint8NDArray (idim); + + idx(2) = 0; + for (int frame = 0; frame < nframes; frame++) + { + imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + const Magick::IndexPacket *pix + = imvec[frameidx(frame)].getConstIndexes (); + + i = 0; + idx(3) = frame; + + for (int y = 0; y < rows; y++) + { + idx(0) = y; + for (int x = 0; x < columns; x++) + { + idx(1) = x; + im(idx) = static_cast (pix[i++]); + } + } + } + + output(0) = octave_value (im); + } + break; + + case 16: + { + uint16NDArray im = uint16NDArray (idim); + + idx(2) = 0; + for (int frame = 0; frame < nframes; frame++) + { + imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + const Magick::IndexPacket *pix + = imvec[frameidx(frame)].getConstIndexes (); + + i = 0; + idx(3) = frame; + + for (int y = 0; y < rows; y++) + { + idx(0) = y; + for (int x = 0; x < columns; x++) + { + idx(1) = x; + im(idx) = static_cast (pix[i++]); + } + } + } + + output(0) = octave_value (im); + } + break; + + default: + error ("__magic_read__: index depths greater than 16-bit are not supported"); + return octave_value_list (); + } + + Matrix map = Matrix (mapsize, 3); + Matrix alpha; + + switch (type) + { + case Magick::PaletteMatteType: +#if 0 + warning ("palettematte"); + Matrix map (mapsize, 3); + Matrix alpha (mapsize, 1); + for (i = 0; i < mapsize; i++) + { + warning ("%d", i); + Magick::ColorRGB c = imvec[0].colorMap (i); + map(i,0) = c.red (); + map(i,1) = c.green (); + map(i,2) = c.blue (); + alpha(i,1) = c.alpha (); + } + break; +#endif + + case Magick::PaletteType: + alpha = Matrix (0, 0); + for (i = 0; i < mapsize; i++) + { + Magick::ColorRGB c = imvec[0].colorMap (i); + map(i,0) = c.red (); + map(i,1) = c.green (); + map(i,2) = c.blue (); + } + break; + + default: + error ("__magick_read__: unsupported indexed image type"); + return octave_value_list (); + } + + if (wantalpha) + output(2) = alpha; + + output(1) = map; + + return output; +} + +template +octave_value_list +read_images (const std::vector& imvec, + const Array& frameidx, unsigned int depth) +{ + typedef typename T::element_type P; + + octave_value_list retval (3, Matrix ()); + + T im; + + int rows = imvec[0].baseRows (); + int columns = imvec[0].baseColumns (); + int nframes = frameidx.length (); + + dim_vector idim = dim_vector (); + idim.resize (4); + idim(0) = rows; + idim(1) = columns; + idim(2) = 1; + idim(3) = nframes; + + Magick::ImageType type = imvec[0].type (); + const int divisor = ((uint64_t (1) << QuantumDepth) - 1) / + ((uint64_t (1) << depth) - 1); + + switch (type) + { + case Magick::BilevelType: + case Magick::GrayscaleType: + { + im = T (idim); + P *vec = im.fortran_vec (); + + for (int frame = 0; frame < nframes; frame++) + { + const Magick::PixelPacket *pix + = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + P *rbuf = vec; + for (int y = 0; y < rows; y++) + { + for (int x = 0; x < columns; x++) + { + *rbuf = pix->red / divisor; + pix++; + rbuf += rows; + } + rbuf -= rows * columns - 1; + } + + // Next frame. + vec += rows * columns * idim(2); + } + } + break; + + case Magick::GrayscaleMatteType: + { + idim(2) = 2; + im = T (idim); + P *vec = im.fortran_vec (); + + for (int frame = 0; frame < nframes; frame++) + { + const Magick::PixelPacket *pix + = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + P *rbuf = vec; + P *obuf = vec + rows * columns; + for (int y = 0; y < rows; y++) + { + for (int x = 0; x < columns; x++) + { + *rbuf = pix->red / divisor; + *obuf = pix->opacity / divisor; + pix++; + rbuf += rows; + obuf += rows; + } + rbuf -= rows * columns - 1; + obuf -= rows * columns - 1; + } + + // Next frame. + vec += rows * columns * idim(2); + } + } + break; + + case Magick::PaletteType: + case Magick::TrueColorType: + { + idim(2) = 3; + im = T (idim); + P *vec = im.fortran_vec (); + + for (int frame = 0; frame < nframes; frame++) + { + const Magick::PixelPacket *pix + = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + P *rbuf = vec; + P *gbuf = vec + rows * columns; + P *bbuf = vec + rows * columns * 2; + for (int y = 0; y < rows; y++) + { + for (int x = 0; x < columns; x++) + { + *rbuf = pix->red / divisor; + *gbuf = pix->green / divisor; + *bbuf = pix->blue / divisor; + pix++; + rbuf += rows; + gbuf += rows; + bbuf += rows; + } + rbuf -= rows * columns - 1; + gbuf -= rows * columns - 1; + bbuf -= rows * columns - 1; + } + + // Next frame. + vec += rows * columns * idim(2); + } + } + break; + + case Magick::PaletteMatteType: + case Magick::TrueColorMatteType: + case Magick::ColorSeparationType: + { + idim(2) = 4; + im = T (idim); + P *vec = im.fortran_vec (); + + for (int frame = 0; frame < nframes; frame++) + { + const Magick::PixelPacket *pix + = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + P *rbuf = vec; + P *gbuf = vec + rows * columns; + P *bbuf = vec + rows * columns * 2; + P *obuf = vec + rows * columns * 3; + for (int y = 0; y < rows; y++) + { + for (int x = 0; x < columns; x++) + { + *rbuf = pix->red / divisor; + *gbuf = pix->green / divisor; + *bbuf = pix->blue / divisor; + *obuf = pix->opacity / divisor; + pix++; + rbuf += rows; + gbuf += rows; + bbuf += rows; + obuf += rows; + } + rbuf -= rows * columns - 1; + gbuf -= rows * columns - 1; + bbuf -= rows * columns - 1; + obuf -= rows * columns - 1; + } + + // Next frame. + vec += rows * columns * idim(2); + } + } + break; + + default: + error ("__magick_read__: undefined ImageMagick image type"); + return retval; + } + + retval(0) = im; + + return retval; +} + +#endif + +static void +maybe_initialize_magick (void) +{ +#ifdef HAVE_MAGICK + + static bool initialized = false; + + if (! initialized) + { + // Save the locale as GraphicsMagick might change this (depending on version) + const char *static_locale = setlocale (LC_ALL, NULL); + const std::string locale (static_locale); + + std::string program_name = octave_env::get_program_invocation_name (); + + Magick::InitializeMagick (program_name.c_str ()); + + // Restore locale from before GraphicsMagick initialisation + setlocale (LC_ALL, locale.c_str ()); + + if (QuantumDepth < 32) + warning ("your version of %s limits images to %d bits per pixel", + MagickPackageName, QuantumDepth); + + initialized = true; + } +#endif +} + +DEFUN_DLD (__magick_read__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Function File} {@var{m} =} __magick_read__ (@var{fname}, @var{index})\n\ +@deftypefnx {Function File} {[@var{m}, @var{colormap}] =} __magick_read__ (@var{fname}, @var{index})\n\ +@deftypefnx {Function File} {[@var{m}, @var{colormap}, @var{alpha}] =} __magick_read__ (@var{fname}, @var{index})\n\ +Read images with ImageMagick++. In general you should not be using this\n\ +function. Instead use @code{imread}.\n\ +@seealso{imread}\n\ +@end deftypefn") +{ + octave_value_list output; + +#ifdef HAVE_MAGICK + + maybe_initialize_magick (); + + if (args.length () > 3 || args.length () < 1 || ! args(0).is_string () + || nargout > 3) + { + print_usage (); + return output; + } + + Array frameidx; + bool all_frames = false; + + if (args.length () == 2 && args(1).is_real_type ()) + frameidx = args(1).int_vector_value (); + else if (args.length () == 3 && args(1).is_string () + && args(1).string_value () == "frames") + { + if (args(2).is_string () && args(2).string_value () == "all") + all_frames = true; + else if (args(2).is_real_type ()) + frameidx = args(2).int_vector_value (); + } + else + { + frameidx = Array (dim_vector (1, 1)); + frameidx(0) = 1; + } + + std::vector imvec; + + try + { + // Read a file into vector of image objects + Magick::readImages (&imvec, args(0).string_value ()); + } + catch (Magick::Warning& w) + { + warning ("Magick++ warning: %s", w.what ()); + } + catch (Magick::ErrorCoder& e) + { + warning ("Magick++ coder error: %s", e.what ()); + } + catch (Magick::Exception& e) + { + error ("Magick++ exception: %s", e.what ()); + return output; + } + + int nframes = imvec.size (); + if (all_frames) + { + frameidx = Array (dim_vector (1, nframes)); + for (int i = 0; i < frameidx.length (); i++) + frameidx(i) = i; + } + else + { + for (int i = 0; i < frameidx.length (); i++) + { + frameidx(i) = frameidx(i) - 1; + + if (frameidx(i) >= nframes || frameidx(i) < 0) + { + error ("__magick_read__: invalid INDEX vector"); + return output; + } + } + } + + Magick::ClassType klass = imvec[0].classType (); + + if (klass == Magick::PseudoClass && nargout > 1) + output = read_indexed_images (imvec, frameidx, (nargout == 3)); + else + { + unsigned int depth = imvec[0].modulusDepth (); + if (depth > 1) + { + --depth; + int i = 1; + while (depth >>= 1) + i++; + depth = 1 << i; + } + + switch (depth) + { + case 1: + output = read_images (imvec, frameidx, depth); + break; + + case 2: + case 4: + case 8: + output = read_images (imvec, frameidx, depth) ; + break; + + case 16: + output = read_images (imvec, frameidx, depth); + break; + + case 32: + case 64: + default: + error ("__magick_read__: image depths greater than 16-bit are not supported"); + } + } +#else + + error ("imread: image reading capabilities were disabled when Octave was compiled"); + +#endif + + return output; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ + +#ifdef HAVE_MAGICK + +static void +jpg_settings (std::vector& imvec, + const Octave_map& options, + bool) +{ + bool something_set = false; + + // Quality setting + octave_value result; + Octave_map::const_iterator p; + bool found_it = false; + + for (p = options.begin (); p != options.end (); p++) + { + if (options.key (p) == "Quality") + { + found_it = true; + result = options.contents (p).elem (0); + break; + } + } + + if (found_it && (! result.is_empty ())) + { + something_set = true; + + if (result.is_real_type ()) + { + int qlev = result.int_value (); + + if (qlev < 0 || qlev > 100) + warning ("warning: Quality setting invalid--use default of 75"); + else + { + for (size_t fnum = 0; fnum < imvec.size (); fnum++) + imvec[fnum].quality (static_cast(qlev)); + } + } + else + warning ("warning: Quality setting invalid--use default of 75"); + } + + // Other settings go here + + if (! something_set) + warning ("__magick_write__ warning: all write parameters ignored"); +} + +static void +encode_bool_image (std::vector& imvec, const octave_value& img) +{ + unsigned int nframes = 1; + boolNDArray m = img.bool_array_value (); + + dim_vector dsizes = m.dims (); + if (dsizes.length () == 4) + nframes = dsizes(3); + + Array idx (dim_vector (dsizes.length (), 1)); + + octave_idx_type rows = m.rows (); + octave_idx_type columns = m.columns (); + + for (unsigned int ii = 0; ii < nframes; ii++) + { + Magick::Image im (Magick::Geometry (columns, rows), "black"); + im.classType (Magick::DirectClass); + im.depth (1); + + for (int y = 0; y < columns; y++) + { + idx(1) = y; + + for (int x = 0; x < rows; x++) + { + if (nframes > 1) + { + idx(2) = 0; + idx(3) = ii; + } + + idx(0) = x; + + if (m(idx)) + im.pixelColor (y, x, "white"); + } + } + + im.quantizeColorSpace (Magick::GRAYColorspace); + im.quantizeColors (2); + im.quantize (); + + imvec.push_back (im); + } +} + +template +static void +encode_uint_image (std::vector& imvec, + const octave_value& img, + bool has_map) +{ + unsigned int bitdepth = 0; + T m; + + if (img.is_uint8_type ()) + { + bitdepth = 8; + m = img.uint8_array_value (); + } + else if (img.is_uint16_type ()) + { + bitdepth = 16; + m = img.uint16_array_value (); + } + else + error ("__magick_write__: invalid image class"); + + dim_vector dsizes = m.dims (); + unsigned int nframes = 1; + if (dsizes.length () == 4) + nframes = dsizes(3); + + bool is_color = ((dsizes.length () > 2) && (dsizes(2) > 2)); + bool has_alpha = (dsizes.length () > 2 && (dsizes(2) == 2 || dsizes(2) == 4)); + + Array idx (dim_vector (dsizes.length (), 1)); + octave_idx_type rows = m.rows (); + octave_idx_type columns = m.columns (); + + unsigned int div_factor = (1 << bitdepth) - 1; + + for (unsigned int ii = 0; ii < nframes; ii++) + { + Magick::Image im (Magick::Geometry (columns, rows), "black"); + + im.depth (bitdepth); + + if (has_map) + im.classType (Magick::PseudoClass); + else + im.classType (Magick::DirectClass); + + if (is_color) + { + if (has_alpha) + im.type (Magick::TrueColorMatteType); + else + im.type (Magick::TrueColorType); + + Magick::ColorRGB c; + + for (int y = 0; y < columns; y++) + { + idx(1) = y; + + for (int x = 0; x < rows; x++) + { + idx(0) = x; + + if (nframes > 1) + idx(3) = ii; + + idx(2) = 0; + c.red (static_cast(m(idx)) / div_factor); + + idx(2) = 1; + c.green (static_cast(m(idx)) / div_factor); + + idx(2) = 2; + c.blue (static_cast(m(idx)) / div_factor); + + if (has_alpha) + { + idx(2) = 3; + c.alpha (static_cast(m(idx)) / div_factor); + } + + im.pixelColor (y, x, c); + } + } + } + else + { + if (has_alpha) + im.type (Magick::GrayscaleMatteType); + else + im.type (Magick::GrayscaleType); + + Magick::ColorGray c; + + for (int y = 0; y < columns; y++) + { + idx(1) = y; + + for (int x=0; x < rows; x++) + { + idx(0) = x; + + if (nframes > 1) + { + idx(2) = 0; + idx(3) = ii; + } + + if (has_alpha) + { + idx(2) = 1; + c.alpha (static_cast(m(idx)) / div_factor); + idx(2) = 0; + } + + c.shade (static_cast(m(idx)) / div_factor); + + im.pixelColor (y, x, c); + } + } + + im.quantizeColorSpace (Magick::GRAYColorspace); + im.quantizeColors (1 << bitdepth); + im.quantize (); + } + + imvec.push_back (im); + } +} + +static void +encode_map (std::vector& imvec, const NDArray& cmap) +{ + unsigned int mapsize = cmap.dim1 (); + + for (size_t fnum = 0; fnum < imvec.size (); fnum++) + { + imvec[fnum].colorMapSize (mapsize); + imvec[fnum].type (Magick::PaletteType); + } + + for (unsigned int ii = 0; ii < mapsize; ii++) + { + Magick::ColorRGB c (cmap(ii,0), cmap(ii,1), cmap(ii,2)); + + // FIXME -- is this case needed? + if (cmap.dim2 () == 4) + c.alpha (cmap(ii,3)); + + try + { + for_each (imvec.begin (), imvec.end (), + Magick::colorMapImage (ii, c)); + } + catch (Magick::Warning& w) + { + warning ("Magick++ warning: %s", w.what ()); + } + catch (Magick::ErrorCoder& e) + { + warning ("Magick++ coder error: %s", e.what ()); + } + catch (Magick::Exception& e) + { + error ("Magick++ exception: %s", e.what ()); + } + } +} + +static void +write_image (const std::string& filename, const std::string& fmt, + const octave_value& img, + const octave_value& map = octave_value (), + const octave_value& params = octave_value ()) +{ + std::vector imvec; + + bool has_map = map.is_defined (); + + if (has_map) + { + error ("__magick_write__: direct saving of indexed images not currently supported; use ind2rgb and save converted image"); + return; + } + + if (img.is_bool_type ()) + encode_bool_image (imvec, img); + else if (img.is_uint8_type ()) + encode_uint_image (imvec, img, has_map); + else if (img.is_uint16_type ()) + encode_uint_image (imvec, img, has_map); + else + error ("__magick_write__: image type not supported"); + + if (! error_state && has_map) + { + NDArray cmap = map.array_value (); + + if (! error_state) + encode_map (imvec, cmap); + } + + if (! error_state && params.is_defined ()) + { + Octave_map options = params.map_value (); + + // Insert calls here to handle parameters for various image formats + if (fmt == "jpg" || fmt == "jpeg") + jpg_settings (imvec, options, has_map); + else + warning ("warning: your parameter(s) currently not supported"); + } + + try + { + Magick::writeImages (imvec.begin (), imvec.end (), fmt + ":" + filename); + } + catch (Magick::Warning& w) + { + warning ("Magick++ warning: %s", w.what ()); + } + catch (Magick::ErrorCoder& e) + { + warning ("Magick++ coder error: %s", e.what ()); + } + catch (Magick::Exception& e) + { + error ("Magick++ exception: %s", e.what ()); + } +} + +#endif + +DEFUN_DLD (__magick_write__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} {} __magick_write__ (@var{fname}, @var{fmt}, @var{img})\n\ +@deftypefnx {Function File} {} __magick_write__ (@var{fname}, @var{fmt}, @var{img}, @var{map})\n\ +Write images with ImageMagick++. In general you should not be using this\n\ +function. Instead use @code{imwrite}.\n\ +@seealso{imread}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_MAGICK + maybe_initialize_magick (); + + int nargin = args.length (); + + if (nargin > 2) + { + std::string filename = args(0).string_value (); + + if (! error_state) + { + std::string fmt = args(1).string_value (); + + if (! error_state) + { + if (nargin > 4) + write_image (filename, fmt, args(2), args(3), args(4)); + else if (nargin > 3) + if (args(3).is_real_type ()) + write_image (filename, fmt, args(2), args(3)); + else + write_image (filename, fmt, args(2), octave_value (), args(3)); + else + write_image (filename, fmt, args(2)); + } + else + error ("__magick_write__: FMT must be string"); + } + else + error ("__magick_write__: FNAME must be a string"); + } + else + print_usage (); +#else + + error ("__magick_write__: not available in this version of Octave"); + +#endif + +return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ + +#ifdef HAVE_MAGICK + +template +static octave_value +magick_to_octave_value (const T magick) +{ + return octave_value (magick); +} + +static octave_value +magick_to_octave_value (const Magick::EndianType magick) +{ + switch (magick) + { + case Magick::LSBEndian: + return octave_value ("little-endian"); + + case Magick::MSBEndian: + return octave_value ("big-endian"); + + default: + return octave_value ("undefined"); + } +} + +static octave_value +magick_to_octave_value (const Magick::ResolutionType magick) +{ + switch (magick) + { + case Magick::PixelsPerInchResolution: + return octave_value ("pixels per inch"); + + case Magick::PixelsPerCentimeterResolution: + return octave_value ("pixels per centimeter"); + + default: + return octave_value ("undefined"); + } +} + +static octave_value +magick_to_octave_value (const Magick::ImageType magick) +{ + switch (magick) + { + case Magick::BilevelType: + case Magick::GrayscaleType: + case Magick::GrayscaleMatteType: + return octave_value ("grayscale"); + + case Magick::PaletteType: + case Magick::PaletteMatteType: + return octave_value ("indexed"); + + case Magick::TrueColorType: + case Magick::TrueColorMatteType: + case Magick::ColorSeparationType: + return octave_value ("truecolor"); + + default: + return octave_value ("undefined"); + } +} + +// We put this in a try-block because GraphicsMagick will throw +// exceptions if a parameter isn't present in the current image. +#define GET_PARAM(NAME, OUTNAME) \ + try \ + { \ + info.contents (OUTNAME)(frame,0) = magick_to_octave_value (im.NAME ()); \ + } \ + catch (Magick::Warning& w) \ + { \ + } + +#endif + +DEFUN_DLD (__magick_finfo__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __magick_finfo__ (@var{fname})\n\ +Read image information with GraphicsMagick++. In general you should\n\ +not be using this function. Instead use @code{imfinfo}.\n\ +@seealso{imfinfo, imread}\n\ +@end deftypefn") +{ + octave_value retval; + +#ifdef HAVE_MAGICK + + maybe_initialize_magick (); + + if (args.length () < 1 || ! args (0).is_string ()) + { + print_usage (); + return retval; + } + + const std::string filename = args (0).string_value (); + + try + { + // Read the file. + std::vector imvec; + Magick::readImages (&imvec, args(0).string_value ()); + int nframes = imvec.size (); + + // Create the right size for the output. + + static const char *fields[] = + { + "Filename", + "FileModDate", + "FileSize", + "Height", + "Width", + "BitDepth", + "Format", + "LongFormat", + "XResolution", + "YResolution", + "TotalColors", + "TileName", + "AnimationDelay", + "AnimationIterations", + "ByteOrder", + "Gamma", + "Matte", + "ModulusDepth", + "Quality", + "QuantizeColors", + "ResolutionUnits", + "ColorType", + "View", + 0 + }; + + Octave_map info (string_vector (fields), dim_vector (nframes, 1)); + + file_stat fs (filename); + + std::string filetime; + + if (fs) + { + octave_localtime mtime = fs.mtime (); + + filetime = mtime.strftime ("%e-%b-%Y %H:%M:%S"); + } + else + { + std::string msg = fs.error (); + + error ("imfinfo: error reading `%s': %s", + filename.c_str (), msg.c_str ()); + + return retval; + } + + // For each frame in the image (some images contain multiple + // layers, each to be treated like a separate image). + for (int frame = 0; frame < nframes; frame++) + { + Magick::Image im = imvec[frame]; + + // Add file name and timestamp. + info.contents ("Filename")(frame,0) = filename; + info.contents ("FileModDate")(frame,0) = filetime; + + // Annoying CamelCase naming is for Matlab compatibility. + GET_PARAM (fileSize, "FileSize") + GET_PARAM (rows, "Height") + GET_PARAM (columns, "Width") + GET_PARAM (depth, "BitDepth") + GET_PARAM (magick, "Format") + GET_PARAM (format, "LongFormat") + GET_PARAM (xResolution, "XResolution") + GET_PARAM (yResolution, "YResolution") + GET_PARAM (totalColors, "TotalColors") + GET_PARAM (tileName, "TileName") + GET_PARAM (animationDelay, "AnimationDelay") + GET_PARAM (animationIterations, "AnimationIterations") + GET_PARAM (endian, "ByteOrder") + GET_PARAM (gamma, "Gamma") + GET_PARAM (matte, "Matte") + GET_PARAM (modulusDepth, "ModulusDepth") + GET_PARAM (quality, "Quality") + GET_PARAM (quantizeColors, "QuantizeColors") + GET_PARAM (resolutionUnits, "ResolutionUnits") + GET_PARAM (type, "ColorType") + GET_PARAM (view, "View") + } + + retval = octave_value (info); + } + catch (Magick::Warning& w) + { + warning ("Magick++ warning: %s", w.what ()); + } + catch (Magick::ErrorCoder& e) + { + warning ("Magick++ coder error: %s", e.what ()); + } + catch (Magick::Exception& e) + { + error ("Magick++ exception: %s", e.what ()); + return retval; + } + +#else + + error ("imfinfo: not available in this version of Octave"); + +#endif + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ + +#undef GET_PARAM + +// Determine the file formats supported by GraphicsMagick. This is +// called once at the beginning of imread or imwrite to determine +// exactly which file formats are supported, so error messages can be +// displayed properly. + +DEFUN_DLD (__magick_format_list__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} {} __magick_format_list__ (@var{formats})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + +#ifdef HAVE_MAGICK + maybe_initialize_magick (); + + std::list accepted_formats; + + if (args.length () == 1) + { + Cell c = args (0).cell_value (); + + if (! error_state) + { + for (octave_idx_type i = 0; i < c.nelem (); i++) + { + try + { + std::string fmt = c.elem (i).string_value (); + + Magick::CoderInfo info(fmt); + + if (info.isReadable () && info.isWritable ()) + accepted_formats.push_back (fmt); + } + catch (Magick::Exception& e) + { + // Do nothing: exception here are simply missing formats. + } + } + } + else + error ("__magick_format_list__: expecting a cell array of image format names"); + } + else + print_usage (); + + retval = Cell (accepted_formats); + +#else + + error ("__magick_format_list__: not available in this version of Octave"); + +#endif + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ diff -r d02b229ce693 -r a132d206a36a src/dldfcn/__voronoi__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__voronoi__.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,334 @@ +/* + +Copyright (C) 2000-2012 Kai Habel + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* +20. Augiust 2000 - Kai Habel: first release +*/ + +/* +2003-12-14 Rafael Laboissiere +Added optional second argument to pass options to the underlying +qhull command +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "lo-ieee.h" + +#include "Cell.h" +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" +#include "unwind-prot.h" + +#if defined (HAVE_QHULL) +# include "oct-qhull.h" +# if defined (NEED_QHULL_VERSION) +char qh_version[] = "__voronoi__.oct 2007-07-24"; +# endif +#endif + +static void +close_fcn (FILE *f) +{ + gnulib::fclose (f); +} + +DEFUN_DLD (__voronoi__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{caller}, @var{pts})\n\ +@deftypefnx {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{caller}, @var{pts}, @var{options})\n\ +@deftypefnx {Loadable Function} {@var{C}, @var{F}, @var{Inf_Pts} =} __voronoi__ (@dots{})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + std::string caller = args(0).string_value (); + +#if defined (HAVE_QHULL) + + retval(0) = 0.0; + + int nargin = args.length (); + if (nargin < 2 || nargin > 3) + { + print_usage (); + return retval; + } + + Matrix points = args(1).matrix_value (); + const octave_idx_type dim = points.columns (); + const octave_idx_type num_points = points.rows (); + + points = points.transpose (); + + std::string options; + + if (dim <= 4) + options = " Qbb"; + else + options = " Qbb Qx"; + + if (nargin == 3) + { + octave_value opt_arg = args(2); + + if (opt_arg.is_string ()) + options = " " + opt_arg.string_value (); + else if (opt_arg.is_empty ()) + ; // Use default options. + else if (opt_arg.is_cellstr ()) + { + options = ""; + + Array tmp = opt_arg.cellstr_value (); + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += " " + tmp(i); + } + else + { + error ("%s: OPTIONS must be a string, cell array of strings, or empty", + caller.c_str ()); + return retval; + } + } + + boolT ismalloc = false; + + unwind_protect frame; + + // Replace the outfile pointer with stdout for debugging information. +#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) + FILE *outfile = gnulib::fopen ("NUL", "w"); +#else + FILE *outfile = gnulib::fopen ("/dev/null", "w"); +#endif + FILE *errfile = stderr; + + if (outfile) + frame.add_fcn (close_fcn, outfile); + else + { + error ("__voronoi__: unable to create temporary file for output"); + return retval; + } + + // qh_new_qhull command and points arguments are not const... + + std::string cmd = "qhull v" + options; + + OCTAVE_LOCAL_BUFFER (char, cmd_str, cmd.length () + 1); + + strcpy (cmd_str, cmd.c_str ()); + + int exitcode = qh_new_qhull (dim, num_points, points.fortran_vec (), + ismalloc, cmd_str, outfile, errfile); + if (! exitcode) + { + // Calling findgood_all provides the number of Voronoi vertices + // (sets qh num_good). + + qh_findgood_all (qh facet_list); + + octave_idx_type num_voronoi_regions + = qh num_vertices - qh_setsize (qh del_vertices); + + octave_idx_type num_voronoi_vertices = qh num_good; + + // Find the voronoi centers for all facets. + + qh_setvoronoi_all (); + + facetT *facet; + vertexT *vertex; + octave_idx_type k; + + // Find the number of Voronoi vertices for each Voronoi cell and + // store them in NI so we can use them later to set the dimensions + // of the RowVector objects used to collect them. + + FORALLfacets + { + facet->seen = false; + } + + OCTAVE_LOCAL_BUFFER (octave_idx_type, ni, num_voronoi_regions); + for (octave_idx_type i = 0; i < num_voronoi_regions; i++) + ni[i] = 0; + + k = 0; + + FORALLvertices + { + if (qh hull_dim == 3) + qh_order_vertexneighbors (vertex); + + bool infinity_seen = false; + + facetT *neighbor, **neighborp; + + FOREACHneighbor_ (vertex) + { + if (neighbor->upperdelaunay) + { + if (! infinity_seen) + { + infinity_seen = true; + ni[k]++; + } + } + else + { + neighbor->seen = true; + ni[k]++; + } + } + + k++; + } + + // If Qhull finds fewer regions than points, we will pad the end + // of the at_inf and C arrays so that they always contain at least + // as many elements as the given points array. + + // FIXME -- is it possible (or does it make sense) for + // num_voronoi_regions to ever be larger than num_points? + + octave_idx_type nr = (num_points > num_voronoi_regions + ? num_points : num_voronoi_regions); + + boolMatrix at_inf (nr, 1, false); + + // The list of Voronoi vertices. The first element is always + // Inf. + Matrix F (num_voronoi_vertices+1, dim); + + for (octave_idx_type d = 0; d < dim; d++) + F(0,d) = octave_Inf; + + // The cell array of vectors of indices into F that represent the + // vertices of the Voronoi regions (cells). + + Cell C (nr, 1); + + // Now loop through the list of vertices again and store the + // coordinates of the Voronoi vertices and the lists of indices + // for the cells. + + FORALLfacets + { + facet->seen = false; + } + + octave_idx_type i = 0; + k = 0; + + FORALLvertices + { + if (qh hull_dim == 3) + qh_order_vertexneighbors (vertex); + + bool infinity_seen = false; + + octave_idx_type idx = qh_pointid (vertex->point); + + octave_idx_type num_vertices = ni[k++]; + + // Qhull seems to sometimes produces regions with a single + // vertex. Is that a bug? How can a region have just one + // vertex? Let's skip it. + + if (num_vertices == 1) + continue; + + RowVector facet_list (num_vertices); + + octave_idx_type m = 0; + + facetT *neighbor, **neighborp; + + FOREACHneighbor_(vertex) + { + if (neighbor->upperdelaunay) + { + if (! infinity_seen) + { + infinity_seen = true; + facet_list(m++) = 1; + at_inf(idx) = true; + } + } + else + { + if (! neighbor->seen) + { + i++; + for (octave_idx_type d = 0; d < dim; d++) + F(i,d) = neighbor->center[d]; + + neighbor->seen = true; + neighbor->visitid = i; + } + + facet_list(m++) = neighbor->visitid + 1; + } + } + + C(idx) = facet_list; + } + + retval(2) = at_inf; + retval(1) = C; + retval(0) = F; + } + else + error ("%s: qhull failed", caller.c_str ()); + + // Free memory from Qhull + qh_freeqhull (! qh_ALL); + + int curlong, totlong; + qh_memfreeshort (&curlong, &totlong); + + if (curlong || totlong) + warning ("%s: qhull did not free %d bytes of long memory (%d pieces)", + caller.c_str (), totlong, curlong); + +#else + error ("%s: not available in this version of Octave", caller.c_str ()); +#endif + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ diff -r d02b229ce693 -r a132d206a36a src/dldfcn/amd.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/amd.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,206 @@ +/* + +Copyright (C) 2008-2012 David Bateman + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// This is the octave interface to amd, which bore the copyright given +// in the help of the functions. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "ov.h" +#include "defun-dld.h" +#include "pager.h" +#include "ov-re-mat.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "oct-map.h" + +#include "oct-sparse.h" +#include "oct-locbuf.h" + +#ifdef IDX_TYPE_LONG +#define AMD_NAME(name) amd_l ## name +#else +#define AMD_NAME(name) amd ## name +#endif + +DEFUN_DLD (amd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} amd (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} amd (@var{S}, @var{opts})\n\ +\n\ +Return the approximate minimum degree permutation of a matrix. This\n\ +permutation such that the Cholesky@tie{}factorization of @code{@var{S}\n\ +(@var{p}, @var{p})} tends to be sparser than the Cholesky@tie{}factorization\n\ +of @var{S} itself. @code{amd} is typically faster than @code{symamd} but\n\ +serves a similar purpose.\n\ +\n\ +The optional parameter @var{opts} is a structure that controls the\n\ +behavior of @code{amd}. The fields of the structure are\n\ +\n\ +@table @asis\n\ +@item @var{opts}.dense\n\ +Determines what @code{amd} considers to be a dense row or column of the\n\ +input matrix. Rows or columns with more than @code{max(16, (dense *\n\ +sqrt (@var{n})} entries, where @var{n} is the order of the matrix @var{S},\n\ +are ignored by @code{amd} during the calculation of the permutation\n\ +The value of dense must be a positive scalar and its default value is 10.0\n\ +\n\ +@item @var{opts}.aggressive\n\ +If this value is a non zero scalar, then @code{amd} performs aggressive\n\ +absorption. The default is not to perform aggressive absorption.\n\ +@end table\n\ +\n\ +The author of the code itself is Timothy A. Davis\n\ +@email{davis@@cise.ufl.edu}, University of Florida (see\n\ +@url{http://www.cise.ufl.edu/research/sparse/amd}).\n\ +@seealso{symamd, colamd}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_AMD + int nargin = args.length (); + + if (nargin < 1 || nargin > 2) + print_usage (); + else + { + octave_idx_type n_row, n_col; + const octave_idx_type *ridx, *cidx; + SparseMatrix sm; + SparseComplexMatrix scm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0).sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + } + else + { + if (args(0).is_complex_type ()) + sm = SparseMatrix (real (args(0).complex_matrix_value ())); + else + sm = SparseMatrix (args(0).matrix_value ()); + + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + if (!error_state && n_row != n_col) + error ("amd: matrix S must be square"); + + if (!error_state) + { + OCTAVE_LOCAL_BUFFER (double, Control, AMD_CONTROL); + AMD_NAME (_defaults) (Control) ; + if (nargin > 1) + { + octave_scalar_map arg1 = args(1).scalar_map_value (); + + if (!error_state) + { + octave_value tmp; + + tmp = arg1.getfield ("dense"); + if (tmp.is_defined ()) + Control[AMD_DENSE] = tmp.double_value (); + + tmp = arg1.getfield ("aggressive"); + if (tmp.is_defined ()) + Control[AMD_AGGRESSIVE] = tmp.double_value (); + } + else + error ("amd: OPTS argument must be a scalar structure"); + } + + if (!error_state) + { + OCTAVE_LOCAL_BUFFER (octave_idx_type, P, n_col); + Matrix xinfo (AMD_INFO, 1); + double *Info = xinfo.fortran_vec (); + + // FIXME -- how can we manage the memory allocation of + // amd in a cleaner manner? + amd_malloc = malloc; + amd_free = free; + amd_calloc = calloc; + amd_realloc = realloc; + amd_printf = printf; + + octave_idx_type result = AMD_NAME (_order) (n_col, cidx, ridx, P, + Control, Info); + + switch (result) + { + case AMD_OUT_OF_MEMORY: + error ("amd: out of memory"); + break; + case AMD_INVALID: + error ("amd: matrix S is corrupted"); + break; + default: + { + if (nargout > 1) + retval(1) = xinfo; + + Matrix Pout (1, n_col); + for (octave_idx_type i = 0; i < n_col; i++) + Pout.xelem (i) = P[i] + 1; + + retval(0) = Pout; + } + } + } + } + } +#else + + error ("amd: not available in this version of Octave"); + +#endif + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/dldfcn/ccolamd.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/ccolamd.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,583 @@ +/* + +Copyright (C) 2005-2012 David Bateman + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// This is the octave interface to ccolamd, which bore the copyright given +// in the help of the functions. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "ov.h" +#include "defun-dld.h" +#include "pager.h" +#include "ov-re-mat.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +#include "oct-sparse.h" +#include "oct-locbuf.h" + +#ifdef IDX_TYPE_LONG +#define CCOLAMD_NAME(name) ccolamd_l ## name +#define CSYMAMD_NAME(name) csymamd_l ## name +#else +#define CCOLAMD_NAME(name) ccolamd ## name +#define CSYMAMD_NAME(name) csymamd ## name +#endif + +DEFUN_DLD (ccolamd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} ccolamd (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} ccolamd (@var{S}, @var{knobs})\n\ +@deftypefnx {Loadable Function} {@var{p} =} ccolamd (@var{S}, @var{knobs}, @var{cmember})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} ccolamd (@dots{})\n\ +\n\ +Constrained column approximate minimum degree permutation.\n\ +@code{@var{p} = ccolamd (@var{S})} returns the column approximate minimum\n\ +degree permutation vector for the sparse matrix @var{S}. For a non-symmetric\n\ +matrix\n\ +@var{S},\n\ +@code{@var{S}(:, @var{p})} tends to have sparser LU@tie{}factors than\n\ +@var{S}. @code{chol (@var{S}(:, @var{p})' * @var{S}(:, @var{p}))} also\n\ +tends to be sparser than @code{chol (@var{S}' * @var{S})}. @code{@var{p} =\n\ +ccolamd (@var{S}, 1)} optimizes the ordering for @code{lu (@var{S}(:,\n\ +@var{p}))}. The ordering is followed by a column elimination tree\n\ +post-ordering.\n\ +\n\ +@var{knobs} is an optional 1-element to 5-element input vector, with a\n\ +default value of @code{[0 10 10 1 0]} if not present or empty. Entries not\n\ +present are set to their defaults.\n\ +\n\ +@table @code\n\ +@item @var{knobs}(1)\n\ +if nonzero, the ordering is optimized for @code{lu (S(:, p))}. It will be a\n\ +poor ordering for @code{chol (@var{S}(:, @var{p})' * @var{S}(:,\n\ +@var{p}))}. This is the most important knob for ccolamd.\n\ +\n\ +@item @var{knobs}(2)\n\ +if @var{S} is m-by-n, rows with more than @code{max (16, @var{knobs}(2) *\n\ +sqrt (n))} entries are ignored.\n\ +\n\ +@item @var{knobs}(3)\n\ +columns with more than @code{max (16, @var{knobs}(3) * sqrt (min (@var{m},\n\ +@var{n})))} entries are ignored and ordered last in the output permutation\n\ +(subject to the cmember constraints).\n\ +\n\ +@item @var{knobs}(4)\n\ +if nonzero, aggressive absorption is performed.\n\ +\n\ +@item @var{knobs}(5)\n\ +if nonzero, statistics and knobs are printed.\n\ +\n\ +@end table\n\ +\n\ +@var{cmember} is an optional vector of length @math{n}. It defines the\n\ +constraints on the column ordering. If @code{@var{cmember}(j) = @var{c}},\n\ +then column @var{j} is in constraint set @var{c} (@var{c} must be in the\n\ +range 1 to\n\ +n). In the output permutation @var{p}, all columns in set 1 appear\n\ +first, followed by all columns in set 2, and so on. @code{@var{cmember} =\n\ +ones (1,n)} if not present or empty.\n\ +@code{ccolamd (@var{S}, [], 1 : n)} returns @code{1 : n}\n\ +\n\ +@code{@var{p} = ccolamd (@var{S})} is about the same as\n\ +@code{@var{p} = colamd (@var{S})}. @var{knobs} and its default values\n\ +differ. @code{colamd} always does aggressive absorption, and it finds an\n\ +ordering suitable for both @code{lu (@var{S}(:, @var{p}))} and @code{chol\n\ +(@var{S}(:, @var{p})' * @var{S}(:, @var{p}))}; it cannot optimize its\n\ +ordering for @code{lu (@var{S}(:, @var{p}))} to the extent that\n\ +@code{ccolamd (@var{S}, 1)} can.\n\ +\n\ +@var{stats} is an optional 20-element output vector that provides data\n\ +about the ordering and the validity of the input matrix @var{S}. Ordering\n\ +statistics are in @code{@var{stats}(1 : 3)}. @code{@var{stats}(1)} and\n\ +@code{@var{stats}(2)} are the number of dense or empty rows and columns\n\ +ignored by @sc{ccolamd} and @code{@var{stats}(3)} is the number of garbage\n\ +collections performed on the internal data structure used by @sc{ccolamd}\n\ +(roughly of size @code{2.2 * nnz (@var{S}) + 4 * @var{m} + 7 * @var{n}}\n\ +integers).\n\ +\n\ +@code{@var{stats}(4 : 7)} provide information if CCOLAMD was able to\n\ +continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ +invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ +unsorted or contains duplicate entries, or zero if no such column exists.\n\ +@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ +index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ +such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ +or out-of-order row indices. @code{@var{stats}(8 : 20)} is always zero in\n\ +the current version of @sc{ccolamd} (reserved for future use).\n\ +\n\ +The authors of the code itself are S. Larimore, T. Davis (Univ. of Florida)\n\ +and S. Rajamanickam in collaboration with J. Bilbert and E. Ng. Supported\n\ +by the National Science Foundation (DMS-9504974, DMS-9803599, CCR-0203270),\n\ +and a grant from Sandia National Lab. See\n\ +@url{http://www.cise.ufl.edu/research/sparse} for ccolamd, csymamd, amd,\n\ +colamd, symamd, and other related orderings.\n\ +@seealso{colamd, csymamd}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_CCOLAMD + + int nargin = args.length (); + int spumoni = 0; + + if (nargout > 2 || nargin < 1 || nargin > 3) + usage ("ccolamd: incorrect number of input and/or output arguments"); + else + { + // Get knobs + OCTAVE_LOCAL_BUFFER (double, knobs, CCOLAMD_KNOBS); + CCOLAMD_NAME (_set_defaults) (knobs); + + // Check for user-passed knobs + if (nargin > 1) + { + NDArray User_knobs = args(1).array_value (); + int nel_User_knobs = User_knobs.length (); + + if (nel_User_knobs > 0) + knobs[CCOLAMD_LU] = (User_knobs(0) != 0); + if (nel_User_knobs > 1) + knobs[CCOLAMD_DENSE_ROW] = User_knobs(1); + if (nel_User_knobs > 2) + knobs[CCOLAMD_DENSE_COL] = User_knobs(2); + if (nel_User_knobs > 3) + knobs[CCOLAMD_AGGRESSIVE] = (User_knobs(3) != 0); + if (nel_User_knobs > 4) + spumoni = (User_knobs(4) != 0); + + // print knob settings if spumoni is set + if (spumoni) + { + octave_stdout << "\nccolamd version " << CCOLAMD_MAIN_VERSION << "." + << CCOLAMD_SUB_VERSION << ", " << CCOLAMD_DATE + << ":\nknobs(1): " << User_knobs(0) << ", order for "; + if (knobs[CCOLAMD_LU] != 0) + octave_stdout << "lu (A)\n"; + else + octave_stdout << "chol (A'*A)\n"; + + if (knobs[CCOLAMD_DENSE_ROW] >= 0) + octave_stdout << "knobs(2): " << User_knobs(1) + << ", rows with > max (16," + << knobs[CCOLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" + << " entries removed\n"; + else + octave_stdout << "knobs(2): " << User_knobs(1) + << ", no dense rows removed\n"; + + if (knobs[CCOLAMD_DENSE_COL] >= 0) + octave_stdout << "knobs(3): " << User_knobs(2) + << ", cols with > max (16," + << knobs[CCOLAMD_DENSE_COL] << "*sqrt (size(A)))" + << " entries removed\n"; + else + octave_stdout << "knobs(3): " << User_knobs(2) + << ", no dense columns removed\n"; + + if (knobs[CCOLAMD_AGGRESSIVE] != 0) + octave_stdout << "knobs(4): " << User_knobs(3) + << ", aggressive absorption: yes"; + else + octave_stdout << "knobs(4): " << User_knobs(3) + << ", aggressive absorption: no"; + + octave_stdout << "knobs(5): " << User_knobs(4) + << ", statistics and knobs printed\n"; + } + } + + octave_idx_type n_row, n_col, nnz; + octave_idx_type *ridx, *cidx; + SparseComplexMatrix scm; + SparseMatrix sm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0). sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + nnz = scm.nnz (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + + n_row = sm.rows (); + n_col = sm.cols (); + nnz = sm.nnz (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + } + else + { + if (args(0).is_complex_type ()) + sm = SparseMatrix (real (args(0).complex_matrix_value ())); + else + sm = SparseMatrix (args(0).matrix_value ()); + + n_row = sm.rows (); + n_col = sm.cols (); + nnz = sm.nnz (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + // Allocate workspace for ccolamd + OCTAVE_LOCAL_BUFFER (octave_idx_type, p, n_col+1); + for (octave_idx_type i = 0; i < n_col+1; i++) + p[i] = cidx[i]; + + octave_idx_type Alen = CCOLAMD_NAME (_recommended) (nnz, n_row, n_col); + OCTAVE_LOCAL_BUFFER (octave_idx_type, A, Alen); + for (octave_idx_type i = 0; i < nnz; i++) + A[i] = ridx[i]; + + OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, CCOLAMD_STATS); + + if (nargin > 2) + { + NDArray in_cmember = args(2).array_value (); + octave_idx_type cslen = in_cmember.length (); + OCTAVE_LOCAL_BUFFER (octave_idx_type, cmember, cslen); + for (octave_idx_type i = 0; i < cslen; i++) + // convert cmember from 1-based to 0-based + cmember[i] = static_cast(in_cmember(i) - 1); + + if (cslen != n_col) + error ("ccolamd: CMEMBER must be of length equal to #cols of A"); + else + // Order the columns (destroys A) + if (! CCOLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats, cmember)) + { + CCOLAMD_NAME (_report) (stats) ; + error ("ccolamd: internal error!"); + return retval; + } + } + else + { + // Order the columns (destroys A) + if (! CCOLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats, 0)) + { + CCOLAMD_NAME (_report) (stats) ; + error ("ccolamd: internal error!"); + return retval; + } + } + + // return the permutation vector + NDArray out_perm (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + out_perm(i) = p[i] + 1; + + retval(0) = out_perm; + + // print stats if spumoni > 0 + if (spumoni > 0) + CCOLAMD_NAME (_report) (stats) ; + + // Return the stats vector + if (nargout == 2) + { + NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); + for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) + out_stats(i) = stats[i] ; + retval(1) = out_stats; + + // fix stats (5) and (6), for 1-based information on + // jumbled matrix. note that this correction doesn't + // occur if symamd returns FALSE + out_stats (CCOLAMD_INFO1) ++ ; + out_stats (CCOLAMD_INFO2) ++ ; + } + } + +#else + + error ("ccolamd: not available in this version of Octave"); + +#endif + + return retval; +} + +DEFUN_DLD (csymamd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} csymamd (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} csymamd (@var{S}, @var{knobs})\n\ +@deftypefnx {Loadable Function} {@var{p} =} csymamd (@var{S}, @var{knobs}, @var{cmember})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} csymamd (@dots{})\n\ +\n\ +For a symmetric positive definite matrix @var{S}, returns the permutation\n\ +vector @var{p} such that @code{@var{S}(@var{p},@var{p})} tends to have a\n\ +sparser Cholesky@tie{}factor than @var{S}. Sometimes @code{csymamd} works\n\ +well for symmetric indefinite matrices too. The matrix @var{S} is assumed\n\ +to be symmetric; only the strictly lower triangular part is referenced.\n\ +@var{S} must be square. The ordering is followed by an elimination tree\n\ +post-ordering.\n\ +\n\ +@var{knobs} is an optional 1-element to 3-element input vector, with a\n\ +default value of @code{[10 1 0]} if present or empty. Entries not\n\ +present are set to their defaults.\n\ +\n\ +@table @code\n\ +@item @var{knobs}(1)\n\ +If @var{S} is n-by-n, then rows and columns with more than\n\ +@code{max(16,@var{knobs}(1)*sqrt(n))} entries are ignored, and ordered\n\ +last in the output permutation (subject to the cmember constraints).\n\ +\n\ +@item @var{knobs}(2)\n\ +If nonzero, aggressive absorption is performed.\n\ +\n\ +@item @var{knobs}(3)\n\ +If nonzero, statistics and knobs are printed.\n\ +\n\ +@end table\n\ +\n\ +@var{cmember} is an optional vector of length n. It defines the constraints\n\ +on the ordering. If @code{@var{cmember}(j) = @var{S}}, then row/column j is\n\ +in constraint set @var{c} (@var{c} must be in the range 1 to n). In the\n\ +output permutation @var{p}, rows/columns in set 1 appear first, followed\n\ +by all rows/columns in set 2, and so on. @code{@var{cmember} = ones (1,n)}\n\ +if not present or empty. @code{csymamd (@var{S},[],1:n)} returns @code{1:n}.\n\ +\n\ +@code{@var{p} = csymamd (@var{S})} is about the same as @code{@var{p} =\n\ +symamd (@var{S})}. @var{knobs} and its default values differ.\n\ +\n\ +@code{@var{stats}(4:7)} provide information if CCOLAMD was able to\n\ +continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ +invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ +unsorted or contains duplicate entries, or zero if no such column exists.\n\ +@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ +index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ +such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ +or out-of-order row indices. @code{@var{stats}(8:20)} is always zero in\n\ +the current version of @sc{ccolamd} (reserved for future use).\n\ +\n\ +The authors of the code itself are S. Larimore, T. Davis (Uni of Florida)\n\ +and S. Rajamanickam in collaboration with J. Bilbert and E. Ng. Supported\n\ +by the National Science Foundation (DMS-9504974, DMS-9803599, CCR-0203270),\n\ +and a grant from Sandia National Lab. See\n\ +@url{http://www.cise.ufl.edu/research/sparse} for ccolamd, csymamd, amd,\n\ +colamd, symamd, and other related orderings.\n\ +@seealso{symamd, ccolamd}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#if HAVE_CCOLAMD + + int nargin = args.length (); + int spumoni = 0; + + if (nargout > 2 || nargin < 1 || nargin > 3) + usage ("ccolamd: incorrect number of input and/or output arguments"); + else + { + // Get knobs + OCTAVE_LOCAL_BUFFER (double, knobs, CCOLAMD_KNOBS); + CCOLAMD_NAME (_set_defaults) (knobs); + + // Check for user-passed knobs + if (nargin > 1) + { + NDArray User_knobs = args(1).array_value (); + int nel_User_knobs = User_knobs.length (); + + if (nel_User_knobs > 0) + knobs[CCOLAMD_DENSE_ROW] = User_knobs(0); + if (nel_User_knobs > 0) + knobs[CCOLAMD_AGGRESSIVE] = User_knobs(1); + if (nel_User_knobs > 1) + spumoni = static_cast (User_knobs(2)); + + // print knob settings if spumoni is set + if (spumoni) + { + octave_stdout << "\ncsymamd version " << CCOLAMD_MAIN_VERSION << "." + << CCOLAMD_SUB_VERSION << ", " << CCOLAMD_DATE << "\n"; + + if (knobs[CCOLAMD_DENSE_ROW] >= 0) + octave_stdout << "knobs(1): " << User_knobs(0) + << ", rows/cols with > max (16," + << knobs[CCOLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" + << " entries removed\n"; + else + octave_stdout << "knobs(1): " << User_knobs(0) + << ", no dense rows/cols removed\n"; + + if (knobs[CCOLAMD_AGGRESSIVE] != 0) + octave_stdout << "knobs(2): " << User_knobs(1) + << ", aggressive absorption: yes"; + else + octave_stdout << "knobs(2): " << User_knobs(1) + << ", aggressive absorption: no"; + + + octave_stdout << "knobs(3): " << User_knobs(2) + << ", statistics and knobs printed\n"; + } + } + + octave_idx_type n_row, n_col; + octave_idx_type *ridx, *cidx; + SparseMatrix sm; + SparseComplexMatrix scm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0).sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + } + else + { + if (args(0).is_complex_type ()) + sm = SparseMatrix (real (args(0).complex_matrix_value ())); + else + sm = SparseMatrix (args(0).matrix_value ()); + + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + if (n_row != n_col) + { + error ("csymamd: matrix S must be square"); + return retval; + } + + // Allocate workspace for symamd + OCTAVE_LOCAL_BUFFER (octave_idx_type, perm, n_col+1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, CCOLAMD_STATS); + + if (nargin > 2) + { + NDArray in_cmember = args(2).array_value (); + octave_idx_type cslen = in_cmember.length (); + OCTAVE_LOCAL_BUFFER (octave_idx_type, cmember, cslen); + for (octave_idx_type i = 0; i < cslen; i++) + // convert cmember from 1-based to 0-based + cmember[i] = static_cast(in_cmember(i) - 1); + + if (cslen != n_col) + error ("csymamd: CMEMBER must be of length equal to #cols of A"); + else + if (!CSYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, + &calloc, &free, cmember, -1)) + { + CSYMAMD_NAME (_report) (stats) ; + error ("csymamd: internal error!") ; + return retval; + } + } + else + { + if (!CSYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, + &calloc, &free, 0, -1)) + { + CSYMAMD_NAME (_report) (stats) ; + error ("csymamd: internal error!") ; + return retval; + } + } + + // return the permutation vector + NDArray out_perm (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + out_perm(i) = perm[i] + 1; + + retval(0) = out_perm; + + // Return the stats vector + if (nargout == 2) + { + NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); + for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) + out_stats(i) = stats[i] ; + retval(1) = out_stats; + + // fix stats (5) and (6), for 1-based information on + // jumbled matrix. note that this correction doesn't + // occur if symamd returns FALSE + out_stats (CCOLAMD_INFO1) ++ ; + out_stats (CCOLAMD_INFO2) ++ ; + } + + // print stats if spumoni > 0 + if (spumoni > 0) + CSYMAMD_NAME (_report) (stats) ; + + // Return the stats vector + if (nargout == 2) + { + NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); + for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) + out_stats(i) = stats[i] ; + retval(1) = out_stats; + + // fix stats (5) and (6), for 1-based information on + // jumbled matrix. note that this correction doesn't + // occur if symamd returns FALSE + out_stats (CCOLAMD_INFO1) ++ ; + out_stats (CCOLAMD_INFO2) ++ ; + } + } + +#else + + error ("csymamd: not available in this version of Octave"); + +#endif + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/dldfcn/chol.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/chol.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1385 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2008-2009 Jaroslav Hajek +Copyright (C) 2008-2009 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "CmplxCHOL.h" +#include "dbleCHOL.h" +#include "fCmplxCHOL.h" +#include "floatCHOL.h" +#include "SparseCmplxCHOL.h" +#include "SparsedbleCHOL.h" +#include "oct-spparms.h" +#include "sparse-util.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "utils.h" + +template +static octave_value +get_chol_r (const CHOLT& fact) +{ + return octave_value (fact.chol_matrix (), + MatrixType (MatrixType::Upper)); +} + +template +static octave_value +get_chol_l (const CHOLT& fact) +{ + return octave_value (fact.chol_matrix ().transpose (), + MatrixType (MatrixType::Lower)); +} + +DEFUN_DLD (chol, args, nargout, +"-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{R} =} chol (@var{A})\n\ +@deftypefnx {Loadable Function} {[@var{R}, @var{p}] =} chol (@var{A})\n\ +@deftypefnx {Loadable Function} {[@var{R}, @var{p}, @var{Q}] =} chol (@var{S})\n\ +@deftypefnx {Loadable Function} {[@var{R}, @var{p}, @var{Q}] =} chol (@var{S}, \"vector\")\n\ +@deftypefnx {Loadable Function} {[@var{L}, @dots{}] =} chol (@dots{}, \"lower\")\n\ +@deftypefnx {Loadable Function} {[@var{L}, @dots{}] =} chol (@dots{}, \"upper\")\n\ +@cindex Cholesky factorization\n\ +Compute the Cholesky@tie{}factor, @var{R}, of the symmetric positive definite\n\ +matrix @var{A}, where\n\ +@tex\n\ +$ R^T R = A $.\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@var{R}' * @var{R} = @var{A}.\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +\n\ +Called with one output argument @code{chol} fails if @var{A} or @var{S} is\n\ +not positive definite. With two or more output arguments @var{p} flags\n\ +whether the matrix was positive definite and @code{chol} does not fail. A\n\ +zero value indicated that the matrix was positive definite and the @var{R}\n\ +gives the factorization, and @var{p} will have a positive value otherwise.\n\ +\n\ +If called with 3 outputs then a sparsity preserving row/column permutation\n\ +is applied to @var{A} prior to the factorization. That is @var{R}\n\ +is the factorization of @code{@var{A}(@var{Q},@var{Q})} such that\n\ +@tex\n\ +$ R^T R = Q^T A Q$.\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@var{R}' * @var{R} = @var{Q}' * @var{A} * @var{Q}.\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +\n\ +The sparsity preserving permutation is generally returned as a matrix.\n\ +However, given the flag \"vector\", @var{Q} will be returned as a vector\n\ +such that\n\ +@tex\n\ +$ R^T R = A (Q, Q)$.\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@var{R}' * @var{R} = @var{A}(@var{Q}, @var{Q}).\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +\n\ +Called with either a sparse or full matrix and using the \"lower\" flag,\n\ +@code{chol} returns the lower triangular factorization such that\n\ +@tex\n\ +$ L L^T = A $.\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@var{L} * @var{L}' = @var{A}.\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +\n\ +For full matrices, if the \"lower\" flag is set only the lower triangular\n\ +part of the matrix is used for the factorization, otherwise the upper\n\ +triangular part is used.\n\ +\n\ +In general the lower triangular factorization is significantly faster for\n\ +sparse matrices.\n\ +@seealso{cholinv, chol2inv}\n\ +@end deftypefn") +{ + octave_value_list retval; + int nargin = args.length (); + bool LLt = false; + bool vecout = false; + + if (nargin < 1 || nargin > 3 || nargout > 3 + || (! args(0).is_sparse_type () && nargout > 2)) + { + print_usage (); + return retval; + } + + int n = 1; + while (n < nargin && ! error_state) + { + std::string tmp = args(n++).string_value (); + + if (! error_state ) + { + if (tmp.compare ("vector") == 0) + vecout = true; + else if (tmp.compare ("lower") == 0) + // FIXME currently the option "lower" is handled by transposing the + // matrix, factorizing it with the lapack function DPOTRF ('U', ...) + // and finally transposing the factor. It would be more efficient to use + // DPOTRF ('L', ...) in this case. + LLt = true; + else if (tmp.compare ("upper") == 0) + LLt = false; + else + error ("chol: unexpected second or third input"); + } + else + error ("chol: expecting trailing string arguments"); + } + + if (! error_state) + { + octave_value arg = args(0); + + octave_idx_type nr = arg.rows (); + octave_idx_type nc = arg.columns (); + bool natural = (nargout != 3); + + int arg_is_empty = empty_arg ("chol", nr, nc); + + if (arg_is_empty < 0) + return retval; + if (arg_is_empty > 0) + return octave_value (Matrix ()); + + if (arg.is_sparse_type ()) + { + if (arg.is_real_type ()) + { + SparseMatrix m = arg.sparse_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + SparseCHOL fact (m, info, natural); + if (nargout == 3) + { + if (vecout) + retval(2) = fact.perm (); + else + retval(2) = fact.Q (); + } + + if (nargout > 1 || info == 0) + { + retval(1) = fact.P (); + if (LLt) + retval(0) = fact.L (); + else + retval(0) = fact.R (); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + SparseComplexMatrix m = arg.sparse_complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + SparseComplexCHOL fact (m, info, natural); + + if (nargout == 3) + { + if (vecout) + retval(2) = fact.perm (); + else + retval(2) = fact.Q (); + } + + if (nargout > 1 || info == 0) + { + retval(1) = fact.P (); + if (LLt) + retval(0) = fact.L (); + else + retval(0) = fact.R (); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else + gripe_wrong_type_arg ("chol", arg); + } + else if (arg.is_single_type ()) + { + if (arg.is_real_type ()) + { + FloatMatrix m = arg.float_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + + FloatCHOL fact; + if (LLt) + fact = FloatCHOL (m.transpose (), info); + else + fact = FloatCHOL (m, info); + + if (nargout == 2 || info == 0) + { + retval(1) = info; + if (LLt) + retval(0) = get_chol_l (fact); + else + retval(0) = get_chol_r (fact); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + FloatComplexMatrix m = arg.float_complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + + FloatComplexCHOL fact; + if (LLt) + fact = FloatComplexCHOL (m.transpose (), info); + else + fact = FloatComplexCHOL (m, info); + + if (nargout == 2 || info == 0) + { + retval(1) = info; + if (LLt) + retval(0) = get_chol_l (fact); + else + retval(0) = get_chol_r (fact); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else + gripe_wrong_type_arg ("chol", arg); + } + else + { + if (arg.is_real_type ()) + { + Matrix m = arg.matrix_value (); + + if (! error_state) + { + octave_idx_type info; + + CHOL fact; + if (LLt) + fact = CHOL (m.transpose (), info); + else + fact = CHOL (m, info); + + if (nargout == 2 || info == 0) + { + retval(1) = info; + if (LLt) + retval(0) = get_chol_l (fact); + else + retval(0) = get_chol_r (fact); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + ComplexMatrix m = arg.complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + + ComplexCHOL fact; + if (LLt) + fact = ComplexCHOL (m.transpose (), info); + else + fact = ComplexCHOL (m, info); + + if (nargout == 2 || info == 0) + { + retval(1) = info; + if (LLt) + retval(0) = get_chol_l (fact); + else + retval(0) = get_chol_r (fact); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else + gripe_wrong_type_arg ("chol", arg); + } + } + + return retval; +} + +/* +%!assert (chol ([2, 1; 1, 1]), [sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)], sqrt (eps)) +%!assert (chol (single ([2, 1; 1, 1])), single ([sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)]), sqrt (eps ("single"))) + +%!error chol () +%!error chol ([1, 2; 3, 4]) +%!error chol ([1, 2; 3, 4; 5, 6]) +%!error chol (1, 2) +*/ + +DEFUN_DLD (cholinv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} cholinv (@var{A})\n\ +Use the Cholesky@tie{}factorization to compute the inverse of the\n\ +symmetric positive definite matrix @var{A}.\n\ +@seealso{chol, chol2inv, inv}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value arg = args(0); + + octave_idx_type nr = arg.rows (); + octave_idx_type nc = arg.columns (); + + if (nr == 0 || nc == 0) + retval = Matrix (); + else + { + if (arg.is_sparse_type ()) + { + if (arg.is_real_type ()) + { + SparseMatrix m = arg.sparse_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + SparseCHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + SparseComplexMatrix m = arg.sparse_complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + SparseComplexCHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else + gripe_wrong_type_arg ("cholinv", arg); + } + else if (arg.is_single_type ()) + { + if (arg.is_real_type ()) + { + FloatMatrix m = arg.float_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + FloatCHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + FloatComplexMatrix m = arg.float_complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + FloatComplexCHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else + gripe_wrong_type_arg ("chol", arg); + } + else + { + if (arg.is_real_type ()) + { + Matrix m = arg.matrix_value (); + + if (! error_state) + { + octave_idx_type info; + CHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + ComplexMatrix m = arg.complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + ComplexCHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else + gripe_wrong_type_arg ("chol", arg); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!shared A, Ainv +%! A = [2,0.2;0.2,1]; +%! Ainv = inv (A); +%!test +%! Ainv1 = cholinv (A); +%! assert (norm (Ainv-Ainv1), 0, 1e-10); +%!testif HAVE_CHOLMOD +%! Ainv2 = inv (sparse (A)); +%! assert (norm (Ainv-Ainv2), 0, 1e-10); +%!testif HAVE_CHOLMOD +%! Ainv3 = cholinv (sparse (A)); +%! assert (norm (Ainv-Ainv3), 0, 1e-10); +*/ + +DEFUN_DLD (chol2inv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} chol2inv (@var{U})\n\ +Invert a symmetric, positive definite square matrix from its Cholesky\n\ +decomposition, @var{U}. Note that @var{U} should be an upper-triangular\n\ +matrix with positive diagonal elements. @code{chol2inv (@var{U})}\n\ +provides @code{inv (@var{U}'*@var{U})} but it is much faster than\n\ +using @code{inv}.\n\ +@seealso{chol, cholinv, inv}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value arg = args(0); + + octave_idx_type nr = arg.rows (); + octave_idx_type nc = arg.columns (); + + if (nr == 0 || nc == 0) + retval = Matrix (); + else + { + if (arg.is_sparse_type ()) + { + if (arg.is_real_type ()) + { + SparseMatrix r = arg.sparse_matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else if (arg.is_complex_type ()) + { + SparseComplexMatrix r = arg.sparse_complex_matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else + gripe_wrong_type_arg ("chol2inv", arg); + } + else if (arg.is_single_type ()) + { + if (arg.is_real_type ()) + { + FloatMatrix r = arg.float_matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else if (arg.is_complex_type ()) + { + FloatComplexMatrix r = arg.float_complex_matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else + gripe_wrong_type_arg ("chol2inv", arg); + + } + else + { + if (arg.is_real_type ()) + { + Matrix r = arg.matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else if (arg.is_complex_type ()) + { + ComplexMatrix r = arg.complex_matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else + gripe_wrong_type_arg ("chol2inv", arg); + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN_DLD (cholupdate, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{R1}, @var{info}] =} cholupdate (@var{R}, @var{u}, @var{op})\n\ +Update or downdate a Cholesky@tie{}factorization. Given an upper triangular\n\ +matrix @var{R} and a column vector @var{u}, attempt to determine another\n\ +upper triangular matrix @var{R1} such that\n\ +\n\ +@itemize @bullet\n\ +@item\n\ +@var{R1}'*@var{R1} = @var{R}'*@var{R} + @var{u}*@var{u}'\n\ +if @var{op} is \"+\"\n\ +\n\ +@item\n\ +@var{R1}'*@var{R1} = @var{R}'*@var{R} - @var{u}*@var{u}'\n\ +if @var{op} is \"-\"\n\ +@end itemize\n\ +\n\ +If @var{op} is \"-\", @var{info} is set to\n\ +\n\ +@itemize\n\ +@item 0 if the downdate was successful,\n\ +\n\ +@item 1 if @var{R}'*@var{R} - @var{u}*@var{u}' is not positive definite,\n\ +\n\ +@item 2 if @var{R} is singular.\n\ +@end itemize\n\ +\n\ +If @var{info} is not present, an error message is printed in cases 1 and 2.\n\ +@seealso{chol, qrupdate}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + + octave_value_list retval; + + if (nargin > 3 || nargin < 2) + { + print_usage (); + return retval; + } + + octave_value argr = args(0); + octave_value argu = args(1); + + if (argr.is_numeric_type () && argu.is_numeric_type () + && (nargin < 3 || args(2).is_string ())) + { + octave_idx_type n = argr.rows (); + + std::string op = (nargin < 3) ? "+" : args(2).string_value (); + + bool down = op == "-"; + + if (down || op == "+") + if (argr.columns () == n && argu.rows () == n && argu.columns () == 1) + { + int err = 0; + if (argr.is_single_type () || argu.is_single_type ()) + { + if (argr.is_real_type () && argu.is_real_type ()) + { + // real case + FloatMatrix R = argr.float_matrix_value (); + FloatColumnVector u = argu.float_column_vector_value (); + + FloatCHOL fact; + fact.set (R); + + if (down) + err = fact.downdate (u); + else + fact.update (u); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + FloatComplexMatrix R = argr.float_complex_matrix_value (); + FloatComplexColumnVector u = argu.float_complex_column_vector_value (); + + FloatComplexCHOL fact; + fact.set (R); + + if (down) + err = fact.downdate (u); + else + fact.update (u); + + retval(0) = get_chol_r (fact); + } + } + else + { + if (argr.is_real_type () && argu.is_real_type ()) + { + // real case + Matrix R = argr.matrix_value (); + ColumnVector u = argu.column_vector_value (); + + CHOL fact; + fact.set (R); + + if (down) + err = fact.downdate (u); + else + fact.update (u); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + ComplexMatrix R = argr.complex_matrix_value (); + ComplexColumnVector u = argu.complex_column_vector_value (); + + ComplexCHOL fact; + fact.set (R); + + if (down) + err = fact.downdate (u); + else + fact.update (u); + + retval(0) = get_chol_r (fact); + } + } + + if (nargout > 1) + retval(1) = err; + else if (err == 1) + error ("cholupdate: downdate violates positiveness"); + else if (err == 2) + error ("cholupdate: singular matrix"); + } + else + error ("cholupdate: dimension mismatch between R and U"); + else + error ("cholupdate: OP must be \"+\" or \"-\""); + } + else + print_usage (); + + return retval; +} + +/* +%!shared A, u, Ac, uc +%! A = [ 0.436997 -0.131721 0.124120 -0.061673 ; +%! -0.131721 0.738529 0.019851 -0.140295 ; +%! 0.124120 0.019851 0.354879 -0.059472 ; +%! -0.061673 -0.140295 -0.059472 0.600939 ]; +%! +%! u = [ 0.98950 ; +%! 0.39844 ; +%! 0.63484 ; +%! 0.13351 ]; +%! Ac = [ 0.5585528 + 0.0000000i -0.1662088 - 0.0315341i 0.0107873 + 0.0236411i -0.0276775 - 0.0186073i ; +%! -0.1662088 + 0.0315341i 0.6760061 + 0.0000000i 0.0011452 - 0.0475528i 0.0145967 + 0.0247641i ; +%! 0.0107873 - 0.0236411i 0.0011452 + 0.0475528i 0.6263149 - 0.0000000i -0.1585837 - 0.0719763i ; +%! -0.0276775 + 0.0186073i 0.0145967 - 0.0247641i -0.1585837 + 0.0719763i 0.6034234 - 0.0000000i ]; +%! +%! uc = [ 0.54267 + 0.91519i ; +%! 0.99647 + 0.43141i ; +%! 0.83760 + 0.68977i ; +%! 0.39160 + 0.90378i ]; + +%!test +%! R = chol (A); +%! R1 = cholupdate (R, u); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - R'*R - u*u', Inf) < 1e1*eps); +%! +%! R1 = cholupdate (R1, u, "-"); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1 - R, Inf) < 1e1*eps); + +%!test +%! R = chol (Ac); +%! R1 = cholupdate (R, uc); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - R'*R - uc*uc', Inf) < 1e1*eps); +%! +%! R1 = cholupdate (R1, uc, "-"); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1 - R, Inf) < 1e1*eps); + +%!test +%! R = chol (single (A)); +%! R1 = cholupdate (R, single (u)); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - R'*R - single (u*u'), Inf) < 1e1*eps ("single")); +%! +%! R1 = cholupdate (R1, single (u), "-"); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1 - R, Inf) < 2e1*eps ("single")); + +%!test +%! R = chol (single (Ac)); +%! R1 = cholupdate (R, single (uc)); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - R'*R - single (uc*uc'), Inf) < 1e1*eps ("single")); +%! +%! R1 = cholupdate (R1, single (uc), "-"); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1 - R, Inf) < 2e1*eps ("single")); +*/ + +DEFUN_DLD (cholinsert, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{R1} =} cholinsert (@var{R}, @var{j}, @var{u})\n\ +@deftypefnx {Loadable Function} {[@var{R1}, @var{info}] =} cholinsert (@var{R}, @var{j}, @var{u})\n\ +Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ +positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ +triangular, return the Cholesky@tie{}factorization of\n\ +@var{A1}, where @w{A1(p,p) = A}, @w{A1(:,j) = A1(j,:)' = u} and\n\ +@w{p = [1:j-1,j+1:n+1]}. @w{u(j)} should be positive.\n\ +On return, @var{info} is set to\n\ +\n\ +@itemize\n\ +@item 0 if the insertion was successful,\n\ +\n\ +@item 1 if @var{A1} is not positive definite,\n\ +\n\ +@item 2 if @var{R} is singular.\n\ +@end itemize\n\ +\n\ +If @var{info} is not present, an error message is printed in cases 1 and 2.\n\ +@seealso{chol, cholupdate, choldelete}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + + octave_value_list retval; + + if (nargin != 3) + { + print_usage (); + return retval; + } + + octave_value argr = args(0); + octave_value argj = args(1); + octave_value argu = args(2); + + if (argr.is_numeric_type () && argu.is_numeric_type () + && argj.is_real_scalar ()) + { + octave_idx_type n = argr.rows (); + octave_idx_type j = argj.scalar_value (); + + if (argr.columns () == n && argu.rows () == n+1 && argu.columns () == 1) + { + if (j > 0 && j <= n+1) + { + int err = 0; + if (argr.is_single_type () || argu.is_single_type ()) + { + if (argr.is_real_type () && argu.is_real_type ()) + { + // real case + FloatMatrix R = argr.float_matrix_value (); + FloatColumnVector u = argu.float_column_vector_value (); + + FloatCHOL fact; + fact.set (R); + err = fact.insert_sym (u, j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + FloatComplexMatrix R = argr.float_complex_matrix_value (); + FloatComplexColumnVector u = argu.float_complex_column_vector_value (); + + FloatComplexCHOL fact; + fact.set (R); + err = fact.insert_sym (u, j-1); + + retval(0) = get_chol_r (fact); + } + } + else + { + if (argr.is_real_type () && argu.is_real_type ()) + { + // real case + Matrix R = argr.matrix_value (); + ColumnVector u = argu.column_vector_value (); + + CHOL fact; + fact.set (R); + err = fact.insert_sym (u, j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + ComplexMatrix R = argr.complex_matrix_value (); + ComplexColumnVector u = argu.complex_column_vector_value (); + + ComplexCHOL fact; + fact.set (R); + err = fact.insert_sym (u, j-1); + + retval(0) = get_chol_r (fact); + } + } + + if (nargout > 1) + retval(1) = err; + else if (err == 1) + error ("cholinsert: insertion violates positiveness"); + else if (err == 2) + error ("cholinsert: singular matrix"); + else if (err == 3) + error ("cholinsert: diagonal element must be real"); + } + else + error ("cholinsert: index J out of range"); + } + else + error ("cholinsert: dimension mismatch between R and U"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! u2 = [ 0.35080 ; +%! 0.63930 ; +%! 3.31057 ; +%! -0.13825 ; +%! 0.45266 ]; +%! +%! R = chol (A); +%! +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (A1(p,p) - A, Inf) < 1e1*eps); + +%!test +%! u2 = [ 0.35080 + 0.04298i; +%! 0.63930 + 0.23778i; +%! 3.31057 + 0.00000i; +%! -0.13825 + 0.19879i; +%! 0.45266 + 0.50020i]; +%! +%! R = chol (Ac); +%! +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (A1(p,p) - Ac, Inf) < 1e1*eps); + +%!test +%! u2 = single ([ 0.35080 ; +%! 0.63930 ; +%! 3.31057 ; +%! -0.13825 ; +%! 0.45266 ]); +%! +%! R = chol (single (A)); +%! +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; +%! +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (A1(p,p) - A, Inf) < 1e1*eps ("single")); + +%!test +%! u2 = single ([ 0.35080 + 0.04298i; +%! 0.63930 + 0.23778i; +%! 3.31057 + 0.00000i; +%! -0.13825 + 0.19879i; +%! 0.45266 + 0.50020i]); +%! +%! R = chol (single (Ac)); +%! +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; +%! +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (A1(p,p) - single (Ac), Inf) < 2e1*eps ("single")); + +%!test +%! cu = chol (triu (A), "upper"); +%! cl = chol (tril (A), "lower"); +%! assert (cu, cl', eps); + +%!test +%! cca = chol (Ac); +%! +%! ccal = chol (Ac, "lower"); +%! ccal2 = chol (tril (Ac), "lower"); +%! +%! ccau = chol (Ac, "upper"); +%! ccau2 = chol (triu (Ac), "upper"); +%! +%! assert (cca'*cca, Ac, eps); +%! assert (ccau'*ccau, Ac, eps); +%! assert (ccau2'*ccau2, Ac, eps); +%! +%! assert (cca, ccal', eps); +%! assert (cca, ccau, eps); +%! assert (cca, ccal2', eps); +%! assert (cca, ccau2, eps); + +%!test +%! cca = chol (single (Ac)); +%! +%! ccal = chol (single (Ac), "lower"); +%! ccal2 = chol (tril (single (Ac)), "lower"); +%! +%! ccau = chol (single (Ac), "upper"); +%! ccau2 = chol (triu (single (Ac)), "upper"); +%! +%! assert (cca'*cca, single (Ac), eps ("single")); +%! assert (ccau'*ccau, single (Ac), eps ("single")); +%! assert (ccau2'*ccau2, single (Ac), eps ("single")); +%! +%! assert (cca, ccal', eps ("single")); +%! assert (cca, ccau, eps ("single")); +%! assert (cca, ccal2', eps ("single")); +%! assert (cca, ccau2, eps ("single")); + +%!test +%! a = [12, 2, 3, 4; +%! 2, 14, 5, 3; +%! 3, 5, 16, 6; +%! 4, 3, 6, 16]; +%! +%! b = [0, 1, 2, 3; +%! -1, 0, 1, 2; +%! -2, -1, 0, 1; +%! -3, -2, -1, 0]; +%! +%! ca = a + i*b; +%! +%! cca = chol (ca); +%! +%! ccal = chol (ca, "lower"); +%! ccal2 = chol (tril (ca), "lower"); +%! +%! ccau = chol (ca, "upper"); +%! ccau2 = chol (triu (ca), "upper"); +%! +%! assert (cca'*cca, ca, 16*eps); +%! assert (ccau'*ccau, ca, 16*eps); +%! assert (ccau2'*ccau2, ca, 16*eps); +%! +%! assert (cca, ccal', 16*eps); +%! assert (cca, ccau, 16*eps); +%! assert (cca, ccal2', 16*eps); +%! assert (cca, ccau2, 16*eps); +*/ + +DEFUN_DLD (choldelete, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{R1} =} choldelete (@var{R}, @var{j})\n\ +Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ +positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ +triangular, return the Cholesky@tie{}factorization of @w{A(p,p)}, where\n\ +@w{p = [1:j-1,j+1:n+1]}.\n\ +@seealso{chol, cholupdate, cholinsert}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + + octave_value_list retval; + + if (nargin != 2) + { + print_usage (); + return retval; + } + + octave_value argr = args(0); + octave_value argj = args(1); + + if (argr.is_numeric_type () && argj.is_real_scalar ()) + { + octave_idx_type n = argr.rows (); + octave_idx_type j = argj.scalar_value (); + + if (argr.columns () == n) + { + if (j > 0 && j <= n) + { + if (argr.is_single_type ()) + { + if (argr.is_real_type ()) + { + // real case + FloatMatrix R = argr.float_matrix_value (); + + FloatCHOL fact; + fact.set (R); + fact.delete_sym (j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + FloatComplexMatrix R = argr.float_complex_matrix_value (); + + FloatComplexCHOL fact; + fact.set (R); + fact.delete_sym (j-1); + + retval(0) = get_chol_r (fact); + } + } + else + { + if (argr.is_real_type ()) + { + // real case + Matrix R = argr.matrix_value (); + + CHOL fact; + fact.set (R); + fact.delete_sym (j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + ComplexMatrix R = argr.complex_matrix_value (); + + ComplexCHOL fact; + fact.set (R); + fact.delete_sym (j-1); + + retval(0) = get_chol_r (fact); + } + } + } + else + error ("choldelete: index J out of range"); + } + else + error ("choldelete: matrix R must be square"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! R = chol (A); +%! +%! j = 3; p = [1:j-1,j+1:4]; +%! R1 = choldelete (R, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); + +%!test +%! R = chol (Ac); +%! +%! j = 3; p = [1:j-1,j+1:4]; +%! R1 = choldelete (R, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); + +%!test +%! R = chol (single (A)); +%! +%! j = 3; p = [1:j-1,j+1:4]; +%! R1 = choldelete (R, j); +%! +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); + +%!test +%! R = chol (single (Ac)); +%! +%! j = 3; p = [1:j-1,j+1:4]; +%! R1 = choldelete (R,j); +%! +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); +*/ + +DEFUN_DLD (cholshift, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{R1} =} cholshift (@var{R}, @var{i}, @var{j})\n\ +Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ +positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ +triangular, return the Cholesky@tie{}factorization of\n\ +@w{@var{A}(p,p)}, where @w{p} is the permutation @*\n\ +@code{p = [1:i-1, shift(i:j, 1), j+1:n]} if @w{@var{i} < @var{j}} @*\n\ + or @*\n\ +@code{p = [1:j-1, shift(j:i,-1), i+1:n]} if @w{@var{j} < @var{i}}. @*\n\ +\n\ +@seealso{chol, cholinsert, choldelete}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + + octave_value_list retval; + + if (nargin != 3) + { + print_usage (); + return retval; + } + + octave_value argr = args(0); + octave_value argi = args(1); + octave_value argj = args(2); + + if (argr.is_numeric_type () && argi.is_real_scalar () && argj.is_real_scalar ()) + { + octave_idx_type n = argr.rows (); + octave_idx_type i = argi.scalar_value (); + octave_idx_type j = argj.scalar_value (); + + if (argr.columns () == n) + { + if (j > 0 && j <= n+1 && i > 0 && i <= n+1) + { + + if (argr.is_single_type () && argi.is_single_type () && + argj.is_single_type ()) + { + if (argr.is_real_type ()) + { + // real case + FloatMatrix R = argr.float_matrix_value (); + + FloatCHOL fact; + fact.set (R); + fact.shift_sym (i-1, j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + FloatComplexMatrix R = argr.float_complex_matrix_value (); + + FloatComplexCHOL fact; + fact.set (R); + fact.shift_sym (i-1, j-1); + + retval(0) = get_chol_r (fact); + } + } + else + { + if (argr.is_real_type ()) + { + // real case + Matrix R = argr.matrix_value (); + + CHOL fact; + fact.set (R); + fact.shift_sym (i-1, j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + ComplexMatrix R = argr.complex_matrix_value (); + + ComplexCHOL fact; + fact.set (R); + fact.shift_sym (i-1, j-1); + + retval(0) = get_chol_r (fact); + } + } + } + else + error ("cholshift: index I or J is out of range"); + } + else + error ("cholshift: R must be a square matrix"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! R = chol (A); +%! +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); +%! +%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1) - R1, Inf), 0); +%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); + +%!test +%! R = chol (Ac); +%! +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); +%! +%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); + +%!test +%! R = chol (single (A)); +%! +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); +%! +%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); + +%!test +%! R = chol (single (Ac)); +%! +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); +%! +%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); +*/ diff -r d02b229ce693 -r a132d206a36a src/dldfcn/colamd.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/colamd.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,768 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// This is the octave interface to colamd, which bore the copyright given +// in the help of the functions. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "ov.h" +#include "defun-dld.h" +#include "pager.h" +#include "ov-re-mat.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +#include "oct-sparse.h" +#include "oct-locbuf.h" + +#ifdef IDX_TYPE_LONG +#define COLAMD_NAME(name) colamd_l ## name +#define SYMAMD_NAME(name) symamd_l ## name +#else +#define COLAMD_NAME(name) colamd ## name +#define SYMAMD_NAME(name) symamd ## name +#endif + +// The symmetric column elimination tree code take from the Davis LDL code. +// Copyright given elsewhere in this file. +static void +symetree (const octave_idx_type *ridx, const octave_idx_type *cidx, + octave_idx_type *Parent, octave_idx_type *P, octave_idx_type n) +{ + OCTAVE_LOCAL_BUFFER (octave_idx_type, Flag, n); + OCTAVE_LOCAL_BUFFER (octave_idx_type, Pinv, (P ? n : 0)); + if (P) + // If P is present then compute Pinv, the inverse of P + for (octave_idx_type k = 0 ; k < n ; k++) + Pinv[P[k]] = k ; + + for (octave_idx_type k = 0 ; k < n ; k++) + { + // L(k,:) pattern: all nodes reachable in etree from nz in A(0:k-1,k) + Parent[k] = n ; // parent of k is not yet known + Flag[k] = k ; // mark node k as visited + octave_idx_type kk = (P) ? (P[k]) : (k) ; // kth original, or permuted, column + octave_idx_type p2 = cidx[kk+1] ; + for (octave_idx_type p = cidx[kk] ; p < p2 ; p++) + { + // A (i,k) is nonzero (original or permuted A) + octave_idx_type i = (Pinv) ? (Pinv[ridx[p]]) : (ridx[p]) ; + if (i < k) + { + // follow path from i to root of etree, stop at flagged node + for ( ; Flag[i] != k ; i = Parent[i]) + { + // find parent of i if not yet determined + if (Parent[i] == n) + Parent[i] = k ; + Flag[i] = k ; // mark i as visited + } + } + } + } +} + +// The elimination tree post-ordering code below is taken from SuperLU +static inline octave_idx_type +make_set (octave_idx_type i, octave_idx_type *pp) +{ + pp[i] = i; + return i; +} + +static inline octave_idx_type +link (octave_idx_type s, octave_idx_type t, octave_idx_type *pp) +{ + pp[s] = t; + return t; +} + +static inline octave_idx_type +find (octave_idx_type i, octave_idx_type *pp) +{ + register octave_idx_type p, gp; + + p = pp[i]; + gp = pp[p]; + + while (gp != p) + { + pp[i] = gp; + i = gp; + p = pp[i]; + gp = pp[p]; + } + + return p; +} + +static octave_idx_type +etdfs (octave_idx_type v, octave_idx_type *first_kid, + octave_idx_type *next_kid, octave_idx_type *post, + octave_idx_type postnum) +{ + for (octave_idx_type w = first_kid[v]; w != -1; w = next_kid[w]) + postnum = etdfs (w, first_kid, next_kid, post, postnum); + + post[postnum++] = v; + + return postnum; +} + +static void +tree_postorder (octave_idx_type n, octave_idx_type *parent, + octave_idx_type *post) +{ + // Allocate storage for working arrays and results + OCTAVE_LOCAL_BUFFER (octave_idx_type, first_kid, n+1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, next_kid, n+1); + + // Set up structure describing children + for (octave_idx_type v = 0; v <= n; first_kid[v++] = -1) + /* do nothing */; + + for (octave_idx_type v = n-1; v >= 0; v--) + { + octave_idx_type dad = parent[v]; + next_kid[v] = first_kid[dad]; + first_kid[dad] = v; + } + + // Depth-first search from dummy root vertex #n + etdfs (n, first_kid, next_kid, post, 0); +} + +static void +coletree (const octave_idx_type *ridx, const octave_idx_type *colbeg, + octave_idx_type *colend, octave_idx_type *parent, + octave_idx_type nr, octave_idx_type nc) +{ + OCTAVE_LOCAL_BUFFER (octave_idx_type, root, nc); + OCTAVE_LOCAL_BUFFER (octave_idx_type, pp, nc); + OCTAVE_LOCAL_BUFFER (octave_idx_type, firstcol, nr); + + // Compute firstcol[row] = first nonzero column in row + for (octave_idx_type row = 0; row < nr; firstcol[row++] = nc) + /* do nothing */; + + for (octave_idx_type col = 0; col < nc; col++) + for (octave_idx_type p = colbeg[col]; p < colend[col]; p++) + { + octave_idx_type row = ridx[p]; + if (firstcol[row] > col) + firstcol[row] = col; + } + + // Compute etree by Liu's algorithm for symmetric matrices, + // except use (firstcol[r],c) in place of an edge (r,c) of A. + // Thus each row clique in A'*A is replaced by a star + // centered at its first vertex, which has the same fill. + for (octave_idx_type col = 0; col < nc; col++) + { + octave_idx_type cset = make_set (col, pp); + root[cset] = col; + parent[col] = nc; + for (octave_idx_type p = colbeg[col]; p < colend[col]; p++) + { + octave_idx_type row = firstcol[ridx[p]]; + if (row >= col) + continue; + octave_idx_type rset = find (row, pp); + octave_idx_type rroot = root[rset]; + if (rroot != col) + { + parent[rroot] = col; + cset = link (cset, rset, pp); + root[cset] = col; + } + } + } +} + +DEFUN_DLD (colamd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} colamd (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} colamd (@var{S}, @var{knobs})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} colamd (@var{S})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} colamd (@var{S}, @var{knobs})\n\ +\n\ +Column approximate minimum degree permutation.\n\ +@code{@var{p} = colamd (@var{S})} returns the column approximate minimum\n\ +degree permutation vector for the sparse matrix @var{S}. For a\n\ +non-symmetric matrix @var{S}, @code{@var{S}(:,@var{p})} tends to have\n\ +sparser LU@tie{}factors than @var{S}. The Cholesky@tie{}factorization of\n\ +@code{@var{S}(:,@var{p})' * @var{S}(:,@var{p})} also tends to be sparser\n\ +than that of @code{@var{S}' * @var{S}}.\n\ +\n\ +@var{knobs} is an optional one- to three-element input vector. If @var{S} is\n\ +m-by-n, then rows with more than @code{max(16,@var{knobs}(1)*sqrt(n))}\n\ +entries are ignored. Columns with more than\n\ +@code{max (16,@var{knobs}(2)*sqrt(min(m,n)))} entries are removed prior to\n\ +ordering, and ordered last in the output permutation @var{p}. Only\n\ +completely dense rows or columns are removed if @code{@var{knobs}(1)} and\n\ +@code{@var{knobs}(2)} are < 0, respectively. If @code{@var{knobs}(3)} is\n\ +nonzero, @var{stats} and @var{knobs} are printed. The default is\n\ +@code{@var{knobs} = [10 10 0]}. Note that @var{knobs} differs from earlier\n\ +versions of colamd.\n\ +\n\ +@var{stats} is an optional 20-element output vector that provides data\n\ +about the ordering and the validity of the input matrix @var{S}. Ordering\n\ +statistics are in @code{@var{stats}(1:3)}. @code{@var{stats}(1)} and\n\ +@code{@var{stats}(2)} are the number of dense or empty rows and columns\n\ +ignored by @sc{colamd} and @code{@var{stats}(3)} is the number of garbage\n\ +collections performed on the internal data structure used by @sc{colamd}\n\ +(roughly of size @code{2.2 * nnz(@var{S}) + 4 * @var{m} + 7 * @var{n}}\n\ +integers).\n\ +\n\ +Octave built-in functions are intended to generate valid sparse matrices,\n\ +with no duplicate entries, with ascending row indices of the nonzeros\n\ +in each column, with a non-negative number of entries in each column (!)\n\ +and so on. If a matrix is invalid, then @sc{colamd} may or may not be able\n\ +to continue. If there are duplicate entries (a row index appears two or\n\ +more times in the same column) or if the row indices in a column are out\n\ +of order, then @sc{colamd} can correct these errors by ignoring the duplicate\n\ +entries and sorting each column of its internal copy of the matrix\n\ +@var{S} (the input matrix @var{S} is not repaired, however). If a matrix\n\ +is invalid in other ways then @sc{colamd} cannot continue, an error message\n\ +is printed, and no output arguments (@var{p} or @var{stats}) are returned.\n\ +@sc{colamd} is thus a simple way to check a sparse matrix to see if it's\n\ +valid.\n\ +\n\ +@code{@var{stats}(4:7)} provide information if COLAMD was able to\n\ +continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ +invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ +unsorted or contains duplicate entries, or zero if no such column exists.\n\ +@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ +index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ +such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ +or out-of-order row indices. @code{@var{stats}(8:20)} is always zero in\n\ +the current version of @sc{colamd} (reserved for future use).\n\ +\n\ +The ordering is followed by a column elimination tree post-ordering.\n\ +\n\ +The authors of the code itself are Stefan I. Larimore and Timothy A.\n\ +Davis @email{davis@@cise.ufl.edu}, University of Florida. The algorithm was\n\ +developed in collaboration with John Gilbert, Xerox PARC, and Esmond\n\ +Ng, Oak Ridge National Laboratory. (see\n\ +@url{http://www.cise.ufl.edu/research/sparse/colamd})\n\ +@seealso{colperm, symamd, ccolamd}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_COLAMD + + int nargin = args.length (); + int spumoni = 0; + + if (nargout > 2 || nargin < 1 || nargin > 2) + print_usage (); + else + { + // Get knobs + OCTAVE_LOCAL_BUFFER (double, knobs, COLAMD_KNOBS); + COLAMD_NAME (_set_defaults) (knobs); + + // Check for user-passed knobs + if (nargin == 2) + { + NDArray User_knobs = args(1).array_value (); + int nel_User_knobs = User_knobs.length (); + + if (nel_User_knobs > 0) + knobs[COLAMD_DENSE_ROW] = User_knobs(0); + if (nel_User_knobs > 1) + knobs[COLAMD_DENSE_COL] = User_knobs(1) ; + if (nel_User_knobs > 2) + spumoni = static_cast (User_knobs(2)); + + // print knob settings if spumoni is set + if (spumoni) + { + + octave_stdout << "\ncolamd version " << COLAMD_MAIN_VERSION << "." + << COLAMD_SUB_VERSION << ", " << COLAMD_DATE << ":\n"; + + if (knobs[COLAMD_DENSE_ROW] >= 0) + octave_stdout << "knobs(1): " << User_knobs (0) + << ", rows with > max (16," + << knobs[COLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" + << " entries removed\n"; + else + octave_stdout << "knobs(1): " << User_knobs (0) + << ", only completely dense rows removed\n"; + + if (knobs[COLAMD_DENSE_COL] >= 0) + octave_stdout << "knobs(2): " << User_knobs (1) + << ", cols with > max (16," + << knobs[COLAMD_DENSE_COL] << "*sqrt (size(A)))" + << " entries removed\n"; + else + octave_stdout << "knobs(2): " << User_knobs (1) + << ", only completely dense columns removed\n"; + + octave_stdout << "knobs(3): " << User_knobs (2) + << ", statistics and knobs printed\n"; + + } + } + + octave_idx_type n_row, n_col, nnz; + octave_idx_type *ridx, *cidx; + SparseComplexMatrix scm; + SparseMatrix sm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0). sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + nnz = scm.nnz (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + + n_row = sm.rows (); + n_col = sm.cols (); + nnz = sm.nnz (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + } + else + { + if (args(0).is_complex_type ()) + sm = SparseMatrix (real (args(0).complex_matrix_value ())); + else + sm = SparseMatrix (args(0).matrix_value ()); + + n_row = sm.rows (); + n_col = sm.cols (); + nnz = sm.nnz (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + // Allocate workspace for colamd + OCTAVE_LOCAL_BUFFER (octave_idx_type, p, n_col+1); + for (octave_idx_type i = 0; i < n_col+1; i++) + p[i] = cidx[i]; + + octave_idx_type Alen = COLAMD_NAME (_recommended) (nnz, n_row, n_col); + OCTAVE_LOCAL_BUFFER (octave_idx_type, A, Alen); + for (octave_idx_type i = 0; i < nnz; i++) + A[i] = ridx[i]; + + // Order the columns (destroys A) + OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, COLAMD_STATS); + if (! COLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats)) + { + COLAMD_NAME (_report) (stats) ; + error ("colamd: internal error!"); + return retval; + } + + // column elimination tree post-ordering (reuse variables) + OCTAVE_LOCAL_BUFFER (octave_idx_type, colbeg, n_col + 1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, colend, n_col + 1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); + + for (octave_idx_type i = 0; i < n_col; i++) + { + colbeg[i] = cidx[p[i]]; + colend[i] = cidx[p[i]+1]; + } + + coletree (ridx, colbeg, colend, etree, n_row, n_col); + + // Calculate the tree post-ordering + tree_postorder (n_col, etree, colbeg); + + // return the permutation vector + NDArray out_perm (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + out_perm(i) = p[colbeg[i]] + 1; + + retval(0) = out_perm; + + // print stats if spumoni > 0 + if (spumoni > 0) + COLAMD_NAME (_report) (stats) ; + + // Return the stats vector + if (nargout == 2) + { + NDArray out_stats (dim_vector (1, COLAMD_STATS)); + for (octave_idx_type i = 0 ; i < COLAMD_STATS ; i++) + out_stats(i) = stats[i] ; + retval(1) = out_stats; + + // fix stats (5) and (6), for 1-based information on + // jumbled matrix. note that this correction doesn't + // occur if symamd returns FALSE + out_stats (COLAMD_INFO1) ++ ; + out_stats (COLAMD_INFO2) ++ ; + } + } + +#else + + error ("colamd: not available in this version of Octave"); + +#endif + + return retval; +} + +DEFUN_DLD (symamd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} symamd (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} symamd (@var{S}, @var{knobs})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} symamd (@var{S})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} symamd (@var{S}, @var{knobs})\n\ +\n\ +For a symmetric positive definite matrix @var{S}, returns the permutation\n\ +vector p such that @code{@var{S}(@var{p}, @var{p})} tends to have a\n\ +sparser Cholesky@tie{}factor than @var{S}. Sometimes @code{symamd} works\n\ +well for symmetric indefinite matrices too. The matrix @var{S} is assumed\n\ +to be symmetric; only the strictly lower triangular part is referenced.\n\ +@var{S} must be square.\n\ +\n\ +@var{knobs} is an optional one- to two-element input vector. If @var{S} is\n\ +n-by-n, then rows and columns with more than\n\ +@code{max (16,@var{knobs}(1)*sqrt(n))} entries are removed prior to ordering,\n\ +and ordered last in the output permutation @var{p}. No rows/columns are\n\ +removed if @code{@var{knobs}(1) < 0}. If @code{@var{knobs} (2)} is nonzero,\n\ +@code{stats} and @var{knobs} are printed. The default is @code{@var{knobs}\n\ += [10 0]}. Note that @var{knobs} differs from earlier versions of symamd.\n\ +\n\ +@var{stats} is an optional 20-element output vector that provides data\n\ +about the ordering and the validity of the input matrix @var{S}. Ordering\n\ +statistics are in @code{@var{stats}(1:3)}. @code{@var{stats}(1) =\n\ +@var{stats}(2)} is the number of dense or empty rows and columns\n\ +ignored by SYMAMD and @code{@var{stats}(3)} is the number of garbage\n\ +collections performed on the internal data structure used by SYMAMD\n\ +(roughly of size @code{8.4 * nnz (tril (@var{S}, -1)) + 9 * @var{n}}\n\ +integers).\n\ +\n\ +Octave built-in functions are intended to generate valid sparse matrices,\n\ +with no duplicate entries, with ascending row indices of the nonzeros\n\ +in each column, with a non-negative number of entries in each column (!)\n\ +and so on. If a matrix is invalid, then SYMAMD may or may not be able\n\ +to continue. If there are duplicate entries (a row index appears two or\n\ +more times in the same column) or if the row indices in a column are out\n\ +of order, then SYMAMD can correct these errors by ignoring the duplicate\n\ +entries and sorting each column of its internal copy of the matrix S (the\n\ +input matrix S is not repaired, however). If a matrix is invalid in\n\ +other ways then SYMAMD cannot continue, an error message is printed, and\n\ +no output arguments (@var{p} or @var{stats}) are returned. SYMAMD is\n\ +thus a simple way to check a sparse matrix to see if it's valid.\n\ +\n\ +@code{@var{stats}(4:7)} provide information if SYMAMD was able to\n\ +continue. The matrix is OK if @code{@var{stats} (4)} is zero, or 1\n\ +if invalid. @code{@var{stats}(5)} is the rightmost column index that\n\ +is unsorted or contains duplicate entries, or zero if no such column\n\ +exists. @code{@var{stats}(6)} is the last seen duplicate or out-of-order\n\ +row index in the column index given by @code{@var{stats}(5)}, or zero\n\ +if no such row index exists. @code{@var{stats}(7)} is the number of\n\ +duplicate or out-of-order row indices. @code{@var{stats}(8:20)} is\n\ +always zero in the current version of SYMAMD (reserved for future use).\n\ +\n\ +The ordering is followed by a column elimination tree post-ordering.\n\ +\n\ +The authors of the code itself are Stefan I. Larimore and Timothy A.\n\ +Davis @email{davis@@cise.ufl.edu}, University of Florida. The algorithm was\n\ +developed in collaboration with John Gilbert, Xerox PARC, and Esmond\n\ +Ng, Oak Ridge National Laboratory. (see\n\ +@url{http://www.cise.ufl.edu/research/sparse/colamd})\n\ +@seealso{colperm, colamd}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_COLAMD + + int nargin = args.length (); + int spumoni = 0; + + if (nargout > 2 || nargin < 1 || nargin > 2) + print_usage (); + else + { + // Get knobs + OCTAVE_LOCAL_BUFFER (double, knobs, COLAMD_KNOBS); + COLAMD_NAME (_set_defaults) (knobs); + + // Check for user-passed knobs + if (nargin == 2) + { + NDArray User_knobs = args(1).array_value (); + int nel_User_knobs = User_knobs.length (); + + if (nel_User_knobs > 0) + knobs[COLAMD_DENSE_ROW] = User_knobs(COLAMD_DENSE_ROW); + if (nel_User_knobs > 1) + spumoni = static_cast (User_knobs (1)); + } + + // print knob settings if spumoni is set + if (spumoni > 0) + octave_stdout << "symamd: dense row/col fraction: " + << knobs[COLAMD_DENSE_ROW] << std::endl; + + octave_idx_type n_row, n_col; + octave_idx_type *ridx, *cidx; + SparseMatrix sm; + SparseComplexMatrix scm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0).sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + } + else + { + if (args(0).is_complex_type ()) + sm = SparseMatrix (real (args(0).complex_matrix_value ())); + else + sm = SparseMatrix (args(0).matrix_value ()); + + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + if (n_row != n_col) + { + error ("symamd: matrix S must be square"); + return retval; + } + + // Allocate workspace for symamd + OCTAVE_LOCAL_BUFFER (octave_idx_type, perm, n_col+1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, COLAMD_STATS); + if (!SYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, &calloc, &free)) + { + SYMAMD_NAME (_report) (stats) ; + error ("symamd: internal error!") ; + return retval; + } + + // column elimination tree post-ordering + OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); + symetree (ridx, cidx, etree, perm, n_col); + + // Calculate the tree post-ordering + OCTAVE_LOCAL_BUFFER (octave_idx_type, post, n_col + 1); + tree_postorder (n_col, etree, post); + + // return the permutation vector + NDArray out_perm (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + out_perm(i) = perm[post[i]] + 1; + + retval(0) = out_perm; + + // print stats if spumoni > 0 + if (spumoni > 0) + SYMAMD_NAME (_report) (stats) ; + + // Return the stats vector + if (nargout == 2) + { + NDArray out_stats (dim_vector (1, COLAMD_STATS)); + for (octave_idx_type i = 0 ; i < COLAMD_STATS ; i++) + out_stats(i) = stats[i] ; + retval(1) = out_stats; + + // fix stats (5) and (6), for 1-based information on + // jumbled matrix. note that this correction doesn't + // occur if symamd returns FALSE + out_stats (COLAMD_INFO1) ++ ; + out_stats (COLAMD_INFO2) ++ ; + } + } + +#else + + error ("symamd: not available in this version of Octave"); + +#endif + + return retval; +} + +DEFUN_DLD (etree, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} etree (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} etree (@var{S}, @var{typ})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{q}] =} etree (@var{S}, @var{typ})\n\ +\n\ +Return the elimination tree for the matrix @var{S}. By default @var{S}\n\ +is assumed to be symmetric and the symmetric elimination tree is\n\ +returned. The argument @var{typ} controls whether a symmetric or\n\ +column elimination tree is returned. Valid values of @var{typ} are\n\ +\"sym\" or \"col\", for symmetric or column elimination tree respectively\n\ +\n\ +Called with a second argument, @code{etree} also returns the postorder\n\ +permutations on the tree.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargout > 2 || nargin < 1 || nargin > 2) + print_usage (); + else + { + octave_idx_type n_row, n_col; + octave_idx_type *ridx, *cidx; + bool is_sym = true; + SparseMatrix sm; + SparseComplexMatrix scm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0).sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + } + else + { + error ("etree: S must be a sparse matrix"); + return retval; + } + + if (nargin == 2) + { + if (args(1).is_string ()) + { + std::string str = args(1).string_value (); + if (str.find ("C") == 0 || str.find ("c") == 0) + is_sym = false; + } + else + { + error ("etree: TYP must be a string"); + return retval; + } + } + + // column elimination tree post-ordering (reuse variables) + OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); + + if (is_sym) + { + if (n_row != n_col) + { + error ("etree: S is marked as symmetric, but is not square"); + return retval; + } + + symetree (ridx, cidx, etree, 0, n_col); + } + else + { + OCTAVE_LOCAL_BUFFER (octave_idx_type, colbeg, n_col); + OCTAVE_LOCAL_BUFFER (octave_idx_type, colend, n_col); + + for (octave_idx_type i = 0; i < n_col; i++) + { + colbeg[i] = cidx[i]; + colend[i] = cidx[i+1]; + } + + coletree (ridx, colbeg, colend, etree, n_row, n_col); + } + + NDArray tree (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + // We flag a root with n_col while Matlab does it with zero + // Convert for matlab compatiable output + if (etree[i] == n_col) + tree(i) = 0; + else + tree(i) = etree[i] + 1; + + retval(0) = tree; + + if (nargout == 2) + { + // Calculate the tree post-ordering + OCTAVE_LOCAL_BUFFER (octave_idx_type, post, n_col + 1); + tree_postorder (n_col, etree, post); + + NDArray postorder (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + postorder(i) = post[i] + 1; + + retval(1) = postorder; + } + } + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/dldfcn/config-module.awk --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/config-module.awk Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,77 @@ +BEGIN { + FS = "|"; + nfiles = 0; + + print "## DO NOT EDIT -- generated from module-files by config-module.awk"; + print "" + print "EXTRA_DIST += \\" + print " dldfcn/config-module.sh \\" + print " dldfcn/config-module.awk \\" + print " dldfcn/module-files \\" + print " dldfcn/oct-qhull.h" + print "" +} +/^#.*/ { next; } +{ + nfiles++; + files[nfiles] = $1; + cppflags[nfiles] = $2; + ldflags[nfiles] = $3; + libraries[nfiles] = $4; +} END { + sep = " \\\n"; + print "DLDFCN_SRC = \\"; + for (i = 1; i <= nfiles; i++) { + if (i == nfiles) + sep = "\n"; + printf (" dldfcn/%s%s", files[i], sep); + } + print ""; + + sep = " \\\n"; + print "DLDFCN_LIBS = $(DLDFCN_SRC:.cc=.la)"; + print ""; + print "if AMCOND_ENABLE_DYNAMIC_LINKING"; + print ""; + print "octlib_LTLIBRARIES += $(DLDFCN_LIBS)"; + print ""; + print "## Use stamp files to avoid problems with checking timestamps"; + print "## of symbolic links"; + print ""; + for (i = 1; i <= nfiles; i++) { + basename = files[i]; + sub (/\.cc$/, "", basename); + printf ("dldfcn/$(am__leading_dot)%s.oct-stamp: dldfcn/%s.la\n", basename, basename); + print "\trm -f $(<:.la=.oct)"; + print "\tla=$( $dld_dir/module.mk-t + +$move_if_change $dld_dir/module.mk-t $dld_dir/module.mk diff -r d02b229ce693 -r a132d206a36a src/dldfcn/convhulln.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/convhulln.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,316 @@ +/* + +Copyright (C) 2000-2012 Kai Habel + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* +29. July 2000 - Kai Habel: first release +2002-04-22 Paul Kienzle +* Use warning(...) function rather than writing to cerr +2006-05-01 Tom Holroyd +* add support for consistent winding in all dimensions; output is +* guaranteed to be simplicial. +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "Cell.h" +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" +#include "parse.h" +#include "unwind-prot.h" + +#if defined (HAVE_QHULL) +# include "oct-qhull.h" +# if defined (NEED_QHULL_VERSION) +char qh_version[] = "convhulln.oct 2007-07-24"; +# endif +#endif + +static void +close_fcn (FILE *f) +{ + gnulib::fclose (f); +} + +DEFUN_DLD (convhulln, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{h} =} convhulln (@var{pts})\n\ +@deftypefnx {Loadable Function} {@var{h} =} convhulln (@var{pts}, @var{options})\n\ +@deftypefnx {Loadable Function} {[@var{h}, @var{v}] =} convhulln (@dots{})\n\ +Compute the convex hull of the set of points @var{pts} which is a matrix\n\ +of size [n, dim] containing n points in a space of dimension dim.\n\ +The hull @var{h} is an index vector into the set of points and specifies\n\ +which points form the enclosing hull.\n\ +\n\ +An optional second argument, which must be a string or cell array of strings,\n\ +contains options passed to the underlying qhull command.\n\ +See the documentation for the Qhull library for details\n\ +@url{http://www.qhull.org/html/qh-quick.htm#options}.\n\ +The default options depend on the dimension of the input:\n\ +\n\ +@itemize\n\ +@item 2D, 3D, 4D: @var{options} = @code{@{\"Qt\"@}}\n\ +\n\ +@item 5D and higher: @var{options} = @code{@{\"Qt\", \"Qx\"@}}\n\ +@end itemize\n\ +\n\ +If @var{options} is not present or @code{[]} then the default arguments are\n\ +used. Otherwise, @var{options} replaces the default argument list.\n\ +To append user options to the defaults it is necessary to repeat the\n\ +default arguments in @var{options}. Use a null string to pass no arguments.\n\ +\n\ +If the second output @var{v} is requested the volume of the enclosing\n\ +convex hull is calculated.\n\n\ +@seealso{convhull, delaunayn, voronoin}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#if defined (HAVE_QHULL) + + int nargin = args.length (); + if (nargin < 1 || nargin > 2) + { + print_usage (); + return retval; + } + + Matrix points (args(0).matrix_value ()); + const octave_idx_type dim = points.columns (); + const octave_idx_type num_points = points.rows (); + + points = points.transpose (); + + std::string options; + + if (dim <= 4) + options = " Qt"; + else + options = " Qt Qx"; + + if (nargin == 2) + { + if (args(1).is_string ()) + options = " " + args(1).string_value (); + else if (args(1).is_empty ()) + ; // Use default options. + else if (args(1).is_cellstr ()) + { + options = ""; + + Array tmp = args(1).cellstr_value (); + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += " " + tmp(i); + } + else + { + error ("convhulln: OPTIONS must be a string, cell array of strings, or empty"); + return retval; + } + } + + boolT ismalloc = false; + + unwind_protect frame; + + // Replace the outfile pointer with stdout for debugging information. +#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) + FILE *outfile = gnulib::fopen ("NUL", "w"); +#else + FILE *outfile = gnulib::fopen ("/dev/null", "w"); +#endif + FILE *errfile = stderr; + + if (outfile) + frame.add_fcn (close_fcn, outfile); + else + { + error ("convhulln: unable to create temporary file for output"); + return retval; + } + + // qh_new_qhull command and points arguments are not const... + + std::string cmd = "qhull" + options; + + OCTAVE_LOCAL_BUFFER (char, cmd_str, cmd.length () + 1); + + strcpy (cmd_str, cmd.c_str ()); + + int exitcode = qh_new_qhull (dim, num_points, points.fortran_vec (), + ismalloc, cmd_str, outfile, errfile); + if (! exitcode) + { + bool nonsimp_seen = false; + + octave_idx_type nf = qh num_facets; + + Matrix idx (nf, dim + 1); + + facetT *facet; + + octave_idx_type i = 0; + + FORALLfacets + { + octave_idx_type j = 0; + + if (! nonsimp_seen && ! facet->simplicial) + { + nonsimp_seen = true; + + if (cmd.find ("QJ") != std::string::npos) + { + // Should never happen with QJ. + error ("convhulln: qhull failed: option 'QJ' returned non-simplicial facet"); + return retval; + } + } + + if (dim == 3) + { + setT *vertices = qh_facet3vertex (facet); + + vertexT *vertex, **vertexp; + + FOREACHvertex_ (vertices) + idx(i, j++) = 1 + qh_pointid(vertex->point); + + qh_settempfree (&vertices); + } + else + { + if (facet->toporient ^ qh_ORIENTclock) + { + vertexT *vertex, **vertexp; + + FOREACHvertex_ (facet->vertices) + idx(i, j++) = 1 + qh_pointid(vertex->point); + } + else + { + vertexT *vertex, **vertexp; + + FOREACHvertexreverse12_ (facet->vertices) + idx(i, j++) = 1 + qh_pointid(vertex->point); + } + } + if (j < dim) + warning ("convhulln: facet %d only has %d vertices", i, j); + + i++; + } + + // Remove extra dimension if all facets were simplicial. + + if (! nonsimp_seen) + idx.resize (nf, dim, 0.0); + + if (nargout == 2) + { + // Calculate volume of convex hull, taken from qhull src/geom2.c. + + realT area; + realT dist; + + FORALLfacets + { + if (! facet->normal) + continue; + + if (facet->upperdelaunay && qh ATinfinity) + continue; + + facet->f.area = area = qh_facetarea (facet); + facet->isarea = True; + + if (qh DELAUNAY) + { + if (facet->upperdelaunay == qh UPPERdelaunay) + qh totarea += area; + } + else + { + qh totarea += area; + qh_distplane (qh interior_point, facet, &dist); + qh totvol += -dist * area/ qh hull_dim; + } + } + + retval(1) = octave_value (qh totvol); + } + + retval(0) = idx; + } + else + error ("convhulln: qhull failed"); + + // Free memory from Qhull + qh_freeqhull (! qh_ALL); + + int curlong, totlong; + qh_memfreeshort (&curlong, &totlong); + + if (curlong || totlong) + warning ("convhulln: did not free %d bytes of long memory (%d pieces)", + totlong, curlong); + +#else + error ("convhulln: not available in this version of Octave"); +#endif + + return retval; +} + +/* +%!testif HAVE_QHULL +%! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; +%! [h, v] = convhulln (cube, "Qt"); +%! assert (size (h), [12 3]); +%! h = sortrows (sort (h, 2), [1:3]); +%! assert (h, [1 2 4; 1 2 6; 1 4 8; 1 5 6; 1 5 8; 2 3 4; 2 3 7; 2 6 7; 3 4 7; 4 7 8; 5 6 7; 5 7 8]); +%! assert (v, 1, 10*eps); +%! [h2, v2] = convhulln (cube); % Test defaut option = "Qt" +%! assert (size (h2), size (h)); +%! h2 = sortrows (sort (h2, 2), [1:3]); +%! assert (h2, h); +%! assert (v2, v, 10*eps); + +%!testif HAVE_QHULL +%! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; +%! [h, v] = convhulln (cube, "QJ"); +%! assert (size (h), [12 3]); +%! assert (sortrows (sort (h, 2), [1:3]), [1 2 4; 1 2 5; 1 4 5; 2 3 4; 2 3 6; 2 5 6; 3 4 8; 3 6 7; 3 7 8; 4 5 8; 5 6 8; 6 7 8]); +%! assert (v, 1.0, 1e6*eps); + +%!testif HAVE_QHULL +%! tetrahedron = [1 1 1;-1 -1 1;-1 1 -1;1 -1 -1]; +%! [h, v] = convhulln (tetrahedron); +%! h = sortrows (sort (h, 2), [1 2 3]); +%! assert (h, [1 2 3;1 2 4; 1 3 4; 2 3 4]); +%! assert (v, 8/3, 10*eps); +*/ diff -r d02b229ce693 -r a132d206a36a src/dldfcn/dmperm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/dmperm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,229 @@ +/* + +Copyright (C) 2005-2012 David Bateman +Copyright (C) 1998-2005 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "utils.h" + +#include "oct-sparse.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "SparseQR.h" +#include "SparseCmplxQR.h" + +#ifdef IDX_TYPE_LONG +#define CXSPARSE_NAME(name) cs_dl ## name +#else +#define CXSPARSE_NAME(name) cs_di ## name +#endif + +static RowVector +put_int (octave_idx_type *p, octave_idx_type n) +{ + RowVector ret (n); + for (octave_idx_type i = 0; i < n; i++) + ret.xelem (i) = p[i] + 1; + return ret; +} + +#if HAVE_CXSPARSE +static octave_value_list +dmperm_internal (bool rank, const octave_value arg, int nargout) +{ + octave_value_list retval; + octave_idx_type nr = arg.rows (); + octave_idx_type nc = arg.columns (); + SparseMatrix m; + SparseComplexMatrix cm; + CXSPARSE_NAME () csm; + csm.m = nr; + csm.n = nc; + csm.x = 0; + csm.nz = -1; + + if (arg.is_real_type ()) + { + m = arg.sparse_matrix_value (); + csm.nzmax = m.nnz (); + csm.p = m.xcidx (); + csm.i = m.xridx (); + } + else + { + cm = arg.sparse_complex_matrix_value (); + csm.nzmax = cm.nnz (); + csm.p = cm.xcidx (); + csm.i = cm.xridx (); + } + + if (!error_state) + { + if (nargout <= 1 || rank) + { +#if defined(CS_VER) && (CS_VER >= 2) + octave_idx_type *jmatch = CXSPARSE_NAME (_maxtrans) (&csm, 0); +#else + octave_idx_type *jmatch = CXSPARSE_NAME (_maxtrans) (&csm); +#endif + if (rank) + { + octave_idx_type r = 0; + for (octave_idx_type i = 0; i < nc; i++) + if (jmatch[nr+i] >= 0) + r++; + retval(0) = static_cast(r); + } + else + retval(0) = put_int (jmatch + nr, nc); + CXSPARSE_NAME (_free) (jmatch); + } + else + { +#if defined(CS_VER) && (CS_VER >= 2) + CXSPARSE_NAME (d) *dm = CXSPARSE_NAME(_dmperm) (&csm, 0); +#else + CXSPARSE_NAME (d) *dm = CXSPARSE_NAME(_dmperm) (&csm); +#endif + + //retval(5) = put_int (dm->rr, 5); + //retval(4) = put_int (dm->cc, 5); +#if defined(CS_VER) && (CS_VER >= 2) + retval(3) = put_int (dm->s, dm->nb+1); + retval(2) = put_int (dm->r, dm->nb+1); + retval(1) = put_int (dm->q, nc); + retval(0) = put_int (dm->p, nr); +#else + retval(3) = put_int (dm->S, dm->nb+1); + retval(2) = put_int (dm->R, dm->nb+1); + retval(1) = put_int (dm->Q, nc); + retval(0) = put_int (dm->P, nr); +#endif + CXSPARSE_NAME (_dfree) (dm); + } + } + return retval; +} +#endif + +DEFUN_DLD (dmperm, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} dmperm (@var{S})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{q}, @var{r}, @var{S}] =} dmperm (@var{S})\n\ +\n\ +@cindex Dulmage-Mendelsohn decomposition\n\ +Perform a Dulmage-Mendelsohn permutation of the sparse matrix @var{S}.\n\ +With a single output argument @code{dmperm} performs the row permutations\n\ +@var{p} such that @code{@var{S}(@var{p},:)} has no zero elements on the\n\ +diagonal.\n\ +\n\ +Called with two or more output arguments, returns the row and column\n\ +permutations, such that @code{@var{S}(@var{p}, @var{q})} is in block\n\ +triangular form. The values of @var{r} and @var{S} define the boundaries\n\ +of the blocks. If @var{S} is square then @code{@var{r} == @var{S}}.\n\ +\n\ +The method used is described in: A. Pothen & C.-J. Fan. @cite{Computing the\n\ +Block Triangular Form of a Sparse Matrix}. ACM Trans. Math. Software,\n\ +16(4):303-324, 1990.\n\ +@seealso{colamd, ccolamd}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value_list retval; + + if (nargin != 1) + { + print_usage (); + return retval; + } + +#if HAVE_CXSPARSE + retval = dmperm_internal (false, args(0), nargout); +#else + error ("dmperm: not available in this version of Octave"); +#endif + + return retval; +} + +/* +%!testif HAVE_CXSPARSE +%! n = 20; +%! a = speye (n,n); +%! a = a(randperm (n),:); +%! assert (a(dmperm (a),:), speye (n)); + +%!testif HAVE_CXSPARSE +%! n = 20; +%! d = 0.2; +%! a = tril (sprandn (n,n,d), -1) + speye (n,n); +%! a = a(randperm (n), randperm (n)); +%! [p,q,r,s] = dmperm (a); +%! assert (tril (a(p,q), -1), sparse (n, n)); +*/ + +DEFUN_DLD (sprank, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} sprank (@var{S})\n\ +@cindex structural rank\n\ +\n\ +Calculate the structural rank of the sparse matrix @var{S}. Note that\n\ +only the structure of the matrix is used in this calculation based on\n\ +a Dulmage-Mendelsohn permutation to block triangular form. As such the\n\ +numerical rank of the matrix @var{S} is bounded by\n\ +@code{sprank (@var{S}) >= rank (@var{S})}. Ignoring floating point errors\n\ +@code{sprank (@var{S}) == rank (@var{S})}.\n\ +@seealso{dmperm}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value_list retval; + + if (nargin != 1) + { + print_usage (); + return retval; + } + +#if HAVE_CXSPARSE + retval = dmperm_internal (true, args(0), nargout); +#else + error ("sprank: not available in this version of Octave"); +#endif + + return retval; +} + +/* +%!testif HAVE_CXSPARSE +%! assert (sprank (speye (20)), 20) +%!testif HAVE_CXSPARSE +%! assert (sprank ([1,0,2,0;2,0,4,0]), 2) + +%!error sprank (1,2) +*/ diff -r d02b229ce693 -r a132d206a36a src/dldfcn/eigs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/eigs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1521 @@ +/* + +Copyright (C) 2005-2012 David Bateman + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "ov.h" +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "quit.h" +#include "variables.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "oct-map.h" +#include "pager.h" +#include "unwind-prot.h" + +#include "eigs-base.cc" + +// Global pointer for user defined function. +static octave_function *eigs_fcn = 0; + +// Have we warned about imaginary values returned from user function? +static bool warned_imaginary = false; + +// Is this a recursive call? +static int call_depth = 0; + +ColumnVector +eigs_func (const ColumnVector &x, int &eigs_error) +{ + ColumnVector retval; + octave_value_list args; + args(0) = x; + + if (eigs_fcn) + { + octave_value_list tmp = eigs_fcn->do_multi_index_op (1, args); + + if (error_state) + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + return retval; + } + + if (tmp.length () && tmp(0).is_defined ()) + { + if (! warned_imaginary && tmp(0).is_complex_type ()) + { + warning ("eigs: ignoring imaginary part returned from user-supplied function"); + warned_imaginary = true; + } + + retval = ColumnVector (tmp(0).vector_value ()); + + if (error_state) + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + } + } + else + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + } + } + + return retval; +} + +ComplexColumnVector +eigs_complex_func (const ComplexColumnVector &x, int &eigs_error) +{ + ComplexColumnVector retval; + octave_value_list args; + args(0) = x; + + if (eigs_fcn) + { + octave_value_list tmp = eigs_fcn->do_multi_index_op (1, args); + + if (error_state) + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + return retval; + } + + if (tmp.length () && tmp(0).is_defined ()) + { + retval = ComplexColumnVector (tmp(0).complex_vector_value ()); + + if (error_state) + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + } + } + else + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + } + } + + return retval; +} + +DEFUN_DLD (eigs, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{d} =} eigs (@var{A})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k}, @var{sigma})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k}, @var{sigma}, @var{opts})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k}, @var{sigma})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k}, @var{sigma}, @var{opts})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k}, @var{sigma})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k}, @var{sigma})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k}, @var{sigma}, @var{opts})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k}, @var{sigma}, @var{opts})\n\ +@deftypefnx {Loadable Function} {[@var{V}, @var{d}] =} eigs (@var{A}, @dots{})\n\ +@deftypefnx {Loadable Function} {[@var{V}, @var{d}] =} eigs (@var{af}, @var{n}, @dots{})\n\ +@deftypefnx {Loadable Function} {[@var{V}, @var{d}, @var{flag}] =} eigs (@var{A}, @dots{})\n\ +@deftypefnx {Loadable Function} {[@var{V}, @var{d}, @var{flag}] =} eigs (@var{af}, @var{n}, @dots{})\n\ +Calculate a limited number of eigenvalues and eigenvectors of @var{A},\n\ +based on a selection criteria. The number of eigenvalues and eigenvectors to\n\ +calculate is given by @var{k} and defaults to 6.\n\ +\n\ +By default, @code{eigs} solve the equation\n\ +@tex\n\ +$A \\nu = \\lambda \\nu$,\n\ +@end tex\n\ +@ifinfo\n\ +@code{A * v = lambda * v},\n\ +@end ifinfo\n\ +where\n\ +@tex\n\ +$\\lambda$ is a scalar representing one of the eigenvalues, and $\\nu$\n\ +@end tex\n\ +@ifinfo\n\ +@code{lambda} is a scalar representing one of the eigenvalues, and @code{v}\n\ +@end ifinfo\n\ +is the corresponding eigenvector. If given the positive definite matrix\n\ +@var{B} then @code{eigs} solves the general eigenvalue equation\n\ +@tex\n\ +$A \\nu = \\lambda B \\nu$.\n\ +@end tex\n\ +@ifinfo\n\ +@code{A * v = lambda * B * v}.\n\ +@end ifinfo\n\ +\n\ +The argument @var{sigma} determines which eigenvalues are returned.\n\ +@var{sigma} can be either a scalar or a string. When @var{sigma} is a\n\ +scalar, the @var{k} eigenvalues closest to @var{sigma} are returned. If\n\ +@var{sigma} is a string, it must have one of the following values.\n\ +\n\ +@table @asis\n\ +@item \"lm\"\n\ +Largest Magnitude (default).\n\ +\n\ +@item \"sm\"\n\ +Smallest Magnitude.\n\ +\n\ +@item \"la\"\n\ +Largest Algebraic (valid only for real symmetric problems).\n\ +\n\ +@item \"sa\"\n\ +Smallest Algebraic (valid only for real symmetric problems).\n\ +\n\ +@item \"be\"\n\ +Both Ends, with one more from the high-end if @var{k} is odd (valid only for\n\ +real symmetric problems).\n\ +\n\ +@item \"lr\"\n\ +Largest Real part (valid only for complex or unsymmetric problems).\n\ +\n\ +@item \"sr\"\n\ +Smallest Real part (valid only for complex or unsymmetric problems).\n\ +\n\ +@item \"li\"\n\ +Largest Imaginary part (valid only for complex or unsymmetric problems).\n\ +\n\ +@item \"si\"\n\ +Smallest Imaginary part (valid only for complex or unsymmetric problems).\n\ +@end table\n\ +\n\ +If @var{opts} is given, it is a structure defining possible options that\n\ +@code{eigs} should use. The fields of the @var{opts} structure are:\n\ +\n\ +@table @code\n\ +@item issym\n\ +If @var{af} is given, then flags whether the function @var{af} defines a\n\ +symmetric problem. It is ignored if @var{A} is given. The default is false.\n\ +\n\ +@item isreal\n\ +If @var{af} is given, then flags whether the function @var{af} defines a\n\ +real problem. It is ignored if @var{A} is given. The default is true.\n\ +\n\ +@item tol\n\ +Defines the required convergence tolerance, calculated as\n\ +@code{tol * norm (A)}. The default is @code{eps}.\n\ +\n\ +@item maxit\n\ +The maximum number of iterations. The default is 300.\n\ +\n\ +@item p\n\ +The number of Lanzcos basis vectors to use. More vectors will result in\n\ +faster convergence, but a greater use of memory. The optimal value of\n\ +@code{p} is problem dependent and should be in the range @var{k} to @var{n}.\n\ +The default value is @code{2 * @var{k}}.\n\ +\n\ +@item v0\n\ +The starting vector for the algorithm. An initial vector close to the\n\ +final vector will speed up convergence. The default is for @sc{arpack}\n\ +to randomly generate a starting vector. If specified, @code{v0} must be\n\ +an @var{n}-by-1 vector where @code{@var{n} = rows (@var{A})}\n\ +\n\ +@item disp\n\ +The level of diagnostic printout (0|1|2). If @code{disp} is 0 then\n\ +diagnostics are disabled. The default value is 0.\n\ +\n\ +@item cholB\n\ +Flag if @code{chol (@var{B})} is passed rather than @var{B}. The default is\n\ +false.\n\ +\n\ +@item permB\n\ +The permutation vector of the Cholesky@tie{}factorization of @var{B} if\n\ +@code{cholB} is true. That is @code{chol (@var{B}(permB, permB))}. The\n\ +default is @code{1:@var{n}}.\n\ +\n\ +@end table\n\ +\n\ +It is also possible to represent @var{A} by a function denoted @var{af}.\n\ +@var{af} must be followed by a scalar argument @var{n} defining the length\n\ +of the vector argument accepted by @var{af}. @var{af} can be\n\ +a function handle, an inline function, or a string. When @var{af} is a\n\ +string it holds the name of the function to use.\n\ +\n\ +@var{af} is a function of the form @code{y = af (x)}\n\ +where the required return value of @var{af} is determined by\n\ +the value of @var{sigma}. The four possible forms are\n\ +\n\ +@table @code\n\ +@item A * x\n\ +if @var{sigma} is not given or is a string other than \"sm\".\n\ +\n\ +@item A \\ x\n\ +if @var{sigma} is 0 or \"sm\".\n\ +\n\ +@item (A - sigma * I) \\ x\n\ +for the standard eigenvalue problem, where @code{I} is the identity matrix of\n\ +the same size as @var{A}.\n\ +\n\ +@item (A - sigma * B) \\ x\n\ +for the general eigenvalue problem.\n\ +@end table\n\ +\n\ +The return arguments of @code{eigs} depend on the number of return arguments\n\ +requested. With a single return argument, a vector @var{d} of length @var{k}\n\ +is returned containing the @var{k} eigenvalues that have been found. With\n\ +two return arguments, @var{V} is a @var{n}-by-@var{k} matrix whose columns\n\ +are the @var{k} eigenvectors corresponding to the returned eigenvalues. The\n\ +eigenvalues themselves are returned in @var{d} in the form of a\n\ +@var{n}-by-@var{k} matrix, where the elements on the diagonal are the\n\ +eigenvalues.\n\ +\n\ +Given a third return argument @var{flag}, @code{eigs} returns the status\n\ +of the convergence. If @var{flag} is 0 then all eigenvalues have converged.\n\ +Any other value indicates a failure to converge.\n\ +\n\ +This function is based on the @sc{arpack} package, written by R. Lehoucq,\n\ +K. Maschhoff, D. Sorensen, and C. Yang. For more information see\n\ +@url{http://www.caam.rice.edu/software/ARPACK/}.\n\ +\n\ +@seealso{eig, svds}\n\ +@end deftypefn") +{ + octave_value_list retval; +#ifdef HAVE_ARPACK + int nargin = args.length (); + std::string fcn_name; + octave_idx_type n = 0; + octave_idx_type k = 6; + Complex sigma = 0.; + double sigmar, sigmai; + bool have_sigma = false; + std::string typ = "LM"; + Matrix amm, bmm, bmt; + ComplexMatrix acm, bcm, bct; + SparseMatrix asmm, bsmm, bsmt; + SparseComplexMatrix ascm, bscm, bsct; + int b_arg = 0; + bool have_b = false; + bool have_a_fun = false; + bool a_is_complex = false; + bool b_is_complex = false; + bool symmetric = false; + bool sym_tested = false; + bool cholB = false; + bool a_is_sparse = false; + ColumnVector permB; + int arg_offset = 0; + double tol = DBL_EPSILON; + int maxit = 300; + int disp = 0; + octave_idx_type p = -1; + ColumnVector resid; + ComplexColumnVector cresid; + octave_idx_type info = 1; + + warned_imaginary = false; + + unwind_protect frame; + + frame.protect_var (call_depth); + call_depth++; + + if (call_depth > 1) + { + error ("eigs: invalid recursive call"); + if (fcn_name.length ()) + clear_function (fcn_name); + return retval; + } + + if (nargin == 0) + print_usage (); + else if (args(0).is_function_handle () || args(0).is_inline_function () + || args(0).is_string ()) + { + if (args(0).is_string ()) + { + std::string name = args(0).string_value (); + std::string fname = "function y = "; + fcn_name = unique_symbol_name ("__eigs_fcn_"); + fname.append (fcn_name); + fname.append ("(x) y = "); + eigs_fcn = extract_function (args(0), "eigs", fcn_name, fname, + "; endfunction"); + } + else + eigs_fcn = args(0).function_value (); + + if (!eigs_fcn) + { + error ("eigs: unknown function"); + return retval; + } + + if (nargin < 2) + { + error ("eigs: incorrect number of arguments"); + return retval; + } + else + { + n = args(1).nint_value (); + arg_offset = 1; + have_a_fun = true; + } + } + else + { + if (args(0).is_complex_type ()) + { + if (args(0).is_sparse_type ()) + { + ascm = (args(0).sparse_complex_matrix_value ()); + a_is_sparse = true; + } + else + acm = (args(0).complex_matrix_value ()); + a_is_complex = true; + symmetric = false; // ARPACK doesn't special case complex symmetric + sym_tested = true; + } + else + { + if (args(0).is_sparse_type ()) + { + asmm = (args(0).sparse_matrix_value ()); + a_is_sparse = true; + } + else + { + amm = (args(0).matrix_value ()); + } + } + + } + + // Note hold off reading B till later to avoid issues of double + // copies of the matrix if B is full/real while A is complex. + if (!error_state && nargin > 1 + arg_offset && + !(args(1 + arg_offset).is_real_scalar ())) + { + if (args(1+arg_offset).is_complex_type ()) + { + b_arg = 1+arg_offset; + have_b = true; + b_is_complex = true; + arg_offset++; + } + else + { + b_arg = 1+arg_offset; + have_b = true; + arg_offset++; + } + } + + if (!error_state && nargin > (1+arg_offset)) + k = args(1+arg_offset).nint_value (); + + if (!error_state && nargin > (2+arg_offset)) + { + if (args(2+arg_offset).is_string ()) + { + typ = args(2+arg_offset).string_value (); + + // Use STL function to convert to upper case + transform (typ.begin (), typ.end (), typ.begin (), toupper); + + sigma = 0.; + } + else + { + sigma = args(2+arg_offset).complex_value (); + + if (! error_state) + have_sigma = true; + else + { + error ("eigs: SIGMA must be a scalar or a string"); + return retval; + } + } + } + + sigmar = std::real (sigma); + sigmai = std::imag (sigma); + + if (!error_state && nargin > (3+arg_offset)) + { + if (args(3+arg_offset).is_map ()) + { + octave_scalar_map map = args(3+arg_offset).scalar_map_value (); + + if (! error_state) + { + octave_value tmp; + + // issym is ignored for complex matrix inputs + tmp = map.getfield ("issym"); + if (tmp.is_defined () && !sym_tested) + { + symmetric = tmp.double_value () != 0.; + sym_tested = true; + } + + // isreal is ignored if A is not a function + tmp = map.getfield ("isreal"); + if (tmp.is_defined () && have_a_fun) + a_is_complex = ! (tmp.double_value () != 0.); + + tmp = map.getfield ("tol"); + if (tmp.is_defined ()) + tol = tmp.double_value (); + + tmp = map.getfield ("maxit"); + if (tmp.is_defined ()) + maxit = tmp.nint_value (); + + tmp = map.getfield ("p"); + if (tmp.is_defined ()) + p = tmp.nint_value (); + + tmp = map.getfield ("v0"); + if (tmp.is_defined ()) + { + if (a_is_complex || b_is_complex) + cresid = ComplexColumnVector (tmp.complex_vector_value ()); + else + resid = ColumnVector (tmp.vector_value ()); + } + + tmp = map.getfield ("disp"); + if (tmp.is_defined ()) + disp = tmp.nint_value (); + + tmp = map.getfield ("cholB"); + if (tmp.is_defined ()) + cholB = tmp.double_value () != 0.; + + tmp = map.getfield ("permB"); + if (tmp.is_defined ()) + permB = ColumnVector (tmp.vector_value ()) - 1.0; + } + else + { + error ("eigs: OPTS argument must be a scalar structure"); + return retval; + } + } + else + { + error ("eigs: OPTS argument must be a structure"); + return retval; + } + } + + if (nargin > (4+arg_offset)) + { + error ("eigs: incorrect number of arguments"); + return retval; + } + + // Test undeclared (no issym) matrix inputs for symmetry + if (!sym_tested && !have_a_fun) + { + if (a_is_sparse) + symmetric = asmm.is_symmetric (); + else + symmetric = amm.is_symmetric (); + } + + if (have_b) + { + if (a_is_complex || b_is_complex) + { + if (a_is_sparse) + bscm = args(b_arg).sparse_complex_matrix_value (); + else + bcm = args(b_arg).complex_matrix_value (); + } + else + { + if (a_is_sparse) + bsmm = args(b_arg).sparse_matrix_value (); + else + bmm = args(b_arg).matrix_value (); + } + } + + // Mode 1 for SM mode seems unstable for some reason. + // Use Mode 3 instead, with sigma = 0. + if (!error_state && !have_sigma && typ == "SM") + have_sigma = true; + + if (!error_state) + { + octave_idx_type nconv; + if (a_is_complex || b_is_complex) + { + ComplexMatrix eig_vec; + ComplexColumnVector eig_val; + + + if (have_a_fun) + nconv = EigsComplexNonSymmetricFunc + (eigs_complex_func, n, typ, sigma, k, p, info, eig_vec, eig_val, + cresid, octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + else if (have_sigma) + { + if (a_is_sparse) + nconv = EigsComplexNonSymmetricMatrixShift + (ascm, sigma, k, p, info, eig_vec, eig_val, bscm, permB, + cresid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else + nconv = EigsComplexNonSymmetricMatrixShift + (acm, sigma, k, p, info, eig_vec, eig_val, bcm, permB, cresid, + octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + } + else + { + if (a_is_sparse) + nconv = EigsComplexNonSymmetricMatrix + (ascm, typ, k, p, info, eig_vec, eig_val, bscm, permB, cresid, + octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + else + nconv = EigsComplexNonSymmetricMatrix + (acm, typ, k, p, info, eig_vec, eig_val, bcm, permB, cresid, + octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + } + + if (nargout < 2) + retval(0) = eig_val; + else + { + retval(2) = double (info); + retval(1) = ComplexDiagMatrix (eig_val); + retval(0) = eig_vec; + } + } + else if (sigmai != 0.) + { + // Promote real problem to a complex one. + ComplexMatrix eig_vec; + ComplexColumnVector eig_val; + + if (have_a_fun) + nconv = EigsComplexNonSymmetricFunc + (eigs_complex_func, n, typ, sigma, k, p, info, eig_vec, eig_val, + cresid, octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + else + { + if (a_is_sparse) + nconv = EigsComplexNonSymmetricMatrixShift + (SparseComplexMatrix (asmm), sigma, k, p, info, eig_vec, + eig_val, SparseComplexMatrix (bsmm), permB, cresid, + octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + else + nconv = EigsComplexNonSymmetricMatrixShift + (ComplexMatrix (amm), sigma, k, p, info, eig_vec, + eig_val, ComplexMatrix (bmm), permB, cresid, + octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + } + + if (nargout < 2) + retval(0) = eig_val; + else + { + retval(2) = double (info); + retval(1) = ComplexDiagMatrix (eig_val); + retval(0) = eig_vec; + } + } + else + { + if (symmetric) + { + Matrix eig_vec; + ColumnVector eig_val; + + if (have_a_fun) + nconv = EigsRealSymmetricFunc + (eigs_func, n, typ, sigmar, k, p, info, eig_vec, eig_val, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else if (have_sigma) + { + if (a_is_sparse) + nconv = EigsRealSymmetricMatrixShift + (asmm, sigmar, k, p, info, eig_vec, eig_val, bsmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else + nconv = EigsRealSymmetricMatrixShift + (amm, sigmar, k, p, info, eig_vec, eig_val, bmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + } + else + { + if (a_is_sparse) + nconv = EigsRealSymmetricMatrix + (asmm, typ, k, p, info, eig_vec, eig_val, bsmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else + nconv = EigsRealSymmetricMatrix + (amm, typ, k, p, info, eig_vec, eig_val, bmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + } + + if (nargout < 2) + retval(0) = eig_val; + else + { + retval(2) = double (info); + retval(1) = DiagMatrix (eig_val); + retval(0) = eig_vec; + } + } + else + { + ComplexMatrix eig_vec; + ComplexColumnVector eig_val; + + if (have_a_fun) + nconv = EigsRealNonSymmetricFunc + (eigs_func, n, typ, sigmar, k, p, info, eig_vec, eig_val, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else if (have_sigma) + { + if (a_is_sparse) + nconv = EigsRealNonSymmetricMatrixShift + (asmm, sigmar, k, p, info, eig_vec, eig_val, bsmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else + nconv = EigsRealNonSymmetricMatrixShift + (amm, sigmar, k, p, info, eig_vec, eig_val, bmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + } + else + { + if (a_is_sparse) + nconv = EigsRealNonSymmetricMatrix + (asmm, typ, k, p, info, eig_vec, eig_val, bsmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else + nconv = EigsRealNonSymmetricMatrix + (amm, typ, k, p, info, eig_vec, eig_val, bmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + } + + if (nargout < 2) + retval(0) = eig_val; + else + { + retval(2) = double (info); + retval(1) = ComplexDiagMatrix (eig_val); + retval(0) = eig_vec; + } + } + } + + if (nconv <= 0) + warning ("eigs: None of the %d requested eigenvalues converged", k); + else if (nconv < k) + warning ("eigs: Only %d of the %d requested eigenvalues converged", + nconv, k); + } + + if (! fcn_name.empty ()) + clear_function (fcn_name); +#else + error ("eigs: not available in this version of Octave"); +#endif + + return retval; +} + +/* #### SPARSE MATRIX VERSIONS #### */ + +/* +## Real positive definite tests, n must be even +%!shared n, k, A, d0, d2 +%! n = 20; +%! k = 4; +%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)]); +%! d0 = eig (A); +%! d2 = sort (d0); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); # initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (d1, d0(end:-1:(end-k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, "sm"); +%! assert (d1, d0(k:-1:1), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "la"); +%! assert (d1, d2(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sa"); +%! assert (d1, d2(1:k), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "be"); +%! assert (d1, d2([1:floor(k/2), (end - ceil(k/2) + 1):end]), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1, "be"); +%! assert (d1, d2([1:floor((k+1)/2), (end - ceil((k+1)/2) + 1):end]), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (d1(idx1), d0(idx0(1:k)), 1e-11); +%!testif HAVE_ARPACK, HAVE_CHOLMOD +%! d1 = eigs (A, speye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (eigs (A, k, 4.1), eigs (A, speye (n), k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (eigs (A, k, 4.1), eigs (A, speye (n), k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (d1, d0(k:-1:1), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (d1, eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! AA = speye (10); +%! fn = @(x) AA * x; +%! opts.issym = 1; opts.isreal = 1; +%! assert (eigs (fn, 10, AA, 3, "lm", opts), [1; 1; 1], 10*eps); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "la"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sa"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "be"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ + +/* +## Real unsymmetric tests +%!shared n, k, A, d0 +%! n = 20; +%! k = 4; +%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)]); +%! d0 = eig (A); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (d0)); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); +%!testif HAVE_ARPACK, HAVE_CHOLMOD +%! d1 = eigs (A, speye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, speye (n), k, 4.1)), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, speye (n), k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ + +/* +## Complex hermitian tests +%!shared n, k, A, d0 +%! n = 20; +%! k = 4; +%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)]); +%! d0 = eig (A); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); +%!testif HAVE_ARPACK, HAVE_CHOLMOD +%! d1 = eigs (A, speye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, speye (n), k, 4.1)), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, speye (n), k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ + +/* #### FULL MATRIX VERSIONS #### */ + +/* +## Real positive definite tests, n must be even +%!shared n, k, A, d0, d2 +%! n = 20; +%! k = 4; +%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)])); +%! d0 = eig (A); +%! d2 = sort (d0); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (d1, d0(end:-1:(end-k)),1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sm"); +%! assert (d1, d0(k:-1:1), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "la"); +%! assert (d1, d2(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sa"); +%! assert (d1, d2(1:k), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "be"); +%! assert (d1, d2([1:floor(k/2), (end - ceil(k/2) + 1):end]), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1, "be"); +%! assert (d1, d2([1:floor((k+1)/2), (end - ceil((k+1)/2) + 1):end]), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (d1(idx1), d0(idx0(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, eye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! assert (eigs (A, k, 4.1), eigs (A, eye (n), k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! assert (eigs (A, k, 4.1), eigs (A, eye (n), k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (d1, d0(k:-1:1), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (d1, eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "la"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sa"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "be"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ + +/* +## Real unsymmetric tests +%!shared n, k, A, d0 +%! n = 20; +%! k = 4; +%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)])); +%! d0 = eig (A); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (d0)); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, eye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, eye (n), k, 4.1)), 1e-11); +%!testif HAVE_ARPACK +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, eye (n), k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ + +/* +## Complex hermitian tests +%!shared n, k, A, d0 +%! n = 20; +%! k = 4; +%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)])); +%! d0 = eig (A); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, eye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, eye (n), k, 4.1)), 1e-11); +%!testif HAVE_ARPACK +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, eye (n), k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ diff -r d02b229ce693 -r a132d206a36a src/dldfcn/fftw.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/fftw.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,269 @@ +/* + +Copyright (C) 2006-2012 David Bateman + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "oct-fftw.h" + +#include "defun-dld.h" +#include "error.h" +#include "ov.h" + +DEFUN_DLD (fftw, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{method} =} fftw (\"planner\")\n\ +@deftypefnx {Loadable Function} {} fftw (\"planner\", @var{method})\n\ +@deftypefnx {Loadable Function} {@var{wisdom} =} fftw (\"dwisdom\")\n\ +@deftypefnx {Loadable Function} {} fftw (\"dwisdom\", @var{wisdom})\n\ +\n\ +Manage @sc{fftw} wisdom data. Wisdom data can be used to significantly\n\ +accelerate the calculation of the FFTs, but implies an initial cost\n\ +in its calculation. When the @sc{fftw} libraries are initialized, they read\n\ +a system wide wisdom file (typically in @file{/etc/fftw/wisdom}), allowing\n\ +wisdom to be shared between applications other than Octave. Alternatively,\n\ +the @code{fftw} function can be used to import wisdom. For example,\n\ +\n\ +@example\n\ +@var{wisdom} = fftw (\"dwisdom\")\n\ +@end example\n\ +\n\ +@noindent\n\ +will save the existing wisdom used by Octave to the string @var{wisdom}.\n\ +This string can then be saved to a file and restored using the @code{save}\n\ +and @code{load} commands respectively. This existing wisdom can be\n\ +reimported as follows\n\ +\n\ +@example\n\ +fftw (\"dwisdom\", @var{wisdom})\n\ +@end example\n\ +\n\ +If @var{wisdom} is an empty matrix, then the wisdom used is cleared.\n\ +\n\ +During the calculation of Fourier transforms further wisdom is generated.\n\ +The fashion in which this wisdom is generated is also controlled by\n\ +the @code{fftw} function. There are five different manners in which the\n\ +wisdom can be treated:\n\ +\n\ +@table @asis\n\ +@item \"estimate\"\n\ +Specifies that no run-time measurement of the optimal means of\n\ +calculating a particular is performed, and a simple heuristic is used\n\ +to pick a (probably sub-optimal) plan. The advantage of this method is\n\ +that there is little or no overhead in the generation of the plan, which\n\ +is appropriate for a Fourier transform that will be calculated once.\n\ +\n\ +@item \"measure\"\n\ +In this case a range of algorithms to perform the transform is considered\n\ +and the best is selected based on their execution time.\n\ +\n\ +@item \"patient\"\n\ +Similar to \"measure\", but a wider range of algorithms is considered.\n\ +\n\ +@item \"exhaustive\"\n\ +Like \"measure\", but all possible algorithms that may be used to\n\ +treat the transform are considered.\n\ +\n\ +@item \"hybrid\"\n\ +As run-time measurement of the algorithm can be expensive, this is a\n\ +compromise where \"measure\" is used for transforms up to the size of 8192\n\ +and beyond that the \"estimate\" method is used.\n\ +@end table\n\ +\n\ +The default method is \"estimate\". The current method can\n\ +be queried with\n\ +\n\ +@example\n\ +@var{method} = fftw (\"planner\")\n\ +@end example\n\ +\n\ +@noindent\n\ +or set by using\n\ +\n\ +@example\n\ +fftw (\"planner\", @var{method})\n\ +@end example\n\ +\n\ +Note that calculated wisdom will be lost when restarting Octave. However,\n\ +the wisdom data can be reloaded if it is saved to a file as described\n\ +above. Saved wisdom files should not be used on different platforms since\n\ +they will not be efficient and the point of calculating the wisdom is lost.\n\ +@seealso{fft, ifft, fft2, ifft2, fftn, ifftn}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 2) + { + print_usage (); + return retval; + } + +#if defined (HAVE_FFTW) + if (args(0).is_string ()) + { + std::string arg0 = args(0).string_value (); + + if (!error_state) + { + // Use STL function to convert to lower case + std::transform (arg0.begin (), arg0.end (), arg0.begin (), tolower); + + if (nargin == 2) + { + std::string arg1 = args(1).string_value (); + if (!error_state) + { + if (arg0 == "planner") + { + std::transform (arg1.begin (), arg1.end (), + arg1.begin (), tolower); + octave_fftw_planner::FftwMethod meth + = octave_fftw_planner::UNKNOWN; + octave_float_fftw_planner::FftwMethod methf + = octave_float_fftw_planner::UNKNOWN; + + if (arg1 == "estimate") + { + meth = octave_fftw_planner::ESTIMATE; + methf = octave_float_fftw_planner::ESTIMATE; + } + else if (arg1 == "measure") + { + meth = octave_fftw_planner::MEASURE; + methf = octave_float_fftw_planner::MEASURE; + } + else if (arg1 == "patient") + { + meth = octave_fftw_planner::PATIENT; + methf = octave_float_fftw_planner::PATIENT; + } + else if (arg1 == "exhaustive") + { + meth = octave_fftw_planner::EXHAUSTIVE; + methf = octave_float_fftw_planner::EXHAUSTIVE; + } + else if (arg1 == "hybrid") + { + meth = octave_fftw_planner::HYBRID; + methf = octave_float_fftw_planner::HYBRID; + } + else + error ("unrecognized planner METHOD"); + + if (!error_state) + { + meth = octave_fftw_planner::method (meth); + octave_float_fftw_planner::method (methf); + + if (meth == octave_fftw_planner::MEASURE) + retval = octave_value ("measure"); + else if (meth == octave_fftw_planner::PATIENT) + retval = octave_value ("patient"); + else if (meth == octave_fftw_planner::EXHAUSTIVE) + retval = octave_value ("exhaustive"); + else if (meth == octave_fftw_planner::HYBRID) + retval = octave_value ("hybrid"); + else + retval = octave_value ("estimate"); + } + } + else if (arg0 == "dwisdom") + { + char *str = fftw_export_wisdom_to_string (); + + if (arg1.length () < 1) + fftw_forget_wisdom (); + else if (! fftw_import_wisdom_from_string (arg1.c_str ())) + error ("could not import supplied WISDOM"); + + if (!error_state) + retval = octave_value (std::string (str)); + + free (str); + } + else if (arg0 == "swisdom") + { + char *str = fftwf_export_wisdom_to_string (); + + if (arg1.length () < 1) + fftwf_forget_wisdom (); + else if (! fftwf_import_wisdom_from_string (arg1.c_str ())) + error ("could not import supplied WISDOM"); + + if (!error_state) + retval = octave_value (std::string (str)); + + free (str); + } + else + error ("unrecognized argument"); + } + } + else + { + if (arg0 == "planner") + { + octave_fftw_planner::FftwMethod meth = + octave_fftw_planner::method (); + + if (meth == octave_fftw_planner::MEASURE) + retval = octave_value ("measure"); + else if (meth == octave_fftw_planner::PATIENT) + retval = octave_value ("patient"); + else if (meth == octave_fftw_planner::EXHAUSTIVE) + retval = octave_value ("exhaustive"); + else if (meth == octave_fftw_planner::HYBRID) + retval = octave_value ("hybrid"); + else + retval = octave_value ("estimate"); + } + else if (arg0 == "dwisdom") + { + char *str = fftw_export_wisdom_to_string (); + retval = octave_value (std::string (str)); + free (str); + } + else if (arg0 == "swisdom") + { + char *str = fftwf_export_wisdom_to_string (); + retval = octave_value (std::string (str)); + free (str); + } + else + error ("unrecognized argument"); + } + } + } +#else + + warning ("fftw: this copy of Octave was not configured to use the FFTW3 planner"); + +#endif + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/dldfcn/module-files --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/module-files Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,22 @@ +# FILE|CPPFLAGS|LDFLAGS|LIBRARIES +__delaunayn__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) +__dsearchn__.cc +__fltk_uigetfile__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) +__glpk__.cc|$(GLPK_CPPFLAGS)|$(GLPK_LDFLAGS)|$(GLPK_LIBS) +__init_fltk__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) +__init_gnuplot__.cc +__magick_read__.cc|$(MAGICK_CPPFLAGS)|$(MAGICK_LDFLAGS)|$(MAGICK_LIBS) +__voronoi__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) +amd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +ccolamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +chol.cc +colamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +convhulln.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) +dmperm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +eigs.cc|$(ARPACK_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(ARPACK_LDFLAGS) $(SPARSE_XLDFLAGS)|$(ARPACK_LIBS) $(SPARSE_XLIBS) $(LAPACK_LIBS) $(BLAS_LIBS) +fftw.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) +qr.cc|$(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(QRUPDATE_LDFLAGS) $(SPARSE_XLDFLAGS)|$(QRUPDATE_LIBS) $(SPARSE_XLIBS) +symbfact.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +symrcm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +tsearch.cc +urlwrite.cc|$(CURL_CPPFLAGS)|$(CURL_LDFLAGS)|$(CURL_LIBS) diff -r d02b229ce693 -r a132d206a36a src/dldfcn/oct-qhull.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/oct-qhull.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,60 @@ +/* + +Copyright (C) 2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_oct_qhull_h) +#define octave_oct_qhull_h 1 + +#include + +extern "C" { + +#if defined (HAVE_LIBQHULL_LIBQHULL_H) +# include +# include +# include +# include +# include +#elif defined (HAVE_QHULL_LIBQHULL_H) || defined (HAVE_QHULL_QHULL_H) +# if defined (HAVE_QHULL_LIBQHULL_H) +# include +# else +# include +# endif +# include +# include +# include +# include +#elif defined (HAVE_LIBQHULL_H) || defined (HAVE_QHULL_H) +# if defined (HAVE_LIBQHULL_H) +# include +# else +# include +# endif +# include +# include +# include +# include +#endif + +} + +#endif diff -r d02b229ce693 -r a132d206a36a src/dldfcn/qr.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/qr.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1598 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2008-2009 Jaroslav Hajek +Copyright (C) 2008-2009 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "CmplxQR.h" +#include "CmplxQRP.h" +#include "dbleQR.h" +#include "dbleQRP.h" +#include "fCmplxQR.h" +#include "fCmplxQRP.h" +#include "floatQR.h" +#include "floatQRP.h" +#include "SparseQR.h" +#include "SparseCmplxQR.h" + + +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "utils.h" + +template +static octave_value +get_qr_r (const base_qr& fact) +{ + MT R = fact.R (); + if (R.is_square () && fact.regular ()) + return octave_value (R, MatrixType (MatrixType::Upper)); + else + return R; +} + +// [Q, R] = qr (X): form Q unitary and R upper triangular such +// that Q * R = X +// +// [Q, R] = qr (X, 0): form the economy decomposition such that if X is +// m by n then only the first n columns of Q are +// computed. +// +// [Q, R, P] = qr (X): form QRP factorization of X where +// P is a permutation matrix such that +// A * P = Q * R +// +// [Q, R, P] = qr (X, 0): form the economy decomposition with +// permutation vector P such that Q * R = X (:, P) +// +// qr (X) alone returns the output of the LAPACK routine dgeqrf, such +// that R = triu (qr (X)) + +DEFUN_DLD (qr, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A})\n\ +@deftypefnx {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A}, '0')\n\ +@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B})\n\ +@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B}, '0')\n\ +@cindex QR factorization\n\ +Compute the QR@tie{}factorization of @var{A}, using standard @sc{lapack}\n\ +subroutines. For example, given the matrix @code{@var{A} = [1, 2; 3, 4]},\n\ +\n\ +@example\n\ +[@var{Q}, @var{R}] = qr (@var{A})\n\ +@end example\n\ +\n\ +@noindent\n\ +returns\n\ +\n\ +@example\n\ +@group\n\ +@var{Q} =\n\ +\n\ + -0.31623 -0.94868\n\ + -0.94868 0.31623\n\ +\n\ +@var{R} =\n\ +\n\ + -3.16228 -4.42719\n\ + 0.00000 -0.63246\n\ +@end group\n\ +@end example\n\ +\n\ +The @code{qr} factorization has applications in the solution of least\n\ +squares problems\n\ +@tex\n\ +$$\n\ +\\min_x \\left\\Vert A x - b \\right\\Vert_2\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +min norm(A x - b)\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +for overdetermined systems of equations (i.e.,\n\ +@tex\n\ +$A$\n\ +@end tex\n\ +@ifnottex\n\ +@var{A}\n\ +@end ifnottex\n\ + is a tall, thin matrix). The QR@tie{}factorization is\n\ +@tex\n\ +$QR = A$ where $Q$ is an orthogonal matrix and $R$ is upper triangular.\n\ +@end tex\n\ +@ifnottex\n\ +@code{@var{Q} * @var{Q} = @var{A}} where @var{Q} is an orthogonal matrix and\n\ +@var{R} is upper triangular.\n\ +@end ifnottex\n\ +\n\ +If given a second argument of '0', @code{qr} returns an economy-sized\n\ +QR@tie{}factorization, omitting zero rows of @var{R} and the corresponding\n\ +columns of @var{Q}.\n\ +\n\ +If the matrix @var{A} is full, the permuted QR@tie{}factorization\n\ +@code{[@var{Q}, @var{R}, @var{P}] = qr (@var{A})} forms the\n\ +QR@tie{}factorization such that the diagonal entries of @var{R} are\n\ +decreasing in magnitude order. For example, given the matrix @code{a = [1,\n\ +2; 3, 4]},\n\ +\n\ +@example\n\ +[@var{Q}, @var{R}, @var{P}] = qr (@var{A})\n\ +@end example\n\ +\n\ +@noindent\n\ +returns\n\ +\n\ +@example\n\ +@group\n\ +@var{Q} =\n\ +\n\ + -0.44721 -0.89443\n\ + -0.89443 0.44721\n\ +\n\ +@var{R} =\n\ +\n\ + -4.47214 -3.13050\n\ + 0.00000 0.44721\n\ +\n\ +@var{P} =\n\ +\n\ + 0 1\n\ + 1 0\n\ +@end group\n\ +@end example\n\ +\n\ +The permuted @code{qr} factorization @code{[@var{Q}, @var{R}, @var{P}] = qr\n\ +(@var{A})} factorization allows the construction of an orthogonal basis of\n\ +@code{span (A)}.\n\ +\n\ +If the matrix @var{A} is sparse, then compute the sparse\n\ +QR@tie{}factorization of @var{A}, using @sc{CSparse}. As the matrix @var{Q}\n\ +is in general a full matrix, this function returns the @var{Q}-less\n\ +factorization @var{R} of @var{A}, such that @code{@var{R} = chol (@var{A}' *\n\ +@var{A})}.\n\ +\n\ +If the final argument is the scalar @code{0} and the number of rows is\n\ +larger than the number of columns, then an economy factorization is\n\ +returned. That is @var{R} will have only @code{size (@var{A},1)} rows.\n\ +\n\ +If an additional matrix @var{B} is supplied, then @code{qr} returns\n\ +@var{C}, where @code{@var{C} = @var{Q}' * @var{B}}. This allows the\n\ +least squares approximation of @code{@var{A} \\ @var{B}} to be calculated\n\ +as\n\ +\n\ +@example\n\ +@group\n\ +[@var{C}, @var{R}] = qr (@var{A}, @var{B})\n\ +x = @var{R} \\ @var{C}\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > (args(0).is_sparse_type () ? 3 : 2)) + { + print_usage (); + return retval; + } + + octave_value arg = args(0); + + int arg_is_empty = empty_arg ("qr", arg.rows (), arg.columns ()); + + if (arg_is_empty < 0) + return retval; + + if (arg.is_sparse_type ()) + { + bool economy = false; + bool is_cmplx = false; + int have_b = 0; + + if (arg.is_complex_type ()) + is_cmplx = true; + if (nargin > 1) + { + have_b = 1; + if (args(nargin-1).is_scalar_type ()) + { + int val = args(nargin-1).int_value (); + if (val == 0) + { + economy = true; + have_b = (nargin > 2 ? 2 : 0); + } + } + if (have_b > 0 && args(have_b).is_complex_type ()) + is_cmplx = true; + } + + if (!error_state) + { + if (have_b && nargout < 2) + error ("qr: incorrect number of output arguments"); + else if (is_cmplx) + { + SparseComplexQR q (arg.sparse_complex_matrix_value ()); + if (!error_state) + { + if (have_b > 0) + { + retval(1) = q.R (economy); + retval(0) = q.C (args(have_b).complex_matrix_value ()); + if (arg.rows () < arg.columns ()) + warning ("qr: non minimum norm solution for under-determined problem"); + } + else if (nargout > 1) + { + retval(1) = q.R (economy); + retval(0) = q.Q (); + } + else + retval(0) = q.R (economy); + } + } + else + { + SparseQR q (arg.sparse_matrix_value ()); + if (!error_state) + { + if (have_b > 0) + { + retval(1) = q.R (economy); + retval(0) = q.C (args(have_b).matrix_value ()); + if (args(0).rows () < args(0).columns ()) + warning ("qr: non minimum norm solution for under-determined problem"); + } + else if (nargout > 1) + { + retval(1) = q.R (economy); + retval(0) = q.Q (); + } + else + retval(0) = q.R (economy); + } + } + } + } + else + { + QR::type type = (nargout == 0 || nargout == 1) ? QR::raw + : (nargin == 2 ? QR::economy : QR::std); + + if (arg.is_single_type ()) + { + if (arg.is_real_type ()) + { + FloatMatrix m = arg.float_matrix_value (); + + if (! error_state) + { + switch (nargout) + { + case 0: + case 1: + { + FloatQR fact (m, type); + retval(0) = fact.R (); + } + break; + + case 2: + { + FloatQR fact (m, type); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + + default: + { + FloatQRP fact (m, type); + if (type == QR::economy) + retval(2) = fact.Pvec (); + else + retval(2) = fact.P (); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + } + } + } + else if (arg.is_complex_type ()) + { + FloatComplexMatrix m = arg.float_complex_matrix_value (); + + if (! error_state) + { + switch (nargout) + { + case 0: + case 1: + { + FloatComplexQR fact (m, type); + retval(0) = fact.R (); + } + break; + + case 2: + { + FloatComplexQR fact (m, type); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + + default: + { + FloatComplexQRP fact (m, type); + if (type == QR::economy) + retval(2) = fact.Pvec (); + else + retval(2) = fact.P (); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + } + } + } + } + else + { + if (arg.is_real_type ()) + { + Matrix m = arg.matrix_value (); + + if (! error_state) + { + switch (nargout) + { + case 0: + case 1: + { + QR fact (m, type); + retval(0) = fact.R (); + } + break; + + case 2: + { + QR fact (m, type); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + + default: + { + QRP fact (m, type); + if (type == QR::economy) + retval(2) = fact.Pvec (); + else + retval(2) = fact.P (); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + } + } + } + else if (arg.is_complex_type ()) + { + ComplexMatrix m = arg.complex_matrix_value (); + + if (! error_state) + { + switch (nargout) + { + case 0: + case 1: + { + ComplexQR fact (m, type); + retval(0) = fact.R (); + } + break; + + case 2: + { + ComplexQR fact (m, type); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + + default: + { + ComplexQRP fact (m, type); + if (type == QR::economy) + retval(2) = fact.Pvec (); + else + retval(2) = fact.P (); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + } + } + } + else + gripe_wrong_type_arg ("qr", arg); + } + } + + return retval; +} + +/* +%!test +%! a = [0, 2, 1; 2, 1, 2]; +%! +%! [q, r] = qr (a); +%! [qe, re] = qr (a, 0); +%! +%! assert (q * r, a, sqrt (eps)); +%! assert (qe * re, a, sqrt (eps)); + +%!test +%! a = [0, 2, 1; 2, 1, 2]; +%! +%! [q, r, p] = qr (a); # FIXME: not giving right dimensions. +%! [qe, re, pe] = qr (a, 0); +%! +%! assert (q * r, a * p, sqrt (eps)); +%! assert (qe * re, a(:, pe), sqrt (eps)); + +%!test +%! a = [0, 2; 2, 1; 1, 2]; +%! +%! [q, r] = qr (a); +%! [qe, re] = qr (a, 0); +%! +%! assert (q * r, a, sqrt (eps)); +%! assert (qe * re, a, sqrt (eps)); + +%!test +%! a = [0, 2; 2, 1; 1, 2]; +%! +%! [q, r, p] = qr (a); +%! [qe, re, pe] = qr (a, 0); +%! +%! assert (q * r, a * p, sqrt (eps)); +%! assert (qe * re, a(:, pe), sqrt (eps)); + +%!error qr () +%!error qr ([1, 2; 3, 4], 0, 2) + +%!function retval = __testqr (q, r, a, p) +%! tol = 100*eps (class (q)); +%! retval = 0; +%! if (nargin == 3) +%! n1 = norm (q*r - a); +%! n2 = norm (q'*q - eye (columns (q))); +%! retval = (n1 < tol && n2 < tol); +%! else +%! n1 = norm (q'*q - eye (columns (q))); +%! retval = (n1 < tol); +%! if (isvector (p)) +%! n2 = norm (q*r - a(:,p)); +%! retval = (retval && n2 < tol); +%! else +%! n2 = norm (q*r - a*p); +%! retval = (retval && n2 < tol); +%! endif +%! endif +%!endfunction + +%!test +%! t = ones (24, 1); +%! j = 1; +%! +%! if (false) # eliminate big matrix tests +%! a = rand (5000, 20); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps; +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! endif +%! +%! a = [ ones(1,15); sqrt(eps)*eye(15) ]; +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps; +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); +%! +%! a = [ ones(1,15); sqrt(eps)*eye(15) ]; +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps; +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! +%! a = [ 611 196 -192 407 -8 -52 -49 29 +%! 196 899 113 -192 -71 -43 -8 -44 +%! -192 113 899 196 61 49 8 52 +%! 407 -192 196 611 8 44 59 -23 +%! -8 -71 61 8 411 -599 208 208 +%! -52 -43 49 44 -599 411 208 208 +%! -49 -8 8 59 208 208 99 -911 +%! 29 -44 52 -23 208 208 -911 99 ]; +%! [q,r] = qr (a); +%! +%! assert (all (t) && norm (q*r - a) < 5000*eps); + +%!test +%! a = single ([0, 2, 1; 2, 1, 2]); +%! +%! [q, r] = qr (a); +%! [qe, re] = qr (a, 0); +%! +%! assert (q * r, a, sqrt (eps ("single"))); +%! assert (qe * re, a, sqrt (eps ("single"))); + +%!test +%! a = single ([0, 2, 1; 2, 1, 2]); +%! +%! [q, r, p] = qr (a); # FIXME: not giving right dimensions. +%! [qe, re, pe] = qr (a, 0); +%! +%! assert (q * r, a * p, sqrt (eps ("single"))); +%! assert (qe * re, a(:, pe), sqrt (eps ("single"))); + +%!test +%! a = single ([0, 2; 2, 1; 1, 2]); +%! +%! [q, r] = qr (a); +%! [qe, re] = qr (a, 0); +%! +%! assert (q * r, a, sqrt (eps ("single"))); +%! assert (qe * re, a, sqrt (eps ("single"))); + +%!test +%! a = single ([0, 2; 2, 1; 1, 2]); +%! +%! [q, r, p] = qr (a); +%! [qe, re, pe] = qr (a, 0); +%! +%! assert (q * r, a * p, sqrt (eps ("single"))); +%! assert (qe * re, a(:, pe), sqrt (eps ("single"))); + +%!error qr () +%!error qr ([1, 2; 3, 4], 0, 2) + +%!test +%! t = ones (24, 1); +%! j = 1; +%! +%! if (false) # eliminate big matrix tests +%! a = rand (5000,20); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps ("single"); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! endif +%! +%! a = [ ones(1,15); sqrt(eps("single"))*eye(15) ]; +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps ("single"); +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); +%! +%! a = [ ones(1,15); sqrt(eps("single"))*eye(15) ]; +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps ("single"); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a',p); +%! +%! a = [ 611 196 -192 407 -8 -52 -49 29 +%! 196 899 113 -192 -71 -43 -8 -44 +%! -192 113 899 196 61 49 8 52 +%! 407 -192 196 611 8 44 59 -23 +%! -8 -71 61 8 411 -599 208 208 +%! -52 -43 49 44 -599 411 208 208 +%! -49 -8 8 59 208 208 99 -911 +%! 29 -44 52 -23 208 208 -911 99 ]; +%! [q,r] = qr (a); +%! +%! assert (all (t) && norm (q*r-a) < 5000*eps ("single")); + +## The deactivated tests below can't be tested till rectangular back-subs is +## implemented for sparse matrices. + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! r = qr (a); +%! assert (r'*r, a'*a, 1e-10) + +%!testif HAVE_COLAMD +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! q = symamd (a); +%! a = a(q,q); +%! r = qr (a); +%! assert (r'*r, a'*a, 1e-10) + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! [c,r] = qr (a, ones (n,1)); +%! assert (r\c, full (a)\ones (n,1), 10e-10) + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) + +%% Test under-determined systems!! +%!#testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = sprandn (n,n+1,d) + speye (n,n+1); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! r = qr (a); +%! assert (r'*r,a'*a,1e-10) + +%!testif HAVE_COLAMD +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! q = symamd (a); +%! a = a(q,q); +%! r = qr (a); +%! assert (r'*r, a'*a, 1e-10) + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! [c,r] = qr (a, ones (n,1)); +%! assert (r\c, full (a)\ones (n,1), 10e-10) + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) + +%% Test under-determined systems!! +%!#testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n+1,d) + speye (n,n+1); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) + +%!error qr (sprandn (10,10,0.2), ones (10,1)) +*/ + +static +bool check_qr_dims (const octave_value& q, const octave_value& r, + bool allow_ecf = false) +{ + octave_idx_type m = q.rows (), k = r.rows (), n = r.columns (); + return ((q.ndims () == 2 && r.ndims () == 2 && k == q.columns ()) + && (m == k || (allow_ecf && k == n && k < m))); +} + +static +bool check_index (const octave_value& i, bool vector_allowed = false) +{ + return ((i.is_real_type () || i.is_integer_type ()) + && (i.is_scalar_type () || vector_allowed)); +} + +DEFUN_DLD (qrupdate, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrupdate (@var{Q}, @var{R}, @var{u}, @var{v})\n\ +Given a QR@tie{}factorization of a real or complex matrix\n\ +@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ +@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization\n\ +of @w{@var{A} + @var{u}*@var{v}'}, where @var{u} and @var{v} are\n\ +column vectors (rank-1 update) or matrices with equal number of columns\n\ +(rank-k update). Notice that the latter case is done as a sequence of rank-1\n\ +updates; thus, for k large enough, it will be both faster and more accurate\n\ +to recompute the factorization from scratch.\n\ +\n\ +The QR@tie{}factorization supplied may be either full\n\ +(Q is square) or economized (R is square).\n\ +\n\ +@seealso{qr, qrinsert, qrdelete}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + octave_value_list retval; + + if (nargin != 4) + { + print_usage (); + return retval; + } + + octave_value argq = args(0); + octave_value argr = args(1); + octave_value argu = args(2); + octave_value argv = args(3); + + if (argq.is_numeric_type () && argr.is_numeric_type () + && argu.is_numeric_type () && argv.is_numeric_type ()) + { + if (check_qr_dims (argq, argr, true)) + { + if (argq.is_real_type () + && argr.is_real_type () + && argu.is_real_type () + && argv.is_real_type ()) + { + // all real case + if (argq.is_single_type () + || argr.is_single_type () + || argu.is_single_type () + || argv.is_single_type ()) + { + FloatMatrix Q = argq.float_matrix_value (); + FloatMatrix R = argr.float_matrix_value (); + FloatMatrix u = argu.float_matrix_value (); + FloatMatrix v = argv.float_matrix_value (); + + FloatQR fact (Q, R); + fact.update (u, v); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + Matrix Q = argq.matrix_value (); + Matrix R = argr.matrix_value (); + Matrix u = argu.matrix_value (); + Matrix v = argv.matrix_value (); + + QR fact (Q, R); + fact.update (u, v); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + else + { + // complex case + if (argq.is_single_type () + || argr.is_single_type () + || argu.is_single_type () + || argv.is_single_type ()) + { + FloatComplexMatrix Q = argq.float_complex_matrix_value (); + FloatComplexMatrix R = argr.float_complex_matrix_value (); + FloatComplexMatrix u = argu.float_complex_matrix_value (); + FloatComplexMatrix v = argv.float_complex_matrix_value (); + + FloatComplexQR fact (Q, R); + fact.update (u, v); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + ComplexMatrix Q = argq.complex_matrix_value (); + ComplexMatrix R = argr.complex_matrix_value (); + ComplexMatrix u = argu.complex_matrix_value (); + ComplexMatrix v = argv.complex_matrix_value (); + + ComplexQR fact (Q, R); + fact.update (u, v); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + } + else + error ("qrupdate: Q and R dimensions don't match"); + } + else + error ("qrupdate: Q, R, U, and V must be numeric"); + + return retval; +} + +/* +%!shared A, u, v, Ac, uc, vc +%! A = [0.091364 0.613038 0.999083; +%! 0.594638 0.425302 0.603537; +%! 0.383594 0.291238 0.085574; +%! 0.265712 0.268003 0.238409; +%! 0.669966 0.743851 0.445057 ]; +%! +%! u = [0.85082; +%! 0.76426; +%! 0.42883; +%! 0.53010; +%! 0.80683 ]; +%! +%! v = [0.98810; +%! 0.24295; +%! 0.43167 ]; +%! +%! Ac = [0.620405 + 0.956953i 0.480013 + 0.048806i 0.402627 + 0.338171i; +%! 0.589077 + 0.658457i 0.013205 + 0.279323i 0.229284 + 0.721929i; +%! 0.092758 + 0.345687i 0.928679 + 0.241052i 0.764536 + 0.832406i; +%! 0.912098 + 0.721024i 0.049018 + 0.269452i 0.730029 + 0.796517i; +%! 0.112849 + 0.603871i 0.486352 + 0.142337i 0.355646 + 0.151496i ]; +%! +%! uc = [0.20351 + 0.05401i; +%! 0.13141 + 0.43708i; +%! 0.29808 + 0.08789i; +%! 0.69821 + 0.38844i; +%! 0.74871 + 0.25821i ]; +%! +%! vc = [0.85839 + 0.29468i; +%! 0.20820 + 0.93090i; +%! 0.86184 + 0.34689i ]; +%! + +%!test +%! [Q,R] = qr (A); +%! [Q,R] = qrupdate (Q, R, u, v); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - A - u*v'), Inf) < norm (A)*1e1*eps); +%! +%!test +%! [Q,R] = qr (Ac); +%! [Q,R] = qrupdate (Q, R, uc, vc); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - Ac - uc*vc'), Inf) < norm (Ac)*1e1*eps); + +%!test +%! [Q,R] = qr (single (A)); +%! [Q,R] = qrupdate (Q, R, single (u), single (v)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - single (A) - single (u)*single (v)'), Inf) < norm (single (A))*1e1*eps ("single")); +%! +%!test +%! [Q,R] = qr (single (Ac)); +%! [Q,R] = qrupdate (Q, R, single (uc), single (vc)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - single (Ac) - single (uc)*single (vc)'), Inf) < norm (single (Ac))*1e1*eps ("single")); +*/ + +DEFUN_DLD (qrinsert, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrinsert (@var{Q}, @var{R}, @var{j}, @var{x}, @var{orient})\n\ +Given a QR@tie{}factorization of a real or complex matrix\n\ +@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ +@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization of\n\ +@w{[A(:,1:j-1) x A(:,j:n)]}, where @var{u} is a column vector to be\n\ +inserted into @var{A} (if @var{orient} is @code{\"col\"}), or the\n\ +QR@tie{}factorization of @w{[A(1:j-1,:);x;A(:,j:n)]}, where @var{x}\n\ +is a row vector to be inserted into @var{A} (if @var{orient} is\n\ +@code{\"row\"}).\n\ +\n\ +The default value of @var{orient} is @code{\"col\"}.\n\ +If @var{orient} is @code{\"col\"},\n\ +@var{u} may be a matrix and @var{j} an index vector\n\ +resulting in the QR@tie{}factorization of a matrix @var{B} such that\n\ +@w{B(:,@var{j})} gives @var{u} and @w{B(:,@var{j}) = []} gives @var{A}.\n\ +Notice that the latter case is done as a sequence of k insertions;\n\ +thus, for k large enough, it will be both faster and more accurate to\n\ +recompute the factorization from scratch.\n\ +\n\ +If @var{orient} is @code{\"col\"},\n\ +the QR@tie{}factorization supplied may be either full\n\ +(Q is square) or economized (R is square).\n\ +\n\ +If @var{orient} is @code{\"row\"}, full factorization is needed.\n\ +@seealso{qr, qrupdate, qrdelete}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + octave_value_list retval; + + if (nargin < 4 || nargin > 5) + { + print_usage (); + return retval; + } + + octave_value argq = args(0); + octave_value argr = args(1); + octave_value argj = args(2); + octave_value argx = args(3); + + if (argq.is_numeric_type () && argr.is_numeric_type () + && argx.is_numeric_type () + && (nargin < 5 || args(4).is_string ())) + { + std::string orient = (nargin < 5) ? "col" : args(4).string_value (); + + bool col = orient == "col"; + + if (col || orient == "row") + if (check_qr_dims (argq, argr, col) + && (col || argx.rows () == 1)) + { + if (check_index (argj, col)) + { + MArray j + = argj.octave_idx_type_vector_value (); + + octave_idx_type one = 1; + + if (argq.is_real_type () + && argr.is_real_type () + && argx.is_real_type ()) + { + // real case + if (argq.is_single_type () + || argr.is_single_type () + || argx.is_single_type ()) + { + FloatMatrix Q = argq.float_matrix_value (); + FloatMatrix R = argr.float_matrix_value (); + FloatMatrix x = argx.float_matrix_value (); + + FloatQR fact (Q, R); + + if (col) + fact.insert_col (x, j-one); + else + fact.insert_row (x.row (0), j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + + } + else + { + Matrix Q = argq.matrix_value (); + Matrix R = argr.matrix_value (); + Matrix x = argx.matrix_value (); + + QR fact (Q, R); + + if (col) + fact.insert_col (x, j-one); + else + fact.insert_row (x.row (0), j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + + } + } + else + { + // complex case + if (argq.is_single_type () + || argr.is_single_type () + || argx.is_single_type ()) + { + FloatComplexMatrix Q = argq.float_complex_matrix_value (); + FloatComplexMatrix R = argr.float_complex_matrix_value (); + FloatComplexMatrix x = argx.float_complex_matrix_value (); + + FloatComplexQR fact (Q, R); + + if (col) + fact.insert_col (x, j-one); + else + fact.insert_row (x.row (0), j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + ComplexMatrix Q = argq.complex_matrix_value (); + ComplexMatrix R = argr.complex_matrix_value (); + ComplexMatrix x = argx.complex_matrix_value (); + + ComplexQR fact (Q, R); + + if (col) + fact.insert_col (x, j-one); + else + fact.insert_row (x.row (0), j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + + } + else + error ("qrinsert: invalid index J"); + } + else + error ("qrinsert: dimension mismatch"); + + else + error ("qrinsert: ORIENT must be \"col\" or \"row\""); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! [Q,R] = qr (A); +%! [Q,R] = qrinsert (Q, R, 3, u); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [A(:,1:2) u A(:,3)]), Inf) < norm (A)*1e1*eps); +%!test +%! [Q,R] = qr (Ac); +%! [Q,R] = qrinsert (Q, R, 3, uc); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [Ac(:,1:2) uc Ac(:,3)]), Inf) < norm (Ac)*1e1*eps); +%!test +%! x = [0.85082 0.76426 0.42883 ]; +%! +%! [Q,R] = qr (A); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [A(1:2,:);x;A(3:5,:)]), Inf) < norm (A)*1e1*eps); +%!test +%! x = [0.20351 + 0.05401i 0.13141 + 0.43708i 0.29808 + 0.08789i ]; +%! +%! [Q,R] = qr (Ac); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [Ac(1:2,:);x;Ac(3:5,:)]), Inf) < norm (Ac)*1e1*eps); + +%!test +%! [Q,R] = qr (single (A)); +%! [Q,R] = qrinsert (Q, R, 3, single (u)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([A(:,1:2) u A(:,3)])), Inf) < norm (single (A))*1e1*eps ("single")); +%!test +%! [Q,R] = qr (single (Ac)); +%! [Q,R] = qrinsert (Q, R, 3, single (uc)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([Ac(:,1:2) uc Ac(:,3)])), Inf) < norm (single (Ac))*1e1*eps ("single")); +%!test +%! x = single ([0.85082 0.76426 0.42883 ]); +%! +%! [Q,R] = qr (single (A)); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([A(1:2,:);x;A(3:5,:)])), Inf) < norm (single (A))*1e1*eps ("single")); +%!test +%! x = single ([0.20351 + 0.05401i 0.13141 + 0.43708i 0.29808 + 0.08789i ]); +%! +%! [Q,R] = qr (single (Ac)); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([Ac(1:2,:);x;Ac(3:5,:)])), Inf) < norm (single (Ac))*1e1*eps ("single")); +*/ + +DEFUN_DLD (qrdelete, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrdelete (@var{Q}, @var{R}, @var{j}, @var{orient})\n\ +Given a QR@tie{}factorization of a real or complex matrix\n\ +@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ +@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization of\n\ +@w{[A(:,1:j-1) A(:,j+1:n)]}, i.e., @var{A} with one column deleted\n\ +(if @var{orient} is \"col\"), or the QR@tie{}factorization of\n\ +@w{[A(1:j-1,:);A(j+1:n,:)]}, i.e., @var{A} with one row deleted (if\n\ +@var{orient} is \"row\").\n\ +\n\ +The default value of @var{orient} is \"col\".\n\ +\n\ +If @var{orient} is @code{\"col\"},\n\ +@var{j} may be an index vector\n\ +resulting in the QR@tie{}factorization of a matrix @var{B} such that\n\ +@w{A(:,@var{j}) = []} gives @var{B}.\n\ +Notice that the latter case is done as a sequence of k deletions;\n\ +thus, for k large enough, it will be both faster and more accurate to\n\ +recompute the factorization from scratch.\n\ +\n\ +If @var{orient} is @code{\"col\"},\n\ +the QR@tie{}factorization supplied may be either full\n\ +(Q is square) or economized (R is square).\n\ +\n\ +If @var{orient} is @code{\"row\"}, full factorization is needed.\n\ +@seealso{qr, qrinsert, qrupdate}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + octave_value_list retval; + + if (nargin < 3 || nargin > 4) + { + print_usage (); + return retval; + } + + octave_value argq = args(0); + octave_value argr = args(1); + octave_value argj = args(2); + + if (argq.is_numeric_type () && argr.is_numeric_type () + && (nargin < 4 || args(3).is_string ())) + { + std::string orient = (nargin < 4) ? "col" : args(3).string_value (); + + bool col = orient == "col"; + + if (col || orient == "row") + if (check_qr_dims (argq, argr, col)) + { + if (check_index (argj, col)) + { + MArray j + = argj.octave_idx_type_vector_value (); + + octave_idx_type one = 1; + + if (argq.is_real_type () + && argr.is_real_type ()) + { + // real case + if (argq.is_single_type () + || argr.is_single_type ()) + { + FloatMatrix Q = argq.float_matrix_value (); + FloatMatrix R = argr.float_matrix_value (); + + FloatQR fact (Q, R); + + if (col) + fact.delete_col (j-one); + else + fact.delete_row (j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + Matrix Q = argq.matrix_value (); + Matrix R = argr.matrix_value (); + + QR fact (Q, R); + + if (col) + fact.delete_col (j-one); + else + fact.delete_row (j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + else + { + // complex case + if (argq.is_single_type () + || argr.is_single_type ()) + { + FloatComplexMatrix Q = argq.float_complex_matrix_value (); + FloatComplexMatrix R = argr.float_complex_matrix_value (); + + FloatComplexQR fact (Q, R); + + if (col) + fact.delete_col (j-one); + else + fact.delete_row (j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + ComplexMatrix Q = argq.complex_matrix_value (); + ComplexMatrix R = argr.complex_matrix_value (); + + ComplexQR fact (Q, R); + + if (col) + fact.delete_col (j-one); + else + fact.delete_row (j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + } + else + error ("qrdelete: invalid index J"); + } + else + error ("qrdelete: dimension mismatch"); + + else + error ("qrdelete: ORIENT must be \"col\" or \"row\""); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! AA = [0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 16*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps); +%! +%!test +%! AA = [0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; +%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; +%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; +%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; +%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ] * I; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 16*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps); +%! +%!test +%! AA = [0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps); +%! +%!test +%! AA = [0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; +%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; +%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; +%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; +%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ] * I; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps); + +%!test +%! AA = single ([0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]); +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps ("single")); +%! +%!test +%! AA = single ([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; +%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; +%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; +%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; +%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ]) * I; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps ("single")); +%! +%!test +%! AA = single ([0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]); +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1.5e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); +%!testif HAVE_QRUPDATE +%! # Same test as above but with more precicision +%! AA = single ([0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]); +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); +%! +%!test +%! AA = single ([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; +%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; +%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; +%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; +%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ]) * I; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); +*/ + +DEFUN_DLD (qrshift, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrshift (@var{Q}, @var{R}, @var{i}, @var{j})\n\ +Given a QR@tie{}factorization of a real or complex matrix\n\ +@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ +@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization\n\ +of @w{@var{A}(:,p)}, where @w{p} is the permutation @*\n\ +@code{p = [1:i-1, shift(i:j, 1), j+1:n]} if @w{@var{i} < @var{j}} @*\n\ + or @*\n\ +@code{p = [1:j-1, shift(j:i,-1), i+1:n]} if @w{@var{j} < @var{i}}. @*\n\ +\n\ +@seealso{qr, qrinsert, qrdelete}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + octave_value_list retval; + + if (nargin != 4) + { + print_usage (); + return retval; + } + + octave_value argq = args(0); + octave_value argr = args(1); + octave_value argi = args(2); + octave_value argj = args(3); + + if (argq.is_numeric_type () && argr.is_numeric_type ()) + { + if (check_qr_dims (argq, argr, true)) + { + if (check_index (argi) && check_index (argj)) + { + octave_idx_type i = argi.int_value (); + octave_idx_type j = argj.int_value (); + + if (argq.is_real_type () + && argr.is_real_type ()) + { + // all real case + if (argq.is_single_type () + && argr.is_single_type ()) + { + FloatMatrix Q = argq.float_matrix_value (); + FloatMatrix R = argr.float_matrix_value (); + + FloatQR fact (Q, R); + fact.shift_cols (i-1, j-1); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + Matrix Q = argq.matrix_value (); + Matrix R = argr.matrix_value (); + + QR fact (Q, R); + fact.shift_cols (i-1, j-1); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + else + { + // complex case + if (argq.is_single_type () + && argr.is_single_type ()) + { + FloatComplexMatrix Q = argq.float_complex_matrix_value (); + FloatComplexMatrix R = argr.float_complex_matrix_value (); + + FloatComplexQR fact (Q, R); + fact.shift_cols (i-1, j-1); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + ComplexMatrix Q = argq.complex_matrix_value (); + ComplexMatrix R = argr.complex_matrix_value (); + + ComplexQR fact (Q, R); + fact.shift_cols (i-1, j-1); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + } + else + error ("qrshift: invalid index I or J"); + } + else + error ("qrshift: dimensions mismatch"); + } + else + error ("qrshift: Q and R must be numeric"); + + return retval; +} + +/* +%!test +%! AA = A.'; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); +%! +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); +%! +%!test +%! AA = Ac.'; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); +%! +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); + +%!test +%! AA = single (A).'; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); +%! +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); +%! +%!test +%! AA = single (Ac).'; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); +%! +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); +*/ diff -r d02b229ce693 -r a132d206a36a src/dldfcn/symbfact.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/symbfact.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,363 @@ +/* + +Copyright (C) 2005-2012 David Bateman +Copyright (C) 1998-2005 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "SparseCmplxCHOL.h" +#include "SparsedbleCHOL.h" +#include "oct-spparms.h" +#include "sparse-util.h" +#include "oct-locbuf.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "utils.h" + +DEFUN_DLD (symbfact, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{count}, @var{h}, @var{parent}, @var{post}, @var{r}] =} symbfact (@var{S})\n\ +@deftypefnx {Loadable Function} {[@dots{}] =} symbfact (@var{S}, @var{typ})\n\ +@deftypefnx {Loadable Function} {[@dots{}] =} symbfact (@var{S}, @var{typ}, @var{mode})\n\ +\n\ +Perform a symbolic factorization analysis on the sparse matrix @var{S}.\n\ +Where\n\ +\n\ +@table @var\n\ +@item S\n\ +@var{S} is a complex or real sparse matrix.\n\ +\n\ +@item typ\n\ +Is the type of the factorization and can be one of\n\ +\n\ +@table @samp\n\ +@item sym\n\ +Factorize @var{S}. This is the default.\n\ +\n\ +@item col\n\ +Factorize @code{@var{S}' * @var{S}}.\n\ +\n\ +@item row\n\ +Factorize @xcode{@var{S} * @var{S}'}.\n\ +\n\ +@item lo\n\ +Factorize @xcode{@var{S}'}\n\ +@end table\n\ +\n\ +@item mode\n\ +The default is to return the Cholesky@tie{}factorization for @var{r}, and if\n\ +@var{mode} is 'L', the conjugate transpose of the Cholesky@tie{}factorization\n\ +is returned. The conjugate transpose version is faster and uses less\n\ +memory, but returns the same values for @var{count}, @var{h}, @var{parent}\n\ +and @var{post} outputs.\n\ +@end table\n\ +\n\ +The output variables are\n\ +\n\ +@table @var\n\ +@item count\n\ +The row counts of the Cholesky@tie{}factorization as determined by @var{typ}.\n\ +\n\ +@item h\n\ +The height of the elimination tree.\n\ +\n\ +@item parent\n\ +The elimination tree itself.\n\ +\n\ +@item post\n\ +A sparse boolean matrix whose structure is that of the Cholesky\n\ +factorization as determined by @var{typ}.\n\ +@end table\n\ +@end deftypefn") +{ + octave_value_list retval; + int nargin = args.length (); + + if (nargin < 1 || nargin > 3 || nargout > 5) + { + print_usage (); + return retval; + } + +#ifdef HAVE_CHOLMOD + + cholmod_common Common; + cholmod_common *cm = &Common; + CHOLMOD_NAME(start) (cm); + + double spu = octave_sparse_params::get_key ("spumoni"); + if (spu == 0.) + { + cm->print = -1; + cm->print_function = 0; + } + else + { + cm->print = static_cast (spu) + 2; + cm->print_function =&SparseCholPrint; + } + + cm->error_handler = &SparseCholError; + cm->complex_divide = CHOLMOD_NAME(divcomplex); + cm->hypotenuse = CHOLMOD_NAME(hypot); + + double dummy; + cholmod_sparse Astore; + cholmod_sparse *A = &Astore; + A->packed = true; + A->sorted = true; + A->nz = 0; +#ifdef IDX_TYPE_LONG + A->itype = CHOLMOD_LONG; +#else + A->itype = CHOLMOD_INT; +#endif + A->dtype = CHOLMOD_DOUBLE; + A->stype = 1; + A->x = &dummy; + + if (args(0).is_real_type ()) + { + const SparseMatrix a = args(0).sparse_matrix_value (); + A->nrow = a.rows (); + A->ncol = a.cols (); + A->p = a.cidx (); + A->i = a.ridx (); + A->nzmax = a.nnz (); + A->xtype = CHOLMOD_REAL; + + if (a.rows () > 0 && a.cols () > 0) + A->x = a.data (); + } + else if (args(0).is_complex_type ()) + { + const SparseComplexMatrix a = args(0).sparse_complex_matrix_value (); + A->nrow = a.rows (); + A->ncol = a.cols (); + A->p = a.cidx (); + A->i = a.ridx (); + A->nzmax = a.nnz (); + A->xtype = CHOLMOD_COMPLEX; + + if (a.rows () > 0 && a.cols () > 0) + A->x = a.data (); + } + else + gripe_wrong_type_arg ("symbfact", args(0)); + + octave_idx_type coletree = false; + octave_idx_type n = A->nrow; + + if (nargin > 1) + { + char ch; + std::string str = args(1).string_value (); + ch = tolower (str.c_str ()[0]); + if (ch == 'r') + A->stype = 0; + else if (ch == 'c') + { + n = A->ncol; + coletree = true; + A->stype = 0; + } + else if (ch == 's') + A->stype = 1; + else if (ch == 's') + A->stype = -1; + else + error ("symbfact: unrecognized TYP in symbolic factorization"); + } + + if (A->stype && A->nrow != A->ncol) + error ("symbfact: S must be a square matrix"); + + if (!error_state) + { + OCTAVE_LOCAL_BUFFER (octave_idx_type, Parent, n); + OCTAVE_LOCAL_BUFFER (octave_idx_type, Post, n); + OCTAVE_LOCAL_BUFFER (octave_idx_type, ColCount, n); + OCTAVE_LOCAL_BUFFER (octave_idx_type, First, n); + OCTAVE_LOCAL_BUFFER (octave_idx_type, Level, n); + + cholmod_sparse *F = CHOLMOD_NAME(transpose) (A, 0, cm); + cholmod_sparse *Aup, *Alo; + + if (A->stype == 1 || coletree) + { + Aup = A ; + Alo = F ; + } + else + { + Aup = F ; + Alo = A ; + } + + CHOLMOD_NAME(etree) (Aup, Parent, cm); + + if (cm->status < CHOLMOD_OK) + { + error ("matrix corrupted"); + goto symbfact_error; + } + + if (CHOLMOD_NAME(postorder) (Parent, n, 0, Post, cm) != n) + { + error ("postorder failed"); + goto symbfact_error; + } + + CHOLMOD_NAME(rowcolcounts) (Alo, 0, 0, Parent, Post, 0, + ColCount, First, Level, cm); + + if (cm->status < CHOLMOD_OK) + { + error ("matrix corrupted"); + goto symbfact_error; + } + + if (nargout > 4) + { + cholmod_sparse *A1, *A2; + + if (A->stype == 1) + { + A1 = A; + A2 = 0; + } + else if (A->stype == -1) + { + A1 = F; + A2 = 0; + } + else if (coletree) + { + A1 = F; + A2 = A; + } + else + { + A1 = A; + A2 = F; + } + + // count the total number of entries in L + octave_idx_type lnz = 0 ; + for (octave_idx_type j = 0 ; j < n ; j++) + lnz += ColCount[j]; + + + // allocate the output matrix L (pattern-only) + SparseBoolMatrix L (n, n, lnz); + + // initialize column pointers + lnz = 0; + for (octave_idx_type j = 0 ; j < n ; j++) + { + L.xcidx(j) = lnz; + lnz += ColCount[j]; + } + L.xcidx(n) = lnz; + + + /* create a copy of the column pointers */ + octave_idx_type *W = First; + for (octave_idx_type j = 0 ; j < n ; j++) + W[j] = L.xcidx (j); + + // get workspace for computing one row of L + cholmod_sparse *R = cholmod_allocate_sparse (n, 1, n, false, true, + 0, CHOLMOD_PATTERN, cm); + octave_idx_type *Rp = static_cast(R->p); + octave_idx_type *Ri = static_cast(R->i); + + // compute L one row at a time + for (octave_idx_type k = 0 ; k < n ; k++) + { + // get the kth row of L and store in the columns of L + CHOLMOD_NAME (row_subtree) (A1, A2, k, Parent, R, cm) ; + for (octave_idx_type p = 0 ; p < Rp[1] ; p++) + L.xridx (W[Ri[p]]++) = k ; + + // add the diagonal entry + L.xridx (W[k]++) = k ; + } + + // free workspace + cholmod_free_sparse (&R, cm) ; + + + // transpose L to get R, or leave as is + if (nargin < 3) + L = L.transpose (); + + // fill numerical values of L with one's + for (octave_idx_type p = 0 ; p < lnz ; p++) + L.xdata(p) = true; + + retval(4) = L; + } + + ColumnVector tmp (n); + if (nargout > 3) + { + for (octave_idx_type i = 0; i < n; i++) + tmp(i) = Post[i] + 1; + retval(3) = tmp; + } + + if (nargout > 2) + { + for (octave_idx_type i = 0; i < n; i++) + tmp(i) = Parent[i] + 1; + retval(2) = tmp; + } + + if (nargout > 1) + { + /* compute the elimination tree height */ + octave_idx_type height = 0 ; + for (int i = 0 ; i < n ; i++) + height = (height > Level[i] ? height : Level[i]); + height++ ; + retval(1) = static_cast (height); + } + + for (octave_idx_type i = 0; i < n; i++) + tmp(i) = ColCount[i]; + retval(0) = tmp; + } + + symbfact_error: +#else + error ("symbfact: not available in this version of Octave"); +#endif + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/dldfcn/symrcm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/symrcm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,702 @@ +/* + +Copyright (C) 2007-2012 Michael Weitzel + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* +An implementation of the Reverse Cuthill-McKee algorithm (symrcm) + +The implementation of this algorithm is based in the descriptions found in + +@INPROCEEDINGS{, + author = {E. Cuthill and J. McKee}, + title = {Reducing the Bandwidth of Sparse Symmetric Matrices}, + booktitle = {Proceedings of the 24th ACM National Conference}, + publisher = {Brandon Press}, + pages = {157 -- 172}, + location = {New Jersey}, + year = {1969} +} + +@BOOK{, + author = {Alan George and Joseph W. H. Liu}, + title = {Computer Solution of Large Sparse Positive Definite Systems}, + publisher = {Prentice Hall Series in Computational Mathematics}, + ISBN = {0-13-165274-5}, + year = {1981} +} + +The algorithm represents a heuristic approach to the NP-complete minimum +bandwidth problem. + +Written by Michael Weitzel + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "ov.h" +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "utils.h" +#include "oct-locbuf.h" + +#include "ov-re-mat.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "oct-sparse.h" + +// A node struct for the Cuthill-McKee algorithm +struct CMK_Node +{ + // the node's id (matrix row index) + octave_idx_type id; + // the node's degree + octave_idx_type deg; + // minimal distance to the root of the spanning tree + octave_idx_type dist; +}; + +// A simple queue. +// Queues Q have a fixed maximum size N (rows,cols of the matrix) and are +// stored in an array. qh and qt point to queue head and tail. + +// Enqueue operation (adds a node "o" at the tail) + +inline static void +Q_enq (CMK_Node *Q, octave_idx_type N, octave_idx_type& qt, const CMK_Node& o) +{ + Q[qt] = o; + qt = (qt + 1) % (N + 1); +} + +// Dequeue operation (removes a node from the head) + +inline static CMK_Node +Q_deq (CMK_Node * Q, octave_idx_type N, octave_idx_type& qh) +{ + CMK_Node r = Q[qh]; + qh = (qh + 1) % (N + 1); + return r; +} + +// Predicate (queue empty) +#define Q_empty(Q, N, qh, qt) ((qh) == (qt)) + +// A simple, array-based binary heap (used as a priority queue for nodes) + +// the left descendant of entry i +#define LEFT(i) (((i) << 1) + 1) // = (2*(i)+1) +// the right descendant of entry i +#define RIGHT(i) (((i) << 1) + 2) // = (2*(i)+2) +// the parent of entry i +#define PARENT(i) (((i) - 1) >> 1) // = floor(((i)-1)/2) + +// Builds a min-heap (the root contains the smallest element). A is an array +// with the graph's nodes, i is a starting position, size is the length of A. + +static void +H_heapify_min (CMK_Node *A, octave_idx_type i, octave_idx_type size) +{ + octave_idx_type j = i; + for (;;) + { + octave_idx_type l = LEFT(j); + octave_idx_type r = RIGHT(j); + + octave_idx_type smallest; + if (l < size && A[l].deg < A[j].deg) + smallest = l; + else + smallest = j; + + if (r < size && A[r].deg < A[smallest].deg) + smallest = r; + + if (smallest != j) + { + std::swap (A[j], A[smallest]); + j = smallest; + } + else + break; + } +} + +// Heap operation insert. Running time is O(log(n)) + +static void +H_insert (CMK_Node *H, octave_idx_type& h, const CMK_Node& o) +{ + octave_idx_type i = h++; + + H[i] = o; + + if (i == 0) + return; + do + { + octave_idx_type p = PARENT(i); + if (H[i].deg < H[p].deg) + { + std::swap (H[i], H[p]); + + i = p; + } + else + break; + } + while (i > 0); +} + +// Heap operation remove-min. Removes the smalles element in O(1) and +// reorganizes the heap optionally in O(log(n)) + +inline static CMK_Node +H_remove_min (CMK_Node *H, octave_idx_type& h, int reorg/*=1*/) +{ + CMK_Node r = H[0]; + H[0] = H[--h]; + if (reorg) + H_heapify_min (H, 0, h); + return r; +} + +// Predicate (heap empty) +#define H_empty(H, h) ((h) == 0) + +// Helper function for the Cuthill-McKee algorithm. Tries to determine a +// pseudo-peripheral node of the graph as starting node. + +static octave_idx_type +find_starting_node (octave_idx_type N, const octave_idx_type *ridx, + const octave_idx_type *cidx, const octave_idx_type *ridx2, + const octave_idx_type *cidx2, octave_idx_type *D, + octave_idx_type start) +{ + CMK_Node w; + + OCTAVE_LOCAL_BUFFER (CMK_Node, Q, N+1); + boolNDArray btmp (dim_vector (1, N), false); + bool *visit = btmp.fortran_vec (); + + octave_idx_type qh = 0; + octave_idx_type qt = 0; + CMK_Node x; + x.id = start; + x.deg = D[start]; + x.dist = 0; + Q_enq (Q, N, qt, x); + visit[start] = true; + + // distance level + octave_idx_type level = 0; + // current largest "eccentricity" + octave_idx_type max_dist = 0; + + for (;;) + { + while (! Q_empty (Q, N, qh, qt)) + { + CMK_Node v = Q_deq (Q, N, qh); + + if (v.dist > x.dist || (v.id != x.id && v.deg > x.deg)) + x = v; + + octave_idx_type i = v.id; + + // add all unvisited neighbors to the queue + octave_idx_type j1 = cidx[i]; + octave_idx_type j2 = cidx2[i]; + while (j1 < cidx[i+1] || j2 < cidx2[i+1]) + { + OCTAVE_QUIT; + + if (j1 == cidx[i+1]) + { + octave_idx_type r2 = ridx2[j2++]; + if (! visit[r2]) + { + // the distance of node j is dist(i)+1 + w.id = r2; + w.deg = D[r2]; + w.dist = v.dist+1; + Q_enq (Q, N, qt, w); + visit[r2] = true; + + if (w.dist > level) + level = w.dist; + } + } + else if (j2 == cidx2[i+1]) + { + octave_idx_type r1 = ridx[j1++]; + if (! visit[r1]) + { + // the distance of node j is dist(i)+1 + w.id = r1; + w.deg = D[r1]; + w.dist = v.dist+1; + Q_enq (Q, N, qt, w); + visit[r1] = true; + + if (w.dist > level) + level = w.dist; + } + } + else + { + octave_idx_type r1 = ridx[j1]; + octave_idx_type r2 = ridx2[j2]; + if (r1 <= r2) + { + if (! visit[r1]) + { + w.id = r1; + w.deg = D[r1]; + w.dist = v.dist+1; + Q_enq (Q, N, qt, w); + visit[r1] = true; + + if (w.dist > level) + level = w.dist; + } + j1++; + if (r1 == r2) + j2++; + } + else + { + if (! visit[r2]) + { + w.id = r2; + w.deg = D[r2]; + w.dist = v.dist+1; + Q_enq (Q, N, qt, w); + visit[r2] = true; + + if (w.dist > level) + level = w.dist; + } + j2++; + } + } + } + } // finish of BFS + + if (max_dist < x.dist) + { + max_dist = x.dist; + + for (octave_idx_type i = 0; i < N; i++) + visit[i] = false; + + visit[x.id] = true; + x.dist = 0; + qt = qh = 0; + Q_enq (Q, N, qt, x); + } + else + break; + } + return x.id; +} + +// Calculates the node's degrees. This means counting the non-zero elements +// in the symmetric matrix' rows. This works for non-symmetric matrices +// as well. + +static octave_idx_type +calc_degrees (octave_idx_type N, const octave_idx_type *ridx, + const octave_idx_type *cidx, octave_idx_type *D) +{ + octave_idx_type max_deg = 0; + + for (octave_idx_type i = 0; i < N; i++) + D[i] = 0; + + for (octave_idx_type j = 0; j < N; j++) + { + for (octave_idx_type i = cidx[j]; i < cidx[j+1]; i++) + { + OCTAVE_QUIT; + octave_idx_type k = ridx[i]; + // there is a non-zero element (k,j) + D[k]++; + if (D[k] > max_deg) + max_deg = D[k]; + // if there is no element (j,k) there is one in + // the symmetric matrix: + if (k != j) + { + bool found = false; + for (octave_idx_type l = cidx[k]; l < cidx[k + 1]; l++) + { + OCTAVE_QUIT; + + if (ridx[l] == j) + { + found = true; + break; + } + else if (ridx[l] > j) + break; + } + + if (! found) + { + // A(j,k) == 0 + D[j]++; + if (D[j] > max_deg) + max_deg = D[j]; + } + } + } + } + return max_deg; +} + +// Transpose of the structure of a square sparse matrix + +static void +transpose (octave_idx_type N, const octave_idx_type *ridx, + const octave_idx_type *cidx, octave_idx_type *ridx2, + octave_idx_type *cidx2) +{ + octave_idx_type nz = cidx[N]; + + OCTAVE_LOCAL_BUFFER (octave_idx_type, w, N + 1); + for (octave_idx_type i = 0; i < N; i++) + w[i] = 0; + for (octave_idx_type i = 0; i < nz; i++) + w[ridx[i]]++; + nz = 0; + for (octave_idx_type i = 0; i < N; i++) + { + OCTAVE_QUIT; + cidx2[i] = nz; + nz += w[i]; + w[i] = cidx2[i]; + } + cidx2[N] = nz; + w[N] = nz; + + for (octave_idx_type j = 0; j < N; j++) + for (octave_idx_type k = cidx[j]; k < cidx[j + 1]; k++) + { + OCTAVE_QUIT; + octave_idx_type q = w[ridx[k]]++; + ridx2[q] = j; + } +} + +// An implementation of the Cuthill-McKee algorithm. +DEFUN_DLD (symrcm, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} symrcm (@var{S})\n\ +Return the symmetric reverse Cuthill-McKee permutation of @var{S}.\n\ +@var{p} is a permutation vector such that\n\ +@code{@var{S}(@var{p}, @var{p})} tends to have its diagonal elements\n\ +closer to the diagonal than @var{S}. This is a good preordering for LU\n\ +or Cholesky@tie{}factorization of matrices that come from ``long, skinny''\n\ +problems. It works for both symmetric and asymmetric @var{S}.\n\ +\n\ +The algorithm represents a heuristic approach to the NP-complete\n\ +bandwidth minimization problem. The implementation is based in the\n\ +descriptions found in\n\ +\n\ +E. Cuthill, J. McKee. @cite{Reducing the Bandwidth of Sparse Symmetric\n\ +Matrices}. Proceedings of the 24th ACM National Conference, 157--172\n\ +1969, Brandon Press, New Jersey.\n\ +\n\ +A. George, J.W.H. Liu. @cite{Computer Solution of Large Sparse\n\ +Positive Definite Systems}, Prentice Hall Series in Computational\n\ +Mathematics, ISBN 0-13-165274-5, 1981.\n\ +\n\ +@seealso{colperm, colamd, symamd}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin != 1) + { + print_usage (); + return retval; + } + + octave_value arg = args(0); + + // the parameter of the matrix is converted into a sparse matrix + //(if necessary) + octave_idx_type *cidx; + octave_idx_type *ridx; + SparseMatrix Ar; + SparseComplexMatrix Ac; + + if (arg.is_real_type ()) + { + Ar = arg.sparse_matrix_value (); + // Note cidx/ridx are const, so use xridx and xcidx... + cidx = Ar.xcidx (); + ridx = Ar.xridx (); + } + else + { + Ac = arg.sparse_complex_matrix_value (); + cidx = Ac.xcidx (); + ridx = Ac.xridx (); + } + + if (error_state) + return retval; + + octave_idx_type nr = arg.rows (); + octave_idx_type nc = arg.columns (); + + if (nr != nc) + { + gripe_square_matrix_required ("symrcm"); + return retval; + } + + if (nr == 0 && nc == 0) + return octave_value (NDArray (dim_vector (1, 0))); + + // sizes of the heaps + octave_idx_type s = 0; + + // head- and tail-indices for the queue + octave_idx_type qt = 0, qh = 0; + CMK_Node v, w; + // dimension of the matrix + octave_idx_type N = nr; + + OCTAVE_LOCAL_BUFFER (octave_idx_type, cidx2, N + 1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, ridx2, cidx[N]); + transpose (N, ridx, cidx, ridx2, cidx2); + + // the permutation vector + NDArray P (dim_vector (1, N)); + + // compute the node degrees + OCTAVE_LOCAL_BUFFER (octave_idx_type, D, N); + octave_idx_type max_deg = calc_degrees (N, ridx, cidx, D); + + // if none of the nodes has a degree > 0 (a matrix of zeros) + // the return value corresponds to the identity permutation + if (max_deg == 0) + { + for (octave_idx_type i = 0; i < N; i++) + P(i) = i; + return octave_value (P); + } + + // a heap for the a node's neighbors. The number of neighbors is + // limited by the maximum degree max_deg: + OCTAVE_LOCAL_BUFFER (CMK_Node, S, max_deg); + + // a queue for the BFS. The array is always one element larger than + // the number of entries that are stored. + OCTAVE_LOCAL_BUFFER (CMK_Node, Q, N+1); + + // a counter (for building the permutation) + octave_idx_type c = -1; + + // upper bound for the bandwidth (=quality of solution) + // initialize the bandwidth of the graph with 0. B contains the + // the maximum of the theoretical lower limits of the subgraphs + // bandwidths. + octave_idx_type B = 0; + + // mark all nodes as unvisited; with the exception of the nodes + // that have degree==0 and build a CC of the graph. + + boolNDArray btmp (dim_vector (1, N), false); + bool *visit = btmp.fortran_vec (); + + do + { + // locate an unvisited starting node of the graph + octave_idx_type i; + for (i = 0; i < N; i++) + if (! visit[i]) + break; + + // locate a probably better starting node + v.id = find_starting_node (N, ridx, cidx, ridx2, cidx2, D, i); + + // mark the node as visited and enqueue it (a starting node + // for the BFS). Since the node will be a root of a spanning + // tree, its dist is 0. + v.deg = D[v.id]; + v.dist = 0; + visit[v.id] = true; + Q_enq (Q, N, qt, v); + + // lower bound for the bandwidth of a subgraph + // keep a "level" in the spanning tree (= min. distance to the + // root) for determining the bandwidth of the computed + // permutation P + octave_idx_type Bsub = 0; + // min. dist. to the root is 0 + octave_idx_type level = 0; + // the root is the first/only node on level 0 + octave_idx_type level_N = 1; + + while (! Q_empty (Q, N, qh, qt)) + { + v = Q_deq (Q, N, qh); + i = v.id; + + c++; + + // for computing the inverse permutation P where + // A(inv(P),inv(P)) or P'*A*P is banded + // P(i) = c; + + // for computing permutation P where + // A(P(i),P(j)) or P*A*P' is banded + P(c) = i; + + // put all unvisited neighbors j of node i on the heap + s = 0; + octave_idx_type j1 = cidx[i]; + octave_idx_type j2 = cidx2[i]; + + OCTAVE_QUIT; + while (j1 < cidx[i+1] || j2 < cidx2[i+1]) + { + OCTAVE_QUIT; + if (j1 == cidx[i+1]) + { + octave_idx_type r2 = ridx2[j2++]; + if (! visit[r2]) + { + // the distance of node j is dist(i)+1 + w.id = r2; + w.deg = D[r2]; + w.dist = v.dist+1; + H_insert (S, s, w); + visit[r2] = true; + } + } + else if (j2 == cidx2[i+1]) + { + octave_idx_type r1 = ridx[j1++]; + if (! visit[r1]) + { + w.id = r1; + w.deg = D[r1]; + w.dist = v.dist+1; + H_insert (S, s, w); + visit[r1] = true; + } + } + else + { + octave_idx_type r1 = ridx[j1]; + octave_idx_type r2 = ridx2[j2]; + if (r1 <= r2) + { + if (! visit[r1]) + { + w.id = r1; + w.deg = D[r1]; + w.dist = v.dist+1; + H_insert (S, s, w); + visit[r1] = true; + } + j1++; + if (r1 == r2) + j2++; + } + else + { + if (! visit[r2]) + { + w.id = r2; + w.deg = D[r2]; + w.dist = v.dist+1; + H_insert (S, s, w); + visit[r2] = true; + } + j2++; + } + } + } + + // add the neighbors to the queue (sorted by node degree) + while (! H_empty (S, s)) + { + OCTAVE_QUIT; + + // locate a neighbor of i with minimal degree in O(log(N)) + v = H_remove_min (S, s, 1); + + // entered the BFS a new level? + if (v.dist > level) + { + // adjustment of bandwith: + // "[...] the minimum bandwidth that + // can be obtained [...] is the + // maximum number of nodes per level" + if (Bsub < level_N) + Bsub = level_N; + + level = v.dist; + // v is the first node on the new level + level_N = 1; + } + else + { + // there is no new level but another node on + // this level: + level_N++; + } + + // enqueue v in O(1) + Q_enq (Q, N, qt, v); + } + + // synchronize the bandwidth with level_N once again: + if (Bsub < level_N) + Bsub = level_N; + } + // finish of BFS. If there are still unvisited nodes in the graph + // then it is split into CCs. The computed bandwidth is the maximum + // of all subgraphs. Update: + if (Bsub > B) + B = Bsub; + } + // are there any nodes left? + while (c+1 < N); + + // compute the reverse-ordering + s = N / 2 - 1; + for (octave_idx_type i = 0, j = N - 1; i <= s; i++, j--) + std::swap (P.elem (i), P.elem (j)); + + // increment all indices, since Octave is not C + return octave_value (P+1); +} diff -r d02b229ce693 -r a132d206a36a src/dldfcn/tsearch.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/tsearch.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,186 @@ +/* + +Copyright (C) 2002-2012 Andreas Stahel + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: Andreas Stahel + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "lo-ieee.h" +#include "lo-math.h" + +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" +#include "parse.h" + +inline double max (double a, double b, double c) +{ + if (a < b) + return (b < c ? c : b); + else + return (a < c ? c : a); +} + +inline double min (double a, double b, double c) +{ + if (a > b) + return (b > c ? c : b); + else + return (a > c ? c : a); +} + +#define REF(x,k,i) x(static_cast(elem((k), (i))) - 1) + +// for large data set the algorithm is very slow +// one should presort (how?) either the elements of the points of evaluation +// to cut down the time needed to decide which triangle contains the +// given point + +// e.g., build up a neighbouring triangle structure and use a simplex-like +// method to traverse it + +DEFUN_DLD (tsearch, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{idx} =} tsearch (@var{x}, @var{y}, @var{t}, @var{xi}, @var{yi})\n\ +Search for the enclosing Delaunay convex hull. For @code{@var{t} =\n\ +delaunay (@var{x}, @var{y})}, finds the index in @var{t} containing the\n\ +points @code{(@var{xi}, @var{yi})}. For points outside the convex hull,\n\ +@var{idx} is NaN.\n\ +@seealso{delaunay, delaunayn}\n\ +@end deftypefn") +{ + const double eps=1.0e-12; + + octave_value_list retval; + const int nargin = args.length (); + if (nargin != 5) + { + print_usage (); + return retval; + } + + const ColumnVector x (args(0).vector_value ()); + const ColumnVector y (args(1).vector_value ()); + const Matrix elem (args(2).matrix_value ()); + const ColumnVector xi (args(3).vector_value ()); + const ColumnVector yi (args(4).vector_value ()); + + if (error_state) + return retval; + + const octave_idx_type nelem = elem.rows (); + + ColumnVector minx (nelem); + ColumnVector maxx (nelem); + ColumnVector miny (nelem); + ColumnVector maxy (nelem); + for (octave_idx_type k = 0; k < nelem; k++) + { + minx(k) = min (REF (x, k, 0), REF (x, k, 1), REF (x, k, 2)) - eps; + maxx(k) = max (REF (x, k, 0), REF (x, k, 1), REF (x, k, 2)) + eps; + miny(k) = min (REF (y, k, 0), REF (y, k, 1), REF (y, k, 2)) - eps; + maxy(k) = max (REF (y, k, 0), REF (y, k, 1), REF (y, k, 2)) + eps; + } + + const octave_idx_type np = xi.length (); + ColumnVector values (np); + + double x0 = 0.0, y0 = 0.0; + double a11 = 0.0, a12 = 0.0, a21 = 0.0, a22 = 0.0, det = 0.0; + + octave_idx_type k = nelem; // k is a counter of elements + for (octave_idx_type kp = 0; kp < np; kp++) + { + const double xt = xi(kp); + const double yt = yi(kp); + + // check if last triangle contains the next point + if (k < nelem) + { + const double dx1 = xt - x0; + const double dx2 = yt - y0; + const double c1 = (a22 * dx1 - a21 * dx2) / det; + const double c2 = (-a12 * dx1 + a11 * dx2) / det; + if (c1 >= -eps && c2 >= -eps && (c1 + c2) <= (1 + eps)) + { + values(kp) = double(k+1); + continue; + } + } + + // it doesn't, so go through all elements + for (k = 0; k < nelem; k++) + { + OCTAVE_QUIT; + if (xt >= minx(k) && xt <= maxx(k) && yt >= miny(k) && yt <= maxy(k)) + { + // element inside the minimum rectangle: examine it closely + x0 = REF (x, k, 0); + y0 = REF (y, k, 0); + a11 = REF (x, k, 1) - x0; + a12 = REF (y, k, 1) - y0; + a21 = REF (x, k, 2) - x0; + a22 = REF (y, k, 2) - y0; + det = a11 * a22 - a21 * a12; + + // solve the system + const double dx1 = xt - x0; + const double dx2 = yt - y0; + const double c1 = (a22 * dx1 - a21 * dx2) / det; + const double c2 = (-a12 * dx1 + a11 * dx2) / det; + if ((c1 >= -eps) && (c2 >= -eps) && ((c1 + c2) <= (1 + eps))) + { + values(kp) = double(k+1); + break; + } + } //endif # examine this element closely + } //endfor # each element + + if (k == nelem) + values(kp) = lo_ieee_nan_value (); + + } //endfor # kp + + retval(0) = values; + + return retval; +} + +/* +%!shared x, y, tri +%! x = [-1;-1;1]; +%! y = [-1;1;-1]; +%! tri = [1, 2, 3]; +%!assert (tsearch (x,y,tri,-1,-1), 1) +%!assert (tsearch (x,y,tri, 1,-1), 1) +%!assert (tsearch (x,y,tri,-1, 1), 1) +%!assert (tsearch (x,y,tri,-1/3, -1/3), 1) +%!assert (tsearch (x,y,tri, 1, 1), NaN) + +%!error tsearch () +*/ diff -r d02b229ce693 -r a132d206a36a src/dldfcn/urlwrite.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/urlwrite.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1740 @@ +// urlwrite and urlread, a curl front-end for octave +/* + +Copyright (C) 2006-2012 Alexander Barth +Copyright (C) 2009 David Bateman + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: Alexander Barth +// Adapted-By: jwe + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include + +#include "dir-ops.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "glob-match.h" + +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" +#include "ov-cell.h" +#include "pager.h" +#include "oct-map.h" +#include "oct-refcount.h" +#include "unwind-prot.h" + +#ifdef HAVE_CURL + +#include +#include +#include + +// Backwards compatibility for curl < 7.17.0 +#if LIBCURL_VERSION_NUM < 0x071100 +#define CURLOPT_DIRLISTONLY CURLOPT_FTPLISTONLY +#endif + +static int +write_data (void *buffer, size_t size, size_t nmemb, void *streamp) +{ + std::ostream& stream = *(static_cast (streamp)); + stream.write (static_cast (buffer), size*nmemb); + return (stream.fail () ? 0 : size * nmemb); +} + +static int +read_data (void *buffer, size_t size, size_t nmemb, void *streamp) +{ + std::istream& stream = *(static_cast (streamp)); + stream.read (static_cast (buffer), size*nmemb); + if (stream.eof ()) + return stream.gcount (); + else + return (stream.fail () ? 0 : size * nmemb); +} + +static size_t +throw_away (void *, size_t size, size_t nmemb, void *) +{ + return static_cast(size * nmemb); +} + +class +curl_handle +{ +private: + class + curl_handle_rep + { + public: + curl_handle_rep (void) : count (1), valid (true), ascii (false) + { + curl = curl_easy_init (); + if (!curl) + error ("can not create curl handle"); + } + + ~curl_handle_rep (void) + { + if (curl) + curl_easy_cleanup (curl); + } + + bool is_valid (void) const + { + return valid; + } + + bool perform (bool curlerror) const + { + bool retval = false; + if (!error_state) + { + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + errnum = curl_easy_perform (curl); + if (errnum != CURLE_OK) + { + if (curlerror) + error ("%s", curl_easy_strerror (errnum)); + } + else + retval = true; + + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + return retval; + } + + CURL* handle (void) const + { + return curl; + } + + bool is_ascii (void) const + { + return ascii; + } + + bool is_binary (void) const + { + return !ascii; + } + + octave_refcount count; + std::string host; + bool valid; + bool ascii; + mutable CURLcode errnum; + + private: + CURL *curl; + + // No copying! + + curl_handle_rep (const curl_handle_rep& ov); + + curl_handle_rep& operator = (const curl_handle_rep&); + }; + +public: + +// I'd love to rewrite this as a private method of the curl_handle +// class, but you can't pass the va_list from the wrapper setopt to +// the curl_easy_setopt function. +#define setopt(option, parameter) \ + { \ + CURLcode res = curl_easy_setopt (rep->handle (), option, parameter); \ + if (res != CURLE_OK) \ + error ("%s", curl_easy_strerror (res)); \ + } + + curl_handle (void) : rep (new curl_handle_rep ()) + { + rep->valid = false; + } + + curl_handle (const std::string& _host, const std::string& user, + const std::string& passwd) : + rep (new curl_handle_rep ()) + { + rep->host = _host; + init (user, passwd, std::cin, octave_stdout); + + std::string url = "ftp://" + _host; + setopt (CURLOPT_URL, url.c_str ()); + + // Setup the link, with no transfer + if (!error_state) + perform (); + } + + curl_handle (const std::string& url, const std::string& method, + const Cell& param, std::ostream& os, bool& retval) : + rep (new curl_handle_rep ()) + { + retval = false; + + init ("", "", std::cin, os); + + setopt (CURLOPT_NOBODY, 0); + + // Don't need to store the parameters here as we can't change + // the URL after the handle is created + std::string query_string = form_query_string (param); + + if (method == "get") + { + query_string = url + "?" + query_string; + setopt (CURLOPT_URL, query_string.c_str ()); + } + else if (method == "post") + { + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_POSTFIELDS, query_string.c_str ()); + } + else + setopt (CURLOPT_URL, url.c_str ()); + + if (!error_state) + retval = perform (false); + } + + curl_handle (const curl_handle& h) : rep (h.rep) + { + rep->count++; + } + + ~curl_handle (void) + { + if (--rep->count == 0) + delete rep; + } + + curl_handle& operator = (const curl_handle& h) + { + if (this != &h) + { + if (--rep->count == 0) + delete rep; + + rep = h.rep; + rep->count++; + } + return *this; + } + + bool is_valid (void) const + { + return rep->is_valid (); + } + + std::string lasterror (void) const + { + return std::string (curl_easy_strerror (rep->errnum)); + } + + void set_ostream (std::ostream& os) const + { + setopt (CURLOPT_WRITEDATA, static_cast (&os)); + } + + void set_istream (std::istream& is) const + { + setopt (CURLOPT_READDATA, static_cast (&is)); + } + + void ascii (void) const + { + setopt (CURLOPT_TRANSFERTEXT, 1); + rep->ascii = true; + } + + void binary (void) const + { + setopt (CURLOPT_TRANSFERTEXT, 0); + rep->ascii = false; + } + + bool is_ascii (void) const + { + return rep->is_ascii (); + } + + bool is_binary (void) const + { + return rep->is_binary (); + } + + void cwd (const std::string& path) const + { + struct curl_slist *slist = 0; + std::string cmd = "cwd " + path; + slist = curl_slist_append (slist, cmd.c_str ()); + setopt (CURLOPT_POSTQUOTE, slist); + if (! error_state) + perform (); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + } + + void del (const std::string& file) const + { + struct curl_slist *slist = 0; + std::string cmd = "dele " + file; + slist = curl_slist_append (slist, cmd.c_str ()); + setopt (CURLOPT_POSTQUOTE, slist); + if (! error_state) + perform (); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + } + + void rmdir (const std::string& path) const + { + struct curl_slist *slist = 0; + std::string cmd = "rmd " + path; + slist = curl_slist_append (slist, cmd.c_str ()); + setopt (CURLOPT_POSTQUOTE, slist); + if (! error_state) + perform (); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + } + + bool mkdir (const std::string& path, bool curlerror = true) const + { + bool retval = false; + struct curl_slist *slist = 0; + std::string cmd = "mkd " + path; + slist = curl_slist_append (slist, cmd.c_str ()); + setopt (CURLOPT_POSTQUOTE, slist); + if (! error_state) + retval = perform (curlerror); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + return retval; + } + + void rename (const std::string& oldname, const std::string& newname) const + { + struct curl_slist *slist = 0; + std::string cmd = "rnfr " + oldname; + slist = curl_slist_append (slist, cmd.c_str ()); + cmd = "rnto " + newname; + slist = curl_slist_append (slist, cmd.c_str ()); + setopt (CURLOPT_POSTQUOTE, slist); + if (! error_state) + perform (); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + } + + void put (const std::string& file, std::istream& is) const + { + std::string url = "ftp://" + rep->host + "/" + file; + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_UPLOAD, 1); + setopt (CURLOPT_NOBODY, 0); + set_istream (is); + if (! error_state) + perform (); + set_istream (std::cin); + setopt (CURLOPT_NOBODY, 1); + setopt (CURLOPT_UPLOAD, 0); + url = "ftp://" + rep->host; + setopt (CURLOPT_URL, url.c_str ()); + } + + void get (const std::string& file, std::ostream& os) const + { + std::string url = "ftp://" + rep->host + "/" + file; + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_NOBODY, 0); + set_ostream (os); + if (! error_state) + perform (); + set_ostream (octave_stdout); + setopt (CURLOPT_NOBODY, 1); + url = "ftp://" + rep->host; + setopt (CURLOPT_URL, url.c_str ()); + } + + void dir (void) const + { + std::string url = "ftp://" + rep->host + "/"; + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_NOBODY, 0); + if (! error_state) + perform (); + setopt (CURLOPT_NOBODY, 1); + url = "ftp://" + rep->host; + setopt (CURLOPT_URL, url.c_str ()); + } + + string_vector list (void) const + { + std::ostringstream buf; + std::string url = "ftp://" + rep->host + "/"; + setopt (CURLOPT_WRITEDATA, static_cast (&buf)); + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_DIRLISTONLY, 1); + setopt (CURLOPT_NOBODY, 0); + if (! error_state) + perform (); + setopt (CURLOPT_NOBODY, 1); + url = "ftp://" + rep->host; + setopt (CURLOPT_WRITEDATA, static_cast (&octave_stdout)); + setopt (CURLOPT_DIRLISTONLY, 0); + setopt (CURLOPT_URL, url.c_str ()); + + // Count number of directory entries + std::string str = buf.str (); + octave_idx_type n = 0; + size_t pos = 0; + while (true) + { + pos = str.find_first_of ('\n', pos); + if (pos == std::string::npos) + break; + pos++; + n++; + } + string_vector retval (n); + pos = 0; + for (octave_idx_type i = 0; i < n; i++) + { + size_t newpos = str.find_first_of ('\n', pos); + if (newpos == std::string::npos) + break; + + retval(i) = str.substr(pos, newpos - pos); + pos = newpos + 1; + } + return retval; + } + + void get_fileinfo (const std::string& filename, double& filesize, + time_t& filetime, bool& fileisdir) const + { + std::string path = pwd (); + + std::string url = "ftp://" + rep->host + "/" + path + "/" + filename; + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_FILETIME, 1); + setopt (CURLOPT_HEADERFUNCTION, throw_away); + setopt (CURLOPT_WRITEFUNCTION, throw_away); + + // FIXME + // The MDTM command fails for a directory on the servers I tested + // so this is a means of testing for directories. It also means + // I can't get the date of directories! + if (! error_state) + { + if (! perform (false)) + { + fileisdir = true; + filetime = -1; + filesize = 0; + } + else + { + fileisdir = false; + time_t ft; + curl_easy_getinfo (rep->handle (), CURLINFO_FILETIME, &ft); + filetime = ft; + double fs; + curl_easy_getinfo (rep->handle (), + CURLINFO_CONTENT_LENGTH_DOWNLOAD, &fs); + filesize = fs; + } + } + + setopt (CURLOPT_WRITEFUNCTION, write_data); + setopt (CURLOPT_HEADERFUNCTION, 0); + setopt (CURLOPT_FILETIME, 0); + url = "ftp://" + rep->host; + setopt (CURLOPT_URL, url.c_str ()); + + // The MDTM command seems to reset the path to the root with the + // servers I tested with, so cd again into the correct path. Make + // the path absolute so that this will work even with servers that + // don't end up in the root after an MDTM command. + cwd ("/" + path); + } + + std::string pwd (void) const + { + struct curl_slist *slist = 0; + std::string retval; + std::ostringstream buf; + + slist = curl_slist_append (slist, "pwd"); + setopt (CURLOPT_POSTQUOTE, slist); + setopt (CURLOPT_HEADERFUNCTION, write_data); + setopt (CURLOPT_WRITEHEADER, static_cast(&buf)); + + if (! error_state) + { + perform (); + retval = buf.str (); + + // Can I assume that the path is alway in "" on the last line + size_t pos2 = retval.rfind ('"'); + size_t pos1 = retval.rfind ('"', pos2 - 1); + retval = retval.substr (pos1 + 1, pos2 - pos1 - 1); + } + setopt (CURLOPT_HEADERFUNCTION, 0); + setopt (CURLOPT_WRITEHEADER, 0); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + + return retval; + } + + bool perform (bool curlerror = true) const + { + return rep->perform (curlerror); + } + +private: + curl_handle_rep *rep; + + std::string form_query_string (const Cell& param) + { + std::ostringstream query; + + for (int i = 0; i < param.numel (); i += 2) + { + std::string name = param(i).string_value (); + std::string text = param(i+1).string_value (); + + // Encode strings. + char *enc_name = curl_easy_escape (rep->handle (), name.c_str (), + name.length ()); + char *enc_text = curl_easy_escape (rep->handle (), text.c_str (), + text.length ()); + + query << enc_name << "=" << enc_text; + + curl_free (enc_name); + curl_free (enc_text); + + if (i < param.numel ()-1) + query << "&"; + } + + query.flush (); + + return query.str (); + } + + void init (const std::string& user, const std::string& passwd, + std::istream& is, std::ostream& os) + { + // No data transfer by default + setopt (CURLOPT_NOBODY, 1); + + // Set the username and password + std::string userpwd = user; + if (! passwd.empty ()) + userpwd += ":" + passwd; + if (! userpwd.empty ()) + setopt (CURLOPT_USERPWD, userpwd.c_str ()); + + // Define our callback to get called when there's data to be written. + setopt (CURLOPT_WRITEFUNCTION, write_data); + + // Set a pointer to our struct to pass to the callback. + setopt (CURLOPT_WRITEDATA, static_cast (&os)); + + // Define our callback to get called when there's data to be read + setopt (CURLOPT_READFUNCTION, read_data); + + // Set a pointer to our struct to pass to the callback. + setopt (CURLOPT_READDATA, static_cast (&is)); + + // Follow redirects. + setopt (CURLOPT_FOLLOWLOCATION, true); + + // Don't use EPSV since connecting to sites that don't support it + // will hang for some time (3 minutes?) before moving on to try PASV + // instead. + setopt (CURLOPT_FTP_USE_EPSV, false); + + setopt (CURLOPT_NOPROGRESS, true); + setopt (CURLOPT_FAILONERROR, true); + + setopt (CURLOPT_POSTQUOTE, 0); + setopt (CURLOPT_QUOTE, 0); + } + +#undef setopt +}; + +class +curl_handles +{ +public: + + typedef std::map::iterator iterator; + typedef std::map::const_iterator const_iterator; + + curl_handles (void) : map () + { + curl_global_init (CURL_GLOBAL_DEFAULT); + } + + ~curl_handles (void) + { + // Remove the elements of the map explicitly as they should + // be deleted before the call to curl_global_cleanup + map.erase (begin (), end ()); + + curl_global_cleanup (); + } + + iterator begin (void) { return iterator (map.begin ()); } + const_iterator begin (void) const { return const_iterator (map.begin ()); } + + iterator end (void) { return iterator (map.end ()); } + const_iterator end (void) const { return const_iterator (map.end ()); } + + iterator seek (const std::string& k) { return map.find (k); } + const_iterator seek (const std::string& k) const { return map.find (k); } + + std::string key (const_iterator p) const { return p->first; } + + curl_handle& contents (const std::string& k) + { + return map[k]; + } + + curl_handle contents (const std::string& k) const + { + const_iterator p = seek (k); + return p != end () ? p->second : curl_handle (); + } + + curl_handle& contents (iterator p) + { return p->second; } + + curl_handle contents (const_iterator p) const + { return p->second; } + + void del (const std::string& k) + { + iterator p = map.find (k); + + if (p != map.end ()) + map.erase (p); + } + +private: + std::map map; +}; + +static curl_handles handles; + +static void +cleanup_urlwrite (std::string filename) +{ + octave_unlink (filename); +} + +static void +reset_path (const curl_handle curl) +{ + curl.cwd (".."); +} + +static void +delete_file (std::string file) +{ + octave_unlink (file); +} +#endif + +DEFUN_DLD (urlwrite, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} urlwrite (@var{url}, @var{localfile})\n\ +@deftypefnx {Loadable Function} {@var{f} =} urlwrite (@var{url}, @var{localfile})\n\ +@deftypefnx {Loadable Function} {[@var{f}, @var{success}] =} urlwrite (@var{url}, @var{localfile})\n\ +@deftypefnx {Loadable Function} {[@var{f}, @var{success}, @var{message}] =} urlwrite (@var{url}, @var{localfile})\n\ +Download a remote file specified by its @var{url} and save it as\n\ +@var{localfile}. For example:\n\ +\n\ +@example\n\ +@group\n\ +urlwrite (\"ftp://ftp.octave.org/pub/octave/README\",\n\ + \"README.txt\");\n\ +@end group\n\ +@end example\n\ +\n\ +The full path of the downloaded file is returned in @var{f}. The\n\ +variable @var{success} is 1 if the download was successful,\n\ +otherwise it is 0 in which case @var{message} contains an error\n\ +message. If no output argument is specified and an error occurs,\n\ +then the error is signaled through Octave's error handling mechanism.\n\ +\n\ +This function uses libcurl. Curl supports, among others, the HTTP,\n\ +FTP and FILE protocols. Username and password may be specified in\n\ +the URL, for example:\n\ +\n\ +@example\n\ +@group\n\ +urlwrite (\"http://username:password@@example.com/file.txt\",\n\ + \"file.txt\");\n\ +@end group\n\ +@end example\n\ +\n\ +GET and POST requests can be specified by @var{method} and @var{param}.\n\ +The parameter @var{method} is either @samp{get} or @samp{post}\n\ +and @var{param} is a cell array of parameter and value pairs.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +urlwrite (\"http://www.google.com/search\", \"search.html\",\n\ + \"get\", @{\"query\", \"octave\"@});\n\ +@end group\n\ +@end example\n\ +@seealso{urlread}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_CURL + + int nargin = args.length (); + + // verify arguments + if (nargin != 2 && nargin != 4) + { + print_usage (); + return retval; + } + + std::string url = args(0).string_value (); + + if (error_state) + { + error ("urlwrite: URL must be a character string"); + return retval; + } + + // name to store the file if download is succesful + std::string filename = args(1).string_value (); + + if (error_state) + { + error ("urlwrite: LOCALFILE must be a character string"); + return retval; + } + + std::string method; + Cell param; // empty cell array + + if (nargin == 4) + { + method = args(2).string_value (); + + if (error_state) + { + error ("urlwrite: METHOD must be \"get\" or \"post\""); + return retval; + } + + if (method != "get" && method != "post") + { + error ("urlwrite: METHOD must be \"get\" or \"post\""); + return retval; + } + + param = args(3).cell_value (); + + if (error_state) + { + error ("urlwrite: parameters (PARAM) for get and post requests must be given as a cell"); + return retval; + } + + + if (param.numel () % 2 == 1 ) + { + error ("urlwrite: number of elements in PARAM must be even"); + return retval; + } + } + + // The file should only be deleted if it doesn't initially exist, we + // create it, and the download fails. We use unwind_protect to do + // it so that the deletion happens no matter how we exit the function. + + file_stat fs (filename); + + std::ofstream ofile (filename.c_str (), std::ios::out | std::ios::binary); + + if (! ofile.is_open ()) + { + error ("urlwrite: unable to open file"); + return retval; + } + + unwind_protect_safe frame; + + frame.add_fcn (cleanup_urlwrite, filename); + + bool ok; + curl_handle curl = curl_handle (url, method, param, ofile, ok); + + ofile.close (); + + if (!error_state) + frame.discard (); + else + frame.run (); + + if (nargout > 0) + { + if (ok) + { + retval(2) = std::string (); + retval(1) = true; + retval(0) = octave_env::make_absolute (filename); + } + else + { + retval(2) = curl.lasterror (); + retval(1) = false; + retval(0) = std::string (); + } + } + + if (nargout < 2 && ! ok) + error ("urlwrite: curl: %s", curl.lasterror ().c_str ()); + +#else + error ("urlwrite: not available in this version of Octave"); +#endif + + return retval; +} + +DEFUN_DLD (urlread, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{s} =} urlread (@var{url})\n\ +@deftypefnx {Loadable Function} {[@var{s}, @var{success}] =} urlread (@var{url})\n\ +@deftypefnx {Loadable Function} {[@var{s}, @var{success}, @var{message}] =} urlread (@var{url})\n\ +@deftypefnx {Loadable Function} {[@dots{}] =} urlread (@var{url}, @var{method}, @var{param})\n\ +Download a remote file specified by its @var{url} and return its content\n\ +in string @var{s}. For example:\n\ +\n\ +@example\n\ +s = urlread (\"ftp://ftp.octave.org/pub/octave/README\");\n\ +@end example\n\ +\n\ +The variable @var{success} is 1 if the download was successful,\n\ +otherwise it is 0 in which case @var{message} contains an error\n\ +message. If no output argument is specified and an error occurs,\n\ +then the error is signaled through Octave's error handling mechanism.\n\ +\n\ +This function uses libcurl. Curl supports, among others, the HTTP,\n\ +FTP and FILE protocols. Username and password may be specified in the\n\ +URL@. For example:\n\ +\n\ +@example\n\ +s = urlread (\"http://user:password@@example.com/file.txt\");\n\ +@end example\n\ +\n\ +GET and POST requests can be specified by @var{method} and @var{param}.\n\ +The parameter @var{method} is either @samp{get} or @samp{post}\n\ +and @var{param} is a cell array of parameter and value pairs.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +s = urlread (\"http://www.google.com/search\", \"get\",\n\ + @{\"query\", \"octave\"@});\n\ +@end group\n\ +@end example\n\ +@seealso{urlwrite}\n\ +@end deftypefn") +{ + // Octave's return value + octave_value_list retval; + +#ifdef HAVE_CURL + + int nargin = args.length (); + + // verify arguments + if (nargin != 1 && nargin != 3) + { + print_usage (); + return retval; + } + + std::string url = args(0).string_value (); + + if (error_state) + { + error ("urlread: URL must be a character string"); + return retval; + } + + std::string method; + Cell param; // empty cell array + + if (nargin == 3) + { + method = args(1).string_value (); + + if (error_state) + { + error ("urlread: METHOD must be \"get\" or \"post\""); + return retval; + } + + if (method != "get" && method != "post") + { + error ("urlread: METHOD must be \"get\" or \"post\""); + return retval; + } + + param = args(2).cell_value (); + + if (error_state) + { + error ("urlread: parameters (PARAM) for get and post requests must be given as a cell"); + return retval; + } + + if (param.numel () % 2 == 1 ) + { + error ("urlread: number of elements in PARAM must be even"); + return retval; + } + } + + std::ostringstream buf; + + bool ok; + curl_handle curl = curl_handle (url, method, param, buf, ok); + + if (nargout > 0) + { + // Return empty string if no error occured. + retval(2) = ok ? "" : curl.lasterror (); + retval(1) = ok; + retval(0) = buf.str (); + } + + if (nargout < 2 && ! ok) + error ("urlread: curl: %s", curl.lasterror().c_str()); + +#else + error ("urlread: not available in this version of Octave"); +#endif + + return retval; +} + +DEFUN_DLD (__ftp__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp__ (@var{handle}, @var{host})\n\ +@deftypefnx {Loadable Function} {} __ftp__ (@var{handle}, @var{host}, @var{username}, @var{password})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + std::string handle; + std::string host; + std::string user = "anonymous"; + std::string passwd = ""; + + if (nargin < 2 || nargin > 4) + error ("incorrect number of arguments"); + else + { + handle = args(0).string_value (); + host = args(1).string_value (); + + if (nargin > 1) + user = args(2).string_value (); + + if (nargin > 2) + passwd = args(3).string_value (); + + if (!error_state) + { + handles.contents (handle) = curl_handle (host, user, passwd); + + if (error_state) + handles.del (handle); + } + } +#else + error ("__ftp__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_pwd__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_pwd__ (@var{handle})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ + octave_value retval; +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_pwd__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + retval = curl.pwd (); + else + error ("__ftp_pwd__: invalid ftp handle"); + } + } +#else + error ("__ftp_pwd__: not available in this version of Octave"); +#endif + + return retval; +} + +DEFUN_DLD (__ftp_cwd__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_cwd__ (@var{handle}, @var{path})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1 && nargin != 2) + error ("__ftp_cwd__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string path = ""; + + if (nargin > 1) + path = args(1).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.cwd (path); + else + error ("__ftp_cwd__: invalid ftp handle"); + } + } +#else + error ("__ftp_cwd__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_dir__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_dir__ (@var{handle})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ + octave_value retval; +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_dir__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + { + if (nargout == 0) + curl.dir (); + else + { + string_vector sv = curl.list (); + octave_idx_type n = sv.length (); + if (n == 0) + { + string_vector flds (5); + flds(0) = "name"; + flds(1) = "date"; + flds(2) = "bytes"; + flds(3) = "isdir"; + flds(4) = "datenum"; + retval = octave_map (flds); + } + else + { + octave_map st; + Cell filectime (dim_vector (n, 1)); + Cell filesize (dim_vector (n, 1)); + Cell fileisdir (dim_vector (n, 1)); + Cell filedatenum (dim_vector (n, 1)); + + st.assign ("name", Cell (sv)); + + for (octave_idx_type i = 0; i < n; i++) + { + time_t ftime; + bool fisdir; + double fsize; + + curl.get_fileinfo (sv(i), fsize, ftime, fisdir); + + fileisdir (i) = fisdir; + filectime (i) = ctime (&ftime); + filesize (i) = fsize; + filedatenum (i) = double (ftime); + } + st.assign ("date", filectime); + st.assign ("bytes", filesize); + st.assign ("isdir", fileisdir); + st.assign ("datenum", filedatenum); + retval = st; + } + } + } + else + error ("__ftp_dir__: invalid ftp handle"); + } + } +#else + error ("__ftp_dir__: not available in this version of Octave"); +#endif + + return retval; +} + +DEFUN_DLD (__ftp_ascii__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_ascii__ (@var{handle})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_ascii__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.ascii (); + else + error ("__ftp_ascii__: invalid ftp handle"); + } + } +#else + error ("__ftp_ascii__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_binary__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_binary__ (@var{handle})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_binary__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.binary (); + else + error ("__ftp_binary__: invalid ftp handle"); + } + } +#else + error ("__ftp_binary__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_close__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_close__ (@var{handle})\n\ + Undocumented internal function\n\ + @end deftypefn") + { + #ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_close__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + if (!error_state) + handles.del (handle); + } + #else + error ("__ftp_close__: not available in this version of Octave"); + #endif + + return octave_value (); + } + +DEFUN_DLD (__ftp_mode__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_mode__ (@var{handle})\n\ + Undocumented internal function\n\ + @end deftypefn") + { + octave_value retval; + #ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_mode__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + retval = (curl.is_ascii () ? "ascii" : "binary"); + else + error ("__ftp_binary__: invalid ftp handle"); + } + } + #else + error ("__ftp_mode__: not available in this version of Octave"); + #endif + + return retval; + } + +DEFUN_DLD (__ftp_delete__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_delete__ (@var{handle}, @var{path})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 2) + error ("__ftp_delete__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string file = args(1).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.del (file); + else + error ("__ftp_delete__: invalid ftp handle"); + } + } +#else + error ("__ftp_delete__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_rmdir__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_rmdir__ (@var{handle}, @var{path})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 2) + error ("__ftp_rmdir__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string dir = args(1).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.rmdir (dir); + else + error ("__ftp_rmdir__: invalid ftp handle"); + } + } +#else + error ("__ftp_rmdir__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_mkdir__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_mkdir__ (@var{handle}, @var{path})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 2) + error ("__ftp_mkdir__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string dir = args(1).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.mkdir (dir); + else + error ("__ftp_mkdir__: invalid ftp handle"); + } + } +#else + error ("__ftp_mkdir__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_rename__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_rename__ (@var{handle}, @var{path})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 3) + error ("__ftp_rename__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string oldname = args(1).string_value (); + std::string newname = args(2).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.rename (oldname, newname); + else + error ("__ftp_rename__: invalid ftp handle"); + } + } +#else + error ("__ftp_rename__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +#ifdef HAVE_CURL +static string_vector +mput_directory (const curl_handle& curl, const std::string& base, + const std::string& dir) +{ + string_vector retval; + + if (! curl.mkdir (dir, false)) + warning ("__ftp_mput__: can not create the remote directory ""%s""", + (base.length () == 0 ? dir : base + + file_ops::dir_sep_str () + dir).c_str ()); + + curl.cwd (dir); + + if (! error_state) + { + unwind_protect_safe frame; + + frame.add_fcn (reset_path, curl); + + std::string realdir = base.length () == 0 ? dir : base + + file_ops::dir_sep_str () + dir; + + dir_entry dirlist (realdir); + + if (dirlist) + { + string_vector files = dirlist.read (); + + for (octave_idx_type i = 0; i < files.length (); i++) + { + std::string file = files (i); + + if (file == "." || file == "..") + continue; + + std::string realfile = realdir + file_ops::dir_sep_str () + file; + file_stat fs (realfile); + + if (! fs.exists ()) + { + error ("__ftp__mput: file ""%s"" does not exist", + realfile.c_str ()); + break; + } + + if (fs.is_dir ()) + { + retval.append (mput_directory (curl, realdir, file)); + + if (error_state) + break; + } + else + { + // FIXME Does ascii mode need to be flagged here? + std::ifstream ifile (realfile.c_str (), std::ios::in | + std::ios::binary); + + if (! ifile.is_open ()) + { + error ("__ftp_mput__: unable to open file ""%s""", + realfile.c_str ()); + break; + } + + curl.put (file, ifile); + + ifile.close (); + + if (error_state) + break; + + retval.append (realfile); + } + } + } + else + error ("__ftp_mput__: can not read the directory ""%s""", + realdir.c_str ()); + } + + return retval; +} +#endif + +DEFUN_DLD (__ftp_mput__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_mput__ (@var{handle}, @var{files})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ + string_vector retval; + +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 2) + error ("__ftp_mput__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string pat = args(1).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + { + glob_match pattern (file_ops::tilde_expand (pat)); + string_vector files = pattern.glob (); + + for (octave_idx_type i = 0; i < files.length (); i++) + { + std::string file = files (i); + + file_stat fs (file); + + if (! fs.exists ()) + { + error ("__ftp__mput: file does not exist"); + break; + } + + if (fs.is_dir ()) + { + retval.append (mput_directory (curl, "", file)); + if (error_state) + break; + } + else + { + // FIXME Does ascii mode need to be flagged here? + std::ifstream ifile (file.c_str (), std::ios::in | + std::ios::binary); + + if (! ifile.is_open ()) + { + error ("__ftp_mput__: unable to open file"); + break; + } + + curl.put (file, ifile); + + ifile.close (); + + if (error_state) + break; + + retval.append (file); + } + } + } + else + error ("__ftp_mput__: invalid ftp handle"); + } + } +#else + error ("__ftp_mput__: not available in this version of Octave"); +#endif + + return (nargout > 0 ? octave_value (retval) : octave_value ()); +} + +#ifdef HAVE_CURL +static void +getallfiles (const curl_handle& curl, const std::string& dir, + const std::string& target) +{ + std::string sep = file_ops::dir_sep_str (); + file_stat fs (dir); + + if (!fs || !fs.is_dir ()) + { + std::string msg; + int status = octave_mkdir (dir, 0777, msg); + + if (status < 0) + error ("__ftp_mget__: can't create directory %s%s%s. %s", + target.c_str (), sep.c_str (), dir.c_str (), msg.c_str ()); + } + + if (! error_state) + { + curl.cwd (dir); + + if (! error_state) + { + unwind_protect_safe frame; + + frame.add_fcn (reset_path, curl); + + string_vector sv = curl.list (); + + for (octave_idx_type i = 0; i < sv.length (); i++) + { + time_t ftime; + bool fisdir; + double fsize; + + curl.get_fileinfo (sv(i), fsize, ftime, fisdir); + + if (fisdir) + getallfiles (curl, sv(i), target + dir + sep); + else + { + std::string realfile = target + dir + sep + sv(i); + std::ofstream ofile (realfile.c_str (), + std::ios::out | + std::ios::binary); + + if (! ofile.is_open ()) + { + error ("__ftp_mget__: unable to open file"); + break; + } + + unwind_protect_safe frame2; + + frame2.add_fcn (delete_file, realfile); + + curl.get (sv(i), ofile); + + ofile.close (); + + if (!error_state) + frame2.discard (); + else + frame2.run (); + } + + if (error_state) + break; + } + } + } +} +#endif + +DEFUN_DLD (__ftp_mget__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_mget__ (@var{handle}, @var{files})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 2 && nargin != 3) + error ("__ftp_mget__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string file = args(1).string_value (); + std::string target; + + if (nargin == 3) + target = args(2).string_value () + file_ops::dir_sep_str (); + + if (! error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + { + string_vector sv = curl.list (); + octave_idx_type n = 0; + glob_match pattern (file); + + for (octave_idx_type i = 0; i < sv.length (); i++) + { + if (pattern.match (sv(i))) + { + n++; + + time_t ftime; + bool fisdir; + double fsize; + + curl.get_fileinfo (sv(i), fsize, ftime, fisdir); + + if (fisdir) + getallfiles (curl, sv(i), target); + else + { + std::ofstream ofile ((target + sv(i)).c_str (), + std::ios::out | + std::ios::binary); + + if (! ofile.is_open ()) + { + error ("__ftp_mget__: unable to open file"); + break; + } + + unwind_protect_safe frame; + + frame.add_fcn (delete_file, target + sv(i)); + + curl.get (sv(i), ofile); + + ofile.close (); + + if (!error_state) + frame.discard (); + else + frame.run (); + } + + if (error_state) + break; + } + } + if (n == 0) + error ("__ftp_mget__: file not found"); + } + } + } +#else + error ("__ftp_mget__: not available in this version of Octave"); +#endif + + return octave_value (); +} diff -r d02b229ce693 -r a132d206a36a src/error.cc --- a/src/error.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1887 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include - -#include "defun.h" -#include "error.h" -#include "input.h" -#include "pager.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "utils.h" -#include "ov.h" -#include "ov-usr-fcn.h" -#include "pt-pr-code.h" -#include "pt-stmt.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "variables.h" - -// TRUE means that Octave will try to beep obnoxiously before printing -// error messages. -static bool Vbeep_on_error = false; - -// TRUE means that Octave will try to enter the debugger when an error -// is encountered. This will also inhibit printing of the normal -// traceback message (you will only see the top-level error message). -bool Vdebug_on_error = false; - -// TRUE means that Octave will try to enter the debugger when a warning -// is encountered. -bool Vdebug_on_warning = false; - -// TRUE means that Octave will try to display a stack trace when a -// warning is encountered. -static bool Vbacktrace_on_warning = false; - -// TRUE means that Octave will print a verbose warning. Currently unused. -static bool Vverbose_warning; - -// TRUE means that Octave will print no warnings, but lastwarn will be -//updated -static bool Vquiet_warning = false; - -// A structure containing (most of) the current state of warnings. -static octave_map warning_options; - -// The text of the last error message. -static std::string Vlast_error_message; - -// The text of the last warning message. -static std::string Vlast_warning_message; - -// The last warning message id. -static std::string Vlast_warning_id; - -// The last error message id. -static std::string Vlast_error_id; - -// The last file in which an error occured -static octave_map Vlast_error_stack; - -// Current error state. -// -// Valid values: -// -// -2: an error has occurred, but don't print any messages. -// -1: an error has occurred, we are printing a traceback -// 0: no error -// 1: an error has occurred -// -int error_state = 0; - -// Current warning state. -// -// Valid values: -// -// 0: no warning -// 1: a warning has occurred -// -int warning_state = 0; - -// Tell the error handler whether to print messages, or just store -// them for later. Used for handling errors in eval() and -// the `unwind_protect' statement. -int buffer_error_messages = 0; - -// TRUE means error messages are turned off. -bool discard_error_messages = false; - -// TRUE means warning messages are turned off. -bool discard_warning_messages = false; - -void -reset_error_handler (void) -{ - error_state = 0; - warning_state = 0; - buffer_error_messages = 0; - discard_error_messages = false; -} - -static void -initialize_warning_options (const std::string& state) -{ - octave_scalar_map initw; - - initw.setfield ("identifier", "all"); - initw.setfield ("state", state); - - warning_options = initw; -} - -static octave_map -initialize_last_error_stack (void) -{ - return octave_call_stack::empty_backtrace (); -} - -// Warning messages are never buffered. - -static void -vwarning (const char *name, const char *id, const char *fmt, va_list args) -{ - if (discard_warning_messages) - return; - - flush_octave_stdout (); - - std::ostringstream output_buf; - - if (name) - output_buf << name << ": "; - - octave_vformat (output_buf, fmt, args); - - output_buf << std::endl; - - // FIXME -- we really want to capture the message before it - // has all the formatting goop attached to it. We probably also - // want just the message, not the traceback information. - - std::string msg_string = output_buf.str (); - - if (! warning_state) - { - // This is the first warning in a possible series. - - Vlast_warning_id = id; - Vlast_warning_message = msg_string; - } - - if (! Vquiet_warning) - { - octave_diary << msg_string; - - std::cerr << msg_string; - } -} - -static void -verror (bool save_last_error, std::ostream& os, - const char *name, const char *id, const char *fmt, va_list args, - bool with_cfn = false) -{ - if (discard_error_messages) - return; - - if (! buffer_error_messages) - flush_octave_stdout (); - - // FIXME -- we really want to capture the message before it - // has all the formatting goop attached to it. We probably also - // want just the message, not the traceback information. - - std::ostringstream output_buf; - - octave_vformat (output_buf, fmt, args); - - std::string base_msg = output_buf.str (); - - bool to_beep_or_not_to_beep_p = Vbeep_on_error && ! error_state; - - std::string msg_string; - - if (to_beep_or_not_to_beep_p) - msg_string = "\a"; - - if (name) - msg_string += std::string (name) + ": "; - - // If with_fcn is specified, we'll attempt to prefix the message with the name - // of the current executing function. But we'll do so only if: - // 1. the name is not empty (anonymous function) - // 2. it is not already there (including the following colon) - if (with_cfn) - { - octave_function *curfcn = octave_call_stack::current (); - if (curfcn) - { - std::string cfn = curfcn->name (); - if (! cfn.empty ()) - { - cfn += ':'; - if (cfn.length () > base_msg.length () - || base_msg.compare (0, cfn.length (), cfn) != 0) - { - msg_string += cfn + ' '; - } - } - } - } - - msg_string += base_msg + "\n"; - - if (! error_state && save_last_error) - { - // This is the first error in a possible series. - - Vlast_error_id = id; - Vlast_error_message = base_msg; - - octave_user_code *fcn = octave_call_stack::caller_user_code (); - - if (fcn) - { - octave_idx_type curr_frame = -1; - - Vlast_error_stack = octave_call_stack::backtrace (0, curr_frame); - } - else - Vlast_error_stack = initialize_last_error_stack (); - } - - if (! buffer_error_messages) - { - octave_diary << msg_string; - os << msg_string; - } -} - -// Note that we don't actually print any message if the error string -// is just "" or "\n". This allows error ("") and error ("\n") to -// just set the error state. - -static void -error_1 (std::ostream& os, const char *name, const char *id, - const char *fmt, va_list args, bool with_cfn = false) -{ - if (error_state != -2) - { - if (fmt) - { - if (*fmt) - { - size_t len = strlen (fmt); - - if (len > 0) - { - if (fmt[len - 1] == '\n') - { - if (len > 1) - { - char *tmp_fmt = strsave (fmt); - tmp_fmt[len - 1] = '\0'; - verror (true, os, name, id, tmp_fmt, args, with_cfn); - delete [] tmp_fmt; - } - - error_state = -2; - } - else - { - verror (true, os, name, id, fmt, args, with_cfn); - - if (! error_state) - error_state = 1; - } - } - } - } - else - panic ("error_1: invalid format"); - } -} - -void -vmessage (const char *name, const char *fmt, va_list args) -{ - verror (false, std::cerr, name, "", fmt, args); -} - -void -message (const char *name, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vmessage (name, fmt, args); - va_end (args); -} - -void -vmessage_with_id (const char *name, const char *id, const char *fmt, - va_list args) -{ - verror (false, std::cerr, name, id, fmt, args); -} - -void -message_with_id (const char *name, const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vmessage_with_id (name, id, fmt, args); - va_end (args); -} - -void -usage_1 (const char *id, const char *fmt, va_list args) -{ - verror (true, std::cerr, "usage", id, fmt, args); - error_state = -1; -} - -void -vusage (const char *fmt, va_list args) -{ - usage_1 ("", fmt, args); -} - -void -usage (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vusage (fmt, args); - va_end (args); -} - -void -vusage_with_id (const char *id, const char *fmt, va_list args) -{ - usage_1 (id, fmt, args); -} - -void -usage_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vusage_with_id (id, fmt, args); - va_end (args); -} - -static void -pr_where_2 (const char *fmt, va_list args) -{ - if (fmt) - { - if (*fmt) - { - size_t len = strlen (fmt); - - if (len > 0) - { - if (fmt[len - 1] == '\n') - { - if (len > 1) - { - char *tmp_fmt = strsave (fmt); - tmp_fmt[len - 1] = '\0'; - verror (false, std::cerr, 0, "", tmp_fmt, args); - delete [] tmp_fmt; - } - } - else - verror (false, std::cerr, 0, "", fmt, args); - } - } - } - else - panic ("pr_where_2: invalid format"); -} - -static void -pr_where_1 (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - pr_where_2 (fmt, args); - va_end (args); -} - -static void -pr_where (const char *who) -{ - octave_idx_type curr_frame = -1; - - octave_map stk = octave_call_stack::backtrace (0, curr_frame); - - octave_idx_type nframes_to_display = stk.numel (); - - if (nframes_to_display > 0) - { - pr_where_1 ("%s: called from\n", who); - - Cell names = stk.contents ("name"); - Cell lines = stk.contents ("line"); - Cell columns = stk.contents ("column"); - - for (octave_idx_type i = 0; i < nframes_to_display; i++) - { - octave_value name = names(i); - octave_value line = lines(i); - octave_value column = columns(i); - - std::string nm = name.string_value (); - - pr_where_1 (" %s at line %d column %d\n", nm.c_str (), - line.int_value (), column.int_value ()); - } - } -} - -static void -error_2 (const char *id, const char *fmt, va_list args, bool with_cfn = false) -{ - int init_state = error_state; - - error_1 (std::cerr, "error", id, fmt, args, with_cfn); - - if ((interactive || forced_interactive) - && Vdebug_on_error && init_state == 0 - && octave_call_stack::caller_user_code ()) - { - unwind_protect frame; - frame.protect_var (Vdebug_on_error); - Vdebug_on_error = false; - - error_state = 0; - - pr_where ("error"); - - do_keyboard (octave_value_list ()); - } -} - -void -verror (const char *fmt, va_list args) -{ - error_2 ("", fmt, args); -} - -void -error (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror (fmt, args); - va_end (args); -} - -void -verror_with_cfn (const char *fmt, va_list args) -{ - error_2 ("", fmt, args, true); -} - -void -error_with_cfn (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror_with_cfn (fmt, args); - va_end (args); -} - -void -verror_with_id (const char *id, const char *fmt, va_list args) -{ - error_2 (id, fmt, args); -} - -void -error_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror_with_id (id, fmt, args); - va_end (args); -} - -void -verror_with_id_cfn (const char *id, const char *fmt, va_list args) -{ - error_2 (id, fmt, args, true); -} - -void -error_with_id_cfn (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror_with_id_cfn (id, fmt, args); - va_end (args); -} - -static int -check_state (const std::string& state) -{ - // -1: not found - // 0: found, "off" - // 1: found, "on" - // 2: found, "error" - - if (state == "off") - return 0; - else if (state == "on") - return 1; - else if (state == "error") - return 2; - else - return -1; -} - -// For given warning ID, return 0 if warnings are disabled, 1 if -// enabled, and 2 if the given ID should be an error instead of a -// warning. - -int -warning_enabled (const std::string& id) -{ - int retval = 0; - - int all_state = -1; - int id_state = -1; - - octave_idx_type nel = warning_options.numel (); - - if (nel > 0) - { - Cell identifier = warning_options.contents ("identifier"); - Cell state = warning_options.contents ("state"); - - bool all_found = false; - bool id_found = false; - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_value ov = identifier(i); - std::string ovs = ov.string_value (); - - if (! all_found && ovs == "all") - { - all_state = check_state (state(i).string_value ()); - - if (all_state >= 0) - all_found = true; - } - - if (! id_found && ovs == id) - { - id_state = check_state (state(i).string_value ()); - - if (id_state >= 0) - id_found = true; - } - - if (all_found && id_found) - break; - } - } - - // If "all" is not present, assume warnings are enabled. - if (all_state == -1) - all_state = 1; - - if (all_state == 0) - { - if (id_state >= 0) - retval = id_state; - } - else if (all_state == 1) - { - if (id_state == 0 || id_state == 2) - retval = id_state; - else - retval = all_state; - } - else if (all_state == 2) - { - if (id_state == 0) - retval= id_state; - else - retval = all_state; - } - - return retval; -} - -static void -warning_1 (const char *id, const char *fmt, va_list args) -{ - int warn_opt = warning_enabled (id); - - if (warn_opt == 2) - { - // Handle this warning as an error. - - error_2 (id, fmt, args); - } - else if (warn_opt == 1) - { - vwarning ("warning", id, fmt, args); - - if (! symbol_table::at_top_level () - && Vbacktrace_on_warning - && ! warning_state - && ! discard_warning_messages) - pr_where ("warning"); - - warning_state = 1; - - if ((interactive || forced_interactive) - && Vdebug_on_warning - && octave_call_stack::caller_user_code ()) - { - unwind_protect frame; - frame.protect_var (Vdebug_on_warning); - Vdebug_on_warning = false; - - do_keyboard (octave_value_list ()); - } - } -} - -void -vwarning (const char *fmt, va_list args) -{ - warning_1 ("", fmt, args); -} - -void -warning (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vwarning (fmt, args); - va_end (args); -} - -void -vwarning_with_id (const char *id, const char *fmt, va_list args) -{ - warning_1 (id, fmt, args); -} - -void -warning_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vwarning_with_id (id, fmt, args); - va_end (args); -} - -void -vparse_error (const char *fmt, va_list args) -{ - error_1 (std::cerr, 0, "", fmt, args); -} - -void -parse_error (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vparse_error (fmt, args); - va_end (args); -} - -void -vparse_error_with_id (const char *id, const char *fmt, va_list args) -{ - error_1 (std::cerr, 0, id, fmt, args); -} - -void -parse_error_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vparse_error_with_id (id, fmt, args); - va_end (args); -} - -void -rethrow_error (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - error_1 (std::cerr, 0, id, fmt, args); - va_end (args); -} - -void -panic (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - buffer_error_messages = 0; - discard_error_messages = false; - verror (false, std::cerr, "panic", "", fmt, args); - va_end (args); - abort (); -} - -static void -defun_usage_message_1 (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - error_1 (octave_stdout, 0, "", fmt, args); - va_end (args); -} - -void -defun_usage_message (const std::string& msg) -{ - defun_usage_message_1 ("%s", msg.c_str ()); -} - -typedef void (*error_fun)(const char *, const char *, ...); - -extern octave_value_list Fsprintf (const octave_value_list&, int); - -static std::string -handle_message (error_fun f, const char *id, const char *msg, - const octave_value_list& args, bool have_fmt) -{ - std::string retval; - - std::string tstr; - - int nargin = args.length (); - - if (nargin > 0) - { - octave_value arg; - - if (have_fmt) - { - octave_value_list tmp = Fsprintf (args, 1); - arg = tmp(0); - } - else - arg = args(0); - - if (arg.is_defined ()) - { - if (arg.is_string ()) - { - tstr = arg.string_value (); - msg = tstr.c_str (); - - if (! msg) - return retval; - } - else if (arg.is_empty ()) - return retval; - } - } - -// Ugh. - - size_t len = strlen (msg); - - if (len > 0) - { - if (msg[len - 1] == '\n') - { - if (len > 1) - { - char *tmp_msg = strsave (msg); - tmp_msg[len - 1] = '\0'; - f (id, "%s\n", tmp_msg); - retval = tmp_msg; - delete [] tmp_msg; - } - } - else - { - f (id, "%s", msg); - retval = msg; - } - } - - return retval; -} - -DEFUN (rethrow, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rethrow (@var{err})\n\ -Reissue a previous error as defined by @var{err}. @var{err} is a structure\n\ -that must contain at least the 'message' and 'identifier' fields. @var{err}\n\ -can also contain a field 'stack' that gives information on the assumed\n\ -location of the error. Typically @var{err} is returned from\n\ -@code{lasterror}.\n\ -@seealso{lasterror, lasterr, error}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin != 1) - print_usage (); - else - { - const octave_scalar_map err = args(0).scalar_map_value (); - - if (! error_state) - { - if (err.contains ("message") && err.contains ("identifier")) - { - std::string msg = err.contents ("message").string_value (); - std::string id = err.contents ("identifier").string_value (); - int len = msg.length (); - - std::string file; - std::string nm; - int l = -1; - int c = -1; - - octave_map err_stack = initialize_last_error_stack (); - - if (err.contains ("stack")) - { - err_stack = err.contents ("stack").map_value (); - - if (err_stack.numel () > 0) - { - if (err_stack.contains ("file")) - file = err_stack.contents ("file")(0).string_value (); - - if (err_stack.contains ("name")) - nm = err_stack.contents ("name")(0).string_value (); - - if (err_stack.contains ("line")) - l = err_stack.contents ("line")(0).nint_value (); - - if (err_stack.contains ("column")) - c = err_stack.contents ("column")(0).nint_value (); - } - } - - // Ugh. - char *tmp_msg = strsave (msg.c_str ()); - if (tmp_msg[len-1] == '\n') - { - if (len > 1) - { - tmp_msg[len - 1] = '\0'; - rethrow_error (id.c_str (), "%s\n", tmp_msg); - } - } - else - rethrow_error (id.c_str (), "%s", tmp_msg); - delete [] tmp_msg; - - // FIXME -- is this the right thing to do for - // Vlast_error_stack? Should it be saved and restored - // with unwind_protect? - - Vlast_error_stack = err_stack; - - if (err.contains ("stack")) - { - if (file.empty ()) - { - if (nm.empty ()) - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: near line %d, column %d", - l, c); - else - pr_where_1 ("error: near line %d", l); - } - } - else - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: called from `%s' near line %d, column %d", - nm.c_str (), l, c); - else - pr_where_1 ("error: called from `%d' near line %d", nm.c_str (), l); - } - } - } - else - { - if (nm.empty ()) - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: in file %s near line %d, column %d", - file.c_str (), l, c); - else - pr_where_1 ("error: in file %s near line %d", file.c_str (), l); - } - } - else - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: called from `%s' in file %s near line %d, column %d", - nm.c_str (), file.c_str (), l, c); - else - pr_where_1 ("error: called from `%d' in file %s near line %d", nm.c_str (), file.c_str (), l); - } - } - } - } - } - else - error ("rethrow: ERR structure must contain the fields 'message and 'identifier'"); - } - } - return retval; -} - -// Determine whether the first argument to error or warning function -// should be handled as the message identifier or as the format string. - -static bool -maybe_extract_message_id (const std::string& caller, - const octave_value_list& args, - octave_value_list& nargs, - std::string& id) -{ - nargs = args; - id = std::string (); - - int nargin = args.length (); - - bool have_fmt = nargin > 1; - - if (nargin > 0) - { - std::string arg1 = args(0).string_value (); - - if (! error_state) - { - // For compatibility with Matlab, an identifier must contain - // ':', but not at the beginning or the end, and it must not - // contain '%' (even if it is not a valid conversion - // operator) or whitespace. - - if (arg1.find_first_of ("% \f\n\r\t\v") == std::string::npos - && arg1.find (':') != std::string::npos - && arg1[0] != ':' - && arg1[arg1.length ()-1] != ':') - { - if (nargin > 1) - { - id = arg1; - - nargs.resize (nargin-1); - - for (int i = 1; i < nargin; i++) - nargs(i-1) = args(i); - } - else - nargs(0) = "call to " + caller - + " with message identifier requires message"; - } - } - } - - return have_fmt; -} - -DEFUN (error, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} error (@var{template}, @dots{})\n\ -@deftypefnx {Built-in Function} {} error (@var{id}, @var{template}, @dots{})\n\ -Format the optional arguments under the control of the template string\n\ -@var{template} using the same rules as the @code{printf} family of\n\ -functions (@pxref{Formatted Output}) and print the resulting message\n\ -on the @code{stderr} stream. The message is prefixed by the character\n\ -string @samp{error: }.\n\ -\n\ -Calling @code{error} also sets Octave's internal error state such that\n\ -control will return to the top level without evaluating any more\n\ -commands. This is useful for aborting from functions or scripts.\n\ -\n\ -If the error message does not end with a new line character, Octave will\n\ -print a traceback of all the function calls leading to the error. For\n\ -example, given the following function definitions:\n\ -\n\ -@example\n\ -@group\n\ -function f () g (); end\n\ -function g () h (); end\n\ -function h () nargin == 1 || error (\"nargin != 1\"); end\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -calling the function @code{f} will result in a list of messages that\n\ -can help you to quickly locate the exact location of the error:\n\ -\n\ -@example\n\ -@group\n\ -f ()\n\ -error: nargin != 1\n\ -error: called from:\n\ -error: error at line -1, column -1\n\ -error: h at line 1, column 27\n\ -error: g at line 1, column 15\n\ -error: f at line 1, column 15\n\ -@end group\n\ -@end example\n\ -\n\ -If the error message ends in a new line character, Octave will print the\n\ -message but will not display any traceback messages as it returns\n\ -control to the top level. For example, modifying the error message\n\ -in the previous example to end in a new line causes Octave to only print\n\ -a single message:\n\ -\n\ -@example\n\ -@group\n\ -function h () nargin == 1 || error (\"nargin != 1\\n\"); end\n\ -f ()\n\ -error: nargin != 1\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - octave_value_list nargs = args; - - std::string id; - - if (nargin == 0) - print_usage (); - else - { - bool have_fmt = false; - - if (nargin == 1 && args(0).is_map ()) - { - // empty struct is not an error. return and resume calling function. - if (args(0).is_empty ()) - return retval; - - octave_value_list tmp; - - octave_scalar_map m = args(0).scalar_map_value (); - - // empty struct is not an error. return and resume calling function. - if (m.nfields () == 0) - return retval; - - if (m.contains ("message")) - { - octave_value c = m.getfield ("message"); - - if (c.is_string ()) - nargs(0) = c.string_value (); - } - - if (m.contains ("identifier")) - { - octave_value c = m.getfield ("identifier"); - - if (c.is_string ()) - id = c.string_value (); - } - - // FIXME -- also need to handle "stack" field in error - // structure, but that will require some more significant - // surgery on handle_message, error_with_id, etc. - } - else - { - have_fmt = maybe_extract_message_id ("error", args, nargs, id); - - if (error_state) - return retval; - } - - handle_message (error_with_id, id.c_str (), "unspecified error", - nargs, have_fmt); - } - - return retval; -} - -DEFUN (warning, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} warning (@var{template}, @dots{})\n\ -@deftypefnx {Built-in Function} {} warning (@var{id}, @var{template}, @dots{})\n\ -@deftypefnx {Built-in Function} {} warning (\"on\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"off\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"query\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"error\", @var{id})\n\ -Format the optional arguments under the control of the template string\n\ -@var{template} using the same rules as the @code{printf} family of\n\ -functions (@pxref{Formatted Output}) and print the resulting message\n\ -on the @code{stderr} stream. The message is prefixed by the character\n\ -string @samp{warning: }.\n\ -You should use this function when you want to notify the user\n\ -of an unusual condition, but only when it makes sense for your program\n\ -to go on.\n\ -\n\ -The optional message identifier allows users to enable or disable\n\ -warnings tagged by @var{id}. The special identifier @samp{\"all\"} may\n\ -be used to set the state of all warnings.\n\ -\n\ -If the first argument is @samp{\"on\"} or @samp{\"off\"}, set the state\n\ -of a particular warning using the identifier @var{id}. If the first\n\ -argument is @samp{\"query\"}, query the state of this warning instead.\n\ -If the identifier is omitted, a value of @samp{\"all\"} is assumed. If\n\ -you set the state of a warning to @samp{\"error\"}, the warning named by\n\ -@var{id} is handled as if it were an error instead. So, for example, the\n\ -following handles all warnings as errors:\n\ -\n\ -@example\n\ -@group\n\ -warning (\"error\");\n\ -@end group\n\ -@end example\n\ -@seealso{warning_ids}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - int argc = nargin + 1; - - bool done = false; - - if (argc > 1 && args.all_strings_p ()) - { - string_vector argv = args.make_argv ("warning"); - - if (! error_state) - { - std::string arg1 = argv(1); - std::string arg2 = "all"; - - if (argc == 3) - arg2 = argv(2); - - if (arg1 == "on" || arg1 == "off" || arg1 == "error") - { - octave_map old_warning_options = warning_options; - - if (arg2 == "all") - { - octave_map tmp; - - Cell id (1, 1); - Cell st (1, 1); - - id(0) = arg2; - st(0) = arg1; - - // Since internal Octave functions are not - // compatible, turning all warnings into errors - // should leave the state of - // Octave:matlab-incompatible alone. - - if (arg1 == "error" - && warning_options.contains ("identifier")) - { - octave_idx_type n = 1; - - Cell tid = warning_options.contents ("identifier"); - Cell tst = warning_options.contents ("state"); - - for (octave_idx_type i = 0; i < tid.numel (); i++) - { - octave_value vid = tid(i); - - if (vid.is_string ()) - { - std::string key = vid.string_value (); - - if (key == "Octave:matlab-incompatible" - || key == "Octave:single-quote-string") - { - id.resize (dim_vector (1, n+1)); - st.resize (dim_vector (1, n+1)); - - id(n) = tid(i); - st(n) = tst(i); - - n++; - } - } - } - } - - tmp.assign ("identifier", id); - tmp.assign ("state", st); - - warning_options = tmp; - - done = true; - } - else if (arg2 == "backtrace") - { - if (arg1 != "error") - { - Vbacktrace_on_warning = (arg1 == "on"); - done = true; - } - } - else if (arg2 == "debug") - { - if (arg1 != "error") - { - Vdebug_on_warning = (arg1 == "on"); - done = true; - } - } - else if (arg2 == "verbose") - { - if (arg1 != "error") - { - Vverbose_warning = (arg1 == "on"); - done = true; - } - } - else if (arg2 == "quiet") - { - if (arg1 != "error") - { - Vquiet_warning = (arg1 == "on"); - done = true; - } - } - else - { - if (arg2 == "last") - arg2 = Vlast_warning_id; - - if (arg2 == "all") - initialize_warning_options (arg1); - else - { - Cell ident = warning_options.contents ("identifier"); - Cell state = warning_options.contents ("state"); - - octave_idx_type nel = ident.numel (); - - bool found = false; - - for (octave_idx_type i = 0; i < nel; i++) - { - if (ident(i).string_value () == arg2) - { - // FIXME -- if state for "all" is - // same as arg1, we can simply remove the - // item from the list. - - state(i) = arg1; - warning_options.assign ("state", state); - found = true; - break; - } - } - - if (! found) - { - // FIXME -- if state for "all" is - // same as arg1, we don't need to do anything. - - ident.resize (dim_vector (1, nel+1)); - state.resize (dim_vector (1, nel+1)); - - ident(nel) = arg2; - state(nel) = arg1; - - warning_options.clear (); - - warning_options.assign ("identifier", ident); - warning_options.assign ("state", state); - } - } - - done = true; - } - - if (done && nargout > 0) - retval = old_warning_options; - } - else if (arg1 == "query") - { - if (arg2 == "all") - retval = warning_options; - else if (arg2 == "backtrace" || arg2 == "debug" - || arg2 == "verbose" || arg2 == "quiet") - { - octave_scalar_map tmp; - tmp.assign ("identifier", arg2); - if (arg2 == "backtrace") - tmp.assign ("state", Vbacktrace_on_warning ? "on" : "off"); - else if (arg2 == "debug") - tmp.assign ("state", Vdebug_on_warning ? "on" : "off"); - else if (arg2 == "verbose") - tmp.assign ("state", Vverbose_warning ? "on" : "off"); - else - tmp.assign ("state", Vquiet_warning ? "on" : "off"); - - retval = tmp; - } - else - { - if (arg2 == "last") - arg2 = Vlast_warning_id; - - Cell ident = warning_options.contents ("identifier"); - Cell state = warning_options.contents ("state"); - - octave_idx_type nel = ident.numel (); - - bool found = false; - - std::string val; - - for (octave_idx_type i = 0; i < nel; i++) - { - if (ident(i).string_value () == arg2) - { - val = state(i).string_value (); - found = true; - break; - } - } - - if (! found) - { - for (octave_idx_type i = 0; i < nel; i++) - { - if (ident(i).string_value () == "all") - { - val = state(i).string_value (); - found = true; - break; - } - } - } - - if (found) - { - octave_scalar_map tmp; - - tmp.assign ("identifier", arg2); - tmp.assign ("state", val); - - retval = tmp; - } - else - error ("warning: unable to find default warning state!"); - } - - done = true; - } - } - } - else if (argc == 1) - { - retval = warning_options; - - done = true; - } - else if (argc == 2) - { - octave_value arg = args(0); - - octave_map old_warning_options = warning_options; - - if (arg.is_map ()) - { - octave_map m = arg.map_value (); - - if (m.contains ("identifier") && m.contains ("state")) - warning_options = m; - else - error ("warning: expecting structure with fields `identifier' and `state'"); - - done = true; - - if (nargout > 0) - retval = old_warning_options; - } - } - - if (! (error_state || done)) - { - octave_value_list nargs = args; - - std::string id; - - bool have_fmt = maybe_extract_message_id ("warning", args, nargs, id); - - if (error_state) - return retval; - - std::string prev_msg = Vlast_warning_message; - - std::string curr_msg = handle_message (warning_with_id, id.c_str (), - "unspecified warning", nargs, - have_fmt); - - if (nargout > 0) - retval = prev_msg; - } - - return retval; -} - -octave_value_list -set_warning_state (const std::string& id, const std::string& state) -{ - octave_value_list args; - - args(1) = id; - args(0) = state; - - return Fwarning (args, 1); -} - -octave_value_list -set_warning_state (const octave_value_list& args) -{ - return Fwarning (args, 1); -} - -void -disable_warning (const std::string& id) -{ - set_warning_state (id, "off"); -} - -void -initialize_default_warning_state (void) -{ - initialize_warning_options ("on"); - - // Most people will want to have the following disabled. - - disable_warning ("Octave:array-to-scalar"); - disable_warning ("Octave:array-to-vector"); - disable_warning ("Octave:imag-to-real"); - disable_warning ("Octave:matlab-incompatible"); - disable_warning ("Octave:missing-semicolon"); - disable_warning ("Octave:neg-dim-as-zero"); - disable_warning ("Octave:resize-on-range-error"); - disable_warning ("Octave:separator-insert"); - disable_warning ("Octave:single-quote-string"); - disable_warning ("Octave:str-to-num"); - disable_warning ("Octave:mixed-string-concat"); - disable_warning ("Octave:variable-switch-label"); - - // This should be an error unless we are in maximum braindamage mode. - // FIXME: Not quite right. This sets the error state even for braindamage - // mode. Also, this error is not triggered in normal mode because another - // error handler catches it first and gives: - // error: subscript indices must be either positive integers or logicals - set_warning_state ("Octave:noninteger-range-as-index", "error"); - -} - -DEFUN (lasterror, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{lasterr} =} lasterror ()\n\ -@deftypefnx {Built-in Function} {} lasterror (@var{err})\n\ -@deftypefnx {Built-in Function} {} lasterror (\"reset\")\n\ -Query or set the last error message structure. When called without\n\ -arguments, return a structure containing the last error message and other\n\ -information related to this error. The elements of the structure are:\n\ -\n\ -@table @asis\n\ -@item 'message'\n\ -The text of the last error message\n\ -\n\ -@item 'identifier'\n\ -The message identifier of this error message\n\ -\n\ -@item 'stack'\n\ -A structure containing information on where the message occurred. This may\n\ -be an empty structure if the information cannot\n\ -be obtained. The fields of the structure are:\n\ -\n\ -@table @asis\n\ -@item 'file'\n\ -The name of the file where the error occurred\n\ -\n\ -@item 'name'\n\ -The name of function in which the error occurred\n\ -\n\ -@item 'line'\n\ -The line number at which the error occurred\n\ -\n\ -@item 'column'\n\ -An optional field with the column number at which the error occurred\n\ -@end table\n\ -@end table\n\ -\n\ -The last error structure may be set by passing a scalar structure, @var{err},\n\ -as input. Any fields of @var{err} that match those above are set while any\n\ -unspecified fields are initialized with default values.\n\ -\n\ -If @code{lasterror} is called with the argument \"reset\", all fields are\n\ -set to their default values.\n\ -@seealso{lasterr}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - unwind_protect frame; - - frame.protect_var (error_state); - error_state = 0; - - if (nargin < 2) - { - octave_scalar_map err; - - err.assign ("message", Vlast_error_message); - err.assign ("identifier", Vlast_error_id); - - err.assign ("stack", octave_value (Vlast_error_stack)); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - if (args(0).string_value () == "reset") - { - Vlast_error_message = std::string (); - Vlast_error_id = std::string (); - - Vlast_error_stack = initialize_last_error_stack (); - } - else - error ("lasterror: unrecognized string argument"); - } - else if (args(0).is_map ()) - { - octave_scalar_map new_err = args(0).scalar_map_value (); - std::string new_error_message; - std::string new_error_id; - std::string new_error_file; - std::string new_error_name; - int new_error_line = -1; - int new_error_column = -1; - - if (! error_state && new_err.contains ("message")) - { - const std::string tmp = - new_err.getfield ("message").string_value (); - new_error_message = tmp; - } - - if (! error_state && new_err.contains ("identifier")) - { - const std::string tmp = - new_err.getfield ("identifier").string_value (); - new_error_id = tmp; - } - - if (! error_state && new_err.contains ("stack")) - { - octave_scalar_map new_err_stack = - new_err.getfield ("stack").scalar_map_value (); - - if (! error_state && new_err_stack.contains ("file")) - { - const std::string tmp = - new_err_stack.getfield ("file").string_value (); - new_error_file = tmp; - } - - if (! error_state && new_err_stack.contains ("name")) - { - const std::string tmp = - new_err_stack.getfield ("name").string_value (); - new_error_name = tmp; - } - - if (! error_state && new_err_stack.contains ("line")) - { - const int tmp = - new_err_stack.getfield ("line").nint_value (); - new_error_line = tmp; - } - - if (! error_state && new_err_stack.contains ("column")) - { - const int tmp = - new_err_stack.getfield ("column").nint_value (); - new_error_column = tmp; - } - } - - if (! error_state) - { - Vlast_error_message = new_error_message; - Vlast_error_id = new_error_id; - - octave_idx_type curr_frame = -1; - - Vlast_error_stack - = octave_call_stack::backtrace (0, curr_frame); - } - } - else - error ("lasterror: argument must be a structure or a string"); - } - - if (! error_state) - retval = err; - } - else - print_usage (); - - return retval; -} - -DEFUN (lasterr, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lasterr ()\n\ -@deftypefnx {Built-in Function} {} lasterr (@var{msg})\n\ -@deftypefnx {Built-in Function} {} lasterr (@var{msg}, @var{msgid})\n\ -Query or set the last error message. When called without input arguments,\n\ -return the last error message and message identifier. With one\n\ -argument, set the last error message to @var{msg}. With two arguments,\n\ -also set the last message identifier.\n\ -@seealso{lasterror}\n\ -@end deftypefn") -{ - octave_value_list retval; - - unwind_protect frame; - - frame.protect_var (error_state); - error_state = 0; - - int argc = args.length () + 1; - - if (argc < 4) - { - string_vector argv = args.make_argv ("lasterr"); - - if (! error_state) - { - std::string prev_error_id = Vlast_error_id; - std::string prev_error_message = Vlast_error_message; - - if (argc > 2) - Vlast_error_id = argv(2); - - if (argc > 1) - Vlast_error_message = argv(1); - - if (argc == 1 || nargout > 0) - { - retval(1) = prev_error_id; - retval(0) = prev_error_message; - } - } - else - error ("lasterr: expecting arguments to be character strings"); - } - else - print_usage (); - - return retval; -} - -DEFUN (lastwarn, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lastwarn (@var{msg}, @var{msgid})\n\ -Without any arguments, return the last warning message. With one\n\ -argument, set the last warning message to @var{msg}. With two arguments,\n\ -also set the last message identifier.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - if (argc < 4) - { - string_vector argv = args.make_argv ("lastwarn"); - - if (! error_state) - { - std::string prev_warning_id = Vlast_warning_id; - std::string prev_warning_message = Vlast_warning_message; - - if (argc > 2) - Vlast_warning_id = argv(2); - - if (argc > 1) - Vlast_warning_message = argv(1); - - if (argc == 1 || nargout > 0) - { - warning_state = 0; - retval(1) = prev_warning_id; - retval(0) = prev_warning_message; - } - } - else - error ("lastwarn: expecting arguments to be character strings"); - } - else - print_usage (); - - return retval; -} - -DEFUN (usage, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} usage (@var{msg})\n\ -Print the message @var{msg}, prefixed by the string @samp{usage: }, and\n\ -set Octave's internal error state such that control will return to the\n\ -top level without evaluating any more commands. This is useful for\n\ -aborting from functions.\n\ -\n\ -After @code{usage} is evaluated, Octave will print a traceback of all\n\ -the function calls leading to the usage message.\n\ -\n\ -You should use this function for reporting problems errors that result\n\ -from an improper call to a function, such as calling a function with an\n\ -incorrect number of arguments, or with arguments of the wrong type. For\n\ -example, most functions distributed with Octave begin with code like\n\ -this\n\ -\n\ -@example\n\ -@group\n\ -if (nargin != 2)\n\ - usage (\"foo (a, b)\");\n\ -endif\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -to check for the proper number of arguments.\n\ -@end deftypefn") -{ - octave_value_list retval; - handle_message (usage_with_id, "", "unknown", args, true); - return retval; -} - -DEFUN (beep_on_error, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} beep_on_error ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} beep_on_error (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} beep_on_error (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to ring the terminal bell before printing an error message.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (beep_on_error); -} - -DEFUN (debug_on_error, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} debug_on_error ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_error (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} debug_on_error (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to enter the debugger when an error is encountered. This will also\n\ -inhibit printing of the normal traceback message (you will only see\n\ -the top-level error message).\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (debug_on_error); -} - -DEFUN (debug_on_warning, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} debug_on_warning ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_warning (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} debug_on_warning (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to enter the debugger when a warning is encountered.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (debug_on_warning); -} - -std::string -last_error_message (void) -{ - return Vlast_error_message; -} - -std::string -last_error_id (void) -{ - return Vlast_error_id; -} - -std::string -last_warning_message (void) -{ - return Vlast_warning_message; -} - -std::string -last_warning_id (void) -{ - return Vlast_warning_id; -} - -void -interpreter_try (unwind_protect& frame) -{ - frame.protect_var (error_state); - frame.protect_var (buffer_error_messages); - frame.protect_var (Vdebug_on_error); - frame.protect_var (Vdebug_on_warning); - - buffer_error_messages++; - Vdebug_on_error = false; - Vdebug_on_warning = false; -} - - diff -r d02b229ce693 -r a132d206a36a src/error.h --- a/src/error.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,142 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_error_h) -#define octave_error_h 1 - -#include -#include - -class octave_value_list; -class unwind_protect; - -#define panic_impossible() \ - panic ("impossible state reached in file `%s' at line %d", \ - __FILE__, __LINE__) - -extern OCTINTERP_API void reset_error_handler (void); - -extern OCTINTERP_API int warning_enabled (const std::string& id); - -extern OCTINTERP_API void vmessage (const char *name, const char *fmt, va_list args); -extern OCTINTERP_API void message (const char *name, const char *fmt, ...); - -extern OCTINTERP_API void vusage (const char *fmt, va_list args); -extern OCTINTERP_API void usage (const char *fmt, ...); - -extern OCTINTERP_API void vwarning (const char *fmt, va_list args); -extern OCTINTERP_API void warning (const char *fmt, ...); - -extern OCTINTERP_API void verror (const char *fmt, va_list args); -extern OCTINTERP_API void error (const char *fmt, ...); - -extern OCTINTERP_API void verror_with_cfn (const char *fmt, va_list args); -extern OCTINTERP_API void error_with_cfn (const char *fmt, ...); - -extern OCTINTERP_API void vparse_error (const char *fmt, va_list args); -extern OCTINTERP_API void parse_error (const char *fmt, ...); - -extern OCTINTERP_API void -vmessage_with_id (const char *id, const char *name, const char *fmt, va_list args); - -extern OCTINTERP_API void -message_with_id (const char *id, const char *name, const char *fmt, ...); - -extern OCTINTERP_API void -vusage_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -usage_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -vwarning_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -warning_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -verror_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -error_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -verror_with_id_cfn (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -error_with_id_cfn (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -vparse_error_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -parse_error_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void panic (const char *fmt, ...) GCC_ATTR_NORETURN; - -// Helper function for print_usage defined in defun.cc. -extern OCTINTERP_API void defun_usage_message (const std::string& msg); - -extern OCTINTERP_API octave_value_list -set_warning_state (const std::string& id, const std::string& state); - -extern OCTINTERP_API octave_value_list -set_warning_state (const octave_value_list& args); - -extern OCTINTERP_API void disable_warning (const std::string& id); -extern OCTINTERP_API void initialize_default_warning_state (void); - -// TRUE means that Octave will try to enter the debugger when an error -// is encountered. This will also inhibit printing of the normal -// traceback message (you will only see the top-level error message). -extern OCTINTERP_API bool Vdebug_on_error; - -// TRUE means that Octave will try to enter the debugger when a warning -// is encountered. -extern OCTINTERP_API bool Vdebug_on_warning; - -// Current error state. -extern OCTINTERP_API int error_state; - -// Current warning state. -extern OCTINTERP_API int warning_state; - -// Tell the error handler whether to print messages, or just store -// them for later. Used for handling errors in eval() and -// the `unwind_protect' statement. -extern OCTINTERP_API int buffer_error_messages; - -// TRUE means error messages are turned off. -extern OCTINTERP_API bool discard_error_messages; - -// TRUE means warning messages are turned off. -extern OCTINTERP_API bool discard_warning_messages; - -// Helper functions to pass last error and warning messages and ids -extern OCTINTERP_API std::string last_error_message (void); -extern OCTINTERP_API std::string last_error_id (void); -extern OCTINTERP_API std::string last_warning_message (void); -extern OCTINTERP_API std::string last_warning_id (void); - -extern OCTINTERP_API void interpreter_try (unwind_protect&); - -#endif diff -r d02b229ce693 -r a132d206a36a src/file-io.cc --- a/src/file-io.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2335 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Originally written by John C. Campbell -// -// Thomas Baier added the original versions of -// the following functions: -// -// popen -// pclose -// execute (now popen2.m) -// sync_system (now merged with system) -// async_system (now merged with system) - -// Extensively revised by John W. Eaton , -// April 1996. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include -#include - -#include -#include -#include - -#ifdef HAVE_ZLIB_H -#include -#endif - -#include "error.h" -#include "file-ops.h" -#include "file-stat.h" -#include "lo-ieee.h" -#include "oct-env.h" -#include "oct-locbuf.h" - -#include "defun.h" -#include "file-io.h" -#include "load-path.h" -#include "oct-fstrm.h" -#include "oct-iostrm.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "oct-prcstrm.h" -#include "oct-stream.h" -#include "oct-strstrm.h" -#include "pager.h" -#include "sysdep.h" -#include "utils.h" -#include "variables.h" - -static octave_value stdin_file; -static octave_value stdout_file; -static octave_value stderr_file; - -static octave_stream stdin_stream; -static octave_stream stdout_stream; -static octave_stream stderr_stream; - -void -initialize_file_io (void) -{ - stdin_stream = octave_istream::create (&std::cin, "stdin"); - - // This uses octave_stdout (see pager.h), not std::cout so that Octave's - // standard output stream will pass through the pager. - - stdout_stream = octave_ostream::create (&octave_stdout, "stdout"); - - stderr_stream = octave_ostream::create (&std::cerr, "stderr"); - - stdin_file = octave_stream_list::insert (stdin_stream); - stdout_file = octave_stream_list::insert (stdout_stream); - stderr_file = octave_stream_list::insert (stderr_stream); -} - -void -close_files (void) -{ - octave_stream_list::clear (); -} - -// List of files to delete when we exit or crash. -// -// FIXME -- this should really be static, but that causes -// problems on some systems. -std::stack tmp_files; - -void -mark_for_deletion (const std::string& file) -{ - tmp_files.push (file); -} - -void -cleanup_tmp_files (void) -{ - while (! tmp_files.empty ()) - { - std::string filename = tmp_files.top (); - tmp_files.pop (); - gnulib::unlink (filename.c_str ()); - } -} - -static std::ios::openmode -fopen_mode_to_ios_mode (const std::string& mode_arg) -{ - std::ios::openmode retval = std::ios::in; - - if (! mode_arg.empty ()) - { - // Could probably be faster, but does it really matter? - - std::string mode = mode_arg; - - // 'W' and 'R' are accepted as 'w' and 'r', but we warn about - // them because Matlab says they perform "automatic flushing" - // but we don't know precisely what action that implies. - - size_t pos = mode.find ('W'); - - if (pos != std::string::npos) - { - warning ("fopen: treating mode \"W\" as equivalent to \"w\""); - mode[pos] = 'w'; - } - - pos = mode.find ('R'); - - if (pos != std::string::npos) - { - warning ("fopen: treating mode \"R\" as equivalent to \"r\""); - mode[pos] = 'r'; - } - - pos = mode.find ('z'); - - if (pos != std::string::npos) - { -#if defined (HAVE_ZLIB) - mode.erase (pos, 1); -#else - error ("this version of Octave does not support gzipped files"); -#endif - } - - if (! error_state) - { - if (mode == "rt") - retval = std::ios::in; - else if (mode == "wt") - retval = std::ios::out | std::ios::trunc; - else if (mode == "at") - retval = std::ios::out | std::ios::app; - else if (mode == "r+t" || mode == "rt+") - retval = std::ios::in | std::ios::out; - else if (mode == "w+t" || mode == "wt+") - retval = std::ios::in | std::ios::out | std::ios::trunc; - else if (mode == "a+t" || mode == "at+") - retval = std::ios::in | std::ios::out | std::ios::app; - else if (mode == "rb" || mode == "r") - retval = std::ios::in | std::ios::binary; - else if (mode == "wb" || mode == "w") - retval = std::ios::out | std::ios::trunc | std::ios::binary; - else if (mode == "ab" || mode == "a") - retval = std::ios::out | std::ios::app | std::ios::binary; - else if (mode == "r+b" || mode == "rb+" || mode == "r+") - retval = std::ios::in | std::ios::out | std::ios::binary; - else if (mode == "w+b" || mode == "wb+" || mode == "w+") - retval = (std::ios::in | std::ios::out | std::ios::trunc - | std::ios::binary); - else if (mode == "a+b" || mode == "ab+" || mode == "a+") - retval = (std::ios::in | std::ios::out | std::ios::app - | std::ios::binary); - else - ::error ("invalid mode specified"); - } - } - - return retval; -} - -DEFUN (fclose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fclose (@var{fid})\n\ -@deftypefnx {Built-in Function} {} fclose (\"all\")\n\ -Close the specified file. If successful, @code{fclose} returns 0,\n\ -otherwise, it returns -1. The second form of the @code{fclose} call closes\n\ -all open files except @code{stdout}, @code{stderr}, and @code{stdin}.\n\ -@seealso{fopen, freport}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - retval = octave_stream_list::remove (args(0), "fclose"); - else - print_usage (); - - return retval; -} - -DEFUN (fclear, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fclear (@var{fid})\n\ -Clear the stream state for the specified file.\n\ -@seealso{fopen}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - int fid = octave_stream_list::get_file_number (args (0)); - - octave_stream os = octave_stream_list::lookup (fid, "fclear"); - - if (! error_state) - os.clearerr (); - } - else - print_usage (); - - return retval; -} - -DEFUN (fflush, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fflush (@var{fid})\n\ -Flush output to @var{fid}. This is useful for ensuring that all\n\ -pending output makes it to the screen before some other event occurs.\n\ -For example, it is always a good idea to flush the standard output\n\ -stream before calling @code{input}.\n\ -\n\ -@code{fflush} returns 0 on success and an OS dependent error value\n\ -(@minus{}1 on Unix) on error.\n\ -@seealso{fopen, fclose}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - // FIXME -- any way to avoid special case for stdout? - - int fid = octave_stream_list::get_file_number (args (0)); - - if (fid == 1) - { - flush_octave_stdout (); - - retval = 0; - } - else - { - octave_stream os = octave_stream_list::lookup (fid, "fflush"); - - if (! error_state) - retval = os.flush (); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fgetl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{str} =} fgetl (@var{fid})\n\ -@deftypefnx {Built-in Function} {@var{str} =} fgetl (@var{fid}, @var{len})\n\ -Read characters from a file, stopping after a newline, or EOF,\n\ -or @var{len} characters have been read. The characters read, excluding\n\ -the possible trailing newline, are returned as a string.\n\ -\n\ -If @var{len} is omitted, @code{fgetl} reads until the next newline\n\ -character.\n\ -\n\ -If there are no more characters to read, @code{fgetl} returns @minus{}1.\n\ -\n\ -To read a line and return the terminating newline see @code{fgets}.\n\ -@seealso{fgets, fscanf, fread, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fgetl"; - - octave_value_list retval; - - retval(1) = 0; - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); - - bool err = false; - - std::string tmp = os.getl (len_arg, err, who); - - if (! (error_state || err)) - { - retval(1) = tmp.length (); - retval(0) = tmp; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fgets, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{str} =} fgets (@var{fid})\n\ -@deftypefnx {Built-in Function} {@var{str} =} fgets (@var{fid}, @var{len})\n\ -Read characters from a file, stopping after a newline, or EOF,\n\ -or @var{len} characters have been read. The characters read, including\n\ -the possible trailing newline, are returned as a string.\n\ -\n\ -If @var{len} is omitted, @code{fgets} reads until the next newline\n\ -character.\n\ -\n\ -If there are no more characters to read, @code{fgets} returns @minus{}1.\n\ -\n\ -To read a line and discard the terminating newline see @code{fgetl}.\n\ -@seealso{fputs, fgetl, fscanf, fread, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fgets"; - - octave_value_list retval; - - retval(1) = 0.0; - retval(0) = -1.0; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); - - bool err = false; - - std::string tmp = os.gets (len_arg, err, who); - - if (! (error_state || err)) - { - retval(1) = tmp.length (); - retval(0) = tmp; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fskipl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{nlines} =} fskipl (@var{fid})\n\ -@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, @var{count})\n\ -@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, Inf)\n\ -Read and skip @var{count} lines from the file descriptor @var{fid}.\n\ -@code{fskipl} discards characters until an end-of-line is encountered exactly\n\ -@var{count}-times, or until the end-of-file marker is found.\n\ -\n\ -If @var{count} is omitted, it defaults to 1. @var{count} may also be\n\ -@code{Inf}, in which case lines are skipped until the end of the file.\n\ -This form is suitable for counting the number of lines in a file.\n\ -\n\ -Returns the number of lines skipped (end-of-line sequences encountered).\n\ -@seealso{fgetl, fgets, fscanf, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fskipl"; - - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - octave_value count_arg = (nargin == 2) ? args(1) : octave_value (); - - bool err = false; - - long tmp = os.skipl (count_arg, err, who); - - if (! (error_state || err)) - retval = tmp; - } - } - else - print_usage (); - - return retval; -} - - -static octave_stream -do_stream_open (const std::string& name, const std::string& mode, - const std::string& arch, int& fid) -{ - octave_stream retval; - - fid = -1; - - std::ios::openmode md = fopen_mode_to_ios_mode (mode); - - if (! error_state) - { - oct_mach_info::float_format flt_fmt = - oct_mach_info::string_to_float_format (arch); - - if (! error_state) - { - std::string fname = file_ops::tilde_expand (name); - - file_stat fs (fname); - - if (! (md & std::ios::out - || octave_env::absolute_pathname (fname) - || octave_env::rooted_relative_pathname (fname))) - { - if (! fs.exists ()) - { - std::string tmp - = octave_env::make_absolute (load_path::find_file (fname)); - - if (! tmp.empty ()) - { - warning_with_id ("Octave:fopen-file-in-path", - "fopen: file found in load path"); - fname = tmp; - } - } - } - - if (! fs.is_dir ()) - { - std::string tmode = mode; - - // Use binary mode if 't' is not specified, but don't add - // 'b' if it is already present. - - size_t bpos = tmode.find ('b'); - size_t tpos = tmode.find ('t'); - - if (bpos == std::string::npos && tpos == std::string::npos) - tmode += 'b'; - -#if defined (HAVE_ZLIB) - size_t pos = tmode.find ('z'); - - if (pos != std::string::npos) - { - tmode.erase (pos, 1); - - FILE *fptr = gnulib::fopen (fname.c_str (), tmode.c_str ()); - - int fd = fileno (fptr); - - gzFile gzf = ::gzdopen (fd, tmode.c_str ()); - - if (fptr) - retval = octave_zstdiostream::create (fname, gzf, fd, - md, flt_fmt); - else - retval.error (gnulib::strerror (errno)); - } - else -#endif - { - FILE *fptr = gnulib::fopen (fname.c_str (), tmode.c_str ()); - - retval = octave_stdiostream::create (fname, fptr, md, flt_fmt); - - if (! fptr) - retval.error (gnulib::strerror (errno)); - } - - } - } - } - - return retval; -} - -static octave_stream -do_stream_open (const octave_value& tc_name, const octave_value& tc_mode, - const octave_value& tc_arch, const char *fcn, int& fid) -{ - octave_stream retval; - - fid = -1; - - std::string name = tc_name.string_value (); - - if (! error_state) - { - std::string mode = tc_mode.string_value (); - - if (! error_state) - { - std::string arch = tc_arch.string_value (); - - if (! error_state) - retval = do_stream_open (name, mode, arch, fid); - else - ::error ("%s: architecture type must be a string", fcn); - } - else - ::error ("%s: file mode must be a string", fcn); - } - else - ::error ("%s: file name must be a string", fcn); - - return retval; -} - -DEFUN (fopen, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} fopen (@var{name}, @var{mode}, @var{arch})\n\ -@deftypefnx {Built-in Function} {@var{fid_list} =} fopen (\"all\")\n\ -@deftypefnx {Built-in Function} {[@var{file}, @var{mode}, @var{arch}] =} fopen (@var{fid})\n\ -The first form of the @code{fopen} function opens the named file with\n\ -the specified mode (read-write, read-only, etc.) and architecture\n\ -interpretation (IEEE big endian, IEEE little endian, etc.), and returns\n\ -an integer value that may be used to refer to the file later. If an\n\ -error occurs, @var{fid} is set to @minus{}1 and @var{msg} contains the\n\ -corresponding system error message. The @var{mode} is a one or two\n\ -character string that specifies whether the file is to be opened for\n\ -reading, writing, or both.\n\ -\n\ -The second form of the @code{fopen} function returns a vector of file ids\n\ -corresponding to all the currently open files, excluding the\n\ -@code{stdin}, @code{stdout}, and @code{stderr} streams.\n\ -\n\ -The third form of the @code{fopen} function returns information about the\n\ -open file given its file id.\n\ -\n\ -For example,\n\ -\n\ -@example\n\ -myfile = fopen (\"splat.dat\", \"r\", \"ieee-le\");\n\ -@end example\n\ -\n\ -@noindent\n\ -opens the file @file{splat.dat} for reading. If necessary, binary\n\ -numeric values will be read assuming they are stored in IEEE format with\n\ -the least significant bit first, and then converted to the native\n\ -representation.\n\ -\n\ -Opening a file that is already open simply opens it again and returns a\n\ -separate file id. It is not an error to open a file several times,\n\ -though writing to the same file through several different file ids may\n\ -produce unexpected results.\n\ -\n\ -The possible values @samp{mode} may have are\n\ -\n\ -@table @asis\n\ -@item @samp{r}\n\ -Open a file for reading.\n\ -\n\ -@item @samp{w}\n\ -Open a file for writing. The previous contents are discarded.\n\ -\n\ -@item @samp{a}\n\ -Open or create a file for writing at the end of the file.\n\ -\n\ -@item @samp{r+}\n\ -Open an existing file for reading and writing.\n\ -\n\ -@item @samp{w+}\n\ -Open a file for reading or writing. The previous contents are\n\ -discarded.\n\ -\n\ -@item @samp{a+}\n\ -Open or create a file for reading or writing at the end of the\n\ -file.\n\ -@end table\n\ -\n\ -Append a \"t\" to the mode string to open the file in text mode or a\n\ -\"b\" to open in binary mode. On Windows and Macintosh systems, text\n\ -mode reading and writing automatically converts linefeeds to the\n\ -appropriate line end character for the system (carriage-return linefeed\n\ -on Windows, carriage-return on Macintosh). The default if no mode is\n\ -specified is binary mode.\n\ -\n\ -Additionally, you may append a \"z\" to the mode string to open a\n\ -gzipped file for reading or writing. For this to be successful, you\n\ -must also open the file in binary mode.\n\ -\n\ -The parameter @var{arch} is a string specifying the default data format\n\ -for the file. Valid values for @var{arch} are:\n\ -\n\ -@table @asis\n\ -@samp{native}\n\ -The format of the current machine (this is the default).\n\ -\n\ -@samp{ieee-be}\n\ -IEEE big endian format.\n\ -\n\ -@samp{ieee-le}\n\ -IEEE little endian format.\n\ -\n\ -@samp{vaxd}\n\ -VAX D floating format.\n\ -\n\ -@samp{vaxg}\n\ -VAX G floating format.\n\ -\n\ -@samp{cray}\n\ -Cray floating format.\n\ -@end table\n\ -\n\ -@noindent\n\ -however, conversions are currently only supported for @samp{native}\n\ -@samp{ieee-be}, and @samp{ieee-le} formats.\n\ -@seealso{fclose, fgets, fgetl, fscanf, fread, fputs, fdisp, fprintf, fwrite, fskipl, fseek, frewind, ftell, feof, ferror, fclear, fflush, freport}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(0) = -1.0; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - // If there is only one argument and it is a string but it - // is not the string "all", we assume it is a file to open - // with MODE = "r". To open a file called "all", you have - // to supply more than one argument. - - if (nargout < 2 && args(0).string_value () == "all") - return octave_stream_list::open_file_numbers (); - } - else - { - string_vector tmp = octave_stream_list::get_info (args(0)); - - if (! error_state) - { - retval(2) = tmp(2); - retval(1) = tmp(1); - retval(0) = tmp(0); - } - - return retval; - } - } - - if (nargin > 0 && nargin < 4) - { - octave_value mode = (nargin == 2 || nargin == 3) - ? args(1) : octave_value ("r"); - - octave_value arch = (nargin == 3) - ? args(2) : octave_value ("native"); - - int fid = -1; - - octave_stream os = do_stream_open (args(0), mode, arch, "fopen", fid); - - if (os && ! error_state) - { - retval(1) = ""; - retval(0) = octave_stream_list::insert (os); - } - else - { - int error_number = 0; - - retval(1) = os.error (false, error_number); - retval(0) = -1.0; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (freport, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} freport ()\n\ -Print a list of which files have been opened, and whether they are open\n\ -for reading, writing, or both. For example:\n\ -\n\ -@example\n\ -@group\n\ -freport ()\n\ -\n\ - @print{} number mode name\n\ - @print{}\n\ - @print{} 0 r stdin\n\ - @print{} 1 w stdout\n\ - @print{} 2 w stderr\n\ - @print{} 3 r myfile\n\ -@end group\n\ -@end example\n\ -@seealso{fopen, fclose}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - warning ("freport: ignoring extra arguments"); - - octave_stdout << octave_stream_list::list_open_files (); - - return retval; -} - -DEFUN (frewind, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} frewind (@var{fid})\n\ -Move the file pointer to the beginning of the file @var{fid}, returning\n\ -0 for success, and -1 if an error was encountered. It is equivalent to\n\ -@code{fseek (@var{fid}, 0, SEEK_SET)}.\n\ -@seealso{fseek, ftell, fopen}\n\ -@end deftypefn") -{ - octave_value retval; - - int result = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_stream os = octave_stream_list::lookup (args(0), "frewind"); - - if (! error_state) - result = os.rewind (); - } - else - print_usage (); - - if (nargout > 0) - retval = result; - - return retval; -} - -DEFUN (fseek, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fseek (@var{fid}, @var{offset})\n\ -@deftypefnx {Built-in Function} {} fseek (@var{fid}, @var{offset}, @var{origin})\n\ -@deftypefnx {Built-in Function} {@var{status} =} fseek (@dots{})\n\ -Set the file pointer to any location within the file @var{fid}.\n\ -\n\ -The pointer is positioned @var{offset} characters from the @var{origin},\n\ -which may be one of the predefined variables @w{@code{SEEK_CUR}} (current\n\ -position), @w{@code{SEEK_SET}} (beginning), or @w{@code{SEEK_END}} (end of\n\ -file) or strings \"cof\", \"bof\" or \"eof\". If @var{origin} is omitted,\n\ -@w{@code{SEEK_SET}} is assumed. @var{offset} may be positive, negative, or zero but not all combinations of @var{origin} and @var{offset} can be realized.\n\ -\n\ -Return 0 on success and -1 on error.\n\ -@seealso{fskipl, frewind, ftell, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - octave_stream os = octave_stream_list::lookup (args(0), "fseek"); - - if (! error_state) - { - octave_value origin_arg = (nargin == 3) - ? args(2) : octave_value (-1.0); - - retval = os.seek (args(1), origin_arg); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (ftell, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ftell (@var{fid})\n\ -Return the position of the file pointer as the number of characters\n\ -from the beginning of the file @var{fid}.\n\ -@seealso{fseek, feof, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_stream os = octave_stream_list::lookup (args(0), "ftell"); - - if (! error_state) - retval = os.tell (); - } - else - print_usage (); - - return retval; -} - -DEFUN (fprintf, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fprintf (@var{fid}, @var{template}, @dots{})\n\ -This function is just like @code{printf}, except that the output is\n\ -written to the stream @var{fid} instead of @code{stdout}.\n\ -If @var{fid} is omitted, the output is written to @code{stdout}.\n\ -@seealso{fputs, fdisp, fwrite, fscanf, printf, sprintf, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fprintf"; - - octave_value retval; - - int result = -1; - - int nargin = args.length (); - - if (nargin > 1 || (nargin > 0 && args(0).is_string ())) - { - octave_stream os; - int fmt_n = 0; - - if (args(0).is_string ()) - { - os = octave_stream_list::lookup (1, who); - } - else - { - fmt_n = 1; - os = octave_stream_list::lookup (args(0), who); - } - - if (! error_state) - { - if (args(fmt_n).is_string ()) - { - octave_value_list tmp_args; - - if (nargin > 1 + fmt_n) - { - tmp_args.resize (nargin-fmt_n-1, octave_value ()); - - for (int i = fmt_n + 1; i < nargin; i++) - tmp_args(i-fmt_n-1) = args(i); - } - - result = os.printf (args(fmt_n), tmp_args, who); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - } - else - print_usage (); - - if (nargout > 0) - retval = result; - - return retval; -} - -DEFUN (printf, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} printf (@var{template}, @dots{})\n\ -Print optional arguments under the control of the template string\n\ -@var{template} to the stream @code{stdout} and return the number of\n\ -characters printed.\n\ -@ifclear OCTAVE_MANUAL\n\ -\n\ -See the Formatted Output section of the GNU Octave manual for a\n\ -complete description of the syntax of the template string.\n\ -@end ifclear\n\ -@seealso{fprintf, sprintf, scanf}\n\ -@end deftypefn") -{ - static std::string who = "printf"; - - octave_value retval; - - int result = -1; - - int nargin = args.length (); - - if (nargin > 0) - { - if (args(0).is_string ()) - { - octave_value_list tmp_args; - - if (nargin > 1) - { - tmp_args.resize (nargin-1, octave_value ()); - - for (int i = 1; i < nargin; i++) - tmp_args(i-1) = args(i); - } - - result = stdout_stream.printf (args(0), tmp_args, who); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - print_usage (); - - if (nargout > 0) - retval = result; - - return retval; -} - -DEFUN (fputs, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fputs (@var{fid}, @var{string})\n\ -Write a string to a file with no formatting.\n\ -\n\ -Return a non-negative number on success and EOF on error.\n\ -@seealso{fdisp, fprintf, fwrite, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fputs"; - - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - retval = os.puts (args(1), who); - } - else - print_usage (); - - return retval; -} - -DEFUN (puts, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} puts (@var{string})\n\ -Write a string to the standard output with no formatting.\n\ -\n\ -Return a non-negative number on success and EOF on error.\n\ -@seealso{fputs, disp}\n\ -@end deftypefn") -{ - static std::string who = "puts"; - - octave_value retval = -1; - - if (args.length () == 1) - retval = stdout_stream.puts (args(0), who); - else - print_usage (); - - return retval; -} - -DEFUN (sprintf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sprintf (@var{template}, @dots{})\n\ -This is like @code{printf}, except that the output is returned as a\n\ -string. Unlike the C library function, which requires you to provide a\n\ -suitably sized string as an argument, Octave's @code{sprintf} function\n\ -returns the string, automatically sized to hold all of the items\n\ -converted.\n\ -@seealso{printf, fprintf, sscanf}\n\ -@end deftypefn") -{ - static std::string who = "sprintf"; - - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - { - retval(2) = -1.0; - retval(1) = "unknown error"; - retval(0) = ""; - - octave_ostrstream *ostr = new octave_ostrstream (); - - octave_stream os (ostr); - - if (os.is_valid ()) - { - octave_value fmt_arg = args(0); - - if (fmt_arg.is_string ()) - { - octave_value_list tmp_args; - - if (nargin > 1) - { - tmp_args.resize (nargin-1, octave_value ()); - - for (int i = 1; i < nargin; i++) - tmp_args(i-1) = args(i); - } - - retval(2) = os.printf (fmt_arg, tmp_args, who); - retval(1) = os.error (); - retval(0) = octave_value (ostr->str (), - fmt_arg.is_sq_string () ? '\'' : '"'); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - ::error ("%s: unable to create output buffer", who.c_str ()); - } - else - print_usage (); - - return retval; -} - -DEFUN (fscanf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} fscanf (@var{fid}, @var{template}, @var{locale})\n\ -In the first form, read from @var{fid} according to @var{template},\n\ -returning the result in the matrix @var{val}.\n\ -\n\ -The optional argument @var{size} specifies the amount of data to read\n\ -and may be one of\n\ -\n\ -@table @code\n\ -@item Inf\n\ -Read as much as possible, returning a column vector.\n\ -\n\ -@item @var{nr}\n\ -Read up to @var{nr} elements, returning a column vector.\n\ -\n\ -@item [@var{nr}, Inf]\n\ -Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ -number of elements read is not an exact multiple of @var{nr}, the last\n\ -column is padded with zeros.\n\ -\n\ -@item [@var{nr}, @var{nc}]\n\ -Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ -@var{nr} rows. If the number of elements read is not an exact multiple\n\ -of @var{nr}, the last column is padded with zeros.\n\ -@end table\n\ -\n\ -@noindent\n\ -If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ -\n\ -A string is returned if @var{template} specifies only character\n\ -conversions.\n\ -\n\ -The number of items successfully read is returned in @var{count}.\n\ -\n\ -If an error occurs, @var{errmsg} contains a system-dependent error message.\n\ -\n\ -In the second form, read from @var{fid} according to @var{template},\n\ -with each conversion specifier in @var{template} corresponding to a\n\ -single scalar return value. This form is more `C-like', and also\n\ -compatible with previous versions of Octave. The number of successful\n\ -conversions is returned in @var{count}. It permits to explicitly\n\ -specify a locale to take into account language specific features, \n\ -such as decimal separator. This operation restores the previous locales\n\ -setting at the end of the conversion.\n\ -@ifclear OCTAVE_MANUAL\n\ -\n\ -See the Formatted Input section of the GNU Octave manual for a\n\ -complete description of the syntax of the template string.\n\ -@end ifclear\n\ -@seealso{fgets, fgetl, fread, scanf, sscanf, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fscanf"; - - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 3 && args(2).is_string ()) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - if (args(1).is_string ()) - { - std::locale oldloc; - try - { - // Use args(2) val as the new locale setting. Keep - // old val for restoring afterwards. - oldloc = - os.imbue (std::locale (args(2).string_value ().c_str ())); - - } - catch (std::runtime_error) - { - // Display a warning if the specified locale is unknown - warning ("fscanf: invalid locale. Try `locale -a' for a list of supported values."); - oldloc = std::locale::classic (); - } - retval = os.oscanf (args(1), who); - os.imbue (oldloc); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - } - else - { - retval(2) = "unknown error"; - retval(1) = 0.0; - retval(0) = Matrix (); - - if (nargin == 2 || nargin == 3) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - if (args(1).is_string ()) - { - octave_idx_type count = 0; - - Array size = (nargin == 3) - ? args(2).vector_value () - : Array (dim_vector (1, 1), lo_ieee_inf_value ()); - - if (! error_state) - { - octave_value tmp = os.scanf (args(1), size, count, who); - - if (! error_state) - { - retval(2) = os.error (); - retval(1) = count; - retval(0) = tmp; - } - } - } - else - ::error ("%s: format must be a string", who.c_str ()); - } - } - else - print_usage (); - } - - return retval; -} - -static std::string -get_sscanf_data (const octave_value& val) -{ - std::string retval; - - if (val.is_string ()) - { - octave_value tmp = val.reshape (dim_vector (1, val.numel ())); - - retval = tmp.string_value (); - } - else - ::error ("sscanf: argument STRING must be a string"); - - return retval; -} - -DEFUN (sscanf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}, @var{pos}] =} sscanf (@var{string}, @var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} sscanf (@var{string}, @var{template}, @var{locale})\n\ -This is like @code{fscanf}, except that the characters are taken from the\n\ -string @var{string} instead of from a stream. Reaching the end of the\n\ -string is treated as an end-of-file condition. In addition to the values\n\ -returned by @code{fscanf}, the index of the next character to be read\n\ -is returned in @var{pos}.\n\ -@seealso{fscanf, scanf, sprintf}\n\ -@end deftypefn") -{ - static std::string who = "sscanf"; - - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 3 && args(2).is_string ()) - { - std::string data = get_sscanf_data (args(0)); - - if (! error_state) - { - octave_stream os = octave_istrstream::create (data); - - if (os.is_valid ()) - { - if (args(1).is_string ()) - { - // Use args(2) val as the new locale setting. As the os - // object is short lived, we don't need to restore - // locale afterwards. - try - { - os.imbue (std::locale (args(2).string_value ().c_str ())); - } - catch (std::runtime_error) - { - // Display a warning if the specified locale is unknown - warning ("sscanf: invalid locale. Try `locale -a' for a list of supported values."); - } - retval = os.oscanf (args(1), who); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - ::error ("%s: unable to create temporary input buffer", - who.c_str ()); - } - else - ::error ("%s: argument STRING must be a string", who.c_str ()); - } - else - { - if (nargin == 2 || nargin == 3) - { - retval(3) = -1.0; - retval(2) = "unknown error"; - retval(1) = 0.0; - retval(0) = Matrix (); - - std::string data = get_sscanf_data (args(0)); - - if (! error_state) - { - octave_stream os = octave_istrstream::create (data); - - if (os.is_valid ()) - { - if (args(1).is_string ()) - { - octave_idx_type count = 0; - - Array size = (nargin == 3) - ? args(2).vector_value () - : Array (dim_vector (1, 1), - lo_ieee_inf_value ()); - - octave_value tmp = os.scanf (args(1), size, count, who); - - if (! error_state) - { - // FIXME -- is this the right thing to do? - // Extract error message first, because getting - // position will clear it. - std::string errmsg = os.error (); - - retval(3) - = (os.eof () ? data.length () : os.tell ()) + 1; - retval(2) = errmsg; - retval(1) = count; - retval(0) = tmp; - } - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - ::error ("%s: unable to create temporary input buffer", - who.c_str ()); - } - } - else - print_usage (); - } - - return retval; -} - -/* -%!test -%! assert (sscanf ("1,2", "%f", "C"), 1) -%! assert (sscanf ("1,2", "%f", "fr_FR"), 1.2) -*/ - -DEFUN (scanf, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} scanf (@var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} scanf (@var{template}, @var{locale})\n\ -This is equivalent to calling @code{fscanf} with @var{fid} = @code{stdin}.\n\ -\n\ -It is currently not useful to call @code{scanf} in interactive\n\ -programs.\n\ -@seealso{fscanf, sscanf, printf}\n\ -@end deftypefn") -{ - int nargin = args.length (); - - octave_value_list tmp_args (nargin+1, octave_value ()); - - tmp_args (0) = 0.0; - for (int i = 0; i < nargin; i++) - tmp_args (i+1) = args (i); - - return Ffscanf (tmp_args, nargout); -} - -static octave_value -do_fread (octave_stream& os, const octave_value& size_arg, - const octave_value& prec_arg, const octave_value& skip_arg, - const octave_value& arch_arg, octave_idx_type& count) -{ - octave_value retval; - - count = -1; - - Array size = size_arg.vector_value (); - - if (! error_state) - { - std::string prec = prec_arg.string_value (); - - if (! error_state) - { - int block_size = 1; - oct_data_conv::data_type input_type; - oct_data_conv::data_type output_type; - - oct_data_conv::string_to_data_type (prec, block_size, - input_type, output_type); - - if (! error_state) - { - int skip = skip_arg.int_value (true); - - if (! error_state) - { - std::string arch = arch_arg.string_value (); - - if (! error_state) - { - oct_mach_info::float_format flt_fmt - = oct_mach_info::string_to_float_format (arch); - - if (! error_state) - retval = os.read (size, block_size, input_type, - output_type, skip, flt_fmt, count); - } - else - ::error ("fread: ARCH architecture type must be a string"); - } - else - ::error ("fread: SKIP must be an integer"); - } - else - ::error ("fread: invalid PRECISION specified"); - } - else - ::error ("fread: PRECISION must be a string"); - } - else - ::error ("fread: invalid SIZE specified"); - - return retval; -} - -DEFUN (fread, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}] =} fread (@var{fid}, @var{size}, @var{precision}, @var{skip}, @var{arch})\n\ -Read binary data of type @var{precision} from the specified file ID\n\ -@var{fid}.\n\ -\n\ -The optional argument @var{size} specifies the amount of data to read\n\ -and may be one of\n\ -\n\ -@table @code\n\ -@item Inf\n\ -Read as much as possible, returning a column vector.\n\ -\n\ -@item @var{nr}\n\ -Read up to @var{nr} elements, returning a column vector.\n\ -\n\ -@item [@var{nr}, Inf]\n\ -Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ -number of elements read is not an exact multiple of @var{nr}, the last\n\ -column is padded with zeros.\n\ -\n\ -@item [@var{nr}, @var{nc}]\n\ -Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ -@var{nr} rows. If the number of elements read is not an exact multiple\n\ -of @var{nr}, the last column is padded with zeros.\n\ -@end table\n\ -\n\ -@noindent\n\ -If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ -\n\ -The optional argument @var{precision} is a string specifying the type of\n\ -data to read and may be one of\n\ -\n\ -@table @asis\n\ -@item \"schar\"\n\ -@itemx \"signed char\"\n\ -Signed character.\n\ -\n\ -@item \"uchar\"\n\ -@itemx \"unsigned char\"\n\ -Unsigned character.\n\ -\n\ -@item \"int8\"\n\ -@itemx \"integer*1\"\n\ -\n\ -8-bit signed integer.\n\ -\n\ -@item \"int16\"\n\ -@itemx \"integer*2\"\n\ -16-bit signed integer.\n\ -\n\ -@item \"int32\"\n\ -@itemx \"integer*4\"\n\ -32-bit signed integer.\n\ -\n\ -@item \"int64\"\n\ -@itemx \"integer*8\"\n\ -64-bit signed integer.\n\ -\n\ -@item \"uint8\"\n\ -8-bit unsigned integer.\n\ -\n\ -@item \"uint16\"\n\ -16-bit unsigned integer.\n\ -\n\ -@item \"uint32\"\n\ -32-bit unsigned integer.\n\ -\n\ -@item \"uint64\"\n\ -64-bit unsigned integer.\n\ -\n\ -@item \"single\"\n\ -@itemx \"float32\"\n\ -@itemx \"real*4\"\n\ -32-bit floating point number.\n\ -\n\ -@item \"double\"\n\ -@itemx \"float64\"\n\ -@itemx \"real*8\"\n\ -64-bit floating point number.\n\ -\n\ -@item \"char\"\n\ -@itemx \"char*1\"\n\ -Single character.\n\ -\n\ -@item \"short\"\n\ -Short integer (size is platform dependent).\n\ -\n\ -@item \"int\"\n\ -Integer (size is platform dependent).\n\ -\n\ -@item \"long\"\n\ -Long integer (size is platform dependent).\n\ -\n\ -@item \"ushort\"\n\ -@itemx \"unsigned short\"\n\ -Unsigned short integer (size is platform dependent).\n\ -\n\ -@item \"uint\"\n\ -@itemx \"unsigned int\"\n\ -Unsigned integer (size is platform dependent).\n\ -\n\ -@item \"ulong\"\n\ -@itemx \"unsigned long\"\n\ -Unsigned long integer (size is platform dependent).\n\ -\n\ -@item \"float\"\n\ -Single precision floating point number (size is platform dependent).\n\ -@end table\n\ -\n\ -@noindent\n\ -The default precision is @code{\"uchar\"}.\n\ -\n\ -The @var{precision} argument may also specify an optional repeat\n\ -count. For example, @samp{32*single} causes @code{fread} to read\n\ -a block of 32 single precision floating point numbers. Reading in\n\ -blocks is useful in combination with the @var{skip} argument.\n\ -\n\ -The @var{precision} argument may also specify a type conversion.\n\ -For example, @samp{int16=>int32} causes @code{fread} to read 16-bit\n\ -integer values and return an array of 32-bit integer values. By\n\ -default, @code{fread} returns a double precision array. The special\n\ -form @samp{*TYPE} is shorthand for @samp{TYPE=>TYPE}.\n\ -\n\ -The conversion and repeat counts may be combined. For example, the\n\ -specification @samp{32*single=>single} causes @code{fread} to read\n\ -blocks of single precision floating point values and return an array\n\ -of single precision values instead of the default array of double\n\ -precision values.\n\ -\n\ -The optional argument @var{skip} specifies the number of bytes to skip\n\ -after each element (or block of elements) is read. If it is not\n\ -specified, a value of 0 is assumed. If the final block read is not\n\ -complete, the final skip is omitted. For example,\n\ -\n\ -@example\n\ -fread (f, 10, \"3*single=>single\", 8)\n\ -@end example\n\ -\n\ -@noindent\n\ -will omit the final 8-byte skip because the last read will not be\n\ -a complete block of 3 values.\n\ -\n\ -The optional argument @var{arch} is a string specifying the data format\n\ -for the file. Valid values are\n\ -\n\ -@table @code\n\ -@item \"native\"\n\ -The format of the current machine.\n\ -\n\ -@item \"ieee-be\"\n\ -IEEE big endian.\n\ -\n\ -@item \"ieee-le\"\n\ -IEEE little endian.\n\ -\n\ -@item \"vaxd\"\n\ -VAX D floating format.\n\ -\n\ -@item \"vaxg\"\n\ -VAX G floating format.\n\ -\n\ -@item \"cray\"\n\ -Cray floating format.\n\ -@end table\n\ -\n\ -@noindent\n\ -Conversions are currently only supported for @code{\"ieee-be\"} and\n\ -@code{\"ieee-le\"} formats.\n\ -\n\ -The data read from the file is returned in @var{val}, and the number of\n\ -values read is returned in @code{count}\n\ -@seealso{fwrite, fgets, fgetl, fscanf, fopen}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0 && nargin < 6) - { - retval(1) = -1.0; - retval(0) = Matrix (); - - octave_stream os = octave_stream_list::lookup (args(0), "fread"); - - if (! error_state) - { - octave_value size = lo_ieee_inf_value (); - octave_value prec = "uchar"; - octave_value skip = 0; - octave_value arch = "unknown"; - - int idx = 1; - - if (nargin > idx && ! args(idx).is_string ()) - size = args(idx++); - - if (nargin > idx) - prec = args(idx++); - - if (nargin > idx) - skip = args(idx++); - - if (nargin > idx) - arch = args(idx++); - else if (skip.is_string ()) - { - arch = skip; - skip = 0; - } - - octave_idx_type count = -1; - - octave_value tmp = do_fread (os, size, prec, skip, arch, count); - - retval(1) = count; - retval(0) = tmp; - } - } - else - print_usage (); - - return retval; -} - -static int -do_fwrite (octave_stream& os, const octave_value& data, - const octave_value& prec_arg, const octave_value& skip_arg, - const octave_value& arch_arg) -{ - int retval = -1; - - std::string prec = prec_arg.string_value (); - - if (! error_state) - { - int block_size = 1; - oct_data_conv::data_type output_type; - - oct_data_conv::string_to_data_type (prec, block_size, output_type); - - if (! error_state) - { - int skip = skip_arg.int_value (true); - - if (! error_state) - { - std::string arch = arch_arg.string_value (); - - if (! error_state) - { - oct_mach_info::float_format flt_fmt - = oct_mach_info::string_to_float_format (arch); - - if (! error_state) - retval = os.write (data, block_size, output_type, - skip, flt_fmt); - } - else - ::error ("fwrite: ARCH architecture type must be a string"); - } - else - ::error ("fwrite: SKIP must be an integer"); - } - else - ::error ("fwrite: invalid PRECISION specified"); - } - else - ::error ("fwrite: PRECISION must be a string"); - - return retval; -} - -DEFUN (fwrite, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{count} =} fwrite (@var{fid}, @var{data}, @var{precision}, @var{skip}, @var{arch})\n\ -Write data in binary form of type @var{precision} to the specified file\n\ -ID @var{fid}, returning the number of values successfully written to the\n\ -file.\n\ -\n\ -The argument @var{data} is a matrix of values that are to be written to\n\ -the file. The values are extracted in column-major order.\n\ -\n\ -The remaining arguments @var{precision}, @var{skip}, and @var{arch} are\n\ -optional, and are interpreted as described for @code{fread}.\n\ -\n\ -The behavior of @code{fwrite} is undefined if the values in @var{data}\n\ -are too large to fit in the specified precision.\n\ -@seealso{fread, fputs, fprintf, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin > 1 && nargin < 6) - { - octave_stream os = octave_stream_list::lookup (args(0), "fwrite"); - - if (! error_state) - { - octave_value prec = "uchar"; - octave_value skip = 0; - octave_value arch = "unknown"; - - int idx = 1; - - octave_value data = args(idx++); - - if (nargin > idx) - prec = args(idx++); - - if (nargin > idx) - skip = args(idx++); - - if (nargin > idx) - arch = args(idx++); - else if (skip.is_string ()) - { - arch = skip; - skip = 0; - } - - double status = do_fwrite (os, data, prec, skip, arch); - - retval = status; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("feof", Ffeof, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} feof (@var{fid})\n\ -Return 1 if an end-of-file condition has been encountered for a given\n\ -file and 0 otherwise. Note that it will only return 1 if the end of the\n\ -file has already been encountered, not if the next read operation will\n\ -result in an end-of-file condition.\n\ -@seealso{fread, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_stream os = octave_stream_list::lookup (args(0), "feof"); - - if (! error_state) - retval = os.eof () ? 1.0 : 0.0; - } - else - print_usage (); - - return retval; -} - -DEFUNX ("ferror", Fferror, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid})\n\ -@deftypefnx {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid}, \"clear\")\n\ -Return 1 if an error condition has been encountered for the file ID\n\ -@var{fid} and 0 otherwise. Note that it will only return 1 if an error\n\ -has already been encountered, not if the next operation will result in\n\ -an error condition.\n\ -\n\ -The second argument is optional. If it is supplied, also clear the\n\ -error condition.\n\ -@seealso{fclear, fopen}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), "ferror"); - - if (! error_state) - { - bool clear = false; - - if (nargin == 2) - { - std::string opt = args(1).string_value (); - - if (! error_state) - clear = (opt == "clear"); - else - return retval; - } - - int error_number = 0; - - std::string error_message = os.error (clear, error_number); - - retval(1) = error_number; - retval(0) = error_message; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (popen, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{fid} =} popen (@var{command}, @var{mode})\n\ -Start a process and create a pipe. The name of the command to run is\n\ -given by @var{command}. The file identifier corresponding to the input\n\ -or output stream of the process is returned in @var{fid}. The argument\n\ -@var{mode} may be\n\ -\n\ -@table @code\n\ -@item \"r\"\n\ -The pipe will be connected to the standard output of the process, and\n\ -open for reading.\n\ -\n\ -@item \"w\"\n\ -The pipe will be connected to the standard input of the process, and\n\ -open for writing.\n\ -@end table\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -fid = popen (\"ls -ltr / | tail -3\", \"r\");\n\ -while (ischar (s = fgets (fid)))\n\ - fputs (stdout, s);\n\ -endwhile\n\ -\n\ - @print{} drwxr-xr-x 33 root root 3072 Feb 15 13:28 etc\n\ - @print{} drwxr-xr-x 3 root root 1024 Feb 15 13:28 lib\n\ - @print{} drwxrwxrwt 15 root root 2048 Feb 17 14:53 tmp\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - std::string mode = args(1).string_value (); - - if (! error_state) - { - if (mode == "r") - { - octave_stream ips = octave_iprocstream::create (name); - - retval = octave_stream_list::insert (ips); - } - else if (mode == "w") - { - octave_stream ops = octave_oprocstream::create (name); - - retval = octave_stream_list::insert (ops); - } - else - ::error ("popen: invalid MODE specified"); - } - else - ::error ("popen: MODE must be a string"); - } - else - ::error ("popen: COMMAND must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (pclose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pclose (@var{fid})\n\ -Close a file identifier that was opened by @code{popen}. You may also\n\ -use @code{fclose} for the same purpose.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - retval = octave_stream_list::remove (args(0), "pclose"); - else - print_usage (); - - return retval; -} - -DEFUNX ("tmpnam", Ftmpnam, args, , - "-*- texinfo -*-\n\ -@c List other forms of function in documentation index\n\ -@findex octave_tmp_file_name\n\ -\n\ -@deftypefn {Built-in Function} {} tmpnam ()\n\ -@deftypefnx {Built-in Function} {} tmpnam (@var{dir})\n\ -@deftypefnx {Built-in Function} {} tmpnam (@var{dir}, @var{prefix})\n\ -Return a unique temporary file name as a string.\n\ -\n\ -If @var{prefix} is omitted, a value of @code{\"oct-\"} is used.\n\ -If @var{dir} is also omitted, the default directory for temporary files\n\ -is used. If @var{dir} is provided, it must exist, otherwise the default\n\ -directory for temporary files is used. Since the named file is not\n\ -opened, by @code{tmpnam}, it is possible (though relatively unlikely)\n\ -that it will not be available by the time your program attempts to open it.\n\ -@seealso{tmpfile, mkstemp, P_tmpdir}\n\ -@end deftypefn") -{ - octave_value retval; - - int len = args.length (); - - if (len < 3) - { - std::string dir = len > 0 ? args(0).string_value () : std::string (); - - if (! error_state) - { - std::string pfx - = len > 1 ? args(1).string_value () : std::string ("oct-"); - - if (! error_state) - retval = octave_tempnam (dir, pfx); - else - ::error ("PREFIX must be a string"); - } - else - ::error ("DIR argument must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFALIAS (octave_tmp_file_name, tmpnam); - -DEFUN (tmpfile, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} tmpfile ()\n\ -Return the file ID corresponding to a new temporary file with a unique\n\ -name. The file is opened in binary read/write (@code{\"w+b\"}) mode.\n\ -The file will be deleted automatically when it is closed or when Octave\n\ -exits.\n\ -\n\ -If successful, @var{fid} is a valid file ID and @var{msg} is an empty\n\ -string. Otherwise, @var{fid} is -1 and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{tmpnam, mkstemp, P_tmpdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - FILE *fid = gnulib::tmpfile (); - - if (fid) - { - std::string nm; - - std::ios::openmode md = fopen_mode_to_ios_mode ("w+b"); - - octave_stream s = octave_stdiostream::create (nm, fid, md); - - if (s) - retval(0) = octave_stream_list::insert (s); - else - error ("tmpfile: failed to create octave_stdiostream object"); - - } - else - { - retval(1) = gnulib::strerror (errno); - retval(0) = -1; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (mkstemp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{name}, @var{msg}] =} mkstemp (@var{template}, @var{delete})\n\ -Return the file ID corresponding to a new temporary file with a unique\n\ -name created from @var{template}. The last six characters of @var{template}\n\ -must be @code{XXXXXX} and these are replaced with a string that makes the\n\ -filename unique. The file is then created with mode read/write and\n\ -permissions that are system dependent (on GNU/Linux systems, the permissions\n\ -will be 0600 for versions of glibc 2.0.7 and later). The file is opened\n\ -in binary mode and with the @w{@code{O_EXCL}} flag.\n\ -\n\ -If the optional argument @var{delete} is supplied and is true,\n\ -the file will be deleted automatically when Octave exits, or when\n\ -the function @code{purge_tmp_files} is called.\n\ -\n\ -If successful, @var{fid} is a valid file ID, @var{name} is the name of\n\ -the file, and @var{msg} is an empty string. Otherwise, @var{fid}\n\ -is -1, @var{name} is empty, and @var{msg} contains a system-dependent\n\ -error message.\n\ -@seealso{tmpfile, tmpnam, P_tmpdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string tmpl8 = args(0).string_value (); - - if (! error_state) - { - OCTAVE_LOCAL_BUFFER (char, tmp, tmpl8.size () + 1); - strcpy (tmp, tmpl8.c_str ()); - - int fd = gnulib::mkostemp (tmp, O_BINARY); - - if (fd < 0) - { - retval(2) = gnulib::strerror (errno); - retval(0) = fd; - } - else - { - const char *fopen_mode = "w+b"; - - FILE *fid = fdopen (fd, fopen_mode); - - if (fid) - { - std::string nm = tmp; - - std::ios::openmode md = fopen_mode_to_ios_mode (fopen_mode); - - octave_stream s = octave_stdiostream::create (nm, fid, md); - - if (s) - { - retval(1) = nm; - retval(0) = octave_stream_list::insert (s); - - if (nargin == 2 && args(1).is_true ()) - mark_for_deletion (nm); - } - else - error ("mkstemp: failed to create octave_stdiostream object"); - } - else - { - retval(2) = gnulib::strerror (errno); - retval(0) = -1; - } - } - } - else - error ("mkstemp: TEMPLATE argument must be a string"); - } - else - print_usage (); - - return retval; -} - -static int -convert (int x, int ibase, int obase) -{ - int retval = 0; - - int tmp = x % obase; - - if (tmp > ibase - 1) - ::error ("umask: invalid digit"); - else - { - retval = tmp; - int mult = ibase; - while ((x = (x - tmp) / obase)) - { - tmp = x % obase; - if (tmp > ibase - 1) - { - ::error ("umask: invalid digit"); - break; - } - retval += mult * tmp; - mult *= ibase; - } - } - - return retval; -} - -DEFUNX ("umask", Fumask, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} umask (@var{mask})\n\ -Set the permission mask for file creation. The parameter @var{mask}\n\ -is an integer, interpreted as an octal number. If successful,\n\ -returns the previous value of the mask (as an integer to be\n\ -interpreted as an octal number); otherwise an error message is printed.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int status = 0; - - if (args.length () == 1) - { - int mask = args(0).int_value (true); - - if (! error_state) - { - if (mask < 0) - { - status = -1; - ::error ("umask: MASK must be a positive integer value"); - } - else - { - int oct_mask = convert (mask, 8, 10); - - if (! error_state) - status = convert (octave_umask (oct_mask), 10, 8); - } - } - else - { - status = -1; - ::error ("umask: MASK must be an integer"); - } - } - else - print_usage (); - - if (status >= 0) - retval(0) = status; - - return retval; -} - -static octave_value -const_value (const char *, const octave_value_list& args, int val) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = val; - else - print_usage (); - - return retval; -} - -DEFUNX ("P_tmpdir", FP_tmpdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} P_tmpdir ()\n\ -Return the default name of the directory for temporary files on\n\ -this system. The name of this directory is system dependent.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = get_P_tmpdir (); - else - print_usage (); - - return retval; -} - -// NOTE: the values of SEEK_SET, SEEK_CUR, and SEEK_END have to be -// this way for Matlab compatibility. - -DEFUNX ("SEEK_SET", FSEEK_SET, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SEEK_SET ()\n\ -@deftypefnx {Built-in Function} {} SEEK_CUR ()\n\ -@deftypefnx {Built-in Function} {} SEEK_END ()\n\ -Return the numerical value to pass to @code{fseek} to perform\n\ -one of the following actions:\n\ -\n\ -@table @code\n\ -@item SEEK_SET\n\ -Position file relative to the beginning.\n\ -\n\ -@item SEEK_CUR\n\ -Position file relative to the current position.\n\ -\n\ -@item SEEK_END\n\ -Position file relative to the end.\n\ -@end table\n\ -@seealso{fseek}\n\ -@end deftypefn") -{ - return const_value ("SEEK_SET", args, -1); -} - -DEFUNX ("SEEK_CUR", FSEEK_CUR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SEEK_CUR ()\n\ -Return the numerical value to pass to @code{fseek} to\n\ -position the file pointer relative to the current position.\n\ -@seealso{SEEK_SET, SEEK_END}.\n\ -@end deftypefn") -{ - return const_value ("SEEK_CUR", args, 0); -} - -DEFUNX ("SEEK_END", FSEEK_END, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SEEK_END ()\n\ -Return the numerical value to pass to @code{fseek} to\n\ -position the file pointer relative to the end of the file.\n\ -@seealso{SEEK_SET, SEEK_CUR}.\n\ -@end deftypefn") -{ - return const_value ("SEEK_END", args, 1); -} - -static octave_value -const_value (const char *, const octave_value_list& args, - const octave_value& val) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = val; - else - print_usage (); - - return retval; -} - -DEFUNX ("stdin", Fstdin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} stdin ()\n\ -Return the numeric value corresponding to the standard input stream.\n\ -When Octave is used interactively, this is filtered through the command\n\ -line editing functions.\n\ -@seealso{stdout, stderr}\n\ -@end deftypefn") -{ - return const_value ("stdin", args, stdin_file); -} - -DEFUNX ("stdout", Fstdout, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} stdout ()\n\ -Return the numeric value corresponding to the standard output stream.\n\ -Data written to the standard output is normally filtered through the pager.\n\ -@seealso{stdin, stderr}\n\ -@end deftypefn") -{ - return const_value ("stdout", args, stdout_file); -} - -DEFUNX ("stderr", Fstderr, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} stderr ()\n\ -Return the numeric value corresponding to the standard error stream.\n\ -Even if paging is turned on, the standard error is not sent to the\n\ -pager. It is useful for error messages and prompts.\n\ -@seealso{stdin, stdout}\n\ -@end deftypefn") -{ - return const_value ("stderr", args, stderr_file); -} diff -r d02b229ce693 -r a132d206a36a src/file-io.h --- a/src/file-io.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Written by John C. Campbell - -#if !defined (octave_file_io_h) -#define octave_file_io_h 1 - -extern OCTINTERP_API void initialize_file_io (void); - -extern OCTINTERP_API void close_files (void); - -extern OCTINTERP_API void mark_for_deletion (const std::string&); - -extern OCTINTERP_API void cleanup_tmp_files (void); - -#endif diff -r d02b229ce693 -r a132d206a36a src/gl-render.cc --- a/src/gl-render.cc Thu Aug 02 12:12:00 2012 +0200 +++ b/src/gl-render.cc Fri Aug 03 14:59:40 2012 -0400 @@ -2488,6 +2488,10 @@ Matrix x = props.get_xdata ().matrix_value (); Matrix y = props.get_ydata ().matrix_value (); + // Someone wants us to draw an empty image? No way. + if (x.is_empty () || y.is_empty ()) + return; + if (w > 1 && x(1) == x(0)) x(1) = x(1) + (w-1); diff -r d02b229ce693 -r a132d206a36a src/graphics.cc --- a/src/graphics.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10274 +0,0 @@ -/* - -Copyright (C) 2007-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include - -#include -#include -#include -#include -#include -#include - -#include "cmd-edit.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-locbuf.h" -#include "singleton-cleanup.h" - -#include "cutils.h" -#include "defun.h" -#include "display.h" -#include "error.h" -#include "graphics.h" -#include "input.h" -#include "ov.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-fcn-handle.h" -#include "pager.h" -#include "parse.h" -#include "toplev.h" -#include "txt-eng-ft.h" -#include "unwind-prot.h" - -// forward declarations -static octave_value xget (const graphics_handle& h, const caseless_str& name); - -static void -gripe_set_invalid (const std::string& pname) -{ - error ("set: invalid value for %s property", pname.c_str ()); -} - -// Check to see that PNAME matches just one of PNAMES uniquely. -// Return the full name of the match, or an empty caseless_str object -// if there is no match, or the match is ambiguous. - -static caseless_str -validate_property_name (const std::string& who, const std::string& what, - const std::set& pnames, - const caseless_str& pname) -{ - size_t len = pname.length (); - std::set matches; - - for (std::set::const_iterator p = pnames.begin (); - p != pnames.end (); p++) - { - if (pname.compare (*p, len)) - { - if (len == p->length ()) - { - // Exact match. - return pname; - } - - matches.insert (*p); - } - } - - size_t num_matches = matches.size (); - - if (num_matches == 0) - { - error ("%s: unknown %s property %s", - who.c_str (), what.c_str (), pname.c_str ()); - } - else if (num_matches > 1) - { - string_vector sv (matches); - - std::ostringstream os; - - sv.list_in_columns (os); - - std::string match_list = os.str (); - - error ("%s: ambiguous %s property name %s; possible matches:\n\n%s", - who.c_str (), what.c_str (), pname.c_str (), match_list.c_str ()); - } - else if (num_matches == 1) - { - // Exact match was handled above. - - std::string possible_match = *(matches.begin ()); - - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s property %s", - who.c_str (), pname.c_str (), what.c_str (), - possible_match.c_str ()); - - return possible_match; - } - - return caseless_str (); -} - -static Matrix -jet_colormap (void) -{ - Matrix cmap (64, 3, 0.0); - - for (octave_idx_type i = 0; i < 64; i++) - { - // This is the jet colormap. It would be nice to be able - // to feval the jet function but since there is a static - // property object that includes a colormap_property - // object, we need to initialize this before main is even - // called, so calling an interpreted function is not - // possible. - - double x = i / 63.0; - - if (x >= 3.0/8.0 && x < 5.0/8.0) - cmap(i,0) = 4.0 * x - 3.0/2.0; - else if (x >= 5.0/8.0 && x < 7.0/8.0) - cmap(i,0) = 1.0; - else if (x >= 7.0/8.0) - cmap(i,0) = -4.0 * x + 9.0/2.0; - - if (x >= 1.0/8.0 && x < 3.0/8.0) - cmap(i,1) = 4.0 * x - 1.0/2.0; - else if (x >= 3.0/8.0 && x < 5.0/8.0) - cmap(i,1) = 1.0; - else if (x >= 5.0/8.0 && x < 7.0/8.0) - cmap(i,1) = -4.0 * x + 7.0/2.0; - - if (x < 1.0/8.0) - cmap(i,2) = 4.0 * x + 1.0/2.0; - else if (x >= 1.0/8.0 && x < 3.0/8.0) - cmap(i,2) = 1.0; - else if (x >= 3.0/8.0 && x < 5.0/8.0) - cmap(i,2) = -4.0 * x + 5.0/2.0; - } - - return cmap; -} - -static double -default_screendepth (void) -{ - return display_info::depth (); -} - -static Matrix -default_screensize (void) -{ - Matrix retval (1, 4, 1.0); - - retval(2) = display_info::width (); - retval(3) = display_info::height (); - - return retval; -} - -static double -default_screenpixelsperinch (void) -{ - return (display_info::x_dpi () + display_info::y_dpi ()) / 2; -} - -static Matrix -default_colororder (void) -{ - Matrix retval (7, 3, 0.0); - - retval(0,2) = 1.0; - - retval(1,1) = 0.5; - - retval(2,0) = 1.0; - - retval(3,1) = 0.75; - retval(3,2) = 0.75; - - retval(4,0) = 0.75; - retval(4,2) = 0.75; - - retval(5,0) = 0.75; - retval(5,1) = 0.75; - - retval(6,0) = 0.25; - retval(6,1) = 0.25; - retval(6,2) = 0.25; - - return retval; -} - -static Matrix -default_lim (bool logscale = false) -{ - Matrix m (1, 2, 0); - - if (logscale) - { - m(0) = 0.1; - m(1) = 1.0; - } - else - m(1) = 1; - - return m; -} - -static Matrix -default_data (void) -{ - Matrix retval (1, 2); - - retval(0) = 0; - retval(1) = 1; - - return retval; -} - -static Matrix -default_axes_position (void) -{ - Matrix m (1, 4, 0.0); - m(0) = 0.13; - m(1) = 0.11; - m(2) = 0.775; - m(3) = 0.815; - return m; -} - -static Matrix -default_axes_outerposition (void) -{ - Matrix m (1, 4, 0.0); - m(2) = m(3) = 1.0; - return m; -} - -static Matrix -default_axes_tick (void) -{ - Matrix m (1, 6, 0.0); - m(0) = 0.0; - m(1) = 0.2; - m(2) = 0.4; - m(3) = 0.6; - m(4) = 0.8; - m(5) = 1.0; - return m; -} - -static Matrix -default_axes_ticklength (void) -{ - Matrix m (1, 2, 0.0); - m(0) = 0.01; - m(1) = 0.025; - return m; -} - -static Matrix -default_figure_position (void) -{ - Matrix m (1, 4, 0.0); - m(0) = 300; - m(1) = 200; - m(2) = 560; - m(3) = 420; - return m; -} - -static Matrix -default_figure_papersize (void) -{ - Matrix m (1, 2, 0.0); - m(0) = 8.5; - m(1) = 11.0; - return m; -} - -static Matrix -default_figure_paperposition (void) -{ - Matrix m (1, 4, 0.0); - m(0) = 0.25; - m(1) = 2.50; - m(2) = 8.00; - m(3) = 6.00; - return m; -} - -static Matrix -default_control_position (void) -{ - Matrix retval (1, 4, 0.0); - - retval(0) = 0; - retval(1) = 0; - retval(2) = 80; - retval(3) = 30; - - return retval; -} - -static Matrix -default_control_sliderstep (void) -{ - Matrix retval (1, 2, 0.0); - - retval(0) = 0.01; - retval(1) = 0.1; - - return retval; -} - -static Matrix -default_panel_position (void) -{ - Matrix retval (1, 4, 0.0); - - retval(0) = 0; - retval(1) = 0; - retval(2) = 0.5; - retval(3) = 0.5; - - return retval; -} - -static double -convert_font_size (double font_size, const caseless_str& from_units, - const caseless_str& to_units, double parent_height = 0) -{ - // Simple case where from_units == to_units - - if (from_units.compare (to_units)) - return font_size; - - // Converts the given fontsize using the following transformation: - // => points => - - double points_size = 0; - double res = 0; - - if (from_units.compare ("points")) - points_size = font_size; - else - { - res = xget (0, "screenpixelsperinch").double_value (); - - if (from_units.compare ("pixels")) - points_size = font_size * 72.0 / res; - else if (from_units.compare ("inches")) - points_size = font_size * 72.0; - else if (from_units.compare ("centimeters")) - points_size = font_size * 72.0 / 2.54; - else if (from_units.compare ("normalized")) - points_size = font_size * parent_height * 72.0 / res; - } - - double new_font_size = 0; - - if (to_units.compare ("points")) - new_font_size = points_size; - else - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - if (to_units.compare ("pixels")) - new_font_size = points_size * res / 72.0; - else if (to_units.compare ("inches")) - new_font_size = points_size / 72.0; - else if (to_units.compare ("centimeters")) - new_font_size = points_size * 2.54 / 72.0; - else if (to_units.compare ("normalized")) - { - // Avoid setting font size to (0/0) = NaN - - if (parent_height > 0) - new_font_size = points_size * res / (parent_height * 72.0); - } - } - - return new_font_size; -} - -static Matrix -convert_position (const Matrix& pos, const caseless_str& from_units, - const caseless_str& to_units, const Matrix& parent_dim) -{ - Matrix retval (1, pos.numel ()); - double res = 0; - bool is_rectangle = (pos.numel () == 4); - bool is_2d = (pos.numel () == 2); - - if (from_units.compare ("pixels")) - retval = pos; - else if (from_units.compare ("normalized")) - { - retval(0) = pos(0) * parent_dim(0) + 1; - retval(1) = pos(1) * parent_dim(1) + 1; - if (is_rectangle) - { - retval(2) = pos(2) * parent_dim(0); - retval(3) = pos(3) * parent_dim(1); - } - else if (! is_2d) - retval(2) = 0; - } - else if (from_units.compare ("characters")) - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - // FIXME -- this assumes the system font is Helvetica 10pt - // (for which "x" requires 6x12 pixels at 74.951 pixels/inch) - f = 12.0 * res / 74.951; - - if (f > 0) - { - retval(0) = 0.5 * pos(0) * f; - retval(1) = pos(1) * f; - if (is_rectangle) - { - retval(2) = 0.5 * pos(2) * f; - retval(3) = pos(3) * f; - } - else if (! is_2d) - retval(2) = 0; - } - } - else - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - if (from_units.compare ("points")) - f = res / 72.0; - else if (from_units.compare ("inches")) - f = res; - else if (from_units.compare ("centimeters")) - f = res / 2.54; - - if (f > 0) - { - retval(0) = pos(0) * f + 1; - retval(1) = pos(1) * f + 1; - if (is_rectangle) - { - retval(2) = pos(2) * f; - retval(3) = pos(3) * f; - } - else if (! is_2d) - retval(2) = 0; - } - } - - if (! to_units.compare ("pixels")) - { - if (to_units.compare ("normalized")) - { - retval(0) = (retval(0) - 1) / parent_dim(0); - retval(1) = (retval(1) - 1) / parent_dim(1); - if (is_rectangle) - { - retval(2) /= parent_dim(0); - retval(3) /= parent_dim(1); - } - else if (! is_2d) - retval(2) = 0; - } - else if (to_units.compare ("characters")) - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - f = 12.0 * res / 74.951; - - if (f > 0) - { - retval(0) = 2 * retval(0) / f; - retval(1) = retval(1) / f; - if (is_rectangle) - { - retval(2) = 2 * retval(2) / f; - retval(3) = retval(3) / f; - } - else if (! is_2d) - retval(2) = 0; - } - } - else - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - if (to_units.compare ("points")) - f = res / 72.0; - else if (to_units.compare ("inches")) - f = res; - else if (to_units.compare ("centimeters")) - f = res / 2.54; - - if (f > 0) - { - retval(0) = (retval(0) - 1) / f; - retval(1) = (retval(1) - 1) / f; - if (is_rectangle) - { - retval(2) /= f; - retval(3) /= f; - } - else if (! is_2d) - retval(2) = 0; - } - } - } - else if (! is_rectangle && ! is_2d) - retval(2) = 0; - - return retval; -} - -static Matrix -convert_text_position (const Matrix& pos, const text::properties& props, - const caseless_str& from_units, - const caseless_str& to_units) -{ - graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); - graphics_object ax = go.get_ancestor ("axes"); - - Matrix retval; - - if (ax.valid_object ()) - { - const axes::properties& ax_props = - dynamic_cast (ax.get_properties ()); - graphics_xform ax_xform = ax_props.get_transform (); - bool is_rectangle = (pos.numel () == 4); - Matrix ax_bbox = ax_props.get_boundingbox (true), - ax_size = ax_bbox.extract_n (0, 2, 1, 2); - - if (from_units.compare ("data")) - { - if (is_rectangle) - { - ColumnVector v1 = ax_xform.transform (pos(0), pos(1), 0), - v2 = ax_xform.transform (pos(0) + pos(2), - pos(1) + pos(3), 0); - - retval.resize (1, 4); - - retval(0) = v1(0) - ax_bbox(0) + 1; - retval(1) = ax_bbox(1) + ax_bbox(3) - v1(1) + 1; - retval(2) = v2(0) - v1(0); - retval(3) = v1(1) - v2(1); - } - else - { - ColumnVector v = ax_xform.transform (pos(0), pos(1), pos(2)); - - retval.resize (1, 3); - - retval(0) = v(0) - ax_bbox(0) + 1; - retval(1) = ax_bbox(1) + ax_bbox(3) - v(1) + 1; - retval(2) = 0; - } - } - else - retval = convert_position (pos, from_units, "pixels", ax_size); - - if (! to_units.compare ("pixels")) - { - if (to_units.compare ("data")) - { - if (is_rectangle) - { - ColumnVector v1 = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, - ax_bbox(1) + ax_bbox(3) - retval(1) + 1), - v2 = ax_xform.untransform (retval(0) + retval(2) + ax_bbox(0) - 1, - ax_bbox(1) + ax_bbox(3) - (retval(1) + retval(3)) + 1); - - retval.resize (1, 4); - - retval(0) = v1(0); - retval(1) = v1(1); - retval(2) = v2(0) - v1(0); - retval(3) = v2(1) - v1(1); - } - else - { - ColumnVector v = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, - ax_bbox(1) + ax_bbox(3) - retval(1) + 1); - - retval.resize (1, 3); - - retval(0) = v(0); - retval(1) = v(1); - retval(2) = v(2); - } - } - else - retval = convert_position (retval, "pixels", to_units, ax_size); - } - } - - return retval; -} - -// This function always returns the screensize in pixels -static Matrix -screen_size_pixels (void) -{ - graphics_object obj = gh_manager::get_object (0); - Matrix sz = obj.get ("screensize").matrix_value (); - return convert_position (sz, obj.get ("units").string_value (), "pixels", sz.extract_n (0, 2, 1, 2)).extract_n (0, 2, 1, 2); -} - -static void -convert_cdata_2 (bool is_scaled, double clim_0, double clim_1, - const double *cmapv, double x, octave_idx_type lda, - octave_idx_type nc, octave_idx_type i, double *av) -{ - if (is_scaled) - x = xround ((nc - 1) * (x - clim_0) / (clim_1 - clim_0)); - else - x = xround (x - 1); - - if (xisnan (x)) - { - av[i] = x; - av[i+lda] = x; - av[i+2*lda] = x; - } - else - { - if (x < 0) - x = 0; - else if (x >= nc) - x = (nc - 1); - - octave_idx_type idx = static_cast (x); - - av[i] = cmapv[idx]; - av[i+lda] = cmapv[idx+nc]; - av[i+2*lda] = cmapv[idx+2*nc]; - } -} - -template -void -convert_cdata_1 (bool is_scaled, double clim_0, double clim_1, - const double *cmapv, const T *cv, octave_idx_type lda, - octave_idx_type nc, double *av) -{ - for (octave_idx_type i = 0; i < lda; i++) - convert_cdata_2 (is_scaled, clim_0, clim_1, cmapv, cv[i], lda, nc, i, av); -} - -static octave_value -convert_cdata (const base_properties& props, const octave_value& cdata, - bool is_scaled, int cdim) -{ - dim_vector dv (cdata.dims ()); - - if (dv.length () == cdim && dv(cdim-1) == 3) - return cdata; - - Matrix cmap (1, 3, 0.0); - Matrix clim (1, 2, 0.0); - - graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); - graphics_object fig = go.get_ancestor ("figure"); - - if (fig.valid_object ()) - { - Matrix _cmap = fig.get (caseless_str ("colormap")).matrix_value (); - - if (! error_state) - cmap = _cmap; - } - - if (is_scaled) - { - graphics_object ax = go.get_ancestor ("axes"); - - if (ax.valid_object ()) - { - Matrix _clim = ax.get (caseless_str ("clim")).matrix_value (); - - if (! error_state) - clim = _clim; - } - } - - dv.resize (cdim); - dv(cdim-1) = 3; - - NDArray a (dv); - - octave_idx_type lda = a.numel () / static_cast (3); - octave_idx_type nc = cmap.rows (); - - double *av = a.fortran_vec (); - const double *cmapv = cmap.data (); - - double clim_0 = clim(0); - double clim_1 = clim(1); - -#define CONVERT_CDATA_1(ARRAY_T, VAL_FN) \ - do \ - { \ - ARRAY_T tmp = cdata. VAL_FN ## array_value (); \ - \ - convert_cdata_1 (is_scaled, clim_0, clim_1, cmapv, \ - tmp.data (), lda, nc, av); \ - } \ - while (0) - - if (cdata.is_uint8_type ()) - CONVERT_CDATA_1 (uint8NDArray, uint8_); - else if (cdata.is_single_type ()) - CONVERT_CDATA_1 (FloatNDArray, float_); - else if (cdata.is_double_type ()) - CONVERT_CDATA_1 (NDArray, ); - else - error ("unsupported type for cdata (= %s)", cdata.type_name ().c_str ()); - -#undef CONVERT_CDATA_1 - - return octave_value (a); -} - -template -static void -get_array_limits (const Array& m, double& emin, double& emax, - double& eminp, double& emaxp) -{ - const T *data = m.data (); - octave_idx_type n = m.numel (); - - for (octave_idx_type i = 0; i < n; i++) - { - double e = double (data[i]); - - // Don't need to test for NaN here as NaN>x and NaN emax) - emax = e; - - if (e > 0 && e < eminp) - eminp = e; - - if (e < 0 && e > emaxp) - emaxp = e; - } - } -} - -static bool -lookup_object_name (const caseless_str& name, caseless_str& go_name, - caseless_str& rest) -{ - int len = name.length (); - int offset = 0; - bool result = false; - - if (len >= 4) - { - caseless_str pfx = name.substr (0, 4); - - if (pfx.compare ("axes") || pfx.compare ("line") - || pfx.compare ("text")) - offset = 4; - else if (len >= 5) - { - pfx = name.substr (0, 5); - - if (pfx.compare ("image") || pfx.compare ("patch")) - offset = 5; - else if (len >= 6) - { - pfx = name.substr (0, 6); - - if (pfx.compare ("figure") || pfx.compare ("uimenu")) - offset = 6; - else if (len >= 7) - { - pfx = name.substr (0, 7); - - if (pfx.compare ("surface") || pfx.compare ("hggroup") - || pfx.compare ("uipanel")) - offset = 7; - else if (len >= 9) - { - pfx = name.substr (0, 9); - - if (pfx.compare ("uicontrol") - || pfx.compare ("uitoolbar")) - offset = 9; - else if (len >= 10) - { - pfx = name.substr (0, 10); - - if (pfx.compare ("uipushtool")) - offset = 10; - else if (len >= 12) - { - pfx = name.substr (0, 12); - - if (pfx.compare ("uitoggletool")) - offset = 12; - else if (len >= 13) - { - pfx = name.substr (0, 13); - - if (pfx.compare ("uicontextmenu")) - offset = 13; - } - } - } - } - } - } - } - - if (offset > 0) - { - go_name = pfx; - rest = name.substr (offset); - result = true; - } - } - - return result; -} - -static base_graphics_object* -make_graphics_object_from_type (const caseless_str& type, - const graphics_handle& h = graphics_handle (), - const graphics_handle& p = graphics_handle ()) -{ - base_graphics_object *go = 0; - - if (type.compare ("figure")) - go = new figure (h, p); - else if (type.compare ("axes")) - go = new axes (h, p); - else if (type.compare ("line")) - go = new line (h, p); - else if (type.compare ("text")) - go = new text (h, p); - else if (type.compare ("image")) - go = new image (h, p); - else if (type.compare ("patch")) - go = new patch (h, p); - else if (type.compare ("surface")) - go = new surface (h, p); - else if (type.compare ("hggroup")) - go = new hggroup (h, p); - else if (type.compare ("uimenu")) - go = new uimenu (h, p); - else if (type.compare ("uicontrol")) - go = new uicontrol (h, p); - else if (type.compare ("uipanel")) - go = new uipanel (h, p); - else if (type.compare ("uicontextmenu")) - go = new uicontextmenu (h, p); - else if (type.compare ("uitoolbar")) - go = new uitoolbar (h, p); - else if (type.compare ("uipushtool")) - go = new uipushtool (h, p); - else if (type.compare ("uitoggletool")) - go = new uitoggletool (h, p); - return go; -} - -// --------------------------------------------------------------------- - -bool -base_property::set (const octave_value& v, bool do_run, bool do_notify_toolkit) -{ - if (do_set (v)) - { - - // Notify graphics toolkit. - if (id >= 0 && do_notify_toolkit) - { - graphics_object go = gh_manager::get_object (parent); - if (go) - go.update (id); - } - - // run listeners - if (do_run && ! error_state) - run_listeners (POSTSET); - - return true; - } - - return false; -} - - -void -base_property::run_listeners (listener_mode mode) -{ - const octave_value_list& l = listeners[mode]; - - for (int i = 0; i < l.length (); i++) - { - gh_manager::execute_listener (parent, l(i)); - - if (error_state) - break; - } -} - -radio_values::radio_values (const std::string& opt_string) - : default_val (), possible_vals () -{ - size_t beg = 0; - size_t len = opt_string.length (); - bool done = len == 0; - - while (! done) - { - size_t end = opt_string.find ('|', beg); - - if (end == std::string::npos) - { - end = len; - done = true; - } - - std::string t = opt_string.substr (beg, end-beg); - - // Might want more error checking here... - if (t[0] == '{') - { - t = t.substr (1, t.length () - 2); - default_val = t; - } - else if (beg == 0) // ensure default value - default_val = t; - - possible_vals.insert (t); - - beg = end + 1; - } -} - -std::string -radio_values::values_as_string (void) const -{ - std::string retval; - for (std::set::const_iterator it = possible_vals.begin (); - it != possible_vals.end (); it++) - { - if (retval == "") - { - if (*it == default_value ()) - retval = "{" + *it + "}"; - else - retval = *it; - } - else - { - if (*it == default_value ()) - retval += " | {" + *it + "}"; - else - retval += " | " + *it; - } - } - if (retval != "") - retval = "[ " + retval + " ]"; - return retval; -} - -Cell -radio_values::values_as_cell (void) const -{ - octave_idx_type i = 0; - Cell retval (nelem (), 1); - for (std::set::const_iterator it = possible_vals.begin (); - it != possible_vals.end (); it++) - retval(i++) = std::string (*it); - return retval; -} - -bool -color_values::str2rgb (std::string str) -{ - double tmp_rgb[3] = {0, 0, 0}; - bool retval = true; - unsigned int len = str.length (); - - std::transform (str.begin (), str.end (), str.begin (), tolower); - - if (str.compare (0, len, "blue", 0, len) == 0) - tmp_rgb[2] = 1; - else if (str.compare (0, len, "black", 0, len) == 0 - || str.compare (0, len, "k", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 0; - else if (str.compare (0, len, "red", 0, len) == 0) - tmp_rgb[0] = 1; - else if (str.compare (0, len, "green", 0, len) == 0) - tmp_rgb[1] = 1; - else if (str.compare (0, len, "yellow", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[1] = 1; - else if (str.compare (0, len, "magenta", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[2] = 1; - else if (str.compare (0, len, "cyan", 0, len) == 0) - tmp_rgb[1] = tmp_rgb[2] = 1; - else if (str.compare (0, len, "white", 0, len) == 0 - || str.compare (0, len, "w", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 1; - else - retval = false; - - if (retval) - { - for (int i = 0; i < 3; i++) - xrgb(i) = tmp_rgb[i]; - } - - return retval; -} - -bool -color_property::do_set (const octave_value& val) -{ - if (val.is_string ()) - { - std::string s = val.string_value (); - - if (! s.empty ()) - { - std::string match; - - if (radio_val.contains (s, match)) - { - if (current_type != radio_t || match != current_val) - { - if (s.length () != match.length ()) - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s value %s", - "set", s.c_str (), get_name ().c_str (), - match.c_str ()); - current_val = match; - current_type = radio_t; - return true; - } - } - else - { - color_values col (s); - if (! error_state) - { - if (current_type != color_t || col != color_val) - { - color_val = col; - current_type = color_t; - return true; - } - } - else - error ("invalid value for color property \"%s\" (value = %s)", - get_name ().c_str (), s.c_str ()); - } - } - else - error ("invalid value for color property \"%s\"", - get_name ().c_str ()); - } - else if (val.is_numeric_type ()) - { - Matrix m = val.matrix_value (); - - if (m.numel () == 3) - { - color_values col (m(0), m(1), m(2)); - if (! error_state) - { - if (current_type != color_t || col != color_val) - { - color_val = col; - current_type = color_t; - return true; - } - } - } - else - error ("invalid value for color property \"%s\"", - get_name ().c_str ()); - } - else - error ("invalid value for color property \"%s\"", - get_name ().c_str ()); - - return false; -} - -bool -double_radio_property::do_set (const octave_value& val) -{ - if (val.is_string ()) - { - std::string s = val.string_value (); - std::string match; - - if (! s.empty () && radio_val.contains (s, match)) - { - if (current_type != radio_t || match != current_val) - { - if (s.length () != match.length ()) - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s value %s", - "set", s.c_str (), get_name ().c_str (), - match.c_str ()); - current_val = match; - current_type = radio_t; - return true; - } - } - else - error ("invalid value for double_radio property \"%s\"", - get_name ().c_str ()); - } - else if (val.is_scalar_type () && val.is_real_type ()) - { - double new_dval = val.double_value (); - - if (current_type != double_t || new_dval != dval) - { - dval = new_dval; - current_type = double_t; - return true; - } - } - else - error ("invalid value for double_radio property \"%s\"", - get_name ().c_str ()); - - return false; -} - -bool -array_property::validate (const octave_value& v) -{ - bool xok = false; - - // FIXME -- should we always support []? - if (v.is_empty () && v.is_numeric_type ()) - return true; - - // check value type - if (type_constraints.size () > 0) - { - for (std::list::const_iterator it = type_constraints.begin (); - ! xok && it != type_constraints.end (); ++it) - if ((*it) == v.class_name ()) - xok = true; - } - else - xok = v.is_numeric_type (); - - if (xok) - { - dim_vector vdims = v.dims (); - int vlen = vdims.length (); - - xok = false; - - // check value size - if (size_constraints.size () > 0) - for (std::list::const_iterator it = size_constraints.begin (); - ! xok && it != size_constraints.end (); ++it) - { - dim_vector itdims = (*it); - - if (itdims.length () == vlen) - { - xok = true; - - for (int i = 0; xok && i < vlen; i++) - if (itdims(i) >= 0 && itdims(i) != vdims(i)) - xok = false; - } - } - else - return true; - } - - return xok; -} - -bool -array_property::is_equal (const octave_value& v) const -{ - if (data.type_name () == v.type_name ()) - { - if (data.dims () == v.dims ()) - { - -#define CHECK_ARRAY_EQUAL(T,F,A) \ - { \ - if (data.numel () == 1) \ - return data.F ## scalar_value () == \ - v.F ## scalar_value (); \ - else \ - { \ - /* Keep copy of array_value to allow sparse/bool arrays */ \ - /* that are converted, to not be deallocated early */ \ - const A m1 = data.F ## array_value (); \ - const T* d1 = m1.data (); \ - const A m2 = v.F ## array_value (); \ - const T* d2 = m2.data ();\ - \ - bool flag = true; \ - \ - for (int i = 0; flag && i < data.numel (); i++) \ - if (d1[i] != d2[i]) \ - flag = false; \ - \ - return flag; \ - } \ - } - - if (data.is_double_type () || data.is_bool_type ()) - CHECK_ARRAY_EQUAL (double, , NDArray) - else if (data.is_single_type ()) - CHECK_ARRAY_EQUAL (float, float_, FloatNDArray) - else if (data.is_int8_type ()) - CHECK_ARRAY_EQUAL (octave_int8, int8_, int8NDArray) - else if (data.is_int16_type ()) - CHECK_ARRAY_EQUAL (octave_int16, int16_, int16NDArray) - else if (data.is_int32_type ()) - CHECK_ARRAY_EQUAL (octave_int32, int32_, int32NDArray) - else if (data.is_int64_type ()) - CHECK_ARRAY_EQUAL (octave_int64, int64_, int64NDArray) - else if (data.is_uint8_type ()) - CHECK_ARRAY_EQUAL (octave_uint8, uint8_, uint8NDArray) - else if (data.is_uint16_type ()) - CHECK_ARRAY_EQUAL (octave_uint16, uint16_, uint16NDArray) - else if (data.is_uint32_type ()) - CHECK_ARRAY_EQUAL (octave_uint32, uint32_, uint32NDArray) - else if (data.is_uint64_type ()) - CHECK_ARRAY_EQUAL (octave_uint64, uint64_, uint64NDArray) - } - } - - return false; -} - -void -array_property::get_data_limits (void) -{ - xmin = xminp = octave_Inf; - xmax = xmaxp = -octave_Inf; - - if (! data.is_empty ()) - { - if (data.is_integer_type ()) - { - if (data.is_int8_type ()) - get_array_limits (data.int8_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint8_type ()) - get_array_limits (data.uint8_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_int16_type ()) - get_array_limits (data.int16_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint16_type ()) - get_array_limits (data.uint16_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_int32_type ()) - get_array_limits (data.int32_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint32_type ()) - get_array_limits (data.uint32_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_int64_type ()) - get_array_limits (data.int64_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint64_type ()) - get_array_limits (data.uint64_array_value (), xmin, xmax, xminp, xmaxp); - } - else - get_array_limits (data.array_value (), xmin, xmax, xminp, xmaxp); - } -} - -bool -handle_property::do_set (const octave_value& v) -{ - double dv = v.double_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (dv); - - if (xisnan (gh.value ()) || gh.ok ()) - { - if (current_val != gh) - { - current_val = gh; - return true; - } - } - else - error ("set: invalid graphics handle (= %g) for property \"%s\"", - dv, get_name ().c_str ()); - } - else - error ("set: invalid graphics handle for property \"%s\"", - get_name ().c_str ()); - - return false; -} - -Matrix -children_property::do_get_children (bool return_hidden) const -{ - Matrix retval (children_list.size (), 1); - octave_idx_type k = 0; - - graphics_object go = gh_manager::get_object (0); - - root_figure::properties& props = - dynamic_cast (go.get_properties ()); - - if (! props.is_showhiddenhandles ()) - { - for (const_children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - graphics_handle kid = *p; - - if (gh_manager::is_handle_visible (kid)) - { - if (! return_hidden) - retval(k++) = *p; - } - else if (return_hidden) - retval(k++) = *p; - } - - retval.resize (k, 1); - } - else - { - for (const_children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - retval(k++) = *p; - } - - return retval; -} - -void -children_property::do_delete_children (bool clear) -{ - for (children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - graphics_object go = gh_manager::get_object (*p); - - if (go.valid_object ()) - gh_manager::free (*p); - - } - - if (clear) - children_list.clear (); -} - -bool -callback_property::validate (const octave_value& v) const -{ - // case 1: function handle - // case 2: cell array with first element being a function handle - // case 3: string corresponding to known function name - // case 4: evaluatable string - // case 5: empty matrix - - if (v.is_function_handle ()) - return true; - else if (v.is_string ()) - // complete validation will be done at execution-time - return true; - else if (v.is_cell () && v.length () > 0 - && (v.rows () == 1 || v.columns () == 1) - && v.cell_value ()(0).is_function_handle ()) - return true; - else if (v.is_empty ()) - return true; - - return false; -} - -// If TRUE, we are executing any callback function, or the functions it -// calls. Used to determine handle visibility inside callback -// functions. -static bool executing_callback = false; - -void -callback_property::execute (const octave_value& data) const -{ - unwind_protect frame; - - // We are executing the callback function associated with this - // callback property. When set to true, we avoid recursive calls to - // callback routines. - frame.protect_var (executing); - - // We are executing a callback function, so allow handles that have - // their handlevisibility property set to "callback" to be visible. - frame.protect_var (executing_callback); - - if (! executing) - { - executing = true; - executing_callback = true; - - if (callback.is_defined () && ! callback.is_empty ()) - gh_manager::execute_callback (get_parent (), callback, data); - } -} - -// Used to cache dummy graphics objects from which dynamic -// properties can be cloned. -static std::map dprop_obj_map; - -property -property::create (const std::string& name, const graphics_handle& h, - const caseless_str& type, const octave_value_list& args) -{ - property retval; - - if (type.compare ("string")) - { - std::string val = (args.length () > 0 ? args(0).string_value () : ""); - - if (! error_state) - retval = property (new string_property (name, h, val)); - } - else if (type.compare ("any")) - { - octave_value val = - (args.length () > 0 ? args(0) : octave_value (Matrix ())); - - retval = property (new any_property (name, h, val)); - } - else if (type.compare ("radio")) - { - if (args.length () > 0) - { - std::string vals = args(0).string_value (); - - if (! error_state) - { - retval = property (new radio_property (name, h, vals)); - - if (args.length () > 1) - retval.set (args(1)); - } - else - error ("addproperty: invalid argument for radio property, expected a string value"); - } - else - error ("addproperty: missing possible values for radio property"); - } - else if (type.compare ("double")) - { - double d = (args.length () > 0 ? args(0).double_value () : 0); - - if (! error_state) - retval = property (new double_property (name, h, d)); - } - else if (type.compare ("handle")) - { - double hh = (args.length () > 0 ? args(0).double_value () : octave_NaN); - - if (! error_state) - { - graphics_handle gh (hh); - - retval = property (new handle_property (name, h, gh)); - } - } - else if (type.compare ("boolean")) - { - retval = property (new bool_property (name, h, false)); - - if (args.length () > 0) - retval.set (args(0)); - } - else if (type.compare ("data")) - { - retval = property (new array_property (name, h, Matrix ())); - - if (args.length () > 0) - { - retval.set (args(0)); - - // FIXME -- additional argument could define constraints, - // but is this really useful? - } - } - else if (type.compare ("color")) - { - color_values cv (0, 0, 0); - radio_values rv; - - if (args.length () > 1) - rv = radio_values (args(1).string_value ()); - - if (! error_state) - { - retval = property (new color_property (name, h, cv, rv)); - - if (! error_state) - { - if (args.length () > 0 && ! args(0).is_empty ()) - retval.set (args(0)); - else - retval.set (rv.default_value ()); - } - } - } - else - { - caseless_str go_name, go_rest; - - if (lookup_object_name (type, go_name, go_rest)) - { - graphics_object go; - - std::map::const_iterator it = - dprop_obj_map.find (go_name); - - if (it == dprop_obj_map.end ()) - { - base_graphics_object *bgo = - make_graphics_object_from_type (go_name); - - if (bgo) - { - go = graphics_object (bgo); - - dprop_obj_map[go_name] = go; - } - } - else - go = it->second; - - if (go.valid_object ()) - { - property prop = go.get_properties ().get_property (go_rest); - - if (! error_state) - { - retval = prop.clone (); - - retval.set_parent (h); - retval.set_name (name); - - if (args.length () > 0) - retval.set (args(0)); - } - } - else - error ("addproperty: invalid object type (= %s)", - go_name.c_str ()); - } - else - error ("addproperty: unsupported type for dynamic property (= %s)", - type.c_str ()); - } - - return retval; -} - -static void -finalize_r (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - if (go) - { - Matrix children = go.get_properties ().get_all_children (); - - for (int k = 0; k < children.numel (); k++) - finalize_r (children(k)); - - go.finalize (); - } -} - -static void -initialize_r (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - if (go) - { - Matrix children = go.get_properties ().get_all_children (); - - go.initialize (); - - for (int k = 0; k < children.numel (); k++) - initialize_r (children(k)); - } -} - -void -figure::properties::set_toolkit (const graphics_toolkit& b) -{ - if (toolkit) - finalize_r (get___myhandle__ ()); - - toolkit = b; - __graphics_toolkit__ = b.get_name (); - __plot_stream__ = Matrix (); - - if (toolkit) - initialize_r (get___myhandle__ ()); - - mark_modified (); -} - -// --------------------------------------------------------------------- - -void -property_list::set (const caseless_str& name, const octave_value& val) -{ - size_t offset = 0; - - size_t len = name.length (); - - if (len > 4) - { - caseless_str pfx = name.substr (0, 4); - - if (pfx.compare ("axes") || pfx.compare ("line") - || pfx.compare ("text")) - offset = 4; - else if (len > 5) - { - pfx = name.substr (0, 5); - - if (pfx.compare ("image") || pfx.compare ("patch")) - offset = 5; - else if (len > 6) - { - pfx = name.substr (0, 6); - - if (pfx.compare ("figure") || pfx.compare ("uimenu")) - offset = 6; - else if (len > 7) - { - pfx = name.substr (0, 7); - - if (pfx.compare ("surface") || pfx.compare ("hggroup") - || pfx.compare ("uipanel")) - offset = 7; - else if (len > 9) - { - pfx = name.substr (0, 9); - - if (pfx.compare ("uicontrol") - || pfx.compare ("uitoolbar")) - offset = 9; - else if (len > 10) - { - pfx = name.substr (0, 10); - - if (pfx.compare ("uipushtool")) - offset = 10; - else if (len > 12) - { - pfx = name.substr (0, 12); - - if (pfx.compare ("uitoogletool")) - offset = 12; - else if (len > 13) - { - pfx = name.substr (0, 13); - - if (pfx.compare ("uicontextmenu")) - offset = 13; - } - } - } - } - } - } - } - - if (offset > 0) - { - // FIXME -- should we validate property names and values here? - - std::string pname = name.substr (offset); - - std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); - std::transform (pname.begin (), pname.end (), pname.begin (), tolower); - - bool has_property = false; - if (pfx == "axes") - has_property = axes::properties::has_core_property (pname); - else if (pfx == "line") - has_property = line::properties::has_core_property (pname); - else if (pfx == "text") - has_property = text::properties::has_core_property (pname); - else if (pfx == "image") - has_property = image::properties::has_core_property (pname); - else if (pfx == "patch") - has_property = patch::properties::has_core_property (pname); - else if (pfx == "figure") - has_property = figure::properties::has_core_property (pname); - else if (pfx == "surface") - has_property = surface::properties::has_core_property (pname); - else if (pfx == "hggroup") - has_property = hggroup::properties::has_core_property (pname); - else if (pfx == "uimenu") - has_property = uimenu::properties::has_core_property (pname); - else if (pfx == "uicontrol") - has_property = uicontrol::properties::has_core_property (pname); - else if (pfx == "uipanel") - has_property = uipanel::properties::has_core_property (pname); - else if (pfx == "uicontextmenu") - has_property = uicontextmenu::properties::has_core_property (pname); - else if (pfx == "uitoolbar") - has_property = uitoolbar::properties::has_core_property (pname); - else if (pfx == "uipushtool") - has_property = uipushtool::properties::has_core_property (pname); - - if (has_property) - { - bool remove = false; - if (val.is_string ()) - { - caseless_str tval = val.string_value (); - - remove = tval.compare ("remove"); - } - - pval_map_type& pval_map = plist_map[pfx]; - - if (remove) - { - pval_map_iterator p = pval_map.find (pname); - - if (p != pval_map.end ()) - pval_map.erase (p); - } - else - pval_map[pname] = val; - } - else - error ("invalid %s property `%s'", pfx.c_str (), pname.c_str ()); - } - } - - if (! error_state && offset == 0) - error ("invalid default property specification"); -} - -octave_value -property_list::lookup (const caseless_str& name) const -{ - octave_value retval; - - size_t offset = 0; - - size_t len = name.length (); - - if (len > 4) - { - caseless_str pfx = name.substr (0, 4); - - if (pfx.compare ("axes") || pfx.compare ("line") - || pfx.compare ("text")) - offset = 4; - else if (len > 5) - { - pfx = name.substr (0, 5); - - if (pfx.compare ("image") || pfx.compare ("patch")) - offset = 5; - else if (len > 6) - { - pfx = name.substr (0, 6); - - if (pfx.compare ("figure") || pfx.compare ("uimenu")) - offset = 6; - else if (len > 7) - { - pfx = name.substr (0, 7); - - if (pfx.compare ("surface") || pfx.compare ("hggroup") - || pfx.compare ("uipanel")) - offset = 7; - else if (len > 9) - { - pfx = name.substr (0, 9); - - if (pfx.compare ("uicontrol") - || pfx.compare ("uitoolbar")) - offset = 9; - else if (len > 10) - { - pfx = name.substr (0, 10); - - if (pfx.compare ("uipushtool")) - offset = 10; - else if (len > 12) - { - pfx = name.substr (0, 12); - - if (pfx.compare ("uitoggletool")) - offset = 12; - else if (len > 13) - { - pfx = name.substr (0, 13); - - if (pfx.compare ("uicontextmenu")) - offset = 13; - } - } - } - } - } - } - } - - if (offset > 0) - { - std::string pname = name.substr (offset); - - std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); - std::transform (pname.begin (), pname.end (), pname.begin (), tolower); - - plist_map_const_iterator p = find (pfx); - - if (p != end ()) - { - const pval_map_type& pval_map = p->second; - - pval_map_const_iterator q = pval_map.find (pname); - - if (q != pval_map.end ()) - retval = q->second; - } - } - } - - return retval; -} - -octave_scalar_map -property_list::as_struct (const std::string& prefix_arg) const -{ - octave_scalar_map m; - - for (plist_map_const_iterator p = begin (); p != end (); p++) - { - std::string prefix = prefix_arg + p->first; - - const pval_map_type pval_map = p->second; - - for (pval_map_const_iterator q = pval_map.begin (); - q != pval_map.end (); - q++) - m.assign (prefix + q->first, q->second); - } - - return m; -} - -graphics_handle::graphics_handle (const octave_value& a) - : val (octave_NaN) -{ - if (a.is_empty ()) - /* do nothing */; - else - { - double tval = a.double_value (); - - if (! error_state) - val = tval; - else - error ("invalid graphics handle"); - } -} - -// Set properties given as a cs-list of name, value pairs. - -void -graphics_object::set (const octave_value_list& args) -{ - int nargin = args.length (); - - if (nargin == 0) - error ("graphics_object::set: Nothing to set"); - else if (nargin % 2 == 0) - { - for (int i = 0; i < nargin; i += 2) - { - caseless_str name = args(i).string_value (); - - if (! error_state) - { - octave_value val = args(i+1); - - set_value_or_default (name, val); - - if (error_state) - break; - } - else - error ("set: expecting argument %d to be a property name", i); - } - } - else - error ("set: invalid number of arguments"); -} - -/* -## test set with name, value pairs -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (h, "linewidth", 10, "marker", "x"); -%! assert (get (h, "linewidth"), 10); -%! assert (get (h, "marker"), "x"); -*/ - -// Set properties given in two cell arrays containing names and values. -void -graphics_object::set (const Array& names, - const Cell& values, octave_idx_type row) -{ - if (names.numel () != values.columns ()) - { - error ("set: number of names must match number of value columns (%d != %d)", - names.numel (), values.columns ()); - } - - octave_idx_type k = names.columns (); - - for (octave_idx_type column = 0; column < k; column++) - { - caseless_str name = names(column); - octave_value val = values(row, column); - - set_value_or_default (name, val); - - if (error_state) - break; - } -} - -/* -## test set with cell array arguments -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (h, {"linewidth", "marker"}, {10, "x"}); -%! assert (get (h, "linewidth"), 10); -%! assert (get (h, "marker"), "x"); - -## test set with multiple handles and cell array arguments -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"}); -%! assert (get (h, "linewidth"), {10; 5}); -%! assert (get (h, "marker"), {"x"; "o"}); -%! set (h, {"linewidth", "marker"}, {10, "x"}); -%! assert (get (h, "linewidth"), {10; 10}); -%! assert (get (h, "marker"), {"x"; "x"}); - -%!error -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"; 7, "."}); - -%!error -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, {"linewidth"}, {10, "x"; 5, "o"}); -*/ - -// Set properties given in a struct array -void -graphics_object::set (const octave_map& m) -{ - for (octave_map::const_iterator p = m.begin (); - p != m.end (); p++) - { - caseless_str name = m.key (p); - - octave_value val = octave_value (m.contents (p).elem (m.numel () - 1)); - - set_value_or_default (name, val); - - if (error_state) - break; - } -} - -/* -## test set with struct arguments -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (h, struct ("linewidth", 10, "marker", "x")); -%! assert (get (h, "linewidth"), 10); -%! assert (get (h, "marker"), "x"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, struct ("linewidth", {5, 10})); -%! assert (get (h, "linewidth"), {10; 10}); -*/ - -// Set a property to a value or to its (factory) default value. - -void -graphics_object::set_value_or_default (const caseless_str& name, - const octave_value& val) -{ - if (val.is_string ()) - { - caseless_str tval = val.string_value (); - - octave_value default_val; - - if (tval.compare ("default")) - { - default_val = get_default (name); - - if (error_state) - return; - - rep->set (name, default_val); - } - else if (tval.compare ("factory")) - { - default_val = get_factory_default (name); - - if (error_state) - return; - - rep->set (name, default_val); - } - else - rep->set (name, val); - } - else - rep->set (name, val); -} - -/* -## test setting of default values -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (0, "defaultlinelinewidth", 20); -%! set (h, "linewidth", "default"); -%! assert (get (h, "linewidth"), 20); -%! set (h, "linewidth", "factory"); -%! assert (get (h, "linewidth"), 0.5); -*/ - -static double -make_handle_fraction (void) -{ - static double maxrand = RAND_MAX + 2.0; - - return (rand () + 1.0) / maxrand; -} - -graphics_handle -gh_manager::do_get_handle (bool integer_figure_handle) -{ - graphics_handle retval; - - if (integer_figure_handle) - { - // Figure handles are positive integers corresponding to the - // figure number. - - // We always want the lowest unused figure number. - - retval = 1; - - while (handle_map.find (retval) != handle_map.end ()) - retval++; - } - else - { - // Other graphics handles are negative integers plus some random - // fractional part. To avoid running out of integers, we - // recycle the integer part but tack on a new random part each - // time. - - free_list_iterator p = handle_free_list.begin (); - - if (p != handle_free_list.end ()) - { - retval = *p; - handle_free_list.erase (p); - } - else - { - retval = graphics_handle (next_handle); - - next_handle = std::ceil (next_handle) - 1.0 - make_handle_fraction (); - } - } - - return retval; -} - -void -gh_manager::do_free (const graphics_handle& h) -{ - if (h.ok ()) - { - if (h.value () != 0) - { - iterator p = handle_map.find (h); - - if (p != handle_map.end ()) - { - base_properties& bp = p->second.get_properties (); - - bp.set_beingdeleted (true); - - bp.delete_children (); - - octave_value val = bp.get_deletefcn (); - - bp.execute_deletefcn (); - - // Notify graphics toolkit. - p->second.finalize (); - - // Note: this will be valid only for first explicitly - // deleted object. All its children will then have an - // unknown graphics toolkit. - - // Graphics handles for non-figure objects are negative - // integers plus some random fractional part. To avoid - // running out of integers, we recycle the integer part - // but tack on a new random part each time. - - handle_map.erase (p); - - if (h.value () < 0) - handle_free_list.insert (std::ceil (h.value ()) - make_handle_fraction ()); - } - else - error ("graphics_handle::free: invalid object %g", h.value ()); - } - else - error ("graphics_handle::free: can't delete root figure"); - } -} - -void -gh_manager::do_renumber_figure (const graphics_handle& old_gh, - const graphics_handle& new_gh) -{ - iterator p = handle_map.find (old_gh); - - if (p != handle_map.end ()) - { - graphics_object go = p->second; - - handle_map.erase (p); - - handle_map[new_gh] = go; - - if (old_gh.value () < 0) - handle_free_list.insert (std::ceil (old_gh.value ()) - - make_handle_fraction ()); - } - else - error ("graphics_handle::free: invalid object %g", old_gh.value ()); - - for (figure_list_iterator q = figure_list.begin (); - q != figure_list.end (); q++) - { - if (*q == old_gh) - { - *q = new_gh; - break; - } - } -} - -gh_manager *gh_manager::instance = 0; - -static void -xset (const graphics_handle& h, const caseless_str& name, - const octave_value& val) -{ - graphics_object obj = gh_manager::get_object (h); - obj.set (name, val); -} - -static void -xset (const graphics_handle& h, const octave_value_list& args) -{ - if (args.length () > 0) - { - graphics_object obj = gh_manager::get_object (h); - obj.set (args); - } -} - -static octave_value -xget (const graphics_handle& h, const caseless_str& name) -{ - graphics_object obj = gh_manager::get_object (h); - return obj.get (name); -} - -static graphics_handle -reparent (const octave_value& ov, const std::string& who, - const std::string& property, const graphics_handle& new_parent, - bool adopt = true) -{ - graphics_handle h = octave_NaN; - - double val = ov.double_value (); - - if (! error_state) - { - h = gh_manager::lookup (val); - - if (h.ok ()) - { - graphics_object obj = gh_manager::get_object (h); - - graphics_handle parent_h = obj.get_parent (); - - graphics_object parent_obj = gh_manager::get_object (parent_h); - - parent_obj.remove_child (h); - - if (adopt) - obj.set ("parent", new_parent.value ()); - else - obj.reparent (new_parent); - } - else - error ("%s: invalid graphics handle (= %g) for %s", - who.c_str (), val, property.c_str ()); - } - else - error ("%s: expecting %s to be a graphics handle", - who.c_str (), property.c_str ()); - - return h; -} - -// This function is NOT equivalent to the scripting language function gcf. -graphics_handle -gcf (void) -{ - octave_value val = xget (0, "currentfigure"); - - return val.is_empty () ? octave_NaN : val.double_value (); -} - -// This function is NOT equivalent to the scripting language function gca. -graphics_handle -gca (void) -{ - octave_value val = xget (gcf (), "currentaxes"); - - return val.is_empty () ? octave_NaN : val.double_value (); -} - -static void -delete_graphics_object (const graphics_handle& h) -{ - if (h.ok ()) - { - graphics_object obj = gh_manager::get_object (h); - - // Don't do recursive deleting, due to callbacks - if (! obj.get_properties ().is_beingdeleted ()) - { - graphics_handle parent_h = obj.get_parent (); - - graphics_object parent_obj = - gh_manager::get_object (parent_h); - - // NOTE: free the handle before removing it from its - // parent's children, such that the object's - // state is correct when the deletefcn callback - // is executed - - gh_manager::free (h); - - // A callback function might have already deleted - // the parent - if (parent_obj.valid_object ()) - parent_obj.remove_child (h); - - Vdrawnow_requested = true; - } - } -} - -static void -delete_graphics_object (double val) -{ - delete_graphics_object (gh_manager::lookup (val)); -} - -static void -delete_graphics_objects (const NDArray vals) -{ - for (octave_idx_type i = 0; i < vals.numel (); i++) - delete_graphics_object (vals.elem (i)); -} - -static void -close_figure (const graphics_handle& handle) -{ - octave_value closerequestfcn = xget (handle, "closerequestfcn"); - - OCTAVE_SAFE_CALL (gh_manager::execute_callback, (handle, closerequestfcn)); -} - -static void -force_close_figure (const graphics_handle& handle) -{ - // Remove the deletefcn and closerequestfcn callbacks and delete the - // object directly. - - xset (handle, "deletefcn", Matrix ()); - xset (handle, "closerequestfcn", Matrix ()); - - delete_graphics_object (handle); -} - -void -gh_manager::do_close_all_figures (void) -{ - // FIXME -- should we process or discard pending events? - - event_queue.clear (); - - // Don't use figure_list_iterator because we'll be removing elements - // from the list elsewhere. - - Matrix hlist = do_figure_handle_list (true); - - for (octave_idx_type i = 0; i < hlist.numel (); i++) - { - graphics_handle h = gh_manager::lookup (hlist(i)); - - if (h.ok ()) - close_figure (h); - } - - // They should all be closed now. If not, force them to close. - - hlist = do_figure_handle_list (true); - - for (octave_idx_type i = 0; i < hlist.numel (); i++) - { - graphics_handle h = gh_manager::lookup (hlist(i)); - - if (h.ok ()) - force_close_figure (h); - } - - // None left now, right? - - hlist = do_figure_handle_list (true); - - assert (hlist.numel () == 0); - - // Clear all callback objects from our list. - - callback_objects.clear (); -} - -static void -adopt (const graphics_handle& p, const graphics_handle& h) -{ - graphics_object parent_obj = gh_manager::get_object (p); - parent_obj.adopt (h); -} - -static bool -is_handle (const graphics_handle& h) -{ - return h.ok (); -} - -static bool -is_handle (double val) -{ - graphics_handle h = gh_manager::lookup (val); - - return h.ok (); -} - -static octave_value -is_handle (const octave_value& val) -{ - octave_value retval = false; - - if (val.is_real_scalar () && is_handle (val.double_value ())) - retval = true; - else if (val.is_numeric_type () && val.is_real_type ()) - { - const NDArray handles = val.array_value (); - - if (! error_state) - { - boolNDArray result (handles.dims ()); - - for (octave_idx_type i = 0; i < handles.numel (); i++) - result.xelem (i) = is_handle (handles (i)); - - retval = result; - } - } - - return retval; -} - -static bool -is_figure (double val) -{ - graphics_object obj = gh_manager::get_object (val); - - return obj && obj.isa ("figure"); -} - -static void -xcreatefcn (const graphics_handle& h) -{ - graphics_object obj = gh_manager::get_object (h); - obj.get_properties ().execute_createfcn (); -} - -static void -xinitialize (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - if (go) - go.initialize (); -} - -// --------------------------------------------------------------------- - -void -base_graphics_toolkit::update (const graphics_handle& h, int id) -{ - graphics_object go = gh_manager::get_object (h); - - update (go, id); -} - -bool -base_graphics_toolkit::initialize (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - return initialize (go); -} - -void -base_graphics_toolkit::finalize (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - finalize (go); -} - -// --------------------------------------------------------------------- - -void -base_properties::set_from_list (base_graphics_object& obj, - property_list& defaults) -{ - std::string go_name = graphics_object_name (); - - property_list::plist_map_const_iterator p = defaults.find (go_name); - - if (p != defaults.end ()) - { - const property_list::pval_map_type pval_map = p->second; - - for (property_list::pval_map_const_iterator q = pval_map.begin (); - q != pval_map.end (); - q++) - { - std::string pname = q->first; - - obj.set (pname, q->second); - - if (error_state) - { - error ("error setting default property %s", pname.c_str ()); - break; - } - } - } -} - -octave_value -base_properties::get_dynamic (const caseless_str& name) const -{ - octave_value retval; - - std::map::const_iterator it = all_props.find (name); - - if (it != all_props.end ()) - retval = it->second.get (); - else - error ("get: unknown property \"%s\"", name.c_str ()); - - return retval; -} - -octave_value -base_properties::get_dynamic (bool all) const -{ - octave_scalar_map m; - - for (std::map::const_iterator it = all_props.begin (); - it != all_props.end (); ++it) - if (all || ! it->second.is_hidden ()) - m.assign (it->second.get_name (), it->second.get ()); - - return m; -} - -std::set -base_properties::dynamic_property_names (void) const -{ - return dynamic_properties; -} - -bool -base_properties::has_dynamic_property (const std::string& pname) -{ - const std::set& dynprops = dynamic_property_names (); - - if (dynprops.find (pname) != dynprops.end ()) - return true; - else - return all_props.find (pname) != all_props.end (); -} - -void -base_properties::set_dynamic (const caseless_str& pname, - const octave_value& val) -{ - std::map::iterator it = all_props.find (pname); - - if (it != all_props.end ()) - it->second.set (val); - else - error ("set: unknown property \"%s\"", pname.c_str ()); - - if (! error_state) - { - dynamic_properties.insert (pname); - - mark_modified (); - } -} - -property -base_properties::get_property_dynamic (const caseless_str& name) -{ - std::map::const_iterator it = all_props.find (name); - - if (it == all_props.end ()) - { - error ("get_property: unknown property \"%s\"", name.c_str ()); - return property (); - } - else - return it->second; -} - -void -base_properties::set_parent (const octave_value& val) -{ - double tmp = val.double_value (); - - graphics_handle new_parent = octave_NaN; - - if (! error_state) - { - new_parent = gh_manager::lookup (tmp); - - if (new_parent.ok ()) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - parent_obj.remove_child (__myhandle__); - - parent = new_parent.as_octave_value (); - - ::adopt (parent.handle_value (), __myhandle__); - } - else - error ("set: invalid graphics handle (= %g) for parent", tmp); - } - else - error ("set: expecting parent to be a graphics handle"); -} - -void -base_properties::mark_modified (void) -{ - __modified__ = "on"; - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - if (parent_obj) - parent_obj.mark_modified (); -} - -void -base_properties::override_defaults (base_graphics_object& obj) -{ - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj) - parent_obj.override_defaults (obj); -} - -void -base_properties::update_axis_limits (const std::string& axis_type) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - obj.update_axis_limits (axis_type); -} - -void -base_properties::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - obj.update_axis_limits (axis_type, h); -} - -bool -base_properties::is_handle_visible (void) const -{ - return (handlevisibility.is ("on") - || (executing_callback && ! handlevisibility.is ("off"))); -} - -graphics_toolkit -base_properties::get_toolkit (void) const -{ - graphics_object go = gh_manager::get_object (get_parent ()); - - if (go) - return go.get_toolkit (); - else - return graphics_toolkit (); -} - -void -base_properties::update_boundingbox (void) -{ - Matrix kids = get_children (); - - for (int i = 0; i < kids.numel (); i++) - { - graphics_object go = gh_manager::get_object (kids(i)); - - if (go.valid_object ()) - go.get_properties ().update_boundingbox (); - } -} - -void -base_properties::update_autopos (const std::string& elem_type) -{ - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj.valid_object ()) - parent_obj.get_properties ().update_autopos (elem_type); -} - -void -base_properties::add_listener (const caseless_str& nm, const octave_value& v, - listener_mode mode) -{ - property p = get_property (nm); - - if (! error_state && p.ok ()) - p.add_listener (v, mode); -} - -void -base_properties::delete_listener (const caseless_str& nm, - const octave_value& v, listener_mode mode) -{ - property p = get_property (nm); - - if (! error_state && p.ok ()) - p.delete_listener (v, mode); -} - -// --------------------------------------------------------------------- - -void -base_graphics_object::update_axis_limits (const std::string& axis_type) -{ - if (valid_object ()) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj) - parent_obj.update_axis_limits (axis_type); - } - else - error ("base_graphics_object::update_axis_limits: invalid graphics object"); -} - -void -base_graphics_object::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) -{ - if (valid_object ()) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj) - parent_obj.update_axis_limits (axis_type, h); - } - else - error ("base_graphics_object::update_axis_limits: invalid graphics object"); -} - -void -base_graphics_object::remove_all_listeners (void) -{ - octave_map m = get (true).map_value (); - - for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) - { - // FIXME -- there has to be a better way. I think we want to - // ask whether it is OK to delete the listener for the given - // property. How can we know in advance that it will be OK? - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (discard_error_messages); - frame.protect_var (Vdebug_on_error); - frame.protect_var (Vdebug_on_warning); - - discard_error_messages = true; - Vdebug_on_error = false; - Vdebug_on_warning = false; - - property p = get_properties ().get_property (pa->first); - - if (! error_state && p.ok ()) - p.delete_listener (); - } -} - -std::string -base_graphics_object::values_as_string (void) -{ - std::string retval; - - if (valid_object ()) - { - octave_map m = get ().map_value (); - - for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) - { - if (pa->first != "children") - { - property p = get_properties ().get_property (pa->first); - - if (p.ok () && ! p.is_hidden ()) - { - retval += "\n\t" + std::string (pa->first) + ": "; - if (p.is_radio ()) - retval += p.values_as_string (); - } - } - } - if (retval != "") - retval += "\n"; - } - else - error ("base_graphics_object::values_as_string: invalid graphics object"); - - return retval; -} - -octave_scalar_map -base_graphics_object::values_as_struct (void) -{ - octave_scalar_map retval; - - if (valid_object ()) - { - octave_scalar_map m = get ().scalar_map_value (); - - for (octave_scalar_map::const_iterator pa = m.begin (); - pa != m.end (); pa++) - { - if (pa->first != "children") - { - property p = get_properties ().get_property (pa->first); - - if (p.ok () && ! p.is_hidden ()) - { - if (p.is_radio ()) - retval.assign (p.get_name (), p.values_as_cell ()); - else - retval.assign (p.get_name (), Cell ()); - } - } - } - } - else - error ("base_graphics_object::values_as_struct: invalid graphics object"); - - return retval; -} - -graphics_object -graphics_object::get_ancestor (const std::string& obj_type) const -{ - if (valid_object ()) - { - if (isa (obj_type)) - return *this; - else - return gh_manager::get_object (get_parent ()).get_ancestor (obj_type); - } - else - return graphics_object (); -} - -// --------------------------------------------------------------------- - -#include "graphics-props.cc" - -// --------------------------------------------------------------------- - -void -root_figure::properties::set_currentfigure (const octave_value& v) -{ - graphics_handle val (v); - - if (error_state) - return; - - if (xisnan (val.value ()) || is_handle (val)) - { - currentfigure = val; - - if (val.ok ()) - gh_manager::push_figure (val); - } - else - gripe_set_invalid ("currentfigure"); -} - -void -root_figure::properties::set_callbackobject (const octave_value& v) -{ - graphics_handle val (v); - - if (error_state) - return; - - if (xisnan (val.value ())) - { - if (! cbo_stack.empty ()) - { - val = cbo_stack.front (); - - cbo_stack.pop_front (); - } - - callbackobject = val; - } - else if (is_handle (val)) - { - if (get_callbackobject ().ok ()) - cbo_stack.push_front (get_callbackobject ()); - - callbackobject = val; - } - else - gripe_set_invalid ("callbackobject"); -} - -void -figure::properties::set_integerhandle (const octave_value& val) -{ - if (! error_state) - { - if (integerhandle.set (val, true)) - { - bool int_fig_handle = integerhandle.is_on (); - - graphics_object this_go = gh_manager::get_object (__myhandle__); - - graphics_handle old_myhandle = __myhandle__; - - __myhandle__ = gh_manager::get_handle (int_fig_handle); - - gh_manager::renumber_figure (old_myhandle, __myhandle__); - - graphics_object parent_go = gh_manager::get_object (get_parent ()); - - base_properties& props = parent_go.get_properties (); - - props.renumber_child (old_myhandle, __myhandle__); - - Matrix kids = get_children (); - - for (octave_idx_type i = 0; i < kids.numel (); i++) - { - graphics_object kid = gh_manager::get_object (kids(i)); - - kid.get_properties ().renumber_parent (__myhandle__); - } - - graphics_handle cf = gh_manager::current_figure (); - - if (__myhandle__ == cf) - xset (0, "currentfigure", __myhandle__.value ()); - - this_go.update (integerhandle.get_id ()); - - mark_modified (); - } - } -} - -// FIXME This should update monitorpositions and pointerlocation, but -// as these properties are yet used, and so it doesn't matter that they -// aren't set yet. -void -root_figure::properties::update_units (void) -{ - caseless_str xunits = get_units (); - - Matrix ss = default_screensize (); - - double dpi = get_screenpixelsperinch (); - - if (xunits.compare ("inches")) - { - ss(0) = 0; - ss(1) = 0; - ss(2) /= dpi; - ss(3) /= dpi; - } - else if (xunits.compare ("centimeters")) - { - ss(0) = 0; - ss(1) = 0; - ss(2) *= 2.54 / dpi; - ss(3) *= 2.54 / dpi; - } - else if (xunits.compare ("normalized")) - { - ss = Matrix (1, 4, 1.0); - ss(0) = 0; - ss(1) = 0; - } - else if (xunits.compare ("points")) - { - ss(0) = 0; - ss(1) = 0; - ss(2) *= 72 / dpi; - ss(3) *= 72 / dpi; - } - - set_screensize (ss); -} - -Matrix -root_figure::properties::get_boundingbox (bool, const Matrix&) const -{ - Matrix screen_size = screen_size_pixels (); - Matrix pos = Matrix (1, 4, 0); - pos(2) = screen_size(0); - pos(3) = screen_size(1); - return pos; -} - -/* -%!test -%! set (0, "units", "pixels"); -%! sz = get (0, "screensize") - [1, 1, 0, 0]; -%! dpi = get (0, "screenpixelsperinch"); -%! set (0, "units", "inches"); -%! assert (get (0, "screensize"), sz / dpi, 0.5 / dpi); -%! set (0, "units", "centimeters"); -%! assert (get (0, "screensize"), sz / dpi * 2.54, 0.5 / dpi * 2.54); -%! set (0, "units", "points"); -%! assert (get (0, "screensize"), sz / dpi * 72, 0.5 / dpi * 72); -%! set (0, "units", "normalized"); -%! assert (get (0, "screensize"), [0.0, 0.0, 1.0, 1.0]); -%! set (0, "units", "pixels"); -%! assert (get (0, "screensize"), sz + [1, 1, 0, 0]); -*/ - -void -root_figure::properties::remove_child (const graphics_handle& gh) -{ - gh_manager::pop_figure (gh); - - graphics_handle cf = gh_manager::current_figure (); - - xset (0, "currentfigure", cf.value ()); - - base_properties::remove_child (gh); -} - -property_list -root_figure::factory_properties = root_figure::init_factory_properties (); - -static void -reset_default_properties (property_list& default_properties) -{ - property_list new_defaults; - - for (property_list::plist_map_const_iterator p = default_properties.begin (); - p != default_properties.end (); p++) - { - const property_list::pval_map_type pval_map = p->second; - std::string prefix = p->first; - - for (property_list::pval_map_const_iterator q = pval_map.begin (); - q != pval_map.end (); - q++) - { - std::string s = q->first; - - if (prefix == "axes" && (s == "position" || s == "units")) - new_defaults.set (prefix + s, q->second); - else if (prefix == "figure" && (s == "position" || s == "units" - || s == "windowstyle" - || s == "paperunits")) - new_defaults.set (prefix + s, q->second); - } - } - - default_properties = new_defaults; -} - -void -root_figure::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -// --------------------------------------------------------------------- - -void -figure::properties::set_currentaxes (const octave_value& v) -{ - graphics_handle val (v); - - if (error_state) - return; - - if (xisnan (val.value ()) || is_handle (val)) - currentaxes = val; - else - gripe_set_invalid ("currentaxes"); -} - -void -figure::properties::remove_child (const graphics_handle& gh) -{ - base_properties::remove_child (gh); - - if (gh == currentaxes.handle_value ()) - { - graphics_handle new_currentaxes; - - Matrix kids = get_children (); - - for (octave_idx_type i = 0; i < kids.numel (); i++) - { - graphics_handle kid = kids(i); - - graphics_object go = gh_manager::get_object (kid); - - if (go.isa ("axes")) - { - new_currentaxes = kid; - break; - } - } - - currentaxes = new_currentaxes; - } -} - -void -figure::properties::set_visible (const octave_value& val) -{ - std::string s = val.string_value (); - - if (! error_state) - { - if (s == "on") - xset (0, "currentfigure", __myhandle__.value ()); - - visible = val; - } -} - -Matrix -figure::properties::get_boundingbox (bool internal, const Matrix&) const -{ - Matrix screen_size = screen_size_pixels (); - Matrix pos = (internal ? - get_position ().matrix_value () : - get_outerposition ().matrix_value ()); - - pos = convert_position (pos, get_units (), "pixels", screen_size); - - pos(0)--; - pos(1)--; - pos(1) = screen_size(1) - pos(1) - pos(3); - - return pos; -} - -void -figure::properties::set_boundingbox (const Matrix& bb, bool internal, - bool do_notify_toolkit) -{ - Matrix screen_size = screen_size_pixels (); - Matrix pos = bb; - - pos(1) = screen_size(1) - pos(1) - pos(3); - pos(1)++; - pos(0)++; - pos = convert_position (pos, "pixels", get_units (), screen_size); - - if (internal) - set_position (pos, do_notify_toolkit); - else - set_outerposition (pos, do_notify_toolkit); -} - -Matrix -figure::properties::map_from_boundingbox (double x, double y) const -{ - Matrix bb = get_boundingbox (true); - Matrix pos (1, 2, 0); - - pos(0) = x; - pos(1) = y; - - pos(1) = bb(3) - pos(1); - pos(0)++; - pos = convert_position (pos, "pixels", get_units (), - bb.extract_n (0, 2, 1, 2)); - - return pos; -} - -Matrix -figure::properties::map_to_boundingbox (double x, double y) const -{ - Matrix bb = get_boundingbox (true); - Matrix pos (1, 2, 0); - - pos(0) = x; - pos(1) = y; - - pos = convert_position (pos, get_units (), "pixels", - bb.extract_n (0, 2, 1, 2)); - pos(0)--; - pos(1) = bb(3) - pos(1); - - return pos; -} - -void -figure::properties::set_position (const octave_value& v, - bool do_notify_toolkit) -{ - if (! error_state) - { - Matrix old_bb, new_bb; - bool modified = false; - - old_bb = get_boundingbox (true); - modified = position.set (v, false, do_notify_toolkit); - new_bb = get_boundingbox (true); - - if (old_bb != new_bb) - { - if (old_bb(2) != new_bb(2) || old_bb(3) != new_bb(3)) - { - execute_resizefcn (); - update_boundingbox (); - } - } - - if (modified) - { - position.run_listeners (POSTSET); - mark_modified (); - } - } -} - -void -figure::properties::set_outerposition (const octave_value& v, - bool do_notify_toolkit) -{ - if (! error_state) - { - if (outerposition.set (v, true, do_notify_toolkit)) - { - mark_modified (); - } - } -} - -void -figure::properties::set_paperunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str typ = get_papertype (); - caseless_str punits = v.string_value (); - if (! error_state) - { - if (punits.compare ("normalized") && typ.compare ("")) - error ("set: can't set the paperunits to normalized when the papertype is custom"); - else - { - caseless_str old_paperunits = get_paperunits (); - if (paperunits.set (v, true)) - { - update_paperunits (old_paperunits); - mark_modified (); - } - } - } - } -} - -void -figure::properties::set_papertype (const octave_value& v) -{ - if (! error_state) - { - caseless_str typ = v.string_value (); - caseless_str punits = get_paperunits (); - if (! error_state) - { - if (punits.compare ("normalized") && typ.compare ("")) - error ("set: can't set the paperunits to normalized when the papertype is custom"); - else - { - if (papertype.set (v, true)) - { - update_papertype (); - mark_modified (); - } - } - } - } -} - -static Matrix -papersize_from_type (const caseless_str punits, const caseless_str typ) -{ - Matrix ret (1, 2, 1.0); - - if (! punits.compare ("normalized")) - { - double in2units; - double mm2units; - - if (punits.compare ("inches")) - { - in2units = 1.0; - mm2units = 1 / 25.4 ; - } - else if (punits.compare ("centimeters")) - { - in2units = 2.54; - mm2units = 1 / 10.0; - } - else // points - { - in2units = 72.0; - mm2units = 72.0 / 25.4; - } - - if (typ.compare ("usletter")) - { - ret (0) = 8.5 * in2units; - ret (1) = 11.0 * in2units; - } - else if (typ.compare ("uslegal")) - { - ret (0) = 8.5 * in2units; - ret (1) = 14.0 * in2units; - } - else if (typ.compare ("tabloid")) - { - ret (0) = 11.0 * in2units; - ret (1) = 17.0 * in2units; - } - else if (typ.compare ("a0")) - { - ret (0) = 841.0 * mm2units; - ret (1) = 1189.0 * mm2units; - } - else if (typ.compare ("a1")) - { - ret (0) = 594.0 * mm2units; - ret (1) = 841.0 * mm2units; - } - else if (typ.compare ("a2")) - { - ret (0) = 420.0 * mm2units; - ret (1) = 594.0 * mm2units; - } - else if (typ.compare ("a3")) - { - ret (0) = 297.0 * mm2units; - ret (1) = 420.0 * mm2units; - } - else if (typ.compare ("a4")) - { - ret (0) = 210.0 * mm2units; - ret (1) = 297.0 * mm2units; - } - else if (typ.compare ("a5")) - { - ret (0) = 148.0 * mm2units; - ret (1) = 210.0 * mm2units; - } - else if (typ.compare ("b0")) - { - ret (0) = 1029.0 * mm2units; - ret (1) = 1456.0 * mm2units; - } - else if (typ.compare ("b1")) - { - ret (0) = 728.0 * mm2units; - ret (1) = 1028.0 * mm2units; - } - else if (typ.compare ("b2")) - { - ret (0) = 514.0 * mm2units; - ret (1) = 728.0 * mm2units; - } - else if (typ.compare ("b3")) - { - ret (0) = 364.0 * mm2units; - ret (1) = 514.0 * mm2units; - } - else if (typ.compare ("b4")) - { - ret (0) = 257.0 * mm2units; - ret (1) = 364.0 * mm2units; - } - else if (typ.compare ("b5")) - { - ret (0) = 182.0 * mm2units; - ret (1) = 257.0 * mm2units; - } - else if (typ.compare ("arch-a")) - { - ret (0) = 9.0 * in2units; - ret (1) = 12.0 * in2units; - } - else if (typ.compare ("arch-b")) - { - ret (0) = 12.0 * in2units; - ret (1) = 18.0 * in2units; - } - else if (typ.compare ("arch-c")) - { - ret (0) = 18.0 * in2units; - ret (1) = 24.0 * in2units; - } - else if (typ.compare ("arch-d")) - { - ret (0) = 24.0 * in2units; - ret (1) = 36.0 * in2units; - } - else if (typ.compare ("arch-e")) - { - ret (0) = 36.0 * in2units; - ret (1) = 48.0 * in2units; - } - else if (typ.compare ("a")) - { - ret (0) = 8.5 * in2units; - ret (1) = 11.0 * in2units; - } - else if (typ.compare ("b")) - { - ret (0) = 11.0 * in2units; - ret (1) = 17.0 * in2units; - } - else if (typ.compare ("c")) - { - ret (0) = 17.0 * in2units; - ret (1) = 22.0 * in2units; - } - else if (typ.compare ("d")) - { - ret (0) = 22.0 * in2units; - ret (1) = 34.0 * in2units; - } - else if (typ.compare ("e")) - { - ret (0) = 34.0 * in2units; - ret (1) = 43.0 * in2units; - } - } - - return ret; -} - -void -figure::properties::update_paperunits (const caseless_str& old_paperunits) -{ - Matrix pos = get_paperposition ().matrix_value (); - Matrix sz = get_papersize ().matrix_value (); - - pos(0) /= sz(0); - pos(1) /= sz(1); - pos(2) /= sz(0); - pos(3) /= sz(1); - - std::string porient = get_paperorientation (); - caseless_str punits = get_paperunits (); - caseless_str typ = get_papertype (); - - if (typ.compare ("")) - { - if (old_paperunits.compare ("centimeters")) - { - sz(0) /= 2.54; - sz(1) /= 2.54; - } - else if (old_paperunits.compare ("points")) - { - sz(0) /= 72.0; - sz(1) /= 72.0; - } - - if (punits.compare ("centimeters")) - { - sz(0) *= 2.54; - sz(1) *= 2.54; - } - else if (punits.compare ("points")) - { - sz(0) *= 72.0; - sz(1) *= 72.0; - } - } - else - { - sz = papersize_from_type (punits, typ); - if (porient == "landscape") - std::swap (sz(0), sz(1)); - } - - pos(0) *= sz(0); - pos(1) *= sz(1); - pos(2) *= sz(0); - pos(3) *= sz(1); - - papersize.set (octave_value (sz)); - paperposition.set (octave_value (pos)); -} - -void -figure::properties::update_papertype (void) -{ - caseless_str typ = get_papertype (); - if (! typ.compare ("")) - { - Matrix sz = papersize_from_type (get_paperunits (), typ); - if (get_paperorientation () == "landscape") - std::swap (sz(0), sz(1)); - // Call papersize.set rather than set_papersize to avoid loops - // between update_papersize and update_papertype - papersize.set (octave_value (sz)); - } -} - -void -figure::properties::update_papersize (void) -{ - Matrix sz = get_papersize ().matrix_value (); - if (sz(0) > sz(1)) - { - std::swap (sz(0), sz(1)); - papersize.set (octave_value (sz)); - paperorientation.set (octave_value ("landscape")); - } - else - { - paperorientation.set ("portrait"); - } - std::string punits = get_paperunits (); - if (punits == "centimeters") - { - sz(0) /= 2.54; - sz(1) /= 2.54; - } - else if (punits == "points") - { - sz(0) /= 72.0; - sz(1) /= 72.0; - } - if (punits == "normalized") - { - caseless_str typ = get_papertype (); - if (get_papertype () == "") - error ("set: can't set the papertype to when the paperunits is normalized"); - } - else - { - // TODO - the papersizes info is also in papersize_from_type(). - // Both should be rewritten to avoid the duplication. - std::string typ = ""; - const double mm2in = 1.0 / 25.4; - const double tol = 0.01; - - if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) - typ = "usletter"; - else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 14.0) < tol) - typ = "uslegal"; - else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) - typ = "tabloid"; - else if (std::abs (sz(0) - 841.0 * mm2in) + std::abs (sz(1) - 1198.0 * mm2in) < tol) - typ = "a0"; - else if (std::abs (sz(0) - 594.0 * mm2in) + std::abs (sz(1) - 841.0 * mm2in) < tol) - typ = "a1"; - else if (std::abs (sz(0) - 420.0 * mm2in) + std::abs (sz(1) - 594.0 * mm2in) < tol) - typ = "a2"; - else if (std::abs (sz(0) - 297.0 * mm2in) + std::abs (sz(1) - 420.0 * mm2in) < tol) - typ = "a3"; - else if (std::abs (sz(0) - 210.0 * mm2in) + std::abs (sz(1) - 297.0 * mm2in) < tol) - typ = "a4"; - else if (std::abs (sz(0) - 148.0 * mm2in) + std::abs (sz(1) - 210.0 * mm2in) < tol) - typ = "a5"; - else if (std::abs (sz(0) - 1029.0 * mm2in) + std::abs (sz(1) - 1456.0 * mm2in) < tol) - typ = "b0"; - else if (std::abs (sz(0) - 728.0 * mm2in) + std::abs (sz(1) - 1028.0 * mm2in) < tol) - typ = "b1"; - else if (std::abs (sz(0) - 514.0 * mm2in) + std::abs (sz(1) - 728.0 * mm2in) < tol) - typ = "b2"; - else if (std::abs (sz(0) - 364.0 * mm2in) + std::abs (sz(1) - 514.0 * mm2in) < tol) - typ = "b3"; - else if (std::abs (sz(0) - 257.0 * mm2in) + std::abs (sz(1) - 364.0 * mm2in) < tol) - typ = "b4"; - else if (std::abs (sz(0) - 182.0 * mm2in) + std::abs (sz(1) - 257.0 * mm2in) < tol) - typ = "b5"; - else if (std::abs (sz(0) - 9.0) + std::abs (sz(1) - 12.0) < tol) - typ = "arch-a"; - else if (std::abs (sz(0) - 12.0) + std::abs (sz(1) - 18.0) < tol) - typ = "arch-b"; - else if (std::abs (sz(0) - 18.0) + std::abs (sz(1) - 24.0) < tol) - typ = "arch-c"; - else if (std::abs (sz(0) - 24.0) + std::abs (sz(1) - 36.0) < tol) - typ = "arch-d"; - else if (std::abs (sz(0) - 36.0) + std::abs (sz(1) - 48.0) < tol) - typ = "arch-e"; - else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) - typ = "a"; - else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) - typ = "b"; - else if (std::abs (sz(0) - 17.0) + std::abs (sz(1) - 22.0) < tol) - typ = "c"; - else if (std::abs (sz(0) - 22.0) + std::abs (sz(1) - 34.0) < tol) - typ = "d"; - else if (std::abs (sz(0) - 34.0) + std::abs (sz(1) - 43.0) < tol) - typ = "e"; - // Call papertype.set rather than set_papertype to avoid loops between - // update_papersize and update_papertype - papertype.set (typ); - } - if (punits == "centimeters") - { - sz(0) *= 2.54; - sz(1) *= 2.54; - } - else if (punits == "points") - { - sz(0) *= 72.0; - sz(1) *= 72.0; - } - if (get_paperorientation () == "landscape") - { - std::swap (sz(0), sz(1)); - papersize.set (octave_value (sz)); - } -} - -/* -%!test -%! figure (1, "visible", "off"); -%! set (1, "paperunits", "inches"); -%! set (1, "papersize", [5, 4]) -%! set (1, "paperunits", "points"); -%! assert (get (1, "papersize"), [5, 4] * 72, 1) -%! papersize = get (gcf, "papersize"); -%! set (1, "papersize", papersize + 1); -%! set (1, "papersize", papersize) -%! assert (get (1, "papersize"), [5, 4] * 72, 1) -%! close (1) -%!test -%! figure (1, "visible", "off"); -%! set (1, "paperunits", "inches"); -%! set (1, "papersize", [5, 4]) -%! set (1, "paperunits", "centimeters"); -%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72) -%! papersize = get (gcf, "papersize"); -%! set (1, "papersize", papersize + 1); -%! set (1, "papersize", papersize) -%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72) -%! close (1) -*/ - -void -figure::properties::update_paperorientation (void) -{ - std::string porient = get_paperorientation (); - Matrix sz = get_papersize ().matrix_value (); - Matrix pos = get_paperposition ().matrix_value (); - if ((sz(0) > sz(1) && porient == "portrait") - || (sz(0) < sz(1) && porient == "landscape")) - { - std::swap (sz(0), sz(1)); - std::swap (pos(0), pos(1)); - std::swap (pos(2), pos(3)); - // Call papertype.set rather than set_papertype to avoid loops - // between update_papersize and update_papertype - papersize.set (octave_value (sz)); - paperposition.set (octave_value (pos)); - } -} - -/* -%!test -%! figure (1, "visible", false); -%! tol = 100 * eps (); -%! ## UPPER case and MiXed case is part of test and should not be changed. -%! set (gcf (), "paperorientation", "PORTRAIT"); -%! set (gcf (), "paperunits", "inches"); -%! set (gcf (), "papertype", "USletter"); -%! assert (get (gcf (), "papersize"), [8.5, 11.0], tol); -%! set (gcf (), "paperorientation", "Landscape"); -%! assert (get (gcf (), "papersize"), [11.0, 8.5], tol); -%! set (gcf (), "paperunits", "centimeters"); -%! assert (get (gcf (), "papersize"), [11.0, 8.5] * 2.54, tol); -%! set (gcf (), "papertype", "a4"); -%! assert (get (gcf (), "papersize"), [29.7, 21.0], tol); -%! set (gcf (), "paperunits", "inches", "papersize", [8.5, 11.0]); -%! assert (get (gcf (), "papertype"), "usletter"); -%! assert (get (gcf (), "paperorientation"), "portrait"); -%! set (gcf (), "papersize", [11.0, 8.5]); -%! assert (get (gcf (), "papertype"), "usletter"); -%! assert (get (gcf (), "paperorientation"), "landscape"); -*/ - -void -figure::properties::set_units (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_units = get_units (); - if (units.set (v, true)) - { - update_units (old_units); - mark_modified (); - } - } -} - -void -figure::properties::update_units (const caseless_str& old_units) -{ - position.set (convert_position (get_position ().matrix_value (), old_units, - get_units (), screen_size_pixels ()), false); -} - -/* -%!test -%! figure (1, "visible", false); -%! set (0, "units", "pixels"); -%! rsz = get (0, "screensize"); -%! set (gcf (), "units", "pixels"); -%! fsz = get (gcf (), "position"); -%! set (gcf (), "units", "normalized"); -%! assert (get (gcf (), "position"), (fsz - [1, 1, 0, 0]) ./ rsz([3, 4, 3, 4])); -*/ - -std::string -figure::properties::get_title (void) const -{ - if (is_numbertitle ()) - { - std::ostringstream os; - std::string nm = get_name (); - - os << "Figure " << __myhandle__.value (); - if (! nm.empty ()) - os << ": " << get_name (); - - return os.str (); - } - else - return get_name (); -} - -octave_value -figure::get_default (const caseless_str& name) const -{ - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - retval = parent_obj.get_default (name); - } - - return retval; -} - -void -figure::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -// --------------------------------------------------------------------- - -void -axes::properties::init (void) -{ - position.add_constraint (dim_vector (1, 4)); - position.add_constraint (dim_vector (0, 0)); - outerposition.add_constraint (dim_vector (1, 4)); - colororder.add_constraint (dim_vector (-1, 3)); - dataaspectratio.add_constraint (dim_vector (1, 3)); - plotboxaspectratio.add_constraint (dim_vector (1, 3)); - xlim.add_constraint (2); - ylim.add_constraint (2); - zlim.add_constraint (2); - clim.add_constraint (2); - alim.add_constraint (2); - xtick.add_constraint (dim_vector (1, -1)); - ytick.add_constraint (dim_vector (1, -1)); - ztick.add_constraint (dim_vector (1, -1)); - Matrix vw (1, 2, 0); - vw(1) = 90; - view = vw; - view.add_constraint (dim_vector (1, 2)); - cameraposition.add_constraint (dim_vector (1, 3)); - Matrix upv (1, 3, 0.0); - upv(2) = 1.0; - cameraupvector = upv; - cameraupvector.add_constraint (dim_vector (1, 3)); - currentpoint.add_constraint (dim_vector (2, 3)); - ticklength.add_constraint (dim_vector (1, 2)); - tightinset.add_constraint (dim_vector (1, 4)); - looseinset.add_constraint (dim_vector (1, 4)); - update_font (); - - x_zlim.resize (1, 2); - - sx = "linear"; - sy = "linear"; - sz = "linear"; - - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - - xset (xlabel.handle_value (), "handlevisibility", "off"); - xset (ylabel.handle_value (), "handlevisibility", "off"); - xset (zlabel.handle_value (), "handlevisibility", "off"); - xset (title.handle_value (), "handlevisibility", "off"); - - xset (xlabel.handle_value (), "horizontalalignment", "center"); - xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (ylabel.handle_value (), "horizontalalignment", "center"); - xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (zlabel.handle_value (), "horizontalalignment", "right"); - xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (title.handle_value (), "horizontalalignment", "center"); - xset (title.handle_value (), "horizontalalignmentmode", "auto"); - - xset (xlabel.handle_value (), "verticalalignment", "cap"); - xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (ylabel.handle_value (), "verticalalignment", "bottom"); - xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); - xset (title.handle_value (), "verticalalignment", "bottom"); - xset (title.handle_value (), "verticalalignmentmode", "auto"); - - xset (ylabel.handle_value (), "rotation", 90.0); - xset (ylabel.handle_value (), "rotationmode", "auto"); - - xset (zlabel.handle_value (), "visible", "off"); - - xset (xlabel.handle_value (), "clipping", "off"); - xset (ylabel.handle_value (), "clipping", "off"); - xset (zlabel.handle_value (), "clipping", "off"); - xset (title.handle_value (), "clipping", "off"); - - xset (xlabel.handle_value (), "autopos_tag", "xlabel"); - xset (ylabel.handle_value (), "autopos_tag", "ylabel"); - xset (zlabel.handle_value (), "autopos_tag", "zlabel"); - xset (title.handle_value (), "autopos_tag", "title"); - - adopt (xlabel.handle_value ()); - adopt (ylabel.handle_value ()); - adopt (zlabel.handle_value ()); - adopt (title.handle_value ()); - - Matrix tlooseinset = default_axes_position (); - tlooseinset(2) = 1-tlooseinset(0)-tlooseinset(2); - tlooseinset(3) = 1-tlooseinset(1)-tlooseinset(3); - looseinset = tlooseinset; -} - -Matrix -axes::properties::calc_tightbox (const Matrix& init_pos) -{ - Matrix pos = init_pos; - graphics_object obj = gh_manager::get_object (get_parent ()); - Matrix parent_bb = obj.get_properties ().get_boundingbox (true); - Matrix ext = get_extent (true, true); - ext(1) = parent_bb(3) - ext(1) - ext(3); - ext(0)++; - ext(1)++; - ext = convert_position (ext, "pixels", get_units (), - parent_bb.extract_n (0, 2, 1, 2)); - if (ext(0) < pos(0)) - { - pos(2) += pos(0)-ext(0); - pos(0) = ext(0); - } - if (ext(0)+ext(2) > pos(0)+pos(2)) - pos(2) = ext(0)+ext(2)-pos(0); - - if (ext(1) < pos(1)) - { - pos(3) += pos(1)-ext(1); - pos(1) = ext(1); - } - if (ext(1)+ext(3) > pos(1)+pos(3)) - pos(3) = ext(1)+ext(3)-pos(1); - return pos; -} - -void -axes::properties::sync_positions (void) -{ - Matrix ref_linset = looseinset.get ().matrix_value (); - if (autopos_tag_is ("subplot")) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - if (parent_obj.isa ("figure")) - { - // FIXME: temporarily changed units should be protected - // from interrupts - std::string fig_units = parent_obj.get ("units").string_value (); - parent_obj.set ("units", "pixels"); - - Matrix ref_outbox = outerposition.get ().matrix_value (); - ref_outbox(2) += ref_outbox(0); - ref_outbox(3) += ref_outbox(1); - - // Find those subplots that are left, right, bottom and top aligned - // with the current subplot - Matrix kids = parent_obj.get_properties ().get_children (); - std::vector aligned; - std::vector l_aligned, b_aligned, r_aligned, t_aligned; - for (octave_idx_type i = 0; i < kids.numel (); i++) - { - graphics_object go = gh_manager::get_object (kids(i)); - if (go.isa ("axes")) - { - axes::properties& props = - dynamic_cast (go.get_properties ()); - if (props.autopos_tag_is ("subplot")) - { - Matrix outpos = go.get ("outerposition").matrix_value (); - bool l_align = (std::abs (outpos(0)-ref_outbox(0)) < 1e-15); - bool b_align = (std::abs (outpos(1)-ref_outbox(1)) < 1e-15); - bool r_align = (std::abs (outpos(0)+outpos(2)-ref_outbox(2)) < 1e-15); - bool t_align = (std::abs (outpos(1)+outpos(3)-ref_outbox(3)) < 1e-15); - if (l_align || b_align || r_align || t_align) - { - aligned.push_back (kids(i)); - l_aligned.push_back (l_align); - b_aligned.push_back (b_align); - r_aligned.push_back (r_align); - t_aligned.push_back (t_align); - // FIXME: the temporarily deleted tags should be - // protected from interrupts - props.set_autopos_tag ("none"); - } - } - } - } - // Determine a minimum box which aligns the subplots - Matrix ref_box (1, 4, 0.); - ref_box(2) = 1.; - ref_box(3) = 1.; - for (size_t i = 0; i < aligned.size (); i++) - { - graphics_object go = gh_manager::get_object (aligned[i]); - axes::properties& props = - dynamic_cast (go.get_properties ()); - Matrix linset = props.get_looseinset ().matrix_value (); - if (l_aligned[i]) - linset(0) = std::min (0., linset(0)-0.01); - if (b_aligned[i]) - linset(1) = std::min (0., linset(1)-0.01); - if (r_aligned[i]) - linset(2) = std::min (0., linset(2)-0.01); - if (t_aligned[i]) - linset(3) = std::min (0., linset(3)-0.01); - props.set_looseinset (linset); - Matrix pos = props.get_position ().matrix_value (); - if (l_aligned[i]) - ref_box(0) = std::max (ref_box(0), pos(0)); - if (b_aligned[i]) - ref_box(1) = std::max (ref_box(1), pos(1)); - if (r_aligned[i]) - ref_box(2) = std::min (ref_box(2), pos(0)+pos(2)); - if (t_aligned[i]) - ref_box(3) = std::min (ref_box(3), pos(1)+pos(3)); - } - // Set common looseinset values for all aligned subplots and - // revert their tag values - for (size_t i = 0; i < aligned.size (); i++) - { - graphics_object go = gh_manager::get_object (aligned[i]); - axes::properties& props = - dynamic_cast (go.get_properties ()); - Matrix outpos = props.get_outerposition ().matrix_value (); - Matrix linset = props.get_looseinset ().matrix_value (); - if (l_aligned[i]) - linset(0) = (ref_box(0)-outpos(0))/outpos(2); - if (b_aligned[i]) - linset(1) = (ref_box(1)-outpos(1))/outpos(3); - if (r_aligned[i]) - linset(2) = (outpos(0)+outpos(2)-ref_box(2))/outpos(2); - if (t_aligned[i]) - linset(3) = (outpos(1)+outpos(3)-ref_box(3))/outpos(3); - props.set_looseinset (linset); - props.set_autopos_tag ("subplot"); - } - parent_obj.set ("units", fig_units); - } - } - else - sync_positions (ref_linset); -} - -void -axes::properties::sync_positions (const Matrix& linset) -{ - Matrix pos = position.get ().matrix_value (); - Matrix outpos = outerposition.get ().matrix_value (); - double lratio = linset(0); - double bratio = linset(1); - double wratio = 1-linset(0)-linset(2); - double hratio = 1-linset(1)-linset(3); - if (activepositionproperty.is ("outerposition")) - { - pos = outpos; - pos(0) = outpos(0)+lratio*outpos(2); - pos(1) = outpos(1)+bratio*outpos(3); - pos(2) = wratio*outpos(2); - pos(3) = hratio*outpos(3); - - position = pos; - update_transform (); - Matrix tightpos = calc_tightbox (pos); - - double thrshldx = 0.005*outpos(2); - double thrshldy = 0.005*outpos(3); - double minsizex = 0.2*outpos(2); - double minsizey = 0.2*outpos(3); - bool updatex = true, updatey = true; - for (int i = 0; i < 10; i++) - { - double dt; - bool modified = false; - dt = outpos(0)+outpos(2)-tightpos(0)-tightpos(2); - if (dt < -thrshldx && updatex) - { - pos(2) += dt; - modified = true; - } - dt = outpos(1)+outpos(3)-tightpos(1)-tightpos(3); - if (dt < -thrshldy && updatey) - { - pos(3) += dt; - modified = true; - } - dt = outpos(0)-tightpos(0); - if (dt > thrshldx && updatex) - { - pos(0) += dt; - pos(2) -= dt; - modified = true; - } - dt = outpos(1)-tightpos(1); - if (dt > thrshldy && updatey) - { - pos(1) += dt; - pos(3) -= dt; - modified = true; - } - - // Note: checking limit for minimum axes size - if (pos(2) < minsizex) - { - pos(0) -= 0.5*(minsizex-pos(2)); - pos(2) = minsizex; - updatex = false; - } - if (pos(3) < minsizey) - { - pos(1) -= 0.5*(minsizey-pos(3)); - pos(3) = minsizey; - updatey = false; - } - - if (modified) - { - position = pos; - update_transform (); - tightpos = calc_tightbox (pos); - } - else - break; - } - } - else - { - update_transform (); - - outpos(0) = pos(0)-pos(2)*lratio/wratio; - outpos(1) = pos(1)-pos(3)*bratio/hratio; - outpos(2) = pos(2)/wratio; - outpos(3) = pos(3)/hratio; - - outerposition = calc_tightbox (outpos); - } - - Matrix inset (1, 4, 1.0); - inset(0) = pos(0)-outpos(0); - inset(1) = pos(1)-outpos(1); - inset(2) = outpos(0)+outpos(2)-pos(0)-pos(2); - inset(3) = outpos(1)+outpos(3)-pos(1)-pos(3); - - tightinset = inset; -} - -void -axes::properties::set_text_child (handle_property& hp, - const std::string& who, - const octave_value& v) -{ - graphics_handle val; - - if (v.is_string ()) - { - val = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - xset (val, "string", v); - } - else - { - graphics_object go = gh_manager::get_object (gh_manager::lookup (v)); - - if (go.isa ("text")) - val = ::reparent (v, "set", who, __myhandle__, false); - else - { - std::string cname = v.class_name (); - - error ("set: expecting text graphics object or character string for %s property, found %s", - who.c_str (), cname.c_str ()); - } - } - - if (! error_state) - { - xset (val, "handlevisibility", "off"); - - gh_manager::free (hp.handle_value ()); - - base_properties::remove_child (hp.handle_value ()); - - hp = val; - - adopt (hp.handle_value ()); - } -} - -void -axes::properties::set_xlabel (const octave_value& v) -{ - set_text_child (xlabel, "xlabel", v); - xset (xlabel.handle_value (), "positionmode", "auto"); - xset (xlabel.handle_value (), "rotationmode", "auto"); - xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (xlabel.handle_value (), "clipping", "off"); - xset (xlabel.handle_value (), "color", get_xcolor ()); - xset (xlabel.handle_value (), "autopos_tag", "xlabel"); - update_xlabel_position (); -} - -void -axes::properties::set_ylabel (const octave_value& v) -{ - set_text_child (ylabel, "ylabel", v); - xset (ylabel.handle_value (), "positionmode", "auto"); - xset (ylabel.handle_value (), "rotationmode", "auto"); - xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); - xset (ylabel.handle_value (), "clipping", "off"); - xset (ylabel.handle_value (), "color", get_ycolor ()); - xset (ylabel.handle_value (), "autopos_tag", "ylabel"); - update_ylabel_position (); -} - -void -axes::properties::set_zlabel (const octave_value& v) -{ - set_text_child (zlabel, "zlabel", v); - xset (zlabel.handle_value (), "positionmode", "auto"); - xset (zlabel.handle_value (), "rotationmode", "auto"); - xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (zlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (zlabel.handle_value (), "clipping", "off"); - xset (zlabel.handle_value (), "color", get_zcolor ()); - xset (zlabel.handle_value (), "autopos_tag", "zlabel"); - update_zlabel_position (); -} - -void -axes::properties::set_title (const octave_value& v) -{ - set_text_child (title, "title", v); - xset (title.handle_value (), "positionmode", "auto"); - xset (title.handle_value (), "horizontalalignment", "center"); - xset (title.handle_value (), "horizontalalignmentmode", "auto"); - xset (title.handle_value (), "verticalalignment", "bottom"); - xset (title.handle_value (), "verticalalignmentmode", "auto"); - xset (title.handle_value (), "clipping", "off"); - xset (title.handle_value (), "autopos_tag", "title"); - update_title_position (); -} - -void -axes::properties::set_defaults (base_graphics_object& obj, - const std::string& mode) -{ - box = "on"; - colororder = default_colororder (); - dataaspectratio = Matrix (1, 3, 1.0); - dataaspectratiomode = "auto"; - layer = "bottom"; - - Matrix tlim (1, 2, 0.0); - tlim(1) = 1; - xlim = tlim; - ylim = tlim; - zlim = tlim; - - Matrix cl (1, 2, 0); - cl(1) = 1; - clim = cl; - - xlimmode = "auto"; - ylimmode = "auto"; - zlimmode = "auto"; - climmode = "auto"; - - xgrid = "off"; - ygrid = "off"; - zgrid = "off"; - xminorgrid = "off"; - yminorgrid = "off"; - zminorgrid = "off"; - xtick = Matrix (); - ytick = Matrix (); - ztick = Matrix (); - xtickmode = "auto"; - ytickmode = "auto"; - ztickmode = "auto"; - xticklabel = ""; - yticklabel = ""; - zticklabel = ""; - xticklabelmode = "auto"; - yticklabelmode = "auto"; - zticklabelmode = "auto"; - color = color_values ("white"); - xcolor = color_values ("black"); - ycolor = color_values ("black"); - zcolor = color_values ("black"); - xscale = "linear"; - yscale = "linear"; - zscale = "linear"; - xdir = "normal"; - ydir = "normal"; - zdir = "normal"; - yaxislocation = "left"; - xaxislocation = "bottom"; - - // Note: camera properties will be set through update_transform - camerapositionmode = "auto"; - cameratargetmode = "auto"; - cameraupvectormode = "auto"; - cameraviewanglemode = "auto"; - plotboxaspectratio = Matrix (1, 3, 1.0); - drawmode = "normal"; - gridlinestyle = ":"; - linestyleorder = "-"; - linewidth = 0.5; - minorgridlinestyle = ":"; - // Note: plotboxaspectratio will be set through update_aspectratiors - plotboxaspectratiomode = "auto"; - projection = "orthographic"; - tickdir = "in"; - tickdirmode = "auto"; - ticklength = default_axes_ticklength (); - tightinset = Matrix (1, 4, 0.0); - - sx = "linear"; - sy = "linear"; - sz = "linear"; - - Matrix tview (1, 2, 0.0); - tview(1) = 90; - view = tview; - - visible = "on"; - nextplot = "replace"; - - if (mode != "replace") - { - fontangle = "normal"; - fontname = OCTAVE_DEFAULT_FONTNAME; - fontsize = 10; - fontunits = "points"; - fontweight = "normal"; - - Matrix touterposition (1, 4, 0.0); - touterposition(2) = 1; - touterposition(3) = 1; - outerposition = touterposition; - - position = default_axes_position (); - - Matrix tlooseinset = default_axes_position (); - tlooseinset(2) = 1-tlooseinset(0)-tlooseinset(2); - tlooseinset(3) = 1-tlooseinset(1)-tlooseinset(3); - looseinset = tlooseinset; - - activepositionproperty = "outerposition"; - } - - delete_children (true); - - xlabel = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - ylabel = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - zlabel = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - title = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - xset (xlabel.handle_value (), "handlevisibility", "off"); - xset (ylabel.handle_value (), "handlevisibility", "off"); - xset (zlabel.handle_value (), "handlevisibility", "off"); - xset (title.handle_value (), "handlevisibility", "off"); - - xset (xlabel.handle_value (), "horizontalalignment", "center"); - xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (ylabel.handle_value (), "horizontalalignment", "center"); - xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (zlabel.handle_value (), "horizontalalignment", "right"); - xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (title.handle_value (), "horizontalalignment", "center"); - xset (title.handle_value (), "horizontalalignmentmode", "auto"); - - xset (xlabel.handle_value (), "verticalalignment", "cap"); - xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (ylabel.handle_value (), "verticalalignment", "bottom"); - xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); - xset (title.handle_value (), "verticalalignment", "bottom"); - xset (title.handle_value (), "verticalalignmentmode", "auto"); - - xset (ylabel.handle_value (), "rotation", 90.0); - xset (ylabel.handle_value (), "rotationmode", "auto"); - - xset (zlabel.handle_value (), "visible", "off"); - - xset (xlabel.handle_value (), "clipping", "off"); - xset (ylabel.handle_value (), "clipping", "off"); - xset (zlabel.handle_value (), "clipping", "off"); - xset (title.handle_value (), "clipping", "off"); - - xset (xlabel.handle_value (), "autopos_tag", "xlabel"); - xset (ylabel.handle_value (), "autopos_tag", "ylabel"); - xset (zlabel.handle_value (), "autopos_tag", "zlabel"); - xset (title.handle_value (), "autopos_tag", "title"); - - adopt (xlabel.handle_value ()); - adopt (ylabel.handle_value ()); - adopt (zlabel.handle_value ()); - adopt (title.handle_value ()); - - update_transform (); - - override_defaults (obj); -} - -void -axes::properties::delete_text_child (handle_property& hp) -{ - graphics_handle h = hp.handle_value (); - - if (h.ok ()) - { - graphics_object go = gh_manager::get_object (h); - - if (go.valid_object ()) - gh_manager::free (h); - - base_properties::remove_child (h); - } - - // FIXME -- is it necessary to check whether the axes object is - // being deleted now? I think this function is only called when an - // individual child object is delete and not when the parent axes - // object is deleted. - - if (! is_beingdeleted ()) - { - hp = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - xset (hp.handle_value (), "handlevisibility", "off"); - - adopt (hp.handle_value ()); - } -} - -void -axes::properties::remove_child (const graphics_handle& h) -{ - if (xlabel.handle_value ().ok () && h == xlabel.handle_value ()) - delete_text_child (xlabel); - else if (ylabel.handle_value ().ok () && h == ylabel.handle_value ()) - delete_text_child (ylabel); - else if (zlabel.handle_value ().ok () && h == zlabel.handle_value ()) - delete_text_child (zlabel); - else if (title.handle_value ().ok () && h == title.handle_value ()) - delete_text_child (title); - else - base_properties::remove_child (h); -} - -inline Matrix -xform_matrix (void) -{ - Matrix m (4, 4, 0.0); - for (int i = 0; i < 4; i++) - m(i,i) = 1; - return m; -} - -inline ColumnVector -xform_vector (void) -{ - ColumnVector v (4, 0.0); - v(3) = 1; - return v; -} - -inline ColumnVector -xform_vector (double x, double y, double z) -{ - ColumnVector v (4, 1.0); - v(0) = x; v(1) = y; v(2) = z; - return v; -} - -inline ColumnVector -transform (const Matrix& m, double x, double y, double z) -{ - return (m * xform_vector (x, y, z)); -} - -inline Matrix -xform_scale (double x, double y, double z) -{ - Matrix m (4, 4, 0.0); - m(0,0) = x; m(1,1) = y; m(2,2) = z; m(3,3) = 1; - return m; -} - -inline Matrix -xform_translate (double x, double y, double z) -{ - Matrix m = xform_matrix (); - m(0,3) = x; m(1,3) = y; m(2,3) = z; m(3,3) = 1; - return m; -} - -inline void -scale (Matrix& m, double x, double y, double z) -{ - m = m * xform_scale (x, y, z); -} - -inline void -translate (Matrix& m, double x, double y, double z) -{ - m = m * xform_translate (x, y, z); -} - -inline void -xform (ColumnVector& v, const Matrix& m) -{ - v = m*v; -} - -inline void -scale (ColumnVector& v, double x, double y, double z) -{ - v(0) *= x; - v(1) *= y; - v(2) *= z; -} - -inline void -translate (ColumnVector& v, double x, double y, double z) -{ - v(0) += x; - v(1) += y; - v(2) += z; -} - -inline void -normalize (ColumnVector& v) -{ - double fact = 1.0 / sqrt (v(0)*v(0)+v(1)*v(1)+v(2)*v(2)); - scale (v, fact, fact, fact); -} - -inline double -dot (const ColumnVector& v1, const ColumnVector& v2) -{ - return (v1(0)*v2(0)+v1(1)*v2(1)+v1(2)*v2(2)); -} - -inline double -norm (const ColumnVector& v) -{ - return sqrt (dot (v, v)); -} - -inline ColumnVector -cross (const ColumnVector& v1, const ColumnVector& v2) -{ - ColumnVector r = xform_vector (); - r(0) = v1(1)*v2(2)-v1(2)*v2(1); - r(1) = v1(2)*v2(0)-v1(0)*v2(2); - r(2) = v1(0)*v2(1)-v1(1)*v2(0); - return r; -} - -inline Matrix -unit_cube (void) -{ - static double data[32] = { - 0,0,0,1, - 1,0,0,1, - 0,1,0,1, - 0,0,1,1, - 1,1,0,1, - 1,0,1,1, - 0,1,1,1, - 1,1,1,1}; - Matrix m (4, 8); - memcpy (m.fortran_vec (), data, sizeof (double)*32); - return m; -} - -inline ColumnVector -cam2xform (const Array& m) -{ - ColumnVector retval (4, 1.0); - memcpy (retval.fortran_vec (), m.fortran_vec (), sizeof (double)*3); - return retval; -} - -inline RowVector -xform2cam (const ColumnVector& v) -{ - return v.extract_n (0, 3).transpose (); -} - -void -axes::properties::update_camera (void) -{ - double xd = (xdir_is ("normal") ? 1 : -1); - double yd = (ydir_is ("normal") ? 1 : -1); - double zd = (zdir_is ("normal") ? 1 : -1); - - Matrix xlimits = sx.scale (get_xlim ().matrix_value ()); - Matrix ylimits = sy.scale (get_ylim ().matrix_value ()); - Matrix zlimits = sz.scale (get_zlim ().matrix_value ()); - - double xo = xlimits(xd > 0 ? 0 : 1); - double yo = ylimits(yd > 0 ? 0 : 1); - double zo = zlimits(zd > 0 ? 0 : 1); - - Matrix pb = get_plotboxaspectratio ().matrix_value (); - - bool autocam = (camerapositionmode_is ("auto") - && cameratargetmode_is ("auto") - && cameraupvectormode_is ("auto") - && cameraviewanglemode_is ("auto")); - bool dowarp = (autocam && dataaspectratiomode_is ("auto") - && plotboxaspectratiomode_is ("auto")); - - ColumnVector c_eye (xform_vector ()); - ColumnVector c_center (xform_vector ()); - ColumnVector c_upv (xform_vector ()); - - if (cameratargetmode_is ("auto")) - { - c_center(0) = (xlimits(0)+xlimits(1))/2; - c_center(1) = (ylimits(0)+ylimits(1))/2; - c_center(2) = (zlimits(0)+zlimits(1))/2; - - cameratarget = xform2cam (c_center); - } - else - c_center = cam2xform (get_cameratarget ().matrix_value ()); - - if (camerapositionmode_is ("auto")) - { - Matrix tview = get_view ().matrix_value (); - double az = tview(0), el = tview(1); - double d = 5 * sqrt (pb(0)*pb(0)+pb(1)*pb(1)+pb(2)*pb(2)); - - if (el == 90 || el == -90) - c_eye(2) = d*signum (el); - else - { - az *= M_PI/180.0; - el *= M_PI/180.0; - c_eye(0) = d * cos (el) * sin (az); - c_eye(1) = -d* cos (el) * cos (az); - c_eye(2) = d * sin (el); - } - c_eye(0) = c_eye(0)*(xlimits(1)-xlimits(0))/(xd*pb(0))+c_center(0); - c_eye(1) = c_eye(1)*(ylimits(1)-ylimits(0))/(yd*pb(1))+c_center(1); - c_eye(2) = c_eye(2)*(zlimits(1)-zlimits(0))/(zd*pb(2))+c_center(2); - - cameraposition = xform2cam (c_eye); - } - else - c_eye = cam2xform (get_cameraposition ().matrix_value ()); - - if (cameraupvectormode_is ("auto")) - { - Matrix tview = get_view ().matrix_value (); - double az = tview(0), el = tview(1); - - if (el == 90 || el == -90) - { - c_upv(0) = - -signum (el) *sin (az*M_PI/180.0)*(xlimits(1)-xlimits(0))/pb(0); - c_upv(1) = - signum (el) * cos (az*M_PI/180.0)*(ylimits(1)-ylimits(0))/pb(1); - } - else - c_upv(2) = 1; - - cameraupvector = xform2cam (c_upv); - } - else - c_upv = cam2xform (get_cameraupvector ().matrix_value ()); - - Matrix x_view = xform_matrix (); - Matrix x_projection = xform_matrix (); - Matrix x_viewport = xform_matrix (); - Matrix x_normrender = xform_matrix (); - Matrix x_pre = xform_matrix (); - - x_render = xform_matrix (); - x_render_inv = xform_matrix (); - - scale (x_pre, pb(0), pb(1), pb(2)); - translate (x_pre, -0.5, -0.5, -0.5); - scale (x_pre, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), - zd/(zlimits(1)-zlimits(0))); - translate (x_pre, -xo, -yo, -zo); - - xform (c_eye, x_pre); - xform (c_center, x_pre); - scale (c_upv, pb(0)/(xlimits(1)-xlimits(0)), pb(1)/(ylimits(1)-ylimits(0)), - pb(2)/(zlimits(1)-zlimits(0))); - translate (c_center, -c_eye(0), -c_eye(1), -c_eye(2)); - - ColumnVector F (c_center), f (F), UP (c_upv); - normalize (f); - normalize (UP); - - if (std::abs (dot (f, UP)) > 1e-15) - { - double fa = 1 / sqrt(1-f(2)*f(2)); - scale (UP, fa, fa, fa); - } - - ColumnVector s = cross (f, UP); - ColumnVector u = cross (s, f); - - scale (x_view, 1, 1, -1); - Matrix l = xform_matrix (); - l(0,0) = s(0); l(0,1) = s(1); l(0,2) = s(2); - l(1,0) = u(0); l(1,1) = u(1); l(1,2) = u(2); - l(2,0) = -f(0); l(2,1) = -f(1); l(2,2) = -f(2); - x_view = x_view * l; - translate (x_view, -c_eye(0), -c_eye(1), -c_eye(2)); - scale (x_view, pb(0), pb(1), pb(2)); - translate (x_view, -0.5, -0.5, -0.5); - - Matrix x_cube = x_view * unit_cube (); - ColumnVector cmin = x_cube.row_min (), cmax = x_cube.row_max (); - double xM = cmax(0)-cmin(0); - double yM = cmax(1)-cmin(1); - - Matrix bb = get_boundingbox (true); - - double v_angle; - - if (cameraviewanglemode_is ("auto")) - { - double af; - - // FIXME -- was this really needed? When compared to Matlab, it - // does not seem to be required. Need investigation with concrete - // graphics toolkit to see results visually. - if (false && dowarp) - af = 1.0 / (xM > yM ? xM : yM); - else - { - if ((bb(2)/bb(3)) > (xM/yM)) - af = 1.0 / yM; - else - af = 1.0 / xM; - } - v_angle = 2 * (180.0 / M_PI) * atan (1 / (2 * af * norm (F))); - - cameraviewangle = v_angle; - } - else - v_angle = get_cameraviewangle (); - - double pf = 1 / (2 * tan ((v_angle / 2) * M_PI / 180.0) * norm (F)); - scale (x_projection, pf, pf, 1); - - if (dowarp) - { - xM *= pf; - yM *= pf; - translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); - scale (x_viewport, bb(2)/xM, -bb(3)/yM, 1); - } - else - { - double pix = 1; - if (autocam) - { - if ((bb(2)/bb(3)) > (xM/yM)) - pix = bb(3); - else - pix = bb(2); - } - else - pix = (bb(2) < bb(3) ? bb(2) : bb(3)); - translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); - scale (x_viewport, pix, -pix, 1); - } - - x_normrender = x_viewport * x_projection * x_view; - - x_cube = x_normrender * unit_cube (); - cmin = x_cube.row_min (); - cmax = x_cube.row_max (); - x_zlim.resize (1, 2); - x_zlim(0) = cmin(2); - x_zlim(1) = cmax(2); - - x_render = x_normrender; - scale (x_render, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), - zd/(zlimits(1)-zlimits(0))); - translate (x_render, -xo, -yo, -zo); - - x_viewtransform = x_view; - x_projectiontransform = x_projection; - x_viewporttransform = x_viewport; - x_normrendertransform = x_normrender; - x_rendertransform = x_render; - - x_render_inv = x_render.inverse (); - - // Note: these matrices are a slight modified version of the regular - // matrices, more suited for OpenGL rendering (x_gl_mat1 => light - // => x_gl_mat2) - x_gl_mat1 = x_view; - scale (x_gl_mat1, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), - zd/(zlimits(1)-zlimits(0))); - translate (x_gl_mat1, -xo, -yo, -zo); - x_gl_mat2 = x_viewport * x_projection; -} - -static bool updating_axes_layout = false; - -void -axes::properties::update_axes_layout (void) -{ - if (updating_axes_layout) - return; - - graphics_xform xform = get_transform (); - - double xd = (xdir_is ("normal") ? 1 : -1); - double yd = (ydir_is ("normal") ? 1 : -1); - double zd = (zdir_is ("normal") ? 1 : -1); - - const Matrix xlims = xform.xscale (get_xlim ().matrix_value ()); - const Matrix ylims = xform.yscale (get_ylim ().matrix_value ()); - const Matrix zlims = xform.zscale (get_zlim ().matrix_value ()); - double x_min = xlims(0), x_max = xlims(1); - double y_min = ylims(0), y_max = ylims(1); - double z_min = zlims(0), z_max = zlims(1); - - ColumnVector p1, p2, dir (3); - - xstate = ystate = zstate = AXE_ANY_DIR; - - p1 = xform.transform (x_min, (y_min+y_max)/2, (z_min+z_max)/2, false); - p2 = xform.transform (x_max, (y_min+y_max)/2, (z_min+z_max)/2, false); - dir(0) = xround (p2(0)-p1(0)); - dir(1) = xround (p2(1)-p1(1)); - dir(2) = (p2(2)-p1(2)); - if (dir(0) == 0 && dir(1) == 0) - xstate = AXE_DEPTH_DIR; - else if (dir(2) == 0) - { - if (dir(0) == 0) - xstate = AXE_VERT_DIR; - else if (dir(1) == 0) - xstate = AXE_HORZ_DIR; - } - - if (dir(2) == 0) - { - if (dir(1) == 0) - xPlane = (dir(0) > 0 ? x_max : x_min); - else - xPlane = (dir(1) < 0 ? x_max : x_min); - } - else - xPlane = (dir(2) < 0 ? x_min : x_max); - - xPlaneN = (xPlane == x_min ? x_max : x_min); - fx = (x_max-x_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); - - p1 = xform.transform ((x_min+x_max)/2, y_min, (z_min+z_max)/2, false); - p2 = xform.transform ((x_min+x_max)/2, y_max, (z_min+z_max)/2, false); - dir(0) = xround (p2(0)-p1(0)); - dir(1) = xround (p2(1)-p1(1)); - dir(2) = (p2(2)-p1(2)); - if (dir(0) == 0 && dir(1) == 0) - ystate = AXE_DEPTH_DIR; - else if (dir(2) == 0) - { - if (dir(0) == 0) - ystate = AXE_VERT_DIR; - else if (dir(1) == 0) - ystate = AXE_HORZ_DIR; - } - - if (dir(2) == 0) - { - if (dir(1) == 0) - yPlane = (dir(0) > 0 ? y_max : y_min); - else - yPlane = (dir(1) < 0 ? y_max : y_min); - } - else - yPlane = (dir(2) < 0 ? y_min : y_max); - - yPlaneN = (yPlane == y_min ? y_max : y_min); - fy = (y_max-y_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); - - p1 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_min, false); - p2 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_max, false); - dir(0) = xround (p2(0)-p1(0)); - dir(1) = xround (p2(1)-p1(1)); - dir(2) = (p2(2)-p1(2)); - if (dir(0) == 0 && dir(1) == 0) - zstate = AXE_DEPTH_DIR; - else if (dir(2) == 0) - { - if (dir(0) == 0) - zstate = AXE_VERT_DIR; - else if (dir(1) == 0) - zstate = AXE_HORZ_DIR; - } - - if (dir(2) == 0) - { - if (dir(1) == 0) - zPlane = (dir(0) > 0 ? z_min : z_max); - else - zPlane = (dir(1) < 0 ? z_min : z_max); - } - else - zPlane = (dir(2) < 0 ? z_min : z_max); - - zPlaneN = (zPlane == z_min ? z_max : z_min); - fz = (z_max-z_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); - - unwind_protect frame; - frame.protect_var (updating_axes_layout); - updating_axes_layout = true; - - xySym = (xd*yd*(xPlane-xPlaneN)*(yPlane-yPlaneN) > 0); - zSign = (zd*(zPlane-zPlaneN) <= 0); - xyzSym = zSign ? xySym : !xySym; - xpTick = (zSign ? xPlaneN : xPlane); - ypTick = (zSign ? yPlaneN : yPlane); - zpTick = (zSign ? zPlane : zPlaneN); - xpTickN = (zSign ? xPlane : xPlaneN); - ypTickN = (zSign ? yPlane : yPlaneN); - zpTickN = (zSign ? zPlaneN : zPlane); - - /* 2D mode */ - x2Dtop = false; - y2Dright = false; - layer2Dtop = false; - if (xstate == AXE_HORZ_DIR && ystate == AXE_VERT_DIR) - { - if (xaxislocation_is ("top")) - { - double tmp = yPlane; - yPlane = yPlaneN; - yPlaneN = tmp; - x2Dtop = true; - } - ypTick = yPlaneN; - ypTickN = yPlane; - if (yaxislocation_is ("right")) - { - double tmp = xPlane; - xPlane = xPlaneN; - xPlaneN = tmp; - y2Dright = true; - } - xpTick = xPlaneN; - xpTickN = xPlane; - if (layer_is ("top")) - { - zpTick = zPlaneN; - layer2Dtop = true; - } - else - zpTick = zPlane; - } - - Matrix viewmat = get_view ().matrix_value (); - nearhoriz = std::abs (viewmat(1)) <= 5; - - update_ticklength (); -} - -void -axes::properties::update_ticklength (void) -{ - bool mode2d = (((xstate > AXE_DEPTH_DIR ? 1 : 0) + - (ystate > AXE_DEPTH_DIR ? 1 : 0) + - (zstate > AXE_DEPTH_DIR ? 1 : 0)) == 2); - - if (tickdirmode_is ("auto")) - tickdir.set (mode2d ? "in" : "out", true); - - double ticksign = (tickdir_is ("in") ? -1 : 1); - - Matrix bbox = get_boundingbox (true); - Matrix ticklen = get_ticklength ().matrix_value (); - ticklen(0) = ticklen(0) * std::max (bbox(2), bbox(3)); - ticklen(1) = ticklen(1) * std::max (bbox(2), bbox(3)); - - xticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); - yticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); - zticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); - - xtickoffset = (mode2d ? std::max (0., xticklen) : std::abs (xticklen)) + 5; - ytickoffset = (mode2d ? std::max (0., yticklen) : std::abs (yticklen)) + 5; - ztickoffset = (mode2d ? std::max (0., zticklen) : std::abs (zticklen)) + 5; - - update_xlabel_position (); - update_ylabel_position (); - update_zlabel_position (); - update_title_position (); -} - -/* -## FIXME: A demo can't be called in a C++ file. This should be made a test -## or moved to a .m file where it can be called. -%!demo -%! clf; -%! subplot (2,1,1); -%! plot (rand (3)); -%! xlabel xlabel; -%! ylabel ylabel; -%! title title; -%! subplot (2,1,2); -%! plot (rand (3)); -%! set (gca, "ticklength", get (gca, "ticklength") * 2, "tickdir", "out"); -%! xlabel xlabel; -%! ylabel ylabel; -%! title title; -*/ - -static bool updating_xlabel_position = false; - -void -axes::properties::update_xlabel_position (void) -{ - if (updating_xlabel_position) - return; - - text::properties& xlabel_props = reinterpret_cast - (gh_manager::get_object (get_xlabel ()).get_properties ()); - - bool is_empty = xlabel_props.get_string ().is_empty (); - - unwind_protect frame; - frame.protect_var (updating_xlabel_position); - updating_xlabel_position = true; - - if (! is_empty) - { - if (xlabel_props.horizontalalignmentmode_is ("auto")) - { - xlabel_props.set_horizontalalignment - (xstate > AXE_DEPTH_DIR - ? "center" : (xyzSym ? "left" : "right")); - - xlabel_props.set_horizontalalignmentmode ("auto"); - } - - if (xlabel_props.verticalalignmentmode_is ("auto")) - { - xlabel_props.set_verticalalignment - (xstate == AXE_VERT_DIR || x2Dtop ? "bottom" : "top"); - - xlabel_props.set_verticalalignmentmode ("auto"); - } - } - - if (xlabel_props.positionmode_is ("auto") - || xlabel_props.rotationmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - Matrix ext (1, 2, 0.0); - ext = get_ticklabel_extents (get_xtick ().matrix_value (), - get_xticklabel ().all_strings (), - get_xlim ().matrix_value ()); - - double wmax = ext(0), hmax = ext(1), angle = 0; - ColumnVector p = - graphics_xform::xform_vector ((xpTickN+xpTick)/2, ypTick, zpTick); - - bool tick_along_z = nearhoriz || xisinf (fy); - if (tick_along_z) - p(2) += (signum (zpTick-zpTickN)*fz*xtickoffset); - else - p(1) += (signum (ypTick-ypTickN)*fy*xtickoffset); - - p = xform.transform (p(0), p(1), p(2), false); - - switch (xstate) - { - case AXE_ANY_DIR: - p(0) += (xyzSym ? wmax : -wmax); - p(1) += hmax; - break; - - case AXE_VERT_DIR: - p(0) -= wmax; - angle = 90; - break; - - case AXE_HORZ_DIR: - p(1) += (x2Dtop ? -hmax : hmax); - break; - } - - if (xlabel_props.positionmode_is ("auto")) - { - p = xform.untransform (p(0), p(1), p(2), true); - xlabel_props.set_position (p.extract_n (0, 3).transpose ()); - xlabel_props.set_positionmode ("auto"); - } - - if (! is_empty && xlabel_props.rotationmode_is ("auto")) - { - xlabel_props.set_rotation (angle); - xlabel_props.set_rotationmode ("auto"); - } - } -} - -static bool updating_ylabel_position = false; - -void -axes::properties::update_ylabel_position (void) -{ - if (updating_ylabel_position) - return; - - text::properties& ylabel_props = reinterpret_cast - (gh_manager::get_object (get_ylabel ()).get_properties ()); - - bool is_empty = ylabel_props.get_string ().is_empty (); - - unwind_protect frame; - frame.protect_var (updating_ylabel_position); - updating_ylabel_position = true; - - if (! is_empty) - { - if (ylabel_props.horizontalalignmentmode_is ("auto")) - { - ylabel_props.set_horizontalalignment - (ystate > AXE_DEPTH_DIR - ? "center" : (!xyzSym ? "left" : "right")); - - ylabel_props.set_horizontalalignmentmode ("auto"); - } - - if (ylabel_props.verticalalignmentmode_is ("auto")) - { - ylabel_props.set_verticalalignment - (ystate == AXE_VERT_DIR && !y2Dright ? "bottom" : "top"); - - ylabel_props.set_verticalalignmentmode ("auto"); - } - } - - if (ylabel_props.positionmode_is ("auto") - || ylabel_props.rotationmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - Matrix ext (1, 2, 0.0); - ext = get_ticklabel_extents (get_ytick ().matrix_value (), - get_yticklabel ().all_strings (), - get_ylim ().matrix_value ()); - - double wmax = ext(0), hmax = ext(1), angle = 0; - ColumnVector p = - graphics_xform::xform_vector (xpTick, (ypTickN+ypTick)/2, zpTick); - - bool tick_along_z = nearhoriz || xisinf (fx); - if (tick_along_z) - p(2) += (signum (zpTick-zpTickN)*fz*ytickoffset); - else - p(0) += (signum (xpTick-xpTickN)*fx*ytickoffset); - - p = xform.transform (p(0), p(1), p(2), false); - - switch (ystate) - { - case AXE_ANY_DIR: - p(0) += (!xyzSym ? wmax : -wmax); - p(1) += hmax; - break; - - case AXE_VERT_DIR: - p(0) += (y2Dright ? wmax : -wmax); - angle = 90; - break; - - case AXE_HORZ_DIR: - p(1) += hmax; - break; - } - - if (ylabel_props.positionmode_is ("auto")) - { - p = xform.untransform (p(0), p(1), p(2), true); - ylabel_props.set_position (p.extract_n (0, 3).transpose ()); - ylabel_props.set_positionmode ("auto"); - } - - if (! is_empty && ylabel_props.rotationmode_is ("auto")) - { - ylabel_props.set_rotation (angle); - ylabel_props.set_rotationmode ("auto"); - } - } -} - -static bool updating_zlabel_position = false; - -void -axes::properties::update_zlabel_position (void) -{ - if (updating_zlabel_position) - return; - - text::properties& zlabel_props = reinterpret_cast - (gh_manager::get_object (get_zlabel ()).get_properties ()); - - bool camAuto = cameraupvectormode_is ("auto"); - bool is_empty = zlabel_props.get_string ().is_empty (); - - unwind_protect frame; - frame.protect_var (updating_zlabel_position); - updating_zlabel_position = true; - - if (! is_empty) - { - if (zlabel_props.horizontalalignmentmode_is ("auto")) - { - zlabel_props.set_horizontalalignment - ((zstate > AXE_DEPTH_DIR || camAuto) ? "center" : "right"); - - zlabel_props.set_horizontalalignmentmode ("auto"); - } - - if (zlabel_props.verticalalignmentmode_is ("auto")) - { - zlabel_props.set_verticalalignment - (zstate == AXE_VERT_DIR - ? "bottom" : ((zSign || camAuto) ? "bottom" : "top")); - - zlabel_props.set_verticalalignmentmode ("auto"); - } - } - - if (zlabel_props.positionmode_is ("auto") - || zlabel_props.rotationmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - Matrix ext (1, 2, 0.0); - ext = get_ticklabel_extents (get_ztick ().matrix_value (), - get_zticklabel ().all_strings (), - get_zlim ().matrix_value ()); - - double wmax = ext(0), hmax = ext(1), angle = 0; - ColumnVector p; - - if (xySym) - { - p = graphics_xform::xform_vector (xPlaneN, yPlane, - (zpTickN+zpTick)/2); - if (xisinf (fy)) - p(0) += (signum (xPlaneN-xPlane)*fx*ztickoffset); - else - p(1) += (signum (yPlane-yPlaneN)*fy*ztickoffset); - } - else - { - p = graphics_xform::xform_vector (xPlane, yPlaneN, - (zpTickN+zpTick)/2); - if (xisinf (fx)) - p(1) += (signum (yPlaneN-yPlane)*fy*ztickoffset); - else - p(0) += (signum (xPlane-xPlaneN)*fx*ztickoffset); - } - - p = xform.transform (p(0), p(1), p(2), false); - - switch (zstate) - { - case AXE_ANY_DIR: - if (camAuto) - { - p(0) -= wmax; - angle = 90; - } - - // FIXME -- what's the correct offset? - // - // p[0] += (!xySym ? wmax : -wmax); - // p[1] += (zSign ? hmax : -hmax); - - break; - - case AXE_VERT_DIR: - p(0) -= wmax; - angle = 90; - break; - - case AXE_HORZ_DIR: - p(1) += hmax; - break; - } - - if (zlabel_props.positionmode_is ("auto")) - { - p = xform.untransform (p(0), p(1), p(2), true); - zlabel_props.set_position (p.extract_n (0, 3).transpose ()); - zlabel_props.set_positionmode ("auto"); - } - - if (! is_empty && zlabel_props.rotationmode_is ("auto")) - { - zlabel_props.set_rotation (angle); - zlabel_props.set_rotationmode ("auto"); - } - } -} - -static bool updating_title_position = false; - -void -axes::properties::update_title_position (void) -{ - if (updating_title_position) - return; - - text::properties& title_props = reinterpret_cast - (gh_manager::get_object (get_title ()).get_properties ()); - - unwind_protect frame; - frame.protect_var (updating_title_position); - updating_title_position = true; - - if (title_props.positionmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - // FIXME: bbox should be stored in axes::properties - Matrix bbox = get_extent (false); - - ColumnVector p = - graphics_xform::xform_vector (bbox(0)+bbox(2)/2, - bbox(1)-10, - (x_zlim(0)+x_zlim(1))/2); - - if (x2Dtop) - { - Matrix ext (1, 2, 0.0); - ext = get_ticklabel_extents (get_xtick ().matrix_value (), - get_xticklabel ().all_strings (), - get_xlim ().matrix_value ()); - p(1) -= ext(1); - } - - p = xform.untransform (p(0), p(1), p(2), true); - - title_props.set_position (p.extract_n (0, 3).transpose ()); - title_props.set_positionmode ("auto"); - } -} - -void -axes::properties::update_autopos (const std::string& elem_type) -{ - if (elem_type == "xlabel") - update_xlabel_position (); - else if (elem_type == "ylabel") - update_ylabel_position (); - else if (elem_type == "zlabel") - update_zlabel_position (); - else if (elem_type == "title") - update_title_position (); - else if (elem_type == "sync") - sync_positions (); -} - -static void -normalized_aspectratios (Matrix& aspectratios, const Matrix& scalefactors, - double xlength, double ylength, double zlength) -{ - double xval = xlength/scalefactors(0); - double yval = ylength/scalefactors(1); - double zval = zlength/scalefactors(2); - - double minval = xmin (xmin (xval, yval), zval); - - aspectratios(0) = xval/minval; - aspectratios(1) = yval/minval; - aspectratios(2) = zval/minval; -} - -static void -max_axes_scale (double& s, Matrix& limits, const Matrix& kids, - double pbfactor, double dafactor, char limit_type, bool tight) -{ - if (tight) - { - double minval = octave_Inf; - double maxval = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - get_children_limits (minval, maxval, min_pos, max_neg, kids, limit_type); - if (!xisinf (minval) && !xisnan (minval) - && !xisinf (maxval) && !xisnan (maxval)) - { - limits(0) = minval; - limits(1) = maxval; - s = xmax(s, (maxval - minval) / (pbfactor * dafactor)); - } - } - else - s = xmax(s, (limits(1) - limits(0)) / (pbfactor * dafactor)); -} - -static bool updating_aspectratios = false; - -void -axes::properties::update_aspectratios (void) -{ - if (updating_aspectratios) - return; - - Matrix xlimits = get_xlim ().matrix_value (); - Matrix ylimits = get_ylim ().matrix_value (); - Matrix zlimits = get_zlim ().matrix_value (); - - double dx = (xlimits(1)-xlimits(0)); - double dy = (ylimits(1)-ylimits(0)); - double dz = (zlimits(1)-zlimits(0)); - - Matrix da = get_dataaspectratio ().matrix_value (); - Matrix pba = get_plotboxaspectratio ().matrix_value (); - - if (dataaspectratiomode_is ("auto")) - { - if (plotboxaspectratiomode_is ("auto")) - { - pba = Matrix (1, 3, 1.0); - plotboxaspectratio.set (pba, false); - } - - normalized_aspectratios (da, pba, dx, dy, dz); - dataaspectratio.set (da, false); - } - else if (plotboxaspectratiomode_is ("auto")) - { - normalized_aspectratios (pba, da, dx, dy, dz); - plotboxaspectratio.set (pba, false); - } - else - { - double s = -octave_Inf; - bool modified_limits = false; - Matrix kids; - - if (xlimmode_is ("auto") && ylimmode_is ("auto") && zlimmode_is ("auto")) - { - modified_limits = true; - kids = get_children (); - max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', true); - max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', true); - max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', true); - } - else if (xlimmode_is ("auto") && ylimmode_is ("auto")) - { - modified_limits = true; - max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', false); - } - else if (ylimmode_is ("auto") && zlimmode_is ("auto")) - { - modified_limits = true; - max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', false); - } - else if (zlimmode_is ("auto") && xlimmode_is ("auto")) - { - modified_limits = true; - max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', false); - } - - if (modified_limits) - { - - unwind_protect frame; - frame.protect_var (updating_aspectratios); - - updating_aspectratios = true; - - dx = pba(0) *da(0); - dy = pba(1) *da(1); - dz = pba(2) *da(2); - if (xisinf (s)) - s = 1 / xmin (xmin (dx, dy), dz); - - if (xlimmode_is ("auto")) - { - dx = s * dx; - xlimits(0) = 0.5 * (xlimits(0) + xlimits(1) - dx); - xlimits(1) = xlimits(0) + dx; - set_xlim (xlimits); - set_xlimmode ("auto"); - } - - if (ylimmode_is ("auto")) - { - dy = s * dy; - ylimits(0) = 0.5 * (ylimits(0) + ylimits(1) - dy); - ylimits(1) = ylimits(0) + dy; - set_ylim (ylimits); - set_ylimmode ("auto"); - } - - if (zlimmode_is ("auto")) - { - dz = s * dz; - zlimits(0) = 0.5 * (zlimits(0) + zlimits(1) - dz); - zlimits(1) = zlimits(0) + dz; - set_zlim (zlimits); - set_zlimmode ("auto"); - } - } - else - { - normalized_aspectratios (pba, da, dx, dy, dz); - plotboxaspectratio.set (pba, false); - } - } -} - -void -axes::properties::update_font (void) -{ -#ifdef HAVE_FREETYPE -#ifdef HAVE_FONTCONFIG - text_renderer.set_font (get ("fontname").string_value (), - get ("fontweight").string_value (), - get ("fontangle").string_value (), - get ("fontsize").double_value ()); -#endif -#endif -} - -// The INTERNAL flag defines whether position or outerposition is used. - -Matrix -axes::properties::get_boundingbox (bool internal, - const Matrix& parent_pix_size) const -{ - Matrix pos = (internal ? - get_position ().matrix_value () - : get_outerposition ().matrix_value ()); - Matrix parent_size (parent_pix_size); - - if (parent_size.numel () == 0) - { - graphics_object obj = gh_manager::get_object (get_parent ()); - - parent_size = - obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - } - - pos = convert_position (pos, get_units (), "pixels", parent_size); - - pos(0)--; - pos(1)--; - pos(1) = parent_size(1) - pos(1) - pos(3); - - return pos; -} - -Matrix -axes::properties::get_extent (bool with_text, bool only_text_height) const -{ - graphics_xform xform = get_transform (); - - Matrix ext (1, 4, 0.0); - ext(0) = octave_Inf; - ext(1) = octave_Inf; - ext(2) = -octave_Inf; - ext(3) = -octave_Inf; - for (int i = 0; i <= 1; i++) - for (int j = 0; j <= 1; j++) - for (int k = 0; k <= 1; k++) - { - ColumnVector p = xform.transform (i ? xPlaneN : xPlane, - j ? yPlaneN : yPlane, - k ? zPlaneN : zPlane, false); - ext(0) = std::min (ext(0), p(0)); - ext(1) = std::min (ext(1), p(1)); - ext(2) = std::max (ext(2), p(0)); - ext(3) = std::max (ext(3), p(1)); - } - - if (with_text) - { - for (int i = 0; i < 4; i++) - { - graphics_handle text_handle; - if (i == 0) - text_handle = get_title (); - else if (i == 1) - text_handle = get_xlabel (); - else if (i == 2) - text_handle = get_ylabel (); - else if (i == 3) - text_handle = get_zlabel (); - - text::properties& text_props = reinterpret_cast - (gh_manager::get_object (text_handle).get_properties ()); - - Matrix text_pos = text_props.get_data_position (); - text_pos = xform.transform (text_pos(0), text_pos(1), text_pos(2)); - if (text_props.get_string ().is_empty ()) - { - ext(0) = std::min (ext(0), text_pos(0)); - ext(1) = std::min (ext(1), text_pos(1)); - ext(2) = std::max (ext(2), text_pos(0)); - ext(3) = std::max (ext(3), text_pos(1)); - } - else - { - Matrix text_ext = text_props.get_extent_matrix (); - - bool ignore_horizontal = false; - bool ignore_vertical = false; - if (only_text_height) - { - double text_rotation = text_props.get_rotation (); - if (text_rotation == 0. || text_rotation == 180.) - ignore_horizontal = true; - else if (text_rotation == 90. || text_rotation == 270.) - ignore_vertical = true; - } - - if (! ignore_horizontal) - { - ext(0) = std::min (ext(0), text_pos(0)+text_ext(0)); - ext(2) = std::max (ext(2), text_pos(0)+text_ext(0)+text_ext(2)); - } - - if (! ignore_vertical) - { - ext(1) = std::min (ext(1), text_pos(1)-text_ext(1)-text_ext(3)); - ext(3) = std::max (ext(3), text_pos(1)-text_ext(1)); - } - } - } - } - - ext(2) = ext(2)-ext(0); - ext(3) = ext(3)-ext(1); - - return ext; -} - -void -axes::properties::set_units (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_units = get_units (); - if (units.set (v, true)) - { - update_units (old_units); - mark_modified (); - } - } -} - -void -axes::properties::update_units (const caseless_str& old_units) -{ - graphics_object obj = gh_manager::get_object (get_parent ()); - Matrix parent_bb = obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - caseless_str new_units = get_units (); - position.set (octave_value (convert_position (get_position ().matrix_value (), old_units, new_units, parent_bb)), false); - outerposition.set (octave_value (convert_position (get_outerposition ().matrix_value (), old_units, new_units, parent_bb)), false); - tightinset.set (octave_value (convert_position (get_tightinset ().matrix_value (), old_units, new_units, parent_bb)), false); -} - -void -axes::properties::set_fontunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_fontunits = get_fontunits (); - if (fontunits.set (v, true)) - { - update_fontunits (old_fontunits); - mark_modified (); - } - } -} - -void -axes::properties::update_fontunits (const caseless_str& old_units) -{ - caseless_str new_units = get_fontunits (); - double parent_height = get_boundingbox (true).elem (3); - double fsz = get_fontsize (); - - fsz = convert_font_size (fsz, old_units, new_units, parent_height); - - set_fontsize (octave_value (fsz)); -} - -double -axes::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - parent_height = get_boundingbox (true).elem (3); - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -ColumnVector -graphics_xform::xform_vector (double x, double y, double z) -{ - return ::xform_vector (x, y, z); -} - -Matrix -graphics_xform::xform_eye (void) -{ - return ::xform_matrix (); -} - -ColumnVector -graphics_xform::transform (double x, double y, double z, - bool use_scale) const -{ - if (use_scale) - { - x = sx.scale (x); - y = sy.scale (y); - z = sz.scale (z); - } - - return ::transform (xform, x, y, z); -} - -ColumnVector -graphics_xform::untransform (double x, double y, double z, - bool use_scale) const -{ - ColumnVector v = ::transform (xform_inv, x, y, z); - - if (use_scale) - { - v(0) = sx.unscale (v(0)); - v(1) = sy.unscale (v(1)); - v(2) = sz.unscale (v(2)); - } - - return v; -} - -octave_value -axes::get_default (const caseless_str& name) const -{ - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - retval = parent_obj.get_default (name); - } - - return retval; -} - -// FIXME -- remove. -// FIXME -- maybe this should go into array_property class? -/* -static void -check_limit_vals (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const array_property& data) -{ - double val = data.min_val (); - if (! (xisinf (val) || xisnan (val)) && val < min_val) - min_val = val; - val = data.max_val (); - if (! (xisinf (val) || xisnan (val)) && val > max_val) - max_val = val; - val = data.min_pos (); - if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) - min_pos = val; - val = data.max_neg (); - if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) - max_neg = val; -} -*/ - -static void -check_limit_vals (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const octave_value& data) -{ - if (data.is_matrix_type ()) - { - Matrix m = data.matrix_value (); - - if (! error_state && m.numel () == 4) - { - double val; - - val = m(0); - if (! (xisinf (val) || xisnan (val)) && val < min_val) - min_val = val; - - val = m(1); - if (! (xisinf (val) || xisnan (val)) && val > max_val) - max_val = val; - - val = m(2); - if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) - min_pos = val; - - val = m(3); - if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) - max_neg = val; - } - } -} - -// magform(x) Returns (a, b), where x = a * 10^b, abs (a) >= 1., and b is -// integer. - -static void -magform (double x, double& a, int& b) -{ - if (x == 0) - { - a = 0; - b = 0; - } - else - { - b = static_cast (gnulib::floor (std::log10 (std::abs (x)))); - a = x / std::pow (10.0, b); - } -} - -// A translation from Tom Holoryd's python code at -// http://kurage.nimh.nih.gov/tomh/tics.py -// FIXME -- add log ticks - -double -axes::properties::calc_tick_sep (double lo, double hi) -{ - int ticint = 5; - - // Reference: Lewart, C. R., "Algorithms SCALE1, SCALE2, and - // SCALE3 for Determination of Scales on Computer Generated - // Plots", Communications of the ACM, 10 (1973), 639-640. - // Also cited as ACM Algorithm 463. - - double a; - int b, x; - - magform ((hi-lo)/ticint, a, b); - - static const double sqrt_2 = sqrt (2.0); - static const double sqrt_10 = sqrt (10.0); - static const double sqrt_50 = sqrt (50.0); - - if (a < sqrt_2) - x = 1; - else if (a < sqrt_10) - x = 2; - else if (a < sqrt_50) - x = 5; - else - x = 10; - - return x * std::pow (10., b); - -} - -// Attempt to make "nice" limits from the actual max and min of the -// data. For log plots, we will also use the smallest strictly positive -// value. - -Matrix -axes::properties::get_axis_limits (double xmin, double xmax, - double min_pos, double max_neg, - bool logscale) -{ - Matrix retval; - - double min_val = xmin; - double max_val = xmax; - - if (xisinf (min_val) && min_val > 0 && xisinf (max_val) && max_val < 0) - { - retval = default_lim (logscale); - return retval; - } - else if (! (xisinf (min_val) || xisinf (max_val))) - { - if (logscale) - { - if (xisinf (min_pos) && xisinf (max_neg)) - { - // TODO -- max_neg is needed for "loglog ([0 -Inf])" - // This is the only place where max_neg is needed. - // Is there another way? - retval = default_lim (); - retval(0) = pow (10., retval(0)); - retval(1) = pow (10., retval(1)); - return retval; - } - if ((min_val <= 0 && max_val > 0)) - { - warning ("axis: omitting non-positive data in log plot"); - min_val = min_pos; - } - // FIXME -- maybe this test should also be relative? - if (std::abs (min_val - max_val) < sqrt (DBL_EPSILON)) - { - // Widen range when too small - if (min_val >= 0) - { - min_val *= 0.9; - max_val *= 1.1; - } - else - { - min_val *= 1.1; - max_val *= 0.9; - } - } - if (min_val > 0) - { - // Log plots with all positive data - min_val = pow (10, gnulib::floor (log10 (min_val))); - max_val = pow (10, std::ceil (log10 (max_val))); - } - else - { - // Log plots with all negative data - min_val = -pow (10, std::ceil (log10 (-min_val))); - max_val = -pow (10, gnulib::floor (log10 (-max_val))); - } - } - else - { - if (min_val == 0 && max_val == 0) - { - min_val = -1; - max_val = 1; - } - // FIXME -- maybe this test should also be relative? - else if (std::abs (min_val - max_val) < sqrt (DBL_EPSILON)) - { - min_val -= 0.1 * std::abs (min_val); - max_val += 0.1 * std::abs (max_val); - } - - double tick_sep = calc_tick_sep (min_val , max_val); - double min_tick = gnulib::floor (min_val / tick_sep); - double max_tick = std::ceil (max_val / tick_sep); - // Prevent round-off from cropping ticks - min_val = std::min (min_val, tick_sep * min_tick); - max_val = std::max (max_val, tick_sep * max_tick); - } - } - - retval.resize (1, 2); - - retval(1) = max_val; - retval(0) = min_val; - - return retval; -} - -void -axes::properties::calc_ticks_and_lims (array_property& lims, - array_property& ticks, - array_property& mticks, - bool limmode_is_auto, bool is_logscale) -{ - // FIXME -- add log ticks and lims - - if (lims.get ().is_empty ()) - return; - - double lo = (lims.get ().matrix_value ()) (0); - double hi = (lims.get ().matrix_value ()) (1); - bool is_negative = lo < 0 && hi < 0; - double tmp; - // FIXME should this be checked for somewhere else? (i.e. set{x,y,z}lim) - if (hi < lo) - { - tmp = hi; - hi = lo; - lo = tmp; - } - - if (is_logscale) - { - if (is_negative) - { - tmp = hi; - hi = std::log10 (-lo); - lo = std::log10 (-tmp); - } - else - { - hi = std::log10 (hi); - lo = std::log10 (lo); - } - } - - double tick_sep = calc_tick_sep (lo , hi); - - if (is_logscale && ! (xisinf (hi) || xisinf (lo))) - { - // FIXME - what if (hi-lo) < tick_sep? - // ex: loglog ([1 1.1]) - tick_sep = std::max (tick_sep, 1.); - tick_sep = std::ceil (tick_sep); - } - - int i1 = static_cast (gnulib::floor (lo / tick_sep)); - int i2 = static_cast (std::ceil (hi / tick_sep)); - - if (limmode_is_auto) - { - // adjust limits to include min and max tics - Matrix tmp_lims (1,2); - tmp_lims(0) = std::min (tick_sep * i1, lo); - tmp_lims(1) = std::max (tick_sep * i2, hi); - - if (is_logscale) - { - tmp_lims(0) = std::pow (10.,tmp_lims(0)); - tmp_lims(1) = std::pow (10.,tmp_lims(1)); - if (tmp_lims(0) <= 0) - tmp_lims(0) = std::pow (10., lo); - if (is_negative) - { - tmp = tmp_lims(0); - tmp_lims(0) = -tmp_lims(1); - tmp_lims(1) = -tmp; - } - } - lims = tmp_lims; - } - - Matrix tmp_ticks (1, i2-i1+1); - for (int i = 0; i <= i2-i1; i++) - { - tmp_ticks (i) = tick_sep * (i+i1); - if (is_logscale) - tmp_ticks (i) = std::pow (10., tmp_ticks (i)); - } - if (is_logscale && is_negative) - { - Matrix rev_ticks (1, i2-i1+1); - rev_ticks = -tmp_ticks; - for (int i = 0; i <= i2-i1; i++) - tmp_ticks (i) = rev_ticks (i2-i1-i); - } - - ticks = tmp_ticks; - - int n = is_logscale ? 8 : 4; - Matrix tmp_mticks (1, n * (tmp_ticks.numel () - 1)); - - for (int i = 0; i < tmp_ticks.numel ()-1; i++) - { - double d = (tmp_ticks (i+1) - tmp_ticks (i)) / (n+1); - for (int j = 0; j < n; j++) - { - tmp_mticks (n*i+j) = tmp_ticks (i) + d * (j+1); - } - } - mticks = tmp_mticks; -} - -void -axes::properties::calc_ticklabels (const array_property& ticks, - any_property& labels, bool logscale) -{ - Matrix values = ticks.get ().matrix_value (); - Cell c (values.dims ()); - std::ostringstream os; - - if (logscale) - { - double significand; - double exponent; - double exp_max = 0.; - double exp_min = 0.; - - for (int i = 0; i < values.numel (); i++) - { - exp_max = std::max (exp_max, std::log10 (values(i))); - exp_min = std::max (exp_min, std::log10 (values(i))); - } - - for (int i = 0; i < values.numel (); i++) - { - if (values(i) < 0.) - exponent = gnulib::floor (std::log10 (-values(i))); - else - exponent = gnulib::floor (std::log10 (values(i))); - significand = values(i) * std::pow (10., -exponent); - os.str (std::string ()); - os << significand; - if (exponent < 0.) - { - os << "e-"; - exponent = -exponent; - } - else - os << "e+"; - if (exponent < 10. && (exp_max > 9 || exp_min < -9)) - os << "0"; - os << exponent; - c(i) = os.str (); - } - } - else - { - for (int i = 0; i < values.numel (); i++) - { - os.str (std::string ()); - os << values(i); - c(i) = os.str (); - } - } - - labels = c; -} - -Matrix -axes::properties::get_ticklabel_extents (const Matrix& ticks, - const string_vector& ticklabels, - const Matrix& limits) -{ -#ifndef HAVE_FREETYPE - double fontsize = get ("fontsize").double_value (); -#endif - - Matrix ext (1, 2, 0.0); - double wmax = 0., hmax = 0.; - int n = std::min (ticklabels.numel (), ticks.numel ()); - for (int i = 0; i < n; i++) - { - double val = ticks(i); - if (limits(0) <= val && val <= limits(1)) - { -#ifdef HAVE_FREETYPE - ext = text_renderer.get_extent (ticklabels(i)); - wmax = std::max (wmax, ext(0)); - hmax = std::max (hmax, ext(1)); -#else - //FIXME: find a better approximation - int len = ticklabels(i).length (); - wmax = std::max (wmax, 0.5*fontsize*len); - hmax = fontsize; -#endif - } - } - - ext(0) = wmax; - ext(1) = hmax; - return ext; -} - -void -get_children_limits (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const Matrix& kids, char limit_type) -{ - octave_idx_type n = kids.numel (); - - switch (limit_type) - { - case 'x': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_xliminclude ()) - { - octave_value lim = obj.get_xlim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'y': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_yliminclude ()) - { - octave_value lim = obj.get_ylim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'z': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_zliminclude ()) - { - octave_value lim = obj.get_zlim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'c': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_climinclude ()) - { - octave_value lim = obj.get_clim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'a': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_aliminclude ()) - { - octave_value lim = obj.get_alim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - default: - break; - } -} - -static bool updating_axis_limits = false; - -void -axes::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) -{ - if (updating_axis_limits) - return; - - Matrix kids = Matrix (1, 1, h.value ()); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - char update_type = 0; - - Matrix limits; - double val; - -#define FIX_LIMITS \ - if (limits.numel () == 4) \ - { \ - val = limits(0); \ - if (! (xisinf (val) || xisnan (val))) \ - min_val = val; \ - val = limits(1); \ - if (! (xisinf (val) || xisnan (val))) \ - max_val = val; \ - val = limits(2); \ - if (! (xisinf (val) || xisnan (val))) \ - min_pos = val; \ - val = limits(3); \ - if (! (xisinf (val) || xisnan (val))) \ - max_neg = val; \ - } \ - else \ - { \ - limits.resize (4, 1); \ - limits(0) = min_val; \ - limits(1) = max_val; \ - limits(2) = min_pos; \ - limits(3) = max_neg; \ - } - - if (axis_type == "xdata" || axis_type == "xscale" - || axis_type == "xlimmode" || axis_type == "xliminclude" - || axis_type == "xlim") - { - if (xproperties.xlimmode_is ("auto")) - { - limits = xproperties.get_xlim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.xscale_is ("log")); - - update_type = 'x'; - } - } - else if (axis_type == "ydata" || axis_type == "yscale" - || axis_type == "ylimmode" || axis_type == "yliminclude" - || axis_type == "ylim") - { - if (xproperties.ylimmode_is ("auto")) - { - limits = xproperties.get_ylim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.yscale_is ("log")); - - update_type = 'y'; - } - } - else if (axis_type == "zdata" || axis_type == "zscale" - || axis_type == "zlimmode" || axis_type == "zliminclude" - || axis_type == "zlim") - { - if (xproperties.zlimmode_is ("auto")) - { - limits = xproperties.get_zlim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.zscale_is ("log")); - - update_type = 'z'; - } - } - else if (axis_type == "cdata" || axis_type == "climmode" - || axis_type == "cdatamapping" || axis_type == "climinclude" - || axis_type == "clim") - { - if (xproperties.climmode_is ("auto")) - { - limits = xproperties.get_clim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - { - max_val = min_val + 1; - min_val -= 1; - } - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'c'; - } - - } - else if (axis_type == "alphadata" || axis_type == "alimmode" - || axis_type == "alphadatamapping" || axis_type == "aliminclude" - || axis_type == "alim") - { - if (xproperties.alimmode_is ("auto")) - { - limits = xproperties.get_alim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - max_val = min_val + 1; - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'a'; - } - - } - -#undef FIX_LIMITS - - unwind_protect frame; - frame.protect_var (updating_axis_limits); - - updating_axis_limits = true; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - xproperties.set_xlimmode ("auto"); - xproperties.update_xlim (); - break; - - case 'y': - xproperties.set_ylim (limits); - xproperties.set_ylimmode ("auto"); - xproperties.update_ylim (); - break; - - case 'z': - xproperties.set_zlim (limits); - xproperties.set_zlimmode ("auto"); - xproperties.update_zlim (); - break; - - case 'c': - xproperties.set_clim (limits); - xproperties.set_climmode ("auto"); - break; - - case 'a': - xproperties.set_alim (limits); - xproperties.set_alimmode ("auto"); - break; - - default: - break; - } - - xproperties.update_transform (); - -} - -void -axes::update_axis_limits (const std::string& axis_type) -{ - if (updating_axis_limits || updating_aspectratios) - return; - - Matrix kids = xproperties.get_children (); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - char update_type = 0; - - Matrix limits; - - if (axis_type == "xdata" || axis_type == "xscale" - || axis_type == "xlimmode" || axis_type == "xliminclude" - || axis_type == "xlim") - { - if (xproperties.xlimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.xscale_is ("log")); - - update_type = 'x'; - } - } - else if (axis_type == "ydata" || axis_type == "yscale" - || axis_type == "ylimmode" || axis_type == "yliminclude" - || axis_type == "ylim") - { - if (xproperties.ylimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.yscale_is ("log")); - - update_type = 'y'; - } - } - else if (axis_type == "zdata" || axis_type == "zscale" - || axis_type == "zlimmode" || axis_type == "zliminclude" - || axis_type == "zlim") - { - if (xproperties.zlimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.zscale_is ("log")); - - update_type = 'z'; - } - } - else if (axis_type == "cdata" || axis_type == "climmode" - || axis_type == "cdatamapping" || axis_type == "climinclude" - || axis_type == "clim") - { - if (xproperties.climmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - { - max_val = min_val + 1; - min_val -= 1; - } - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'c'; - } - - } - else if (axis_type == "alphadata" || axis_type == "alimmode" - || axis_type == "alphadatamapping" || axis_type == "aliminclude" - || axis_type == "alim") - { - if (xproperties.alimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - max_val = min_val + 1; - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'a'; - } - - } - - unwind_protect frame; - frame.protect_var (updating_axis_limits); - - updating_axis_limits = true; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - xproperties.set_xlimmode ("auto"); - xproperties.update_xlim (); - break; - - case 'y': - xproperties.set_ylim (limits); - xproperties.set_ylimmode ("auto"); - xproperties.update_ylim (); - break; - - case 'z': - xproperties.set_zlim (limits); - xproperties.set_zlimmode ("auto"); - xproperties.update_zlim (); - break; - - case 'c': - xproperties.set_clim (limits); - xproperties.set_climmode ("auto"); - break; - - case 'a': - xproperties.set_alim (limits); - xproperties.set_alimmode ("auto"); - break; - - default: - break; - } - - xproperties.update_transform (); -} - -inline -double force_in_range (const double x, const double lower, const double upper) -{ - if (x < lower) - { return lower; } - else if (x > upper) - { return upper; } - else - { return x; } -} - -static Matrix -do_zoom (double val, double factor, const Matrix& lims, bool is_logscale) -{ - Matrix new_lims = lims; - - double lo = lims(0); - double hi = lims(1); - - bool is_negative = lo < 0 && hi < 0; - - if (is_logscale) - { - if (is_negative) - { - double tmp = hi; - hi = std::log10 (-lo); - lo = std::log10 (-tmp); - val = std::log10 (-val); - } - else - { - hi = std::log10 (hi); - lo = std::log10 (lo); - val = std::log10 (val); - } - } - - // Perform the zooming - lo = val + factor * (lo - val); - hi = val + factor * (hi - val); - - if (is_logscale) - { - if (is_negative) - { - double tmp = -std::pow (10.0, hi); - hi = -std::pow (10.0, lo); - lo = tmp; - } - else - { - lo = std::pow (10.0, lo); - hi = std::pow (10.0, hi); - } - } - - new_lims(0) = lo; - new_lims(1) = hi; - - return new_lims; -} - -void -axes::properties::zoom_about_point (double x, double y, double factor, - bool push_to_zoom_stack) -{ - // FIXME: Do we need error checking here? - Matrix xlims = get_xlim ().matrix_value (); - Matrix ylims = get_ylim ().matrix_value (); - - // Get children axes limits - Matrix kids = get_children (); - double minx = octave_Inf; - double maxx = -octave_Inf; - double min_pos_x = octave_Inf; - double max_neg_x = -octave_Inf; - get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); - - double miny = octave_Inf; - double maxy = -octave_Inf; - double min_pos_y = octave_Inf; - double max_neg_y = -octave_Inf; - get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); - - xlims = do_zoom (x, factor, xlims, xscale_is ("log")); - ylims = do_zoom (y, factor, ylims, yscale_is ("log")); - - zoom (xlims, ylims, push_to_zoom_stack); -} - -void -axes::properties::zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack) -{ - if (push_to_zoom_stack) - { - zoom_stack.push_front (xlimmode.get ()); - zoom_stack.push_front (xlim.get ()); - zoom_stack.push_front (ylimmode.get ()); - zoom_stack.push_front (ylim.get ()); - } - - xlim = xl; - xlimmode = "manual"; - ylim = yl; - ylimmode = "manual"; - - update_transform (); - update_xlim (false); - update_ylim (false); -} - -static Matrix -do_translate (double x0, double x1, const Matrix& lims, bool is_logscale) -{ - Matrix new_lims = lims; - - double lo = lims(0); - double hi = lims(1); - - bool is_negative = lo < 0 && hi < 0; - - double delta; - - if (is_logscale) - { - if (is_negative) - { - double tmp = hi; - hi = std::log10 (-lo); - lo = std::log10 (-tmp); - x0 = -x0; - x1 = -x1; - } - else - { - hi = std::log10 (hi); - lo = std::log10 (lo); - } - - delta = std::log10 (x0) - std::log10 (x1); - } - else - { - delta = x0 - x1; - } - - // Perform the translation - lo += delta; - hi += delta; - - if (is_logscale) - { - if (is_negative) - { - double tmp = -std::pow (10.0, hi); - hi = -std::pow (10.0, lo); - lo = tmp; - } - else - { - lo = std::pow (10.0, lo); - hi = std::pow (10.0, hi); - } - } - - new_lims(0) = lo; - new_lims(1) = hi; - - return new_lims; -} - -void -axes::properties::translate_view (double x0, double x1, double y0, double y1) -{ - // FIXME: Do we need error checking here? - Matrix xlims = get_xlim ().matrix_value (); - Matrix ylims = get_ylim ().matrix_value (); - - // Get children axes limits - Matrix kids = get_children (); - double minx = octave_Inf; - double maxx = -octave_Inf; - double min_pos_x = octave_Inf; - double max_neg_x = -octave_Inf; - get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); - - double miny = octave_Inf; - double maxy = -octave_Inf; - double min_pos_y = octave_Inf; - double max_neg_y = -octave_Inf; - get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); - - xlims = do_translate (x0, x1, xlims, xscale_is ("log")); - ylims = do_translate (y0, y1, ylims, yscale_is ("log")); - - zoom (xlims, ylims, false); -} - -void -axes::properties::rotate_view (double delta_el, double delta_az) -{ - Matrix v = get_view ().matrix_value (); - - v(1) += delta_el; - - if (v(1) > 90) - v(1) = 90; - if (v(1) < -90) - v(1) = -90; - - v(0) = fmod (v(0) - delta_az + 720,360); - - set_view (v); - update_transform (); -} - -void -axes::properties::unzoom (void) -{ - if (zoom_stack.size () >= 4) - { - ylim = zoom_stack.front (); - zoom_stack.pop_front (); - ylimmode = zoom_stack.front (); - zoom_stack.pop_front (); - xlim = zoom_stack.front (); - zoom_stack.pop_front (); - xlimmode = zoom_stack.front (); - zoom_stack.pop_front (); - - update_transform (); - update_xlim (false); - update_ylim (false); - } -} - -void -axes::properties::clear_zoom_stack (void) -{ - while (zoom_stack.size () > 4) - zoom_stack.pop_front (); - - unzoom (); -} - -void -axes::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -void -axes::initialize (const graphics_object& go) -{ - base_graphics_object::initialize (go); - - xinitialize (xproperties.get_title ()); - xinitialize (xproperties.get_xlabel ()); - xinitialize (xproperties.get_ylabel ()); - xinitialize (xproperties.get_zlabel ()); -} - -// --------------------------------------------------------------------- - -Matrix -line::properties::compute_xlim (void) const -{ - Matrix m (1, 4); - - m(0) = xdata.min_val (); - m(1) = xdata.max_val (); - m(2) = xdata.min_pos (); - m(3) = xdata.max_neg (); - - return m; -} - -Matrix -line::properties::compute_ylim (void) const -{ - Matrix m (1, 4); - - m(0) = ydata.min_val (); - m(1) = ydata.max_val (); - m(2) = ydata.min_pos (); - m(3) = ydata.max_neg (); - - return m; -} - -// --------------------------------------------------------------------- - -Matrix -text::properties::get_data_position (void) const -{ - Matrix pos = get_position ().matrix_value (); - - if (! units_is ("data")) - pos = convert_text_position (pos, *this, get_units (), "data"); - - return pos; -} - -Matrix -text::properties::get_extent_matrix (void) const -{ - // FIXME: Should this function also add the (x,y) base position? - return extent.get ().matrix_value (); -} - -octave_value -text::properties::get_extent (void) const -{ - // FIXME: This doesn't work right for 3D plots. - // (It doesn't in Matlab either, at least not in version 6.5.) - Matrix m = extent.get ().matrix_value (); - Matrix pos = get_position ().matrix_value (); - Matrix p = convert_text_position (pos, *this, get_units (), "pixels"); - - m(0) += p(0); - m(1) += p(1); - - return convert_text_position (m, *this, "pixels", get_units ()); -} - -void -text::properties::update_font (void) -{ -#ifdef HAVE_FREETYPE -#ifdef HAVE_FONTCONFIG - renderer.set_font (get ("fontname").string_value (), - get ("fontweight").string_value (), - get ("fontangle").string_value (), - get ("fontsize").double_value ()); -#endif - renderer.set_color (get_color_rgb ()); -#endif -} - -void -text::properties::update_text_extent (void) -{ -#ifdef HAVE_FREETYPE - - int halign = 0, valign = 0; - - if (horizontalalignment_is ("center")) - halign = 1; - else if (horizontalalignment_is ("right")) - halign = 2; - - if (verticalalignment_is ("top")) - valign = 2; - else if (verticalalignment_is ("baseline")) - valign = 3; - else if (verticalalignment_is ("middle")) - valign = 1; - - Matrix bbox; - - // FIXME: string should be parsed only when modified, for efficiency - - octave_value string_prop = get_string (); - - string_vector sv = string_prop.all_strings (); - - renderer.text_to_pixels (sv.join ("\n"), pixels, bbox, - halign, valign, get_rotation ()); - /* The bbox is relative to the text's position. - We'll leave it that way, because get_position () does not return - valid results when the text is first constructed. - Conversion to proper coordinates is performed in get_extent. */ - set_extent (bbox); - -#endif - - if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || - autopos_tag_is ("zlabel") || autopos_tag_is ("title")) - update_autopos ("sync"); -} - -void -text::properties::request_autopos (void) -{ - if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || - autopos_tag_is ("zlabel") || autopos_tag_is ("title")) - update_autopos (get_autopos_tag ()); -} - -void -text::properties::update_units (void) -{ - if (! units_is ("data")) - { - set_xliminclude ("off"); - set_yliminclude ("off"); - set_zliminclude ("off"); - } - - Matrix pos = get_position ().matrix_value (); - - pos = convert_text_position (pos, *this, cached_units, get_units ()); - // FIXME: if the current axes view is 2D, then one should - // probably drop the z-component of "pos" and leave "zliminclude" - // to "off". - set_position (pos); - - if (units_is ("data")) - { - set_xliminclude ("on"); - set_yliminclude ("on"); - // FIXME: see above - set_zliminclude ("off"); - } - - cached_units = get_units (); -} - -double -text::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - { - graphics_object go (gh_manager::get_object (get___myhandle__ ())); - graphics_object ax (go.get_ancestor ("axes")); - - parent_height = ax.get_properties ().get_boundingbox (true).elem (3); - } - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -// --------------------------------------------------------------------- - -octave_value -image::properties::get_color_data (void) const -{ - return convert_cdata (*this, get_cdata (), - cdatamapping_is ("scaled"), 3); -} - -// --------------------------------------------------------------------- - -octave_value -patch::properties::get_color_data (void) const -{ - octave_value fvc = get_facevertexcdata (); - if (fvc.is_undefined () || fvc.is_empty ()) - return Matrix (); - else - return convert_cdata (*this, fvc,cdatamapping_is ("scaled"), 2); -} - -// --------------------------------------------------------------------- - -octave_value -surface::properties::get_color_data (void) const -{ - return convert_cdata (*this, get_cdata (), cdatamapping_is ("scaled"), 3); -} - -inline void -cross_product (double x1, double y1, double z1, - double x2, double y2, double z2, - double& x, double& y, double& z) -{ - x += (y1 * z2 - z1 * y2); - y += (z1 * x2 - x1 * z2); - z += (x1 * y2 - y1 * x2); -} - -void -surface::properties::update_normals (void) -{ - if (normalmode_is ("auto")) - { - Matrix x = get_xdata ().matrix_value (); - Matrix y = get_ydata ().matrix_value (); - Matrix z = get_zdata ().matrix_value (); - - - int p = z.columns (), q = z.rows (); - int i1 = 0, i2 = 0, i3 = 0; - int j1 = 0, j2 = 0, j3 = 0; - - bool x_mat = (x.rows () == q); - bool y_mat = (y.columns () == p); - - NDArray n (dim_vector (q, p, 3), 0.0); - - for (int i = 0; i < p; i++) - { - if (y_mat) - { - i1 = i - 1; - i2 = i; - i3 = i + 1; - } - - for (int j = 0; j < q; j++) - { - if (x_mat) - { - j1 = j - 1; - j2 = j; - j3 = j + 1; - } - - double& nx = n(j, i, 0); - double& ny = n(j, i, 1); - double& nz = n(j, i, 2); - - if ((j > 0) && (i > 0)) - // upper left quadrangle - cross_product (x(j1,i-1)-x(j2,i), y(j-1,i1)-y(j,i2), z(j-1,i-1)-z(j,i), - x(j2,i-1)-x(j1,i), y(j,i1)-y(j-1,i2), z(j,i-1)-z(j-1,i), - nx, ny, nz); - - if ((j > 0) && (i < (p -1))) - // upper right quadrangle - cross_product (x(j1,i+1)-x(j2,i), y(j-1,i3)-y(j,i2), z(j-1,i+1)-z(j,i), - x(j1,i)-x(j2,i+1), y(j-1,i2)-y(j,i3), z(j-1,i)-z(j,i+1), - nx, ny, nz); - - if ((j < (q - 1)) && (i > 0)) - // lower left quadrangle - cross_product (x(j2,i-1)-x(j3,i), y(j,i1)-y(j+1,i2), z(j,i-1)-z(j+1,i), - x(j3,i-1)-x(j2,i), y(j+1,i1)-y(j,i2), z(j+1,i-1)-z(j,i), - nx, ny, nz); - - if ((j < (q - 1)) && (i < (p -1))) - // lower right quadrangle - cross_product (x(j3,i)-x(j2,i+1), y(j+1,i2)-y(j,i3), z(j+1,i)-z(j,i+1), - x(j3,i+1)-x(j2,i), y(j+1,i3)-y(j,i2), z(j+1,i+1)-z(j,i), - nx, ny, nz); - - double d = -std::max (std::max (fabs (nx), fabs (ny)), fabs (nz)); - - nx /= d; - ny /= d; - nz /= d; - } - } - vertexnormals = n; - } -} - -// --------------------------------------------------------------------- - -void -hggroup::properties::update_limits (void) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - { - obj.update_axis_limits ("xlim"); - obj.update_axis_limits ("ylim"); - obj.update_axis_limits ("zlim"); - obj.update_axis_limits ("clim"); - obj.update_axis_limits ("alim"); - } -} - -void -hggroup::properties::update_limits (const graphics_handle& h) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - { - obj.update_axis_limits ("xlim", h); - obj.update_axis_limits ("ylim", h); - obj.update_axis_limits ("zlim", h); - obj.update_axis_limits ("clim", h); - obj.update_axis_limits ("alim", h); - } -} - -static bool updating_hggroup_limits = false; - -void -hggroup::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) -{ - if (updating_hggroup_limits) - return; - - Matrix kids = Matrix (1, 1, h.value ()); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - Matrix limits; - double val; - - char update_type = 0; - - if (axis_type == "xlim" || axis_type == "xliminclude") - { - limits = xproperties.get_xlim ().matrix_value (); - update_type = 'x'; - } - else if (axis_type == "ylim" || axis_type == "yliminclude") - { - limits = xproperties.get_ylim ().matrix_value (); - update_type = 'y'; - } - else if (axis_type == "zlim" || axis_type == "zliminclude") - { - limits = xproperties.get_zlim ().matrix_value (); - update_type = 'z'; - } - else if (axis_type == "clim" || axis_type == "climinclude") - { - limits = xproperties.get_clim ().matrix_value (); - update_type = 'c'; - } - else if (axis_type == "alim" || axis_type == "aliminclude") - { - limits = xproperties.get_alim ().matrix_value (); - update_type = 'a'; - } - - if (limits.numel () == 4) - { - val = limits(0); - if (! (xisinf (val) || xisnan (val))) - min_val = val; - val = limits(1); - if (! (xisinf (val) || xisnan (val))) - max_val = val; - val = limits(2); - if (! (xisinf (val) || xisnan (val))) - min_pos = val; - val = limits(3); - if (! (xisinf (val) || xisnan (val))) - max_neg = val; - } - else - { - limits.resize (4,1); - limits(0) = min_val; - limits(1) = max_val; - limits(2) = min_pos; - limits(3) = max_neg; - } - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, update_type); - - unwind_protect frame; - frame.protect_var (updating_hggroup_limits); - - updating_hggroup_limits = true; - - if (limits(0) != min_val || limits(1) != max_val - || limits(2) != min_pos || limits(3) != max_neg) - { - limits(0) = min_val; - limits(1) = max_val; - limits(2) = min_pos; - limits(3) = max_neg; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - break; - - case 'y': - xproperties.set_ylim (limits); - break; - - case 'z': - xproperties.set_zlim (limits); - break; - - case 'c': - xproperties.set_clim (limits); - break; - - case 'a': - xproperties.set_alim (limits); - break; - - default: - break; - } - - base_graphics_object::update_axis_limits (axis_type, h); - } -} - -void -hggroup::update_axis_limits (const std::string& axis_type) -{ - if (updating_hggroup_limits) - return; - - Matrix kids = xproperties.get_children (); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - char update_type = 0; - - if (axis_type == "xlim" || axis_type == "xliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); - - update_type = 'x'; - } - else if (axis_type == "ylim" || axis_type == "yliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); - - update_type = 'y'; - } - else if (axis_type == "zlim" || axis_type == "zliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); - - update_type = 'z'; - } - else if (axis_type == "clim" || axis_type == "climinclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); - - update_type = 'c'; - } - else if (axis_type == "alim" || axis_type == "aliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); - - update_type = 'a'; - } - - unwind_protect frame; - frame.protect_var (updating_hggroup_limits); - - updating_hggroup_limits = true; - - Matrix limits (1, 4, 0.0); - - limits(0) = min_val; - limits(1) = max_val; - limits(2) = min_pos; - limits(3) = max_neg; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - break; - - case 'y': - xproperties.set_ylim (limits); - break; - - case 'z': - xproperties.set_zlim (limits); - break; - - case 'c': - xproperties.set_clim (limits); - break; - - case 'a': - xproperties.set_alim (limits); - break; - - default: - break; - } - - base_graphics_object::update_axis_limits (axis_type); -} - -// --------------------------------------------------------------------- - -octave_value -uicontrol::properties::get_extent (void) const -{ - Matrix m = extent.get ().matrix_value (); - - graphics_object parent_obj = - gh_manager::get_object (get_parent ()); - Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), - parent_size = parent_bbox.extract_n (0, 2, 1, 2); - - return convert_position (m, "pixels", get_units (), parent_size); -} - -void -uicontrol::properties::update_text_extent (void) -{ -#ifdef HAVE_FREETYPE - - text_element *elt; - ft_render text_renderer; - Matrix box; - - // FIXME: parsed content should be cached for efficiency - // FIXME: support multiline text - - elt = text_parser_none ().parse (get_string_string ()); -#ifdef HAVE_FONTCONFIG - text_renderer.set_font (get_fontname (), - get_fontweight (), - get_fontangle (), - get_fontsize ()); -#endif - box = text_renderer.get_extent (elt, 0); - - Matrix ext (1, 4, 0.0); - - // FIXME: also handle left and bottom components - - ext(0) = ext(1) = 1; - ext(2) = box(0); - ext(3) = box(1); - - set_extent (ext); - -#endif -} - -void -uicontrol::properties::update_units (void) -{ - Matrix pos = get_position ().matrix_value (); - - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), - parent_size = parent_bbox.extract_n (0, 2, 1, 2); - - pos = convert_position (pos, cached_units, get_units (), parent_size); - set_position (pos); - - cached_units = get_units (); -} - -void -uicontrol::properties::set_style (const octave_value& st) -{ - if (get___object__ ().is_empty ()) - style = st; - else - error ("set: cannot change the style of a uicontrol object after creation."); -} - -Matrix -uicontrol::properties::get_boundingbox (bool, - const Matrix& parent_pix_size) const -{ - Matrix pos = get_position ().matrix_value (); - Matrix parent_size (parent_pix_size); - - if (parent_size.numel () == 0) - { - graphics_object obj = gh_manager::get_object (get_parent ()); - - parent_size = - obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - } - - pos = convert_position (pos, get_units (), "pixels", parent_size); - - pos(0)--; - pos(1)--; - pos(1) = parent_size(1) - pos(1) - pos(3); - - return pos; -} - -void -uicontrol::properties::set_fontunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_fontunits = get_fontunits (); - if (fontunits.set (v, true)) - { - update_fontunits (old_fontunits); - mark_modified (); - } - } -} - -void -uicontrol::properties::update_fontunits (const caseless_str& old_units) -{ - caseless_str new_units = get_fontunits (); - double parent_height = get_boundingbox (false).elem (3); - double fsz = get_fontsize (); - - fsz = convert_font_size (fsz, old_units, new_units, parent_height); - - fontsize.set (octave_value (fsz), true); -} - -double -uicontrol::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - parent_height = get_boundingbox (false).elem (3); - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -// --------------------------------------------------------------------- - -Matrix -uipanel::properties::get_boundingbox (bool internal, - const Matrix& parent_pix_size) const -{ - Matrix pos = get_position ().matrix_value (); - Matrix parent_size (parent_pix_size); - - if (parent_size.numel () == 0) - { - graphics_object obj = gh_manager::get_object (get_parent ()); - - parent_size = - obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - } - - pos = convert_position (pos, get_units (), "pixels", parent_size); - - pos(0)--; - pos(1)--; - pos(1) = parent_size(1) - pos(1) - pos(3); - - if (internal) - { - double outer_height = pos(3); - - pos(0) = pos(1) = 0; - - if (! bordertype_is ("none")) - { - double bw = get_borderwidth (); - double mul = 1.0; - - if (bordertype_is ("etchedin") || bordertype_is ("etchedout")) - mul = 2.0; - - pos(0) += mul * bw; - pos(1) += mul * bw; - pos(2) -= 2 * mul * bw; - pos(3) -= 2 * mul * bw; - } - - if (! get_title ().empty ()) - { - double fs = get_fontsize (); - - if (! fontunits_is ("pixels")) - { - double res = xget (0, "screenpixelsperinch").double_value (); - - if (fontunits_is ("points")) - fs *= (res / 72.0); - else if (fontunits_is ("inches")) - fs *= res; - else if (fontunits_is ("centimeters")) - fs *= (res / 2.54); - else if (fontunits_is ("normalized")) - fs *= outer_height; - } - - if (titleposition_is ("lefttop") || titleposition_is ("centertop") - || titleposition_is ("righttop")) - pos(1) += (fs / 2); - pos(3) -= (fs / 2); - } - } - - return pos; -} - -void -uipanel::properties::set_units (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_units = get_units (); - if (units.set (v, true)) - { - update_units (old_units); - mark_modified (); - } - } -} - -void -uipanel::properties::update_units (const caseless_str& old_units) -{ - Matrix pos = get_position ().matrix_value (); - - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), - parent_size = parent_bbox.extract_n (0, 2, 1, 2); - - pos = convert_position (pos, old_units, get_units (), parent_size); - set_position (pos); -} - -void -uipanel::properties::set_fontunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_fontunits = get_fontunits (); - if (fontunits.set (v, true)) - { - update_fontunits (old_fontunits); - mark_modified (); - } - } -} - -void -uipanel::properties::update_fontunits (const caseless_str& old_units) -{ - caseless_str new_units = get_fontunits (); - double parent_height = get_boundingbox (false).elem (3); - double fsz = get_fontsize (); - - fsz = convert_font_size (fsz, old_units, new_units, parent_height); - - set_fontsize (octave_value (fsz)); -} - -double -uipanel::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - parent_height = get_boundingbox (false).elem (3); - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -// --------------------------------------------------------------------- - -octave_value -uitoolbar::get_default (const caseless_str& name) const -{ - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - retval = parent_obj.get_default (name); - } - - return retval; -} - -void -uitoolbar::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -// --------------------------------------------------------------------- - -octave_value -base_graphics_object::get_default (const caseless_str& name) const -{ - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - return parent_obj.get_default (type () + name); -} - -octave_value -base_graphics_object::get_factory_default (const caseless_str& name) const -{ - graphics_object parent_obj = gh_manager::get_object (0); - - return parent_obj.get_factory_default (type () + name); -} - -// We use a random value for the handle to avoid issues with plots and -// scalar values for the first argument. -gh_manager::gh_manager (void) - : handle_map (), handle_free_list (), - next_handle (-1.0 - (rand () + 1.0) / (RAND_MAX + 2.0)), - figure_list (), graphics_lock (), event_queue (), - callback_objects (), event_processing (0) -{ - handle_map[0] = graphics_object (new root_figure ()); - - // Make sure the default graphics toolkit is registered. - gtk_manager::default_toolkit (); -} - -void -gh_manager::create_instance (void) -{ - instance = new gh_manager (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); -} - -graphics_handle -gh_manager::do_make_graphics_handle (const std::string& go_name, - const graphics_handle& p, - bool integer_figure_handle, - bool do_createfcn, - bool do_notify_toolkit) -{ - graphics_handle h = get_handle (integer_figure_handle); - - base_graphics_object *go = 0; - - go = make_graphics_object_from_type (go_name, h, p); - - if (go) - { - graphics_object obj (go); - - handle_map[h] = obj; - if (do_createfcn) - go->get_properties ().execute_createfcn (); - - // Notify graphics toolkit. - if (do_notify_toolkit) - obj.initialize (); - } - else - error ("gh_manager::do_make_graphics_handle: invalid object type `%s'", - go_name.c_str ()); - - return h; -} - -graphics_handle -gh_manager::do_make_figure_handle (double val, bool do_notify_toolkit) -{ - graphics_handle h = val; - - base_graphics_object* go = new figure (h, 0); - graphics_object obj (go); - - handle_map[h] = obj; - - // Notify graphics toolkit. - if (do_notify_toolkit) - obj.initialize (); - - return h; -} - -void -gh_manager::do_push_figure (const graphics_handle& h) -{ - do_pop_figure (h); - - figure_list.push_front (h); -} - -void -gh_manager::do_pop_figure (const graphics_handle& h) -{ - for (figure_list_iterator p = figure_list.begin (); - p != figure_list.end (); - p++) - { - if (*p == h) - { - figure_list.erase (p); - break; - } - } -} - -class -callback_event : public base_graphics_event -{ -public: - callback_event (const graphics_handle& h, const std::string& name, - const octave_value& data = Matrix ()) - : base_graphics_event (), handle (h), callback_name (name), - callback (), callback_data (data) { } - - callback_event (const graphics_handle& h, const octave_value& cb, - const octave_value& data = Matrix ()) - : base_graphics_event (), handle (h), callback_name (), - callback (cb), callback_data (data) { } - - void execute (void) - { - if (callback.is_defined ()) - gh_manager::execute_callback (handle, callback, callback_data); - else - gh_manager::execute_callback (handle, callback_name, callback_data); - } - -private: - callback_event (void) - : base_graphics_event (), handle (), - callback_name (), callback_data () - { } - -private: - graphics_handle handle; - std::string callback_name; - octave_value callback; - octave_value callback_data; -}; - -class -function_event : public base_graphics_event -{ -public: - function_event (graphics_event::event_fcn fcn, void* data = 0) - : base_graphics_event (), function (fcn), - function_data (data) { } - - void execute (void) - { - function (function_data); - } - -private: - - graphics_event::event_fcn function; - - void* function_data; - - // function_event objects must be created with at least a function. - function_event (void); - - // No copying! - - function_event (const function_event &); - - function_event & operator = (const function_event &); -}; - -class -set_event : public base_graphics_event -{ -public: - set_event (const graphics_handle& h, const std::string& name, - const octave_value& value, bool do_notify_toolkit = true) - : base_graphics_event (), handle (h), property_name (name), - property_value (value), notify_toolkit (do_notify_toolkit) { } - - void execute (void) - { - gh_manager::auto_lock guard; - - graphics_object go = gh_manager::get_object (handle); - - if (go) - { - property p = go.get_properties ().get_property (property_name); - - if (p.ok ()) - p.set (property_value, true, notify_toolkit); - } - } - -private: - set_event (void) - : base_graphics_event (), handle (), property_name (), property_value () - { } - -private: - graphics_handle handle; - std::string property_name; - octave_value property_value; - bool notify_toolkit; -}; - -graphics_event -graphics_event::create_callback_event (const graphics_handle& h, - const std::string& name, - const octave_value& data) -{ - graphics_event e; - - e.rep = new callback_event (h, name, data); - - return e; -} - -graphics_event -graphics_event::create_callback_event (const graphics_handle& h, - const octave_value& cb, - const octave_value& data) -{ - graphics_event e; - - e.rep = new callback_event (h, cb, data); - - return e; -} - -graphics_event -graphics_event::create_function_event (graphics_event::event_fcn fcn, - void *data) -{ - graphics_event e; - - e.rep = new function_event (fcn, data); - - return e; -} - -graphics_event -graphics_event::create_set_event (const graphics_handle& h, - const std::string& name, - const octave_value& data, - bool notify_toolkit) -{ - graphics_event e; - - e.rep = new set_event (h, name, data, notify_toolkit); - - return e; -} - -static void -xset_gcbo (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (0); - root_figure::properties& props = - dynamic_cast (go.get_properties ()); - - props.set_callbackobject (h.as_octave_value ()); -} - -void -gh_manager::do_restore_gcbo (void) -{ - gh_manager::auto_lock guard; - - callback_objects.pop_front (); - - xset_gcbo (callback_objects.empty () - ? graphics_handle () - : callback_objects.front ().get_handle ()); -} - -void -gh_manager::do_execute_listener (const graphics_handle& h, - const octave_value& l) -{ - if (octave_thread::is_octave_thread ()) - gh_manager::execute_callback (h, l, octave_value ()); - else - { - gh_manager::auto_lock guard; - - do_post_event (graphics_event::create_callback_event (h, l)); - } -} - -void -gh_manager::do_execute_callback (const graphics_handle& h, - const octave_value& cb_arg, - const octave_value& data) -{ - if (cb_arg.is_defined () && ! cb_arg.is_empty ()) - { - octave_value_list args; - octave_function *fcn = 0; - - args(0) = h.as_octave_value (); - if (data.is_defined ()) - args(1) = data; - else - args(1) = Matrix (); - - unwind_protect_safe frame; - frame.add_fcn (gh_manager::restore_gcbo); - - if (true) - { - gh_manager::auto_lock guard; - - callback_objects.push_front (get_object (h)); - xset_gcbo (h); - } - - BEGIN_INTERRUPT_WITH_EXCEPTIONS; - - // Copy CB because "function_value" method is non-const. - - octave_value cb = cb_arg; - - if (cb.is_function () || cb.is_function_handle ()) - fcn = cb.function_value (); - else if (cb.is_string ()) - { - int status; - std::string s = cb.string_value (); - - eval_string (s, false, status, 0); - } - else if (cb.is_cell () && cb.length () > 0 - && (cb.rows () == 1 || cb.columns () == 1) - && (cb.cell_value ()(0).is_function () - || cb.cell_value ()(0).is_function_handle ())) - { - Cell c = cb.cell_value (); - - fcn = c(0).function_value (); - if (! error_state) - { - for (int i = 1; i < c.length () ; i++) - args(1+i) = c(i); - } - } - else - { - std::string nm = cb.class_name (); - error ("trying to execute non-executable object (class = %s)", - nm.c_str ()); - } - - if (fcn && ! error_state) - feval (fcn, args); - - END_INTERRUPT_WITH_EXCEPTIONS; - } -} - -void -gh_manager::do_post_event (const graphics_event& e) -{ - event_queue.push_back (e); - - command_editor::add_event_hook (gh_manager::process_events); -} - -void -gh_manager::do_post_callback (const graphics_handle& h, const std::string name, - const octave_value& data) -{ - gh_manager::auto_lock guard; - - graphics_object go = get_object (h); - - if (go.valid_object ()) - { - if (callback_objects.empty ()) - do_post_event (graphics_event::create_callback_event (h, name, data)); - else - { - const graphics_object& current = callback_objects.front (); - - if (current.get_properties ().is_interruptible ()) - do_post_event (graphics_event::create_callback_event (h, name, data)); - else - { - caseless_str busy_action (go.get_properties ().get_busyaction ()); - - if (busy_action.compare ("queue")) - do_post_event (graphics_event::create_callback_event (h, name, data)); - else - { - caseless_str cname (name); - - if (cname.compare ("deletefcn") - || cname.compare ("createfcn") - || (go.isa ("figure") - && (cname.compare ("closerequestfcn") - || cname.compare ("resizefcn")))) - do_post_event (graphics_event::create_callback_event (h, name, data)); - } - } - } - } -} - -void -gh_manager::do_post_function (graphics_event::event_fcn fcn, void* fcn_data) -{ - gh_manager::auto_lock guard; - - do_post_event (graphics_event::create_function_event (fcn, fcn_data)); -} - -void -gh_manager::do_post_set (const graphics_handle& h, const std::string name, - const octave_value& value, bool notify_toolkit) -{ - gh_manager::auto_lock guard; - - do_post_event (graphics_event::create_set_event (h, name, value, - notify_toolkit)); -} - -int -gh_manager::do_process_events (bool force) -{ - graphics_event e; - bool old_Vdrawnow_requested = Vdrawnow_requested; - bool events_executed = false; - - do - { - e = graphics_event (); - - gh_manager::lock (); - - if (! event_queue.empty ()) - { - if (callback_objects.empty () || force) - { - e = event_queue.front (); - - event_queue.pop_front (); - } - else - { - const graphics_object& go = callback_objects.front (); - - if (go.get_properties ().is_interruptible ()) - { - e = event_queue.front (); - - event_queue.pop_front (); - } - } - } - - gh_manager::unlock (); - - if (e.ok ()) - { - e.execute (); - events_executed = true; - } - } - while (e.ok ()); - - gh_manager::lock (); - - if (event_queue.empty () && event_processing == 0) - command_editor::remove_event_hook (gh_manager::process_events); - - gh_manager::unlock (); - - if (events_executed) - flush_octave_stdout (); - - if (Vdrawnow_requested && ! old_Vdrawnow_requested) - { - feval ("drawnow"); - - Vdrawnow_requested = false; - } - - return 0; -} - -void -gh_manager::do_enable_event_processing (bool enable) -{ - gh_manager::auto_lock guard; - - if (enable) - { - event_processing++; - - command_editor::add_event_hook (gh_manager::process_events); - } - else - { - event_processing--; - - if (event_queue.empty () && event_processing == 0) - command_editor::remove_event_hook (gh_manager::process_events); - } -} - -property_list::plist_map_type -root_figure::init_factory_properties (void) -{ - property_list::plist_map_type plist_map; - - plist_map["figure"] = figure::properties::factory_defaults (); - plist_map["axes"] = axes::properties::factory_defaults (); - plist_map["line"] = line::properties::factory_defaults (); - plist_map["text"] = text::properties::factory_defaults (); - plist_map["image"] = image::properties::factory_defaults (); - plist_map["patch"] = patch::properties::factory_defaults (); - plist_map["surface"] = surface::properties::factory_defaults (); - plist_map["hggroup"] = hggroup::properties::factory_defaults (); - plist_map["uimenu"] = uimenu::properties::factory_defaults (); - plist_map["uicontrol"] = uicontrol::properties::factory_defaults (); - plist_map["uipanel"] = uipanel::properties::factory_defaults (); - plist_map["uicontextmenu"] = uicontextmenu::properties::factory_defaults (); - plist_map["uitoolbar"] = uitoolbar::properties::factory_defaults (); - plist_map["uipushtool"] = uipushtool::properties::factory_defaults (); - plist_map["uitoggletool"] = uitoggletool::properties::factory_defaults (); - - return plist_map; -} - -// --------------------------------------------------------------------- - -DEFUN (ishandle, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ishandle (@var{h})\n\ -Return true if @var{h} is a graphics handle and false otherwise.\n\ -@var{h} may also be a matrix of handles in which case a logical\n\ -array is returned that is true where the elements of @var{h} are\n\ -graphics handles and false where they are not.\n\ -@seealso{isfigure}\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () == 1) - retval = is_handle (args(0)); - else - print_usage (); - - return retval; -} - -static bool -is_handle_visible (const graphics_handle& h) -{ - return h.ok () && gh_manager::is_handle_visible (h); -} - -static bool -is_handle_visible (double val) -{ - return is_handle_visible (gh_manager::lookup (val)); -} - -static octave_value -is_handle_visible (const octave_value& val) -{ - octave_value retval = false; - - if (val.is_real_scalar () && is_handle_visible (val.double_value ())) - retval = true; - else if (val.is_numeric_type () && val.is_real_type ()) - { - const NDArray handles = val.array_value (); - - if (! error_state) - { - boolNDArray result (handles.dims ()); - - for (octave_idx_type i = 0; i < handles.numel (); i++) - result.xelem (i) = is_handle_visible (handles (i)); - - retval = result; - } - } - - return retval; -} - -DEFUN (__is_handle_visible__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} __is_handle_visible__ (@var{h})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = is_handle_visible (args(0)); - else - print_usage (); - - return retval; -} - -DEFUN (reset, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} reset (@var{h}, @var{property})\n\ -Remove any defaults set for the handle @var{h}. The default figure\n\ -properties of \"position\", \"units\", \"windowstyle\" and\n\ -\"paperunits\" and the default axes properties of \"position\" and \"units\"\n\ -are not reset.\n\ -@end deftypefn") -{ - int nargin = args.length (); - - if (nargin != 1) - print_usage (); - else - { - // get vector of graphics handles - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - // loop over graphics objects - for (octave_idx_type n = 0; n < hcv.length (); n++) - gh_manager::get_object (hcv(n)).reset_default_properties (); - } - } - - return octave_value (); -} - -DEFUN (set, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} set (@var{h}, @var{property}, @var{value}, @dots{})\n\ -@deftypefnx {Built-in Function} {} set (@var{h}, @var{properties}, @var{values})\n\ -@deftypefnx {Built-in Function} {} set (@var{h}, @var{pv})\n\ -Set named property values for the graphics handle (or vector of graphics\n\ -handles) @var{h}.\n\ -There are three ways how to give the property names and values:\n\ -\n\ -@itemize\n\ -@item as a comma separated list of @var{property}, @var{value} pairs\n\ -\n\ -Here, each @var{property} is a string containing the property name, each\n\ -@var{value} is a value of the appropriate type for the property.\n\ -\n\ -@item as a cell array of strings @var{properties} containing property names\n\ -and a cell array @var{values} containing property values.\n\ -\n\ -In this case, the number of columns of @var{values} must match the number of\n\ -elements in @var{properties}. The first column of @var{values} contains\n\ -values for the first entry in @var{properties}, etc. The number of rows of\n\ -@var{values} must be 1 or match the number of elements of @var{h}. In the\n\ -first case, each handle in @var{h} will be assigned the same values. In the\n\ -latter case, the first handle in @var{h} will be assigned the values from\n\ -the first row of @var{values} and so on.\n\ -\n\ -@item as a structure array @var{pv}\n\ -\n\ -Here, the field names of @var{pv} represent the property names, and the field\n\ -values give the property values. In contrast to the previous case, all\n\ -elements of @var{pv} will be set in all handles in @var{h} independent of\n\ -the dimensions of @var{pv}.\n\ -@end itemize\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - int nargin = args.length (); - - if (nargin > 0) - { - // get vector of graphics handles - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - bool request_drawnow = false; - - // loop over graphics objects - for (octave_idx_type n = 0; n < hcv.length (); n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - { - if (nargin == 3 && args(1).is_cellstr () - && args(2).is_cell ()) - { - if (args(2).cell_value ().rows () == 1) - { - obj.set (args(1).cellstr_value (), - args(2).cell_value (), 0); - } - else if (hcv.length () == args(2).cell_value ().rows ()) - { - obj.set (args(1).cellstr_value (), - args(2).cell_value (), n); - } - else - { - error ("set: number of graphics handles must match number of value rows (%d != %d)", - hcv.length (), args(2).cell_value ().rows ()); - break; - - } - } - else if (nargin == 2 && args(1).is_map ()) - { - obj.set (args(1).map_value ()); - } - else if (nargin == 1) - { - if (nargout != 0) - retval = obj.values_as_struct (); - else - { - std::string s = obj.values_as_string (); - if (! error_state) - octave_stdout << s; - } - } - else - { - obj.set (args.splice (0, 1)); - request_drawnow = true; - } - } - else - { - error ("set: invalid handle (= %g)", hcv(n)); - break; - } - - if (error_state) - break; - - request_drawnow = true; - } - - if (! error_state && request_drawnow) - Vdrawnow_requested = true; - } - else - error ("set: expecting graphics handle as first argument"); - } - else - print_usage (); - - return retval; -} - -static std::string -get_graphics_object_type (const double val) -{ - std::string retval; - - graphics_object obj = gh_manager::get_object (val); - - if (obj) - retval = obj.type (); - else - error ("get: invalid handle (= %g)", val); - - return retval; -} - -DEFUN (get, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} get (@var{h}, @var{p})\n\ -Return the named property @var{p} from the graphics handle @var{h}.\n\ -If @var{p} is omitted, return the complete property list for @var{h}.\n\ -If @var{h} is a vector, return a cell array including the property\n\ -values or lists respectively.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - Cell vals; - - int nargin = args.length (); - - bool use_cell_format = false; - - if (nargin == 1 || nargin == 2) - { - if (args(0).is_empty ()) - { - retval = Matrix (); - return retval; - } - - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - octave_idx_type len = hcv.length (); - - if (nargin == 1 && len > 1) - { - std::string t0 = get_graphics_object_type (hcv(0)); - - if (! error_state) - { - for (octave_idx_type n = 1; n < len; n++) - { - std::string t = get_graphics_object_type (hcv(n)); - - if (error_state) - break; - - if (t != t0) - { - error ("get: vector of handles must all have same type"); - break; - } - } - - } - } - - if (! error_state) - { - if (nargin > 1 && args(1).is_cellstr ()) - { - Array plist = args(1).cellstr_value (); - - if (! error_state) - { - octave_idx_type plen = plist.numel (); - - use_cell_format = true; - - vals.resize (dim_vector (len, plen)); - - for (octave_idx_type n = 0; ! error_state && n < len; n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - { - for (octave_idx_type m = 0; ! error_state && m < plen; m++) - { - caseless_str property = plist(m); - - vals(n, m) = obj.get (property); - } - } - else - { - error ("get: invalid handle (= %g)", hcv(n)); - break; - } - } - } - else - error ("get: expecting property name or cell array of property names as second argument"); - } - else - { - caseless_str property; - - if (nargin > 1) - { - property = args(1).string_value (); - - if (error_state) - error ("get: expecting property name or cell array of property names as second argument"); - } - - vals.resize (dim_vector (len, 1)); - - if (! error_state) - { - for (octave_idx_type n = 0; ! error_state && n < len; n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - { - if (nargin == 1) - vals(n) = obj.get (); - else - vals(n) = obj.get (property); - } - else - { - error ("get: invalid handle (= %g)", hcv(n)); - break; - } - } - } - } - } - } - else - error ("get: expecting graphics handle as first argument"); - } - else - print_usage (); - - if (! error_state) - { - if (use_cell_format) - retval = vals; - else - { - octave_idx_type len = vals.numel (); - - if (len == 0) - retval = Matrix (); - else if (len == 1) - retval = vals(0); - else if (len > 1 && nargin == 1) - { - OCTAVE_LOCAL_BUFFER (octave_scalar_map, tmp, len); - - for (octave_idx_type n = 0; n < len; n++) - tmp[n] = vals(n).scalar_map_value (); - - retval = octave_map::cat (0, len, tmp); - } - else - retval = vals; - } - } - - return retval; -} - -/* -%!assert (get (findobj (0, "Tag", "nonexistenttag"), "nonexistentproperty"), []) -*/ - -// Return all properties from the graphics handle @var{h}. -// If @var{h} is a vector, return a cell array including the -// property values or lists respectively. - -DEFUN (__get__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __get__ (@var{h})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - Cell vals; - - int nargin = args.length (); - - if (nargin == 1) - { - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - octave_idx_type len = hcv.length (); - - vals.resize (dim_vector (len, 1)); - - for (octave_idx_type n = 0; n < len; n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - vals(n) = obj.get (true); - else - { - error ("get: invalid handle (= %g)", hcv(n)); - break; - } - } - } - else - error ("get: expecting graphics handle as first argument"); - } - else - print_usage (); - - if (! error_state) - { - octave_idx_type len = vals.numel (); - - if (len > 1) - retval = vals; - else if (len == 1) - retval = vals(0); - } - - return retval; -} - -static octave_value -make_graphics_object (const std::string& go_name, - bool integer_figure_handle, - const octave_value_list& args) -{ - octave_value retval; - - double val = octave_NaN; - - octave_value_list xargs = args.splice (0, 1); - - caseless_str p ("parent"); - - for (int i = 0; i < xargs.length (); i++) - if (xargs(i).is_string () - && p.compare (xargs(i).string_value ())) - { - if (i < (xargs.length () - 1)) - { - val = xargs(i+1).double_value (); - - if (! error_state) - { - xargs = xargs.splice (i, 2); - break; - } - } - else - error ("__go_%s__: missing value for parent property", - go_name.c_str ()); - } - - if (! error_state && xisnan (val)) - val = args(0).double_value (); - - if (! error_state) - { - graphics_handle parent = gh_manager::lookup (val); - - if (parent.ok ()) - { - graphics_handle h - = gh_manager::make_graphics_handle (go_name, parent, - integer_figure_handle, - false, false); - - if (! error_state) - { - adopt (parent, h); - - xset (h, xargs); - xcreatefcn (h); - xinitialize (h); - - retval = h.value (); - - if (! error_state) - Vdrawnow_requested = true; - } - else - error ("__go%s__: unable to create graphics handle", - go_name.c_str ()); - } - else - error ("__go_%s__: invalid parent", go_name.c_str ()); - } - else - error ("__go_%s__: invalid parent", go_name.c_str ()); - - return retval; -} - -DEFUN (__go_figure__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_figure__ (@var{fignum})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () > 0) - { - double val = args(0).double_value (); - - if (! error_state) - { - if (is_figure (val)) - { - graphics_handle h = gh_manager::lookup (val); - - xset (h, args.splice (0, 1)); - - retval = h.value (); - } - else - { - bool int_fig_handle = true; - - octave_value_list xargs = args.splice (0, 1); - - graphics_handle h = octave_NaN; - - if (xisnan (val)) - { - caseless_str p ("integerhandle"); - - for (int i = 0; i < xargs.length (); i++) - { - if (xargs(i).is_string () - && p.compare (xargs(i).string_value ())) - { - if (i < (xargs.length () - 1)) - { - std::string pval = xargs(i+1).string_value (); - - if (! error_state) - { - caseless_str on ("on"); - int_fig_handle = on.compare (pval); - xargs = xargs.splice (i, 2); - break; - } - } - } - } - - h = gh_manager::make_graphics_handle ("figure", 0, - int_fig_handle, - false, false); - - if (! int_fig_handle) - { - // We need to intiailize the integerhandle - // property without calling the set_integerhandle - // method, because doing that will generate a new - // handle value... - - graphics_object go = gh_manager::get_object (h); - go.get_properties ().init_integerhandle ("off"); - } - } - else if (val > 0 && D_NINT (val) == val) - h = gh_manager::make_figure_handle (val, false); - - if (! error_state && h.ok ()) - { - adopt (0, h); - - gh_manager::push_figure (h); - - xset (h, xargs); - xcreatefcn (h); - xinitialize (h); - - retval = h.value (); - } - else - error ("__go_figure__: failed to create figure handle"); - } - } - else - error ("__go_figure__: expecting figure number to be double value"); - } - else - print_usage (); - - return retval; -} - -#define GO_BODY(TYPE) \ - gh_manager::auto_lock guard; \ - \ - octave_value retval; \ - \ - if (args.length () > 0) \ - retval = make_graphics_object (#TYPE, false, args); \ - else \ - print_usage (); \ - \ - return retval - -int -calc_dimensions (const graphics_object& go) -{ - - int nd = 2; - - if (go.isa ("surface")) - nd = 3; - - if ((go.isa ("line") || go.isa ("patch")) && ! go.get("zdata").is_empty ()) - nd = 3; - - Matrix kids = go.get_properties ().get_children (); - - for (octave_idx_type i = 0; i < kids.length (); i++) - { - graphics_handle hnd = gh_manager::lookup (kids(i)); - - if (hnd.ok ()) - { - const graphics_object& kid = gh_manager::get_object (hnd); - - if (kid.valid_object ()) - nd = calc_dimensions (kid); - - if (nd == 3) - break; - } - } - - return nd; -} - -DEFUN (__calc_dimensions__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __calc_dimensions__ (@var{axes})\n\ -Internal function. Determine the number of dimensions in a graphics\n\ -object, whether 2 or 3.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - double h = args(0).double_value (); - - if (! error_state) - retval = calc_dimensions (gh_manager::get_object (h)); - else - error ("__calc_dimensions__: expecting graphics handle as only argument"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__go_axes__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_axes__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (axes); -} - -DEFUN (__go_line__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_line__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (line); -} - -DEFUN (__go_text__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_text__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (text); -} - -DEFUN (__go_image__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_image__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (image); -} - -DEFUN (__go_surface__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_surface__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (surface); -} - -DEFUN (__go_patch__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_patch__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (patch); -} - -DEFUN (__go_hggroup__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_hggroup__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (hggroup); -} - -DEFUN (__go_uimenu__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uimenu__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uimenu); -} - -DEFUN (__go_uicontrol__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uicontrol__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uicontrol); -} - -DEFUN (__go_uipanel__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uipanel__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uipanel); -} - -DEFUN (__go_uicontextmenu__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uicontextmenu__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uicontextmenu); -} - -DEFUN (__go_uitoolbar__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uitoolbar__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uitoolbar); -} - -DEFUN (__go_uipushtool__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uipushtool__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uipushtool); -} - -DEFUN (__go_uitoggletool__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uitoggletool__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uitoggletool); -} - -DEFUN (__go_delete__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_delete__ (@var{h})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value_list retval; - - if (args.length () == 1) - { - graphics_handle h = octave_NaN; - - const NDArray vals = args (0).array_value (); - - if (! error_state) - { - // Check is all the handles to delete are valid first - // as callbacks might delete one of the handles we - // later want to delete - for (octave_idx_type i = 0; i < vals.numel (); i++) - { - h = gh_manager::lookup (vals.elem (i)); - - if (! h.ok ()) - { - error ("delete: invalid graphics object (= %g)", - vals.elem (i)); - break; - } - } - - if (! error_state) - delete_graphics_objects (vals); - } - else - error ("delete: invalid graphics object"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__go_axes_init__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_axes_init__ (@var{h}, @var{mode})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - int nargin = args.length (); - - std::string mode = ""; - - if (nargin == 2) - { - mode = args(1).string_value (); - - if (error_state) - return retval; - } - - if (nargin == 1 || nargin == 2) - { - graphics_handle h = octave_NaN; - - double val = args(0).double_value (); - - if (! error_state) - { - h = gh_manager::lookup (val); - - if (h.ok ()) - { - graphics_object obj = gh_manager::get_object (h); - - obj.set_defaults (mode); - - h = gh_manager::lookup (val); - if (! h.ok ()) - error ("__go_axes_init__: axis deleted during initialization (= %g)", val); - } - else - error ("__go_axes_init__: invalid graphics object (= %g)", val); - } - else - error ("__go_axes_init__: invalid graphics object"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__go_handles__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_handles__ (@var{show_hidden})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - bool show_hidden = false; - - if (args.length () > 0) - show_hidden = args(0).bool_value (); - - return octave_value (gh_manager::handle_list (show_hidden)); -} - -DEFUN (__go_figure_handles__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_figure_handles__ (@var{show_hidden})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - bool show_hidden = false; - - if (args.length () > 0) - show_hidden = args(0).bool_value (); - - return octave_value (gh_manager::figure_handle_list (show_hidden)); -} - -DEFUN (__go_execute_callback__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name})\n\ -@deftypefnx {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name}, @var{param})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - double val = args(0).double_value (); - - if (! error_state) - { - graphics_handle h = gh_manager::lookup (val); - - if (h.ok ()) - { - std::string name = args(1).string_value (); - - if (! error_state) - { - if (nargin == 2) - gh_manager::execute_callback (h, name); - else - gh_manager::execute_callback (h, name, args(2)); - } - else - error ("__go_execute_callback__: invalid callback name"); - } - else - error ("__go_execute_callback__: invalid graphics object (= %g)", - val); - } - else - error ("__go_execute_callback__: invalid graphics object"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__image_pixel_size__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{px}, @var{py}} __image_pixel_size__ (@var{h})\n\ -Internal function: returns the pixel size of the image in normalized units.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - double h = args(0).double_value (); - - if (! error_state) - { - graphics_object fobj = gh_manager::get_object (h); - if (fobj && fobj.isa ("image")) - { - image::properties& ip = - dynamic_cast (fobj.get_properties ()); - - Matrix dp = Matrix (1, 2, 0); - dp(0, 0) = ip.pixel_xsize (); - dp(0, 1) = ip.pixel_ysize (); - retval = dp; - } - else - error ("__image_pixel_size__: object is not an image"); - } - else - error ("__image_pixel_size__: argument is not a handle"); - } - else - print_usage (); - - return retval; -} - -gtk_manager *gtk_manager::instance = 0; - -void -gtk_manager::create_instance (void) -{ - instance = new gtk_manager (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); -} - -graphics_toolkit -gtk_manager::do_get_toolkit (void) const -{ - graphics_toolkit retval; - - const_loaded_toolkits_iterator pl = loaded_toolkits.find (dtk); - - if (pl == loaded_toolkits.end ()) - { - const_available_toolkits_iterator pa = available_toolkits.find (dtk); - - if (pa != available_toolkits.end ()) - { - octave_value_list args; - args(0) = dtk; - feval ("graphics_toolkit", args); - - if (! error_state) - pl = loaded_toolkits.find (dtk); - - if (error_state || pl == loaded_toolkits.end ()) - error ("failed to load %s graphics toolkit", dtk.c_str ()); - else - retval = pl->second; - } - else - error ("default graphics toolkit `%s' is not available!", - dtk.c_str ()); - } - else - retval = pl->second; - - return retval; -} - -DEFUN (available_graphics_toolkits, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} available_graphics_toolkits ()\n\ -Return a cell array of registered graphics toolkits.\n\ -@seealso{graphics_toolkit, register_graphics_toolkit}\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - return octave_value (gtk_manager::available_toolkits_list ()); -} - -DEFUN (register_graphics_toolkit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} register_graphics_toolkit (@var{toolkit})\n\ -List @var{toolkit} as an available graphics toolkit.\n\ -@seealso{available_graphics_toolkits}\n\ -@end deftypefn") -{ - octave_value retval; - - gh_manager::auto_lock guard; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - gtk_manager::register_toolkit (name); - else - error ("register_graphics_toolkit: expecting character string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (loaded_graphics_toolkits, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} loaded_graphics_toolkits ()\n\ -Return a cell array of the currently loaded graphics toolkits.\n\ -@seealso{available_graphics_toolkits}\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - return octave_value (gtk_manager::loaded_toolkits_list ()); -} - -DEFUN (drawnow, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} drawnow ()\n\ -@deftypefnx {Built-in Function} {} drawnow (\"expose\")\n\ -@deftypefnx {Built-in Function} {} drawnow (@var{term}, @var{file}, @var{mono}, @var{debug_file})\n\ -Update figure windows and their children. The event queue is flushed and\n\ -any callbacks generated are executed. With the optional argument\n\ -@code{\"expose\"}, only graphic objects are updated and no other events or\n\ -callbacks are processed.\n\ -The third calling form of @code{drawnow} is for debugging and is\n\ -undocumented.\n\ -@end deftypefn") -{ - static int drawnow_executing = 0; - - octave_value retval; - - gh_manager::lock (); - - unwind_protect frame; - frame.protect_var (Vdrawnow_requested, false); - - frame.protect_var (drawnow_executing); - - if (++drawnow_executing <= 1) - { - if (args.length () == 0 || args.length () == 1) - { - Matrix hlist = gh_manager::figure_handle_list (true); - - for (int i = 0; ! error_state && i < hlist.length (); i++) - { - graphics_handle h = gh_manager::lookup (hlist(i)); - - if (h.ok () && h != 0) - { - graphics_object go = gh_manager::get_object (h); - figure::properties& fprops = dynamic_cast (go.get_properties ()); - - if (fprops.is_modified ()) - { - if (fprops.is_visible ()) - { - gh_manager::unlock (); - - fprops.get_toolkit ().redraw_figure (go); - - gh_manager::lock (); - } - - fprops.set_modified (false); - } - } - } - - bool do_events = true; - - if (args.length () == 1) - { - caseless_str val (args(0).string_value ()); - - if (! error_state && val.compare ("expose")) - do_events = false; - else - { - error ("drawnow: invalid argument, expected `expose' as argument"); - return retval; - } - } - - if (do_events) - { - gh_manager::unlock (); - - gh_manager::process_events (); - - gh_manager::lock (); - } - } - else if (args.length () >= 2 && args.length () <= 4) - { - std::string term, file, debug_file; - bool mono; - - term = args(0).string_value (); - - if (! error_state) - { - file = args(1).string_value (); - - if (! error_state) - { - size_t pos = file.find_first_not_of ("|"); - if (pos > 0) - file = file.substr (pos); - else - { - pos = file.find_last_of (file_ops::dir_sep_chars ()); - - if (pos != std::string::npos) - { - std::string dirname = file.substr (0, pos+1); - - file_stat fs (dirname); - - if (! (fs && fs.is_dir ())) - { - error ("drawnow: nonexistent directory `%s'", - dirname.c_str ()); - - return retval; - } - } - } - - mono = (args.length () >= 3 ? args(2).bool_value () : false); - - if (! error_state) - { - debug_file = (args.length () > 3 ? args(3).string_value () - : ""); - - if (! error_state) - { - graphics_handle h = gcf (); - - if (h.ok ()) - { - graphics_object go = gh_manager::get_object (h); - - gh_manager::unlock (); - - go.get_toolkit () - .print_figure (go, term, file, mono, debug_file); - - gh_manager::lock (); - } - else - error ("drawnow: nothing to draw"); - } - else - error ("drawnow: invalid DEBUG_FILE, expected a string value"); - } - else - error ("drawnow: invalid colormode MONO, expected a boolean value"); - } - else - error ("drawnow: invalid FILE, expected a string value"); - } - else - error ("drawnow: invalid terminal TERM, expected a string value"); - } - else - print_usage (); - } - - gh_manager::unlock (); - - return retval; -} - -DEFUN (addlistener, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} addlistener (@var{h}, @var{prop}, @var{fcn})\n\ -Register @var{fcn} as listener for the property @var{prop} of the graphics\n\ -object @var{h}. Property listeners are executed (in order of registration)\n\ -when the property is set. The new value is already available when the\n\ -listeners are executed.\n\ -\n\ -@var{prop} must be a string naming a valid property in @var{h}.\n\ -\n\ -@var{fcn} can be a function handle, a string or a cell array whose first\n\ -element is a function handle. If @var{fcn} is a function handle, the\n\ -corresponding function should accept at least 2 arguments, that will be\n\ -set to the object handle and the empty matrix respectively. If @var{fcn}\n\ -is a string, it must be any valid octave expression. If @var{fcn} is a cell\n\ -array, the first element must be a function handle with the same signature\n\ -as described above. The next elements of the cell array are passed\n\ -as additional arguments to the function.\n\ -\n\ -Example:\n\ -\n\ -@example\n\ -@group\n\ -function my_listener (h, dummy, p1)\n\ - fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ -endfunction\n\ -\n\ -addlistener (gcf, \"position\", @{@@my_listener, \"my string\"@})\n\ -@end group\n\ -@end example\n\ -\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () >= 3 && args.length () <= 4) - { - double h = args(0).double_value (); - - if (! error_state) - { - std::string pname = args(1).string_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (h); - - if (gh.ok ()) - { - graphics_object go = gh_manager::get_object (gh); - - go.add_property_listener (pname, args(2), POSTSET); - - if (args.length () == 4) - { - caseless_str persistent = args(3).string_value (); - if (persistent.compare ("persistent")) - go.add_property_listener (pname, args(2), PERSISTENT); - } - } - else - error ("addlistener: invalid graphics object (= %g)", - h); - } - else - error ("addlistener: invalid property name, expected a string value"); - } - else - error ("addlistener: invalid handle"); - } - else - print_usage (); - - return retval; -} - -DEFUN (dellistener, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dellistener (@var{h}, @var{prop}, @var{fcn})\n\ -Remove the registration of @var{fcn} as a listener for the property\n\ -@var{prop} of the graphics object @var{h}. The function @var{fcn} must\n\ -be the same variable (not just the same value), as was passed to the\n\ -original call to @code{addlistener}.\n\ -\n\ -If @var{fcn} is not defined then all listener functions of @var{prop}\n\ -are removed.\n\ -\n\ -Example:\n\ -\n\ -@example\n\ -@group\n\ -function my_listener (h, dummy, p1)\n\ - fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ -endfunction\n\ -\n\ -c = @{@@my_listener, \"my string\"@};\n\ -addlistener (gcf, \"position\", c);\n\ -dellistener (gcf, \"position\", c);\n\ -@end group\n\ -@end example\n\ -\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () == 3 || args.length () == 2) - { - double h = args(0).double_value (); - - if (! error_state) - { - std::string pname = args(1).string_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (h); - - if (gh.ok ()) - { - graphics_object go = gh_manager::get_object (gh); - - if (args.length () == 2) - go.delete_property_listener (pname, octave_value (), POSTSET); - else - { - caseless_str persistent = args(2).string_value (); - if (persistent.compare ("persistent")) - { - go.delete_property_listener (pname, octave_value (), PERSISTENT); - go.delete_property_listener (pname, octave_value (), POSTSET); - } - else - go.delete_property_listener (pname, args(2), POSTSET); - } - } - else - error ("dellistener: invalid graphics object (= %g)", - h); - } - else - error ("dellistener: invalid property name, expected a string value"); - } - else - error ("dellistener: invalid handle"); - } - else - print_usage (); - - return retval; -} - -DEFUN (addproperty, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type})\n\ -@deftypefnx {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type}, @var{arg}, @dots{})\n\ -Create a new property named @var{name} in graphics object @var{h}.\n\ -@var{type} determines the type of the property to create. @var{args}\n\ -usually contains the default value of the property, but additional\n\ -arguments might be given, depending on the type of the property.\n\ -\n\ -The supported property types are:\n\ -\n\ -@table @code\n\ -@item string\n\ -A string property. @var{arg} contains the default string value.\n\ -\n\ -@item any\n\ -An un-typed property. This kind of property can hold any octave\n\ -value. @var{args} contains the default value.\n\ -\n\ -@item radio\n\ -A string property with a limited set of accepted values. The first\n\ -argument must be a string with all accepted values separated by\n\ -a vertical bar ('|'). The default value can be marked by enclosing\n\ -it with a '@{' '@}' pair. The default value may also be given as\n\ -an optional second string argument.\n\ -\n\ -@item boolean\n\ -A boolean property. This property type is equivalent to a radio\n\ -property with \"on|off\" as accepted values. @var{arg} contains\n\ -the default property value.\n\ -\n\ -@item double\n\ -A scalar double property. @var{arg} contains the default value.\n\ -\n\ -@item handle\n\ -A handle property. This kind of property holds the handle of a\n\ -graphics object. @var{arg} contains the default handle value.\n\ -When no default value is given, the property is initialized to\n\ -the empty matrix.\n\ -\n\ -@item data\n\ -A data (matrix) property. @var{arg} contains the default data\n\ -value. When no default value is given, the data is initialized to\n\ -the empty matrix.\n\ -\n\ -@item color\n\ -A color property. @var{arg} contains the default color value.\n\ -When no default color is given, the property is set to black.\n\ -An optional second string argument may be given to specify an\n\ -additional set of accepted string values (like a radio property).\n\ -@end table\n\ -\n\ -@var{type} may also be the concatenation of a core object type and\n\ -a valid property name for that object type. The property created\n\ -then has the same characteristics as the referenced property (type,\n\ -possible values, hidden state@dots{}). This allows to clone an existing\n\ -property into the graphics object @var{h}.\n\ -\n\ -Examples:\n\ -\n\ -@example\n\ -@group\n\ -addproperty (\"my_property\", gcf, \"string\", \"a string value\");\n\ -addproperty (\"my_radio\", gcf, \"radio\", \"val_1|val_2|@{val_3@}\");\n\ -addproperty (\"my_style\", gcf, \"linelinestyle\", \"--\");\n\ -@end group\n\ -@end example\n\ -\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () >= 3) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - double h = args(1).double_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (h); - - if (gh.ok ()) - { - graphics_object go = gh_manager::get_object (gh); - - std::string type = args(2).string_value (); - - if (! error_state) - { - if (! go.get_properties ().has_property (name)) - { - property p = property::create (name, gh, type, - args.splice (0, 3)); - - if (! error_state) - go.get_properties ().insert_property (name, p); - } - else - error ("addproperty: a `%s' property already exists in the graphics object", - name.c_str ()); - } - else - error ("addproperty: invalid property TYPE, expected a string value"); - } - else - error ("addproperty: invalid graphics object (= %g)", h); - } - else - error ("addproperty: invalid handle value"); - } - else - error ("addproperty: invalid property NAME, expected a string value"); - } - else - print_usage (); - - return retval; -} - -octave_value -get_property_from_handle (double handle, const std::string& property, - const std::string& func) -{ - gh_manager::auto_lock guard; - - graphics_object obj = gh_manager::get_object (handle); - octave_value retval; - - if (obj) - retval = obj.get (caseless_str (property)); - else - error ("%s: invalid handle (= %g)", func.c_str (), handle); - - return retval; -} - -bool -set_property_in_handle (double handle, const std::string& property, - const octave_value& arg, const std::string& func) -{ - gh_manager::auto_lock guard; - - graphics_object obj = gh_manager::get_object (handle); - int ret = false; - - if (obj) - { - obj.set (caseless_str (property), arg); - - if (! error_state) - ret = true; - } - else - error ("%s: invalid handle (= %g)", func.c_str (), handle); - - return ret; -} - -static bool -compare_property_values (const octave_value& o1, const octave_value& o2) -{ - octave_value_list args (2); - - args(0) = o1; - args(1) = o2; - - octave_value_list result = feval ("isequal", args, 1); - - if (! error_state && result.length () > 0) - return result(0).bool_value (); - - return false; -} - -static std::map waitfor_results; - -static void -cleanup_waitfor_id (uint32_t id) -{ - waitfor_results.erase (id); -} - -static void -do_cleanup_waitfor_listener (const octave_value& listener, - listener_mode mode = POSTSET) -{ - Cell c = listener.cell_value (); - - if (c.numel () >= 4) - { - double h = c(2).double_value (); - - if (! error_state) - { - caseless_str pname = c(3).string_value (); - - if (! error_state) - { - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - graphics_object go = gh_manager::get_object (handle); - - if (go.get_properties ().has_property (pname)) - { - go.get_properties () - .delete_listener (pname, listener, mode); - if (mode == POSTSET) - go.get_properties () - .delete_listener (pname, listener, PERSISTENT); - } - } - } - } - } -} - -static void -cleanup_waitfor_postset_listener (const octave_value& listener) -{ do_cleanup_waitfor_listener (listener, POSTSET); } - -static void -cleanup_waitfor_predelete_listener (const octave_value& listener) -{ do_cleanup_waitfor_listener (listener, PREDELETE); } - -static octave_value_list -waitfor_listener (const octave_value_list& args, int) -{ - if (args.length () > 3) - { - uint32_t id = args(2).uint32_scalar_value ().value (); - - if (! error_state) - { - if (args.length () > 5) - { - double h = args(0).double_value (); - - if (! error_state) - { - caseless_str pname = args(4).string_value (); - - if (! error_state) - { - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - graphics_object go = gh_manager::get_object (handle); - octave_value pvalue = go.get (pname); - - if (compare_property_values (pvalue, args(5))) - waitfor_results[id] = true; - } - } - } - } - else - waitfor_results[id] = true; - } - } - - return octave_value_list (); -} - -static octave_value_list -waitfor_del_listener (const octave_value_list& args, int) -{ - if (args.length () > 2) - { - uint32_t id = args(2).uint32_scalar_value ().value (); - - if (! error_state) - waitfor_results[id] = true; - } - - return octave_value_list (); -} - -DEFUN (waitfor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} waitfor (@var{h})\n\ -@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop})\n\ -@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop}, @var{value})\n\ -@deftypefnx {Built-in Function} {} waitfor (@dots{}, \"timeout\", @var{timeout})\n\ -Suspend the execution of the current program until a condition is\n\ -satisfied on the graphics handle @var{h}. While the program is suspended\n\ -graphics events are still being processed normally, allowing callbacks to\n\ -modify the state of graphics objects. This function is reentrant and can be\n\ -called from a callback, while another @code{waitfor} call is pending at\n\ -top-level.\n\ -\n\ -In the first form, program execution is suspended until the graphics object\n\ -@var{h} is destroyed. If the graphics handle is invalid, the function\n\ -returns immediately.\n\ -\n\ -In the second form, execution is suspended until the graphics object is\n\ -destroyed or the property named @var{prop} is modified. If the graphics\n\ -handle is invalid or the property does not exist, the function returns\n\ -immediately.\n\ -\n\ -In the third form, execution is suspended until the graphics object is\n\ -destroyed or the property named @var{prop} is set to @var{value}. The\n\ -function @code{isequal} is used to compare property values. If the graphics\n\ -handle is invalid, the property does not exist or the property is already\n\ -set to @var{value}, the function returns immediately.\n\ -\n\ -An optional timeout can be specified using the property @code{timeout}.\n\ -This timeout value is the number of seconds to wait for the condition to be\n\ -true. @var{timeout} must be at least 1. If a smaller value is specified, a\n\ -warning is issued and a value of 1 is used instead. If the timeout value is\n\ -not an integer, it is truncated towards 0.\n\ -\n\ -To define a condition on a property named @code{timeout}, use the string\n\ -@code{\\timeout} instead.\n\ -\n\ -In all cases, typing CTRL-C stops program execution immediately.\n\ -@seealso{isequal}\n\ -@end deftypefn") -{ - if (args.length () > 0) - { - double h = args(0).double_value (); - - if (! error_state) - { - caseless_str pname; - - unwind_protect frame; - - static uint32_t id_counter = 0; - uint32_t id = 0; - - int max_arg_index = 0; - int timeout_index = -1; - - int timeout = 0; - - if (args.length () > 1) - { - pname = args(1).string_value (); - if (! error_state - && ! pname.empty () - && ! pname.compare ("timeout")) - { - if (pname.compare ("\\timeout")) - pname = "timeout"; - - static octave_value wf_listener; - - if (! wf_listener.is_defined ()) - wf_listener = - octave_value (new octave_builtin (waitfor_listener, - "waitfor_listener")); - - max_arg_index++; - if (args.length () > 2) - { - if (args(2).is_string ()) - { - caseless_str s = args(2).string_value (); - - if (! error_state) - { - if (s.compare ("timeout")) - timeout_index = 2; - else - max_arg_index++; - } - } - else - max_arg_index++; - } - - Cell listener (1, max_arg_index >= 2 ? 5 : 4); - - id = id_counter++; - frame.add_fcn (cleanup_waitfor_id, id); - waitfor_results[id] = false; - - listener(0) = wf_listener; - listener(1) = octave_uint32 (id); - listener(2) = h; - listener(3) = pname; - - if (max_arg_index >= 2) - listener(4) = args(2); - - octave_value ov_listener (listener); - - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - graphics_object go = gh_manager::get_object (handle); - - if (max_arg_index >= 2 - && compare_property_values (go.get (pname), - args(2))) - waitfor_results[id] = true; - else - { - - frame.add_fcn (cleanup_waitfor_postset_listener, - ov_listener); - go.add_property_listener (pname, ov_listener, - POSTSET); - go.add_property_listener (pname, ov_listener, - PERSISTENT); - - if (go.get_properties () - .has_dynamic_property (pname)) - { - static octave_value wf_del_listener; - - if (! wf_del_listener.is_defined ()) - wf_del_listener = - octave_value (new octave_builtin - (waitfor_del_listener, - "waitfor_del_listener")); - - Cell del_listener (1, 4); - - del_listener(0) = wf_del_listener; - del_listener(1) = octave_uint32 (id); - del_listener(2) = h; - del_listener(3) = pname; - - octave_value ov_del_listener (del_listener); - - frame.add_fcn (cleanup_waitfor_predelete_listener, - ov_del_listener); - go.add_property_listener (pname, ov_del_listener, - PREDELETE); - } - } - } - } - else if (error_state || pname.empty ()) - error ("waitfor: invalid property name, expected a non-empty string value"); - } - - if (! error_state - && timeout_index < 0 - && args.length () > (max_arg_index + 1)) - { - caseless_str s = args(max_arg_index + 1).string_value (); - - if (! error_state) - { - if (s.compare ("timeout")) - timeout_index = max_arg_index + 1; - else - error ("waitfor: invalid parameter `%s'", s.c_str ()); - } - else - error ("waitfor: invalid parameter, expected `timeout'"); - } - - if (! error_state && timeout_index >= 0) - { - if (args.length () > (timeout_index + 1)) - { - timeout = static_cast - (args(timeout_index + 1).scalar_value ()); - - if (! error_state) - { - if (timeout < 1) - { - warning ("waitfor: the timeout value must be >= 1, using 1 instead"); - timeout = 1; - } - } - else - error ("waitfor: invalid timeout value, expected a value >= 1"); - } - else - error ("waitfor: missing timeout value"); - } - - // FIXME: There is still a "hole" in the following loop. The code - // assumes that an object handle is unique, which is a fair - // assumptions, except for figures. If a figure is destroyed - // then recreated with the same figure ID, within the same - // run of event hooks, then the figure destruction won't be - // caught and the loop will not stop. This is an unlikely - // possibility in practice, though. - // - // Using deletefcn callback is also unreliable as it could be - // modified during a callback execution and the waitfor loop - // would not stop. - // - // The only "good" implementation would require object - // listeners, similar to property listeners. - - time_t start = 0; - - if (timeout > 0) - start = time (0); - - while (! error_state) - { - if (true) - { - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - if (! pname.empty () && waitfor_results[id]) - break; - } - else - break; - } - - octave_usleep (100000); - - OCTAVE_QUIT; - - command_editor::run_event_hooks (); - - if (timeout > 0) - { - if (start + timeout < time (0)) - break; - } - } - } - else - error ("waitfor: invalid handle value."); - } - else - print_usage (); - - return octave_value (); -} diff -r d02b229ce693 -r a132d206a36a src/graphics.in.h --- a/src/graphics.in.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5830 +0,0 @@ -/* - -Copyright (C) 2007-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (graphics_h) -#define graphics_h 1 - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include -#include -#include -#include -#include - -#include "caseless-str.h" -#include "lo-ieee.h" - -#include "gripes.h" -#include "oct-map.h" -#include "oct-mutex.h" -#include "oct-refcount.h" -#include "ov.h" -#include "txt-eng-ft.h" - -// FIXME -- maybe this should be a configure option? -// Matlab defaults to "Helvetica", but that causes problems for many -// gnuplot users. -#if !defined (OCTAVE_DEFAULT_FONTNAME) -#define OCTAVE_DEFAULT_FONTNAME "*" -#endif - -// --------------------------------------------------------------------- - -class graphics_handle -{ -public: - graphics_handle (void) : val (octave_NaN) { } - - graphics_handle (const octave_value& a); - - graphics_handle (int a) : val (a) { } - - graphics_handle (double a) : val (a) { } - - graphics_handle (const graphics_handle& a) : val (a.val) { } - - graphics_handle& operator = (const graphics_handle& a) - { - if (&a != this) - val = a.val; - - return *this; - } - - ~graphics_handle (void) { } - - double value (void) const { return val; } - - octave_value as_octave_value (void) const - { - return ok () ? octave_value (val) : octave_value (Matrix ()); - } - - // Prefix increment/decrement operators. - graphics_handle& operator ++ (void) - { - ++val; - return *this; - } - - graphics_handle& operator -- (void) - { - --val; - return *this; - } - - // Postfix increment/decrement operators. - const graphics_handle operator ++ (int) - { - graphics_handle old_value = *this; - ++(*this); - return old_value; - } - - const graphics_handle operator -- (int) - { - graphics_handle old_value = *this; - --(*this); - return old_value; - } - - bool ok (void) const { return ! xisnan (val); } - -private: - double val; -}; - -inline bool -operator == (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () == b.value (); -} - -inline bool -operator != (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () != b.value (); -} - -inline bool -operator < (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () < b.value (); -} - -inline bool -operator <= (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () <= b.value (); -} - -inline bool -operator >= (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () >= b.value (); -} - -inline bool -operator > (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () > b.value (); -} - -// --------------------------------------------------------------------- - -class base_scaler -{ -public: - base_scaler (void) { } - - virtual ~base_scaler (void) { } - - virtual Matrix scale (const Matrix& m) const - { - error ("invalid axis scale"); - return m; - } - - virtual NDArray scale (const NDArray& m) const - { - error ("invalid axis scale"); - return m; - } - - virtual double scale (double d) const - { - error ("invalid axis scale"); - return d; - } - - virtual double unscale (double d) const - { - error ("invalid axis scale"); - return d; - } - - virtual base_scaler* clone () const - { return new base_scaler (); } - - virtual bool is_linear (void) const - { return false; } -}; - -class lin_scaler : public base_scaler -{ -public: - lin_scaler (void) { } - - Matrix scale (const Matrix& m) const { return m; } - - NDArray scale (const NDArray& m) const { return m; } - - double scale (double d) const { return d; } - - double unscale (double d) const { return d; } - - base_scaler* clone (void) const { return new lin_scaler (); } - - bool is_linear (void) const { return true; } -}; - -class log_scaler : public base_scaler -{ -public: - log_scaler (void) { } - - Matrix scale (const Matrix& m) const - { - Matrix retval (m.rows (), m.cols ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - NDArray scale (const NDArray& m) const - { - NDArray retval (m.dims ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - double scale (double d) const - { return log10 (d); } - - double unscale (double d) const - { return pow (10.0, d); } - - base_scaler* clone (void) const - { return new log_scaler (); } - -private: - void do_scale (const double *src, double *dest, int n) const - { - for (int i = 0; i < n; i++) - dest[i] = log10 (src[i]); - } -}; - -class neg_log_scaler : public base_scaler -{ -public: - neg_log_scaler (void) { } - - Matrix scale (const Matrix& m) const - { - Matrix retval (m.rows (), m.cols ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - NDArray scale (const NDArray& m) const - { - NDArray retval (m.dims ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - double scale (double d) const - { return -log10 (-d); } - - double unscale (double d) const - { return -pow (10.0, -d); } - - base_scaler* clone (void) const - { return new neg_log_scaler (); } - -private: - void do_scale (const double *src, double *dest, int n) const - { - for (int i = 0; i < n; i++) - dest[i] = -log10 (-src[i]); - } -}; - -class scaler -{ -public: - scaler (void) : rep (new base_scaler ()) { } - - scaler (const scaler& s) : rep (s.rep->clone ()) { } - - scaler (const std::string& s) - : rep (s == "log" - ? new log_scaler () - : (s == "neglog" ? new neg_log_scaler () - : (s == "linear" ? new lin_scaler () : new base_scaler ()))) - { } - - ~scaler (void) { delete rep; } - - Matrix scale (const Matrix& m) const - { return rep->scale (m); } - - NDArray scale (const NDArray& m) const - { return rep->scale (m); } - - double scale (double d) const - { return rep->scale (d); } - - double unscale (double d) const - { return rep->unscale (d); } - - bool is_linear (void) const - { return rep->is_linear (); } - - scaler& operator = (const scaler& s) - { - if (rep) - { - delete rep; - rep = 0; - } - - rep = s.rep->clone (); - - return *this; - } - - scaler& operator = (const std::string& s) - { - if (rep) - { - delete rep; - rep = 0; - } - - if (s == "log") - rep = new log_scaler (); - else if (s == "neglog") - rep = new neg_log_scaler (); - else if (s == "linear") - rep = new lin_scaler (); - else - rep = new base_scaler (); - - return *this; - } - -private: - base_scaler *rep; -}; - -// --------------------------------------------------------------------- - -class property; - -enum listener_mode { POSTSET, PERSISTENT, PREDELETE }; - -class base_property -{ -public: - friend class property; - -public: - base_property (void) - : id (-1), count (1), name (), parent (), hidden (), listeners () - { } - - base_property (const std::string& s, const graphics_handle& h) - : id (-1), count (1), name (s), parent (h), hidden (false), listeners () - { } - - base_property (const base_property& p) - : id (-1), count (1), name (p.name), parent (p.parent), - hidden (p.hidden), listeners () - { } - - virtual ~base_property (void) { } - - bool ok (void) const { return parent.ok (); } - - std::string get_name (void) const { return name; } - - void set_name (const std::string& s) { name = s; } - - graphics_handle get_parent (void) const { return parent; } - - void set_parent (const graphics_handle &h) { parent = h; } - - bool is_hidden (void) const { return hidden; } - - void set_hidden (bool flag) { hidden = flag; } - - virtual bool is_radio (void) const { return false; } - - int get_id (void) const { return id; } - - void set_id (int d) { id = d; } - - // Sets property value, notifies graphics toolkit. - // If do_run is true, runs associated listeners. - OCTINTERP_API bool set (const octave_value& v, bool do_run = true, - bool do_notify_toolkit = true); - - virtual octave_value get (void) const - { - error ("get: invalid property \"%s\"", name.c_str ()); - return octave_value (); - } - - - virtual std::string values_as_string (void) const - { - error ("values_as_string: invalid property \"%s\"", name.c_str ()); - return std::string (); - } - - virtual Cell values_as_cell (void) const - { - error ("values_as_cell: invalid property \"%s\"", name.c_str ()); - return Cell (); - } - - base_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - void add_listener (const octave_value& v, listener_mode mode = POSTSET) - { - octave_value_list& l = listeners[mode]; - l.resize (l.length () + 1, v); - } - - void delete_listener (const octave_value& v = octave_value (), - listener_mode mode = POSTSET) - { - octave_value_list& l = listeners[mode]; - - if (v.is_defined ()) - { - bool found = false; - int i; - - for (i = 0; i < l.length (); i++) - { - if (v.internal_rep () == l(i).internal_rep ()) - { - found = true; - break; - } - } - if (found) - { - for (int j = i; j < l.length () - 1; j++) - l(j) = l(j + 1); - - l.resize (l.length () - 1); - } - } - else - { - if (mode == PERSISTENT) - l.resize (0); - else - { - octave_value_list lnew (0); - octave_value_list& lp = listeners[PERSISTENT]; - for (int i = l.length () - 1; i >= 0 ; i--) - { - for (int j = 0; j < lp.length (); j++) - { - if (l(i).internal_rep () == lp(j).internal_rep ()) - { - lnew.resize (lnew.length () + 1, l(i)); - break; - } - } - } - l = lnew; - } - } - - } - - OCTINTERP_API void run_listeners (listener_mode mode = POSTSET); - - virtual base_property* clone (void) const - { return new base_property (*this); } - -protected: - virtual bool do_set (const octave_value&) - { - error ("set: invalid property \"%s\"", name.c_str ()); - return false; - } - -private: - typedef std::map listener_map; - typedef std::map::iterator listener_map_iterator; - typedef std::map::const_iterator listener_map_const_iterator; - -private: - int id; - octave_refcount count; - std::string name; - graphics_handle parent; - bool hidden; - listener_map listeners; -}; - -// --------------------------------------------------------------------- - -class string_property : public base_property -{ -public: - string_property (const std::string& s, const graphics_handle& h, - const std::string& val = "") - : base_property (s, h), str (val) { } - - string_property (const string_property& p) - : base_property (p), str (p.str) { } - - octave_value get (void) const - { return octave_value (str); } - - std::string string_value (void) const { return str; } - - string_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new string_property (*this); } - -protected: - bool do_set (const octave_value& val) - { - if (val.is_string ()) - { - std::string new_str = val.string_value (); - - if (new_str != str) - { - str = new_str; - return true; - } - } - else - error ("set: invalid string property value for \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - std::string str; -}; - -// --------------------------------------------------------------------- - -class string_array_property : public base_property -{ -public: - enum desired_enum { string_t, cell_t }; - - string_array_property (const std::string& s, const graphics_handle& h, - const std::string& val = "", const char& sep = '|', - const desired_enum& typ = string_t) - : base_property (s, h), desired_type (typ), separator (sep), str () - { - size_t pos = 0; - - while (true) - { - size_t new_pos = val.find_first_of (separator, pos); - - if (new_pos == std::string::npos) - { - str.append (val.substr (pos)); - break; - } - else - str.append (val.substr (pos, new_pos - pos)); - - pos = new_pos + 1; - } - } - - string_array_property (const std::string& s, const graphics_handle& h, - const Cell& c, const char& sep = '|', - const desired_enum& typ = string_t) - : base_property (s, h), desired_type (typ), separator (sep), str () - { - if (c.is_cellstr ()) - { - string_vector strings (c.numel ()); - - for (octave_idx_type i = 0; i < c.numel (); i++) - strings[i] = c(i).string_value (); - - str = strings; - } - else - error ("set: invalid order property value for \"%s\"", - get_name ().c_str ()); - } - - string_array_property (const string_array_property& p) - : base_property (p), desired_type (p.desired_type), - separator (p.separator), str (p.str) { } - - octave_value get (void) const - { - if (desired_type == string_t) - return octave_value (string_value ()); - else - return octave_value (cell_value ()); - } - - std::string string_value (void) const - { - std::string s; - - for (octave_idx_type i = 0; i < str.length (); i++) - { - s += str[i]; - if (i != str.length () - 1) - s += separator; - } - - return s; - } - - Cell cell_value (void) const {return Cell (str);} - - string_vector string_vector_value (void) const { return str; } - - string_array_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new string_array_property (*this); } - -protected: - bool do_set (const octave_value& val) - { - if (val.is_string ()) - { - bool replace = false; - std::string new_str = val.string_value (); - string_vector strings; - size_t pos = 0; - - while (pos != std::string::npos) - { - size_t new_pos = new_str.find_first_of (separator, pos); - - if (new_pos == std::string::npos) - { - strings.append (new_str.substr (pos)); - break; - } - else - strings.append (new_str.substr (pos, new_pos - pos)); - - pos = new_pos + 1; - } - - if (str.numel () == strings.numel ()) - { - for (octave_idx_type i = 0; i < str.numel (); i++) - if (strings[i] != str[i]) - { - replace = true; - break; - } - } - else - replace = true; - - desired_type = string_t; - - if (replace) - { - str = strings; - return true; - } - } - else if (val.is_cellstr ()) - { - bool replace = false; - Cell new_cell = val.cell_value (); - - string_vector strings = new_cell.cellstr_value (); - - octave_idx_type nel = strings.length (); - - if (nel != str.length ()) - replace = true; - else - { - for (octave_idx_type i = 0; i < nel; i++) - { - if (strings[i] != str[i]) - { - replace = true; - break; - } - } - } - - desired_type = cell_t; - - if (replace) - { - str = strings; - return true; - } - } - else - error ("set: invalid string property value for \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - desired_enum desired_type; - char separator; - string_vector str; -}; - -// --------------------------------------------------------------------- - -class text_label_property : public base_property -{ -public: - enum type { char_t, cellstr_t }; - - text_label_property (const std::string& s, const graphics_handle& h, - const std::string& val = "") - : base_property (s, h), value (val), stored_type (char_t) - { } - - text_label_property (const std::string& s, const graphics_handle& h, - const NDArray& nda) - : base_property (s, h), stored_type (char_t) - { - octave_idx_type nel = nda.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - std::ostringstream buf; - buf << nda(i); - value[i] = buf.str (); - } - } - - text_label_property (const std::string& s, const graphics_handle& h, - const Cell& c) - : base_property (s, h), stored_type (cellstr_t) - { - octave_idx_type nel = c.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_value tmp = c(i); - - if (tmp.is_string ()) - value[i] = c(i).string_value (); - else - { - double d = c(i).double_value (); - - if (! error_state) - { - std::ostringstream buf; - buf << d; - value[i] = buf.str (); - } - else - break; - } - } - } - - text_label_property (const text_label_property& p) - : base_property (p), value (p.value), stored_type (p.stored_type) - { } - - bool empty (void) const - { - octave_value tmp = get (); - return tmp.is_empty (); - } - - octave_value get (void) const - { - if (stored_type == char_t) - return octave_value (char_value ()); - else - return octave_value (cell_value ()); - } - - std::string string_value (void) const - { - return value.empty () ? std::string () : value[0]; - } - - string_vector string_vector_value (void) const { return value; } - - charMatrix char_value (void) const { return charMatrix (value, ' '); } - - Cell cell_value (void) const {return Cell (value); } - - text_label_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new text_label_property (*this); } - -protected: - - bool do_set (const octave_value& val) - { - if (val.is_string ()) - { - value = val.all_strings (); - - stored_type = char_t; - } - else if (val.is_cell ()) - { - Cell c = val.cell_value (); - - octave_idx_type nel = c.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_value tmp = c(i); - - if (tmp.is_string ()) - value[i] = c(i).string_value (); - else - { - double d = c(i).double_value (); - - if (! error_state) - { - std::ostringstream buf; - buf << d; - value[i] = buf.str (); - } - else - return false; - } - } - - stored_type = cellstr_t; - } - else - { - NDArray nda = val.array_value (); - - if (! error_state) - { - octave_idx_type nel = nda.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - std::ostringstream buf; - buf << nda(i); - value[i] = buf.str (); - } - - stored_type = char_t; - } - else - { - error ("set: invalid string property value for \"%s\"", - get_name ().c_str ()); - - return false; - } - } - - return true; - } - -private: - string_vector value; - type stored_type; -}; - -// --------------------------------------------------------------------- - -class radio_values -{ -public: - OCTINTERP_API radio_values (const std::string& opt_string = std::string ()); - - radio_values (const radio_values& a) - : default_val (a.default_val), possible_vals (a.possible_vals) { } - - radio_values& operator = (const radio_values& a) - { - if (&a != this) - { - default_val = a.default_val; - possible_vals = a.possible_vals; - } - - return *this; - } - - std::string default_value (void) const { return default_val; } - - bool validate (const std::string& val, std::string& match) - { - bool retval = true; - - if (! contains (val, match)) - { - error ("invalid value = %s", val.c_str ()); - retval = false; - } - - return retval; - } - - bool contains (const std::string& val, std::string& match) - { - size_t k = 0; - - size_t len = val.length (); - - std::string first_match; - - for (std::set::const_iterator p = possible_vals.begin (); - p != possible_vals.end (); p++) - { - if (p->compare (val, len)) - { - if (len == p->length ()) - { - // We found a full match (consider the case of val == - // "replace" with possible values "replace" and - // "replacechildren"). Any other matches are - // irrelevant, so set match and return now. - - match = *p; - return true; - } - else - { - if (k == 0) - first_match = *p; - - k++; - } - } - } - - if (k == 1) - { - match = first_match; - return true; - } - else - return false; - } - - std::string values_as_string (void) const; - - Cell values_as_cell (void) const; - - octave_idx_type nelem (void) const { return possible_vals.size (); } - -private: - // Might also want to cache - std::string default_val; - std::set possible_vals; -}; - -class radio_property : public base_property -{ -public: - radio_property (const std::string& nm, const graphics_handle& h, - const radio_values& v = radio_values ()) - : base_property (nm, h), - vals (v), current_val (v.default_value ()) { } - - radio_property (const std::string& nm, const graphics_handle& h, - const std::string& v) - : base_property (nm, h), - vals (v), current_val (vals.default_value ()) { } - - radio_property (const std::string& nm, const graphics_handle& h, - const radio_values& v, const std::string& def) - : base_property (nm, h), - vals (v), current_val (def) { } - - radio_property (const radio_property& p) - : base_property (p), vals (p.vals), current_val (p.current_val) { } - - octave_value get (void) const { return octave_value (current_val); } - - const std::string& current_value (void) const { return current_val; } - - std::string values_as_string (void) const { return vals.values_as_string (); } - - Cell values_as_cell (void) const { return vals.values_as_cell (); } - - bool is (const caseless_str& v) const - { return v.compare (current_val); } - - bool is_radio (void) const { return true; } - - radio_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new radio_property (*this); } - -protected: - bool do_set (const octave_value& newval) - { - if (newval.is_string ()) - { - std::string s = newval.string_value (); - - std::string match; - - if (vals.validate (s, match)) - { - if (match != current_val) - { - if (s.length () != match.length ()) - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s value %s", - "set", s.c_str (), get_name ().c_str (), - match.c_str ()); - current_val = match; - return true; - } - } - else - error ("set: invalid value for radio property \"%s\" (value = %s)", - get_name ().c_str (), s.c_str ()); - } - else - error ("set: invalid value for radio property \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - radio_values vals; - std::string current_val; -}; - -// --------------------------------------------------------------------- - -class color_values -{ -public: - color_values (double r = 0, double g = 0, double b = 1) - : xrgb (1, 3) - { - xrgb(0) = r; - xrgb(1) = g; - xrgb(2) = b; - - validate (); - } - - color_values (std::string str) - : xrgb (1, 3) - { - if (! str2rgb (str)) - error ("invalid color specification: %s", str.c_str ()); - } - - color_values (const color_values& c) - : xrgb (c.xrgb) - { } - - color_values& operator = (const color_values& c) - { - if (&c != this) - xrgb = c.xrgb; - - return *this; - } - - bool operator == (const color_values& c) const - { - return (xrgb(0) == c.xrgb(0) - && xrgb(1) == c.xrgb(1) - && xrgb(2) == c.xrgb(2)); - } - - bool operator != (const color_values& c) const - { return ! (*this == c); } - - Matrix rgb (void) const { return xrgb; } - - operator octave_value (void) const { return xrgb; } - - void validate (void) const - { - for (int i = 0; i < 3; i++) - { - if (xrgb(i) < 0 || xrgb(i) > 1) - { - error ("invalid RGB color specification"); - break; - } - } - } - -private: - Matrix xrgb; - - OCTINTERP_API bool str2rgb (std::string str); -}; - -class color_property : public base_property -{ -public: - color_property (const color_values& c, const radio_values& v) - : base_property ("", graphics_handle ()), - current_type (color_t), color_val (c), radio_val (v), - current_val (v.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const color_values& c = color_values (), - const radio_values& v = radio_values ()) - : base_property (nm, h), - current_type (color_t), color_val (c), radio_val (v), - current_val (v.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const radio_values& v) - : base_property (nm, h), - current_type (radio_t), color_val (color_values ()), radio_val (v), - current_val (v.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const std::string& v) - : base_property (nm, h), - current_type (radio_t), color_val (color_values ()), radio_val (v), - current_val (radio_val.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const color_property& v) - : base_property (nm, h), - current_type (v.current_type), color_val (v.color_val), - radio_val (v.radio_val), current_val (v.current_val) - { } - - color_property (const color_property& p) - : base_property (p), current_type (p.current_type), - color_val (p.color_val), radio_val (p.radio_val), - current_val (p.current_val) { } - - octave_value get (void) const - { - if (current_type == color_t) - return color_val.rgb (); - - return current_val; - } - - bool is_rgb (void) const { return (current_type == color_t); } - - bool is_radio (void) const { return (current_type == radio_t); } - - bool is (const std::string& v) const - { return (is_radio () && current_val == v); } - - Matrix rgb (void) const - { - if (current_type != color_t) - error ("color has no rgb value"); - - return color_val.rgb (); - } - - const std::string& current_value (void) const - { - if (current_type != radio_t) - error ("color has no radio value"); - - return current_val; - } - - color_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - operator octave_value (void) const { return get (); } - - base_property* clone (void) const { return new color_property (*this); } - - std::string values_as_string (void) const { return radio_val.values_as_string (); } - - Cell values_as_cell (void) const { return radio_val.values_as_cell (); } - -protected: - OCTINTERP_API bool do_set (const octave_value& newval); - -private: - enum current_enum { color_t, radio_t } current_type; - color_values color_val; - radio_values radio_val; - std::string current_val; -}; - -// --------------------------------------------------------------------- - -class double_property : public base_property -{ -public: - double_property (const std::string& nm, const graphics_handle& h, - double d = 0) - : base_property (nm, h), - current_val (d) { } - - double_property (const double_property& p) - : base_property (p), current_val (p.current_val) { } - - octave_value get (void) const { return octave_value (current_val); } - - double double_value (void) const { return current_val; } - - double_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new double_property (*this); } - -protected: - bool do_set (const octave_value& v) - { - if (v.is_scalar_type () && v.is_real_type ()) - { - double new_val = v.double_value (); - - if (new_val != current_val) - { - current_val = new_val; - return true; - } - } - else - error ("set: invalid value for double property \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - double current_val; -}; - -// --------------------------------------------------------------------- - -class double_radio_property : public base_property -{ -public: - double_radio_property (double d, const radio_values& v) - : base_property ("", graphics_handle ()), - current_type (double_t), dval (d), radio_val (v), - current_val (v.default_value ()) - { } - - double_radio_property (const std::string& nm, const graphics_handle& h, - const std::string& v) - : base_property (nm, h), - current_type (radio_t), dval (0), radio_val (v), - current_val (radio_val.default_value ()) - { } - - double_radio_property (const std::string& nm, const graphics_handle& h, - const double_radio_property& v) - : base_property (nm, h), - current_type (v.current_type), dval (v.dval), - radio_val (v.radio_val), current_val (v.current_val) - { } - - double_radio_property (const double_radio_property& p) - : base_property (p), current_type (p.current_type), - dval (p.dval), radio_val (p.radio_val), - current_val (p.current_val) { } - - octave_value get (void) const - { - if (current_type == double_t) - return dval; - - return current_val; - } - - bool is_double (void) const { return (current_type == double_t); } - - bool is_radio (void) const { return (current_type == radio_t); } - - bool is (const std::string& v) const - { return (is_radio () && current_val == v); } - - double double_value (void) const - { - if (current_type != double_t) - error ("%s: property has no double", get_name ().c_str ()); - - return dval; - } - - const std::string& current_value (void) const - { - if (current_type != radio_t) - error ("%s: property has no radio value"); - - return current_val; - } - - double_radio_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - operator octave_value (void) const { return get (); } - - base_property* clone (void) const - { return new double_radio_property (*this); } - -protected: - OCTINTERP_API bool do_set (const octave_value& v); - -private: - enum current_enum { double_t, radio_t } current_type; - double dval; - radio_values radio_val; - std::string current_val; -}; - -// --------------------------------------------------------------------- - -class array_property : public base_property -{ -public: - array_property (void) - : base_property ("", graphics_handle ()), data (Matrix ()), - xmin (), xmax (), xminp (), xmaxp (), - type_constraints (), size_constraints () - { - get_data_limits (); - } - - array_property (const std::string& nm, const graphics_handle& h, - const octave_value& m) - : base_property (nm, h), data (m), - xmin (), xmax (), xminp (), xmaxp (), - type_constraints (), size_constraints () - { - get_data_limits (); - } - - // This copy constructor is only intended to be used - // internally to access min/max values; no need to - // copy constraints. - array_property (const array_property& p) - : base_property (p), data (p.data), - xmin (p.xmin), xmax (p.xmax), xminp (p.xminp), xmaxp (p.xmaxp), - type_constraints (), size_constraints () - { } - - octave_value get (void) const { return data; } - - void add_constraint (const std::string& type) - { type_constraints.push_back (type); } - - void add_constraint (const dim_vector& dims) - { size_constraints.push_back (dims); } - - double min_val (void) const { return xmin; } - double max_val (void) const { return xmax; } - double min_pos (void) const { return xminp; } - double max_neg (void) const { return xmaxp; } - - Matrix get_limits (void) const - { - Matrix m (1, 4); - - m(0) = min_val (); - m(1) = max_val (); - m(2) = min_pos (); - m(3) = max_neg (); - - return m; - } - - array_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const - { - array_property *p = new array_property (*this); - - p->type_constraints = type_constraints; - p->size_constraints = size_constraints; - - return p; - } - -protected: - bool do_set (const octave_value& v) - { - if (validate (v)) - { - // FIXME -- should we check for actual data change? - if (! is_equal (v)) - { - data = v; - - get_data_limits (); - - return true; - } - } - else - error ("invalid value for array property \"%s\"", - get_name ().c_str ()); - - return false; - } - -private: - OCTINTERP_API bool validate (const octave_value& v); - - OCTINTERP_API bool is_equal (const octave_value& v) const; - - OCTINTERP_API void get_data_limits (void); - -protected: - octave_value data; - double xmin; - double xmax; - double xminp; - double xmaxp; - std::list type_constraints; - std::list size_constraints; -}; - -class row_vector_property : public array_property -{ -public: - row_vector_property (const std::string& nm, const graphics_handle& h, - const octave_value& m) - : array_property (nm, h, m) - { - add_constraint (dim_vector (-1, 1)); - add_constraint (dim_vector (1, -1)); - } - - row_vector_property (const row_vector_property& p) - : array_property (p) - { - add_constraint (dim_vector (-1, 1)); - add_constraint (dim_vector (1, -1)); - } - - void add_constraint (const std::string& type) - { - array_property::add_constraint (type); - } - - void add_constraint (const dim_vector& dims) - { - array_property::add_constraint (dims); - } - - void add_constraint (octave_idx_type len) - { - size_constraints.remove (dim_vector (1, -1)); - size_constraints.remove (dim_vector (-1, 1)); - - add_constraint (dim_vector (1, len)); - add_constraint (dim_vector (len, 1)); - } - - row_vector_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const - { - row_vector_property *p = new row_vector_property (*this); - - p->type_constraints = type_constraints; - p->size_constraints = size_constraints; - - return p; - } - -protected: - bool do_set (const octave_value& v) - { - bool retval = array_property::do_set (v); - - if (! error_state) - { - dim_vector dv = data.dims (); - - if (dv(0) > 1 && dv(1) == 1) - { - int tmp = dv(0); - dv(0) = dv(1); - dv(1) = tmp; - - data = data.reshape (dv); - } - - return retval; - } - - return false; - } - -private: - OCTINTERP_API bool validate (const octave_value& v); -}; - -// --------------------------------------------------------------------- - -class bool_property : public radio_property -{ -public: - bool_property (const std::string& nm, const graphics_handle& h, - bool val) - : radio_property (nm, h, radio_values (val ? "{on}|off" : "on|{off}")) - { } - - bool_property (const std::string& nm, const graphics_handle& h, - const char* val) - : radio_property (nm, h, radio_values ("on|off"), val) - { } - - bool_property (const bool_property& p) - : radio_property (p) { } - - bool is_on (void) const { return is ("on"); } - - bool_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new bool_property (*this); } - -protected: - bool do_set (const octave_value& val) - { - if (val.is_bool_scalar ()) - return radio_property::do_set (val.bool_value () ? "on" : "off"); - else - return radio_property::do_set (val); - } -}; - -// --------------------------------------------------------------------- - -class handle_property : public base_property -{ -public: - handle_property (const std::string& nm, const graphics_handle& h, - const graphics_handle& val = graphics_handle ()) - : base_property (nm, h), - current_val (val) { } - - handle_property (const handle_property& p) - : base_property (p), current_val (p.current_val) { } - - octave_value get (void) const { return current_val.as_octave_value (); } - - graphics_handle handle_value (void) const { return current_val; } - - handle_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - handle_property& operator = (const graphics_handle& h) - { - set (octave_value (h.value ())); - return *this; - } - - base_property* clone (void) const { return new handle_property (*this); } - -protected: - OCTINTERP_API bool do_set (const octave_value& v); - -private: - graphics_handle current_val; -}; - -// --------------------------------------------------------------------- - -class any_property : public base_property -{ -public: - any_property (const std::string& nm, const graphics_handle& h, - const octave_value& m = Matrix ()) - : base_property (nm, h), data (m) { } - - any_property (const any_property& p) - : base_property (p), data (p.data) { } - - octave_value get (void) const { return data; } - - any_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new any_property (*this); } - -protected: - bool do_set (const octave_value& v) - { - data = v; - return true; - } - -private: - octave_value data; -}; - -// --------------------------------------------------------------------- - -class children_property : public base_property -{ -public: - children_property (void) - : base_property ("", graphics_handle ()), children_list () - { - do_init_children (Matrix ()); - } - - children_property (const std::string& nm, const graphics_handle& h, - const Matrix &val) - : base_property (nm, h), children_list () - { - do_init_children (val); - } - - children_property (const children_property& p) - : base_property (p), children_list () - { - do_init_children (p.children_list); - } - - children_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new children_property (*this); } - - bool remove_child (const double &val) - { - return do_remove_child (val); - } - - void adopt (const double &val) - { - do_adopt_child (val); - } - - Matrix get_children (void) const - { - return do_get_children (false); - } - - Matrix get_hidden (void) const - { - return do_get_children (true); - } - - Matrix get_all (void) const - { - return do_get_all_children (); - } - - octave_value get (void) const - { - return octave_value (get_children ()); - } - - void delete_children (bool clear = false) - { - do_delete_children (clear); - } - - void renumber (graphics_handle old_gh, graphics_handle new_gh) - { - for (children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - if (*p == old_gh) - { - *p = new_gh.value (); - return; - } - } - - error ("children_list::renumber: child not found!"); - } - -private: - typedef std::list::iterator children_list_iterator; - typedef std::list::const_iterator const_children_list_iterator; - std::list children_list; - -protected: - bool do_set (const octave_value& val) - { - const Matrix new_kids = val.matrix_value (); - - octave_idx_type nel = new_kids.numel (); - - const Matrix new_kids_column = new_kids.reshape (dim_vector (nel, 1)); - - bool is_ok = true; - - if (! error_state) - { - const Matrix visible_kids = do_get_children (false); - - if (visible_kids.numel () == new_kids.numel ()) - { - Matrix t1 = visible_kids.sort (); - Matrix t2 = new_kids_column.sort (); - - if (t1 != t2) - is_ok = false; - } - else - is_ok = false; - - if (! is_ok) - error ("set: new children must be a permutation of existing children"); - } - else - { - is_ok = false; - error ("set: expecting children to be array of graphics handles"); - } - - if (is_ok) - { - Matrix tmp = new_kids_column.stack (get_hidden ()); - - children_list.clear (); - - // Don't use do_init_children here, as that reverses the - // order of the list, and we don't want to do that if setting - // the child list directly. - - for (octave_idx_type i = 0; i < tmp.numel (); i++) - children_list.push_back (tmp.xelem (i)); - } - - return is_ok; - } - -private: - void do_init_children (const Matrix &val) - { - children_list.clear (); - for (octave_idx_type i = 0; i < val.numel (); i++) - children_list.push_front (val.xelem (i)); - } - - void do_init_children (const std::list &val) - { - children_list.clear (); - for (const_children_list_iterator p = val.begin (); p != val.end (); p++) - children_list.push_front (*p); - } - - Matrix do_get_children (bool return_hidden) const; - - Matrix do_get_all_children (void) const - { - Matrix retval (children_list.size (), 1); - octave_idx_type i = 0; - - for (const_children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - retval(i++) = *p; - return retval; - } - - bool do_remove_child (double child) - { - for (children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - if (*p == child) - { - children_list.erase (p); - return true; - } - } - return false; - } - - void do_adopt_child (const double &val) - { - children_list.push_front (val); - } - - void do_delete_children (bool clear); -}; - - - -// --------------------------------------------------------------------- - -class callback_property : public base_property -{ -public: - callback_property (const std::string& nm, const graphics_handle& h, - const octave_value& m) - : base_property (nm, h), callback (m), executing (false) { } - - callback_property (const callback_property& p) - : base_property (p), callback (p.callback), executing (false) { } - - octave_value get (void) const { return callback; } - - OCTINTERP_API void execute (const octave_value& data = octave_value ()) const; - - bool is_defined (void) const - { - return (callback.is_defined () && ! callback.is_empty ()); - } - - callback_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new callback_property (*this); } - -protected: - bool do_set (const octave_value& v) - { - if (validate (v)) - { - callback = v; - return true; - } - else - error ("invalid value for callback property \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - OCTINTERP_API bool validate (const octave_value& v) const; - -private: - octave_value callback; - - // If TRUE, we are executing this callback. - mutable bool executing; -}; - -// --------------------------------------------------------------------- - -class property -{ -public: - property (void) : rep (new base_property ("", graphics_handle ())) - { } - - property (base_property *bp, bool persist = false) : rep (bp) - { if (persist) rep->count++; } - - property (const property& p) : rep (p.rep) - { - rep->count++; - } - - ~property (void) - { - if (--rep->count == 0) - delete rep; - } - - bool ok (void) const - { return rep->ok (); } - - std::string get_name (void) const - { return rep->get_name (); } - - void set_name (const std::string& name) - { rep->set_name (name); } - - graphics_handle get_parent (void) const - { return rep->get_parent (); } - - void set_parent (const graphics_handle& h) - { rep->set_parent (h); } - - bool is_hidden (void) const - { return rep->is_hidden (); } - - void set_hidden (bool flag) - { rep->set_hidden (flag); } - - bool is_radio (void) const - { return rep->is_radio (); } - - int get_id (void) const - { return rep->get_id (); } - - void set_id (int d) - { rep->set_id (d); } - - octave_value get (void) const - { return rep->get (); } - - bool set (const octave_value& val, bool do_run = true, - bool do_notify_toolkit = true) - { return rep->set (val, do_run, do_notify_toolkit); } - - std::string values_as_string (void) const - { return rep->values_as_string (); } - - Cell values_as_cell (void) const - { return rep->values_as_cell (); } - - property& operator = (const octave_value& val) - { - *rep = val; - return *this; - } - - property& operator = (const property& p) - { - if (rep && --rep->count == 0) - delete rep; - - rep = p.rep; - rep->count++; - - return *this; - } - - void add_listener (const octave_value& v, listener_mode mode = POSTSET) - { rep->add_listener (v, mode); } - - void delete_listener (const octave_value& v = octave_value (), - listener_mode mode = POSTSET) - { rep->delete_listener (v, mode); } - - void run_listeners (listener_mode mode = POSTSET) - { rep->run_listeners (mode); } - - OCTINTERP_API static - property create (const std::string& name, const graphics_handle& parent, - const caseless_str& type, - const octave_value_list& args); - - property clone (void) const - { return property (rep->clone ()); } - - /* - const string_property& as_string_property (void) const - { return *(dynamic_cast (rep)); } - - const radio_property& as_radio_property (void) const - { return *(dynamic_cast (rep)); } - - const color_property& as_color_property (void) const - { return *(dynamic_cast (rep)); } - - const double_property& as_double_property (void) const - { return *(dynamic_cast (rep)); } - - const bool_property& as_bool_property (void) const - { return *(dynamic_cast (rep)); } - - const handle_property& as_handle_property (void) const - { return *(dynamic_cast (rep)); } - */ - -private: - base_property *rep; -}; - -// --------------------------------------------------------------------- - -class property_list -{ -public: - typedef std::map pval_map_type; - typedef std::map plist_map_type; - - typedef pval_map_type::iterator pval_map_iterator; - typedef pval_map_type::const_iterator pval_map_const_iterator; - - typedef plist_map_type::iterator plist_map_iterator; - typedef plist_map_type::const_iterator plist_map_const_iterator; - - property_list (const plist_map_type& m = plist_map_type ()) - : plist_map (m) { } - - ~property_list (void) { } - - void set (const caseless_str& name, const octave_value& val); - - octave_value lookup (const caseless_str& name) const; - - plist_map_iterator begin (void) { return plist_map.begin (); } - plist_map_const_iterator begin (void) const { return plist_map.begin (); } - - plist_map_iterator end (void) { return plist_map.end (); } - plist_map_const_iterator end (void) const { return plist_map.end (); } - - plist_map_iterator find (const std::string& go_name) - { - return plist_map.find (go_name); - } - - plist_map_const_iterator find (const std::string& go_name) const - { - return plist_map.find (go_name); - } - - octave_scalar_map as_struct (const std::string& prefix_arg) const; - -private: - plist_map_type plist_map; -}; - -// --------------------------------------------------------------------- - -class graphics_toolkit; -class graphics_object; - -class base_graphics_toolkit -{ -public: - friend class graphics_toolkit; - -public: - base_graphics_toolkit (const std::string& nm) - : name (nm), count (0) { } - - virtual ~base_graphics_toolkit (void) { } - - std::string get_name (void) const { return name; } - - virtual bool is_valid (void) const { return false; } - - virtual void redraw_figure (const graphics_object&) const - { gripe_invalid ("redraw_figure"); } - - virtual void print_figure (const graphics_object&, const std::string&, - const std::string&, bool, - const std::string& = "") const - { gripe_invalid ("print_figure"); } - - virtual Matrix get_canvas_size (const graphics_handle&) const - { - gripe_invalid ("get_canvas_size"); - return Matrix (1, 2, 0.0); - } - - virtual double get_screen_resolution (void) const - { - gripe_invalid ("get_screen_resolution"); - return 72.0; - } - - virtual Matrix get_screen_size (void) const - { - gripe_invalid ("get_screen_size"); - return Matrix (1, 2, 0.0); - } - - // Callback function executed when the given graphics object - // changes. This allows the graphics toolkit to act on property - // changes if needed. - virtual void update (const graphics_object&, int) - { gripe_invalid ("base_graphics_toolkit::update"); } - - void update (const graphics_handle&, int); - - // Callback function executed when the given graphics object is - // created. This allows the graphics toolkit to do toolkit-specific - // initializations for a newly created object. - virtual bool initialize (const graphics_object&) - { gripe_invalid ("base_graphics_toolkit::initialize"); return false; } - - bool initialize (const graphics_handle&); - - // Callback function executed just prior to deleting the given - // graphics object. This allows the graphics toolkit to perform - // toolkit-specific cleanup operations before an object is deleted. - virtual void finalize (const graphics_object&) - { gripe_invalid ("base_graphics_toolkit::finalize"); } - - void finalize (const graphics_handle&); - - // Close the graphics toolkit. - virtual void close (void) - { gripe_invalid ("base_graphics_toolkit::close"); } - -private: - std::string name; - octave_refcount count; - -private: - void gripe_invalid (const std::string& fname) const - { - if (! is_valid ()) - error ("%s: invalid graphics toolkit", fname.c_str ()); - } -}; - -class graphics_toolkit -{ -public: - graphics_toolkit (void) - : rep (new base_graphics_toolkit ("unknown")) - { - rep->count++; - } - - graphics_toolkit (base_graphics_toolkit* b) - : rep (b) - { - rep->count++; - } - - graphics_toolkit (const graphics_toolkit& b) - : rep (b.rep) - { - rep->count++; - } - - ~graphics_toolkit (void) - { - if (--rep->count == 0) - delete rep; - } - - graphics_toolkit& operator = (const graphics_toolkit& b) - { - if (rep != b.rep) - { - if (--rep->count == 0) - delete rep; - - rep = b.rep; - rep->count++; - } - - return *this; - } - - operator bool (void) const { return rep->is_valid (); } - - std::string get_name (void) const { return rep->get_name (); } - - void redraw_figure (const graphics_object& go) const - { rep->redraw_figure (go); } - - void print_figure (const graphics_object& go, const std::string& term, - const std::string& file, bool mono, - const std::string& debug_file = "") const - { rep->print_figure (go, term, file, mono, debug_file); } - - Matrix get_canvas_size (const graphics_handle& fh) const - { return rep->get_canvas_size (fh); } - - double get_screen_resolution (void) const - { return rep->get_screen_resolution (); } - - Matrix get_screen_size (void) const - { return rep->get_screen_size (); } - - // Notifies graphics toolkit that object't property has changed. - void update (const graphics_object& go, int id) - { rep->update (go, id); } - - void update (const graphics_handle& h, int id) - { rep->update (h, id); } - - // Notifies graphics toolkit that new object was created. - bool initialize (const graphics_object& go) - { return rep->initialize (go); } - - bool initialize (const graphics_handle& h) - { return rep->initialize (h); } - - // Notifies graphics toolkit that object was destroyed. - // This is called only for explicitly deleted object. Children are - // deleted implicitly and graphics toolkit isn't notified. - void finalize (const graphics_object& go) - { rep->finalize (go); } - - void finalize (const graphics_handle& h) - { rep->finalize (h); } - - // Close the graphics toolkit. - void close (void) { rep->close (); } - -private: - - base_graphics_toolkit *rep; -}; - -class gtk_manager -{ -public: - - static graphics_toolkit get_toolkit (void) - { - return instance_ok () ? instance->do_get_toolkit () : graphics_toolkit (); - } - - static void register_toolkit (const std::string& name) - { - if (instance_ok ()) - instance->do_register_toolkit (name); - } - - static void unregister_toolkit (const std::string& name) - { - if (instance_ok ()) - instance->do_unregister_toolkit (name); - } - - static void load_toolkit (const graphics_toolkit& tk) - { - if (instance_ok ()) - instance->do_load_toolkit (tk); - } - - static void unload_toolkit (const std::string& name) - { - if (instance_ok ()) - instance->do_unload_toolkit (name); - } - - static graphics_toolkit find_toolkit (const std::string& name) - { - return instance_ok () - ? instance->do_find_toolkit (name) : graphics_toolkit (); - } - - static Cell available_toolkits_list (void) - { - return instance_ok () ? instance->do_available_toolkits_list () : Cell (); - } - - static Cell loaded_toolkits_list (void) - { - return instance_ok () ? instance->do_loaded_toolkits_list () : Cell (); - } - - static void unload_all_toolkits (void) - { - if (instance_ok ()) - instance->do_unload_all_toolkits (); - } - - static std::string default_toolkit (void) - { - return instance_ok () ? instance->do_default_toolkit () : std::string (); - } - -private: - - // FIXME -- default toolkit should be configurable. - - gtk_manager (void) - : dtk ("gnuplot"), available_toolkits (), loaded_toolkits () { } - - ~gtk_manager (void) { } - - OCTINTERP_API static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create gh_manager!"); - - retval = false; - } - - return retval; - } - - static void cleanup_instance (void) { delete instance; instance = 0; } - - OCTINTERP_API static gtk_manager *instance; - - // The name of the default toolkit. - std::string dtk; - - // The list of toolkits that we know about. - std::set available_toolkits; - - // The list of toolkits we have actually loaded. - std::map loaded_toolkits; - - typedef std::set::iterator available_toolkits_iterator; - - typedef std::set::const_iterator - const_available_toolkits_iterator; - - typedef std::map::iterator - loaded_toolkits_iterator; - - typedef std::map::const_iterator - const_loaded_toolkits_iterator; - - graphics_toolkit do_get_toolkit (void) const; - - void do_register_toolkit (const std::string& name) - { - available_toolkits.insert (name); - } - - void do_unregister_toolkit (const std::string& name) - { - available_toolkits.erase (name); - } - - void do_load_toolkit (const graphics_toolkit& tk) - { - loaded_toolkits[tk.get_name ()] = tk; - } - - void do_unload_toolkit (const std::string& name) - { - loaded_toolkits.erase (name); - } - - graphics_toolkit do_find_toolkit (const std::string& name) const - { - const_loaded_toolkits_iterator p = loaded_toolkits.find (name); - - if (p != loaded_toolkits.end ()) - return p->second; - else - return graphics_toolkit (); - } - - Cell do_available_toolkits_list (void) const - { - Cell m (1 , available_toolkits.size ()); - - octave_idx_type i = 0; - for (const_available_toolkits_iterator p = available_toolkits.begin (); - p != available_toolkits.end (); p++) - m(i++) = *p; - - return m; - } - - Cell do_loaded_toolkits_list (void) const - { - Cell m (1 , loaded_toolkits.size ()); - - octave_idx_type i = 0; - for (const_loaded_toolkits_iterator p = loaded_toolkits.begin (); - p != loaded_toolkits.end (); p++) - m(i++) = p->first; - - return m; - } - - void do_unload_all_toolkits (void) - { - while (! loaded_toolkits.empty ()) - { - loaded_toolkits_iterator p = loaded_toolkits.begin (); - - std::string name = p->first; - - p->second.close (); - - // The toolkit may have unloaded itself. If not, we'll do - // it here. - if (loaded_toolkits.find (name) != loaded_toolkits.end ()) - unload_toolkit (name); - } - } - - std::string do_default_toolkit (void) { return dtk; } -}; - -// --------------------------------------------------------------------- - -class base_graphics_object; -class graphics_object; - -class OCTINTERP_API base_properties -{ -public: - base_properties (const std::string& ty = "unknown", - const graphics_handle& mh = graphics_handle (), - const graphics_handle& p = graphics_handle ()); - - virtual ~base_properties (void) { } - - virtual std::string graphics_object_name (void) const { return "unknonwn"; } - - void mark_modified (void); - - void override_defaults (base_graphics_object& obj); - - virtual void init_integerhandle (const octave_value&) - { - panic_impossible (); - } - - // Look through DEFAULTS for properties with given CLASS_NAME, and - // apply them to the current object with set (virtual method). - - void set_from_list (base_graphics_object& obj, property_list& defaults); - - void insert_property (const std::string& name, property p) - { - p.set_name (name); - p.set_parent (__myhandle__); - all_props[name] = p; - } - - virtual void set (const caseless_str&, const octave_value&); - - virtual octave_value get (const caseless_str& pname) const; - - virtual octave_value get (const std::string& pname) const - { - return get (caseless_str (pname)); - } - - virtual octave_value get (const char *pname) const - { - return get (caseless_str (pname)); - } - - virtual octave_value get (bool all = false) const; - - virtual property get_property (const caseless_str& pname); - - virtual bool has_property (const caseless_str&) const - { - panic_impossible (); - return false; - } - - bool is_modified (void) const { return is___modified__ (); } - - virtual void remove_child (const graphics_handle& h) - { - if (children.remove_child (h.value ())) - mark_modified (); - } - - virtual void adopt (const graphics_handle& h) - { - children.adopt (h.value ()); - mark_modified (); - } - - virtual graphics_toolkit get_toolkit (void) const; - - virtual Matrix get_boundingbox (bool /*internal*/ = false, - const Matrix& /*parent_pix_size*/ = Matrix ()) const - { return Matrix (1, 4, 0.0); } - - virtual void update_boundingbox (void); - - virtual void update_autopos (const std::string& elem_type); - - virtual void add_listener (const caseless_str&, const octave_value&, - listener_mode = POSTSET); - - virtual void delete_listener (const caseless_str&, const octave_value&, - listener_mode = POSTSET); - - void set_tag (const octave_value& val) { tag = val; } - - void set_parent (const octave_value& val); - - Matrix get_children (void) const - { - return children.get_children (); - } - - Matrix get_all_children (void) const - { - return children.get_all (); - } - - Matrix get_hidden_children (void) const - { - return children.get_hidden (); - } - - void set_modified (const octave_value& val) { set___modified__ (val); } - - void set___modified__ (const octave_value& val) { __modified__ = val; } - - void reparent (const graphics_handle& new_parent) { parent = new_parent; } - - // Update data limits for AXIS_TYPE (xdata, ydata, etc.) in the parent - // axes object. - - virtual void update_axis_limits (const std::string& axis_type) const; - - virtual void update_axis_limits (const std::string& axis_type, - const graphics_handle& h) const; - - virtual void delete_children (bool clear = false) - { - children.delete_children (clear); - } - - void renumber_child (graphics_handle old_gh, graphics_handle new_gh) - { - children.renumber (old_gh, new_gh); - } - - void renumber_parent (graphics_handle new_gh) - { - parent = new_gh; - } - - static property_list::pval_map_type factory_defaults (void); - - // FIXME -- these functions should be generated automatically by the - // genprops.awk script. - // - // EMIT_BASE_PROPERTIES_GET_FUNCTIONS - - virtual octave_value get_xlim (void) const { return octave_value (); } - virtual octave_value get_ylim (void) const { return octave_value (); } - virtual octave_value get_zlim (void) const { return octave_value (); } - virtual octave_value get_clim (void) const { return octave_value (); } - virtual octave_value get_alim (void) const { return octave_value (); } - - virtual bool is_xliminclude (void) const { return false; } - virtual bool is_yliminclude (void) const { return false; } - virtual bool is_zliminclude (void) const { return false; } - virtual bool is_climinclude (void) const { return false; } - virtual bool is_aliminclude (void) const { return false; } - - bool is_handle_visible (void) const; - - std::set dynamic_property_names (void) const; - - bool has_dynamic_property (const std::string& pname); - -protected: - std::set dynamic_properties; - - void set_dynamic (const caseless_str& pname, const octave_value& val); - - octave_value get_dynamic (const caseless_str& pname) const; - - octave_value get_dynamic (bool all = false) const; - - property get_property_dynamic (const caseless_str& pname); - - BEGIN_BASE_PROPERTIES - // properties common to all objects - bool_property beingdeleted , "off" - radio_property busyaction , "{queue}|cancel" - callback_property buttondownfcn , Matrix () - children_property children gf , Matrix () - bool_property clipping , "on" - callback_property createfcn , Matrix () - callback_property deletefcn , Matrix () - radio_property handlevisibility , "{on}|callback|off" - bool_property hittest , "on" - bool_property interruptible , "on" - handle_property parent fs , p - bool_property selected , "off" - bool_property selectionhighlight , "on" - string_property tag s , "" - string_property type frs , ty - any_property userdata , Matrix () - bool_property visible , "on" - // additional (octave-specific) properties - bool_property __modified__ s , "on" - graphics_handle __myhandle__ fhrs , mh - // FIXME -- should this really be here? - handle_property uicontextmenu , graphics_handle () - END_PROPERTIES - -protected: - struct cmp_caseless_str - { - bool operator () (const caseless_str &a, const caseless_str &b) const - { - std::string a1 = a; - std::transform (a1.begin (), a1.end (), a1.begin (), tolower); - std::string b1 = b; - std::transform (b1.begin (), b1.end (), b1.begin (), tolower); - - return a1 < b1; - } - }; - - std::map all_props; - -protected: - void insert_static_property (const std::string& name, base_property& p) - { insert_property (name, property (&p, true)); } - - virtual void init (void) { } -}; - -class OCTINTERP_API base_graphics_object -{ -public: - friend class graphics_object; - - base_graphics_object (void) : count (1), toolkit_flag (false) { } - - virtual ~base_graphics_object (void) { } - - virtual void mark_modified (void) - { - if (valid_object ()) - get_properties ().mark_modified (); - else - error ("base_graphics_object::mark_modified: invalid graphics object"); - } - - virtual void override_defaults (base_graphics_object& obj) - { - if (valid_object ()) - get_properties ().override_defaults (obj); - else - error ("base_graphics_object::override_defaults: invalid graphics object"); - } - - virtual void set_from_list (property_list& plist) - { - if (valid_object ()) - get_properties ().set_from_list (*this, plist); - else - error ("base_graphics_object::set_from_list: invalid graphics object"); - } - - virtual void set (const caseless_str& pname, const octave_value& pval) - { - if (valid_object ()) - get_properties ().set (pname, pval); - else - error ("base_graphics_object::set: invalid graphics object"); - } - - virtual void set_defaults (const std::string&) - { - error ("base_graphics_object::set_defaults: invalid graphics object"); - } - - virtual octave_value get (bool all = false) const - { - if (valid_object ()) - return get_properties ().get (all); - else - { - error ("base_graphics_object::get: invalid graphics object"); - return octave_value (); - } - } - - virtual octave_value get (const caseless_str& pname) const - { - if (valid_object ()) - return get_properties ().get (pname); - else - { - error ("base_graphics_object::get: invalid graphics object"); - return octave_value (); - } - } - - virtual octave_value get_default (const caseless_str&) const; - - virtual octave_value get_factory_default (const caseless_str&) const; - - virtual octave_value get_defaults (void) const - { - error ("base_graphics_object::get_defaults: invalid graphics object"); - return octave_value (); - } - - virtual octave_value get_factory_defaults (void) const - { - error ("base_graphics_object::get_factory_defaults: invalid graphics object"); - return octave_value (); - } - - virtual std::string values_as_string (void); - - virtual octave_scalar_map values_as_struct (void); - - virtual graphics_handle get_parent (void) const - { - if (valid_object ()) - return get_properties ().get_parent (); - else - { - error ("base_graphics_object::get_parent: invalid graphics object"); - return graphics_handle (); - } - } - - graphics_handle get_handle (void) const - { - if (valid_object ()) - return get_properties ().get___myhandle__ (); - else - { - error ("base_graphics_object::get_handle: invalid graphics object"); - return graphics_handle (); - } - } - - virtual void remove_child (const graphics_handle& h) - { - if (valid_object ()) - get_properties ().remove_child (h); - else - error ("base_graphics_object::remove_child: invalid graphics object"); - } - - virtual void adopt (const graphics_handle& h) - { - if (valid_object ()) - get_properties ().adopt (h); - else - error ("base_graphics_object::adopt: invalid graphics object"); - } - - virtual void reparent (const graphics_handle& np) - { - if (valid_object ()) - get_properties ().reparent (np); - else - error ("base_graphics_object::reparent: invalid graphics object"); - } - - virtual void defaults (void) const - { - if (valid_object ()) - { - std::string msg = (type () + "::defaults"); - gripe_not_implemented (msg.c_str ()); - } - else - error ("base_graphics_object::default: invalid graphics object"); - } - - virtual base_properties& get_properties (void) - { - static base_properties properties; - error ("base_graphics_object::get_properties: invalid graphics object"); - return properties; - } - - virtual const base_properties& get_properties (void) const - { - static base_properties properties; - error ("base_graphics_object::get_properties: invalid graphics object"); - return properties; - } - - virtual void update_axis_limits (const std::string& axis_type); - - virtual void update_axis_limits (const std::string& axis_type, - const graphics_handle& h); - - virtual bool valid_object (void) const { return false; } - - bool valid_toolkit_object (void) const { return toolkit_flag; } - - virtual std::string type (void) const - { - return (valid_object () ? get_properties ().graphics_object_name () - : "unknown"); - } - - bool isa (const std::string& go_name) const - { - return type () == go_name; - } - - virtual graphics_toolkit get_toolkit (void) const - { - if (valid_object ()) - return get_properties ().get_toolkit (); - else - { - error ("base_graphics_object::get_toolkit: invalid graphics object"); - return graphics_toolkit (); - } - } - - virtual void add_property_listener (const std::string& nm, - const octave_value& v, - listener_mode mode = POSTSET) - { - if (valid_object ()) - get_properties ().add_listener (nm, v, mode); - } - - virtual void delete_property_listener (const std::string& nm, - const octave_value& v, - listener_mode mode = POSTSET) - { - if (valid_object ()) - get_properties ().delete_listener (nm, v, mode); - } - - virtual void remove_all_listeners (void); - - virtual void reset_default_properties (void) - { - if (valid_object ()) - { - std::string msg = (type () + "::reset_default_properties"); - gripe_not_implemented (msg.c_str ()); - } - else - error ("base_graphics_object::default: invalid graphics object"); - } - -protected: - virtual void initialize (const graphics_object& go) - { - if (! toolkit_flag) - toolkit_flag = get_toolkit ().initialize (go); - } - - virtual void finalize (const graphics_object& go) - { - if (toolkit_flag) - { - get_toolkit ().finalize (go); - toolkit_flag = false; - } - } - - virtual void update (const graphics_object& go, int id) - { - if (toolkit_flag) - get_toolkit ().update (go, id); - } - -protected: - // A reference count. - octave_refcount count; - - // A flag telling whether this object is a valid object - // in the backend context. - bool toolkit_flag; - - // No copying! - - base_graphics_object (const base_graphics_object&) : count (0) { } - - base_graphics_object& operator = (const base_graphics_object&) - { - return *this; - } -}; - -class OCTINTERP_API graphics_object -{ -public: - graphics_object (void) : rep (new base_graphics_object ()) { } - - graphics_object (base_graphics_object *new_rep) - : rep (new_rep) { } - - graphics_object (const graphics_object& obj) : rep (obj.rep) - { - rep->count++; - } - - graphics_object& operator = (const graphics_object& obj) - { - if (rep != obj.rep) - { - if (--rep->count == 0) - delete rep; - - rep = obj.rep; - rep->count++; - } - - return *this; - } - - ~graphics_object (void) - { - if (--rep->count == 0) - delete rep; - } - - void mark_modified (void) { rep->mark_modified (); } - - void override_defaults (base_graphics_object& obj) - { - rep->override_defaults (obj); - } - - void set_from_list (property_list& plist) { rep->set_from_list (plist); } - - void set (const caseless_str& name, const octave_value& val) - { - rep->set (name, val); - } - - void set (const octave_value_list& args); - - void set (const Array& names, const Cell& values, - octave_idx_type row); - - void set (const octave_map& m); - - void set_value_or_default (const caseless_str& name, - const octave_value& val); - - void set_defaults (const std::string& mode) { rep->set_defaults (mode); } - - octave_value get (bool all = false) const { return rep->get (all); } - - octave_value get (const caseless_str& name) const - { - return name.compare ("default") - ? get_defaults () - : (name.compare ("factory") - ? get_factory_defaults () : rep->get (name)); - } - - octave_value get (const std::string& name) const - { - return get (caseless_str (name)); - } - - octave_value get (const char *name) const - { - return get (caseless_str (name)); - } - - octave_value get_default (const caseless_str& name) const - { - return rep->get_default (name); - } - - octave_value get_factory_default (const caseless_str& name) const - { - return rep->get_factory_default (name); - } - - octave_value get_defaults (void) const { return rep->get_defaults (); } - - octave_value get_factory_defaults (void) const - { - return rep->get_factory_defaults (); - } - - std::string values_as_string (void) { return rep->values_as_string (); } - - octave_map values_as_struct (void) { return rep->values_as_struct (); } - - graphics_handle get_parent (void) const { return rep->get_parent (); } - - graphics_handle get_handle (void) const { return rep->get_handle (); } - - graphics_object get_ancestor (const std::string& type) const; - - void remove_child (const graphics_handle& h) { rep->remove_child (h); } - - void adopt (const graphics_handle& h) { rep->adopt (h); } - - void reparent (const graphics_handle& h) { rep->reparent (h); } - - void defaults (void) const { rep->defaults (); } - - bool isa (const std::string& go_name) const { return rep->isa (go_name); } - - base_properties& get_properties (void) { return rep->get_properties (); } - - const base_properties& get_properties (void) const - { - return rep->get_properties (); - } - - void update_axis_limits (const std::string& axis_type) - { - rep->update_axis_limits (axis_type); - } - - void update_axis_limits (const std::string& axis_type, - const graphics_handle& h) - { - rep->update_axis_limits (axis_type, h); - } - - bool valid_object (void) const { return rep->valid_object (); } - - std::string type (void) const { return rep->type (); } - - operator bool (void) const { return rep->valid_object (); } - - // FIXME -- these functions should be generated automatically by the - // genprops.awk script. - // - // EMIT_GRAPHICS_OBJECT_GET_FUNCTIONS - - octave_value get_xlim (void) const - { return get_properties ().get_xlim (); } - - octave_value get_ylim (void) const - { return get_properties ().get_ylim (); } - - octave_value get_zlim (void) const - { return get_properties ().get_zlim (); } - - octave_value get_clim (void) const - { return get_properties ().get_clim (); } - - octave_value get_alim (void) const - { return get_properties ().get_alim (); } - - bool is_xliminclude (void) const - { return get_properties ().is_xliminclude (); } - - bool is_yliminclude (void) const - { return get_properties ().is_yliminclude (); } - - bool is_zliminclude (void) const - { return get_properties ().is_zliminclude (); } - - bool is_climinclude (void) const - { return get_properties ().is_climinclude (); } - - bool is_aliminclude (void) const - { return get_properties ().is_aliminclude (); } - - bool is_handle_visible (void) const - { return get_properties ().is_handle_visible (); } - - graphics_toolkit get_toolkit (void) const { return rep->get_toolkit (); } - - void add_property_listener (const std::string& nm, const octave_value& v, - listener_mode mode = POSTSET) - { rep->add_property_listener (nm, v, mode); } - - void delete_property_listener (const std::string& nm, const octave_value& v, - listener_mode mode = POSTSET) - { rep->delete_property_listener (nm, v, mode); } - - void initialize (void) { rep->initialize (*this); } - - void finalize (void) { rep->finalize (*this); } - - void update (int id) { rep->update (*this, id); } - - void reset_default_properties (void) - { rep->reset_default_properties (); } - -private: - base_graphics_object *rep; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API root_figure : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void remove_child (const graphics_handle& h); - - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - // FIXME -- it seems strange to me that the diary, diaryfile, - // echo, format, formatspacing, language, and recursionlimit - // properties are here. WTF do they have to do with graphics? - // Also note that these properties (and the monitorpositions, - // pointerlocation, and pointerwindow properties) are not yet used - // by Octave, so setting them will have no effect, and changes - // made elswhere (say, the diary or format functions) will not - // cause these properties to be updated. - - BEGIN_PROPERTIES (root_figure, root) - handle_property callbackobject Sr , graphics_handle () - array_property commandwindowsize r , Matrix (1, 2, 0) - handle_property currentfigure S , graphics_handle () - bool_property diary , "off" - string_property diaryfile , "diary" - bool_property echo , "off" - radio_property format , "+|bank|bit|debug|hex|long|longe|longeng|longg|native-bit|native-hex|rational|{short}|shorte|shorteng|shortg" - radio_property formatspacing , "{loose}|compact" - string_property language , "ascii" - array_property monitorpositions , Matrix (1, 4, 0) - array_property pointerlocation , Matrix (1, 2, 0) - double_property pointerwindow , 0.0 - double_property recursionlimit , 256.0 - double_property screendepth r , default_screendepth () - double_property screenpixelsperinch r , default_screenpixelsperinch () - array_property screensize r , default_screensize () - bool_property showhiddenhandles , "off" - radio_property units U , "inches|centimeters|normalized|points|{pixels}" - END_PROPERTIES - - private: - std::list cbo_stack; - }; - -private: - properties xproperties; - -public: - - root_figure (void) : xproperties (0, graphics_handle ()), default_properties () { } - - ~root_figure (void) { } - - void mark_modified (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - if (name.compare ("default", 7)) - return get_default (name.substr (7)); - else if (name.compare ("factory", 7)) - return get_factory_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const - { - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - // no default property found, use factory default - retval = factory_properties.lookup (name); - - if (retval.is_undefined ()) - error ("get: invalid default property `%s'", name.c_str ()); - } - - return retval; - } - - octave_value get_factory_default (const caseless_str& name) const - { - octave_value retval = factory_properties.lookup (name); - - if (retval.is_undefined ()) - error ("get: invalid factory default property `%s'", name.c_str ()); - - return retval; - } - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - octave_value get_factory_defaults (void) const - { - return factory_properties.as_struct ("factory"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -private: - property_list default_properties; - - static property_list factory_properties; - - static property_list::plist_map_type init_factory_properties (void); -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API figure : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void init_integerhandle (const octave_value& val) - { - integerhandle = val; - } - - void remove_child (const graphics_handle& h); - - void set_visible (const octave_value& val); - - graphics_toolkit get_toolkit (void) const - { - if (! toolkit) - toolkit = gtk_manager::get_toolkit (); - - return toolkit; - } - - void set_toolkit (const graphics_toolkit& b); - - void set___graphics_toolkit__ (const octave_value& val) - { - if (! error_state) - { - if (val.is_string ()) - { - std::string nm = val.string_value (); - graphics_toolkit b = gtk_manager::find_toolkit (nm); - if (b.get_name () != nm) - { - error ("set___graphics_toolkit__: invalid graphics toolkit"); - } - else - { - set_toolkit (b); - mark_modified (); - } - } - else - error ("set___graphics_toolkit__ must be a string"); - } - } - - void set_position (const octave_value& val, - bool do_notify_toolkit = true); - - void set_outerposition (const octave_value& val, - bool do_notify_toolkit = true); - - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - void set_boundingbox (const Matrix& bb, bool internal = false, - bool do_notify_toolkit = true); - - Matrix map_from_boundingbox (double x, double y) const; - - Matrix map_to_boundingbox (double x, double y) const; - - void update_units (const caseless_str& old_units); - - void update_paperunits (const caseless_str& old_paperunits); - - std::string get_title (void) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (figure) - any_property __plot_stream__ h , Matrix () - bool_property __enhanced__ h , "on" - radio_property nextplot , "new|{add}|replacechildren|replace" - callback_property closerequestfcn , "closereq" - handle_property currentaxes S , graphics_handle () - array_property colormap , jet_colormap () - radio_property paperorientation U , "{portrait}|landscape|rotated" - color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) - array_property alphamap , Matrix (64, 1, 1) - string_property currentcharacter r , "" - handle_property currentobject r , graphics_handle () - array_property currentpoint r , Matrix (2, 1, 0) - bool_property dockcontrols , "off" - bool_property doublebuffer , "on" - string_property filename , "" - bool_property integerhandle S , "on" - bool_property inverthardcopy , "off" - callback_property keypressfcn , Matrix () - callback_property keyreleasefcn , Matrix () - radio_property menubar , "none|{figure}" - double_property mincolormap , 64 - string_property name , "" - bool_property numbertitle , "on" - array_property outerposition s , Matrix (1, 4, -1.0) - radio_property paperunits Su , "{inches}|centimeters|normalized|points" - array_property paperposition , default_figure_paperposition () - radio_property paperpositionmode , "auto|{manual}" - array_property papersize U , default_figure_papersize () - radio_property papertype SU , "{usletter}|uslegal|a0|a1|a2|a3|a4|a5|b0|b1|b2|b3|b4|b5|arch-a|arch-b|arch-c|arch-d|arch-e|a|b|c|d|e|tabloid|" - radio_property pointer , "crosshair|fullcrosshair|{arrow}|ibeam|watch|topl|topr|botl|botr|left|top|right|bottom|circle|cross|fleur|custom|hand" - array_property pointershapecdata , Matrix (16, 16, 0) - array_property pointershapehotspot , Matrix (1, 2, 0) - array_property position s , default_figure_position () - radio_property renderer , "{painters}|zbuffer|opengl|none" - radio_property renderermode , "{auto}|manual" - bool_property resize , "on" - callback_property resizefcn , Matrix () - radio_property selectiontype , "{normal}|open|alt|extend" - radio_property toolbar , "none|{auto}|figure" - radio_property units Su , "inches|centimeters|normalized|points|{pixels}|characters" - callback_property windowbuttondownfcn , Matrix () - callback_property windowbuttonmotionfcn , Matrix () - callback_property windowbuttonupfcn , Matrix () - callback_property windowbuttonwheelfcn , Matrix () - radio_property windowstyle , "{normal}|modal|docked" - string_property wvisual , "" - radio_property wvisualmode , "{auto}|manual" - string_property xdisplay , "" - string_property xvisual , "" - radio_property xvisualmode , "{auto}|manual" - callback_property buttondownfcn , Matrix () - string_property __graphics_toolkit__ s , "gnuplot" - any_property __guidata__ h , Matrix () - END_PROPERTIES - - protected: - void init (void) - { - colormap.add_constraint (dim_vector (-1, 3)); - alphamap.add_constraint (dim_vector (-1, 1)); - paperposition.add_constraint (dim_vector (1, 4)); - pointershapecdata.add_constraint (dim_vector (16, 16)); - pointershapehotspot.add_constraint (dim_vector (1, 2)); - position.add_constraint (dim_vector (1, 4)); - outerposition.add_constraint (dim_vector (1, 4)); - } - - private: - mutable graphics_toolkit toolkit; - }; - -private: - properties xproperties; - -public: - figure (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p), default_properties () - { - xproperties.override_defaults (*this); - } - - ~figure (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Allow parent (root figure) to override first (properties knows how - // to find the parent object). - xproperties.override_defaults (obj); - - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - if (name.compare ("default", 7)) - retval = get_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const; - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -private: - property_list default_properties; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API graphics_xform -{ -public: - graphics_xform (void) - : xform (xform_eye ()), xform_inv (xform_eye ()), - sx ("linear"), sy ("linear"), sz ("linear"), zlim (1, 2, 0.0) - { - zlim(1) = 1.0; - } - - graphics_xform (const Matrix& xm, const Matrix& xim, - const scaler& x, const scaler& y, const scaler& z, - const Matrix& zl) - : xform (xm), xform_inv (xim), sx (x), sy (y), sz (z), zlim (zl) { } - - graphics_xform (const graphics_xform& g) - : xform (g.xform), xform_inv (g.xform_inv), sx (g.sx), - sy (g.sy), sz (g.sz), zlim (g.zlim) { } - - ~graphics_xform (void) { } - - graphics_xform& operator = (const graphics_xform& g) - { - xform = g.xform; - xform_inv = g.xform_inv; - sx = g.sx; - sy = g.sy; - sz = g.sz; - zlim = g.zlim; - - return *this; - } - - static ColumnVector xform_vector (double x, double y, double z); - - static Matrix xform_eye (void); - - ColumnVector transform (double x, double y, double z, - bool use_scale = true) const; - - ColumnVector untransform (double x, double y, double z, - bool use_scale = true) const; - - ColumnVector untransform (double x, double y, bool use_scale = true) const - { return untransform (x, y, (zlim(0)+zlim(1))/2, use_scale); } - - Matrix xscale (const Matrix& m) const { return sx.scale (m); } - Matrix yscale (const Matrix& m) const { return sy.scale (m); } - Matrix zscale (const Matrix& m) const { return sz.scale (m); } - - Matrix scale (const Matrix& m) const - { - bool has_z = (m.columns () > 2); - - if (sx.is_linear () && sy.is_linear () - && (! has_z || sz.is_linear ())) - return m; - - Matrix retval (m.dims ()); - - int r = m.rows (); - - for (int i = 0; i < r; i++) - { - retval(i,0) = sx.scale (m(i,0)); - retval(i,1) = sy.scale (m(i,1)); - if (has_z) - retval(i,2) = sz.scale (m(i,2)); - } - - return retval; - } - -private: - Matrix xform; - Matrix xform_inv; - scaler sx, sy, sz; - Matrix zlim; -}; - -enum { - AXE_ANY_DIR = 0, - AXE_DEPTH_DIR = 1, - AXE_HORZ_DIR = 2, - AXE_VERT_DIR = 3 -}; - -class OCTINTERP_API axes : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void set_defaults (base_graphics_object& obj, const std::string& mode); - - void remove_child (const graphics_handle& h); - - const scaler& get_x_scaler (void) const { return sx; } - const scaler& get_y_scaler (void) const { return sy; } - const scaler& get_z_scaler (void) const { return sz; } - - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - Matrix get_extent (bool with_text = false, bool only_text_height=false) const; - - double get_fontsize_points (double box_pix_height = 0) const; - - void update_boundingbox (void) - { - if (units_is ("normalized")) - { - sync_positions (); - base_properties::update_boundingbox (); - } - } - - void update_camera (void); - void update_axes_layout (void); - void update_aspectratios (void); - void update_transform (void) - { - update_aspectratios (); - update_camera (); - update_axes_layout (); - } - - void update_autopos (const std::string& elem_type); - void update_xlabel_position (void); - void update_ylabel_position (void); - void update_zlabel_position (void); - void update_title_position (void); - - graphics_xform get_transform (void) const - { return graphics_xform (x_render, x_render_inv, sx, sy, sz, x_zlim); } - - Matrix get_transform_matrix (void) const { return x_render; } - Matrix get_inverse_transform_matrix (void) const { return x_render_inv; } - Matrix get_opengl_matrix_1 (void) const { return x_gl_mat1; } - Matrix get_opengl_matrix_2 (void) const { return x_gl_mat2; } - Matrix get_transform_zlim (void) const { return x_zlim; } - - int get_xstate (void) const { return xstate; } - int get_ystate (void) const { return ystate; } - int get_zstate (void) const { return zstate; } - double get_xPlane (void) const { return xPlane; } - double get_xPlaneN (void) const { return xPlaneN; } - double get_yPlane (void) const { return yPlane; } - double get_yPlaneN (void) const { return yPlaneN; } - double get_zPlane (void) const { return zPlane; } - double get_zPlaneN (void) const { return zPlaneN; } - double get_xpTick (void) const { return xpTick; } - double get_xpTickN (void) const { return xpTickN; } - double get_ypTick (void) const { return ypTick; } - double get_ypTickN (void) const { return ypTickN; } - double get_zpTick (void) const { return zpTick; } - double get_zpTickN (void) const { return zpTickN; } - double get_x_min (void) const { return std::min (xPlane, xPlaneN); } - double get_x_max (void) const { return std::max (xPlane, xPlaneN); } - double get_y_min (void) const { return std::min (yPlane, yPlaneN); } - double get_y_max (void) const { return std::max (yPlane, yPlaneN); } - double get_z_min (void) const { return std::min (zPlane, zPlaneN); } - double get_z_max (void) const { return std::max (zPlane, zPlaneN); } - double get_fx (void) const { return fx; } - double get_fy (void) const { return fy; } - double get_fz (void) const { return fz; } - double get_xticklen (void) const { return xticklen; } - double get_yticklen (void) const { return yticklen; } - double get_zticklen (void) const { return zticklen; } - double get_xtickoffset (void) const { return xtickoffset; } - double get_ytickoffset (void) const { return ytickoffset; } - double get_ztickoffset (void) const { return ztickoffset; } - bool get_x2Dtop (void) const { return x2Dtop; } - bool get_y2Dright (void) const { return y2Dright; } - bool get_layer2Dtop (void) const { return layer2Dtop; } - bool get_xySym (void) const { return xySym; } - bool get_xyzSym (void) const { return xyzSym; } - bool get_zSign (void) const { return zSign; } - bool get_nearhoriz (void) const { return nearhoriz; } - - ColumnVector pixel2coord (double px, double py) const - { return get_transform ().untransform (px, py, (x_zlim(0)+x_zlim(1))/2); } - - ColumnVector coord2pixel (double x, double y, double z) const - { return get_transform ().transform (x, y, z); } - - void zoom_about_point (double x, double y, double factor, - bool push_to_zoom_stack = true); - void zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack = true); - void translate_view (double x0, double x1, double y0, double y1); - void rotate_view (double delta_az, double delta_el); - void unzoom (void); - void clear_zoom_stack (void); - - void update_units (const caseless_str& old_units); - - void update_fontunits (const caseless_str& old_fontunits); - - private: - scaler sx, sy, sz; - Matrix x_render, x_render_inv; - Matrix x_gl_mat1, x_gl_mat2; - Matrix x_zlim; - std::list zoom_stack; - - // Axes layout data - int xstate, ystate, zstate; - double xPlane, xPlaneN, yPlane, yPlaneN, zPlane, zPlaneN; - double xpTick, xpTickN, ypTick, ypTickN, zpTick, zpTickN; - double fx, fy, fz; - double xticklen, yticklen, zticklen; - double xtickoffset, ytickoffset, ztickoffset; - bool x2Dtop, y2Dright, layer2Dtop; - bool xySym, xyzSym, zSign, nearhoriz; - -#if HAVE_FREETYPE - // freetype renderer, used for calculation of text (tick labels) size - ft_render text_renderer; -#endif - - void set_text_child (handle_property& h, const std::string& who, - const octave_value& v); - - void delete_text_child (handle_property& h); - - // See the genprops.awk script for an explanation of the - // properties declarations. - - // properties which are not in matlab: interpreter - - BEGIN_PROPERTIES (axes) - array_property position u , default_axes_position () - bool_property box , "on" - array_property colororder , default_colororder () - array_property dataaspectratio mu , Matrix (1, 3, 1.0) - radio_property dataaspectratiomode u , "{auto}|manual" - radio_property layer u , "{bottom}|top" - row_vector_property xlim mu , default_lim () - row_vector_property ylim mu , default_lim () - row_vector_property zlim mu , default_lim () - row_vector_property clim m , default_lim () - row_vector_property alim m , default_lim () - radio_property xlimmode al , "{auto}|manual" - radio_property ylimmode al , "{auto}|manual" - radio_property zlimmode al , "{auto}|manual" - radio_property climmode al , "{auto}|manual" - radio_property alimmode , "{auto}|manual" - handle_property xlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - handle_property ylabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - handle_property zlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - handle_property title SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - bool_property xgrid , "off" - bool_property ygrid , "off" - bool_property zgrid , "off" - bool_property xminorgrid , "off" - bool_property yminorgrid , "off" - bool_property zminorgrid , "off" - row_vector_property xtick mu , default_axes_tick () - row_vector_property ytick mu , default_axes_tick () - row_vector_property ztick mu , default_axes_tick () - radio_property xtickmode u , "{auto}|manual" - radio_property ytickmode u , "{auto}|manual" - radio_property ztickmode u , "{auto}|manual" - bool_property xminortick , "off" - bool_property yminortick , "off" - bool_property zminortick , "off" - // FIXME -- should be kind of string array. - any_property xticklabel m , "" - any_property yticklabel m , "" - any_property zticklabel m , "" - radio_property xticklabelmode u , "{auto}|manual" - radio_property yticklabelmode u , "{auto}|manual" - radio_property zticklabelmode u , "{auto}|manual" - radio_property interpreter , "tex|{none}|latex" - color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) - color_property xcolor , color_values (0, 0, 0) - color_property ycolor , color_values (0, 0, 0) - color_property zcolor , color_values (0, 0, 0) - radio_property xscale alu , "{linear}|log" - radio_property yscale alu , "{linear}|log" - radio_property zscale alu , "{linear}|log" - radio_property xdir u , "{normal}|reverse" - radio_property ydir u , "{normal}|reverse" - radio_property zdir u , "{normal}|reverse" - radio_property yaxislocation u , "{left}|right|zero" - radio_property xaxislocation u , "{bottom}|top|zero" - array_property view u , Matrix () - bool_property __hold_all__ h , "off" - radio_property nextplot , "new|add|replacechildren|{replace}" - array_property outerposition u , default_axes_outerposition () - radio_property activepositionproperty , "{outerposition}|position" - color_property ambientlightcolor , color_values (1, 1, 1) - array_property cameraposition m , Matrix (1, 3, 0.0) - array_property cameratarget m , Matrix (1, 3, 0.0) - array_property cameraupvector m , Matrix () - double_property cameraviewangle m , 10.0 - radio_property camerapositionmode , "{auto}|manual" - radio_property cameratargetmode , "{auto}|manual" - radio_property cameraupvectormode , "{auto}|manual" - radio_property cameraviewanglemode , "{auto}|manual" - array_property currentpoint , Matrix (2, 3, 0.0) - radio_property drawmode , "{normal}|fast" - radio_property fontangle u , "{normal}|italic|oblique" - string_property fontname u , OCTAVE_DEFAULT_FONTNAME - double_property fontsize u , 10 - radio_property fontunits SU , "{points}|normalized|inches|centimeters|pixels" - radio_property fontweight u , "{normal}|light|demi|bold" - radio_property gridlinestyle , "-|--|{:}|-.|none" - string_array_property linestyleorder , "-" - double_property linewidth , 0.5 - radio_property minorgridlinestyle , "-|--|{:}|-.|none" - array_property plotboxaspectratio mu , Matrix (1, 3, 1.0) - radio_property plotboxaspectratiomode u , "{auto}|manual" - radio_property projection , "{orthographic}|perpective" - radio_property tickdir mu , "{in}|out" - radio_property tickdirmode u , "{auto}|manual" - array_property ticklength u , default_axes_ticklength () - array_property tightinset r , Matrix (1, 4, 0.0) - // FIXME -- uicontextmenu should be moved here. - radio_property units SU , "{normalized}|inches|centimeters|points|pixels|characters" - // hidden properties for transformation computation - array_property x_viewtransform h , Matrix (4, 4, 0.0) - array_property x_projectiontransform h , Matrix (4, 4, 0.0) - array_property x_viewporttransform h , Matrix (4, 4, 0.0) - array_property x_normrendertransform h , Matrix (4, 4, 0.0) - array_property x_rendertransform h , Matrix (4, 4, 0.0) - // hidden properties for minor ticks - row_vector_property xmtick h , Matrix () - row_vector_property ymtick h , Matrix () - row_vector_property zmtick h , Matrix () - // hidden properties for inset - array_property looseinset hu , Matrix (1, 4, 0.0) - // hidden properties for alignment of subplots - radio_property autopos_tag h , "{none}|subplot" - END_PROPERTIES - - protected: - void init (void); - - private: - - std::string - get_scale (const std::string& scale, const Matrix& lims) - { - std::string retval = scale; - - if (scale == "log" && lims.numel () > 1 && lims(0) < 0 && lims(1) < 0) - retval = "neglog"; - - return retval; - } - - void update_xscale (void) - { - sx = get_scale (get_xscale (), xlim.get ().matrix_value ()); - } - - void update_yscale (void) - { - sy = get_scale (get_yscale (), ylim.get ().matrix_value ()); - } - - void update_zscale (void) - { - sz = get_scale (get_zscale (), zlim.get ().matrix_value ()); - } - - void update_view (void) { sync_positions (); } - void update_dataaspectratio (void) { sync_positions (); } - void update_dataaspectratiomode (void) { sync_positions (); } - void update_plotboxaspectratio (void) { sync_positions (); } - void update_plotboxaspectratiomode (void) { sync_positions (); } - - void update_layer (void) { update_axes_layout (); } - void update_yaxislocation (void) - { - update_axes_layout (); - update_ylabel_position (); - } - void update_xaxislocation (void) - { - update_axes_layout (); - update_xlabel_position (); - } - - void update_xdir (void) { update_camera (); update_axes_layout (); } - void update_ydir (void) { update_camera (); update_axes_layout (); } - void update_zdir (void) { update_camera (); update_axes_layout (); } - - void update_ticklength (void); - void update_tickdir (void) { update_ticklength (); } - void update_tickdirmode (void) { update_ticklength (); } - - void update_xtick (void) - { - if (xticklabelmode.is ("auto")) - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - } - void update_ytick (void) - { - if (yticklabelmode.is ("auto")) - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - } - void update_ztick (void) - { - if (zticklabelmode.is ("auto")) - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - } - - void update_xtickmode (void) - { - if (xtickmode.is ("auto")) - { - calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); - update_xtick (); - } - } - void update_ytickmode (void) - { - if (ytickmode.is ("auto")) - { - calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); - update_ytick (); - } - } - void update_ztickmode (void) - { - if (ztickmode.is ("auto")) - { - calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); - update_ztick (); - } - } - - void update_xticklabelmode (void) - { - if (xticklabelmode.is ("auto")) - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - } - void update_yticklabelmode (void) - { - if (yticklabelmode.is ("auto")) - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - } - void update_zticklabelmode (void) - { - if (zticklabelmode.is ("auto")) - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - } - - void update_font (void); - void update_fontname (void) { update_font (); } - void update_fontsize (void) { update_font (); } - void update_fontangle (void) { update_font (); } - void update_fontweight (void) { update_font (); } - - void sync_positions (const Matrix& linset); - void sync_positions (void); - - void update_outerposition (void) - { - set_activepositionproperty ("outerposition"); - sync_positions (); - } - - void update_position (void) - { - set_activepositionproperty ("position"); - sync_positions (); - } - - void update_looseinset (void) { sync_positions (); } - - double calc_tick_sep (double minval, double maxval); - void calc_ticks_and_lims (array_property& lims, array_property& ticks, array_property& mticks, - bool limmode_is_auto, bool is_logscale); - void calc_ticklabels (const array_property& ticks, any_property& labels, bool is_logscale); - Matrix get_ticklabel_extents (const Matrix& ticks, - const string_vector& ticklabels, - const Matrix& limits); - - void fix_limits (array_property& lims) - { - if (lims.get ().is_empty ()) - return; - - Matrix l = lims.get ().matrix_value (); - if (l(0) > l(1)) - { - l(0) = 0; - l(1) = 1; - lims = l; - } - else if (l(0) == l(1)) - { - l(0) -= 0.5; - l(1) += 0.5; - lims = l; - } - } - - Matrix calc_tightbox (const Matrix& init_pos); - - public: - Matrix get_axis_limits (double xmin, double xmax, - double min_pos, double max_neg, - bool logscale); - - void update_xlim (bool do_clr_zoom = true) - { - if (xtickmode.is ("auto")) - calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); - if (xticklabelmode.is ("auto")) - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - - fix_limits (xlim); - - update_xscale (); - - if (do_clr_zoom) - zoom_stack.clear (); - - update_axes_layout (); - } - - void update_ylim (bool do_clr_zoom = true) - { - if (ytickmode.is ("auto")) - calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); - if (yticklabelmode.is ("auto")) - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - - fix_limits (ylim); - - update_yscale (); - - if (do_clr_zoom) - zoom_stack.clear (); - - update_axes_layout (); - } - - void update_zlim (void) - { - if (ztickmode.is ("auto")) - calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); - if (zticklabelmode.is ("auto")) - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - - fix_limits (zlim); - - update_zscale (); - - zoom_stack.clear (); - - update_axes_layout (); - } - - }; - -private: - properties xproperties; - -public: - axes (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p), default_properties () - { - xproperties.override_defaults (*this); - xproperties.update_transform (); - } - - ~axes (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Allow parent (figure) to override first (properties knows how - // to find the parent object). - xproperties.override_defaults (obj); - - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - void set_defaults (const std::string& mode) - { - remove_all_listeners (); - xproperties.set_defaults (*this, mode); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - // FIXME -- finish this. - if (name.compare ("default", 7)) - retval = get_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const; - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - void update_axis_limits (const std::string& axis_type); - - void update_axis_limits (const std::string& axis_type, - const graphics_handle& h); - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -protected: - void initialize (const graphics_object& go); - -private: - property_list default_properties; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API line : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - // properties which are not in matlab: interpreter - - BEGIN_PROPERTIES (line) - row_vector_property xdata u , default_data () - row_vector_property ydata u , default_data () - row_vector_property zdata u , Matrix () - string_property xdatasource , "" - string_property ydatasource , "" - string_property zdatasource , "" - color_property color , color_values (0, 0, 0) - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" - color_property markeredgecolor , "{auto}|none" - color_property markerfacecolor , "auto|{none}" - double_property markersize , 6 - radio_property interpreter , "{tex}|none|latex" - string_property displayname , "" - radio_property erasemode , "{normal}|none|xor|background" - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property zliminclude hl , "off" - END_PROPERTIES - - private: - Matrix compute_xlim (void) const; - Matrix compute_ylim (void) const; - - void update_xdata (void) { set_xlim (compute_xlim ()); } - - void update_ydata (void) { set_ylim (compute_ylim ()); } - - void update_zdata (void) - { - set_zlim (zdata.get_limits ()); - set_zliminclude (get_zdata ().numel () > 0); - } - }; - -private: - properties xproperties; - -public: - line (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~line (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API text : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - double get_fontsize_points (double box_pix_height = 0) const; - - void set_position (const octave_value& val) - { - if (! error_state) - { - octave_value new_val (val); - - if (new_val.numel () == 2) - { - dim_vector dv (1, 3); - - new_val = new_val.resize (dv, true); - } - - if (position.set (new_val, false)) - { - set_positionmode ("manual"); - update_position (); - position.run_listeners (POSTSET); - mark_modified (); - } - else - set_positionmode ("manual"); - } - } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (text) - text_label_property string u , "" - radio_property units u , "{data}|pixels|normalized|inches|centimeters|points" - array_property position smu , Matrix (1, 3, 0.0) - double_property rotation mu , 0 - radio_property horizontalalignment mu , "{left}|center|right" - color_property color u , color_values (0, 0, 0) - string_property fontname u , OCTAVE_DEFAULT_FONTNAME - double_property fontsize u , 10 - radio_property fontangle u , "{normal}|italic|oblique" - radio_property fontweight u , "light|{normal}|demi|bold" - radio_property interpreter u , "{tex}|none|latex" - color_property backgroundcolor , "{none}" - string_property displayname , "" - color_property edgecolor , "{none}" - radio_property erasemode , "{normal}|none|xor|background" - bool_property editing , "off" - radio_property fontunits , "inches|centimeters|normalized|{points}|pixels" - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - double_property margin , 1 - radio_property verticalalignment mu , "top|cap|{middle}|baseline|bottom" - array_property extent rG , Matrix (1, 4, 0.0) - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - bool_property xliminclude hl , "off" - bool_property yliminclude hl , "off" - bool_property zliminclude hl , "off" - // hidden properties for auto-positioning - radio_property positionmode hu , "{auto}|manual" - radio_property rotationmode hu , "{auto}|manual" - radio_property horizontalalignmentmode hu , "{auto}|manual" - radio_property verticalalignmentmode hu , "{auto}|manual" - radio_property autopos_tag h , "{none}|xlabel|ylabel|zlabel|title" - END_PROPERTIES - - Matrix get_data_position (void) const; - Matrix get_extent_matrix (void) const; - const uint8NDArray& get_pixels (void) const { return pixels; } -#if HAVE_FREETYPE - // freetype renderer, used for calculation of text size - ft_render renderer; -#endif - - protected: - void init (void) - { - position.add_constraint (dim_vector (1, 3)); - cached_units = get_units (); - update_font (); - } - - private: - void update_position (void) - { - Matrix pos = get_data_position (); - Matrix lim; - - lim = Matrix (1, 3, pos(0)); - lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); - set_xlim (lim); - - lim = Matrix (1, 3, pos(1)); - lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); - set_ylim (lim); - - if (pos.numel () == 3) - { - lim = Matrix (1, 3, pos(2)); - lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); - set_zliminclude ("on"); - set_zlim (lim); - } - else - set_zliminclude ("off"); - } - - void update_text_extent (void); - - void request_autopos (void); - void update_positionmode (void) { request_autopos (); } - void update_rotationmode (void) { request_autopos (); } - void update_horizontalalignmentmode (void) { request_autopos (); } - void update_verticalalignmentmode (void) { request_autopos (); } - - void update_font (void); - void update_string (void) { request_autopos (); update_text_extent (); } - void update_rotation (void) { update_text_extent (); } - void update_color (void) { update_font (); } - void update_fontname (void) { update_font (); update_text_extent (); } - void update_fontsize (void) { update_font (); update_text_extent (); } - void update_fontangle (void) { update_font (); update_text_extent (); } - void update_fontweight (void) { update_font (); update_text_extent (); } - void update_interpreter (void) { update_text_extent (); } - void update_horizontalalignment (void) { update_text_extent (); } - void update_verticalalignment (void) { update_text_extent (); } - - void update_units (void); - - private: - std::string cached_units; - uint8NDArray pixels; - }; - -private: - properties xproperties; - -public: - text (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.set_clipping ("off"); - xproperties.override_defaults (*this); - } - - ~text (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API image : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - bool is_climinclude (void) const - { return (climinclude.is_on () && cdatamapping.is ("scaled")); } - std::string get_climinclude (void) const - { return climinclude.current_value (); } - - octave_value get_color_data (void) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (image) - row_vector_property xdata u , Matrix () - row_vector_property ydata u , Matrix () - array_property cdata u , Matrix () - radio_property cdatamapping al , "{scaled}|direct" - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property clim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property climinclude hlg , "on" - END_PROPERTIES - - protected: - void init (void) - { - xdata.add_constraint (2); - ydata.add_constraint (2); - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("logical"); - cdata.add_constraint ("uint8"); - cdata.add_constraint ("uint16"); - cdata.add_constraint ("int16"); - cdata.add_constraint (dim_vector (-1, -1)); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - - private: - void update_xdata (void) - { - Matrix limits = xdata.get_limits (); - float dp = pixel_xsize (); - - limits(0) = limits(0) - dp; - limits(1) = limits(1) + dp; - set_xlim (limits); - } - - void update_ydata (void) - { - Matrix limits = ydata.get_limits (); - float dp = pixel_ysize (); - - limits(0) = limits(0) - dp; - limits(1) = limits(1) + dp; - set_ylim (limits); - } - - void update_cdata (void) - { - if (cdatamapping_is ("scaled")) - set_clim (cdata.get_limits ()); - else - clim = cdata.get_limits (); - } - - float pixel_size (octave_idx_type dim, const Matrix limits) - { - octave_idx_type l = dim - 1; - float dp; - - if (l > 0 && limits(0) != limits(1)) - dp = (limits(1) - limits(0))/(2*l); - else - { - if (limits(1) == limits(2)) - dp = 0.5; - else - dp = (limits(1) - limits(0))/2; - } - return dp; - } - - public: - float pixel_xsize (void) - { - return pixel_size ((get_cdata ().dims ())(1), xdata.get_limits ()); - } - - float pixel_ysize (void) - { - return pixel_size ((get_cdata ().dims ())(0), ydata.get_limits ()); - } - }; - -private: - properties xproperties; - -public: - image (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~image (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API patch : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - octave_value get_color_data (void) const; - - bool is_climinclude (void) const - { return (climinclude.is_on () && cdatamapping.is ("scaled")); } - std::string get_climinclude (void) const - { return climinclude.current_value (); } - - bool is_aliminclude (void) const - { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } - std::string get_aliminclude (void) const - { return aliminclude.current_value (); } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (patch) - array_property xdata u , Matrix () - array_property ydata u , Matrix () - array_property zdata u , Matrix () - array_property cdata u , Matrix () - radio_property cdatamapping l , "{scaled}|direct" - array_property faces , Matrix () - array_property facevertexalphadata , Matrix () - array_property facevertexcdata , Matrix () - array_property vertices , Matrix () - array_property vertexnormals , Matrix () - radio_property normalmode , "{auto}|manual" - color_property facecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) - double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) - radio_property facelighting , "flat|{none}|gouraud|phong" - color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) - double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) - radio_property edgelighting , "{none}|flat|gouraud|phong" - radio_property backfacelighting , "{reverselit}|unlit|lit" - double_property ambientstrength , 0.3 - double_property diffusestrength , 0.6 - double_property specularstrength , 0.6 - double_property specularexponent , 10.0 - double_property specularcolorreflectance , 1.0 - radio_property erasemode , "{normal}|background|xor|none" - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" - color_property markeredgecolor , "{auto}|none|flat" - color_property markerfacecolor , "auto|{none}|flat" - double_property markersize , 6 - radio_property interpreter , "{tex}|none|latex" - string_property displayname , "" - radio_property alphadatamapping l , "none|{scaled}|direct" - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - row_vector_property clim hlr , Matrix () - row_vector_property alim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property zliminclude hl , "on" - bool_property climinclude hlg , "on" - bool_property aliminclude hlg , "on" - END_PROPERTIES - - protected: - void init (void) - { - xdata.add_constraint (dim_vector (-1, -1)); - ydata.add_constraint (dim_vector (-1, -1)); - zdata.add_constraint (dim_vector (-1, -1)); - vertices.add_constraint (dim_vector (-1, 2)); - vertices.add_constraint (dim_vector (-1, 3)); - cdata.add_constraint (dim_vector (-1, -1)); - cdata.add_constraint (dim_vector (-1, -1, 3)); - facevertexcdata.add_constraint (dim_vector (-1, 1)); - facevertexcdata.add_constraint (dim_vector (-1, 3)); - facevertexalphadata.add_constraint (dim_vector (-1, 1)); - } - - private: - void update_xdata (void) { set_xlim (xdata.get_limits ()); } - void update_ydata (void) { set_ylim (ydata.get_limits ()); } - void update_zdata (void) { set_zlim (zdata.get_limits ()); } - - void update_cdata (void) - { - if (cdatamapping_is ("scaled")) - set_clim (cdata.get_limits ()); - else - clim = cdata.get_limits (); - } - }; - -private: - properties xproperties; - -public: - patch (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~patch (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API surface : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - octave_value get_color_data (void) const; - - bool is_climinclude (void) const - { return (climinclude.is_on () && cdatamapping.is ("scaled")); } - std::string get_climinclude (void) const - { return climinclude.current_value (); } - - bool is_aliminclude (void) const - { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } - std::string get_aliminclude (void) const - { return aliminclude.current_value (); } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (surface) - array_property xdata u , Matrix () - array_property ydata u , Matrix () - array_property zdata u , Matrix () - array_property cdata u , Matrix () - radio_property cdatamapping al , "{scaled}|direct" - string_property xdatasource , "" - string_property ydatasource , "" - string_property zdatasource , "" - string_property cdatasource , "" - color_property facecolor , "{flat}|none|interp|texturemap" - double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) - color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" - color_property markeredgecolor , "{auto}|none" - color_property markerfacecolor , "auto|{none}" - double_property markersize , 6 - radio_property interpreter , "{tex}|none|latex" - string_property displayname , "" - array_property alphadata u , Matrix () - radio_property alphadatamapping l , "none|direct|{scaled}" - double_property ambientstrength , 0.3 - radio_property backfacelighting , "unlit|lit|{reverselit}" - double_property diffusestrength , 0.6 - double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) - radio_property edgelighting , "{none}|flat|gouraud|phong" - radio_property erasemode , "{normal}|none|xor|background" - radio_property facelighting , "{none}|flat|gouraud|phong" - radio_property meshstyle , "{both}|row|column" - radio_property normalmode u , "{auto}|manual" - double_property specularcolorreflectance , 1 - double_property specularexponent , 10 - double_property specularstrength , 0.9 - array_property vertexnormals u , Matrix () - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - row_vector_property clim hlr , Matrix () - row_vector_property alim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property zliminclude hl , "on" - bool_property climinclude hlg , "on" - bool_property aliminclude hlg , "on" - END_PROPERTIES - - protected: - void init (void) - { - xdata.add_constraint (dim_vector (-1, -1)); - ydata.add_constraint (dim_vector (-1, -1)); - zdata.add_constraint (dim_vector (-1, -1)); - alphadata.add_constraint ("single"); - alphadata.add_constraint ("double"); - alphadata.add_constraint ("uint8"); - alphadata.add_constraint (dim_vector (-1, -1)); - vertexnormals.add_constraint (dim_vector (-1, -1, 3)); - cdata.add_constraint ("single"); - cdata.add_constraint ("double"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1)); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - - private: - void update_normals (void); - - void update_xdata (void) - { - update_normals (); - set_xlim (xdata.get_limits ()); - } - - void update_ydata (void) - { - update_normals (); - set_ylim (ydata.get_limits ()); - } - - void update_zdata (void) - { - update_normals (); - set_zlim (zdata.get_limits ()); - } - - void update_cdata (void) - { - if (cdatamapping_is ("scaled")) - set_clim (cdata.get_limits ()); - else - clim = cdata.get_limits (); - } - - void update_alphadata (void) - { - if (alphadatamapping_is ("scaled")) - set_alim (alphadata.get_limits ()); - else - alim = alphadata.get_limits (); - } - - void update_normalmode (void) - { update_normals (); } - - void update_vertexnormals (void) - { set_normalmode ("manual"); } - }; - -private: - properties xproperties; - -public: - surface (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~surface (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API hggroup : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void remove_child (const graphics_handle& h) - { - base_properties::remove_child (h); - update_limits (); - } - - void adopt (const graphics_handle& h) - { - - base_properties::adopt (h); - update_limits (h); - } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (hggroup) - // hidden properties for limit computation - row_vector_property xlim hr , Matrix () - row_vector_property ylim hr , Matrix () - row_vector_property zlim hr , Matrix () - row_vector_property clim hr , Matrix () - row_vector_property alim hr , Matrix () - bool_property xliminclude h , "on" - bool_property yliminclude h , "on" - bool_property zliminclude h , "on" - bool_property climinclude h , "on" - bool_property aliminclude h , "on" - END_PROPERTIES - - private: - void update_limits (void) const; - - void update_limits (const graphics_handle& h) const; - - protected: - void init (void) - { } - - }; - -private: - properties xproperties; - -public: - hggroup (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~hggroup (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void update_axis_limits (const std::string& axis_type); - - void update_axis_limits (const std::string& axis_type, - const graphics_handle& h); - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uimenu : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void remove_child (const graphics_handle& h) - { - base_properties::remove_child (h); - } - - void adopt (const graphics_handle& h) - { - base_properties::adopt (h); - } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uimenu) - any_property __object__ , Matrix () - string_property accelerator , "" - callback_property callback , Matrix () - bool_property checked , "off" - bool_property enable , "on" - color_property foregroundcolor , color_values (0, 0, 0) - string_property label , "" - double_property position , 9 - bool_property separator , "off" - string_property fltk_label h , "" - END_PROPERTIES - - protected: - void init (void) - { } - }; - -private: - properties xproperties; - -public: - uimenu (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uimenu (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uicontextmenu : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uicontextmenu) - any_property __object__ , Matrix () - callback_property callback , Matrix () - array_property position , Matrix (1, 2, 0.0) - END_PROPERTIES - - protected: - void init (void) - { - position.add_constraint (dim_vector (1, 2)); - position.add_constraint (dim_vector (2, 1)); - visible.set (octave_value (true)); - } - }; - -private: - properties xproperties; - -public: - uicontextmenu (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uicontextmenu (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uicontrol : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - double get_fontsize_points (double box_pix_height = 0) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uicontrol) - any_property __object__ , Matrix () - color_property backgroundcolor , color_values (1, 1, 1) - callback_property callback , Matrix () - array_property cdata , Matrix () - bool_property clipping , "on" - radio_property enable , "{on}|inactive|off" - array_property extent rG , Matrix (1, 4, 0.0) - radio_property fontangle u , "{normal}|italic|oblique" - string_property fontname u , OCTAVE_DEFAULT_FONTNAME - double_property fontsize u , 10 - radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" - radio_property fontweight u , "light|{normal}|demi|bold" - color_property foregroundcolor , color_values (0, 0, 0) - radio_property horizontalalignment , "{left}|center|right" - callback_property keypressfcn , Matrix () - double_property listboxtop , 1 - double_property max , 1 - double_property min , 0 - array_property position , default_control_position () - array_property sliderstep , default_control_sliderstep () - string_array_property string u , "" - radio_property style S , "{pushbutton}|togglebutton|radiobutton|checkbox|edit|text|slider|frame|listbox|popupmenu" - string_property tooltipstring , "" - radio_property units u , "normalized|inches|centimeters|points|{pixels}|characters" - row_vector_property value , Matrix (1, 1, 1.0) - radio_property verticalalignment , "top|{middle}|bottom" - END_PROPERTIES - - private: - std::string cached_units; - - protected: - void init (void) - { - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1, 3)); - position.add_constraint (dim_vector (1, 4)); - sliderstep.add_constraint (dim_vector (1, 2)); - cached_units = get_units (); - } - - void update_text_extent (void); - - void update_string (void) { update_text_extent (); } - void update_fontname (void) { update_text_extent (); } - void update_fontsize (void) { update_text_extent (); } - void update_fontangle (void) { update_text_extent (); } - void update_fontweight (void) { update_text_extent (); } - void update_fontunits (const caseless_str& old_units); - - void update_units (void); - - }; - -private: - properties xproperties; - -public: - uicontrol (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uicontrol (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uipanel : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - double get_fontsize_points (double box_pix_height = 0) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uipanel) - any_property __object__ , Matrix () - color_property backgroundcolor , color_values (1, 1, 1) - radio_property bordertype , "none|{etchedin}|etchedout|beveledin|beveledout|line" - double_property borderwidth , 1 - radio_property fontangle , "{normal}|italic|oblique" - string_property fontname , OCTAVE_DEFAULT_FONTNAME - double_property fontsize , 10 - radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" - radio_property fontweight , "light|{normal}|demi|bold" - color_property foregroundcolor , color_values (0, 0, 0) - color_property highlightcolor , color_values (1, 1, 1) - array_property position , default_panel_position () - callback_property resizefcn , Matrix () - color_property shadowcolor , color_values (0, 0, 0) - string_property title , "" - radio_property titleposition , "{lefttop}|centertop|righttop|leftbottom|centerbottom|rightbottom" - radio_property units S , "{normalized}|inches|centimeters|points|pixels|characters" - END_PROPERTIES - - protected: - void init (void) - { - position.add_constraint (dim_vector (1, 4)); - } - - void update_units (const caseless_str& old_units); - void update_fontunits (const caseless_str& old_units); - - }; - -private: - properties xproperties; - -public: - uipanel (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uipanel (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uitoolbar : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uitoolbar) - any_property __object__ , Matrix () - END_PROPERTIES - - protected: - void init (void) - { } - }; - -private: - properties xproperties; - -public: - uitoolbar (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p), default_properties () - { - xproperties.override_defaults (*this); - } - - ~uitoolbar (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Allow parent (figure) to override first (properties knows how - // to find the parent object). - xproperties.override_defaults (obj); - - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - if (name.compare ("default", 7)) - retval = get_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const; - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -private: - property_list default_properties; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uipushtool : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uipushtool) - any_property __object__ , Matrix () - array_property cdata , Matrix () - callback_property clickedcallback , Matrix () - bool_property enable , "on" - bool_property separator , "off" - string_property tooltipstring , "" - END_PROPERTIES - - protected: - void init (void) - { - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - }; - -private: - properties xproperties; - -public: - uipushtool (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uipushtool (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uitoggletool : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uitoggletool) - any_property __object__ , Matrix () - array_property cdata , Matrix () - callback_property clickedcallback , Matrix () - bool_property enable , "on" - callback_property offcallback , Matrix () - callback_property oncallback , Matrix () - bool_property separator , "off" - bool_property state , "off" - string_property tooltipstring , "" - END_PROPERTIES - - protected: - void init (void) - { - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - }; - -private: - properties xproperties; - -public: - uitoggletool (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uitoggletool (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -octave_value -get_property_from_handle (double handle, const std::string &property, - const std::string &func); -bool -set_property_in_handle (double handle, const std::string &property, - const octave_value &arg, const std::string &func); - -// --------------------------------------------------------------------- - -class graphics_event; - -class -base_graphics_event -{ -public: - friend class graphics_event; - - base_graphics_event (void) : count (1) { } - - virtual ~base_graphics_event (void) { } - - virtual void execute (void) = 0; - -private: - octave_refcount count; -}; - -class -graphics_event -{ -public: - typedef void (*event_fcn) (void*); - - graphics_event (void) : rep (0) { } - - graphics_event (const graphics_event& e) : rep (e.rep) - { - rep->count++; - } - - ~graphics_event (void) - { - if (rep && --rep->count == 0) - delete rep; - } - - graphics_event& operator = (const graphics_event& e) - { - if (rep != e.rep) - { - if (rep && --rep->count == 0) - delete rep; - - rep = e.rep; - if (rep) - rep->count++; - } - - return *this; - } - - void execute (void) - { if (rep) rep->execute (); } - - bool ok (void) const - { return (rep != 0); } - - static graphics_event - create_callback_event (const graphics_handle& h, - const std::string& name, - const octave_value& data = Matrix ()); - - static graphics_event - create_callback_event (const graphics_handle& h, - const octave_value& cb, - const octave_value& data = Matrix ()); - - static graphics_event - create_function_event (event_fcn fcn, void *data = 0); - - static graphics_event - create_set_event (const graphics_handle& h, const std::string& name, - const octave_value& value, - bool notify_toolkit = true); -private: - base_graphics_event *rep; -}; - -class OCTINTERP_API gh_manager -{ -protected: - - gh_manager (void); - -public: - - static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create gh_manager!"); - - retval = false; - } - - return retval; - } - - static void cleanup_instance (void) { delete instance; instance = 0; } - - static graphics_handle get_handle (bool integer_figure_handle) - { - return instance_ok () - ? instance->do_get_handle (integer_figure_handle) : graphics_handle (); - } - - static void free (const graphics_handle& h) - { - if (instance_ok ()) - instance->do_free (h); - } - - static void renumber_figure (const graphics_handle& old_gh, - const graphics_handle& new_gh) - { - if (instance_ok ()) - instance->do_renumber_figure (old_gh, new_gh); - } - - static graphics_handle lookup (double val) - { - return instance_ok () ? instance->do_lookup (val) : graphics_handle (); - } - - static graphics_handle lookup (const octave_value& val) - { - return val.is_real_scalar () - ? lookup (val.double_value ()) : graphics_handle (); - } - - static graphics_object get_object (double val) - { - return get_object (lookup (val)); - } - - static graphics_object get_object (const graphics_handle& h) - { - return instance_ok () ? instance->do_get_object (h) : graphics_object (); - } - - static graphics_handle - make_graphics_handle (const std::string& go_name, - const graphics_handle& parent, - bool integer_figure_handle = false, - bool do_createfcn = true, - bool do_notify_toolkit = true) - { - return instance_ok () - ? instance->do_make_graphics_handle (go_name, parent, - integer_figure_handle, - do_createfcn, do_notify_toolkit) - : graphics_handle (); - } - - static graphics_handle make_figure_handle (double val, - bool do_notify_toolkit = true) - { - return instance_ok () - ? instance->do_make_figure_handle (val, do_notify_toolkit) - : graphics_handle (); - } - - static void push_figure (const graphics_handle& h) - { - if (instance_ok ()) - instance->do_push_figure (h); - } - - static void pop_figure (const graphics_handle& h) - { - if (instance_ok ()) - instance->do_pop_figure (h); - } - - static graphics_handle current_figure (void) - { - return instance_ok () - ? instance->do_current_figure () : graphics_handle (); - } - - static Matrix handle_list (bool show_hidden = false) - { - return instance_ok () - ? instance->do_handle_list (show_hidden) : Matrix (); - } - - static void lock (void) - { - if (instance_ok ()) - instance->do_lock (); - } - - static bool try_lock (void) - { - if (instance_ok ()) - return instance->do_try_lock (); - else - return false; - } - - static void unlock (void) - { - if (instance_ok ()) - instance->do_unlock (); - } - - static Matrix figure_handle_list (bool show_hidden = false) - { - return instance_ok () - ? instance->do_figure_handle_list (show_hidden) : Matrix (); - } - - static void execute_listener (const graphics_handle& h, - const octave_value& l) - { - if (instance_ok ()) - instance->do_execute_listener (h, l); - } - - static void execute_callback (const graphics_handle& h, - const std::string& name, - const octave_value& data = Matrix ()) - { - octave_value cb; - - if (true) - { - gh_manager::auto_lock lock; - - graphics_object go = get_object (h); - - if (go.valid_object ()) - cb = go.get (name); - } - - if (! error_state) - execute_callback (h, cb, data); - } - - static void execute_callback (const graphics_handle& h, - const octave_value& cb, - const octave_value& data = Matrix ()) - { - if (instance_ok ()) - instance->do_execute_callback (h, cb, data); - } - - static void post_callback (const graphics_handle& h, - const std::string& name, - const octave_value& data = Matrix ()) - { - if (instance_ok ()) - instance->do_post_callback (h, name, data); - } - - static void post_function (graphics_event::event_fcn fcn, void* data = 0) - { - if (instance_ok ()) - instance->do_post_function (fcn, data); - } - - static void post_set (const graphics_handle& h, const std::string& name, - const octave_value& value, bool notify_toolkit = true) - { - if (instance_ok ()) - instance->do_post_set (h, name, value, notify_toolkit); - } - - static int process_events (void) - { - return (instance_ok () ? instance->do_process_events () : 0); - } - - static int flush_events (void) - { - return (instance_ok () ? instance->do_process_events (true) : 0); - } - - static void enable_event_processing (bool enable = true) - { - if (instance_ok ()) - instance->do_enable_event_processing (enable); - } - - static bool is_handle_visible (const graphics_handle& h) - { - bool retval = false; - - graphics_object go = get_object (h); - - if (go.valid_object ()) - retval = go.is_handle_visible (); - - return retval; - } - - static void close_all_figures (void) - { - if (instance_ok ()) - instance->do_close_all_figures (); - } - -public: - class auto_lock : public octave_autolock - { - public: - auto_lock (bool wait = true) - : octave_autolock (instance_ok () - ? instance->graphics_lock - : octave_mutex (), - wait) - { } - - private: - - // No copying! - auto_lock (const auto_lock&); - auto_lock& operator = (const auto_lock&); - }; - -private: - - static gh_manager *instance; - - typedef std::map::iterator iterator; - typedef std::map::const_iterator const_iterator; - - typedef std::set::iterator free_list_iterator; - typedef std::set::const_iterator const_free_list_iterator; - - typedef std::list::iterator figure_list_iterator; - typedef std::list::const_iterator const_figure_list_iterator; - - // A map of handles to graphics objects. - std::map handle_map; - - // The available graphics handles. - std::set handle_free_list; - - // The next handle available if handle_free_list is empty. - double next_handle; - - // The allocated figure handles. Top of the stack is most recently - // created. - std::list figure_list; - - // The lock for accessing the graphics sytsem. - octave_mutex graphics_lock; - - // The list of events queued by graphics toolkits. - std::list event_queue; - - // The stack of callback objects. - std::list callback_objects; - - // A flag telling whether event processing must be constantly on. - int event_processing; - - graphics_handle do_get_handle (bool integer_figure_handle); - - void do_free (const graphics_handle& h); - - void do_renumber_figure (const graphics_handle& old_gh, - const graphics_handle& new_gh); - - graphics_handle do_lookup (double val) - { - iterator p = (xisnan (val) ? handle_map.end () : handle_map.find (val)); - - return (p != handle_map.end ()) ? p->first : graphics_handle (); - } - - graphics_object do_get_object (const graphics_handle& h) - { - iterator p = (h.ok () ? handle_map.find (h) : handle_map.end ()); - - return (p != handle_map.end ()) ? p->second : graphics_object (); - } - - graphics_handle do_make_graphics_handle (const std::string& go_name, - const graphics_handle& p, - bool integer_figure_handle, - bool do_createfcn, - bool do_notify_toolkit); - - graphics_handle do_make_figure_handle (double val, bool do_notify_toolkit); - - Matrix do_handle_list (bool show_hidden) - { - Matrix retval (1, handle_map.size ()); - - octave_idx_type i = 0; - for (const_iterator p = handle_map.begin (); p != handle_map.end (); p++) - { - graphics_handle h = p->first; - - if (show_hidden || is_handle_visible (h)) - retval(i++) = h.value (); - } - - retval.resize (1, i); - - return retval; - } - - Matrix do_figure_handle_list (bool show_hidden) - { - Matrix retval (1, figure_list.size ()); - - octave_idx_type i = 0; - for (const_figure_list_iterator p = figure_list.begin (); - p != figure_list.end (); - p++) - { - graphics_handle h = *p; - - if (show_hidden || is_handle_visible (h)) - retval(i++) = h.value (); - } - - retval.resize (1, i); - - return retval; - } - - void do_push_figure (const graphics_handle& h); - - void do_pop_figure (const graphics_handle& h); - - graphics_handle do_current_figure (void) const - { - graphics_handle retval; - - for (const_figure_list_iterator p = figure_list.begin (); - p != figure_list.end (); - p++) - { - graphics_handle h = *p; - - if (is_handle_visible (h)) - retval = h; - } - - return retval; - } - - void do_lock (void) { graphics_lock.lock (); } - - bool do_try_lock (void) { return graphics_lock.try_lock (); } - - void do_unlock (void) { graphics_lock.unlock (); } - - void do_execute_listener (const graphics_handle& h, const octave_value& l); - - void do_execute_callback (const graphics_handle& h, const octave_value& cb, - const octave_value& data); - - void do_post_callback (const graphics_handle& h, const std::string name, - const octave_value& data); - - void do_post_function (graphics_event::event_fcn fcn, void* fcn_data); - - void do_post_set (const graphics_handle& h, const std::string name, - const octave_value& value, bool notify_toolkit = true); - - int do_process_events (bool force = false); - - void do_close_all_figures (void); - - static void restore_gcbo (void) - { - if (instance_ok ()) - instance->do_restore_gcbo (); - } - - void do_restore_gcbo (void); - - void do_post_event (const graphics_event& e); - - void do_enable_event_processing (bool enable = true); -}; - -void get_children_limits (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const Matrix& kids, char limit_type); - -OCTINTERP_API int calc_dimensions (const graphics_object& gh); - -// This function is NOT equivalent to the scripting language function gcf. -OCTINTERP_API graphics_handle gcf (void); - -// This function is NOT equivalent to the scripting language function gca. -OCTINTERP_API graphics_handle gca (void); - -OCTINTERP_API void close_all_figures (void); - -#endif diff -r d02b229ce693 -r a132d206a36a src/help.cc --- a/src/help.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1405 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "str-vec.h" - -#include -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "load-path.h" -#include "oct-obj.h" -#include "ov-usr-fcn.h" -#include "pager.h" -#include "parse.h" -#include "pathsearch.h" -#include "procstream.h" -#include "pt-pr-code.h" -#include "sighandlers.h" -#include "symtab.h" -#include "syswait.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "quit.h" - -// Name of the doc cache file specified on the command line. -// (--doc-cache-file file) -std::string Vdoc_cache_file; - -// Name of the file containing local Texinfo macros that are prepended -// to doc strings before processing. -// (--texi-macros-file) -std::string Vtexi_macros_file; - -// Name of the info file specified on command line. -// (--info-file file) -std::string Vinfo_file; - -// Name of the info reader we'd like to use. -// (--info-program program) -std::string Vinfo_program; - -// Name of the makeinfo program to run. -static std::string Vmakeinfo_program = "makeinfo"; - -// If TRUE, don't print additional help message in help and usage -// functions. -static bool Vsuppress_verbose_help_message = false; - -#include - -typedef std::map map_type; -typedef map_type::value_type pair_type; -typedef map_type::const_iterator map_iter; - -template -std::size_t -size (T const (&)[z]) -{ - return z; -} - -const static pair_type operators[] = -{ - pair_type ("!", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} !\n\ -Logical 'not' operator.\n\ -@seealso{~, not}\n\ -@end deftypefn"), - - pair_type ("~", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ~\n\ -Logical 'not' operator.\n\ -@seealso{!, not}\n\ -@end deftypefn"), - - pair_type ("!=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} !=\n\ -Logical 'not equals' operator.\n\ -@seealso{~=, ne}\n\ -@end deftypefn"), - - pair_type ("~=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ~=\n\ -Logical 'not equals' operator.\n\ -@seealso{!=, ne}\n\ -@end deftypefn"), - - pair_type ("\"", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} \"\n\ -String delimiter.\n\ -@end deftypefn"), - - pair_type ("#", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} #\n\ -Begin comment character.\n\ -@seealso{%, #@\\{}\n\ -@end deftypefn"), - - pair_type ("%", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} %\n\ -Begin comment character.\n\ -@seealso{#, %@\\{}\n\ -@end deftypefn"), - - pair_type ("#{", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} #@{\n\ -Begin block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{#@{}.\n\ -It is possible to nest block comments.\n\ -@seealso{%@\\{, #@\\}, #}\n\ -@end deftypefn"), - - pair_type ("%{", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} %@{\n\ -Begin block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{%@{}.\n\ -It is possible to nest block comments.\n\ -@seealso{#@\\{, %@\\}, %}\n\ -@end deftypefn"), - - pair_type ("#}", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} #@}\n\ -Close block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{#@}}.\n\ -It is possible to nest block comments.\n\ -@seealso{%@\\}, #@\\{, #}\n\ -@end deftypefn"), - - pair_type ("%}", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} %@}\n\ -Close block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{%@}}.\n\ -It is possible to nest block comments.\n\ -@seealso{#@\\}, %@\\{, %}\n\ -@end deftypefn"), - - pair_type ("...", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ...\n\ -Continuation marker. Joins current line with following line.\n\ -@end deftypefn"), - - pair_type ("&", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} &\n\ -Element by element logical 'and' operator.\n\ -@seealso{&&, and}\n\ -@end deftypefn"), - - pair_type ("&&", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} &&\n\ -Logical 'and' operator (with short-circuit evaluation).\n\ -@seealso{&, and}\n\ -@end deftypefn"), - - pair_type ("'", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} '\n\ -Matrix transpose operator. For complex matrices, computes the\n\ -complex conjugate (Hermitian) transpose.\n\ -\n\ -The single quote character may also be used to delimit strings, but\n\ -it is better to use the double quote character, since that is never\n\ -ambiguous.\n\ -@seealso{.', transpose}\n\ -@end deftypefn"), - - pair_type ("(", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} (\n\ -Array index or function argument delimiter.\n\ -@end deftypefn"), - - pair_type (")", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} )\n\ -Array index or function argument delimiter.\n\ -@end deftypefn"), - - pair_type ("*", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} *\n\ -Multiplication operator.\n\ -@seealso{.*, times}\n\ -@end deftypefn"), - - pair_type ("**", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} **\n\ -Power operator. This may return complex results for real inputs. Use\n\ -@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ -real results when possible.\n\ -@seealso{power, ^, .**, .^, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type ("^", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ^\n\ -Power operator. This may return complex results for real inputs. Use\n\ -@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ -real results when possible.\n\ -@seealso{power, **, .^, .**, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type ("+", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} +\n\ -Addition operator.\n\ -@seealso{plus}\n\ -@end deftypefn"), - - pair_type ("++", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ++\n\ -Increment operator. As in C, may be applied as a prefix or postfix\n\ -operator.\n\ -@seealso{--}\n\ -@end deftypefn"), - - pair_type (",", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ,\n\ -Array index, function argument, or command separator.\n\ -@end deftypefn"), - - pair_type ("-", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} -\n\ -Subtraction or unary negation operator.\n\ -@seealso{minus}\n\ -@end deftypefn"), - - pair_type ("--", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} --\n\ -Decrement operator. As in C, may be applied as a prefix or postfix\n\ -operator.\n\ -@seealso{++}\n\ -@end deftypefn"), - - pair_type (".'", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .'\n\ -Matrix transpose operator. For complex matrices, computes the\n\ -transpose, @emph{not} the complex conjugate transpose.\n\ -@seealso{', transpose}\n\ -@end deftypefn"), - - pair_type (".*", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .*\n\ -Element by element multiplication operator.\n\ -@seealso{*, times}\n\ -@end deftypefn"), - - pair_type (".**", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .*\n\ -Element by element power operator. If several complex results are possible,\n\ -returns the one with smallest non-negative argument (angle). Use\n\ -@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ -real result is preferred.\n\ -@seealso{**, ^, .^, power, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type (".^", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .^\n\ -Element by element power operator. If several complex results are possible,\n\ -returns the one with smallest non-negative argument (angle). Use\n\ -@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ -real result is preferred.\n\ -@seealso{.**, ^, **, power, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type ("./", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ./\n\ -Element by element right division operator.\n\ -@seealso{/, .\\, rdivide, mrdivide}\n\ -@end deftypefn"), - - pair_type ("/", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} /\n\ -Right division operator.\n\ -@seealso{./, \\, rdivide, mrdivide}\n\ -@end deftypefn"), - - pair_type (".\\", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .\\\n\ -Element by element left division operator.\n\ -@seealso{\\, ./, rdivide, mrdivide}\n\ -@end deftypefn"), - - pair_type ("\\", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} \\\n\ -Left division operator.\n\ -@seealso{.\\, /, ldivide, mldivide}\n\ -@end deftypefn"), - - pair_type (":", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} :\n\ -Select entire rows or columns of matrices.\n\ -@end deftypefn"), - - pair_type (";", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ;\n\ -Array row or command separator.\n\ -@seealso{,}\n\ -@end deftypefn"), - - pair_type ("<", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} <\n\ -'Less than' operator.\n\ -@seealso{lt}\n\ -@end deftypefn"), - - pair_type ("<=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} <=\n\ -'Less than' or 'equals' operator.\n\ -@seealso{le}\n\ -@end deftypefn"), - - pair_type ("=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} =\n\ -Assignment operator.\n\ -@end deftypefn"), - - pair_type ("==", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ==\n\ -Equality test operator.\n\ -@seealso{eq}\n\ -@end deftypefn"), - - pair_type (">", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} >\n\ -'Greater than' operator.\n\ -@seealso{gt}\n\ -@end deftypefn"), - - pair_type (">=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} >=\n\ -'Greater than' or 'equals' operator.\n\ -@seealso{ge}\n\ -@end deftypefn"), - - pair_type ("[", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} [\n\ -Return list delimiter.\n\ -@seealso{]}\n\ -@end deftypefn"), - - pair_type ("]", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ]\n\ -Return list delimiter.\n\ -@seealso{[}\n\ -@end deftypefn"), - - pair_type ("|", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} |\n\ -Element by element logical 'or' operator.\n\ -@seealso{||, or}\n\ -@end deftypefn"), - - pair_type ("||", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ||\n\ -Logical 'or' (with short-circuit evaluation) operator.\n\ -@seealso{|, or}\n\ -@end deftypefn"), -}; - -const static pair_type keywords[] = -{ - pair_type ("break", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} break\n\ -Exit the innermost enclosing do, while or for loop.\n\ -@seealso{do, while, for, parfor, continue}\n\ -@end deftypefn"), - - pair_type ("case", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} case @{@var{value}@}\n\ -A case statement in an switch. Octave cases are exclusive and do not\n\ -fall-through as do C-language cases. A switch statement must have at least\n\ -one case. See @code{switch} for an example.\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("catch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} catch\n\ -Begin the cleanup part of a try-catch block.\n\ -@seealso{try}\n\ -@end deftypefn"), - - pair_type ("continue", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} continue\n\ -Jump to the end of the innermost enclosing do, while or for loop.\n\ -@seealso{do, while, for, parfor, break}\n\ -@end deftypefn"), - - pair_type ("do", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} do\n\ -Begin a do-until loop. This differs from a do-while loop in that the\n\ -body of the loop is executed at least once.\n\ -@seealso{while}\n\ -@end deftypefn"), - - pair_type ("else", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} else\n\ -Alternate action for an if block. See @code{if} for an example.\n\ -@seealso{if}\n\ -@end deftypefn"), - - pair_type ("elseif", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} elseif (@var{condition})\n\ -Alternate conditional test for an if block. See @code{if} for an example.\n\ -@seealso{if}\n\ -@end deftypefn"), - - pair_type ("end", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} end\n\ -Mark the end of any @code{for}, @code{if}, @code{do}, @code{while}, or\n\ -@code{function} block.\n\ -@seealso{for, parfor, if, do, while, function}\n\ -@end deftypefn"), - - pair_type ("end_try_catch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} end_try_catch\n\ -Mark the end of an @code{try-catch} block.\n\ -@seealso{try, catch}\n\ -@end deftypefn"), - - pair_type ("end_unwind_protect", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} end_unwind_protect\n\ -Mark the end of an unwind_protect block.\n\ -@seealso{unwind_protect}\n\ -@end deftypefn"), - - pair_type ("endfor", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endfor\n\ -Mark the end of a for loop. See @code{for} for an example.\n\ -@seealso{for}\n\ -@end deftypefn"), - - pair_type ("endfunction", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endfunction\n\ -Mark the end of a function.\n\ -@seealso{function}\n\ -@end deftypefn"), - - pair_type ("endif", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endif\n\ -Mark the end of an if block. See @code{if} for an example.\n\ -@seealso{if}\n\ -@end deftypefn"), - - pair_type ("endparfor", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endparfor\n\ -Mark the end of a parfor loop. See @code{parfor} for an example.\n\ -@seealso{parfor}\n\ -@end deftypefn"), - - pair_type ("endswitch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endswitch\n\ -Mark the end of a switch block. See @code{switch} for an example.\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("endwhile", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endwhile\n\ -Mark the end of a while loop. See @code{while} for an example.\n\ -@seealso{do, while}\n\ -@end deftypefn"), - - pair_type ("for", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ -Begin a for loop.\n\ -\n\ -@example\n\ -@group\n\ -for i = 1:10\n\ - i\n\ -endfor\n\ -@end group\n\ -@end example\n\ -@seealso{do, parfor, while}\n\ -@end deftypefn"), - - pair_type ("function", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} function @var{outputs} = function (@var{input}, @dots{})\n\ -@deftypefnx {Keyword} {} function {} function (@var{input}, @dots{})\n\ -@deftypefnx {Keyword} {} function @var{outputs} = function\n\ -Begin a function body with @var{outputs} as results and @var{inputs} as\n\ -parameters.\n\ -@seealso{return}\n\ -@end deftypefn"), - - pair_type ("global", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} global\n\ -Declare variables to have global scope.\n\ -\n\ -@example\n\ -@group\n\ -global @var{x};\n\ -if (isempty (@var{x}))\n\ - x = 1;\n\ -endif\n\ -@end group\n\ -@end example\n\ -@seealso{persistent}\n\ -@end deftypefn"), - - pair_type ("if", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} if (@var{cond}) @dots{} endif\n\ -@deftypefnx {Keyword} {} if (@var{cond}) @dots{} else @dots{} endif\n\ -@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} endif\n\ -@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} else @dots{} endif\n\ -Begin an if block.\n\ -\n\ -@example\n\ -@group\n\ -x = 1;\n\ -if (x == 1)\n\ - disp (\"one\");\n\ -elseif (x == 2)\n\ - disp (\"two\");\n\ -else\n\ - disp (\"not one or two\");\n\ -endif\n\ -@end group\n\ -@end example\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("otherwise", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} otherwise\n\ -The default statement in a switch block (similar to else in an if block).\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("parfor", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ -@deftypefnx {Keyword} {} for (@var{i} = @var{range}, @var{maxproc})\n\ -Begin a for loop that may execute in parallel.\n\ -\n\ -@example\n\ -@group\n\ -parfor i = 1:10\n\ - i\n\ -endparfor\n\ -@end group\n\ -@end example\n\ -@seealso{for, do, while}\n\ -@end deftypefn"), - - pair_type ("persistent", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} persistent @var{var}\n\ -Declare variables as persistent. A variable that has been declared\n\ -persistent within a function will retain its contents in memory between\n\ -subsequent calls to the same function. The difference between persistent\n\ -variables and global variables is that persistent variables are local in \n\ -scope to a particular function and are not visible elsewhere.\n\ -@seealso{global}\n\ -@end deftypefn"), - - pair_type ("return", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} return\n\ -Return from a function.\n\ -@seealso{function}\n\ -@end deftypefn"), - - pair_type ("static", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} static\n\ -This function has been deprecated in favor of persistent.\n\ -@seealso{persistent}\n\ -@end deftypefn"), - - pair_type ("switch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} switch @var{statement}\n\ -Begin a switch block.\n\ -\n\ -@example\n\ -@group\n\ -yesno = \"yes\"\n\ -\n\ -switch yesno\n\ - case @{\"Yes\" \"yes\" \"YES\" \"y\" \"Y\"@}\n\ - value = 1;\n\ - case @{\"No\" \"no\" \"NO\" \"n\" \"N\"@}\n\ - value = 0;\n\ - otherwise\n\ - error (\"invalid value\");\n\ -endswitch\n\ -@end group\n\ -@end example\n\ -@seealso{if, case, otherwise}\n\ -@end deftypefn"), - - pair_type ("try", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} try\n\ -Begin a try-catch block.\n\ -\n\ -If an error occurs within a try block, then the catch code will be run and\n\ -execution will proceed after the catch block (though it is often\n\ -recommended to use the lasterr function to re-throw the error after cleanup\n\ -is completed).\n\ -@seealso{catch, unwind_protect}\n\ -@end deftypefn"), - - pair_type ("until", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} until\n\ -End a do-until loop.\n\ -@seealso{do}\n\ -@end deftypefn"), - - pair_type ("unwind_protect", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} unwind_protect\n\ -Begin an unwind_protect block.\n\ -\n\ -If an error occurs within the first part of an unwind_protect block\n\ -the commands within the unwind_protect_cleanup block are executed before\n\ -the error is thrown. If an error is not thrown, then the\n\ -unwind_protect_cleanup block is still executed (in other words, the\n\ -unwind_protect_cleanup will be run with or without an error in the\n\ -unwind_protect block).\n\ -@seealso{unwind_protect_cleanup, try}\n\ -@end deftypefn"), - - pair_type ("unwind_protect_cleanup", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} unwind_protect_cleanup\n\ -Begin the cleanup section of an unwind_protect block.\n\ -@seealso{unwind_protect}\n\ -@end deftypefn"), - - pair_type ("varargin", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} varargin\n\ -Pass an arbitrary number of arguments into a function.\n\ -@seealso{varargout, nargin, isargout, nargout, nthargout}\n\ -@end deftypefn"), - - pair_type ("varargout", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} varargout\n\ -Pass an arbitrary number of arguments out of a function.\n\ -@seealso{varargin, nargin, isargout, nargout, nthargout}\n\ -@end deftypefn"), - - pair_type ("while", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} while\n\ -Begin a while loop.\n\ -@seealso{do}\n\ -@end deftypefn"), -}; - -// Return a copy of the operator or keyword names. -static string_vector -names (const map_type& lst) -{ - string_vector retval (lst.size ()); - int j = 0; - for (map_iter iter = lst.begin (); iter != lst.end (); iter ++) - retval[j++] = iter->first; - return retval; -} - -const static map_type operators_map (operators, operators + size (operators)); -const static map_type keywords_map (keywords, keywords + size (keywords)); -const static string_vector keyword_names = names (keywords_map); - -// FIXME -- It's not likely that this does the right thing now. - -string_vector -make_name_list (void) -{ - const int key_len = keyword_names.length (); - - const string_vector bif = symbol_table::built_in_function_names (); - const int bif_len = bif.length (); - - const string_vector cfl = symbol_table::cmdline_function_names (); - const int cfl_len = cfl.length (); - - const string_vector lcl = symbol_table::variable_names (); - const int lcl_len = lcl.length (); - - const string_vector ffl = load_path::fcn_names (); - const int ffl_len = ffl.length (); - - const string_vector afl = autoloaded_functions (); - const int afl_len = afl.length (); - - const int total_len - = key_len + bif_len + cfl_len + lcl_len + ffl_len + afl_len; - - string_vector list (total_len); - - // Put all the symbols in one big list. - - int j = 0; - int i = 0; - for (i = 0; i < key_len; i++) - list[j++] = keyword_names[i]; - - for (i = 0; i < bif_len; i++) - list[j++] = bif[i]; - - for (i = 0; i < cfl_len; i++) - list[j++] = cfl[i]; - - for (i = 0; i < lcl_len; i++) - list[j++] = lcl[i]; - - for (i = 0; i < ffl_len; i++) - list[j++] = ffl[i]; - - for (i = 0; i < afl_len; i++) - list[j++] = afl[i]; - - return list; -} - -static bool -looks_like_html (const std::string& msg) -{ - const size_t p1 = msg.find ('\n'); - std::string t = msg.substr (0, p1); - const size_t p2 = t.find ("doc_string (); - - retval = true; - - w = fcn->fcn_file_name (); - - if (w.empty ()) - w = fcn->is_user_function () - ? "command-line function" : "built-in function"; - } - } - - return retval; -} - -static bool -raw_help_from_file (const std::string& nm, std::string& h, - std::string& file, bool& symbol_found) -{ - bool retval = false; - - // FIXME -- this is a bit of a kluge... - unwind_protect frame; - frame.protect_var (reading_script_file); - reading_script_file = true; - - h = get_help_from_file (nm, symbol_found, file); - - if (h.length () > 0) - retval = true; - - return retval; -} - -static bool -raw_help_from_map (const std::string& nm, std::string& h, - const map_type& map, bool& symbol_found) -{ - map_iter idx = map.find (nm); - symbol_found = (idx != map.end ()); - h = (symbol_found) ? idx->second : ""; - return symbol_found; -} - -std::string -raw_help (const std::string& nm, bool& symbol_found) -{ - std::string h; - std::string w; - std::string f; - - (raw_help_from_symbol_table (nm, h, w, symbol_found) - || raw_help_from_file (nm, h, f, symbol_found) - || raw_help_from_map (nm, h, operators_map, symbol_found) - || raw_help_from_map (nm, h, keywords_map, symbol_found)); - - return h; -} - -static void -do_get_help_text (const std::string& name, std::string& text, - std::string& format) -{ - bool symbol_found = false; - text = raw_help (name, symbol_found); - - format = "Not found"; - if (symbol_found) - { - size_t idx = -1; - if (text.empty ()) - { - format = "Not documented"; - } - else if (looks_like_texinfo (text, idx)) - { - format = "texinfo"; - text.erase (0, idx); - } - else if (looks_like_html (text)) - { - format = "html"; - } - else - { - format = "plain text"; - } - } -} - -DEFUN (get_help_text, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text (@var{name})\n\ -Return the raw help text of function @var{name}.\n\ -\n\ -The raw help text is returned in @var{text} and the format in @var{format}\n\ -The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ -@t{\"plain text\"}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - const std::string name = args (0).string_value (); - - if (! error_state) - { - std::string text; - std::string format; - - do_get_help_text (name, text, format); - - retval(1) = format; - retval(0) = text; - } - else - error ("get_help_text: invalid input"); - } - else - print_usage (); - - return retval; -} - -static void -do_get_help_text_from_file (const std::string& fname, std::string& text, - std::string& format) -{ - bool symbol_found = false; - - std::string f; - - raw_help_from_file (fname, text, f, symbol_found); - - format = "Not found"; - if (symbol_found) - { - size_t idx = -1; - if (text.empty ()) - { - format = "Not documented"; - } - else if (looks_like_texinfo (text, idx)) - { - format = "texinfo"; - text.erase (0, idx); - } - else if (looks_like_html (text)) - { - format = "html"; - } - else - { - format = "plain text"; - } - } -} - -DEFUN (get_help_text_from_file, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text_from_file (@var{fname})\n\ -Return the raw help text from the file @var{fname}.\n\ -\n\ -The raw help text is returned in @var{text} and the format in @var{format}\n\ -The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ -@t{\"plain text\"}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - const std::string fname = args(0).string_value (); - - if (! error_state) - { - std::string text; - std::string format; - - do_get_help_text_from_file (fname, text, format); - - retval(1) = format; - retval(0) = text; - } - else - error ("get_help_text_from_file: invalid input"); - } - else - print_usage (); - - return retval; -} - -// Return a cell array of strings containing the names of all -// operators. - -DEFUN (__operators__, , , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __operators__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return octave_value (Cell (names (operators_map))); -} - -// Return a cell array of strings containing the names of all -// keywords. - -DEFUN (__keywords__, , , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __keywords__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return octave_value (Cell (names (keywords_map))); -} - -// Return a cell array of strings containing the names of all builtin -// functions. - -DEFUN (__builtins__, , , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __builtins__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - const string_vector bif = symbol_table::built_in_function_names (); - - return octave_value (Cell (bif)); -} - -static std::string -do_which (const std::string& name, std::string& type) -{ - std::string file; - - type = std::string (); - - octave_value val = symbol_table::find_function (name); - - if (name.find_first_of ('.') == std::string::npos) - { - if (val.is_defined ()) - { - octave_function *fcn = val.function_value (); - - if (fcn) - { - file = fcn->fcn_file_name (); - - if (file.empty ()) - { - if (fcn->is_user_function ()) - type = "command-line function"; - else - { - file = fcn->src_file_name (); - type = "built-in function"; - } - } - else - type = val.is_user_script () - ? std::string ("script") : std::string ("function"); - } - } - else - { - // We might find a file that contains only a doc string. - - file = load_path::find_fcn_file (name); - } - } - else - { - // File query. - - // For compatibility: "file." queries "file". - if (name.size () > 1 && name[name.size () - 1] == '.') - file = load_path::find_file (name.substr (0, name.size () - 1)); - else - file = load_path::find_file (name); - } - - - return file; -} - -std::string -do_which (const std::string& name) -{ - std::string retval; - - std::string type; - - retval = do_which (name, type); - - return retval; -} - -DEFUN (__which__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __which__ (@var{name}, @dots{})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - string_vector argv = args.make_argv ("which"); - - if (! error_state) - { - int argc = argv.length (); - - if (argc > 1) - { - octave_map m (dim_vector (1, argc-1)); - - Cell names (1, argc-1); - Cell files (1, argc-1); - Cell types (1, argc-1); - - for (int i = 1; i < argc; i++) - { - std::string name = argv[i]; - - std::string type; - - std::string file = do_which (name, type); - - names(i-1) = name; - files(i-1) = file; - types(i-1) = type; - } - - m.assign ("name", names); - m.assign ("file", files); - m.assign ("type", types); - - retval = m; - } - else - print_usage (); - } - - return retval; -} - -// FIXME -- Are we sure this function always does the right thing? -inline bool -file_is_in_dir (const std::string filename, const std::string dir) -{ - if (filename.find (dir) == 0) - { - const int dir_len = dir.size (); - const int filename_len = filename.size (); - const int max_allowed_seps = file_ops::is_dir_sep (dir[dir_len-1]) ? 0 : 1; - - int num_seps = 0; - for (int i = dir_len; i < filename_len; i++) - if (file_ops::is_dir_sep (filename[i])) - num_seps ++; - - return (num_seps <= max_allowed_seps); - } - else - return false; -} - -// Return a cell array of strings containing the names of all -// functions available in DIRECTORY. If no directory is given, search -// the current path. - -DEFUN (__list_functions__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} {@var{retval} =} __list_functions__ ()\n\ -@deftypefnx {Function File} {@var{retval} =} __list_functions__ (@var{directory})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - // Get list of functions - string_vector ffl = load_path::fcn_names (); - string_vector afl = autoloaded_functions (); - - if (args.length () == 0) - retval = Cell (ffl.append (afl)); - else - { - std::string dir = args (0).string_value (); - - if (! error_state) - { - string_vector fl = load_path::files (dir, true); - - if (! error_state) - { - // Return a sorted list with unique entries (in case of - // .m and .oct versions of the same function in a given - // directory, for example). - fl.sort (true); - - retval = Cell (fl); - } - } - else - error ("__list_functions__: DIRECTORY argument must be a string"); - } - - return retval; -} - -DEFUN (doc_cache_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} doc_cache_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} doc_cache_file (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} doc_cache_file (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -Octave documentation cache file. A cache file significantly improves\n\ -the performance of the @code{lookfor} command. The default value is \n\ -@file{@var{octave-home}/share/octave/@var{version}/etc/doc-cache},\n\ -in which @var{octave-home} is the root directory of the Octave installation,\n\ -and @var{version} is the Octave version number.\n\ -The default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_DOC_CACHE_FILE}}, or the command line argument\n\ -@samp{--doc-cache-file NAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{lookfor, info_program, doc, help, makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (doc_cache_file); -} - -DEFUN (texi_macros_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} texi_macros_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} texi_macros_file (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} texi_macros_file (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -file containing Texinfo macros that are prepended to documentation strings\n\ -before they are passed to makeinfo. The default value is \n\ -@file{@var{octave-home}/share/octave/@var{version}/etc/macros.texi},\n\ -in which @var{octave-home} is the root directory of the Octave installation,\n\ -and @var{version} is the Octave version number.\n\ -The default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_TEXI_MACROS_FILE}}, or the command line argument\n\ -@samp{--texi-macros-file NAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (texi_macros_file); -} - -DEFUN (info_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} info_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} info_file (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} info_file (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -Octave info file. The default value is\n\ -@file{@var{octave-home}/info/octave.info}, in\n\ -which @var{octave-home} is the root directory of the Octave installation.\n\ -The default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_INFO_FILE}}, or the command line argument\n\ -@samp{--info-file NAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{info_program, doc, help, makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_file); -} - -DEFUN (info_program, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} info_program ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} info_program (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} info_program (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -info program to run. The default value is\n\ -@file{@var{octave-home}/libexec/octave/@var{version}/exec/@var{arch}/info}\n\ -in which @var{octave-home} is the root directory of the Octave installation,\n\ -@var{version} is the Octave version number, and @var{arch}\n\ -is the system type (for example, @code{i686-pc-linux-gnu}). The\n\ -default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_INFO_PROGRAM}}, or the command line argument\n\ -@samp{--info-program NAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{info_file, doc, help, makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_program); -} - -DEFUN (makeinfo_program, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} makeinfo_program ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} makeinfo_program (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} makeinfo_program (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -program that Octave runs to format help text containing\n\ -Texinfo markup commands. The default value is @code{makeinfo}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{texi_macros_file, info_file, info_program, doc, help}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (makeinfo_program); -} - -DEFUN (suppress_verbose_help_message, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} suppress_verbose_help_message ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} suppress_verbose_help_message (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} suppress_verbose_help_message (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave\n\ -will add additional help information to the end of the output from\n\ -the @code{help} command and usage messages for built-in commands.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (suppress_verbose_help_message); -} diff -r d02b229ce693 -r a132d206a36a src/help.h --- a/src/help.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_help_h) -#define octave_help_h 1 - -#include -#include - -class string_vector; - -extern string_vector make_name_list (void); - -extern OCTINTERP_API std::string raw_help (const std::string&, bool&); - -// Name of the doc cache file specified on the command line. -// (--doc-cache-file file) -extern std::string Vdoc_cache_file; - -// Name of the file containing local Texinfo macros that are prepended -// to doc strings before processing. -// (--texi-macros-file) -extern std::string Vtexi_macros_file; - -// Name of the info file specified on command line. -// (--info-file file) -extern std::string Vinfo_file; - -// Name of the info reader we'd like to use. -// (--info-program program) -extern std::string Vinfo_program; - -extern std::string do_which (const std::string& name); - -#endif diff -r d02b229ce693 -r a132d206a36a src/input.cc --- a/src/input.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1570 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Get command input interactively or from files. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include - -#include -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "file-ops.h" -#include "quit.h" -#include "str-vec.h" - -#include "debug.h" -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "lex.h" -#include "load-path.h" -#include "oct-map.h" -#include "oct-hist.h" -#include "toplev.h" -#include "oct-obj.h" -#include "pager.h" -#include "parse.h" -#include "pathlen.h" -#include "pt.h" -#include "pt-const.h" -#include "pt-eval.h" -#include "pt-stmt.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Primary prompt string. -static std::string VPS1 = "\\s:\\#> "; - -// Secondary prompt string. -static std::string VPS2 = "> "; - -// String printed before echoed input (enabled by --echo-input). -std::string VPS4 = "+ "; - -// Echo commands as they are executed? -// -// 1 ==> echo commands read from script files -// 2 ==> echo commands from functions -// 4 ==> echo commands read from command line -// -// more than one state can be active at once. -int Vecho_executing_commands = ECHO_OFF; - -// The time we last printed a prompt. -octave_time Vlast_prompt_time = 0.0; - -// Character to append after successful command-line completion attempts. -static char Vcompletion_append_char = ' '; - -// Global pointer for eval(). -std::string current_eval_string; - -// TRUE means get input from current_eval_string. -bool get_input_from_eval_string = false; - -// TRUE means we haven't been asked for the input from -// current_eval_string yet. -bool input_from_eval_string_pending = false; - -// TRUE means that input is coming from a file that was named on -// the command line. -bool input_from_command_line_file = false; - -// TRUE means that stdin is a terminal, not a pipe or redirected file. -bool stdin_is_tty = false; - -// TRUE means we're parsing a function file. -bool reading_fcn_file = false; - -// TRUE means we're parsing a classdef file. -bool reading_classdef_file = false; - -// Simple name of function file we are reading. -std::string curr_fcn_file_name; - -// Full name of file we are reading. -std::string curr_fcn_file_full_name; - -// TRUE means we're parsing a script file. -bool reading_script_file = false; - -// If we are reading from an M-file, this is it. -FILE *ff_instream = 0; - -// TRUE means this is an interactive shell. -bool interactive = false; - -// TRUE means the user forced this shell to be interactive (-i). -bool forced_interactive = false; - -// Should we issue a prompt? -int promptflag = 1; - -// The current line of input, from wherever. -std::string current_input_line; - -// TRUE after a call to completion_matches. -bool octave_completion_matches_called = false; - -// TRUE if the plotting system has requested a call to drawnow at -// the next user prompt. -bool Vdrawnow_requested = false; - -// TRUE if we are in debugging mode. -bool Vdebugging = false; - -// If we are in debugging mode, this is the last command entered, so -// that we can repeat the previous command if the user just types RET. -static std::string last_debugging_command; - -// TRUE if we are running in the Emacs GUD mode. -static bool Vgud_mode = false; - -// The filemarker used to separate filenames from subfunction names -char Vfilemarker = '>'; - -static void -do_input_echo (const std::string& input_string) -{ - int do_echo = reading_script_file ? - (Vecho_executing_commands & ECHO_SCRIPTS) - : (Vecho_executing_commands & ECHO_CMD_LINE) && ! forced_interactive; - - if (do_echo) - { - if (forced_interactive) - { - if (promptflag > 0) - octave_stdout << command_editor::decode_prompt_string (VPS1); - else - octave_stdout << command_editor::decode_prompt_string (VPS2); - } - else - octave_stdout << command_editor::decode_prompt_string (VPS4); - - if (! input_string.empty ()) - { - octave_stdout << input_string; - - if (input_string[input_string.length () - 1] != '\n') - octave_stdout << "\n"; - } - } -} - -std::string -gnu_readline (const std::string& s, bool force_readline) -{ - octave_quit (); - - std::string retval; - - if (line_editing || force_readline) - { - bool eof; - - retval = command_editor::readline (s, eof); - - if (! eof && retval.empty ()) - retval = "\n"; - } - else - { - if (! s.empty () && (interactive || forced_interactive)) - { - FILE *stream = command_editor::get_output_stream (); - - gnulib::fputs (s.c_str (), stream); - gnulib::fflush (stream); - } - - FILE *curr_stream = command_editor::get_input_stream (); - - if (reading_fcn_file || reading_script_file || reading_classdef_file) - curr_stream = ff_instream; - - retval = octave_fgets (curr_stream); - } - - return retval; -} - -static inline std::string -interactive_input (const std::string& s, bool force_readline = false) -{ - Vlast_prompt_time.stamp (); - - if (Vdrawnow_requested && (interactive || forced_interactive)) - { - feval ("drawnow"); - - flush_octave_stdout (); - - // We set Vdrawnow_requested to false even if there is an error - // in drawnow so that the error doesn't reappear at every prompt. - - Vdrawnow_requested = false; - - if (error_state) - return "\n"; - } - - return gnu_readline (s, force_readline); -} - -static std::string -octave_gets (void) -{ - octave_quit (); - - std::string retval; - - bool history_skip_auto_repeated_debugging_command = false; - - if ((interactive || forced_interactive) - && (! (reading_fcn_file - || reading_classdef_file - || reading_script_file - || get_input_from_eval_string - || input_from_startup_file - || input_from_command_line_file))) - { - std::string ps = (promptflag > 0) ? VPS1 : VPS2; - - std::string prompt = command_editor::decode_prompt_string (ps); - - pipe_handler_error_count = 0; - - flush_octave_stdout (); - - octave_pager_stream::reset (); - octave_diary_stream::reset (); - - octave_diary << prompt; - - retval = interactive_input (prompt); - - // There is no need to update the load_path cache if there is no - // user input. - if (! retval.empty () - && retval.find_first_not_of (" \t\n\r") != std::string::npos) - { - load_path::update (); - - if (Vdebugging) - last_debugging_command = retval; - else - last_debugging_command = std::string (); - } - else if (Vdebugging) - { - retval = last_debugging_command; - history_skip_auto_repeated_debugging_command = true; - } - } - else - retval = gnu_readline (""); - - current_input_line = retval; - - if (! current_input_line.empty ()) - { - if (! (input_from_startup_file || input_from_command_line_file - || history_skip_auto_repeated_debugging_command)) - command_history::add (current_input_line); - - if (! (reading_fcn_file || reading_script_file || reading_classdef_file)) - { - octave_diary << current_input_line; - - if (current_input_line[current_input_line.length () - 1] != '\n') - octave_diary << "\n"; - } - - do_input_echo (current_input_line); - } - else if (! (reading_fcn_file || reading_script_file || reading_classdef_file)) - octave_diary << "\n"; - - return retval; -} - -// Read a line from the input stream. - -static std::string -get_user_input (void) -{ - octave_quit (); - - std::string retval; - - if (get_input_from_eval_string) - { - if (input_from_eval_string_pending) - { - input_from_eval_string_pending = false; - - retval = current_eval_string; - - size_t len = retval.length (); - - if (len > 0 && retval[len-1] != '\n') - retval.append ("\n"); - } - } - else - retval = octave_gets (); - - current_input_line = retval; - - return retval; -} - -int -octave_read (char *buf, unsigned max_size) -{ - // FIXME -- is this a safe way to buffer the input? - - static const char * const eol = "\n"; - static std::string input_buf; - static const char *pos = 0; - static size_t chars_left = 0; - - int status = 0; - if (chars_left == 0) - { - pos = 0; - - input_buf = get_user_input (); - - chars_left = input_buf.length (); - - pos = input_buf.c_str (); - } - - if (chars_left > 0) - { - size_t len = max_size > chars_left ? chars_left : max_size; - assert (len > 0); - - memcpy (buf, pos, len); - - chars_left -= len; - pos += len; - - // Make sure input ends with a new line character. - if (chars_left == 0 && buf[len-1] != '\n') - { - if (len < max_size) - { - // There is enough room to plug the newline character in - // the buffer. - buf[len++] = '\n'; - } - else - { - // There isn't enough room to plug the newline character - // in the buffer so make sure it is returned on the next - // octave_read call. - pos = eol; - chars_left = 1; - } - } - - status = len; - - } - else if (chars_left == 0) - { - status = 0; - } - else - status = -1; - - return status; -} - -// Fix things up so that input can come from file `name', printing a -// warning if the file doesn't exist. - -FILE * -get_input_from_file (const std::string& name, int warn) -{ - FILE *instream = 0; - - if (name.length () > 0) - instream = gnulib::fopen (name.c_str (), "rb"); - - if (! instream && warn) - warning ("%s: no such file or directory", name.c_str ()); - - if (reading_fcn_file || reading_script_file || reading_classdef_file) - ff_instream = instream; - else - command_editor::set_input_stream (instream); - - return instream; -} - -// Fix things up so that input can come from the standard input. This -// may need to become much more complicated, which is why it's in a -// separate function. - -FILE * -get_input_from_stdin (void) -{ - command_editor::set_input_stream (stdin); - return command_editor::get_input_stream (); -} - -// FIXME -- make this generate file names when appropriate. - -static string_vector -generate_possible_completions (const std::string& text, std::string& prefix, - std::string& hint) -{ - string_vector names; - - prefix = ""; - - if (looks_like_struct (text)) - names = generate_struct_completions (text, prefix, hint); - else - names = make_name_list (); - - // Sort and remove duplicates. - - names.sort (true); - - return names; -} - -static bool -is_completing_dirfns (void) -{ - static std::string dirfns_commands[] = {"cd", "ls"}; - static const size_t dirfns_commands_length = 2; - - bool retval = false; - - std::string line = command_editor::get_line_buffer (); - - for (size_t i = 0; i < dirfns_commands_length; i++) - { - int index = line.find (dirfns_commands[i] + " "); - - if (index == 0) - { - retval = true; - break; - } - } - - return retval; -} - -static std::string -generate_completion (const std::string& text, int state) -{ - std::string retval; - - static std::string prefix; - static std::string hint; - - static size_t hint_len = 0; - - static int list_index = 0; - static int name_list_len = 0; - static int name_list_total_len = 0; - static string_vector name_list; - static string_vector file_name_list; - - static int matches = 0; - - if (state == 0) - { - list_index = 0; - - prefix = ""; - - hint = text; - - // No reason to display symbols while completing a - // file/directory operation. - - if (is_completing_dirfns ()) - name_list = string_vector (); - else - name_list = generate_possible_completions (text, prefix, hint); - - name_list_len = name_list.length (); - - file_name_list = command_editor::generate_filename_completions (text); - - name_list.append (file_name_list); - - name_list_total_len = name_list.length (); - - hint_len = hint.length (); - - matches = 0; - - for (int i = 0; i < name_list_len; i++) - if (hint == name_list[i].substr (0, hint_len)) - matches++; - } - - if (name_list_total_len > 0 && matches > 0) - { - while (list_index < name_list_total_len) - { - std::string name = name_list[list_index]; - - list_index++; - - if (hint == name.substr (0, hint_len)) - { - if (list_index <= name_list_len && ! prefix.empty ()) - retval = prefix + "." + name; - else - retval = name; - - // FIXME -- looks_like_struct is broken for now, - // so it always returns false. - - if (matches == 1 && looks_like_struct (retval)) - { - // Don't append anything, since we don't know - // whether it should be '(' or '.'. - - command_editor::set_completion_append_character ('\0'); - } - else - command_editor::set_completion_append_character - (Vcompletion_append_char); - - break; - } - } - } - - return retval; -} - -static std::string -quoting_filename (const std::string &text, int, char quote) -{ - if (quote) - return text; - else - return (std::string ("'") + text); -} - -void -initialize_command_input (void) -{ - // If we are using readline, this allows conditional parsing of the - // .inputrc file. - - command_editor::set_name ("Octave"); - - // FIXME -- this needs to include a comma too, but that - // causes trouble for the new struct element completion code. - - static const char *s = "\t\n !\"\'*+-/:;<=>(){}[\\]^`~"; - - command_editor::set_basic_word_break_characters (s); - - command_editor::set_completer_word_break_characters (s); - - command_editor::set_basic_quote_characters ("\""); - - command_editor::set_filename_quote_characters (" \t\n\\\"'@<>=;|&()#$`?*[!:{"); - command_editor::set_completer_quote_characters ("'\""); - - command_editor::set_completion_function (generate_completion); - - command_editor::set_quoting_function (quoting_filename); -} - -static void -get_debug_input (const std::string& prompt) -{ - octave_user_code *caller = octave_call_stack::caller_user_code (); - std::string nm; - - int curr_debug_line = octave_call_stack::current_line (); - - bool have_file = false; - - if (caller) - { - nm = caller->fcn_file_name (); - - if (nm.empty ()) - nm = caller->name (); - else - have_file = true; - } - else - curr_debug_line = -1; - - std::ostringstream buf; - - if (! nm.empty ()) - { - if (Vgud_mode) - { - static char ctrl_z = 'Z' & 0x1f; - - buf << ctrl_z << ctrl_z << nm << ":" << curr_debug_line; - } - else - { - // FIXME -- we should come up with a clean way to detect - // that we are stopped on the no-op command that marks the - // end of a function or script. - - buf << "stopped in " << nm; - - if (curr_debug_line > 0) - buf << " at line " << curr_debug_line; - - if (have_file) - { - std::string line_buf - = get_file_line (nm, curr_debug_line); - - if (! line_buf.empty ()) - buf << "\n" << curr_debug_line << ": " << line_buf; - } - } - } - - std::string msg = buf.str (); - - if (! msg.empty ()) - std::cerr << msg << std::endl; - - unwind_protect frame; - - frame.protect_var (VPS1); - VPS1 = prompt; - - if (! (interactive || forced_interactive) - || (reading_fcn_file - || reading_classdef_file - || reading_script_file - || get_input_from_eval_string - || input_from_startup_file - || input_from_command_line_file)) - { - frame.protect_var (forced_interactive); - forced_interactive = true; - - frame.protect_var (reading_fcn_file); - reading_fcn_file = false; - - frame.protect_var (reading_classdef_file); - reading_classdef_file = false; - - frame.protect_var (reading_script_file); - reading_script_file = false; - - frame.protect_var (input_from_startup_file); - input_from_startup_file = false; - - frame.protect_var (input_from_command_line_file); - input_from_command_line_file = false; - - frame.protect_var (get_input_from_eval_string); - get_input_from_eval_string = false; - - YY_BUFFER_STATE old_buf = current_buffer (); - YY_BUFFER_STATE new_buf = create_buffer (get_input_from_stdin ()); - - // FIXME: are these safe? - frame.add_fcn (switch_to_buffer, old_buf); - frame.add_fcn (delete_buffer, new_buf); - - switch_to_buffer (new_buf); - } - - while (Vdebugging) - { - reset_error_handler (); - - reset_parser (); - - // Save current value of global_command. - frame.protect_var (global_command); - - global_command = 0; - - // Do this with an unwind-protect cleanup function so that the - // forced variables will be unmarked in the event of an interrupt. - symbol_table::scope_id scope = symbol_table::top_scope (); - frame.add_fcn (symbol_table::unmark_forced_variables, scope); - - // This is the same as yyparse in parse.y. - int retval = octave_parse (); - - if (retval == 0 && global_command) - { - unwind_protect inner_frame; - - // Use an unwind-protect cleanup function so that the - // global_command list will be deleted in the event of an - // interrupt. - - inner_frame.add_fcn (cleanup_statement_list, &global_command); - - global_command->accept (*current_evaluator); - - if (octave_completion_matches_called) - octave_completion_matches_called = false; - } - - // Unmark forced variables. - // Restore previous value of global_command. - frame.run_top (2); - - octave_quit (); - } -} - -// If the user simply hits return, this will produce an empty matrix. - -static octave_value_list -get_user_input (const octave_value_list& args, int nargout) -{ - octave_value_list retval; - - int nargin = args.length (); - - int read_as_string = 0; - - if (nargin == 2) - read_as_string++; - - std::string prompt = args(0).string_value (); - - if (error_state) - { - error ("input: unrecognized argument"); - return retval; - } - - flush_octave_stdout (); - - octave_pager_stream::reset (); - octave_diary_stream::reset (); - - octave_diary << prompt; - - std::string input_buf = interactive_input (prompt.c_str (), true); - - if (! (error_state || input_buf.empty ())) - { - if (! input_from_startup_file) - command_history::add (input_buf); - - size_t len = input_buf.length (); - - octave_diary << input_buf; - - if (input_buf[len - 1] != '\n') - octave_diary << "\n"; - - if (len < 1) - return read_as_string ? octave_value ("") : octave_value (Matrix ()); - - if (read_as_string) - { - // FIXME -- fix gnu_readline and octave_gets instead! - if (input_buf.length () == 1 && input_buf[0] == '\n') - retval(0) = ""; - else - retval(0) = input_buf; - } - else - { - int parse_status = 0; - - retval = eval_string (input_buf, true, parse_status, nargout); - - if (! Vdebugging && retval.length () == 0) - retval(0) = Matrix (); - } - } - else - error ("input: reading user-input failed!"); - - return retval; -} - -DEFUN (input, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} input (@var{prompt})\n\ -@deftypefnx {Built-in Function} {} input (@var{prompt}, \"s\")\n\ -Print a prompt and wait for user input. For example,\n\ -\n\ -@example\n\ -input (\"Pick a number, any number! \")\n\ -@end example\n\ -\n\ -@noindent\n\ -prints the prompt\n\ -\n\ -@example\n\ -Pick a number, any number!\n\ -@end example\n\ -\n\ -@noindent\n\ -and waits for the user to enter a value. The string entered by the user\n\ -is evaluated as an expression, so it may be a literal constant, a\n\ -variable name, or any other valid expression.\n\ -\n\ -Currently, @code{input} only returns one value, regardless of the number\n\ -of values produced by the evaluation of the expression.\n\ -\n\ -If you are only interested in getting a literal string value, you can\n\ -call @code{input} with the character string @code{\"s\"} as the second\n\ -argument. This tells Octave to return the string entered by the user\n\ -directly, without evaluating it first.\n\ -\n\ -Because there may be output waiting to be displayed by the pager, it is\n\ -a good idea to always call @code{fflush (stdout)} before calling\n\ -@code{input}. This will ensure that all pending output is written to\n\ -the screen before your prompt. @xref{Input and Output}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - retval = get_user_input (args, nargout); - else - print_usage (); - - return retval; -} - -bool -octave_yes_or_no (const std::string& prompt) -{ - std::string prompt_string = prompt + "(yes or no) "; - - while (1) - { - std::string input_buf = interactive_input (prompt_string, true); - - if (input_buf == "yes") - return true; - else if (input_buf == "no") - return false; - else - message (0, "Please answer yes or no."); - } -} - -DEFUN (yes_or_no, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} yes_or_no (@var{prompt})\n\ -Ask the user a yes-or-no question. Return 1 if the answer is yes.\n\ -Takes one argument, which is the string to display to ask the\n\ -question. It should end in a space; @samp{yes-or-no-p} adds\n\ -@samp{(yes or no) } to it. The user must confirm the answer with\n\ -RET and can edit it until it has been confirmed.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0 || nargin == 1) - { - std::string prompt; - - if (nargin == 1) - { - prompt = args(0).string_value (); - - if (error_state) - { - error ("yes_or_no: PROMPT must be a character string"); - return retval; - } - } - - retval = octave_yes_or_no (prompt); - } - else - print_usage (); - - return retval; -} - -octave_value -do_keyboard (const octave_value_list& args) -{ - octave_value retval; - - int nargin = args.length (); - - assert (nargin == 0 || nargin == 1); - - unwind_protect frame; - - frame.add_fcn (command_history::ignore_entries, - command_history::ignoring_entries ()); - - command_history::ignore_entries (false); - - frame.protect_var (Vdebugging); - - frame.add_fcn (octave_call_stack::restore_frame, - octave_call_stack::current_frame ()); - - // FIXME -- probably we just want to print one line, not the - // entire statement, which might span many lines... - // - // tree_print_code tpc (octave_stdout); - // stmt.accept (tpc); - - Vdebugging = true; - - std::string prompt = "debug> "; - if (nargin > 0) - prompt = args(0).string_value (); - - if (! error_state) - get_debug_input (prompt); - - return retval; -} - -DEFUN (keyboard, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} keyboard ()\n\ -@deftypefnx {Built-in Function} {} keyboard (@var{prompt})\n\ -This function is normally used for simple debugging. When the\n\ -@code{keyboard} function is executed, Octave prints a prompt and waits\n\ -for user input. The input strings are then evaluated and the results\n\ -are printed. This makes it possible to examine the values of variables\n\ -within a function, and to assign new values if necessary. To leave the\n\ -prompt and return to normal execution type @samp{return} or @samp{dbcont}.\n\ -The @code{keyboard} function does not return an exit status.\n\ -\n\ -If @code{keyboard} is invoked without arguments, a default prompt of\n\ -@samp{debug> } is used.\n\ -@seealso{dbcont, dbquit}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0 || nargin == 1) - { - unwind_protect frame; - - frame.add_fcn (octave_call_stack::restore_frame, - octave_call_stack::current_frame ()); - - // Skip the frame assigned to the keyboard function. - octave_call_stack::goto_frame_relative (0); - - tree_evaluator::debug_mode = true; - - tree_evaluator::current_frame = octave_call_stack::current_frame (); - - do_keyboard (args); - } - else - print_usage (); - - return retval; -} - -DEFUN (echo, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} echo options\n\ -Control whether commands are displayed as they are executed. Valid\n\ -options are:\n\ -\n\ -@table @code\n\ -@item on\n\ -Enable echoing of commands as they are executed in script files.\n\ -\n\ -@item off\n\ -Disable echoing of commands as they are executed in script files.\n\ -\n\ -@item on all\n\ -Enable echoing of commands as they are executed in script files and\n\ -functions.\n\ -\n\ -@item off all\n\ -Disable echoing of commands as they are executed in script files and\n\ -functions.\n\ -@end table\n\ -\n\ -@noindent\n\ -With no arguments, @code{echo} toggles the current echo state.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("echo"); - - if (error_state) - return retval; - - switch (argc) - { - case 1: - { - if ((Vecho_executing_commands & ECHO_SCRIPTS) - || (Vecho_executing_commands & ECHO_FUNCTIONS)) - Vecho_executing_commands = ECHO_OFF; - else - Vecho_executing_commands = ECHO_SCRIPTS; - } - break; - - case 2: - { - std::string arg = argv[1]; - - if (arg == "on") - Vecho_executing_commands = ECHO_SCRIPTS; - else if (arg == "off") - Vecho_executing_commands = ECHO_OFF; - else - print_usage (); - } - break; - - case 3: - { - std::string arg = argv[1]; - - if (arg == "on" && argv[2] == "all") - { - int tmp = (ECHO_SCRIPTS | ECHO_FUNCTIONS); - Vecho_executing_commands = tmp; - } - else if (arg == "off" && argv[2] == "all") - Vecho_executing_commands = ECHO_OFF; - else - print_usage (); - } - break; - - default: - print_usage (); - break; - } - - return retval; -} - -DEFUN (completion_matches, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} completion_matches (@var{hint})\n\ -Generate possible completions given @var{hint}.\n\ -\n\ -This function is provided for the benefit of programs like Emacs which\n\ -might be controlling Octave and handling user input. The current\n\ -command number is not incremented when this function is called. This is\n\ -a feature, not a bug.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - std::string hint = args(0).string_value (); - - if (! error_state) - { - int n = 32; - - string_vector list (n); - - int k = 0; - - for (;;) - { - std::string cmd = generate_completion (hint, k); - - if (! cmd.empty ()) - { - if (k == n) - { - n *= 2; - list.resize (n); - } - - list[k++] = cmd; - } - else - { - list.resize (k); - break; - } - } - - if (nargout > 0) - { - if (! list.empty ()) - retval = list; - else - retval = ""; - } - else - { - // We don't use string_vector::list_in_columns here - // because it will be easier for Emacs if the names - // appear in a single column. - - int len = list.length (); - - for (int i = 0; i < len; i++) - octave_stdout << list[i] << "\n"; - } - - octave_completion_matches_called = true; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (read_readline_init_file, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} read_readline_init_file (@var{file})\n\ -Read the readline library initialization file @var{file}. If\n\ -@var{file} is omitted, read the default initialization file (normally\n\ -@file{~/.inputrc}).\n\ -\n\ -@xref{Readline Init File, , , readline, GNU Readline Library},\n\ -for details.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0) - command_editor::read_init_file (); - else if (nargin == 1) - { - std::string file = args(0).string_value (); - - if (! error_state) - command_editor::read_init_file (file); - } - else - print_usage (); - - return retval; -} - -DEFUN (re_read_readline_init_file, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} re_read_readline_init_file ()\n\ -Re-read the last readline library initialization file that was read.\n\ -@xref{Readline Init File, , , readline, GNU Readline Library},\n\ -for details.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 0) - command_editor::re_read_init_file (); - else - print_usage (); - - return retval; -} - -typedef std::map hook_fcn_map_type; - -static hook_fcn_map_type hook_fcn_map; - -static int -input_event_hook (void) -{ - if (! lexer_flags.defining_func) - { - hook_fcn_map_type::iterator p = hook_fcn_map.begin (); - - while (p != hook_fcn_map.end ()) - { - std::string hook_fcn = p->first; - octave_value user_data = p->second; - - hook_fcn_map_type::iterator q = p++; - - if (is_valid_function (hook_fcn)) - { - if (user_data.is_defined ()) - feval (hook_fcn, user_data, 0); - else - feval (hook_fcn, octave_value_list (), 0); - } - else - hook_fcn_map.erase (q); - } - - if (hook_fcn_map.empty ()) - command_editor::remove_event_hook (input_event_hook); - } - - return 0; -} - -DEFUN (add_input_event_hook, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} add_input_event_hook (@var{fcn})\n\ -@deftypefnx {Built-in Function} {} add_input_event_hook (@var{fcn}, @var{data})\n\ -Add the named function @var{fcn} to the list of functions to call\n\ -periodically when Octave is waiting for input. The function should\n\ -have the form\n\ -\n\ -@example\n\ -@var{fcn} (@var{data})\n\ -@end example\n\ -\n\ -If @var{data} is omitted, Octave calls the function without any\n\ -arguments.\n\ -@seealso{remove_input_event_hook}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_value user_data; - - if (nargin == 2) - user_data = args(1); - - std::string hook_fcn = args(0).string_value (); - - if (! error_state) - { - if (hook_fcn_map.empty ()) - command_editor::add_event_hook (input_event_hook); - - hook_fcn_map[hook_fcn] = user_data; - } - else - error ("add_input_event_hook: expecting string as first arg"); - } - else - print_usage (); - - return retval; -} - -DEFUN (remove_input_event_hook, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} remove_input_event_hook (@var{fcn})\n\ -Remove the named function @var{fcn} from the list of functions to call\n\ -periodically when Octave is waiting for input.\n\ -@seealso{add_input_event_hook}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1) - { - std::string hook_fcn = args(0).string_value (); - - if (! error_state) - { - hook_fcn_map_type::iterator p = hook_fcn_map.find (hook_fcn); - - if (p != hook_fcn_map.end ()) - hook_fcn_map.erase (p); - else - error ("remove_input_event_hook: %s not found in list", - hook_fcn.c_str ()); - - if (hook_fcn_map.empty ()) - command_editor::remove_event_hook (input_event_hook); - } - else - error ("remove_input_event_hook: expecting string as first arg"); - } - else - print_usage (); - - return retval; -} - -DEFUN (PS1, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PS1 ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PS1 (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PS1 (@var{new_val}, \"local\")\n\ -Query or set the primary prompt string. When executing interactively,\n\ -Octave displays the primary prompt when it is ready to read a command.\n\ -\n\ -The default value of the primary prompt string is @code{\"\\s:\\#> \"}.\n\ -To change it, use a command like\n\ -\n\ -@example\n\ -PS1 (\"\\\\u@@\\\\H> \")\n\ -@end example\n\ -\n\ -@noindent\n\ -which will result in the prompt @samp{boris@@kremvax> } for the user\n\ -@samp{boris} logged in on the host @samp{kremvax.kgb.su}. Note that two\n\ -backslashes are required to enter a backslash into a double-quoted\n\ -character string. @xref{Strings}.\n\ -\n\ -You can also use ANSI escape sequences if your terminal supports them.\n\ -This can be useful for coloring the prompt. For example,\n\ -\n\ -@example\n\ -PS1 (\"\\\\[\\\\033[01;31m\\\\]\\\\s:\\\\#> \\\\[\\\\033[0m\\\\]\")\n\ -@end example\n\ -\n\ -@noindent\n\ -will give the default Octave prompt a red coloring.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PS2, PS4}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (PS1); -} - -DEFUN (PS2, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PS2 ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PS2 (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PS2 (@var{new_val}, \"local\")\n\ -Query or set the secondary prompt string. The secondary prompt is\n\ -printed when Octave is expecting additional input to complete a\n\ -command. For example, if you are typing a @code{for} loop that spans several\n\ -lines, Octave will print the secondary prompt at the beginning of\n\ -each line after the first. The default value of the secondary prompt\n\ -string is @code{\"> \"}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PS1, PS4}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (PS2); -} - -DEFUN (PS4, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PS4 ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PS4 (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PS4 (@var{new_val}, \"local\")\n\ -Query or set the character string used to prefix output produced\n\ -when echoing commands is enabled.\n\ -The default value is @code{\"+ \"}.\n\ -@xref{Diary and Echo Commands}, for a description of echoing commands.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{echo, echo_executing_commands, PS1, PS2}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (PS4); -} - -DEFUN (completion_append_char, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} completion_append_char ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} completion_append_char (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} completion_append_char (@var{new_val}, \"local\")\n\ -Query or set the internal character variable that is appended to\n\ -successful command-line completion attempts. The default\n\ -value is @code{\" \"} (a single space).\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (completion_append_char); -} - -DEFUN (echo_executing_commands, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} echo_executing_commands ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} echo_executing_commands (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} echo_executing_commands (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls the echo state.\n\ -It may be the sum of the following values:\n\ -\n\ -@table @asis\n\ -@item 1\n\ -Echo commands read from script files.\n\ -\n\ -@item 2\n\ -Echo commands from functions.\n\ -\n\ -@item 4\n\ -Echo commands read from command line.\n\ -@end table\n\ -\n\ -More than one state can be active at once. For example, a value of 3 is\n\ -equivalent to the command @kbd{echo on all}.\n\ -\n\ -The value of @code{echo_executing_commands} may be set by the @kbd{echo}\n\ -command or the command line option @option{--echo-commands}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (echo_executing_commands); -} - -DEFUN (__request_drawnow__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __request_drawnow__ ()\n\ -@deftypefnx {Built-in Function} {} __request_drawnow__ (@var{flag})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - Vdrawnow_requested = true; - else if (nargin == 1) - Vdrawnow_requested = args(0).bool_value (); - else - print_usage (); - - return retval; -} - -DEFUN (__gud_mode__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __gud_mode__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = Vgud_mode; - else if (nargin == 1) - Vgud_mode = args(0).bool_value (); - else - print_usage (); - - return retval; -} - -DEFUN (filemarker, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} filemarker ()\n\ -@deftypefnx {Built-in Function} {} filemarker (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} filemarker (@var{new_val}, \"local\")\n\ -Query or set the character used to separate filename from the\n\ -the subfunction names contained within the file. This can be used in\n\ -a generic manner to interact with subfunctions. For example,\n\ -\n\ -@example\n\ -help ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ -@end example\n\ -\n\ -@noindent\n\ -returns the help string associated with the subfunction @code{mysubfunc}\n\ -of the function @code{myfunc}. Another use of @code{filemarker} is when\n\ -debugging it allows easier placement of breakpoints within subfunctions.\n\ -For example,\n\ -\n\ -@example\n\ -dbstop ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ -@end example\n\ -\n\ -@noindent\n\ -will set a breakpoint at the first line of the subfunction @code{mysubfunc}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - char tmp = Vfilemarker; - octave_value retval = SET_INTERNAL_VARIABLE (filemarker); - - // The character passed must not be a legal character for a function name - if (! error_state && (::isalnum (Vfilemarker) || Vfilemarker == '_')) - { - Vfilemarker = tmp; - error ("filemarker: character can not be a valid character for a function name"); - } - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/input.h --- a/src/input.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,123 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Use the GNU readline library for command line editing and hisory. - -#if !defined (octave_input_h) -#define octave_input_h 1 - -#include - -#include - -#include "oct-time.h" -#include "oct-obj.h" -#include "pager.h" - -class octave_value; - -extern OCTINTERP_API int octave_read (char *buf, unsigned max_size); -extern OCTINTERP_API FILE *get_input_from_file (const std::string& name, int warn = 1); -extern OCTINTERP_API FILE *get_input_from_stdin (void); - -// Global pointer for eval(). -extern std::string current_eval_string; - -// TRUE means get input from current_eval_string. -extern bool get_input_from_eval_string; - -// TRUE means we haven't been asked for the input from -// current_eval_string yet. -extern bool input_from_eval_string_pending; - -// TRUE means that input is coming from a file that was named on -// the command line. -extern bool input_from_command_line_file; - -// TRUE means that stdin is a terminal, not a pipe or redirected file. -extern bool stdin_is_tty; - -// TRUE means we're parsing a function file. -extern bool reading_fcn_file; - -// Simple name of function file we are reading. -extern std::string curr_fcn_file_name; - -// Full name of file we are reading. -extern std::string curr_fcn_file_full_name; - -// TRUE means we're parsing a script file. -extern bool reading_script_file; - -// TRUE means we're parsing a classdef file. -extern bool reading_classdef_file; - -// If we are reading from an M-file, this is it. -extern FILE *ff_instream; - -// TRUE means this is an interactive shell. -extern bool interactive; - -// TRUE means the user forced this shell to be interactive (-i). -extern bool forced_interactive; - -// Should we issue a prompt? -extern int promptflag; - -// A line of input. -extern std::string current_input_line; - -// TRUE after a call to completion_matches. -extern bool octave_completion_matches_called; - -// TRUE if the plotting system has requested a call to drawnow at -// the next user prompt. -extern OCTINTERP_API bool Vdrawnow_requested; - -// TRUE if we are in debugging mode. -extern OCTINTERP_API bool Vdebugging; - -extern std::string gnu_readline (const std::string& s, bool force_readline = false); - -extern void initialize_command_input (void); - -extern bool octave_yes_or_no (const std::string& prompt); - -extern octave_value do_keyboard (const octave_value_list& args = octave_value_list ()); - -extern std::string VPS4; - -extern char Vfilemarker; - -enum echo_state -{ - ECHO_OFF = 0, - ECHO_SCRIPTS = 1, - ECHO_FUNCTIONS = 2, - ECHO_CMD_LINE = 4 -}; - -extern int Vecho_executing_commands; - -extern octave_time Vlast_prompt_time; - -#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/data.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/data.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,7370 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton +Copyright (C) 2009 Jaroslav Hajek +Copyright (C) 2009-2010 VZLU Prague +Copyright (C) 2012 Carlo de Falco + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#ifdef HAVE_SYS_RESOURCE_H +#include +#endif + +#include +#include + +#include +extern "C" +{ +#include +} + +#include "lo-ieee.h" +#include "lo-math.h" +#include "oct-time.h" +#include "str-vec.h" +#include "quit.h" +#include "mx-base.h" +#include "oct-binmap.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-class.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-cx-sparse.h" +#include "parse.h" +#include "pt-mat.h" +#include "utils.h" +#include "variables.h" +#include "pager.h" +#include "xnorm.h" + +#if ! defined (CLOCKS_PER_SEC) +#if defined (CLK_TCK) +#define CLOCKS_PER_SEC CLK_TCK +#else +#error "no definition for CLOCKS_PER_SEC!" +#endif +#endif + +#if ! defined (HAVE_HYPOTF) && defined (HAVE__HYPOTF) +#define hypotf _hypotf +#define HAVE_HYPOTF 1 +#endif + +#define ANY_ALL(FCN) \ + \ + octave_value retval; \ + \ + int nargin = args.length (); \ + \ + if (nargin == 1 || nargin == 2) \ + { \ + int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ + \ + if (! error_state) \ + { \ + if (dim >= -1) \ + retval = args(0).FCN (dim); \ + else \ + error (#FCN ": invalid dimension argument = %d", dim + 1); \ + } \ + else \ + error (#FCN ": expecting dimension argument to be an integer"); \ + } \ + else \ + print_usage (); \ + \ + return retval + +DEFUN (all, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} all (@var{x})\n\ +@deftypefnx {Built-in Function} {} all (@var{x}, @var{dim})\n\ +For a vector argument, return true (logical 1) if all elements of the vector\n\ +are nonzero.\n\ +\n\ +For a matrix argument, return a row vector of logical ones and\n\ +zeros with each element indicating whether all of the elements of the\n\ +corresponding column of the matrix are nonzero. For example:\n\ +\n\ +@example\n\ +@group\n\ +all ([2, 3; 1, 0]))\n\ + @result{} [ 1, 0 ]\n\ +@end group\n\ +@end example\n\ +\n\ +If the optional argument @var{dim} is supplied, work along dimension\n\ +@var{dim}.\n\ +@seealso{any}\n\ +@end deftypefn") +{ + ANY_ALL (all); +} + +/* +%!test +%! x = ones (3); +%! x(1,1) = 0; +%! assert (all (all (rand (3) + 1) == [1, 1, 1]) == 1); +%! assert (all (all (x) == [0, 1, 1]) == 1); +%! assert (all (x, 1) == [0, 1, 1]); +%! assert (all (x, 2) == [0; 1; 1]); + +%!test +%! x = ones (3, "single"); +%! x(1,1) = 0; +%! assert (all (all (single (rand (3) + 1)) == [1, 1, 1]) == 1); +%! assert (all (all (x) == [0, 1, 1]) == 1); +%! assert (all (x, 1) == [0, 1, 1]); +%! assert (all (x, 2) == [0; 1; 1]); + +%!error all () +%!error all (1, 2, 3) +*/ + +DEFUN (any, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} any (@var{x})\n\ +@deftypefnx {Built-in Function} {} any (@var{x}, @var{dim})\n\ +For a vector argument, return true (logical 1) if any element of the vector\n\ +is nonzero.\n\ +\n\ +For a matrix argument, return a row vector of logical ones and\n\ +zeros with each element indicating whether any of the elements of the\n\ +corresponding column of the matrix are nonzero. For example:\n\ +\n\ +@example\n\ +@group\n\ +any (eye (2, 4))\n\ + @result{} [ 1, 1, 0, 0 ]\n\ +@end group\n\ +@end example\n\ +\n\ +If the optional argument @var{dim} is supplied, work along dimension\n\ +@var{dim}. For example:\n\ +\n\ +@example\n\ +@group\n\ +any (eye (2, 4), 2)\n\ + @result{} [ 1; 1 ]\n\ +@end group\n\ +@end example\n\ +@seealso{all}\n\ +@end deftypefn") +{ + ANY_ALL (any); +} + +/* +%!test +%! x = zeros (3); +%! x(3,3) = 1; +%! assert (all (any (x) == [0, 0, 1]) == 1); +%! assert (all (any (ones (3)) == [1, 1, 1]) == 1); +%! assert (any (x, 1) == [0, 0, 1]); +%! assert (any (x, 2) == [0; 0; 1]); + +%!test +%! x = zeros (3, "single"); +%! x(3,3) = 1; +%! assert (all (any (x) == [0, 0, 1]) == 1); +%! assert (all (any (ones (3, "single")) == [1, 1, 1]) == 1); +%! assert (any (x, 1) == [0, 0, 1]); +%! assert (any (x, 2) == [0; 0; 1]); + +%!error any () +%!error any (1, 2, 3) +*/ + +// These mapping functions may also be useful in other places, eh? + +DEFUN (atan2, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} atan2 (@var{y}, @var{x})\n\ +Compute atan (@var{y} / @var{x}) for corresponding elements of @var{y}\n\ +and @var{x}. Signal an error if @var{y} and @var{x} do not match in size\n\ +and orientation.\n\ +@seealso{tan, tand, tanh, atanh}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if (! args(0).is_numeric_type ()) + gripe_wrong_type_arg ("atan2", args(0)); + else if (! args(1).is_numeric_type ()) + gripe_wrong_type_arg ("atan2", args(1)); + else if (args(0).is_complex_type () || args(1).is_complex_type ()) + error ("atan2: not defined for complex numbers"); + else if (args(0).is_single_type () || args(1).is_single_type ()) + { + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + retval = atan2f (args(0).float_value (), args(1).float_value ()); + else + { + FloatNDArray a0 = args(0).float_array_value (); + FloatNDArray a1 = args(1).float_array_value (); + retval = binmap (a0, a1, ::atan2f, "atan2"); + } + } + else + { + bool a0_scalar = args(0).is_scalar_type (); + bool a1_scalar = args(1).is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = atan2 (args(0).scalar_value (), args(1).scalar_value ()); + else if ((a0_scalar || args(0).is_sparse_type ()) + && (a1_scalar || args(1).is_sparse_type ())) + { + SparseMatrix m0 = args(0).sparse_matrix_value (); + SparseMatrix m1 = args(1).sparse_matrix_value (); + retval = binmap (m0, m1, ::atan2, "atan2"); + } + else + { + NDArray a0 = args(0).array_value (); + NDArray a1 = args(1).array_value (); + retval = binmap (a0, a1, ::atan2, "atan2"); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (size (atan2 (zeros (0, 2), zeros (0, 2))), [0, 2]) +%!assert (size (atan2 (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) +%!assert (size (atan2 (rand (2, 3, 4), 1)), [2, 3, 4]) +%!assert (size (atan2 (1, rand (2, 3, 4))), [2, 3, 4]) +%!assert (size (atan2 (1, 2)), [1, 1]) + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; +%! y = [0, rt3, 1, rt3, -rt3, -1, -rt3, 0]; +%! x = [1, 3, 1, 1, 1, 1, 3, 1]; +%! assert (atan2 (y, x), v, sqrt (eps)); + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); +%! y = single ([0, rt3, 1, rt3, -rt3, -1, -rt3, 0]); +%! x = single ([1, 3, 1, 1, 1, 1, 3, 1]); +%! assert (atan2 (y, x), v, sqrt (eps ("single"))); + +%!error atan2 () +%!error atan2 (1, 2, 3) +*/ + + +static octave_value +do_hypot (const octave_value& x, const octave_value& y) +{ + octave_value retval; + + octave_value arg0 = x, arg1 = y; + if (! arg0.is_numeric_type ()) + gripe_wrong_type_arg ("hypot", arg0); + else if (! arg1.is_numeric_type ()) + gripe_wrong_type_arg ("hypot", arg1); + else + { + if (arg0.is_complex_type ()) + arg0 = arg0.abs (); + if (arg1.is_complex_type ()) + arg1 = arg1.abs (); + + if (arg0.is_single_type () || arg1.is_single_type ()) + { + if (arg0.is_scalar_type () && arg1.is_scalar_type ()) + retval = hypotf (arg0.float_value (), arg1.float_value ()); + else + { + FloatNDArray a0 = arg0.float_array_value (); + FloatNDArray a1 = arg1.float_array_value (); + retval = binmap (a0, a1, ::hypotf, "hypot"); + } + } + else + { + bool a0_scalar = arg0.is_scalar_type (); + bool a1_scalar = arg1.is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = hypot (arg0.scalar_value (), arg1.scalar_value ()); + else if ((a0_scalar || arg0.is_sparse_type ()) + && (a1_scalar || arg1.is_sparse_type ())) + { + SparseMatrix m0 = arg0.sparse_matrix_value (); + SparseMatrix m1 = arg1.sparse_matrix_value (); + retval = binmap (m0, m1, ::hypot, "hypot"); + } + else + { + NDArray a0 = arg0.array_value (); + NDArray a1 = arg1.array_value (); + retval = binmap (a0, a1, ::hypot, "hypot"); + } + } + } + + return retval; +} + +DEFUN (hypot, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} hypot (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} hypot (@var{x}, @var{y}, @var{z}, @dots{})\n\ +Compute the element-by-element square root of the sum of the squares of\n\ +@var{x} and @var{y}. This is equivalent to\n\ +@code{sqrt (@var{x}.^2 + @var{y}.^2)}, but calculated in a manner that\n\ +avoids overflows for large values of @var{x} or @var{y}.\n\ +@code{hypot} can also be called with more than 2 arguments; in this case,\n\ +the arguments are accumulated from left to right:\n\ +\n\ +@example\n\ +@group\n\ +hypot (hypot (@var{x}, @var{y}), @var{z})\n\ +hypot (hypot (hypot (@var{x}, @var{y}), @var{z}), @var{w}), etc.\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + retval = do_hypot (args(0), args(1)); + } + else if (nargin >= 3) + { + retval = args(0); + for (int i = 1; i < nargin && ! error_state; i++) + retval = do_hypot (retval, args(i)); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (size (hypot (zeros (0, 2), zeros (0, 2))), [0, 2]) +%!assert (size (hypot (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) +%!assert (size (hypot (rand (2, 3, 4), 1)), [2, 3, 4]) +%!assert (size (hypot (1, rand (2, 3, 4))), [2, 3, 4]) +%!assert (size (hypot (1, 2)), [1, 1]) +%!assert (hypot (1:10, 1:10), sqrt (2) * [1:10], 16*eps) +%!assert (hypot (single (1:10), single (1:10)), single (sqrt (2) * [1:10])) +*/ + +template +void +map_2_xlog2 (const Array& x, Array& f, Array& e) +{ + f = Array(x.dims ()); + e = Array(x.dims ()); + for (octave_idx_type i = 0; i < x.numel (); i++) + { + int exp; + f.xelem (i) = xlog2 (x(i), exp); + e.xelem (i) = exp; + } +} + +DEFUN (log2, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log2 (@var{x})\n\ +@deftypefnx {Mapping Function} {[@var{f}, @var{e}] =} log2 (@var{x})\n\ +Compute the base-2 logarithm of each element of @var{x}.\n\ +\n\ +If called with two output arguments, split @var{x} into\n\ +binary mantissa and exponent so that\n\ +@tex\n\ +${1 \\over 2} \\le \\left| f \\right| < 1$\n\ +@end tex\n\ +@ifnottex\n\ +@code{1/2 <= abs(f) < 1}\n\ +@end ifnottex\n\ +and @var{e} is an integer. If\n\ +@tex\n\ +$x = 0$, $f = e = 0$.\n\ +@end tex\n\ +@ifnottex\n\ +@code{x = 0}, @code{f = e = 0}.\n\ +@end ifnottex\n\ +@seealso{pow2, log, log10, exp}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + if (nargout < 2) + retval(0) = args(0).log2 (); + else if (args(0).is_single_type ()) + { + if (args(0).is_real_type ()) + { + FloatNDArray f; + FloatNDArray x = args(0).float_array_value (); + // FIXME -- should E be an int value? + FloatMatrix e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + else if (args(0).is_complex_type ()) + { + FloatComplexNDArray f; + FloatComplexNDArray x = args(0).float_complex_array_value (); + // FIXME -- should E be an int value? + FloatNDArray e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + } + else if (args(0).is_real_type ()) + { + NDArray f; + NDArray x = args(0).array_value (); + // FIXME -- should E be an int value? + Matrix e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + else if (args(0).is_complex_type ()) + { + ComplexNDArray f; + ComplexNDArray x = args(0).complex_array_value (); + // FIXME -- should E be an int value? + NDArray e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + else + gripe_wrong_type_arg ("log2", args(0)); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (log2 ([1/4, 1/2, 1, 2, 4]), [-2, -1, 0, 1, 2]) +%!assert (log2 (Inf), Inf) +%!assert (isnan (log2 (NaN))) +%!assert (log2 (4*i), 2 + log2 (1*i)) +%!assert (log2 (complex (0,Inf)), Inf + log2 (i)) + +%!test +%! [f, e] = log2 ([0,-1; 2,-4; Inf,-Inf]); +%! assert (f, [0,-0.5; 0.5,-0.5; Inf,-Inf]); +%! assert (e(1:2,:), [0,1;2,3]); + +%!test +%! [f, e] = log2 (complex (zeros (3, 2), [0,-1; 2,-4; Inf,-Inf])); +%! assert (f, complex (zeros (3, 2), [0,-0.5; 0.5,-0.5; Inf,-Inf])); +%! assert (e(1:2,:), [0,1; 2,3]); +*/ + +DEFUN (rem, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} rem (@var{x}, @var{y})\n\ +@deftypefnx {Mapping Function} {} fmod (@var{x}, @var{y})\n\ +Return the remainder of the division @code{@var{x} / @var{y}}, computed\n\ +using the expression\n\ +\n\ +@example\n\ +x - y .* fix (x ./ y)\n\ +@end example\n\ +\n\ +An error message is printed if the dimensions of the arguments do not\n\ +agree, or if either of the arguments is complex.\n\ +@seealso{mod}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if (! args(0).is_numeric_type ()) + gripe_wrong_type_arg ("rem", args(0)); + else if (! args(1).is_numeric_type ()) + gripe_wrong_type_arg ("rem", args(1)); + else if (args(0).is_complex_type () || args(1).is_complex_type ()) + error ("rem: not defined for complex numbers"); + else if (args(0).is_integer_type () || args(1).is_integer_type ()) + { + builtin_type_t btyp0 = args(0).builtin_type (); + builtin_type_t btyp1 = args(1).builtin_type (); + if (btyp0 == btyp_double || btyp0 == btyp_float) + btyp0 = btyp1; + if (btyp1 == btyp_double || btyp1 == btyp_float) + btyp1 = btyp0; + + if (btyp0 == btyp1) + { + switch (btyp0) + { +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + { \ + X##NDArray a0 = args(0).X##_array_value (); \ + X##NDArray a1 = args(1).X##_array_value (); \ + retval = binmap (a0, a1, rem, "rem"); \ + } \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + default: + panic_impossible (); + } + } + else + error ("rem: cannot combine %s and %d", + args(0).class_name ().c_str (), args(1).class_name ().c_str ()); + } + else if (args(0).is_single_type () || args(1).is_single_type ()) + { + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + retval = xrem (args(0).float_value (), args(1).float_value ()); + else + { + FloatNDArray a0 = args(0).float_array_value (); + FloatNDArray a1 = args(1).float_array_value (); + retval = binmap (a0, a1, xrem, "rem"); + } + } + else + { + bool a0_scalar = args(0).is_scalar_type (); + bool a1_scalar = args(1).is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = xrem (args(0).scalar_value (), args(1).scalar_value ()); + else if ((a0_scalar || args(0).is_sparse_type ()) + && (a1_scalar || args(1).is_sparse_type ())) + { + SparseMatrix m0 = args(0).sparse_matrix_value (); + SparseMatrix m1 = args(1).sparse_matrix_value (); + retval = binmap (m0, m1, xrem, "rem"); + } + else + { + NDArray a0 = args(0).array_value (); + NDArray a1 = args(1).array_value (); + retval = binmap (a0, a1, xrem, "rem"); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (rem ([1, 2, 3; -1, -2, -3], 2), [1, 0, 1; -1, 0, -1]) +%!assert (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3)),[1, 0, 1; -1, 0, -1]) +%!assert (rem (uint8 ([1, 2, 3; -1, -2, -3]), uint8 (2)), uint8 ([1, 0, 1; -1, 0, -1])) +%!assert (uint8 (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3))),uint8 ([1, 0, 1; -1, 0, -1])) + +%!error rem (uint (8), int8 (5)) +%!error rem (uint8 ([1, 2]), uint8 ([3, 4, 5])) +%!error rem () +%!error rem (1, 2, 3) +%!error rem ([1, 2], [3, 4, 5]) +%!error rem (i, 1) +*/ + +/* + +%!assert (size (fmod (zeros (0, 2), zeros (0, 2))), [0, 2]) +%!assert (size (fmod (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) +%!assert (size (fmod (rand (2, 3, 4), 1)), [2, 3, 4]) +%!assert (size (fmod (1, rand (2, 3, 4))), [2, 3, 4]) +%!assert (size (fmod (1, 2)), [1, 1]) +*/ + +DEFALIAS (fmod, rem) + +DEFUN (mod, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} mod (@var{x}, @var{y})\n\ +Compute the modulo of @var{x} and @var{y}. Conceptually this is given by\n\ +\n\ +@example\n\ +x - y .* floor (x ./ y)\n\ +@end example\n\ +\n\ +@noindent\n\ +and is written such that the correct modulus is returned for\n\ +integer types. This function handles negative values correctly. That\n\ +is, @code{mod (-1, 3)} is 2, not -1, as @code{rem (-1, 3)} returns.\n\ +@code{mod (@var{x}, 0)} returns @var{x}.\n\ +\n\ +An error results if the dimensions of the arguments do not agree, or if\n\ +either of the arguments is complex.\n\ +@seealso{rem}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if (! args(0).is_numeric_type ()) + gripe_wrong_type_arg ("mod", args(0)); + else if (! args(1).is_numeric_type ()) + gripe_wrong_type_arg ("mod", args(1)); + else if (args(0).is_complex_type () || args(1).is_complex_type ()) + error ("mod: not defined for complex numbers"); + else if (args(0).is_integer_type () || args(1).is_integer_type ()) + { + builtin_type_t btyp0 = args(0).builtin_type (); + builtin_type_t btyp1 = args(1).builtin_type (); + if (btyp0 == btyp_double || btyp0 == btyp_float) + btyp0 = btyp1; + if (btyp1 == btyp_double || btyp1 == btyp_float) + btyp1 = btyp0; + + if (btyp0 == btyp1) + { + switch (btyp0) + { +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + { \ + X##NDArray a0 = args(0).X##_array_value (); \ + X##NDArray a1 = args(1).X##_array_value (); \ + retval = binmap (a0, a1, mod, "mod"); \ + } \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + default: + panic_impossible (); + } + } + else + error ("mod: cannot combine %s and %d", + args(0).class_name ().c_str (), args(1).class_name ().c_str ()); + } + else if (args(0).is_single_type () || args(1).is_single_type ()) + { + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + retval = xmod (args(0).float_value (), args(1).float_value ()); + else + { + FloatNDArray a0 = args(0).float_array_value (); + FloatNDArray a1 = args(1).float_array_value (); + retval = binmap (a0, a1, xmod, "mod"); + } + } + else + { + bool a0_scalar = args(0).is_scalar_type (); + bool a1_scalar = args(1).is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = xmod (args(0).scalar_value (), args(1).scalar_value ()); + else if ((a0_scalar || args(0).is_sparse_type ()) + && (a1_scalar || args(1).is_sparse_type ())) + { + SparseMatrix m0 = args(0).sparse_matrix_value (); + SparseMatrix m1 = args(1).sparse_matrix_value (); + retval = binmap (m0, m1, xmod, "mod"); + } + else + { + NDArray a0 = args(0).array_value (); + NDArray a1 = args(1).array_value (); + retval = binmap (a0, a1, xmod, "mod"); + } + } + } + else + print_usage (); + + return retval; +} + +/* +## empty input test +%!assert (isempty (mod ([], []))) + +## x mod y, y != 0 tests +%!assert (mod (5, 3), 2) +%!assert (mod (-5, 3), 1) +%!assert (mod (0, 3), 0) +%!assert (mod ([-5, 5, 0], [3, 3, 3]), [1, 2, 0]) +%!assert (mod ([-5; 5; 0], [3; 3; 3]), [1; 2; 0]) +%!assert (mod ([-5, 5; 0, 3], [3, 3 ; 3, 1]), [1, 2 ; 0, 0]) + +## x mod 0 tests +%!assert (mod (5, 0), 5) +%!assert (mod (-5, 0), -5) +%!assert (mod ([-5, 5, 0], [3, 0, 3]), [1, 5, 0]) +%!assert (mod ([-5; 5; 0], [3; 0; 3]), [1; 5; 0]) +%!assert (mod ([-5, 5; 0, 3], [3, 0 ; 3, 1]), [1, 5 ; 0, 0]) +%!assert (mod ([-5, 5; 0, 3], [0, 0 ; 0, 0]), [-5, 5; 0, 3]) + +## mixed scalar/matrix tests +%!assert (mod ([-5, 5; 0, 3], 0), [-5, 5; 0, 3]) +%!assert (mod ([-5, 5; 0, 3], 3), [1, 2; 0, 0]) +%!assert (mod (-5, [0,0; 0,0]), [-5, -5; -5, -5]) +%!assert (mod (-5, [3,0; 3,1]), [1, -5; 1, 0]) +%!assert (mod (-5, [3,2; 3,1]), [1, 1; 1, 0]) + +## integer types +%!assert (mod (uint8 (5), uint8 (4)), uint8 (1)) +%!assert (mod (uint8 ([1:5]), uint8 (4)), uint8 ([1,2,3,0,1])) +%!assert (mod (uint8 ([1:5]), uint8 (0)), uint8 ([1:5])) +%!error (mod (uint8 (5), int8 (4))) + +## mixed integer/real types +%!assert (mod (uint8 (5), 4), uint8 (1)) +%!assert (mod (5, uint8 (4)), uint8 (1)) +%!assert (mod (uint8 ([1:5]), 4), uint8 ([1,2,3,0,1])) + +## non-integer real numbers +%!assert (mod (2.1, 0.1), 0) +%!assert (mod (2.1, 0.2), 0.1, eps) +*/ + +// FIXME: Need to convert the reduction functions of this file for single precision + +#define NATIVE_REDUCTION_1(FCN, TYPE, DIM) \ + (arg.is_ ## TYPE ## _type ()) \ + { \ + TYPE ## NDArray tmp = arg. TYPE ##_array_value (); \ + \ + if (! error_state) \ + { \ + retval = tmp.FCN (DIM); \ + } \ + } + +#define NATIVE_REDUCTION(FCN, BOOL_FCN) \ + \ + octave_value retval; \ + \ + int nargin = args.length (); \ + \ + bool isnative = false; \ + bool isdouble = false; \ + \ + if (nargin > 1 && args(nargin - 1).is_string ()) \ + { \ + std::string str = args(nargin - 1).string_value (); \ + \ + if (! error_state) \ + { \ + if (str == "native") \ + isnative = true; \ + else if (str == "double") \ + isdouble = true; \ + else \ + error ("sum: unrecognized string argument"); \ + nargin --; \ + } \ + } \ + \ + if (nargin == 1 || nargin == 2) \ + { \ + octave_value arg = args(0); \ + \ + int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ + \ + if (! error_state) \ + { \ + if (dim >= -1) \ + { \ + if (arg.is_sparse_type ()) \ + { \ + if (arg.is_real_type ()) \ + { \ + SparseMatrix tmp = arg.sparse_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else \ + { \ + if (isnative) \ + { \ + if NATIVE_REDUCTION_1 (FCN, uint8, dim) \ + else if NATIVE_REDUCTION_1 (FCN, uint16, dim) \ + else if NATIVE_REDUCTION_1 (FCN, uint32, dim) \ + else if NATIVE_REDUCTION_1 (FCN, uint64, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int8, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int16, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int32, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int64, dim) \ + else if (arg.is_bool_type ()) \ + { \ + boolNDArray tmp = arg.bool_array_value (); \ + if (! error_state) \ + retval = boolNDArray (tmp.BOOL_FCN (dim)); \ + } \ + else if (arg.is_char_matrix ()) \ + { \ + error (#FCN, ": invalid char type"); \ + } \ + else if (!isdouble && arg.is_single_type ()) \ + { \ + if (arg.is_complex_type ()) \ + { \ + FloatComplexNDArray tmp = \ + arg.float_complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_real_type ()) \ + { \ + FloatNDArray tmp = arg.float_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else if (arg.is_complex_type ()) \ + { \ + ComplexNDArray tmp = arg.complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_real_type ()) \ + { \ + NDArray tmp = arg.array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + gripe_wrong_type_arg (#FCN, arg); \ + return retval; \ + } \ + } \ + else if (arg.is_bool_type ()) \ + { \ + boolNDArray tmp = arg.bool_array_value (); \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (!isdouble && arg.is_single_type ()) \ + { \ + if (arg.is_real_type ()) \ + { \ + FloatNDArray tmp = arg.float_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_complex_type ()) \ + { \ + FloatComplexNDArray tmp = \ + arg.float_complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else if (arg.is_real_type ()) \ + { \ + NDArray tmp = arg.array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_complex_type ()) \ + { \ + ComplexNDArray tmp = arg.complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + gripe_wrong_type_arg (#FCN, arg); \ + return retval; \ + } \ + } \ + } \ + else \ + error (#FCN ": invalid dimension argument = %d", dim + 1); \ + } \ + \ + } \ + else \ + print_usage (); \ + \ + return retval + +#define DATA_REDUCTION(FCN) \ + \ + octave_value retval; \ + \ + int nargin = args.length (); \ + \ + if (nargin == 1 || nargin == 2) \ + { \ + octave_value arg = args(0); \ + \ + int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ + \ + if (! error_state) \ + { \ + if (dim >= -1) \ + { \ + if (arg.is_real_type ()) \ + { \ + if (arg.is_sparse_type ()) \ + { \ + SparseMatrix tmp = arg.sparse_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_single_type ()) \ + { \ + FloatNDArray tmp = arg.float_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + NDArray tmp = arg.array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else if (arg.is_complex_type ()) \ + { \ + if (arg.is_sparse_type ()) \ + { \ + SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_single_type ()) \ + { \ + FloatComplexNDArray tmp = arg.float_complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + ComplexNDArray tmp = arg.complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else \ + { \ + gripe_wrong_type_arg (#FCN, arg); \ + return retval; \ + } \ + } \ + else \ + error (#FCN ": invalid dimension argument = %d", dim + 1); \ + } \ + } \ + else \ + print_usage (); \ + \ + return retval + +DEFUN (cumprod, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cumprod (@var{x})\n\ +@deftypefnx {Built-in Function} {} cumprod (@var{x}, @var{dim})\n\ +Cumulative product of elements along dimension @var{dim}. If\n\ +@var{dim} is omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +@seealso{prod, cumsum}\n\ +@end deftypefn") +{ + DATA_REDUCTION (cumprod); +} + +/* +%!assert (cumprod ([1, 2, 3]), [1, 2, 6]) +%!assert (cumprod ([-1; -2; -3]), [-1; 2; -6]) +%!assert (cumprod ([i, 2+i, -3+2i, 4]), [i, -1+2i, -1-8i, -4-32i]) +%!assert (cumprod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i]) + +%!assert (cumprod (single ([1, 2, 3])), single ([1, 2, 6])) +%!assert (cumprod (single ([-1; -2; -3])), single ([-1; 2; -6])) +%!assert (cumprod (single ([i, 2+i, -3+2i, 4])), single ([i, -1+2i, -1-8i, -4-32i])) +%!assert (cumprod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i])) + +%!assert (cumprod ([2, 3; 4, 5], 1), [2, 3; 8, 15]) +%!assert (cumprod ([2, 3; 4, 5], 2), [2, 6; 4, 20]) + +%!assert (cumprod (single ([2, 3; 4, 5]), 1), single ([2, 3; 8, 15])) +%!assert (cumprod (single ([2, 3; 4, 5]), 2), single ([2, 6; 4, 20])) + +%!error cumprod () +*/ + +DEFUN (cumsum, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cumsum (@var{x})\n\ +@deftypefnx {Built-in Function} {} cumsum (@var{x}, @var{dim})\n\ +@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"native\")\n\ +@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"double\")\n\ +@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"extra\")\n\ +Cumulative sum of elements along dimension @var{dim}. If @var{dim}\n\ +is omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +See @code{sum} for an explanation of the optional parameters \"native\",\n\ +\"double\", and \"extra\".\n\ +@seealso{sum, cumprod}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + bool isnative = false; + bool isdouble = false; + + if (nargin > 1 && args(nargin - 1).is_string ()) + { + std::string str = args(nargin - 1).string_value (); + + if (! error_state) + { + if (str == "native") + isnative = true; + else if (str == "double") + isdouble = true; + else + error ("sum: unrecognized string argument"); + nargin --; + } + } + + if (error_state) + return retval; + + if (nargin == 1 || nargin == 2) + { + octave_value arg = args(0); + + int dim = -1; + if (nargin == 2) + { + dim = args(1).int_value () - 1; + if (dim < 0) + error ("cumsum: invalid dimension argument = %d", dim + 1); + } + + if (! error_state) + { + switch (arg.builtin_type ()) + { + case btyp_double: + if (arg.is_sparse_type ()) + retval = arg.sparse_matrix_value ().cumsum (dim); + else + retval = arg.array_value ().cumsum (dim); + break; + case btyp_complex: + if (arg.is_sparse_type ()) + retval = arg.sparse_complex_matrix_value ().cumsum (dim); + else + retval = arg.complex_array_value ().cumsum (dim); + break; + case btyp_float: + if (isdouble) + retval = arg.array_value ().cumsum (dim); + else + retval = arg.float_array_value ().cumsum (dim); + break; + case btyp_float_complex: + if (isdouble) + retval = arg.complex_array_value ().cumsum (dim); + else + retval = arg.float_complex_array_value ().cumsum (dim); + break; + +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + if (isnative) \ + retval = arg.X ## _array_value ().cumsum (dim); \ + else \ + retval = arg.array_value ().cumsum (dim); \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + + case btyp_bool: + if (arg.is_sparse_type ()) + { + SparseMatrix cs = arg.sparse_matrix_value ().cumsum (dim); + if (isnative) + retval = cs != 0.0; + else + retval = cs; + } + else + { + NDArray cs = arg.bool_array_value ().cumsum (dim); + if (isnative) + retval = cs != 0.0; + else + retval = cs; + } + break; + + default: + gripe_wrong_type_arg ("cumsum", arg); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (cumsum ([1, 2, 3]), [1, 3, 6]) +%!assert (cumsum ([-1; -2; -3]), [-1; -3; -6]) +%!assert (cumsum ([i, 2+i, -3+2i, 4]), [i, 2+2i, -1+4i, 3+4i]) +%!assert (cumsum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i]) + +%!assert (cumsum (single ([1, 2, 3])), single ([1, 3, 6])) +%!assert (cumsum (single ([-1; -2; -3])), single ([-1; -3; -6])) +%!assert (cumsum (single ([i, 2+i, -3+2i, 4])), single ([i, 2+2i, -1+4i, 3+4i])) +%!assert (cumsum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i])) + +%!assert (cumsum ([1, 2; 3, 4], 1), [1, 2; 4, 6]) +%!assert (cumsum ([1, 2; 3, 4], 2), [1, 3; 3, 7]) + +%!assert (cumsum (single ([1, 2; 3, 4]), 1), single ([1, 2; 4, 6])) +%!assert (cumsum (single ([1, 2; 3, 4]), 2), single ([1, 3; 3, 7])) + +%!error cumsum () +*/ + +DEFUN (diag, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{M} =} diag (@var{v})\n\ +@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{k})\n\ +@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M})\n\ +@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M}, @var{k})\n\ +Return a diagonal matrix with vector @var{v} on diagonal @var{k}. The\n\ +second argument is optional. If it is positive, the vector is placed on\n\ +the @var{k}-th super-diagonal. If it is negative, it is placed on the\n\ +@var{-k}-th sub-diagonal. The default value of @var{k} is 0, and the\n\ +vector is placed on the main diagonal. For example:\n\ +\n\ +@example\n\ +@group\n\ +diag ([1, 2, 3], 1)\n\ + @result{} 0 1 0 0\n\ + 0 0 2 0\n\ + 0 0 0 3\n\ + 0 0 0 0\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +The 3-input form returns a diagonal matrix with vector @var{v} on the main\n\ +diagonal and the resulting matrix being of size @var{m} rows x @var{n}\n\ +columns.\n\ +\n\ +Given a matrix argument, instead of a vector, @code{diag} extracts the\n\ +@var{k}-th diagonal of the matrix.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 && args(0).is_defined ()) + retval = args(0).diag (); + else if (nargin == 2 && args(0).is_defined () && args(1).is_defined ()) + { + octave_idx_type k = args(1).int_value (); + + if (error_state) + error ("diag: invalid argument K"); + else + retval = args(0).diag (k); + } + else if (nargin == 3) + { + octave_value arg0 = args(0); + + if (arg0.ndims () == 2 && (arg0.rows () == 1 || arg0.columns () == 1)) + { + octave_idx_type m = args(1).int_value (); + octave_idx_type n = args(2).int_value (); + + if (! error_state) + retval = arg0.diag (m, n); + else + error ("diag: invalid dimensions"); + } + else + error ("diag: V must be a vector"); + } + else + print_usage (); + + return retval; +} + +/* + +%!assert (full (diag ([1; 2; 3])), [1, 0, 0; 0, 2, 0; 0, 0, 3]) +%!assert (diag ([1; 2; 3], 1), [0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]) +%!assert (diag ([1; 2; 3], 2), [0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0]) +%!assert (diag ([1; 2; 3],-1), [0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]) +%!assert (diag ([1; 2; 3],-2), [0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0]) + +%!assert (diag ([1, 0, 0; 0, 2, 0; 0, 0, 3]), [1; 2; 3]) +%!assert (diag ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0], 1), [1; 2; 3]) +%!assert (diag ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0], -1), [1; 2; 3]) +%!assert (diag (ones (1, 0), 2), zeros (2)) +%!assert (diag (1:3, 4, 2), [1, 0; 0, 2; 0, 0; 0, 0]) + +%!assert (full (diag (single ([1; 2; 3]))), single ([1, 0, 0; 0, 2, 0; 0, 0, 3])) +%!assert (diag (single ([1; 2; 3]), 1), single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) +%!assert (diag (single ([1; 2; 3]), 2), single ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) +%!assert (diag (single ([1; 2; 3]),-1), single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) +%!assert (diag (single ([1; 2; 3]),-2), single ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) + +%!assert (diag (single ([1, 0, 0; 0, 2, 0; 0, 0, 3])), single ([1; 2; 3])) +%!assert (diag (single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), single ([1; 2; 3])) +%!assert (diag (single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), single ([1; 2; 3])) + +%!assert (diag (int8 ([1; 2; 3])), int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])) +%!assert (diag (int8 ([1; 2; 3]), 1), int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) +%!assert (diag (int8 ([1; 2; 3]), 2), int8 ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) +%!assert (diag (int8 ([1; 2; 3]),-1), int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) +%!assert (diag (int8 ([1; 2; 3]),-2), int8 ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) + +%!assert (diag (int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])), int8 ([1; 2; 3])) +%!assert (diag (int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), int8 ([1; 2; 3])) +%!assert (diag (int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), int8 ([1; 2; 3])) + +## Test non-square size +%!assert (diag ([1,2,3], 6, 3), [1 0 0; 0 2 0; 0 0 3; 0 0 0; 0 0 0; 0 0 0]) +%!assert (diag (1, 2, 3), [1,0,0; 0,0,0]); +%!assert (diag ({1}, 2, 3), {1,[],[]; [],[],[]}); +%!assert (diag ({1,2}, 3, 4), {1,[],[],[]; [],2,[],[]; [],[],[],[]}); + +%% Test input validation +%!error diag () +%!error diag (1,2,3,4) +%!error diag (ones (2), 3, 3) +%!error diag (1:3, -4, 3) + +%!assert (diag (1, 3, 3), diag ([1, 0, 0])) +%!assert (diag (i, 3, 3), diag ([i, 0, 0])) +%!assert (diag (single (1), 3, 3), diag ([single(1), 0, 0])) +%!assert (diag (single (i), 3, 3), diag ([single(i), 0, 0])) +%!assert (diag ([1, 2], 3, 3), diag ([1, 2, 0])) +%!assert (diag ([1, 2]*i, 3, 3), diag ([1, 2, 0]*i)) +%!assert (diag (single ([1, 2]), 3, 3), diag (single ([1, 2, 0]))) +%!assert (diag (single ([1, 2]*i), 3, 3), diag (single ([1, 2, 0]*i))) +*/ + +DEFUN (prod, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} prod (@var{x})\n\ +@deftypefnx {Built-in Function} {} prod (@var{x}, @var{dim})\n\ +Product of elements along dimension @var{dim}. If @var{dim} is\n\ +omitted, it defaults to the first non-singleton dimension.\n\ +@seealso{cumprod, sum}\n\ +@end deftypefn") +{ + DATA_REDUCTION (prod); +} + +/* +%!assert (prod ([1, 2, 3]), 6) +%!assert (prod ([-1; -2; -3]), -6) +%!assert (prod ([i, 2+i, -3+2i, 4]), -4 - 32i) +%!assert (prod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [-1+i, -8+8i, -27+27i]) + +%!assert (prod (single ([1, 2, 3])), single (6)) +%!assert (prod (single ([-1; -2; -3])), single (-6)) +%!assert (prod (single ([i, 2+i, -3+2i, 4])), single (-4 - 32i)) +%!assert (prod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([-1+i, -8+8i, -27+27i])) + +%!assert (prod ([1, 2; 3, 4], 1), [3, 8]) +%!assert (prod ([1, 2; 3, 4], 2), [2; 12]) +%!assert (prod (zeros (1, 0)), 1) +%!assert (prod (zeros (1, 0), 1), zeros (1, 0)) +%!assert (prod (zeros (1, 0), 2), 1) +%!assert (prod (zeros (0, 1)), 1) +%!assert (prod (zeros (0, 1), 1), 1) +%!assert (prod (zeros (0, 1), 2), zeros (0, 1)) +%!assert (prod (zeros (2, 0)), zeros (1, 0)) +%!assert (prod (zeros (2, 0), 1), zeros (1, 0)) +%!assert (prod (zeros (2, 0), 2), [1; 1]) +%!assert (prod (zeros (0, 2)), [1, 1]) +%!assert (prod (zeros (0, 2), 1), [1, 1]) +%!assert (prod (zeros (0, 2), 2), zeros (0, 1)) + +%!assert (prod (single ([1, 2; 3, 4]), 1), single ([3, 8])) +%!assert (prod (single ([1, 2; 3, 4]), 2), single ([2; 12])) +%!assert (prod (zeros (1, 0, "single")), single (1)) +%!assert (prod (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (prod (zeros (1, 0, "single"), 2), single (1)) +%!assert (prod (zeros (0, 1, "single")), single (1)) +%!assert (prod (zeros (0, 1, "single"), 1), single (1)) +%!assert (prod (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) +%!assert (prod (zeros (2, 0, "single")), zeros (1, 0, "single")) +%!assert (prod (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (prod (zeros (2, 0, "single"), 2), single ([1; 1])) +%!assert (prod (zeros (0, 2, "single")), single ([1, 1])) +%!assert (prod (zeros (0, 2, "single"), 1), single ([1, 1])) +%!assert (prod (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) + +%!error prod () +*/ + +static bool +all_scalar_1x1 (const octave_value_list& args) +{ + int n_args = args.length (); + for (int i = 0; i < n_args; i++) + if (args(i).numel () != 1) + return false; + + return true; +} + +template +static void +single_type_concat (Array& result, + const octave_value_list& args, + int dim) +{ + int n_args = args.length (); + if (! (equal_types::value + || equal_types::value) + && all_scalar_1x1 (args)) + { + // Optimize all scalars case. + dim_vector dv (1, 1); + if (dim == -1 || dim == -2) + dim = -dim - 1; + else if (dim >= 2) + dv.resize (dim+1, 1); + dv(dim) = n_args; + + result.clear (dv); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + result(j) = octave_value_extract (args(j)); + } + } + else + { + OCTAVE_LOCAL_BUFFER (Array, array_list, n_args); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + array_list[j] = octave_value_extract (args(j)); + } + + if (! error_state) + result = Array::cat (dim, n_args, array_list); + } +} + +template +static void +single_type_concat (Sparse& result, + const octave_value_list& args, + int dim) +{ + int n_args = args.length (); + OCTAVE_LOCAL_BUFFER (Sparse, sparse_list, n_args); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + sparse_list[j] = octave_value_extract (args(j)); + } + + if (! error_state) + result = Sparse::cat (dim, n_args, sparse_list); +} + +// Dispatcher. +template +static TYPE +do_single_type_concat (const octave_value_list& args, int dim) +{ + TYPE result; + + single_type_concat (result, args, dim); + + return result; +} + +template +static void +single_type_concat_map (octave_map& result, + const octave_value_list& args, + int dim) +{ + int n_args = args.length (); + OCTAVE_LOCAL_BUFFER (MAP, map_list, n_args); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + map_list[j] = octave_value_extract (args(j)); + } + + if (! error_state) + result = octave_map::cat (dim, n_args, map_list); +} + +static octave_map +do_single_type_concat_map (const octave_value_list& args, + int dim) +{ + octave_map result; + if (all_scalar_1x1 (args)) // optimize all scalars case. + single_type_concat_map (result, args, dim); + else + single_type_concat_map (result, args, dim); + + return result; +} + +static octave_value +attempt_type_conversion (const octave_value& ov, std::string dtype) +{ + octave_value retval; + + // First try to find function in the class of OV that can convert to + // the dispatch type dtype. It will have the name of the dispatch + // type. + + std::string cname = ov.class_name (); + + octave_value fcn = symbol_table::find_method (dtype, cname); + + if (fcn.is_defined ()) + { + octave_value_list result + = fcn.do_multi_index_op (1, octave_value_list (1, ov)); + + if (! error_state && result.length () > 0) + retval = result(0); + else + error ("conversion from %s to %s failed", dtype.c_str (), + cname.c_str ()); + } + else + { + // No conversion function available. Try the constructor for the + // dispatch type. + + fcn = symbol_table::find_method (dtype, dtype); + + if (fcn.is_defined ()) + { + octave_value_list result + = fcn.do_multi_index_op (1, octave_value_list (1, ov)); + + if (! error_state && result.length () > 0) + retval = result(0); + else + error ("%s constructor failed for %s argument", dtype.c_str (), + cname.c_str ()); + } + else + error ("no constructor for %s!", dtype.c_str ()); + } + + return retval; +} + +octave_value +do_class_concat (const octave_value_list& ovl, std::string cattype, int dim) +{ + octave_value retval; + + // Get dominant type for list + + std::string dtype = get_dispatch_type (ovl); + + octave_value fcn = symbol_table::find_method (cattype, dtype); + + if (fcn.is_defined ()) + { + // Have method for dominant type, so call it and let it handle + // conversions. + + octave_value_list tmp2 = fcn.do_multi_index_op (1, ovl); + + if (! error_state) + { + if (tmp2.length () > 0) + retval = tmp2(0); + else + { + error ("%s/%s method did not return a value", + dtype.c_str (), cattype.c_str ()); + goto done; + } + } + else + goto done; + } + else + { + // No method for dominant type, so attempt type conversions for + // all elements that are not of the dominant type, then do the + // default operation for octave_class values. + + octave_idx_type j = 0; + octave_idx_type len = ovl.length (); + octave_value_list tmp (len, octave_value ()); + for (octave_idx_type k = 0; k < len; k++) + { + octave_value elt = ovl(k); + + std::string t1_type = elt.class_name (); + + if (t1_type == dtype) + tmp(j++) = elt; + else if (elt.is_object () || ! elt.is_empty ()) + { + tmp(j++) = attempt_type_conversion (elt, dtype); + + if (error_state) + goto done; + } + } + + tmp.resize (j); + + octave_map m = do_single_type_concat_map (tmp, dim); + + std::string cname = tmp(0).class_name (); + std::list parents = tmp(0).parent_class_name_list (); + + retval = octave_value (new octave_class (m, cname, parents)); + } + + done: + return retval; +} + +static octave_value +do_cat (const octave_value_list& xargs, int dim, std::string fname) +{ + octave_value retval; + + // We may need to convert elements of the list to cells, so make a + // copy. This should be efficient, it is done mostly by incrementing + // reference counts. + octave_value_list args = xargs; + + int n_args = args.length (); + + if (n_args == 0) + retval = Matrix (); + else if (n_args == 1) + retval = args(0); + else if (n_args > 1) + { + std::string result_type; + + bool all_sq_strings_p = true; + bool all_dq_strings_p = true; + bool all_real_p = true; + bool all_cmplx_p = true; + bool any_sparse_p = false; + bool any_cell_p = false; + bool any_class_p = false; + + bool first_elem_is_struct = false; + + for (int i = 0; i < n_args; i++) + { + if (i == 0) + { + result_type = args(i).class_name (); + + first_elem_is_struct = args(i).is_map (); + } + else + result_type = get_concat_class (result_type, args(i).class_name ()); + + if (all_sq_strings_p && ! args(i).is_sq_string ()) + all_sq_strings_p = false; + if (all_dq_strings_p && ! args(i).is_dq_string ()) + all_dq_strings_p = false; + if (all_real_p && ! args(i).is_real_type ()) + all_real_p = false; + if (all_cmplx_p && ! (args(i).is_complex_type () || args(i).is_real_type ())) + all_cmplx_p = false; + if (!any_sparse_p && args(i).is_sparse_type ()) + any_sparse_p = true; + if (!any_cell_p && args(i).is_cell ()) + any_cell_p = true; + if (!any_class_p && args(i).is_object ()) + any_class_p = true; + } + + if (any_cell_p && ! any_class_p && ! first_elem_is_struct) + { + for (int i = 0; i < n_args; i++) + { + if (! args(i).is_cell ()) + args(i) = Cell (args(i)); + } + } + + if (any_class_p) + { + retval = do_class_concat (args, fname, dim); + } + else if (result_type == "double") + { + if (any_sparse_p) + { + if (all_real_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + else + { + if (all_real_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + } + else if (result_type == "single") + { + if (all_real_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + else if (result_type == "char") + { + char type = all_dq_strings_p ? '"' : '\''; + + maybe_warn_string_concat (all_dq_strings_p, all_sq_strings_p); + + charNDArray result = do_single_type_concat (args, dim); + + retval = octave_value (result, type); + } + else if (result_type == "logical") + { + if (any_sparse_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + else if (result_type == "int8") + retval = do_single_type_concat (args, dim); + else if (result_type == "int16") + retval = do_single_type_concat (args, dim); + else if (result_type == "int32") + retval = do_single_type_concat (args, dim); + else if (result_type == "int64") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint8") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint16") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint32") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint64") + retval = do_single_type_concat (args, dim); + else if (result_type == "cell") + retval = do_single_type_concat (args, dim); + else if (result_type == "struct") + retval = do_single_type_concat_map (args, dim); + else + { + dim_vector dv = args(0).dims (); + + // Default concatenation. + bool (dim_vector::*concat_rule) (const dim_vector&, int) = &dim_vector::concat; + + if (dim == -1 || dim == -2) + { + concat_rule = &dim_vector::hvcat; + dim = -dim - 1; + } + + for (int i = 1; i < args.length (); i++) + { + if (! (dv.*concat_rule) (args(i).dims (), dim)) + { + // Dimensions do not match. + error ("cat: dimension mismatch"); + return retval; + } + } + + // The lines below might seem crazy, since we take a copy + // of the first argument, resize it to be empty and then resize + // it to be full. This is done since it means that there is no + // recopying of data, as would happen if we used a single resize. + // It should be noted that resize operation is also significantly + // slower than the do_cat_op function, so it makes sense to have + // an empty matrix and copy all data. + // + // We might also start with a empty octave_value using + // tmp = octave_value_typeinfo::lookup_type + // (args(1).type_name()); + // and then directly resize. However, for some types there might + // be some additional setup needed, and so this should be avoided. + + octave_value tmp = args (0); + tmp = tmp.resize (dim_vector (0,0)).resize (dv); + + if (error_state) + return retval; + + int dv_len = dv.length (); + Array ra_idx (dim_vector (dv_len, 1), 0); + + for (int j = 0; j < n_args; j++) + { + // Can't fast return here to skip empty matrices as something + // like cat (1,[],single ([])) must return an empty matrix of + // the right type. + tmp = do_cat_op (tmp, args (j), ra_idx); + + if (error_state) + return retval; + + dim_vector dv_tmp = args (j).dims (); + + if (dim >= dv_len) + { + if (j > 1) + error ("%s: indexing error", fname.c_str ()); + break; + } + else + ra_idx (dim) += (dim < dv_tmp.length () ? + dv_tmp (dim) : 1); + } + retval = tmp; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (horzcat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} horzcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ +Return the horizontal concatenation of N-D array objects, @var{array1},\n\ +@var{array2}, @dots{}, @var{arrayN} along dimension 2.\n\ +\n\ +Arrays may also be concatenated horizontally using the syntax for creating\n\ +new matrices. For example:\n\ +\n\ +@example\n\ +@var{hcat} = [ @var{array1}, @var{array2}, @dots{} ]\n\ +@end example\n\ +@seealso{cat, vertcat}\n\ +@end deftypefn") +{ + return do_cat (args, -2, "horzcat"); +} + +/* +## Test concatenation with all zero matrices +%!assert (horzcat ("", 65*ones (1,10)), "AAAAAAAAAA"); +%!assert (horzcat (65*ones (1,10), ""), "AAAAAAAAAA"); + +%!assert (class (horzcat (int64 (1), int64 (1))), "int64") +%!assert (class (horzcat (int64 (1), int32 (1))), "int64") +%!assert (class (horzcat (int64 (1), int16 (1))), "int64") +%!assert (class (horzcat (int64 (1), int8 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint64 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint32 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint16 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint8 (1))), "int64") +%!assert (class (horzcat (int64 (1), single (1))), "int64") +%!assert (class (horzcat (int64 (1), double (1))), "int64") +%!assert (class (horzcat (int64 (1), cell (1))), "cell") +%!assert (class (horzcat (int64 (1), true)), "int64") +%!assert (class (horzcat (int64 (1), "a")), "char") + +%!assert (class (horzcat (int32 (1), int64 (1))), "int32") +%!assert (class (horzcat (int32 (1), int32 (1))), "int32") +%!assert (class (horzcat (int32 (1), int16 (1))), "int32") +%!assert (class (horzcat (int32 (1), int8 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint64 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint32 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint16 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint8 (1))), "int32") +%!assert (class (horzcat (int32 (1), single (1))), "int32") +%!assert (class (horzcat (int32 (1), double (1))), "int32") +%!assert (class (horzcat (int32 (1), cell (1))), "cell") +%!assert (class (horzcat (int32 (1), true)), "int32") +%!assert (class (horzcat (int32 (1), "a")), "char") + +%!assert (class (horzcat (int16 (1), int64 (1))), "int16") +%!assert (class (horzcat (int16 (1), int32 (1))), "int16") +%!assert (class (horzcat (int16 (1), int16 (1))), "int16") +%!assert (class (horzcat (int16 (1), int8 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint64 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint32 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint16 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint8 (1))), "int16") +%!assert (class (horzcat (int16 (1), single (1))), "int16") +%!assert (class (horzcat (int16 (1), double (1))), "int16") +%!assert (class (horzcat (int16 (1), cell (1))), "cell") +%!assert (class (horzcat (int16 (1), true)), "int16") +%!assert (class (horzcat (int16 (1), "a")), "char") + +%!assert (class (horzcat (int8 (1), int64 (1))), "int8") +%!assert (class (horzcat (int8 (1), int32 (1))), "int8") +%!assert (class (horzcat (int8 (1), int16 (1))), "int8") +%!assert (class (horzcat (int8 (1), int8 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint64 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint32 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint16 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint8 (1))), "int8") +%!assert (class (horzcat (int8 (1), single (1))), "int8") +%!assert (class (horzcat (int8 (1), double (1))), "int8") +%!assert (class (horzcat (int8 (1), cell (1))), "cell") +%!assert (class (horzcat (int8 (1), true)), "int8") +%!assert (class (horzcat (int8 (1), "a")), "char") + +%!assert (class (horzcat (uint64 (1), int64 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), int32 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), int16 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), int8 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint64 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint32 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint16 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint8 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), single (1))), "uint64") +%!assert (class (horzcat (uint64 (1), double (1))), "uint64") +%!assert (class (horzcat (uint64 (1), cell (1))), "cell") +%!assert (class (horzcat (uint64 (1), true)), "uint64") +%!assert (class (horzcat (uint64 (1), "a")), "char") + +%!assert (class (horzcat (uint32 (1), int64 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), int32 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), int16 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), int8 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint64 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint32 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint16 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint8 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), single (1))), "uint32") +%!assert (class (horzcat (uint32 (1), double (1))), "uint32") +%!assert (class (horzcat (uint32 (1), cell (1))), "cell") +%!assert (class (horzcat (uint32 (1), true)), "uint32") +%!assert (class (horzcat (uint32 (1), "a")), "char") + +%!assert (class (horzcat (uint16 (1), int64 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), int32 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), int16 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), int8 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint64 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint32 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint16 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint8 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), single (1))), "uint16") +%!assert (class (horzcat (uint16 (1), double (1))), "uint16") +%!assert (class (horzcat (uint16 (1), cell (1))), "cell") +%!assert (class (horzcat (uint16 (1), true)), "uint16") +%!assert (class (horzcat (uint16 (1), "a")), "char") + +%!assert (class (horzcat (uint8 (1), int64 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), int32 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), int16 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), int8 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint64 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint32 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint16 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint8 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), single (1))), "uint8") +%!assert (class (horzcat (uint8 (1), double (1))), "uint8") +%!assert (class (horzcat (uint8 (1), cell (1))), "cell") +%!assert (class (horzcat (uint8 (1), true)), "uint8") +%!assert (class (horzcat (uint8 (1), "a")), "char") + +%!assert (class (horzcat (single (1), int64 (1))), "int64") +%!assert (class (horzcat (single (1), int32 (1))), "int32") +%!assert (class (horzcat (single (1), int16 (1))), "int16") +%!assert (class (horzcat (single (1), int8 (1))), "int8") +%!assert (class (horzcat (single (1), uint64 (1))), "uint64") +%!assert (class (horzcat (single (1), uint32 (1))), "uint32") +%!assert (class (horzcat (single (1), uint16 (1))), "uint16") +%!assert (class (horzcat (single (1), uint8 (1))), "uint8") +%!assert (class (horzcat (single (1), single (1))), "single") +%!assert (class (horzcat (single (1), double (1))), "single") +%!assert (class (horzcat (single (1), cell (1))), "cell") +%!assert (class (horzcat (single (1), true)), "single") +%!assert (class (horzcat (single (1), "a")), "char") + +%!assert (class (horzcat (double (1), int64 (1))), "int64") +%!assert (class (horzcat (double (1), int32 (1))), "int32") +%!assert (class (horzcat (double (1), int16 (1))), "int16") +%!assert (class (horzcat (double (1), int8 (1))), "int8") +%!assert (class (horzcat (double (1), uint64 (1))), "uint64") +%!assert (class (horzcat (double (1), uint32 (1))), "uint32") +%!assert (class (horzcat (double (1), uint16 (1))), "uint16") +%!assert (class (horzcat (double (1), uint8 (1))), "uint8") +%!assert (class (horzcat (double (1), single (1))), "single") +%!assert (class (horzcat (double (1), double (1))), "double") +%!assert (class (horzcat (double (1), cell (1))), "cell") +%!assert (class (horzcat (double (1), true)), "double") +%!assert (class (horzcat (double (1), "a")), "char") + +%!assert (class (horzcat (cell (1), int64 (1))), "cell") +%!assert (class (horzcat (cell (1), int32 (1))), "cell") +%!assert (class (horzcat (cell (1), int16 (1))), "cell") +%!assert (class (horzcat (cell (1), int8 (1))), "cell") +%!assert (class (horzcat (cell (1), uint64 (1))), "cell") +%!assert (class (horzcat (cell (1), uint32 (1))), "cell") +%!assert (class (horzcat (cell (1), uint16 (1))), "cell") +%!assert (class (horzcat (cell (1), uint8 (1))), "cell") +%!assert (class (horzcat (cell (1), single (1))), "cell") +%!assert (class (horzcat (cell (1), double (1))), "cell") +%!assert (class (horzcat (cell (1), cell (1))), "cell") +%!assert (class (horzcat (cell (1), true)), "cell") +%!assert (class (horzcat (cell (1), "a")), "cell") + +%!assert (class (horzcat (true, int64 (1))), "int64") +%!assert (class (horzcat (true, int32 (1))), "int32") +%!assert (class (horzcat (true, int16 (1))), "int16") +%!assert (class (horzcat (true, int8 (1))), "int8") +%!assert (class (horzcat (true, uint64 (1))), "uint64") +%!assert (class (horzcat (true, uint32 (1))), "uint32") +%!assert (class (horzcat (true, uint16 (1))), "uint16") +%!assert (class (horzcat (true, uint8 (1))), "uint8") +%!assert (class (horzcat (true, single (1))), "single") +%!assert (class (horzcat (true, double (1))), "double") +%!assert (class (horzcat (true, cell (1))), "cell") +%!assert (class (horzcat (true, true)), "logical") +%!assert (class (horzcat (true, "a")), "char") + +%!assert (class (horzcat ("a", int64 (1))), "char") +%!assert (class (horzcat ("a", int32 (1))), "char") +%!assert (class (horzcat ("a", int16 (1))), "char") +%!assert (class (horzcat ("a", int8 (1))), "char") +%!assert (class (horzcat ("a", int64 (1))), "char") +%!assert (class (horzcat ("a", int32 (1))), "char") +%!assert (class (horzcat ("a", int16 (1))), "char") +%!assert (class (horzcat ("a", int8 (1))), "char") +%!assert (class (horzcat ("a", single (1))), "char") +%!assert (class (horzcat ("a", double (1))), "char") +%!assert (class (horzcat ("a", cell (1))), "cell") +%!assert (class (horzcat ("a", true)), "char") +%!assert (class (horzcat ("a", "a")), "char") + +%!assert (class (horzcat (cell (1), struct ("foo", "bar"))), "cell") + +%!error horzcat (struct ("foo", "bar"), cell (1)) +*/ + +DEFUN (vertcat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} vertcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ +Return the vertical concatenation of N-D array objects, @var{array1},\n\ +@var{array2}, @dots{}, @var{arrayN} along dimension 1.\n\ +\n\ +Arrays may also be concatenated vertically using the syntax for creating\n\ +new matrices. For example:\n\ +\n\ +@example\n\ +@var{vcat} = [ @var{array1}; @var{array2}; @dots{} ]\n\ +@end example\n\ +@seealso{cat, horzcat}\n\ +@end deftypefn") +{ + return do_cat (args, -1, "vertcat"); +} + +/* +%!test +%! c = {"foo"; "bar"; "bazoloa"}; +%! assert (vertcat (c, "a", "bc", "def"), {"foo"; "bar"; "bazoloa"; "a"; "bc"; "def"}); +*/ + +DEFUN (cat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cat (@var{dim}, @var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ +Return the concatenation of N-D array objects, @var{array1},\n\ +@var{array2}, @dots{}, @var{arrayN} along dimension @var{dim}.\n\ +\n\ +@example\n\ +@group\n\ +A = ones (2, 2);\n\ +B = zeros (2, 2);\n\ +cat (2, A, B)\n\ + @result{} 1 1 0 0\n\ + 1 1 0 0\n\ +@end group\n\ +@end example\n\ +\n\ +Alternatively, we can concatenate @var{A} and @var{B} along the\n\ +second dimension in the following way:\n\ +\n\ +@example\n\ +@group\n\ +[A, B]\n\ +@end group\n\ +@end example\n\ +\n\ +@var{dim} can be larger than the dimensions of the N-D array objects\n\ +and the result will thus have @var{dim} dimensions as the\n\ +following example shows:\n\ +\n\ +@example\n\ +@group\n\ +cat (4, ones (2, 2), zeros (2, 2))\n\ + @result{} ans(:,:,1,1) =\n\ +\n\ + 1 1\n\ + 1 1\n\ +\n\ + ans(:,:,1,2) =\n\ +\n\ + 0 0\n\ + 0 0\n\ +@end group\n\ +@end example\n\ +@seealso{horzcat, vertcat}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () > 0) + { + int dim = args(0).int_value () - 1; + + if (! error_state) + { + if (dim >= 0) + retval = do_cat (args.slice (1, args.length () - 1), dim, "cat"); + else + error ("cat: DIM must be a valid dimension"); + } + else + error ("cat: DIM must be an integer"); + } + else + print_usage (); + + return retval; +} + +/* +%!function ret = __testcat (t1, t2, tr, cmplx) +%! assert (cat (1, cast ([], t1), cast ([], t2)), cast ([], tr)); +%! +%! assert (cat (1, cast (1, t1), cast (2, t2)), cast ([1; 2], tr)); +%! assert (cat (1, cast (1, t1), cast ([2; 3], t2)), cast ([1; 2; 3], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast (3, t2)), cast ([1; 2; 3], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast ([3; 4], t2)), cast ([1; 2; 3; 4], tr)); +%! assert (cat (2, cast (1, t1), cast (2, t2)), cast ([1, 2], tr)); +%! assert (cat (2, cast (1, t1), cast ([2, 3], t2)), cast ([1, 2, 3], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast (3, t2)), cast ([1, 2, 3], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast ([3, 4], t2)), cast ([1, 2, 3, 4], tr)); +%! +%! assert ([cast(1, t1); cast(2, t2)], cast ([1; 2], tr)); +%! assert ([cast(1, t1); cast([2; 3], t2)], cast ([1; 2; 3], tr)); +%! assert ([cast([1; 2], t1); cast(3, t2)], cast ([1; 2; 3], tr)); +%! assert ([cast([1; 2], t1); cast([3; 4], t2)], cast ([1; 2; 3; 4], tr)); +%! assert ([cast(1, t1), cast(2, t2)], cast ([1, 2], tr)); +%! assert ([cast(1, t1), cast([2, 3], t2)], cast ([1, 2, 3], tr)); +%! assert ([cast([1, 2], t1), cast(3, t2)], cast ([1, 2, 3], tr)); +%! assert ([cast([1, 2], t1), cast([3, 4], t2)], cast ([1, 2, 3, 4], tr)); +%! +%! if (nargin == 3 || cmplx) +%! assert (cat (1, cast (1i, t1), cast (2, t2)), cast ([1i; 2], tr)); +%! assert (cat (1, cast (1i, t1), cast ([2; 3], t2)), cast ([1i; 2; 3], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast (3, t2)), cast ([1i; 2; 3], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast ([3; 4], t2)), cast ([1i; 2; 3; 4], tr)); +%! assert (cat (2, cast (1i, t1), cast (2, t2)), cast ([1i, 2], tr)); +%! assert (cat (2, cast (1i, t1), cast ([2, 3], t2)), cast ([1i, 2, 3], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast (3, t2)), cast ([1i, 2, 3], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast ([3, 4], t2)), cast ([1i, 2, 3, 4], tr)); +%! +%! assert ([cast(1i, t1); cast(2, t2)], cast ([1i; 2], tr)); +%! assert ([cast(1i, t1); cast([2; 3], t2)], cast ([1i; 2; 3], tr)); +%! assert ([cast([1i; 2], t1); cast(3, t2)], cast ([1i; 2; 3], tr)); +%! assert ([cast([1i; 2], t1); cast([3; 4], t2)], cast ([1i; 2; 3; 4], tr)); +%! assert ([cast(1i, t1), cast(2, t2)], cast ([1i, 2], tr)); +%! assert ([cast(1i, t1), cast([2, 3], t2)], cast ([1i, 2, 3], tr)); +%! assert ([cast([1i, 2], t1), cast(3, t2)], cast ([1i, 2, 3], tr)); +%! assert ([cast([1i, 2], t1), cast([3, 4], t2)], cast ([1i, 2, 3, 4], tr)); +%! +%! assert (cat (1, cast (1, t1), cast (2i, t2)), cast ([1; 2i], tr)); +%! assert (cat (1, cast (1, t1), cast ([2i; 3], t2)), cast ([1; 2i; 3], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast (3i, t2)), cast ([1; 2; 3i], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast ([3i; 4], t2)), cast ([1; 2; 3i; 4], tr)); +%! assert (cat (2, cast (1, t1), cast (2i, t2)), cast ([1, 2i], tr)); +%! assert (cat (2, cast (1, t1), cast ([2i, 3], t2)), cast ([1, 2i, 3], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast (3i, t2)), cast ([1, 2, 3i], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast ([3i, 4], t2)), cast ([1, 2, 3i, 4], tr)); +%! +%! assert ([cast(1, t1); cast(2i, t2)], cast ([1; 2i], tr)); +%! assert ([cast(1, t1); cast([2i; 3], t2)], cast ([1; 2i; 3], tr)); +%! assert ([cast([1; 2], t1); cast(3i, t2)], cast ([1; 2; 3i], tr)); +%! assert ([cast([1; 2], t1); cast([3i; 4], t2)], cast ([1; 2; 3i; 4], tr)); +%! assert ([cast(1, t1), cast(2i, t2)], cast ([1, 2i], tr)); +%! assert ([cast(1, t1), cast([2i, 3], t2)], cast ([1, 2i, 3], tr)); +%! assert ([cast([1, 2], t1), cast(3i, t2)], cast ([1, 2, 3i], tr)); +%! assert ([cast([1, 2], t1), cast([3i, 4], t2)], cast ([1, 2, 3i, 4], tr)); +%! +%! assert (cat (1, cast (1i, t1), cast (2i, t2)), cast ([1i; 2i], tr)); +%! assert (cat (1, cast (1i, t1), cast ([2i; 3], t2)), cast ([1i; 2i; 3], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast (3i, t2)), cast ([1i; 2; 3i], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast ([3i; 4], t2)), cast ([1i; 2; 3i; 4], tr)); +%! assert (cat (2, cast (1i, t1), cast (2i, t2)), cast ([1i, 2i], tr)); +%! assert (cat (2, cast (1i, t1), cast ([2i, 3], t2)), cast ([1i, 2i, 3], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast (3i, t2)), cast ([1i, 2, 3i], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast ([3i, 4], t2)), cast ([1i, 2, 3i, 4], tr)); +%! +%! assert ([cast(1i, t1); cast(2i, t2)], cast ([1i; 2i], tr)); +%! assert ([cast(1i, t1); cast([2i; 3], t2)], cast ([1i; 2i; 3], tr)); +%! assert ([cast([1i; 2], t1); cast(3i, t2)], cast ([1i; 2; 3i], tr)); +%! assert ([cast([1i; 2], t1); cast([3i; 4], t2)], cast ([1i; 2; 3i; 4], tr)); +%! assert ([cast(1i, t1), cast(2i, t2)], cast ([1i, 2i], tr)); +%! assert ([cast(1i, t1), cast([2i, 3], t2)], cast ([1i, 2i, 3], tr)); +%! assert ([cast([1i, 2], t1), cast(3i, t2)], cast ([1i, 2, 3i], tr)); +%! assert ([cast([1i, 2], t1), cast([3i, 4], t2)], cast ([1i, 2, 3i, 4], tr)); +%! endif +%! ret = true; +%!endfunction + +%!assert (__testcat ("double", "double", "double")) +%!assert (__testcat ("single", "double", "single")) +%!assert (__testcat ("double", "single", "single")) +%!assert (__testcat ("single", "single", "single")) + +%!assert (__testcat ("double", "int8", "int8", false)) +%!assert (__testcat ("int8", "double", "int8", false)) +%!assert (__testcat ("single", "int8", "int8", false)) +%!assert (__testcat ("int8", "single", "int8", false)) +%!assert (__testcat ("int8", "int8", "int8", false)) +%!assert (__testcat ("double", "int16", "int16", false)) +%!assert (__testcat ("int16", "double", "int16", false)) +%!assert (__testcat ("single", "int16", "int16", false)) +%!assert (__testcat ("int16", "single", "int16", false)) +%!assert (__testcat ("int16", "int16", "int16", false)) +%!assert (__testcat ("double", "int32", "int32", false)) +%!assert (__testcat ("int32", "double", "int32", false)) +%!assert (__testcat ("single", "int32", "int32", false)) +%!assert (__testcat ("int32", "single", "int32", false)) +%!assert (__testcat ("int32", "int32", "int32", false)) +%!assert (__testcat ("double", "int64", "int64", false)) +%!assert (__testcat ("int64", "double", "int64", false)) +%!assert (__testcat ("single", "int64", "int64", false)) +%!assert (__testcat ("int64", "single", "int64", false)) +%!assert (__testcat ("int64", "int64", "int64", false)) + +%!assert (__testcat ("double", "uint8", "uint8", false)) +%!assert (__testcat ("uint8", "double", "uint8", false)) +%!assert (__testcat ("single", "uint8", "uint8", false)) +%!assert (__testcat ("uint8", "single", "uint8", false)) +%!assert (__testcat ("uint8", "uint8", "uint8", false)) +%!assert (__testcat ("double", "uint16", "uint16", false)) +%!assert (__testcat ("uint16", "double", "uint16", false)) +%!assert (__testcat ("single", "uint16", "uint16", false)) +%!assert (__testcat ("uint16", "single", "uint16", false)) +%!assert (__testcat ("uint16", "uint16", "uint16", false)) +%!assert (__testcat ("double", "uint32", "uint32", false)) +%!assert (__testcat ("uint32", "double", "uint32", false)) +%!assert (__testcat ("single", "uint32", "uint32", false)) +%!assert (__testcat ("uint32", "single", "uint32", false)) +%!assert (__testcat ("uint32", "uint32", "uint32", false)) +%!assert (__testcat ("double", "uint64", "uint64", false)) +%!assert (__testcat ("uint64", "double", "uint64", false)) +%!assert (__testcat ("single", "uint64", "uint64", false)) +%!assert (__testcat ("uint64", "single", "uint64", false)) +%!assert (__testcat ("uint64", "uint64", "uint64", false)) + +%!assert (cat (3, [], [1,2;3,4]), [1,2;3,4]) +%!assert (cat (3, [1,2;3,4], []), [1,2;3,4]) +%!assert (cat (3, [], [1,2;3,4], []), [1,2;3,4]) +%!assert (cat (3, [], [], []), zeros (0, 0, 3)) + +%!assert (cat (3, [], [], 1, 2), cat (3, 1, 2)) +%!assert (cat (3, [], [], [1,2;3,4]), [1,2;3,4]) +%!assert (cat (4, [], [], [1,2;3,4]), [1,2;3,4]) + +%!assert ([zeros(3,2,2); ones(1,2,2)], repmat ([0;0;0;1],[1,2,2]) ) +%!assert ([zeros(3,2,2); ones(1,2,2)], vertcat (zeros (3,2,2), ones (1,2,2)) ) + +%!error cat (3, cat (3, [], []), [1,2;3,4]) +%!error cat (3, zeros (0, 0, 2), [1,2;3,4]) +*/ + +static octave_value +do_permute (const octave_value_list& args, bool inv) +{ + octave_value retval; + + if (args.length () == 2 && args(1).length () >= args(1).ndims ()) + { + Array vec = args(1).int_vector_value (); + + // FIXME -- maybe we should create an idx_vector object + // here and pass that to permute? + + int n = vec.length (); + + for (int i = 0; i < n; i++) + vec(i)--; + + octave_value ret = args(0).permute (vec, inv); + + if (! error_state) + retval = ret; + } + else + print_usage (); + + return retval; +} + +DEFUN (permute, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} permute (@var{A}, @var{perm})\n\ +Return the generalized transpose for an N-D array object @var{A}.\n\ +The permutation vector @var{perm} must contain the elements\n\ +@code{1:ndims (A)} (in any order, but each element must appear only once).\n\ +@seealso{ipermute}\n\ +@end deftypefn") +{ + return do_permute (args, false); +} + +DEFUN (ipermute, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ipermute (@var{A}, @var{iperm})\n\ +The inverse of the @code{permute} function. The expression\n\ +\n\ +@example\n\ +ipermute (permute (A, perm), perm)\n\ +@end example\n\ +\n\ +@noindent\n\ +returns the original array @var{A}.\n\ +@seealso{permute}\n\ +@end deftypefn") +{ + return do_permute (args, true); +} + +DEFUN (length, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} length (@var{a})\n\ +Return the \"length\" of the object @var{a}. For matrix objects, the\n\ +length is the number of rows or columns, whichever is greater (this\n\ +odd definition is used for compatibility with @sc{matlab}).\n\ +@seealso{size}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).length (); + else + print_usage (); + + return retval; +} + +DEFUN (ndims, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ndims (@var{a})\n\ +Return the number of dimensions of @var{a}.\n\ +For any array, the result will always be larger than or equal to 2.\n\ +Trailing singleton dimensions are not counted.\n\ +\n\ +@example\n\ +@group\n\ +ndims (ones (4, 1, 2, 1))\n\ + @result{} 3\n\ +@end group\n\ +@end example\n\ +@seealso{size}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).ndims (); + else + print_usage (); + + return retval; +} + +DEFUN (numel, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} numel (@var{a})\n\ +@deftypefnx {Built-in Function} {} numel (@var{a}, @var{idx1}, @var{idx2}, @dots{})\n\ +Return the number of elements in the object @var{a}.\n\ +Optionally, if indices @var{idx1}, @var{idx2}, @dots{} are supplied,\n\ +return the number of elements that would result from the indexing\n\ +\n\ +@example\n\ +@var{a}(@var{idx1}, @var{idx2}, @dots{})\n\ +@end example\n\ +\n\ +Note that the indices do not have to be numerical. For example,\n\ +\n\ +@example\n\ +@group\n\ +@var{a} = 1;\n\ +@var{b} = ones (2, 3);\n\ +numel (@var{a}, @var{b})\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +will return 6, as this is the number of ways to index with @var{b}.\n\ +\n\ +This method is also called when an object appears as lvalue with cs-list\n\ +indexing, i.e., @code{object@{@dots{}@}} or @code{object(@dots{}).field}.\n\ +@seealso{size}\n\ +@end deftypefn") +{ + octave_value retval; + octave_idx_type nargin = args.length (); + + if (nargin == 1) + retval = args(0).numel (); + else if (nargin > 1) + { + // Don't use numel (const octave_value_list&) here as that corresponds to + // an overloaded call, not to builtin! + retval = dims_to_numel (args(0).dims (), args.slice (1, nargin-1)); + } + else + print_usage (); + + return retval; +} + +DEFUN (size, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} size (@var{a})\n\ +@deftypefnx {Built-in Function} {} size (@var{a}, @var{dim})\n\ +Return the number of rows and columns of @var{a}.\n\ +\n\ +With one input argument and one output argument, the result is returned\n\ +in a row vector. If there are multiple output arguments, the number of\n\ +rows is assigned to the first, and the number of columns to the second,\n\ +etc. For example:\n\ +\n\ +@example\n\ +@group\n\ +size ([1, 2; 3, 4; 5, 6])\n\ + @result{} [ 3, 2 ]\n\ +\n\ +[nr, nc] = size ([1, 2; 3, 4; 5, 6])\n\ + @result{} nr = 3\n\ + @result{} nc = 2\n\ +@end group\n\ +@end example\n\ +\n\ +If given a second argument, @code{size} will return the size of the\n\ +corresponding dimension. For example,\n\ +\n\ +@example\n\ +@group\n\ +size ([1, 2; 3, 4; 5, 6], 2)\n\ + @result{} 2\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +returns the number of columns in the given matrix.\n\ +@seealso{numel, ndims, length, rows, columns}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1) + { + const dim_vector dimensions = args(0).dims (); + + if (nargout > 1) + { + const dim_vector rdims = dimensions.redim (nargout); + retval.resize (nargout); + for (int i = 0; i < nargout; i++) + retval(i) = rdims(i); + } + else + { + int ndims = dimensions.length (); + + NoAlias m (1, ndims); + + for (int i = 0; i < ndims; i++) + m(i) = dimensions(i); + + retval(0) = m; + } + } + else if (nargin == 2 && nargout < 2) + { + octave_idx_type nd = args(1).int_value (true); + + if (error_state) + error ("size: DIM must be a scalar"); + else + { + const dim_vector dv = args(0).dims (); + + if (nd > 0) + { + if (nd <= dv.length ()) + retval(0) = dv(nd-1); + else + retval(0) = 1; + } + else + error ("size: requested dimension DIM (= %d) out of range", nd); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (size_equal, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} size_equal (@var{a}, @var{b}, @dots{})\n\ +Return true if the dimensions of all arguments agree.\n\ +Trailing singleton dimensions are ignored.\n\ +Called with a single or no argument, size_equal returns true.\n\ +@seealso{size, numel, ndims}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + retval = true; + + if (nargin >= 1) + { + dim_vector a_dims = args(0).dims (); + + for (int i = 1; i < nargin; ++i) + { + dim_vector b_dims = args(i).dims (); + + if (a_dims != b_dims) + { + retval = false; + break; + } + } + } + + return retval; +} + +DEFUN (nnz, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{scalar} =} nnz (@var{a})\n\ +Return the number of non zero elements in @var{a}.\n\ +@seealso{sparse, nzmax}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).nnz (); + else + print_usage (); + + return retval; +} + +DEFUN (nzmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{scalar} =} nzmax (@var{SM})\n\ +Return the amount of storage allocated to the sparse matrix @var{SM}.\n\ +Note that Octave tends to crop unused memory at the first opportunity\n\ +for sparse objects. There are some cases of user created sparse objects\n\ +where the value returned by @dfn{nzmax} will not be the same as @dfn{nnz},\n\ +but in general they will give the same result.\n\ +@seealso{nnz, spalloc, sparse}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).nzmax (); + else + print_usage (); + + return retval; +} + +DEFUN (rows, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rows (@var{a})\n\ +Return the number of rows of @var{a}.\n\ +@seealso{columns, size, length, numel, isscalar, isvector, ismatrix}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).rows (); + else + print_usage (); + + return retval; +} + +DEFUN (columns, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} columns (@var{a})\n\ +Return the number of columns of @var{a}.\n\ +@seealso{rows, size, length, numel, isscalar, isvector, ismatrix}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).columns (); + else + print_usage (); + + return retval; +} + +DEFUN (sum, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sum (@var{x})\n\ +@deftypefnx {Built-in Function} {} sum (@var{x}, @var{dim})\n\ +@deftypefnx {Built-in Function} {} sum (@dots{}, \"native\")\n\ +@deftypefnx {Built-in Function} {} sum (@dots{}, \"double\")\n\ +@deftypefnx {Built-in Function} {} sum (@dots{}, \"extra\")\n\ +Sum of elements along dimension @var{dim}. If @var{dim} is\n\ +omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +If the optional argument \"native\" is given, then the sum is performed\n\ +in the same type as the original argument, rather than in the default\n\ +double type. For example:\n\ +\n\ +@example\n\ +@group\n\ +sum ([true, true])\n\ + @result{} 2\n\ +sum ([true, true], \"native\")\n\ + @result{} true\n\ +@end group\n\ +@end example\n\ +\n\ +On the contrary, if \"double\" is given, the sum is performed in double\n\ +precision even for single precision inputs.\n\ +\n\ +For double precision inputs, \"extra\" indicates that a more accurate\n\ +algorithm than straightforward summation is to be used. For single precision\n\ +inputs, \"extra\" is the same as \"double\". Otherwise, \"extra\" has no\n\ +effect.\n\ +@seealso{cumsum, sumsq, prod}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + bool isnative = false; + bool isdouble = false; + bool isextra = false; + + if (nargin > 1 && args(nargin - 1).is_string ()) + { + std::string str = args(nargin - 1).string_value (); + + if (! error_state) + { + if (str == "native") + isnative = true; + else if (str == "double") + isdouble = true; + else if (str == "extra") + isextra = true; + else + error ("sum: unrecognized string argument"); + nargin --; + } + } + + if (error_state) + return retval; + + if (nargin == 1 || nargin == 2) + { + octave_value arg = args(0); + + int dim = -1; + if (nargin == 2) + { + dim = args(1).int_value () - 1; + if (dim < 0) + error ("sum: invalid dimension DIM = %d", dim + 1); + } + + if (! error_state) + { + switch (arg.builtin_type ()) + { + case btyp_double: + if (arg.is_sparse_type ()) + { + if (isextra) + warning ("sum: 'extra' not yet implemented for sparse matrices"); + retval = arg.sparse_matrix_value ().sum (dim); + } + else if (isextra) + retval = arg.array_value ().xsum (dim); + else + retval = arg.array_value ().sum (dim); + break; + case btyp_complex: + if (arg.is_sparse_type ()) + { + if (isextra) + warning ("sum: 'extra' not yet implemented for sparse matrices"); + retval = arg.sparse_complex_matrix_value ().sum (dim); + } + else if (isextra) + retval = arg.complex_array_value ().xsum (dim); + else + retval = arg.complex_array_value ().sum (dim); + break; + case btyp_float: + if (isdouble || isextra) + retval = arg.float_array_value ().dsum (dim); + else + retval = arg.float_array_value ().sum (dim); + break; + case btyp_float_complex: + if (isdouble || isextra) + retval = arg.float_complex_array_value ().dsum (dim); + else + retval = arg.float_complex_array_value ().sum (dim); + break; + +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + if (isnative) \ + retval = arg.X ## _array_value ().sum (dim); \ + else \ + retval = arg.X ## _array_value ().dsum (dim); \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + + case btyp_bool: + if (arg.is_sparse_type ()) + { + if (isnative) + retval = arg.sparse_bool_matrix_value ().any (dim); + else + retval = arg.sparse_bool_matrix_value ().sum (dim); + } + else if (isnative) + retval = arg.bool_array_value ().any (dim); + else + retval = arg.bool_array_value ().sum (dim); + break; + + default: + gripe_wrong_type_arg ("sum", arg); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (sum ([true,true]), 2) +%!assert (sum ([true,true],"native"), true) +%!assert (sum (int8 ([127,10,-20])), 117) +%!assert (sum (int8 ([127,10,-20]),'native'), int8 (107)) + +%!assert (sum ([1, 2, 3]), 6) +%!assert (sum ([-1; -2; -3]), -6) +%!assert (sum ([i, 2+i, -3+2i, 4]), 3+4i) +%!assert (sum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [2+2i, 4+4i, 6+6i]) + +%!assert (sum (single ([1, 2, 3])), single (6)) +%!assert (sum (single ([-1; -2; -3])), single (-6)) +%!assert (sum (single ([i, 2+i, -3+2i, 4])), single (3+4i)) +%!assert (sum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([2+2i, 4+4i, 6+6i])) + +%!assert (sum ([1, 2; 3, 4], 1), [4, 6]) +%!assert (sum ([1, 2; 3, 4], 2), [3; 7]) +%!assert (sum (zeros (1, 0)), 0) +%!assert (sum (zeros (1, 0), 1), zeros (1, 0)) +%!assert (sum (zeros (1, 0), 2), 0) +%!assert (sum (zeros (0, 1)), 0) +%!assert (sum (zeros (0, 1), 1), 0) +%!assert (sum (zeros (0, 1), 2), zeros (0, 1)) +%!assert (sum (zeros (2, 0)), zeros (1, 0)) +%!assert (sum (zeros (2, 0), 1), zeros (1, 0)) +%!assert (sum (zeros (2, 0), 2), [0; 0]) +%!assert (sum (zeros (0, 2)), [0, 0]) +%!assert (sum (zeros (0, 2), 1), [0, 0]) +%!assert (sum (zeros (0, 2), 2), zeros (0, 1)) +%!assert (sum (zeros (2, 2, 0, 3)), zeros (1, 2, 0, 3)) +%!assert (sum (zeros (2, 2, 0, 3), 2), zeros (2, 1, 0, 3)) +%!assert (sum (zeros (2, 2, 0, 3), 3), zeros (2, 2, 1, 3)) +%!assert (sum (zeros (2, 2, 0, 3), 4), zeros (2, 2, 0)) +%!assert (sum (zeros (2, 2, 0, 3), 7), zeros (2, 2, 0, 3)) + +%!assert (sum (single ([1, 2; 3, 4]), 1), single ([4, 6])) +%!assert (sum (single ([1, 2; 3, 4]), 2), single ([3; 7])) +%!assert (sum (zeros (1, 0, "single")), single (0)) +%!assert (sum (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (sum (zeros (1, 0, "single"), 2), single (0)) +%!assert (sum (zeros (0, 1, "single")), single (0)) +%!assert (sum (zeros (0, 1, "single"), 1), single (0)) +%!assert (sum (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) +%!assert (sum (zeros (2, 0, "single")), zeros (1, 0, "single")) +%!assert (sum (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (sum (zeros (2, 0, "single"), 2), single ([0; 0])) +%!assert (sum (zeros (0, 2, "single")), single ([0, 0])) +%!assert (sum (zeros (0, 2, "single"), 1), single ([0, 0])) +%!assert (sum (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single")), zeros (1, 2, 0, 3, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 2), zeros (2, 1, 0, 3, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 3), zeros (2, 2, 1, 3, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 4), zeros (2, 2, 0, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 7), zeros (2, 2, 0, 3, "single")) + +%!error sum () +*/ + +DEFUN (sumsq, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sumsq (@var{x})\n\ +@deftypefnx {Built-in Function} {} sumsq (@var{x}, @var{dim})\n\ +Sum of squares of elements along dimension @var{dim}. If @var{dim}\n\ +is omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +This function is conceptually equivalent to computing\n\ +\n\ +@example\n\ +sum (x .* conj (x), dim)\n\ +@end example\n\ +\n\ +@noindent\n\ +but it uses less memory and avoids calling @code{conj} if @var{x} is real.\n\ +@seealso{sum, prod}\n\ +@end deftypefn") +{ + DATA_REDUCTION (sumsq); +} + +/* +%!assert (sumsq ([1, 2, 3]), 14) +%!assert (sumsq ([-1; -2; 4i]), 21) +%!assert (sumsq ([1, 2, 3; 2, 3, 4; 4i, 6i, 2]), [21, 49, 29]) + +%!assert (sumsq (single ([1, 2, 3])), single (14)) +%!assert (sumsq (single ([-1; -2; 4i])), single (21)) +%!assert (sumsq (single ([1, 2, 3; 2, 3, 4; 4i, 6i, 2])), single ([21, 49, 29])) + +%!assert (sumsq ([1, 2; 3, 4], 1), [10, 20]) +%!assert (sumsq ([1, 2; 3, 4], 2), [5; 25]) + +%!assert (sumsq (single ([1, 2; 3, 4]), 1), single ([10, 20])) +%!assert (sumsq (single ([1, 2; 3, 4]), 2), single ([5; 25])) + +%!error sumsq () +*/ + +DEFUN (islogical, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} islogical (@var{x})\n\ +@deftypefnx {Built-in Function} {} isbool (@var{x})\n\ +Return true if @var{x} is a logical object.\n\ +@seealso{isfloat, isinteger, ischar, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_bool_type (); + else + print_usage (); + + return retval; +} + +DEFALIAS (isbool, islogical); + +/* +%!assert (islogical (true), true) +%!assert (islogical (false), true) +%!assert (islogical ([true, false]), true) +%!assert (islogical (1), false) +%!assert (islogical (1i), false) +%!assert (islogical ([1,1]), false) +%!assert (islogical (single (1)), false) +%!assert (islogical (single (1i)), false) +%!assert (islogical (single ([1,1])), false) +%!assert (islogical (sparse ([true, false])), true) +%!assert (islogical (sparse ([1, 0])), false) +*/ + +DEFUN (isinteger, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isinteger (@var{x})\n\ +Return true if @var{x} is an integer object (int8, uint8, int16, etc.).\n\ +Note that @w{@code{isinteger (14)}} is false because numeric constants in\n\ +Octave are double precision floating point values.\n\ +@seealso{isfloat, ischar, islogical, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_integer_type (); + else + print_usage (); + + return retval; +} + +DEFUN (iscomplex, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} iscomplex (@var{x})\n\ +Return true if @var{x} is a complex-valued numeric object.\n\ +@seealso{isreal, isnumeric, islogical, ischar, isfloat, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_complex_type (); + else + print_usage (); + + return retval; +} + +DEFUN (isfloat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isfloat (@var{x})\n\ +Return true if @var{x} is a floating-point numeric object.\n\ +Objects of class double or single are floating-point objects.\n\ +@seealso{isinteger, ischar, islogical, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_float_type (); + else + print_usage (); + + return retval; +} + +// FIXME -- perhaps this should be implemented with an +// octave_value member function? + +DEFUN (complex, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} complex (@var{x})\n\ +@deftypefnx {Built-in Function} {} complex (@var{re}, @var{im})\n\ +Return a complex result from real arguments. With 1 real argument @var{x},\n\ +return the complex result @code{@var{x} + 0i}. With 2 real arguments,\n\ +return the complex result @code{@var{re} + @var{im}}. @code{complex} can\n\ +often be more convenient than expressions such as @code{a + i*b}.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +complex ([1, 2], [3, 4])\n\ + @result{} [ 1 + 3i 2 + 4i ]\n\ +@end group\n\ +@end example\n\ +@seealso{real, imag, iscomplex, abs, arg}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value arg = args(0); + + if (arg.is_complex_type ()) + retval = arg; + else + { + if (arg.is_sparse_type ()) + { + SparseComplexMatrix val = arg.sparse_complex_matrix_value (); + + if (! error_state) + retval = octave_value (new octave_sparse_complex_matrix (val)); + } + else if (arg.is_single_type ()) + { + if (arg.numel () == 1) + { + FloatComplex val = arg.float_complex_value (); + + if (! error_state) + retval = octave_value (new octave_float_complex (val)); + } + else + { + FloatComplexNDArray val = arg.float_complex_array_value (); + + if (! error_state) + retval = octave_value (new octave_float_complex_matrix (val)); + } + } + else + { + if (arg.numel () == 1) + { + Complex val = arg.complex_value (); + + if (! error_state) + retval = octave_value (new octave_complex (val)); + } + else + { + ComplexNDArray val = arg.complex_array_value (); + + if (! error_state) + retval = octave_value (new octave_complex_matrix (val)); + } + } + + if (error_state) + error ("complex: invalid conversion"); + } + } + else if (nargin == 2) + { + octave_value re = args(0); + octave_value im = args(1); + + if (re.is_sparse_type () && im.is_sparse_type ()) + { + const SparseMatrix re_val = re.sparse_matrix_value (); + const SparseMatrix im_val = im.sparse_matrix_value (); + + if (!error_state) + { + if (re.numel () == 1) + { + SparseComplexMatrix result; + if (re_val.nnz () == 0) + result = Complex (0, 1) * SparseComplexMatrix (im_val); + else + { + result = SparseComplexMatrix (im_val.dims (), re_val (0)); + octave_idx_type nr = im_val.rows (); + octave_idx_type nc = im_val.cols (); + + for (octave_idx_type j = 0; j < nc; j++) + { + octave_idx_type off = j * nr; + for (octave_idx_type i = im_val.cidx (j); + i < im_val.cidx (j + 1); i++) + result.data (im_val.ridx (i) + off) = + result.data (im_val.ridx (i) + off) + + Complex (0, im_val.data (i)); + } + } + retval = octave_value (new octave_sparse_complex_matrix (result)); + } + else if (im.numel () == 1) + { + SparseComplexMatrix result; + if (im_val.nnz () == 0) + result = SparseComplexMatrix (re_val); + else + { + result = SparseComplexMatrix (re_val.rows (), re_val.cols (), Complex (0, im_val (0))); + octave_idx_type nr = re_val.rows (); + octave_idx_type nc = re_val.cols (); + + for (octave_idx_type j = 0; j < nc; j++) + { + octave_idx_type off = j * nr; + for (octave_idx_type i = re_val.cidx (j); + i < re_val.cidx (j + 1); i++) + result.data (re_val.ridx (i) + off) = + result.data (re_val.ridx (i) + off) + + re_val.data (i); + } + } + retval = octave_value (new octave_sparse_complex_matrix (result)); + } + else + { + if (re_val.dims () == im_val.dims ()) + { + SparseComplexMatrix result = SparseComplexMatrix (re_val) + + Complex (0, 1) * SparseComplexMatrix (im_val); + retval = octave_value (new octave_sparse_complex_matrix (result)); + } + else + error ("complex: dimension mismatch"); + } + } + } + else if (re.is_single_type () || im.is_single_type ()) + { + if (re.numel () == 1) + { + float re_val = re.float_value (); + + if (im.numel () == 1) + { + float im_val = im.double_value (); + + if (! error_state) + retval = octave_value (new octave_float_complex (FloatComplex (re_val, im_val))); + } + else + { + const FloatNDArray im_val = im.float_array_value (); + + if (! error_state) + { + FloatComplexNDArray result (im_val.dims (), FloatComplex ()); + + for (octave_idx_type i = 0; i < im_val.numel (); i++) + result.xelem (i) = FloatComplex (re_val, im_val(i)); + + retval = octave_value (new octave_float_complex_matrix (result)); + } + } + } + else + { + const FloatNDArray re_val = re.float_array_value (); + + if (im.numel () == 1) + { + float im_val = im.float_value (); + + if (! error_state) + { + FloatComplexNDArray result (re_val.dims (), FloatComplex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = FloatComplex (re_val(i), im_val); + + retval = octave_value (new octave_float_complex_matrix (result)); + } + } + else + { + const FloatNDArray im_val = im.float_array_value (); + + if (! error_state) + { + if (re_val.dims () == im_val.dims ()) + { + FloatComplexNDArray result (re_val.dims (), FloatComplex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = FloatComplex (re_val(i), im_val(i)); + + retval = octave_value (new octave_float_complex_matrix (result)); + } + else + error ("complex: dimension mismatch"); + } + } + } + } + else if (re.numel () == 1) + { + double re_val = re.double_value (); + + if (im.numel () == 1) + { + double im_val = im.double_value (); + + if (! error_state) + retval = octave_value (new octave_complex (Complex (re_val, im_val))); + } + else + { + const NDArray im_val = im.array_value (); + + if (! error_state) + { + ComplexNDArray result (im_val.dims (), Complex ()); + + for (octave_idx_type i = 0; i < im_val.numel (); i++) + result.xelem (i) = Complex (re_val, im_val(i)); + + retval = octave_value (new octave_complex_matrix (result)); + } + } + } + else + { + const NDArray re_val = re.array_value (); + + if (im.numel () == 1) + { + double im_val = im.double_value (); + + if (! error_state) + { + ComplexNDArray result (re_val.dims (), Complex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = Complex (re_val(i), im_val); + + retval = octave_value (new octave_complex_matrix (result)); + } + } + else + { + const NDArray im_val = im.array_value (); + + if (! error_state) + { + if (re_val.dims () == im_val.dims ()) + { + ComplexNDArray result (re_val.dims (), Complex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = Complex (re_val(i), im_val(i)); + + retval = octave_value (new octave_complex_matrix (result)); + } + else + error ("complex: dimension mismatch"); + } + } + } + + if (error_state) + error ("complex: invalid conversion"); + } + else + print_usage (); + + return retval; +} + +DEFUN (isreal, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isreal (@var{x})\n\ +Return true if @var{x} is a non-complex matrix or scalar.\n\ +For compatibility with @sc{matlab}, this includes logical and character\n\ +matrices.\n\ +@seealso{iscomplex, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_real_type (); + else + print_usage (); + + return retval; +} + +DEFUN (isempty, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isempty (@var{a})\n\ +Return true if @var{a} is an empty matrix (any one of its dimensions is\n\ +zero). Otherwise, return false.\n\ +@seealso{isnull, isa}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + retval = args(0).is_empty (); + else + print_usage (); + + return retval; +} + +DEFUN (isnumeric, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isnumeric (@var{x})\n\ +Return true if @var{x} is a numeric object, i.e., an integer, real, or\n\ +complex array. Logical and character arrays are not considered to be\n\ +numeric.\n\ +@seealso{isinteger, isfloat, isreal, iscomplex, islogical, ischar, iscell, isstruct, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_numeric_type (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isnumeric (1), true) +%!assert (isnumeric (1i), true) +%!assert (isnumeric ([1,1]), true) +%!assert (isnumeric (single (1)), true) +%!assert (isnumeric (single (1i)), true) +%!assert (isnumeric (single ([1,1])), true) +%!assert (isnumeric (int8 (1)), true) +%!assert (isnumeric (uint8 ([1,1])), true) +%!assert (isnumeric ("Hello World"), false) +%!assert (isnumeric (true), false) +%!assert (isnumeric (false), false) +%!assert (isnumeric ([true, false]), false) +%!assert (isnumeric (sparse ([true, false])), false) +*/ + +DEFUN (ismatrix, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ismatrix (@var{a})\n\ +Return true if @var{a} is a numeric, logical, or character matrix.\n\ +Scalars (1x1 matrices) and vectors (@nospell{1xN} or @nospell{Nx1} matrices)\n\ +are subsets of the more general N-dimensional matrix and @code{ismatrix}\n\ +will return true for these objects as well.\n\ +@seealso{isscalar, isvector, iscell, isstruct, issparse, isa}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + octave_value arg = args(0); + + retval = arg.is_matrix_type () || arg.is_scalar_type () || arg.is_range (); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (ismatrix ([])) +%!assert (ismatrix (1)) +%!assert (ismatrix ([1, 2, 3])) +%!assert (ismatrix ([1, 2; 3, 4])) +%!assert (ismatrix (zeros (3, 2, 4))) + +%!assert (ismatrix (single ([]))) +%!assert (ismatrix (single (1))) +%!assert (ismatrix (single ([1, 2, 3]))) +%!assert (ismatrix (single ([1, 2; 3, 4]))) + +%!assert (ismatrix ("t")) +%!assert (ismatrix ("test")) +%!assert (ismatrix (["test"; "ing"])) + +%!test +%! s.a = 1; +%! assert (ismatrix (s), false); + +%!error ismatrix () +%!error ismatrix ([1, 2; 3, 4], 2) +*/ + +static octave_value +fill_matrix (const octave_value_list& args, int val, const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // FIXME -- perhaps this should be made extensible by + // using the class name to lookup a function to call to create + // the new value. + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_int8: + retval = int8NDArray (dims, val); + break; + + case oct_data_conv::dt_uint8: + retval = uint8NDArray (dims, val); + break; + + case oct_data_conv::dt_int16: + retval = int16NDArray (dims, val); + break; + + case oct_data_conv::dt_uint16: + retval = uint16NDArray (dims, val); + break; + + case oct_data_conv::dt_int32: + retval = int32NDArray (dims, val); + break; + + case oct_data_conv::dt_uint32: + retval = uint32NDArray (dims, val); + break; + + case oct_data_conv::dt_int64: + retval = int64NDArray (dims, val); + break; + + case oct_data_conv::dt_uint64: + retval = uint64NDArray (dims, val); + break; + + case oct_data_conv::dt_single: + retval = FloatNDArray (dims, val); + break; + + case oct_data_conv::dt_double: + { + if (val == 1 && dims.length () == 2 && dims (0) == 1) + retval = Range (1.0, 0.0, dims (1)); // packed form + else + retval = NDArray (dims, val); + } + break; + + case oct_data_conv::dt_logical: + retval = boolNDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, double val, float fval, + const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_single: + retval = FloatNDArray (dims, fval); + break; + + case oct_data_conv::dt_double: + retval = NDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, double val, const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_single: + retval = FloatNDArray (dims, static_cast (val)); + break; + + case oct_data_conv::dt_double: + retval = NDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, const Complex& val, + const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_single: + retval = FloatComplexNDArray (dims, static_cast (val)); + break; + + case oct_data_conv::dt_double: + retval = ComplexNDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, bool val, const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + dim_vector dims (1, 1); + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + retval = boolNDArray (dims, val); + } + + return retval; +} + +DEFUN (ones, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ones (@var{n})\n\ +@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} ones ([@var{m} @var{n} @dots{}])\n\ +@deftypefnx {Built-in Function} {} ones (@dots{}, @var{class})\n\ +Return a matrix or N-dimensional array whose elements are all 1.\n\ +If invoked with a single scalar integer argument @var{n}, return a square\n\ +@nospell{NxN} matrix. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +the given dimensions.\n\ +\n\ +If you need to create a matrix whose values are all the same, you should\n\ +use an expression like\n\ +\n\ +@example\n\ +val_matrix = val * ones (m, n)\n\ +@end example\n\ +\n\ +The optional argument @var{class} specifies the class of the return array\n\ +and defaults to double. For example:\n\ +\n\ +@example\n\ +val = ones (m,n, \"uint8\")\n\ +@end example\n\ +@seealso{zeros}\n\ +@end deftypefn") +{ + return fill_matrix (args, 1, "ones"); +} + +/* +%!assert (ones (3), [1, 1, 1; 1, 1, 1; 1, 1, 1]) +%!assert (ones (2, 3), [1, 1, 1; 1, 1, 1]) +%!assert (ones (3, 2), [1, 1; 1, 1; 1, 1]) +%!assert (size (ones (3, 4, 5)), [3, 4, 5]) + +%!assert (ones (3, "single"), single ([1, 1, 1; 1, 1, 1; 1, 1, 1])) +%!assert (ones (2, 3, "single"), single ([1, 1, 1; 1, 1, 1])) +%!assert (ones (3, 2, "single"), single ([1, 1; 1, 1; 1, 1])) +%!assert (size (ones (3, 4, 5, "single")), [3, 4, 5]) + +%!assert (ones (3, "int8"), int8 ([1, 1, 1; 1, 1, 1; 1, 1, 1])) +%!assert (ones (2, 3, "int8"), int8 ([1, 1, 1; 1, 1, 1])) +%!assert (ones (3, 2, "int8"), int8 ([1, 1; 1, 1; 1, 1])) +%!assert (size (ones (3, 4, 5, "int8")), [3, 4, 5]) +*/ + +DEFUN (zeros, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} zeros (@var{n})\n\ +@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} zeros ([@var{m} @var{n} @dots{}])\n\ +@deftypefnx {Built-in Function} {} zeros (@dots{}, @var{class})\n\ +Return a matrix or N-dimensional array whose elements are all 0.\n\ +If invoked with a single scalar integer argument, return a square\n\ +@nospell{NxN} matrix. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +the given dimensions.\n\ +\n\ +The optional argument @var{class} specifies the class of the return array\n\ +and defaults to double. For example:\n\ +\n\ +@example\n\ +val = zeros (m,n, \"uint8\")\n\ +@end example\n\ +@seealso{ones}\n\ +@end deftypefn") +{ + return fill_matrix (args, 0, "zeros"); +} + +/* +%!assert (zeros (3), [0, 0, 0; 0, 0, 0; 0, 0, 0]) +%!assert (zeros (2, 3), [0, 0, 0; 0, 0, 0]) +%!assert (zeros (3, 2), [0, 0; 0, 0; 0, 0]) +%!assert (size (zeros (3, 4, 5)), [3, 4, 5]) + +%!assert (zeros (3, "single"), single ([0, 0, 0; 0, 0, 0; 0, 0, 0])) +%!assert (zeros (2, 3, "single"), single ([0, 0, 0; 0, 0, 0])) +%!assert (zeros (3, 2, "single"), single ([0, 0; 0, 0; 0, 0])) +%!assert (size (zeros (3, 4, 5, "single")), [3, 4, 5]) + +%!assert (zeros (3, "int8"), int8 ([0, 0, 0; 0, 0, 0; 0, 0, 0])) +%!assert (zeros (2, 3, "int8"), int8 ([0, 0, 0; 0, 0, 0])) +%!assert (zeros (3, 2, "int8"), int8 ([0, 0; 0, 0; 0, 0])) +%!assert (size (zeros (3, 4, 5, "int8")), [3, 4, 5]) +*/ + +DEFUN (Inf, args, , + "-*- texinfo -*-\n\ +@c List other form of function in documentation index\n\ +@findex inf\n\ +\n\ +@deftypefn {Built-in Function} {} Inf\n\ +@deftypefnx {Built-in Function} {} Inf (@var{n})\n\ +@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} Inf (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ +to the IEEE representation for positive infinity.\n\ +\n\ +Infinity is produced when results are too large to be represented using the\n\ +the IEEE floating point format for numbers. Two common examples which\n\ +produce infinity are division by zero and overflow.\n\ +\n\ +@example\n\ +@group\n\ +[ 1/0 e^800 ]\n\ +@result{} Inf Inf\n\ +@end group\n\ +@end example\n\ +\n\ +When called with no arguments, return a scalar with the value @samp{Inf}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{isinf, NaN}\n\ +@end deftypefn") +{ + return fill_matrix (args, lo_ieee_inf_value (), + lo_ieee_float_inf_value (), "Inf"); +} + +DEFALIAS (inf, Inf); + +/* +%!assert (inf (3), [Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf]) +%!assert (inf (2, 3), [Inf, Inf, Inf; Inf, Inf, Inf]) +%!assert (inf (3, 2), [Inf, Inf; Inf, Inf; Inf, Inf]) +%!assert (size (inf (3, 4, 5)), [3, 4, 5]) + +%!assert (inf (3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf])) +%!assert (inf (2, 3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf])) +%!assert (inf (3, 2, "single"), single ([Inf, Inf; Inf, Inf; Inf, Inf])) +%!assert (size (inf (3, 4, 5, "single")), [3, 4, 5]) + +%!error (inf (3, "int8")) +%!error (inf (2, 3, "int8")) +%!error (inf (3, 2, "int8")) +%!error (inf (3, 4, 5, "int8")) +*/ + +DEFUN (NaN, args, , + "-*- texinfo -*-\n\ +@c List other form of function in documentation index\n\ +@findex nan\n\ +\n\ +@deftypefn {Built-in Function} {} NaN\n\ +@deftypefnx {Built-in Function} {} NaN (@var{n})\n\ +@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} NaN (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the IEEE symbol NaN (Not a Number).\n\ +NaN is the result of operations which do not produce a well defined numerical\n\ +result. Common operations which produce a NaN are arithmetic with infinity\n\ +@tex\n\ +($\\infty - \\infty$), zero divided by zero ($0/0$),\n\ +@end tex\n\ +@ifnottex\n\ +(Inf - Inf), zero divided by zero (0/0),\n\ +@end ifnottex\n\ +and any operation involving another NaN value (5 + NaN).\n\ +\n\ +Note that NaN always compares not equal to NaN (NaN != NaN). This behavior\n\ +is specified by the IEEE standard for floating point arithmetic. To\n\ +find NaN values, use the @code{isnan} function.\n\ +\n\ +When called with no arguments, return a scalar with the value @samp{NaN}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{isnan, Inf}\n\ +@end deftypefn") +{ + return fill_matrix (args, lo_ieee_nan_value (), + lo_ieee_float_nan_value (), "NaN"); +} + +DEFALIAS (nan, NaN); + +/* +%!assert (NaN (3), [NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN]) +%!assert (NaN (2, 3), [NaN, NaN, NaN; NaN, NaN, NaN]) +%!assert (NaN (3, 2), [NaN, NaN; NaN, NaN; NaN, NaN]) +%!assert (size (NaN (3, 4, 5)), [3, 4, 5]) + +%!assert (NaN (3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN])) +%!assert (NaN (2, 3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN])) +%!assert (NaN (3, 2, "single"), single ([NaN, NaN; NaN, NaN; NaN, NaN])) +%!assert (size (NaN (3, 4, 5, "single")), [3, 4, 5]) + +%!error (NaN (3, "int8")) +%!error (NaN (2, 3, "int8")) +%!error (NaN (3, 2, "int8")) +%!error (NaN (3, 4, 5, "int8")) +*/ + +DEFUN (e, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} e\n\ +@deftypefnx {Built-in Function} {} e (@var{n})\n\ +@deftypefnx {Built-in Function} {} e (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} e (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} e (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the base of natural logarithms. The constant\n\ +@tex\n\ +$e$ satisfies the equation $\\log (e) = 1$.\n\ +@end tex\n\ +@ifnottex\n\ +@samp{e} satisfies the equation @code{log} (e) = 1.\n\ +@end ifnottex\n\ +\n\ +When called with no arguments, return a scalar with the value @math{e}. When\n\ +called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{log, exp, pi, i, j}\n\ +@end deftypefn") +{ +#if defined (M_E) + double e_val = M_E; +#else + double e_val = exp (1.0); +#endif + + return fill_matrix (args, e_val, "e"); +} + +DEFUN (eps, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eps\n\ +@deftypefnx {Built-in Function} {} eps (@var{x})\n\ +@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} eps (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all eps,\n\ +the machine precision. More precisely, @code{eps} is the relative spacing\n\ +between any two adjacent numbers in the machine's floating point system.\n\ +This number is obviously system dependent. On machines that support IEEE\n\ +floating point arithmetic, @code{eps} is approximately\n\ +@tex\n\ +$2.2204\\times10^{-16}$ for double precision and $1.1921\\times10^{-7}$\n\ +@end tex\n\ +@ifnottex\n\ +2.2204e-16 for double precision and 1.1921e-07\n\ +@end ifnottex\n\ +for single precision.\n\ +\n\ +When called with no arguments, return a scalar with the value\n\ +@code{eps (1.0)}.\n\ +Given a single argument @var{x}, return the distance between @var{x} and\n\ +the next largest value.\n\ +When called with more than one argument the first two arguments are taken as\n\ +the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{realmax, realmin, intmax, bitmax}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value retval; + + if (nargin == 1 && ! args(0).is_string ()) + { + if (args(0).is_single_type ()) + { + float val = args(0).float_value (); + + if (! error_state) + { + val = ::fabsf (val); + if (xisnan (val) || xisinf (val)) + retval = fill_matrix (octave_value ("single"), + lo_ieee_nan_value (), + lo_ieee_float_nan_value (), "eps"); + else if (val < FLT_MIN) + retval = fill_matrix (octave_value ("single"), 0e0, + powf (2.0, -149e0), "eps"); + else + { + int expon; + frexpf (val, &expon); + val = std::pow (static_cast (2.0), + static_cast (expon - 24)); + retval = fill_matrix (octave_value ("single"), DBL_EPSILON, + val, "eps"); + } + } + } + else + { + double val = args(0).double_value (); + + if (! error_state) + { + val = ::fabs (val); + if (xisnan (val) || xisinf (val)) + retval = fill_matrix (octave_value_list (), + lo_ieee_nan_value (), + lo_ieee_float_nan_value (), "eps"); + else if (val < DBL_MIN) + retval = fill_matrix (octave_value_list (), + pow (2.0, -1074e0), 0e0, "eps"); + else + { + int expon; + frexp (val, &expon); + val = std::pow (static_cast (2.0), + static_cast (expon - 53)); + retval = fill_matrix (octave_value_list (), val, + FLT_EPSILON, "eps"); + } + } + } + } + else + retval = fill_matrix (args, DBL_EPSILON, FLT_EPSILON, "eps"); + + return retval; +} + +/* +%!assert (eps (1/2), 2^(-53)) +%!assert (eps (1), 2^(-52)) +%!assert (eps (2), 2^(-51)) +%!assert (eps (realmax), 2^971) +%!assert (eps (0), 2^(-1074)) +%!assert (eps (realmin/2), 2^(-1074)) +%!assert (eps (realmin/16), 2^(-1074)) +%!assert (eps (Inf), NaN) +%!assert (eps (NaN), NaN) +%!assert (eps (single (1/2)), single (2^(-24))) +%!assert (eps (single (1)), single (2^(-23))) +%!assert (eps (single (2)), single (2^(-22))) +%!assert (eps (realmax ("single")), single (2^104)) +%!assert (eps (single (0)), single (2^(-149))) +%!assert (eps (realmin ("single")/2), single (2^(-149))) +%!assert (eps (realmin ("single")/16), single (2^(-149))) +%!assert (eps (single (Inf)), single (NaN)) +%!assert (eps (single (NaN)), single (NaN)) +*/ + +DEFUN (pi, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pi\n\ +@deftypefnx {Built-in Function} {} pi (@var{n})\n\ +@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} pi (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the ratio of the circumference of a circle to its\n\ +@tex\n\ +diameter($\\pi$).\n\ +@end tex\n\ +@ifnottex\n\ +diameter.\n\ +@end ifnottex\n\ +Internally, @code{pi} is computed as @samp{4.0 * atan (1.0)}.\n\ +\n\ +When called with no arguments, return a scalar with the value of\n\ +@tex\n\ +$\\pi$.\n\ +@end tex\n\ +@ifnottex\n\ +pi.\n\ +@end ifnottex\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{e, i, j}\n\ +@end deftypefn") +{ +#if defined (M_PI) + double pi_val = M_PI; +#else + double pi_val = 4.0 * atan (1.0); +#endif + + return fill_matrix (args, pi_val, "pi"); +} + +DEFUN (realmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} realmax\n\ +@deftypefnx {Built-in Function} {} realmax (@var{n})\n\ +@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} realmax (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ +to the largest floating point number that is representable. The actual\n\ +value is system dependent. On machines that support IEEE\n\ +floating point arithmetic, @code{realmax} is approximately\n\ +@tex\n\ +$1.7977\\times10^{308}$ for double precision and $3.4028\\times10^{38}$\n\ +@end tex\n\ +@ifnottex\n\ +1.7977e+308 for double precision and 3.4028e+38\n\ +@end ifnottex\n\ +for single precision.\n\ +\n\ +When called with no arguments, return a scalar with the value\n\ +@code{realmax (\"double\")}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{realmin, intmax, bitmax, eps}\n\ +@end deftypefn") +{ + return fill_matrix (args, DBL_MAX, FLT_MAX, "realmax"); +} + +DEFUN (realmin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} realmin\n\ +@deftypefnx {Built-in Function} {} realmin (@var{n})\n\ +@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} realmin (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ +to the smallest normalized floating point number that is representable.\n\ +The actual value is system dependent. On machines that support\n\ +IEEE floating point arithmetic, @code{realmin} is approximately\n\ +@tex\n\ +$2.2251\\times10^{-308}$ for double precision and $1.1755\\times10^{-38}$\n\ +@end tex\n\ +@ifnottex\n\ +2.2251e-308 for double precision and 1.1755e-38\n\ +@end ifnottex\n\ +for single precision.\n\ +\n\ +When called with no arguments, return a scalar with the value\n\ +@code{realmin (\"double\")}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{realmax, intmin, eps}\n\ +@end deftypefn") +{ + return fill_matrix (args, DBL_MIN, FLT_MIN, "realmin"); +} + +DEFUN (I, args, , + "-*- texinfo -*-\n\ +@c List other forms of function in documentation index\n\ +@findex i\n\ +@findex j\n\ +@findex J\n\ +\n\ +@deftypefn {Built-in Function} {} I\n\ +@deftypefnx {Built-in Function} {} I (@var{n})\n\ +@deftypefnx {Built-in Function} {} I (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} I (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} I (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the pure imaginary unit, defined as\n\ +@tex\n\ +$\\sqrt{-1}$.\n\ +@end tex\n\ +@ifnottex\n\ +@code{sqrt (-1)}.\n\ +@end ifnottex\n\ +\n\ +I, and its equivalents i, j, and J, are functions so any of the names may\n\ +be reused for other purposes (such as i for a counter variable).\n\ +\n\ +When called with no arguments, return a scalar with the value @math{i}. When\n\ +called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{e, pi, log, exp, i, j, J}\n\ +@end deftypefn") +{ + return fill_matrix (args, Complex (0.0, 1.0), "I"); +} + +DEFALIAS (i, I); +DEFALIAS (J, I); +DEFALIAS (j, I); + +DEFUN (NA, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} NA\n\ +@deftypefnx {Built-in Function} {} NA (@var{n})\n\ +@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} NA (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the special constant used to designate missing values.\n\ +\n\ +Note that NA always compares not equal to NA (NA != NA).\n\ +To find NA values, use the @code{isna} function.\n\ +\n\ +When called with no arguments, return a scalar with the value @samp{NA}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{isna}\n\ +@end deftypefn") +{ + return fill_matrix (args, lo_ieee_na_value (), + lo_ieee_float_na_value (), "NA"); +} + +/* +%!assert (single (NA ("double")), NA ("single")) +%!assert (double (NA ("single")), NA ("double")) +*/ + +DEFUN (false, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} false (@var{x})\n\ +@deftypefnx {Built-in Function} {} false (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} false (@var{n}, @var{m}, @var{k}, @dots{})\n\ +Return a matrix or N-dimensional array whose elements are all logical 0.\n\ +If invoked with a single scalar integer argument, return a square\n\ +matrix of the specified size. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +given dimensions.\n\ +@seealso{true}\n\ +@end deftypefn") +{ + return fill_matrix (args, false, "false"); +} + +DEFUN (true, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} true (@var{x})\n\ +@deftypefnx {Built-in Function} {} true (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} true (@var{n}, @var{m}, @var{k}, @dots{})\n\ +Return a matrix or N-dimensional array whose elements are all logical 1.\n\ +If invoked with a single scalar integer argument, return a square\n\ +matrix of the specified size. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +given dimensions.\n\ +@seealso{false}\n\ +@end deftypefn") +{ + return fill_matrix (args, true, "true"); +} + +template +octave_value +identity_matrix (int nr, int nc) +{ + octave_value retval; + + typename MT::element_type one (1); + + if (nr == 1 && nc == 1) + retval = one; + else + { + dim_vector dims (nr, nc); + + typename MT::element_type zero (0); + + MT m (dims, zero); + + if (nr > 0 && nc > 0) + { + int n = std::min (nr, nc); + + for (int i = 0; i < n; i++) + m(i,i) = one; + } + + retval = m; + } + + return retval; +} + +#define INSTANTIATE_EYE(T) \ + template octave_value identity_matrix (int, int) + +INSTANTIATE_EYE (int8NDArray); +INSTANTIATE_EYE (uint8NDArray); +INSTANTIATE_EYE (int16NDArray); +INSTANTIATE_EYE (uint16NDArray); +INSTANTIATE_EYE (int32NDArray); +INSTANTIATE_EYE (uint32NDArray); +INSTANTIATE_EYE (int64NDArray); +INSTANTIATE_EYE (uint64NDArray); +INSTANTIATE_EYE (FloatNDArray); +INSTANTIATE_EYE (NDArray); +INSTANTIATE_EYE (boolNDArray); + +static octave_value +identity_matrix (int nr, int nc, oct_data_conv::data_type dt) +{ + octave_value retval; + + // FIXME -- perhaps this should be made extensible by using + // the class name to lookup a function to call to create the new + // value. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_int8: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint8: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_int16: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint16: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_int32: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint32: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_int64: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint64: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_single: + retval = FloatDiagMatrix (nr, nc, 1.0f); + break; + + case oct_data_conv::dt_double: + retval = DiagMatrix (nr, nc, 1.0); + break; + + case oct_data_conv::dt_logical: + retval = identity_matrix (nr, nc); + break; + + default: + error ("eye: invalid class name"); + break; + } + } + + return retval; +} + +#undef INT_EYE_MATRIX + +DEFUN (eye, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eye (@var{n})\n\ +@deftypefnx {Built-in Function} {} eye (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} eye ([@var{m} @var{n}])\n\ +@deftypefnx {Built-in Function} {} eye (@dots{}, @var{class})\n\ +Return an identity matrix. If invoked with a single scalar argument @var{n},\n\ +return a square @nospell{NxN} identity matrix. If\n\ +supplied two scalar arguments (@var{m}, @var{n}), @code{eye} takes them to be\n\ +the number of rows and columns. If given a vector with two elements,\n\ +@code{eye} uses the values of the elements as the number of rows and columns,\n\ +respectively. For example:\n\ +\n\ +@example\n\ +@group\n\ +eye (3)\n\ + @result{} 1 0 0\n\ + 0 1 0\n\ + 0 0 1\n\ +@end group\n\ +@end example\n\ +\n\ +The following expressions all produce the same result:\n\ +\n\ +@example\n\ +@group\n\ +eye (2)\n\ +@equiv{}\n\ +eye (2, 2)\n\ +@equiv{}\n\ +eye (size ([1, 2; 3, 4])\n\ +@end group\n\ +@end example\n\ +\n\ +The optional argument @var{class}, allows @code{eye} to return an array of\n\ +the specified type, like\n\ +\n\ +@example\n\ +val = zeros (n,m, \"uint8\")\n\ +@end example\n\ +\n\ +Calling @code{eye} with no arguments is equivalent to calling it\n\ +with an argument of 1. Any negative dimensions are treated as zero. \n\ +These odd definitions are for compatibility with @sc{matlab}.\n\ +@seealso{speye, ones, zeros}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + // Check for type information. + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + retval = identity_matrix (1, 1, dt); + break; + + case 1: + { + octave_idx_type nr, nc; + get_dimensions (args(0), "eye", nr, nc); + + if (! error_state) + retval = identity_matrix (nr, nc, dt); + } + break; + + case 2: + { + octave_idx_type nr, nc; + get_dimensions (args(0), args(1), "eye", nr, nc); + + if (! error_state) + retval = identity_matrix (nr, nc, dt); + } + break; + + default: + print_usage (); + break; + } + + return retval; +} + +/* +%!assert (full (eye (3)), [1, 0, 0; 0, 1, 0; 0, 0, 1]) +%!assert (full (eye (2, 3)), [1, 0, 0; 0, 1, 0]) + +%!assert (full (eye (3,"single")), single ([1, 0, 0; 0, 1, 0; 0, 0, 1])) +%!assert (full (eye (2, 3,"single")), single ([1, 0, 0; 0, 1, 0])) + +%!assert (eye (3, "int8"), int8 ([1, 0, 0; 0, 1, 0; 0, 0, 1])) +%!assert (eye (2, 3, "int8"), int8 ([1, 0, 0; 0, 1, 0])) + +%!error eye (1, 2, 3) +*/ + +template +static octave_value +do_linspace (const octave_value& base, const octave_value& limit, + octave_idx_type n) +{ + typedef typename MT::column_vector_type CVT; + typedef typename MT::element_type T; + + octave_value retval; + + if (base.is_scalar_type ()) + { + T bs = octave_value_extract (base); + if (limit.is_scalar_type ()) + { + T ls = octave_value_extract (limit); + retval = linspace (bs, ls, n); + } + else + { + CVT lv = octave_value_extract (limit); + CVT bv (lv.length (), bs); + retval = linspace (bv, lv, n); + } + } + else + { + CVT bv = octave_value_extract (base); + if (limit.is_scalar_type ()) + { + T ls = octave_value_extract (limit); + CVT lv (bv.length (), ls); + retval = linspace (bv, lv, n); + } + else + { + CVT lv = octave_value_extract (limit); + retval = linspace (bv, lv, n); + } + } + + return retval; +} + +DEFUN (linspace, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} linspace (@var{base}, @var{limit})\n\ +@deftypefnx {Built-in Function} {} linspace (@var{base}, @var{limit}, @var{n})\n\ +Return a row vector with @var{n} linearly spaced elements between\n\ +@var{base} and @var{limit}. If the number of elements is greater than one,\n\ +then the endpoints @var{base} and @var{limit} are always included in\n\ +the range. If @var{base} is greater than @var{limit}, the elements are\n\ +stored in decreasing order. If the number of points is not specified, a\n\ +value of 100 is used.\n\ +\n\ +The @code{linspace} function always returns a row vector if both\n\ +@var{base} and @var{limit} are scalars. If one, or both, of them are column\n\ +vectors, @code{linspace} returns a matrix.\n\ +\n\ +For compatibility with @sc{matlab}, return the second argument (@var{limit})\n\ +if fewer than two values are requested.\n\ +@seealso{logspace}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + octave_idx_type npoints = 100; + + if (nargin != 2 && nargin != 3) + { + print_usage (); + return retval; + } + + if (nargin == 3) + npoints = args(2).idx_type_value (); + + if (! error_state) + { + octave_value arg_1 = args(0); + octave_value arg_2 = args(1); + + if (arg_1.is_single_type () || arg_2.is_single_type ()) + { + if (arg_1.is_complex_type () || arg_2.is_complex_type ()) + retval = do_linspace (arg_1, arg_2, npoints); + else + retval = do_linspace (arg_1, arg_2, npoints); + + } + else + { + if (arg_1.is_complex_type () || arg_2.is_complex_type ()) + retval = do_linspace (arg_1, arg_2, npoints); + else + retval = do_linspace (arg_1, arg_2, npoints); + } + } + else + error ("linspace: N must be an integer"); + + return retval; +} + + +/* +%!test +%! x1 = linspace (1, 2); +%! x2 = linspace (1, 2, 10); +%! x3 = linspace (1, -2, 10); +%! assert (size (x1) == [1, 100] && x1(1) == 1 && x1(100) == 2); +%! assert (size (x2) == [1, 10] && x2(1) == 1 && x2(10) == 2); +%! assert (size (x3) == [1, 10] && x3(1) == 1 && x3(10) == -2); + +%assert (linspace ([1, 2; 3, 4], 5, 6), linspace (1, 5, 6)) + +%!error linspace () +%!error linspace (1, 2, 3, 4) +*/ + +// FIXME -- should accept dimensions as separate args for N-d +// arrays as well as 1-d and 2-d arrays. + +DEFUN (resize, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} resize (@var{x}, @var{m})\n\ +@deftypefnx {Built-in Function} {} resize (@var{x}, @var{m}, @var{n}, @dots{})\n\ +@deftypefnx {Built-in Function} {} resize (@var{x}, [@var{m} @var{n} @dots{}])\n\ +Resize @var{x} cutting off elements as necessary.\n\ +\n\ +In the result, element with certain indices is equal to the corresponding\n\ +element of @var{x} if the indices are within the bounds of @var{x};\n\ +otherwise, the element is set to zero.\n\ +\n\ +In other words, the statement\n\ +\n\ +@example\n\ +y = resize (x, dv)\n\ +@end example\n\ +\n\ +@noindent\n\ +is equivalent to the following code:\n\ +\n\ +@example\n\ +@group\n\ +y = zeros (dv, class (x));\n\ +sz = min (dv, size (x));\n\ +for i = 1:length (sz)\n\ + idx@{i@} = 1:sz(i);\n\ +endfor\n\ +y(idx@{:@}) = x(idx@{:@});\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +but is performed more efficiently.\n\ +\n\ +If only @var{m} is supplied, and it is a scalar, the dimension of the\n\ +result is @var{m}-by-@var{m}.\n\ +If @var{m}, @var{n}, @dots{} are all scalars, then the dimensions of\n\ +the result are @var{m}-by-@var{n}-by-@dots{}.\n\ +If given a vector as input, then the\n\ +dimensions of the result are given by the elements of that vector.\n\ +\n\ +An object can be resized to more dimensions than it has;\n\ +in such case the missing dimensions are assumed to be 1.\n\ +Resizing an object to fewer dimensions is not possible.\n\ +@seealso{reshape, postpad, prepad, cat}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin == 2) + { + Array vec = args(1).vector_value (); + int ndim = vec.length (); + if (ndim == 1) + { + octave_idx_type m = static_cast (vec(0)); + retval = args(0); + retval = retval.resize (dim_vector (m, m), true); + } + else + { + dim_vector dv; + dv.resize (ndim); + for (int i = 0; i < ndim; i++) + dv(i) = static_cast (vec(i)); + retval = args(0); + retval = retval.resize (dv, true); + } + } + else if (nargin > 2) + { + dim_vector dv; + dv.resize (nargin - 1); + for (octave_idx_type i = 1; i < nargin; i++) + dv(i-1) = static_cast (args(i).scalar_value ()); + if (!error_state) + { + retval = args(0); + retval = retval.resize (dv, true); + } + + } + else + print_usage (); + return retval; +} + +// FIXME -- should use octave_idx_type for dimensions. + +DEFUN (reshape, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} reshape (@var{A}, @var{m}, @var{n}, @dots{})\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, [@var{m} @var{n} @dots{}])\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, @dots{}, [], @dots{})\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, @var{size})\n\ +Return a matrix with the specified dimensions (@var{m}, @var{n}, @dots{})\n\ +whose elements are taken from the matrix @var{A}. The elements of the\n\ +matrix are accessed in column-major order (like Fortran arrays are stored).\n\ +\n\ +The following code demonstrates reshaping a 1x4 row vector into a 2x2 square\n\ +matrix.\n\ +\n\ +@example\n\ +@group\n\ +reshape ([1, 2, 3, 4], 2, 2)\n\ + @result{} 1 3\n\ + 2 4\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Note that the total number of elements in the original\n\ +matrix (@code{prod (size (@var{A}))}) must match the total number of elements\n\ +in the new matrix (@code{prod ([@var{m} @var{n} @dots{}])}).\n\ +\n\ +A single dimension of the return matrix may be left unspecified and Octave\n\ +will determine its size automatically. An empty matrix ([]) is used to flag\n\ +the unspecified dimension.\n\ +@seealso{resize, vec, postpad, cat, squeeze}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + dim_vector new_dims; + + if (nargin == 2) + { + Array new_size = args(1).octave_idx_type_vector_value (); + + new_dims = dim_vector::alloc (new_size.length ()); + + for (octave_idx_type i = 0; i < new_size.length (); i++) + { + if (new_size(i) < 0) + { + error ("reshape: SIZE must be non-negative"); + break; + } + else + new_dims(i) = new_size(i); + } + } + else if (nargin > 2) + { + new_dims = dim_vector::alloc (nargin-1); + int empty_dim = -1; + + for (int i = 1; i < nargin; i++) + { + if (args(i).is_empty ()) + { + if (empty_dim > 0) + { + error ("reshape: only a single dimension can be unknown"); + break; + } + else + { + empty_dim = i; + new_dims(i-1) = 1; + } + } + else + { + new_dims(i-1) = args(i).idx_type_value (); + + if (error_state) + break; + else if (new_dims(i-1) < 0) + { + error ("reshape: SIZE must be non-negative"); + break; + } + } + } + + if (! error_state && (empty_dim > 0)) + { + octave_idx_type nel = new_dims.numel (); + + if (nel == 0) + new_dims(empty_dim-1) = 0; + else + { + octave_idx_type a_nel = args(0).numel (); + octave_idx_type size_empty_dim = a_nel / nel; + + if (a_nel != size_empty_dim * nel) + error ("reshape: SIZE is not divisible by the product of known dimensions (= %d)", nel); + else + new_dims(empty_dim-1) = size_empty_dim; + } + } + } + else + { + print_usage (); + return retval; + } + + if (! error_state) + retval = args(0).reshape (new_dims); + + return retval; +} + +/* +%!assert (size (reshape (ones (4, 4), 2, 8)), [2, 8]) +%!assert (size (reshape (ones (4, 4), 8, 2)), [8, 2]) +%!assert (size (reshape (ones (15, 4), 1, 60)), [1, 60]) +%!assert (size (reshape (ones (15, 4), 60, 1)), [60, 1]) + +%!assert (size (reshape (ones (4, 4, "single"), 2, 8)), [2, 8]) +%!assert (size (reshape (ones (4, 4, "single"), 8, 2)), [8, 2]) +%!assert (size (reshape (ones (15, 4, "single"), 1, 60)), [1, 60]) +%!assert (size (reshape (ones (15, 4, "single"), 60, 1)), [60, 1]) + +%!test +%! s.a = 1; +%! fail ("reshape (s, 2, 3)"); + +%!error reshape () +%!error reshape (1, 2, 3, 4) +*/ + +DEFUN (vec, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{v} =} vec (@var{x})\n\ +@deftypefnx {Built-in Function} {@var{v} =} vec (@var{x}, @var{dim})\n\ +Return the vector obtained by stacking the columns of the matrix @var{x}\n\ +one above the other. Without @var{dim} this is equivalent to\n\ +@code{@var{x}(:)}. If @var{dim} is supplied, the dimensions of @var{v}\n\ +are set to @var{dim} with all elements along the last dimension.\n\ +This is equivalent to @code{shiftdim (@var{x}(:), 1-@var{dim})}.\n\ +@seealso{vech, resize, cat}\n\ +@end deftypefn") +{ + octave_value retval; + int dim = 1; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 2) + print_usage () ; + + if (! error_state && nargin == 2) + { + dim = args(1).idx_type_value (); + + if (dim < 1) + error ("vec: DIM must be greater than zero"); + } + + if (! error_state) + { + octave_value colon (octave_value::magic_colon_t); + octave_value arg = args(0); + retval = arg.single_subsref ("(", colon); + + + if (! error_state && dim > 1) + { + dim_vector new_dims = dim_vector::alloc (dim); + + for (int i = 0; i < dim-1; i++) + new_dims(i) = 1; + + new_dims(dim-1) = retval.numel (); + + retval = retval.reshape (new_dims); + } + } + + return retval; +} + +/* +%!assert (vec ([1, 2; 3, 4]), [1; 3; 2; 4]) +%!assert (vec ([1, 3, 2, 4]), [1; 3; 2; 4]) +%!assert (vec ([1, 2, 3, 4], 2), [1, 2, 3, 4]) +%!assert (vec ([1, 2; 3, 4]), vec ([1, 2; 3, 4], 1)) +%!assert (vec ([1, 2; 3, 4], 1), [1; 3; 2; 4]) +%!assert (vec ([1, 2; 3, 4], 2), [1, 3, 2, 4]) +%!assert (vec ([1, 3; 2, 4], 3), reshape ([1, 2, 3, 4], 1, 1, 4)) +%!assert (vec ([1, 3; 2, 4], 3), shiftdim (vec ([1, 3; 2, 4]), -2)) + +%!error vec () +%!error vec (1, 2, 3) +%!error vec ([1, 2; 3, 4], 0) +*/ + +DEFUN (squeeze, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} squeeze (@var{x})\n\ +Remove singleton dimensions from @var{x} and return the result.\n\ +Note that for compatibility with @sc{matlab}, all objects have\n\ +a minimum of two dimensions and row vectors are left unchanged.\n\ +@seealso{reshape}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).squeeze (); + else + print_usage (); + + return retval; +} + +DEFUN (full, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{FM} =} full (@var{SM})\n\ +Return a full storage matrix from a sparse, diagonal, permutation matrix\n\ +or a range.\n\ +@seealso{sparse}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).full_value (); + else + print_usage (); + + return retval; +} + +// Compute various norms of the vector X. + +DEFUN (norm, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} norm (@var{A})\n\ +@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p})\n\ +@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p}, @var{opt})\n\ +Compute the p-norm of the matrix @var{A}. If the second argument is\n\ +missing, @code{p = 2} is assumed.\n\ +\n\ +If @var{A} is a matrix (or sparse matrix):\n\ +\n\ +@table @asis\n\ +@item @var{p} = @code{1}\n\ +1-norm, the largest column sum of the absolute values of @var{A}.\n\ +\n\ +@item @var{p} = @code{2}\n\ +Largest singular value of @var{A}.\n\ +\n\ +@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ +@cindex infinity norm\n\ +Infinity norm, the largest row sum of the absolute values of @var{A}.\n\ +\n\ +@item @var{p} = @code{\"fro\"}\n\ +@cindex Frobenius norm\n\ +Frobenius norm of @var{A}, @code{sqrt (sum (diag (@var{A}' * @var{A})))}.\n\ +\n\ +@item other @var{p}, @code{@var{p} > 1}\n\ +@cindex general p-norm\n\ +maximum @code{norm (A*x, p)} such that @code{norm (x, p) == 1}\n\ +@end table\n\ +\n\ +If @var{A} is a vector or a scalar:\n\ +\n\ +@table @asis\n\ +@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ +@code{max (abs (@var{A}))}.\n\ +\n\ +@item @var{p} = @code{-Inf}\n\ +@code{min (abs (@var{A}))}.\n\ +\n\ +@item @var{p} = @code{\"fro\"}\n\ +Frobenius norm of @var{A}, @code{sqrt (sumsq (abs (A)))}.\n\ +\n\ +@item @var{p} = 0\n\ +Hamming norm - the number of nonzero elements.\n\ +\n\ +@item other @var{p}, @code{@var{p} > 1}\n\ +p-norm of @var{A}, @code{(sum (abs (@var{A}) .^ @var{p})) ^ (1/@var{p})}.\n\ +\n\ +@item other @var{p} @code{@var{p} < 1}\n\ +the p-pseudonorm defined as above.\n\ +@end table\n\ +\n\ +If @var{opt} is the value @code{\"rows\"}, treat each row as a vector and\n\ +compute its norm. The result is returned as a column vector.\n\ +Similarly, if @var{opt} is @code{\"columns\"} or @code{\"cols\"} then compute\n\ +the norms of each column and return a row vector.\n\ +@seealso{cond, svd}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin >= 1 && nargin <= 3) + { + octave_value x_arg = args(0); + + if (x_arg.ndims () == 2) + { + enum { sfmatrix, sfcols, sfrows, sffrob, sfinf } strflag = sfmatrix; + if (nargin > 1 && args(nargin-1).is_string ()) + { + std::string str = args(nargin-1).string_value (); + if (str == "cols" || str == "columns") + strflag = sfcols; + else if (str == "rows") + strflag = sfrows; + else if (str == "fro") + strflag = sffrob; + else if (str == "inf") + strflag = sfinf; + else + error ("norm: unrecognized option: %s", str.c_str ()); + // we've handled the last parameter, so act as if it was removed + nargin --; + } + else if (nargin > 1 && ! args(1).is_scalar_type ()) + gripe_wrong_type_arg ("norm", args(1), true); + + if (! error_state) + { + octave_value p_arg = (nargin > 1) ? args(1) : octave_value (2); + switch (strflag) + { + case sfmatrix: + retval(0) = xnorm (x_arg, p_arg); + break; + case sfcols: + retval(0) = xcolnorms (x_arg, p_arg); + break; + case sfrows: + retval(0) = xrownorms (x_arg, p_arg); + break; + case sffrob: + retval(0) = xfrobnorm (x_arg); + break; + case sfinf: + retval(0) = xnorm (x_arg, octave_Inf); + break; + } + } + } + else + error ("norm: only valid for 2-D objects"); + } + else + print_usage (); + + return retval; +} + +/* +%!shared x +%! x = [1, -3, 4, 5, -7]; +%!assert (norm (x,1), 20) +%!assert (norm (x,2), 10) +%!assert (norm (x,3), 8.24257059961711, -4*eps) +%!assert (norm (x,Inf), 7) +%!assert (norm (x,-Inf), 1) +%!assert (norm (x,"inf"), 7) +%!assert (norm (x,"fro"), 10, -eps) +%!assert (norm (x), 10) +%!assert (norm ([1e200, 1]), 1e200) +%!assert (norm ([3+4i, 3-4i, sqrt(31)]), 9, -4*eps) +%!shared m +%! m = magic (4); +%!assert (norm (m,1), 34) +%!assert (norm (m,2), 34, -eps) +%!assert (norm (m,Inf), 34) +%!assert (norm (m,"inf"), 34) +%!shared m2, flo, fhi +%! m2 = [1,2;3,4]; +%! flo = 1e-300; +%! fhi = 1e+300; +%!assert (norm (flo*m2,"fro"), sqrt (30)*flo, -eps) +%!assert (norm (fhi*m2,"fro"), sqrt (30)*fhi, -eps) + +%!shared x +%! x = single ([1, -3, 4, 5, -7]); +%!assert (norm (x,1), single (20)) +%!assert (norm (x,2), single (10)) +%!assert (norm (x,3), single (8.24257059961711), -4*eps ("single")) +%!assert (norm (x,Inf), single (7)) +%!assert (norm (x,-Inf), single (1)) +%!assert (norm (x,"inf"), single (7)) +%!assert (norm (x,"fro"), single (10), -eps ("single")) +%!assert (norm (x), single (10)) +%!assert (norm (single ([1e200, 1])), single (1e200)) +%!assert (norm (single ([3+4i, 3-4i, sqrt(31)])), single (9), -4*eps ("single")) +%!shared m +%! m = single (magic (4)); +%!assert (norm (m,1), single (34)) +%!assert (norm (m,2), single (34), -eps ("single")) +%!assert (norm (m,Inf), single (34)) +%!assert (norm (m,"inf"), single (34)) +%!shared m2, flo, fhi +%! m2 = single ([1,2;3,4]); +%! flo = single (1e-300); +%! fhi = single (1e+300); +%!assert (norm (flo*m2,"fro"), single (sqrt (30)*flo), -eps ("single")) +%!assert (norm (fhi*m2,"fro"), single (sqrt (30)*fhi), -eps ("single")) + +%!test +%! ## Test for norm returning NaN on sparse matrix (bug #30631) +%! A = sparse (2,2); +%! A(2,1) = 1; +%! assert (norm (A), 1); +*/ + +static octave_value +unary_op_defun_body (octave_value::unary_op op, + const octave_value_list& args) +{ + octave_value retval; + if (args.length () == 1) + retval = do_unary_op (op, args(0)); + else + print_usage (); + + return retval; +} + +DEFUN (not, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} not (@var{x})\n\ +Return the logical NOT of @var{x}. This function is equivalent to\n\ +@code{! x}.\n\ +@seealso{and, or, xor}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_not, args); +} + +DEFUN (uplus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} uplus (@var{x})\n\ +This function and @w{@xcode{+ x}} are equivalent.\n\ +@seealso{uminus, plus, minus}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_uplus, args); +} + +DEFUN (uminus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} uminus (@var{x})\n\ +This function and @w{@xcode{- x}} are equivalent.\n\ +@seealso{uplus, minus}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_uminus, args); +} + +DEFUN (transpose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} transpose (@var{x})\n\ +Return the transpose of @var{x}.\n\ +This function and @xcode{x.'} are equivalent.\n\ +@seealso{ctranspose}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_transpose, args); +} + +/* +%!assert (2.', 2) +%!assert (2i.', 2i) +%!assert ([1:4].', [1;2;3;4]) +%!assert ([1;2;3;4].', [1:4]) +%!assert ([1,2;3,4].', [1,3;2,4]) +%!assert ([1,2i;3,4].', [1,3;2i,4]) + +%!assert (transpose ([1,2;3,4]), [1,3;2,4]) + +%!assert (single (2).', single (2)) +%!assert (single (2i).', single (2i)) +%!assert (single ([1:4]).', single ([1;2;3;4])) +%!assert (single ([1;2;3;4]).', single ([1:4])) +%!assert (single ([1,2;3,4]).', single ([1,3;2,4])) +%!assert (single ([1,2i;3,4]).', single ([1,3;2i,4])) + +%!assert (transpose (single ([1,2;3,4])), single ([1,3;2,4])) +*/ + +DEFUN (ctranspose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ctranspose (@var{x})\n\ +Return the complex conjugate transpose of @var{x}.\n\ +This function and @xcode{x'} are equivalent.\n\ +@seealso{transpose}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_hermitian, args); +} + +/* +%!assert (2', 2) +%!assert (2i', -2i) +%!assert ([1:4]', [1;2;3;4]) +%!assert ([1;2;3;4]', [1:4]) +%!assert ([1,2;3,4]', [1,3;2,4]) +%!assert ([1,2i;3,4]', [1,3;-2i,4]) + +%!assert (ctranspose ([1,2i;3,4]), [1,3;-2i,4]) + +%!assert (single (2)', single (2)) +%!assert (single (2i)', single (-2i)) +%!assert (single ([1:4])', single ([1;2;3;4])) +%!assert (single ([1;2;3;4])', single ([1:4])) +%!assert (single ([1,2;3,4])', single ([1,3;2,4])) +%!assert (single ([1,2i;3,4])', single ([1,3;-2i,4])) + +%!assert (ctranspose (single ([1,2i;3,4])), single ([1,3;-2i,4])) +*/ + +static octave_value +binary_op_defun_body (octave_value::binary_op op, + const octave_value_list& args) +{ + octave_value retval; + + if (args.length () == 2) + retval = do_binary_op (op, args(0), args(1)); + else + print_usage (); + + return retval; +} + +static octave_value +binary_assoc_op_defun_body (octave_value::binary_op op, + octave_value::assign_op aop, + const octave_value_list& args) +{ + octave_value retval; + int nargin = args.length (); + + switch (nargin) + { + case 0: + print_usage (); + break; + case 1: + retval = args(0); + break; + case 2: + retval = do_binary_op (op, args(0), args(1)); + break; + default: + retval = do_binary_op (op, args(0), args(1)); + for (int i = 2; i < nargin; i++) + retval.assign (aop, args(i)); + break; + } + + return retval; +} + +DEFUN (plus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} plus (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} plus (@var{x1}, @var{x2}, @dots{})\n\ +This function and @w{@xcode{x + y}} are equivalent.\n\ +If more arguments are given, the summation is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 + x2) + x3) + @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{minus, uplus}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_add, + octave_value::op_add_eq, args); +} + +DEFUN (minus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} minus (@var{x}, @var{y})\n\ +This function and @w{@xcode{x - y}} are equivalent.\n\ +@seealso{plus, uminus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_sub, args); +} + +DEFUN (mtimes, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mtimes (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} mtimes (@var{x1}, @var{x2}, @dots{})\n\ +Return the matrix multiplication product of inputs.\n\ +This function and @w{@xcode{x * y}} are equivalent.\n\ +If more arguments are given, the multiplication is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 * x2) * x3) * @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{times, plus, minus, rdivide, mrdivide, mldivide, mpower}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_mul, + octave_value::op_mul_eq, args); +} + +DEFUN (mrdivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mrdivide (@var{x}, @var{y})\n\ +Return the matrix right division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x / y}} are equivalent.\n\ +@seealso{mldivide, rdivide, plus, minus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_div, args); +} + +DEFUN (mpower, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mpower (@var{x}, @var{y})\n\ +Return the matrix power operation of @var{x} raised to the @var{y} power.\n\ +This function and @w{@xcode{x ^ y}} are equivalent.\n\ +@seealso{power, mtimes, plus, minus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_pow, args); +} + +DEFUN (mldivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mldivide (@var{x}, @var{y})\n\ +Return the matrix left division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x @xbackslashchar{} y}} are equivalent.\n\ +@seealso{mrdivide, ldivide, rdivide}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_ldiv, args); +} + +DEFUN (lt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} lt (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x < y}}.\n\ +@seealso{le, eq, ge, gt, ne}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_lt, args); +} + +DEFUN (le, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} le (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x <= y}}.\n\ +@seealso{eq, ge, gt, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_le, args); +} + +DEFUN (eq, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eq (@var{x}, @var{y})\n\ +Return true if the two inputs are equal.\n\ +This function is equivalent to @w{@code{x == y}}.\n\ +@seealso{ne, isequal, le, ge, gt, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_eq, args); +} + +DEFUN (ge, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ge (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x >= y}}.\n\ +@seealso{le, eq, gt, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_ge, args); +} + +DEFUN (gt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} gt (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x > y}}.\n\ +@seealso{le, eq, ge, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_gt, args); +} + +DEFUN (ne, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ne (@var{x}, @var{y})\n\ +Return true if the two inputs are not equal.\n\ +This function is equivalent to @w{@code{x != y}}.\n\ +@seealso{eq, isequal, le, ge, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_ne, args); +} + +DEFUN (times, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} times (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} times (@var{x1}, @var{x2}, @dots{})\n\ +Return the element-by-element multiplication product of inputs.\n\ +This function and @w{@xcode{x .* y}} are equivalent.\n\ +If more arguments are given, the multiplication is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 .* x2) .* x3) .* @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{mtimes, rdivide}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_el_mul, + octave_value::op_el_mul_eq, args); +} + +DEFUN (rdivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rdivide (@var{x}, @var{y})\n\ +Return the element-by-element right division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x ./ y}} are equivalent.\n\ +@seealso{ldivide, mrdivide, times, plus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_el_div, args); +} + +DEFUN (power, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} power (@var{x}, @var{y})\n\ +Return the element-by-element operation of @var{x} raised to the\n\ +@var{y} power. If several complex results are possible,\n\ +returns the one with smallest non-negative argument (angle). Use\n\ +@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ +real result is preferred.\n\ +\n\ +This function and @w{@xcode{x .^ y}} are equivalent.\n\ +@seealso{mpower, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_el_pow, args); +} + +DEFUN (ldivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ldivide (@var{x}, @var{y})\n\ +Return the element-by-element left division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x .@xbackslashchar{} y}} are equivalent.\n\ +@seealso{rdivide, mldivide, times, plus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_el_ldiv, args); +} + +DEFUN (and, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} and (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} and (@var{x1}, @var{x2}, @dots{})\n\ +Return the logical AND of @var{x} and @var{y}.\n\ +This function is equivalent to @w{@code{x & y}}.\n\ +If more arguments are given, the logical and is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 & x2) & x3) & @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{or, not, xor}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_el_and, + octave_value::op_el_and_eq, args); +} + +DEFUN (or, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} or (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} or (@var{x1}, @var{x2}, @dots{})\n\ +Return the logical OR of @var{x} and @var{y}.\n\ +This function is equivalent to @w{@code{x | y}}.\n\ +If more arguments are given, the logical or is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 | x2) | x3) | @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{and, not, xor}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_el_or, + octave_value::op_el_or_eq, args); +} + +static double tic_toc_timestamp = -1.0; + +DEFUN (tic, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} tic ()\n\ +@deftypefnx {Built-in Function} {@var{id} =} tic ()\n\ +@deftypefnx {Built-in Function} {} toc ()\n\ +@deftypefnx {Built-in Function} {} toc (@var{id})\n\ +@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ +Set or check a wall-clock timer. Calling @code{tic} without an\n\ +output argument sets the internal timer state. Subsequent calls\n\ +to @code{toc} return the number of seconds since the timer was set.\n\ +For example,\n\ +\n\ +@example\n\ +@group\n\ +tic ();\n\ +# many computations later@dots{}\n\ +elapsed_time = toc ();\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +will set the variable @code{elapsed_time} to the number of seconds since\n\ +the most recent call to the function @code{tic}.\n\ +\n\ +If called with one output argument, @code{tic} returns a scalar\n\ +of type @code{uint64} that may be later passed to @code{toc}.\n\ +\n\ +@example\n\ +@group\n\ +id = tic; sleep (5); toc (id)\n\ + @result{} 5.0010\n\ +@end group\n\ +@end example\n\ +\n\ +Calling @code{tic} and @code{toc} this way allows nested timing calls.\n\ +\n\ +If you are more interested in the CPU time that your process used, you\n\ +should use the @code{cputime} function instead. The @code{tic} and\n\ +@code{toc} functions report the actual wall clock time that elapsed\n\ +between the calls. This may include time spent processing other jobs or\n\ +doing nothing at all.\n\ +@seealso{toc, cputime}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin != 0) + warning ("tic: ignoring extra arguments"); + + octave_time now; + + double tmp = now.double_value (); + + if (nargout > 0) + { + double ip = 0.0; + double frac = modf (tmp, &ip); + uint64_t microsecs = static_cast (CLOCKS_PER_SEC * frac); + microsecs += CLOCKS_PER_SEC * static_cast (ip); + retval = octave_uint64 (microsecs); + } + else + tic_toc_timestamp = tmp; + + return retval; +} + +DEFUN (toc, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} toc ()\n\ +@deftypefnx {Built-in Function} {} toc (@var{id})\n\ +@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ +@seealso{tic, cputime}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + double start_time = tic_toc_timestamp; + + if (nargin > 1) + print_usage (); + else + { + if (nargin == 1) + { + octave_uint64 id = args(0).uint64_scalar_value (); + + if (! error_state) + { + uint64_t val = id.value (); + + start_time + = (static_cast (val / CLOCKS_PER_SEC) + + static_cast (val % CLOCKS_PER_SEC) / CLOCKS_PER_SEC); + + // FIXME -- should we also check to see whether the start + // time is after the beginning of this Octave session? + } + else + error ("toc: invalid ID"); + } + + if (! error_state) + { + if (start_time < 0) + error ("toc called before timer set"); + else + { + octave_time now; + + double tmp = now.double_value () - start_time; + + if (nargout > 0) + retval = tmp; + else + octave_stdout << "Elapsed time is " << tmp << " seconds.\n"; + } + } + } + + return retval; +} + +/* +%!shared id +%! id = tic (); +%!assert (isa (id, "uint64")) +%!assert (isa (toc (id), "double")) +*/ + +DEFUN (cputime, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{total}, @var{user}, @var{system}] =} cputime ();\n\ +Return the CPU time used by your Octave session. The first output is\n\ +the total time spent executing your process and is equal to the sum of\n\ +second and third outputs, which are the number of CPU seconds spent\n\ +executing in user mode and the number of CPU seconds spent executing in\n\ +system mode, respectively. If your system does not have a way to report\n\ +CPU time usage, @code{cputime} returns 0 for each of its output values.\n\ +Note that because Octave used some CPU time to start, it is reasonable\n\ +to check to see if @code{cputime} works by checking to see if the total\n\ +CPU time used is nonzero.\n\ +@seealso{tic, toc}\n\ +@end deftypefn") +{ + octave_value_list retval; + int nargin = args.length (); + double usr = 0.0; + double sys = 0.0; + + if (nargin != 0) + warning ("tic: ignoring extra arguments"); + +#if defined (HAVE_GETRUSAGE) + + struct rusage ru; + + getrusage (RUSAGE_SELF, &ru); + + usr = static_cast (ru.ru_utime.tv_sec) + + static_cast (ru.ru_utime.tv_usec) * 1e-6; + + sys = static_cast (ru.ru_stime.tv_sec) + + static_cast (ru.ru_stime.tv_usec) * 1e-6; + +#else + + struct tms t; + + times (&t); + + unsigned long ticks; + unsigned long seconds; + unsigned long fraction; + + ticks = t.tms_utime + t.tms_cutime; + fraction = ticks % CLOCKS_PER_SEC; + seconds = ticks / CLOCKS_PER_SEC; + + usr = static_cast (seconds) + static_cast(fraction) / + static_cast(CLOCKS_PER_SEC); + + ticks = t.tms_stime + t.tms_cstime; + fraction = ticks % CLOCKS_PER_SEC; + seconds = ticks / CLOCKS_PER_SEC; + + sys = static_cast (seconds) + static_cast(fraction) / + static_cast(CLOCKS_PER_SEC); + +#endif + + retval(2) = sys; + retval(1) = usr; + retval(0) = sys + usr; + + return retval; +} + +DEFUN (sort, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x})\n\ +@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim})\n\ +@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{mode})\n\ +@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim}, @var{mode})\n\ +Return a copy of @var{x} with the elements arranged in increasing\n\ +order. For matrices, @code{sort} orders the elements within columns\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +sort ([1, 2; 2, 3; 3, 1])\n\ + @result{} 1 1\n\ + 2 2\n\ + 3 3\n\ +@end group\n\ +@end example\n\ +\n\ +If the optional argument @var{dim} is given, then the matrix is sorted\n\ +along the dimension defined by @var{dim}. The optional argument @code{mode}\n\ +defines the order in which the values will be sorted. Valid values of\n\ +@code{mode} are \"ascend\" or \"descend\".\n\ +\n\ +The @code{sort} function may also be used to produce a matrix\n\ +containing the original row indices of the elements in the sorted\n\ +matrix. For example:\n\ +\n\ +@example\n\ +@group\n\ +[s, i] = sort ([1, 2; 2, 3; 3, 1])\n\ + @result{} s = 1 1\n\ + 2 2\n\ + 3 3\n\ + @result{} i = 1 3\n\ + 2 1\n\ + 3 2\n\ +@end group\n\ +@end example\n\ +\n\ +For equal elements, the indices are such that equal elements are listed\n\ +in the order in which they appeared in the original list.\n\ +\n\ +Sorting of complex entries is done first by magnitude (@code{abs (@var{z})})\n\ +and for any ties by phase angle (@code{angle (z)}). For example:\n\ +\n\ +@example\n\ +@group\n\ +sort ([1+i; 1; 1-i])\n\ + @result{} 1 + 0i\n\ + 1 - 1i\n\ + 1 + 1i\n\ +@end group\n\ +@end example\n\ +\n\ +NaN values are treated as being greater than any other value and are sorted\n\ +to the end of the list.\n\ +\n\ +The @code{sort} function may also be used to sort strings and cell arrays\n\ +of strings, in which case ASCII dictionary order (uppercase 'A' precedes\n\ +lowercase 'a') of the strings is used.\n\ +\n\ +The algorithm used in @code{sort} is optimized for the sorting of partially\n\ +ordered lists.\n\ +@seealso{sortrows, issorted}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + sortmode smode = ASCENDING; + + if (nargin < 1 || nargin > 3) + { + print_usage (); + return retval; + } + + bool return_idx = nargout > 1; + + octave_value arg = args(0); + + int dim = 0; + if (nargin > 1) + { + if (args(1).is_string ()) + { + std::string mode = args(1).string_value (); + if (mode == "ascend") + smode = ASCENDING; + else if (mode == "descend") + smode = DESCENDING; + else + { + error ("sort: MODE must be either \"ascend\" or \"descend\""); + return retval; + } + } + else + dim = args(1).nint_value () - 1; + } + + if (nargin > 2) + { + if (args(1).is_string ()) + { + print_usage (); + return retval; + } + + if (! args(2).is_string ()) + { + error ("sort: MODE must be a string"); + return retval; + } + std::string mode = args(2).string_value (); + if (mode == "ascend") + smode = ASCENDING; + else if (mode == "descend") + smode = DESCENDING; + else + { + error ("sort: MODE must be either \"ascend\" or \"descend\""); + return retval; + } + } + + const dim_vector dv = arg.dims (); + if (nargin == 1 || args(1).is_string ()) + { + // Find first non singleton dimension + dim = dv.first_non_singleton (); + } + else + { + if (dim < 0) + { + error ("sort: DIM must be a valid dimension"); + return retval; + } + } + + if (return_idx) + { + retval.resize (2); + + Array sidx; + + retval(0) = arg.sort (sidx, dim, smode); + retval(1) = idx_vector (sidx, dv(dim)); // No checking, the extent is known. + } + else + retval(0) = arg.sort (dim, smode); + + return retval; +} + +/* +## Double +%!assert (sort ([NaN, 1, -1, 2, Inf]), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 1), [NaN, 1, -1, 2, Inf]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 2), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 3), [NaN, 1, -1, 2, Inf]) +%!assert (sort ([NaN, 1, -1, 2, Inf], "ascend"), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "ascend"), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], "descend"), [NaN, Inf, 2, 1, -1]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, 1, -1]) +%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4]), [3, 1, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 1), [3, 1, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 2), [1, 3, 5, 7; 2, 4, 6, 8]) +%!assert (sort (1), 1) + +%!test +%! [v, i] = sort ([NaN, 1, -1, Inf, 1]); +%! assert (v, [-1, 1, 1, Inf, NaN]); +%! assert (i, [3, 2, 5, 4, 1]); + +## Complex +%!assert (sort ([NaN, 1i, -1, 2, Inf]), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 1), [NaN, 1i, -1, 2, Inf]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 2), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 3), [NaN, 1i, -1, 2, Inf]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], "ascend"), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "ascend"), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], "descend"), [NaN, Inf, 2, -1, 1i]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, -1, 1i]) +%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4]), [3, 1i, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 1), [3, 1i, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 2), [1i, 3, 5, 7; 2, 4, 6, 8]) +%!assert (sort (1i), 1i) + +%!test +%! [v, i] = sort ([NaN, 1i, -1, Inf, 1, 1i]); +%! assert (v, [1, 1i, 1i, -1, Inf, NaN]); +%! assert (i, [5, 2, 6, 3, 4, 1]); + +## Single +%!assert (sort (single ([NaN, 1, -1, 2, Inf])), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 1), single ([NaN, 1, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 3), single ([NaN, 1, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "ascend"), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "ascend"), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, 1, -1])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, 1, -1])) +%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4])), single ([3, 1, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 2), single ([1, 3, 5, 7; 2, 4, 6, 8])) +%!assert (sort (single (1)), single (1)) + +%!test +%! [v, i] = sort (single ([NaN, 1, -1, Inf, 1])); +%! assert (v, single ([-1, 1, 1, Inf, NaN])); +%! assert (i, [3, 2, 5, 4, 1]); + +## Single Complex +%!assert (sort (single ([NaN, 1i, -1, 2, Inf])), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 1), single ([NaN, 1i, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 3), single ([NaN, 1i, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "ascend"), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "ascend"), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, -1, 1i])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, -1, 1i])) +%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4])), single ([3, 1i, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1i, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 2), single ([1i, 3, 5, 7; 2, 4, 6, 8])) +%!assert (sort (single (1i)), single (1i)) + +%!test +%! [v, i] = sort (single ([NaN, 1i, -1, Inf, 1, 1i])); +%! assert (v, single ([1, 1i, 1i, -1, Inf, NaN])); +%! assert (i, [5, 2, 6, 3, 4, 1]); + +## Bool +%!assert (sort ([true, false, true, false]), [false, false, true, true]) +%!assert (sort ([true, false, true, false], 1), [true, false, true, false]) +%!assert (sort ([true, false, true, false], 2), [false, false, true, true]) +%!assert (sort ([true, false, true, false], 3), [true, false, true, false]) +%!assert (sort ([true, false, true, false], "ascend"), [false, false, true, true]) +%!assert (sort ([true, false, true, false], 2, "ascend"), [false, false, true, true]) +%!assert (sort ([true, false, true, false], "descend"), [true, true, false, false]) +%!assert (sort ([true, false, true, false], 2, "descend"), [true, true, false, false]) +%!assert (sort (true), true) + +%!test +%! [v, i] = sort ([true, false, true, false]); +%! assert (v, [false, false, true, true]); +%! assert (i, [2, 4, 1, 3]); + +## Sparse Double +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf])), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) + +%!shared a +%! a = randn (10, 10); +%! a(a < 0) = 0; +%!assert (sort (sparse (a)), sparse (sort (a))) +%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) +%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) +%!test +%! [v, i] = sort (a); +%! [vs, is] = sort (sparse (a)); +%! assert (vs, sparse (v)); +%! assert (is, i); + +## Sparse Complex +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf])), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) + +%!shared a +%! a = randn (10, 10); +%! a(a < 0) = 0; +%! a = 1i * a; +%!assert (sort (sparse (a)), sparse (sort (a))) +%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) +%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) +%!test +%! [v, i] = sort (a); +%! [vs, is] = sort (sparse (a)); +%! assert (vs, sparse (v)); +%! assert (is, i); + +## Sparse Bool +%!assert (sort (sparse ([true, false, true, false])), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), 1), sparse ([true, false, true, false])) +%!assert (sort (sparse ([true, false, true, false]), 2), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), 3), sparse ([true, false, true, false])) +%!assert (sort (sparse ([true, false, true, false]), "ascend"), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), 2, "ascend"), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), "descend"), sparse ([true, true, false, false])) +%!assert (sort (sparse ([true, false, true, false]), 2, "descend"), sparse ([true, true, false, false])) + +%!test +%! [v, i] = sort (sparse ([true, false, true, false])); +%! assert (v, sparse ([false, false, true, true])); +%! assert (i, [2, 4, 1, 3]); + +## Cell string array +%!shared a, b, c +%! a = {"Alice", "Cecile", "Eric", "Barry", "David"}; +%! b = {"Alice", "Barry", "Cecile", "David", "Eric"}; +%! c = {"Eric", "David", "Cecile", "Barry", "Alice"}; +%!assert (sort (a), b) +%!assert (sort (a, 1), a) +%!assert (sort (a, 2), b) +%!assert (sort (a, 3), a) +%!assert (sort (a, "ascend"), b) +%!assert (sort (a, 2, "ascend"), b) +%!assert (sort (a, "descend"), c) +%!assert (sort (a, 2, "descend"), c) + +%!test +%! [v, i] = sort (a); +%! assert (i, [1, 4, 2, 5, 3]); + +%!error sort () +%!error sort (1, 2, 3, 4) +*/ + +// Sort the rows of the matrix @var{a} according to the order +// specified by @var{mode}, which can either be `ascend' or `descend' +// and return the index vector corresponding to the sort order. +// +// This function does not yet support sparse matrices. + +DEFUN (__sort_rows_idx__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __sort_rows_idx__ (@var{a}, @var{mode})\n\ +Undocumented internal function.\n\ +@end deftypefn\n") +{ + octave_value retval; + + int nargin = args.length (); + sortmode smode = ASCENDING; + + if (nargin < 1 || nargin > 2 || (nargin == 2 && ! args(1).is_string ())) + { + print_usage (); + return retval; + } + + if (nargin > 1) + { + std::string mode = args(1).string_value (); + if (mode == "ascend") + smode = ASCENDING; + else if (mode == "descend") + smode = DESCENDING; + else + { + error ("__sort_rows_idx__: MODE must be either \"ascend\" or \"descend\""); + return retval; + } + } + + octave_value arg = args(0); + + if (arg.is_sparse_type ()) + error ("__sort_rows_idx__: sparse matrices not yet supported"); + if (arg.ndims () == 2) + { + Array idx = arg.sort_rows_idx (smode); + + retval = octave_value (idx, true, true); + } + else + error ("__sort_rows_idx__: needs a 2-dimensional object"); + + return retval; +} + +static sortmode +get_sort_mode_option (const octave_value& arg, const char *argn) +{ + // FIXME -- we initialize to UNSORTED here to avoid a GCC warning + // about possibly using sortmode uninitialized. + // FIXME -- shouldn't these modes be scoped inside a class? + sortmode smode = UNSORTED; + + std::string mode = arg.string_value (); + + if (error_state) + error ("issorted: expecting %s argument to be a character string", argn); + else if (mode == "ascending") + smode = ASCENDING; + else if (mode == "descending") + smode = DESCENDING; + else if (mode == "either") + smode = UNSORTED; + else + error ("issorted: MODE must be \"ascending\", \"descending\", or \"either\""); + + return smode; +} + +DEFUN (issorted, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} issorted (@var{a})\n\ +@deftypefnx {Built-in Function} {} issorted (@var{a}, @var{mode})\n\ +@deftypefnx {Built-in Function} {} issorted (@var{a}, \"rows\", @var{mode})\n\ +Return true if the array is sorted according to @var{mode}, which\n\ +may be either \"ascending\", \"descending\", or \"either\". By default,\n\ + @var{mode} is \"ascending\". NaNs are treated in the same manner as\n\ +@code{sort}.\n\ +\n\ +If the optional argument \"rows\" is supplied, check whether\n\ +the array is sorted by rows as output by the function @code{sortrows}\n\ +(with no options).\n\ +\n\ +This function does not support sparse matrices.\n\ +@seealso{sort, sortrows}\n\ +@end deftypefn\n") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 3) + { + print_usage (); + return retval; + } + + bool by_rows = false; + + sortmode smode = ASCENDING; + + if (nargin > 1) + { + octave_value mode_arg; + + if (nargin == 3) + smode = get_sort_mode_option (args(2), "third"); + + std::string tmp = args(1).string_value (); + + if (! error_state) + { + if (tmp == "rows") + by_rows = true; + else + smode = get_sort_mode_option (args(1), "second"); + } + else + error ("expecting second argument to be character string"); + + if (error_state) + return retval; + } + + octave_value arg = args(0); + + if (by_rows) + { + if (arg.is_sparse_type ()) + error ("issorted: sparse matrices not yet supported"); + if (arg.ndims () == 2) + retval = arg.is_sorted_rows (smode) != UNSORTED; + else + error ("issorted: A must be a 2-dimensional object"); + } + else + { + if (arg.dims ().is_vector ()) + retval = args(0).is_sorted (smode) != UNSORTED; + else + error ("issorted: needs a vector"); + } + + return retval; +} + +/* +%!shared sm, um, sv, uv +%! sm = [1, 2; 3, 4]; +%! um = [3, 1; 2, 4]; +%! sv = [1, 2, 3, 4]; +%! uv = [2, 1, 4, 3]; +%!assert (issorted (sm, "rows")) +%!assert (!issorted (um, "rows")) +%!assert (issorted (sv)) +%!assert (!issorted (uv)) +%!assert (issorted (sv')) +%!assert (!issorted (uv')) +%!assert (issorted (sm, "rows", "ascending")) +%!assert (!issorted (um, "rows", "ascending")) +%!assert (issorted (sv, "ascending")) +%!assert (!issorted (uv, "ascending")) +%!assert (issorted (sv', "ascending")) +%!assert (!issorted (uv', "ascending")) +%!assert (!issorted (sm, "rows", "descending")) +%!assert (issorted (flipud (sm), "rows", "descending")) +%!assert (!issorted (sv, "descending")) +%!assert (issorted (fliplr (sv), "descending")) +%!assert (!issorted (sv', "descending")) +%!assert (issorted (fliplr (sv)', "descending")) +%!assert (!issorted (um, "rows", "either")) +%!assert (!issorted (uv, "either")) +%!assert (issorted (sm, "rows", "either")) +%!assert (issorted (flipud (sm), "rows", "either")) +%!assert (issorted (sv, "either")) +%!assert (issorted (fliplr (sv), "either")) +%!assert (issorted (sv', "either")) +%!assert (issorted (fliplr (sv)', "either")) +*/ + +DEFUN (nth_element, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} nth_element (@var{x}, @var{n})\n\ +@deftypefnx {Built-in Function} {} nth_element (@var{x}, @var{n}, @var{dim})\n\ +Select the n-th smallest element of a vector, using the ordering defined by\n\ +@code{sort}. In other words, the result is equivalent to\n\ +@code{sort(@var{x})(@var{n})}.\n\ +@var{n} can also be a contiguous range, either ascending @code{l:u}\n\ +or descending @code{u:-1:l}, in which case a range of elements is returned.\n\ +If @var{x} is an array, @code{nth_element} operates along the dimension\n\ +defined by @var{dim}, or the first non-singleton dimension if @var{dim} is\n\ +not given.\n\ +\n\ +nth_element encapsulates the C++ standard library algorithms nth_element and\n\ +partial_sort. On average, the complexity of the operation is O(M*log(K)),\n\ +where @w{@code{M = size (@var{x}, @var{dim})}} and\n\ +@w{@code{K = length (@var{n})}}.\n\ +This function is intended for cases where the ratio K/M is small; otherwise,\n\ +it may be better to use @code{sort}.\n\ +@seealso{sort, min, max}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + octave_value argx = args(0); + + int dim = -1; + if (nargin == 3) + { + dim = args(2).int_value (true) - 1; + if (dim < 0) + error ("nth_element: DIM must be a valid dimension"); + } + if (dim < 0) + dim = argx.dims ().first_non_singleton (); + + idx_vector n = args(1).index_vector (); + + if (error_state) + return retval; + + switch (argx.builtin_type ()) + { + case btyp_double: + retval = argx.array_value ().nth_element (n, dim); + break; + case btyp_float: + retval = argx.float_array_value ().nth_element (n, dim); + break; + case btyp_complex: + retval = argx.complex_array_value ().nth_element (n, dim); + break; + case btyp_float_complex: + retval = argx.float_complex_array_value ().nth_element (n, dim); + break; +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + retval = argx.X ## _array_value ().nth_element (n, dim); \ + break + + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + default: + if (argx.is_cellstr ()) + retval = argx.cellstr_value ().nth_element (n, dim); + else + gripe_wrong_type_arg ("nth_element", argx); + } + } + else + print_usage (); + + return retval; +} + +template +static NDT +do_accumarray_sum (const idx_vector& idx, const NDT& vals, + octave_idx_type n = -1) +{ + typedef typename NDT::element_type T; + if (n < 0) + n = idx.extent (0); + else if (idx.extent (n) > n) + error ("accumarray: index out of range"); + + NDT retval (dim_vector (n, 1), T ()); + + if (vals.numel () == 1) + retval.idx_add (idx, vals (0)); + else if (vals.numel () == idx.length (n)) + retval.idx_add (idx, vals); + else + error ("accumarray: dimensions mismatch"); + + return retval; +} + +DEFUN (__accumarray_sum__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumarray_sum__ (@var{idx}, @var{vals}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + if (nargin >= 2 && nargin <= 3 && args(0).is_numeric_type ()) + { + idx_vector idx = args(0).index_vector (); + octave_idx_type n = -1; + if (nargin == 3) + n = args(2).idx_type_value (true); + + if (! error_state) + { + octave_value vals = args(1); + if (vals.is_range ()) + { + Range r = vals.range_value (); + if (r.inc () == 0) + vals = r.base (); + } + + if (vals.is_single_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumarray_sum (idx, vals.float_complex_array_value (), n); + else + retval = do_accumarray_sum (idx, vals.float_array_value (), n); + } + else if (vals.is_numeric_type () || vals.is_bool_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumarray_sum (idx, vals.complex_array_value (), n); + else + retval = do_accumarray_sum (idx, vals.array_value (), n); + } + else + gripe_wrong_type_arg ("accumarray", vals); + } + } + else + print_usage (); + + return retval; +} + +template +static NDT +do_accumarray_minmax (const idx_vector& idx, const NDT& vals, + octave_idx_type n, bool ismin, + const typename NDT::element_type& zero_val) +{ + typedef typename NDT::element_type T; + if (n < 0) + n = idx.extent (0); + else if (idx.extent (n) > n) + error ("accumarray: index out of range"); + + NDT retval (dim_vector (n, 1), zero_val); + + // Pick minimizer or maximizer. + void (MArray::*op) (const idx_vector&, const MArray&) = + ismin ? (&MArray::idx_min) : (&MArray::idx_max); + + octave_idx_type l = idx.length (n); + if (vals.numel () == 1) + (retval.*op) (idx, NDT (dim_vector (l, 1), vals(0))); + else if (vals.numel () == l) + (retval.*op) (idx, vals); + else + error ("accumarray: dimensions mismatch"); + + return retval; +} + +static octave_value_list +do_accumarray_minmax_fun (const octave_value_list& args, + bool ismin) +{ + octave_value retval; + int nargin = args.length (); + if (nargin >= 3 && nargin <= 4 && args(0).is_numeric_type ()) + { + idx_vector idx = args(0).index_vector (); + octave_idx_type n = -1; + if (nargin == 4) + n = args(3).idx_type_value (true); + + if (! error_state) + { + octave_value vals = args(1), zero = args (2); + + switch (vals.builtin_type ()) + { + case btyp_double: + retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, + zero.double_value ()); + break; + case btyp_float: + retval = do_accumarray_minmax (idx, vals.float_array_value (), n, ismin, + zero.float_value ()); + break; + case btyp_complex: + retval = do_accumarray_minmax (idx, vals.complex_array_value (), n, ismin, + zero.complex_value ()); + break; + case btyp_float_complex: + retval = do_accumarray_minmax (idx, vals.float_complex_array_value (), n, ismin, + zero.float_complex_value ()); + break; +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + retval = do_accumarray_minmax (idx, vals.X ## _array_value (), n, ismin, \ + zero.X ## _scalar_value ()); \ + break + + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + case btyp_bool: + retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, + zero.bool_value ()); + break; + default: + gripe_wrong_type_arg ("accumarray", vals); + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (__accumarray_min__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumarray_min__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return do_accumarray_minmax_fun (args, true); +} + +DEFUN (__accumarray_max__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumarray_max__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return do_accumarray_minmax_fun (args, false); +} + +template +static NDT +do_accumdim_sum (const idx_vector& idx, const NDT& vals, + int dim = -1, octave_idx_type n = -1) +{ + typedef typename NDT::element_type T; + if (n < 0) + n = idx.extent (0); + else if (idx.extent (n) > n) + error ("accumdim: index out of range"); + + dim_vector vals_dim = vals.dims (), rdv = vals_dim; + + if (dim < 0) + dim = vals.dims ().first_non_singleton (); + else if (dim >= rdv.length ()) + rdv.resize (dim+1, 1); + + rdv(dim) = n; + + NDT retval (rdv, T ()); + + if (idx.length () != vals_dim(dim)) + error ("accumdim: dimension mismatch"); + + retval.idx_add_nd (idx, vals, dim); + + return retval; +} + +DEFUN (__accumdim_sum__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumdim_sum__ (@var{idx}, @var{vals}, @var{dim}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + if (nargin >= 2 && nargin <= 4 && args(0).is_numeric_type ()) + { + idx_vector idx = args(0).index_vector (); + int dim = -1; + if (nargin >= 3) + dim = args(2).int_value () - 1; + + octave_idx_type n = -1; + if (nargin == 4) + n = args(3).idx_type_value (true); + + if (! error_state) + { + octave_value vals = args(1); + + if (vals.is_single_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumdim_sum (idx, vals.float_complex_array_value (), dim, n); + else + retval = do_accumdim_sum (idx, vals.float_array_value (), dim, n); + } + else if (vals.is_numeric_type () || vals.is_bool_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumdim_sum (idx, vals.complex_array_value (), dim, n); + else + retval = do_accumdim_sum (idx, vals.array_value (), dim, n); + } + else + gripe_wrong_type_arg ("accumdim", vals); + } + } + else + print_usage (); + + return retval; +} + +template +static NDT +do_merge (const Array& mask, + const NDT& tval, const NDT& fval) +{ + typedef typename NDT::element_type T; + dim_vector dv = mask.dims (); + NDT retval (dv); + + bool tscl = tval.numel () == 1, fscl = fval.numel () == 1; + + if ((! tscl && tval.dims () != dv) + || (! fscl && fval.dims () != dv)) + error ("merge: MASK, TVAL, and FVAL dimensions must match"); + else + { + T *rv = retval.fortran_vec (); + octave_idx_type n = retval.numel (); + + const T *tv = tval.data (), *fv = fval.data (); + const bool *mv = mask.data (); + + if (tscl) + { + if (fscl) + { + T ts = tv[0], fs = fv[0]; + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? ts : fs; + } + else + { + T ts = tv[0]; + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? ts : fv[i]; + } + } + else + { + if (fscl) + { + T fs = fv[0]; + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? tv[i] : fs; + } + else + { + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? tv[i] : fv[i]; + } + } + } + + return retval; +} + +#define MAKE_INT_BRANCH(INTX) \ + else if (tval.is_ ## INTX ## _type () && fval.is_ ## INTX ## _type ()) \ + { \ + retval = do_merge (mask, \ + tval.INTX ## _array_value (), \ + fval.INTX ## _array_value ()); \ + } + +DEFUN (merge, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} merge (@var{mask}, @var{tval}, @var{fval})\n\ +@deftypefnx {Built-in Function} {} ifelse (@var{mask}, @var{tval}, @var{fval})\n\ +Merge elements of @var{true_val} and @var{false_val}, depending on the\n\ +value of @var{mask}. If @var{mask} is a logical scalar, the other two\n\ +arguments can be arbitrary values. Otherwise, @var{mask} must be a logical\n\ +array, and @var{tval}, @var{fval} should be arrays of matching class, or\n\ +cell arrays. In the scalar mask case, @var{tval} is returned if @var{mask}\n\ +is true, otherwise @var{fval} is returned.\n\ +\n\ +In the array mask case, both @var{tval} and @var{fval} must be either\n\ +scalars or arrays with dimensions equal to @var{mask}. The result is\n\ +constructed as follows:\n\ +\n\ +@example\n\ +@group\n\ +result(mask) = tval(mask);\n\ +result(! mask) = fval(! mask);\n\ +@end group\n\ +@end example\n\ +\n\ +@var{mask} can also be arbitrary numeric type, in which case\n\ +it is first converted to logical.\n\ +@seealso{logical, diff}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value retval; + + if (nargin == 3 && (args(0).is_bool_type () || args(0).is_numeric_type ())) + { + octave_value mask_val = args(0); + + if (mask_val.is_scalar_type ()) + retval = mask_val.is_true () ? args(1) : args(2); + else + { + boolNDArray mask = mask_val.bool_array_value (); + octave_value tval = args(1), fval = args(2); + if (tval.is_double_type () && fval.is_double_type ()) + { + if (tval.is_complex_type () || fval.is_complex_type ()) + retval = do_merge (mask, + tval.complex_array_value (), + fval.complex_array_value ()); + else + retval = do_merge (mask, + tval.array_value (), + fval.array_value ()); + } + else if (tval.is_single_type () && fval.is_single_type ()) + { + if (tval.is_complex_type () || fval.is_complex_type ()) + retval = do_merge (mask, + tval.float_complex_array_value (), + fval.float_complex_array_value ()); + else + retval = do_merge (mask, + tval.float_array_value (), + fval.float_array_value ()); + } + else if (tval.is_string () && fval.is_string ()) + { + bool sq_string = tval.is_sq_string () || fval.is_sq_string (); + retval = octave_value (do_merge (mask, + tval.char_array_value (), + fval.char_array_value ()), + sq_string ? '\'' : '"'); + } + else if (tval.is_cell () && fval.is_cell ()) + { + retval = do_merge (mask, + tval.cell_value (), + fval.cell_value ()); + } + + MAKE_INT_BRANCH (int8) + MAKE_INT_BRANCH (int16) + MAKE_INT_BRANCH (int32) + MAKE_INT_BRANCH (int64) + MAKE_INT_BRANCH (uint8) + MAKE_INT_BRANCH (uint16) + MAKE_INT_BRANCH (uint32) + MAKE_INT_BRANCH (uint64) + + else + error ("merge: cannot merge %s with %s with array mask", + tval.class_name ().c_str (), + fval.class_name ().c_str ()); + } + } + else + print_usage (); + + return retval; +} + +DEFALIAS (ifelse, merge); + +#undef MAKE_INT_BRANCH + +template +static SparseT +do_sparse_diff (const SparseT& array, octave_idx_type order, + int dim) +{ + SparseT retval = array; + if (dim == 1) + { + octave_idx_type k = retval.columns (); + while (order > 0 && k > 0) + { + idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); + retval = SparseT (retval.index (col1, sl1)) - SparseT (retval.index (col2, sl2)); + assert (retval.columns () == k-1); + order--; + k--; + } + } + else + { + octave_idx_type k = retval.rows (); + while (order > 0 && k > 0) + { + idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); + retval = SparseT (retval.index (sl1, col1)) - SparseT (retval.index (sl2, col2)); + assert (retval.rows () == k-1); + order--; + k--; + } + } + + return retval; +} + +static octave_value +do_diff (const octave_value& array, octave_idx_type order, + int dim = -1) +{ + octave_value retval; + + const dim_vector& dv = array.dims (); + if (dim == -1) + { + dim = array.dims ().first_non_singleton (); + + // Bother Matlab. This behavior is really wicked. + if (dv(dim) <= order) + { + if (dv(dim) == 1) + retval = array.resize (dim_vector (0, 0)); + else + { + retval = array; + while (order > 0) + { + if (dim == dv.length ()) + { + retval = do_diff (array, order, dim - 1); + order = 0; + } + else if (dv(dim) == 1) + dim++; + else + { + retval = do_diff (array, dv(dim) - 1, dim); + order -= dv(dim) - 1; + dim++; + } + } + } + + return retval; + } + } + + if (array.is_integer_type ()) + { + if (array.is_int8_type ()) + retval = array.int8_array_value ().diff (order, dim); + else if (array.is_int16_type ()) + retval = array.int16_array_value ().diff (order, dim); + else if (array.is_int32_type ()) + retval = array.int32_array_value ().diff (order, dim); + else if (array.is_int64_type ()) + retval = array.int64_array_value ().diff (order, dim); + else if (array.is_uint8_type ()) + retval = array.uint8_array_value ().diff (order, dim); + else if (array.is_uint16_type ()) + retval = array.uint16_array_value ().diff (order, dim); + else if (array.is_uint32_type ()) + retval = array.uint32_array_value ().diff (order, dim); + else if (array.is_uint64_type ()) + retval = array.uint64_array_value ().diff (order, dim); + else + panic_impossible (); + } + else if (array.is_sparse_type ()) + { + if (array.is_complex_type ()) + retval = do_sparse_diff (array.sparse_complex_matrix_value (), order, dim); + else + retval = do_sparse_diff (array.sparse_matrix_value (), order, dim); + } + else if (array.is_single_type ()) + { + if (array.is_complex_type ()) + retval = array.float_complex_array_value ().diff (order, dim); + else + retval = array.float_array_value ().diff (order, dim); + } + else + { + if (array.is_complex_type ()) + retval = array.complex_array_value ().diff (order, dim); + else + retval = array.array_value ().diff (order, dim); + } + + return retval; +} + +DEFUN (diff, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} diff (@var{x})\n\ +@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k})\n\ +@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k}, @var{dim})\n\ +If @var{x} is a vector of length @math{n}, @code{diff (@var{x})} is the\n\ +vector of first differences\n\ +@tex\n\ + $x_2 - x_1, \\ldots{}, x_n - x_{n-1}$.\n\ +@end tex\n\ +@ifnottex\n\ + @var{x}(2) - @var{x}(1), @dots{}, @var{x}(n) - @var{x}(n-1).\n\ +@end ifnottex\n\ +\n\ +If @var{x} is a matrix, @code{diff (@var{x})} is the matrix of column\n\ +differences along the first non-singleton dimension.\n\ +\n\ +The second argument is optional. If supplied, @code{diff (@var{x},\n\ +@var{k})}, where @var{k} is a non-negative integer, returns the\n\ +@var{k}-th differences. It is possible that @var{k} is larger than\n\ +the first non-singleton dimension of the matrix. In this case,\n\ +@code{diff} continues to take the differences along the next\n\ +non-singleton dimension.\n\ +\n\ +The dimension along which to take the difference can be explicitly\n\ +stated with the optional variable @var{dim}. In this case the\n\ +@var{k}-th order differences are calculated along this dimension.\n\ +In the case where @var{k} exceeds @code{size (@var{x}, @var{dim})}\n\ +an empty matrix is returned.\n\ +@seealso{sort, merge}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value retval; + + if (nargin < 1 || nargin > 3) + print_usage (); + else if (! (args(0).is_numeric_type () || args(0).is_bool_type ())) + error ("diff: X must be numeric or logical"); + + if (! error_state) + { + int dim = -1; + octave_idx_type order = 1; + if (nargin > 1) + { + if (args(1).is_scalar_type ()) + order = args(1).idx_type_value (true, false); + else if (! args(1).is_zero_by_zero ()) + error ("order K must be a scalar or []"); + if (! error_state && order < 0) + error ("order K must be non-negative"); + } + + if (nargin > 2) + { + dim = args(2).int_value (true, false); + if (! error_state && (dim < 1 || dim > args(0).ndims ())) + error ("DIM must be a valid dimension"); + else + dim -= 1; + } + + if (! error_state) + retval = do_diff (args(0), order, dim); + } + + return retval; +} + +/* +%!assert (diff ([1, 2, 3, 4]), [1, 1, 1]) +%!assert (diff ([1, 3, 7, 19], 2), [2, 8]) +%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1]), [4, 2; 3, 3; 1, -1; -6, -5]) +%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1], 3), [-1, -5; -5, 0]) +%!assert (isempty (diff (1))) + +%!error diff () +%!error diff (1, 2, 3, 4) +%!error diff ("foo") +%!error diff ([1, 2; 3, 4], -1) +*/ + +template +static Array +do_repelems (const Array& src, const Array& rep) +{ + Array retval; + + assert (rep.ndims () == 2 && rep.rows () == 2); + + octave_idx_type n = rep.columns (), l = 0; + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type k = rep(1, i); + if (k < 0) + { + error ("repelems: second row must contain non-negative numbers"); + return retval; + } + + l += k; + } + + retval.clear (1, l); + T *dest = retval.fortran_vec (); + l = 0; + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type k = rep(1, i); + std::fill_n (dest, k, src.checkelem (rep(0, i) - 1)); + dest += k; + } + + return retval; +} + +DEFUN (repelems, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} repelems (@var{x}, @var{r})\n\ +Construct a vector of repeated elements from @var{x}. @var{r}\n\ +is a 2x@var{N} integer matrix specifying which elements to repeat and\n\ +how often to repeat each element.\n\ +\n\ +Entries in the first row, @var{r}(1,j), select an element to repeat.\n\ +The corresponding entry in the second row, @var{r}(2,j), specifies\n\ +the repeat count. If @var{x} is a matrix then the columns of @var{x} are\n\ +imagined to be stacked on top of each other for purposes of the selection\n\ +index. A row vector is always returned.\n\ +\n\ +Conceptually the result is calculated as follows:\n\ +\n\ +@example\n\ +@group\n\ +y = [];\n\ +for i = 1:columns (@var{r})\n\ + y = [y, @var{x}(@var{r}(1,i)*ones(1, @var{r}(2,i)))];\n\ +endfor\n\ +@end group\n\ +@end example\n\ +@seealso{repmat, cat}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + octave_value x = args(0); + + const Matrix rm = args(1).matrix_value (); + if (error_state) + return retval; + else if (rm.rows () != 2 || rm.ndims () != 2) + { + error ("repelems: R must be a matrix with two rows"); + return retval; + } + else + { + NoAlias< Array > r (rm.dims ()); + + for (octave_idx_type i = 0; i < rm.numel (); i++) + { + octave_idx_type rx = rm(i); + if (static_cast (rx) != rm(i)) + { + error ("repelems: R must be a matrix of integers"); + return retval; + } + + r(i) = rx; + } + + switch (x.builtin_type ()) + { +#define BTYP_BRANCH(X, EX) \ + case btyp_ ## X: \ + retval = do_repelems (x.EX ## _value (), r); \ + break + + BTYP_BRANCH (double, array); + BTYP_BRANCH (float, float_array); + BTYP_BRANCH (complex, complex_array); + BTYP_BRANCH (float_complex, float_complex_array); + BTYP_BRANCH (bool, bool_array); + BTYP_BRANCH (char, char_array); + + BTYP_BRANCH (int8, int8_array); + BTYP_BRANCH (int16, int16_array); + BTYP_BRANCH (int32, int32_array); + BTYP_BRANCH (int64, int64_array); + BTYP_BRANCH (uint8, uint8_array); + BTYP_BRANCH (uint16, uint16_array); + BTYP_BRANCH (uint32, uint32_array); + BTYP_BRANCH (uint64, uint64_array); + + BTYP_BRANCH (cell, cell); + //BTYP_BRANCH (struct, map);//FIXME +#undef BTYP_BRANCH + + default: + gripe_wrong_type_arg ("repelems", x); + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (base64_encode, args, , "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{s} =} base64_encode (@var{x})\n\ +Encode a double matrix or array @var{x} into the base64 format string\n\ +@var{s}.\n\ +\n\ +@strong{Warning:} Encoding different numeric types, such as single or\n\ +integer, is not currently supported. Any non-double input will be converted\n\ +to type double before encoding.\n\ +@seealso{base64_decode}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin != 1) + print_usage (); + else + { + const Array in = args(0).array_value (); + if (! error_state) + { + const char* inc = reinterpret_cast (in.data ()); + size_t inlen = in.numel () * sizeof (double) / sizeof (char); + char* out; + size_t outlen = base64_encode_alloc (inc, inlen, &out); + + if (! out && outlen == 0 && inlen != 0) + error ("base64_encode: input array too large"); + else if (! out) + error ("base64_encode: memory allocation error"); + else + retval(0) = octave_value (out); + } + } + + return retval; +} + +/* +%!assert (base64_encode (single (pi)), "AAAAYPshCUA=") +%!assert (base64_encode (uint8 (pi)), base64_encode (double (uint8 (pi)))) + +%!error base64_encode () +%!error base64_encode (1,2) +%!error base64_encode ("A string") +*/ + +DEFUN (base64_decode, args, , "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{x} =} base64_decode (@var{s})\n\ +@deftypefnx {Built-in Function} {@var{x} =} base64_decode (@var{s}, @var{dims})\n\ +Decode the double matrix or array @var{x} from the base64 format string\n\ +@var{s}. The optional input parameter @var{dims} should be a vector\n\ +containing the dimensions of the decoded array.\n\ +@seealso{base64_encode}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 2) + print_usage (); + else + { + dim_vector new_dims; + Array res; + + if (nargin > 1) + { + const Array new_size = + args(1).octave_idx_type_vector_value (); + if (! error_state) + { + new_dims = dim_vector::alloc (new_size.length ()); + for (octave_idx_type i = 0; i < new_size.length (); i++) + new_dims(i) = new_size(i); + } + } + + const std::string in = args(0).string_value (); + + if (! error_state) + { + const char *inc = &(in[0]); + char *out; + size_t inlen = in.length (), outlen; + + bool ok = base64_decode_alloc (inc, inlen, &out, &outlen); + + if (! ok) + error ("base64_decode: input was not valid base64"); + else if (! out) + error ("base64_decode: memory allocation error"); + else + { + if ((outlen % (sizeof (double) / sizeof (char))) != 0) + error ("base64_decode: incorrect input size"); + else + { + octave_idx_type l; + l = (outlen * sizeof (char)) / sizeof (double); + res.resize1 (l); + double *dout = reinterpret_cast (out); + std::copy (dout, dout + l, res.fortran_vec ()); + + if (nargin > 1) + retval(0) = octave_value (res).reshape (new_dims); + else + retval(0) = octave_value (res); + } + } + } + } + + return retval; +} + +/* +%!assert (base64_decode (base64_encode (pi)), pi) +%! +%!test +%! in = randn (10); +%! outv = base64_decode (base64_encode (in)); +%! outm = base64_decode (base64_encode (in), size (in)); +%! assert (outv, in(:).'); +%! assert (outm, in); + +%!error base64_decode () +%!error base64_decode (1,2,3) +%!error base64_decode (1, "this is not a valid set of dimensions") +%!error base64_decode (1) +%!error base64_decode ("AQ=") +%!error base64_decode ("AQ==") +*/ diff -r d02b229ce693 -r a132d206a36a src/interpfcn/data.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/data.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,34 @@ +/* + +Copyright (C) 2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_data_h) +#define octave_data_h 1 + +#include + +class octave_value; +class octave_value_list; + +extern OCTINTERP_API octave_value +do_class_concat (const octave_value_list& ovl, std::string cattype, int dim); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/debug.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/debug.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1268 @@ +/* + +Copyright (C) 2001-2012 Ben Sapp +Copyright (C) 2007-2009 John Swensen + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include +#include + +#include "file-stat.h" +#include "singleton-cleanup.h" + +#include "defun.h" +#include "error.h" +#include "help.h" +#include "input.h" +#include "pager.h" +#include "oct-obj.h" +#include "utils.h" +#include "parse.h" +#include "symtab.h" +#include "gripes.h" +#include "ov.h" +#include "ov-usr-fcn.h" +#include "ov-fcn.h" +#include "ov-struct.h" +#include "pt-pr-code.h" +#include "pt-bp.h" +#include "pt-eval.h" +#include "pt-stmt.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "variables.h" + +#include "debug.h" + +// Initialize the singleton object +bp_table *bp_table::instance = 0; + +static std::string +snarf_file (const std::string& fname) +{ + std::string retval; + + file_stat fs (fname); + + if (fs) + { + size_t sz = fs.size (); + + std::ifstream file (fname.c_str (), std::ios::in|std::ios::binary); + + if (file) + { + std::string buf (sz+1, 0); + + file.read (&buf[0], sz+1); + + if (file.eof ()) + { + // Expected to read the entire file. + + retval = buf; + } + else + error ("error reading file %s", fname.c_str ()); + } + } + + return retval; +} + +static std::deque +get_line_offsets (const std::string& buf) +{ + // This could maybe be smarter. Is deque the right thing to use + // here? + + std::deque offsets; + + offsets.push_back (0); + + size_t len = buf.length (); + + for (size_t i = 0; i < len; i++) + { + char c = buf[i]; + + if (c == '\r' && ++i < len) + { + c = buf[i]; + + if (c == '\n') + offsets.push_back (i+1); + else + offsets.push_back (i); + } + else if (c == '\n') + offsets.push_back (i+1); + } + + offsets.push_back (len); + + return offsets; +} + +std::string +get_file_line (const std::string& fname, size_t line) +{ + std::string retval; + + static std::string last_fname; + + static std::string buf; + + static std::deque offsets; + + if (fname != last_fname) + { + buf = snarf_file (fname); + + offsets = get_line_offsets (buf); + } + + if (line > 0) + line--; + + if (line < offsets.size () - 1) + { + size_t bol = offsets[line]; + size_t eol = offsets[line+1]; + + while (eol > 0 && eol > bol && (buf[eol-1] == '\n' || buf[eol-1] == '\r')) + eol--; + + retval = buf.substr (bol, eol - bol); + } + + return retval; +} + +// Return a pointer to the user-defined function FNAME. If FNAME is +// empty, search backward for the first user-defined function in the +// current call stack. + +static octave_user_code * +get_user_code (const std::string& fname = std::string ()) +{ + octave_user_code *dbg_fcn = 0; + + if (fname.empty ()) + dbg_fcn = octave_call_stack::caller_user_code (); + else + { + octave_value fcn = symbol_table::find_function (fname); + + if (fcn.is_defined () && fcn.is_user_code ()) + dbg_fcn = fcn.user_code_value (); + } + + return dbg_fcn; +} + +static void +parse_dbfunction_params (const char *who, const octave_value_list& args, + std::string& symbol_name, bp_table::intmap& lines) +{ + int nargin = args.length (); + int idx = 0; + int list_idx = 0; + symbol_name = std::string (); + lines = bp_table::intmap (); + + if (args.length () == 0) + return; + + // If we are already in a debugging function. + if (octave_call_stack::caller_user_code ()) + { + idx = 0; + symbol_name = get_user_code ()->name (); + } + else if (args(0).is_map ()) + { + // Problem because parse_dbfunction_params() can only pass out a + // single function + } + else if (args(0).is_string ()) + { + symbol_name = args(0).string_value (); + if (error_state) + return; + idx = 1; + } + else + error ("%s: invalid parameter specified", who); + + for (int i = idx; i < nargin; i++ ) + { + if (args(i).is_string ()) + { + int line = atoi (args(i).string_value ().c_str ()); + if (error_state) + break; + lines[list_idx++] = line; + } + else if (args(i).is_map ()) + octave_stdout << who << ": accepting a struct" << std::endl; + else + { + const NDArray arg = args(i).array_value (); + + if (error_state) + break; + + for (octave_idx_type j = 0; j < arg.nelem (); j++) + { + int line = static_cast (arg.elem (j)); + if (error_state) + break; + lines[list_idx++] = line; + } + + if (error_state) + break; + } + } +} + +bool +bp_table::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new bp_table (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create breakpoint table!"); + retval = false; + } + + return retval; +} + +bp_table::intmap +bp_table::do_add_breakpoint (const std::string& fname, + const bp_table::intmap& line) +{ + intmap retval; + + octave_idx_type len = line.size (); + + octave_user_code *dbg_fcn = get_user_code (fname); + + if (dbg_fcn) + { + tree_statement_list *cmds = dbg_fcn->body (); + + if (cmds) + { + for (int i = 0; i < len; i++) + { + const_intmap_iterator p = line.find (i); + + if (p != line.end ()) + { + int lineno = p->second; + + retval[i] = cmds->set_breakpoint (lineno); + + if (retval[i] != 0) + { + bp_set.insert (fname); + } + } + } + } + } + else + error ("add_breakpoint: unable to find the requested function\n"); + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; + + return retval; +} + + +int +bp_table::do_remove_breakpoint (const std::string& fname, + const bp_table::intmap& line) +{ + int retval = 0; + + octave_idx_type len = line.size (); + + if (len == 0) + { + intmap results = remove_all_breakpoints_in_file (fname); + retval = results.size (); + } + else + { + octave_user_code *dbg_fcn = get_user_code (fname); + + if (dbg_fcn) + { + tree_statement_list *cmds = dbg_fcn->body (); + + if (cmds) + { + octave_value_list results = cmds->list_breakpoints (); + + if (results.length () > 0) + { + for (int i = 0; i < len; i++) + { + const_intmap_iterator p = line.find (i); + + if (p != line.end ()) + cmds->delete_breakpoint (p->second); + } + + results = cmds->list_breakpoints (); + + bp_set_iterator it = bp_set.find (fname); + if (results.length () == 0 && it != bp_set.end ()) + bp_set.erase (it); + + } + + retval = results.length (); + } + } + else + error ("remove_breakpoint: unable to find the requested function\n"); + } + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; + + return retval; +} + + +bp_table::intmap +bp_table::do_remove_all_breakpoints_in_file (const std::string& fname, + bool silent) +{ + intmap retval; + + octave_user_code *dbg_fcn = get_user_code (fname); + + if (dbg_fcn) + { + tree_statement_list *cmds = dbg_fcn->body (); + + if (cmds) + { + octave_value_list bkpts = cmds->list_breakpoints (); + + for (int i = 0; i < bkpts.length (); i++) + { + int lineno = static_cast (bkpts(i).int_value ()); + cmds->delete_breakpoint (lineno); + retval[i] = lineno; + } + + bp_set_iterator it = bp_set.find (fname); + if (it != bp_set.end ()) + bp_set.erase (it); + + } + } + else if (! silent) + error ("remove_all_breakpoint_in_file: " + "unable to find the requested function\n"); + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; + + return retval; +} + +void +bp_table::do_remove_all_breakpoints (void) +{ + for (const_bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) + remove_all_breakpoints_in_file (*it); + + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; +} + +std::string +do_find_bkpt_list (octave_value_list slist, + std::string match) +{ + std::string retval; + + for (int i = 0; i < slist.length (); i++) + { + if (slist (i).string_value () == match) + { + retval = slist(i).string_value (); + break; + } + } + + return retval; +} + + +bp_table::fname_line_map +bp_table::do_get_breakpoint_list (const octave_value_list& fname_list) +{ + fname_line_map retval; + + for (bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) + { + if (fname_list.length () == 0 + || do_find_bkpt_list (fname_list, *it) != "") + { + octave_user_code *f = get_user_code (*it); + + if (f) + { + tree_statement_list *cmds = f->body (); + + if (cmds) + { + octave_value_list bkpts = cmds->list_breakpoints (); + octave_idx_type len = bkpts.length (); + + if (len > 0) + { + bp_table::intmap bkpts_vec; + + for (int i = 0; i < len; i++) + bkpts_vec[i] = bkpts (i).double_value (); + + std::string symbol_name = f->name (); + + retval[symbol_name] = bkpts_vec; + } + } + } + } + } + + return retval; +} + +static octave_value +intmap_to_ov (const bp_table::intmap& line) +{ + int idx = 0; + + NDArray retval (dim_vector (1, line.size ())); + + for (size_t i = 0; i < line.size (); i++) + { + bp_table::const_intmap_iterator p = line.find (i); + + if (p != line.end ()) + { + int lineno = p->second; + retval(idx++) = lineno; + } + } + + retval.resize (dim_vector (1, idx)); + + return retval; +} + +DEFUN (dbstop, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\")\n\ +@deftypefnx {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\", @var{line}, @dots{})\n\ +Set a breakpoint in function @var{func}.\n\ +\n\ +Arguments are\n\ +\n\ +@table @var\n\ +@item func\n\ +Function name as a string variable. When already in debug\n\ +mode this should be left out and only the line should be given.\n\ +\n\ +@item line\n\ +Line number where the breakpoint should be set. Multiple\n\ +lines may be given as separate arguments or as a vector.\n\ +@end table\n\ +\n\ +When called with a single argument @var{func}, the breakpoint\n\ +is set at the first executable line in the named function.\n\ +\n\ +The optional output @var{rline} is the real line number where the\n\ +breakpoint was set. This can differ from specified line if\n\ +the line is not executable. For example, if a breakpoint attempted on a\n\ +blank line then Octave will set the real breakpoint at the\n\ +next executable line.\n\ +@seealso{dbclear, dbstatus, dbstep, debug_on_error, debug_on_warning, debug_on_interrupt}\n\ +@end deftypefn") +{ + bp_table::intmap retval; + std::string symbol_name; + bp_table::intmap lines; + + parse_dbfunction_params ("dbstop", args, symbol_name, lines); + + if (lines.size () == 0) + lines[0] = 1; + + if (! error_state) + retval = bp_table::add_breakpoint (symbol_name, lines); + + return intmap_to_ov (retval); +} + +DEFUN (dbclear, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbclear (\"@var{func}\")\n\ +@deftypefnx {Built-in Function} {} dbclear (\"@var{func}\", @var{line}, @dots{})\n\ +Delete a breakpoint in the function @var{func}.\n\ +\n\ +Arguments are\n\ +\n\ +@table @var\n\ +@item func\n\ +Function name as a string variable. When already in debug\n\ +mode this should be left out and only the line should be given.\n\ +\n\ +@item line\n\ +Line number from which to remove a breakpoint. Multiple\n\ +lines may be given as separate arguments or as a vector.\n\ +@end table\n\ +\n\ +When called without a line number specification all breakpoints\n\ +in the named function are cleared.\n\ +\n\ +If the requested line is not a breakpoint no action is performed.\n\ +@seealso{dbstop, dbstatus, dbwhere}\n\ +@end deftypefn") +{ + octave_value retval; + std::string symbol_name = ""; + bp_table::intmap lines; + + parse_dbfunction_params ("dbclear", args, symbol_name, lines); + + if (! error_state) + bp_table::remove_breakpoint (symbol_name, lines); + + return retval; +} + +DEFUN (dbstatus, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbstatus ()\n\ +@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus ()\n\ +@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus (\"@var{func}\")\n\ +Report the location of active breakpoints.\n\ +\n\ +When called with no input or output arguments, print the list of\n\ +all functions with breakpoints and the line numbers where those\n\ +breakpoints are set.\n\ +If a function name @var{func} is specified then only report breakpoints\n\ +for the named function.\n\ +\n\ +The optional return argument @var{brk_list} is a struct array with the\n\ +following fields.\n\ +\n\ +@table @asis\n\ +@item name\n\ +The name of the function with a breakpoint.\n\ +\n\ +@item file\n\ +The name of the m-file where the function code is located.\n\ +\n\ +@item line\n\ +A line number, or vector of line numbers, with a breakpoint.\n\ +@end table\n\ +\n\ +@seealso{dbclear, dbwhere}\n\ +@end deftypefn") +{ + octave_map retval; + int nargin = args.length (); + octave_value_list fcn_list; + bp_table::fname_line_map bp_list; + std::string symbol_name; + + if (nargin != 0 && nargin != 1) + { + error ("dbstatus: only zero or one arguments accepted\n"); + return octave_value (); + } + + if (nargin == 1) + { + if (args(0).is_string ()) + { + symbol_name = args(0).string_value (); + fcn_list(0) = symbol_name; + bp_list = bp_table::get_breakpoint_list (fcn_list); + } + else + gripe_wrong_type_arg ("dbstatus", args(0)); + } + else + { + octave_user_code *dbg_fcn = get_user_code (); + if (dbg_fcn) + { + symbol_name = dbg_fcn->name (); + fcn_list(0) = symbol_name; + } + + bp_list = bp_table::get_breakpoint_list (fcn_list); + } + + if (nargout == 0) + { + // Print out the breakpoint information. + + for (bp_table::fname_line_map_iterator it = bp_list.begin (); + it != bp_list.end (); it++) + { + bp_table::intmap m = it->second; + + size_t nel = m.size (); + + octave_stdout << "breakpoint in " << it->first; + if (nel > 1) + octave_stdout << " at lines "; + else + octave_stdout << " at line "; + + for (size_t j = 0; j < nel; j++) + octave_stdout << m[j] << ((j < nel - 1) ? ", " : "."); + + if (nel > 0) + octave_stdout << std::endl; + } + return octave_value (); + } + else + { + // Fill in an array for return. + + int i = 0; + Cell names (dim_vector (bp_list.size (), 1)); + Cell file (dim_vector (bp_list.size (), 1)); + Cell line (dim_vector (bp_list.size (), 1)); + + for (bp_table::const_fname_line_map_iterator it = bp_list.begin (); + it != bp_list.end (); it++) + { + names(i) = it->first; + line(i) = intmap_to_ov (it->second); + file(i) = do_which (it->first); + i++; + } + + retval.assign ("name", names); + retval.assign ("file", file); + retval.assign ("line", line); + + return octave_value (retval); + } +} + +DEFUN (dbwhere, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbwhere ()\n\ +In debugging mode, report the current file and line number where\n\ +execution is stopped.\n\ +@seealso{dbstatus, dbcont, dbstep, dbup}\n\ +@end deftypefn") +{ + octave_value retval; + + octave_user_code *dbg_fcn = get_user_code (); + + if (dbg_fcn) + { + bool have_file = true; + + std::string name = dbg_fcn->fcn_file_name (); + + if (name.empty ()) + { + have_file = false; + + name = dbg_fcn->name (); + } + + octave_stdout << "stopped in " << name << " at "; + + int l = octave_call_stack::caller_user_code_line (); + + if (l > 0) + { + octave_stdout << " line " << l << std::endl; + + if (have_file) + { + std::string line = get_file_line (name, l); + + if (! line.empty ()) + octave_stdout << l << ": " << line << std::endl; + } + } + else + octave_stdout << " " << std::endl; + } + else + error ("dbwhere: must be inside a user function to use dbwhere\n"); + + return retval; +} + +// Copied and modified from the do_type command in help.cc +// Maybe we could share some code? +void +do_dbtype (std::ostream& os, const std::string& name, int start, int end) +{ + std::string ff = fcn_file_in_path (name); + + if (! ff.empty ()) + { + std::ifstream fs (ff.c_str (), std::ios::in); + + if (fs) + { + char ch; + int line = 1; + + if (line >= start && line <= end) + os << line << "\t"; + + while (fs.get (ch)) + { + if (line >= start && line <= end) + { + os << ch; + } + + if (ch == '\n') + { + line++; + if (line >= start && line <= end) + os << line << "\t"; + } + } + } + else + os << "dbtype: unable to open `" << ff << "' for reading!\n"; + } + else + os << "dbtype: unknown function " << name << "\n"; + + os.flush (); +} + +DEFUN (dbtype, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbtype ()\n\ +@deftypefnx {Built-in Function} {} dbtype (\"startl:endl\")\n\ +@deftypefnx {Built-in Function} {} dbtype (\"startl:end\")\n\ +@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\")\n\ +@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl\")\n\ +@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl:endl\")\n\ +@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl:end\")\n\ +When in debugging mode and called with no arguments, list the script file\n\ +being debugged with line numbers. An optional range specification,\n\ +specified as a string, can be used to list only a portion of the file.\n\ +The special keyword \"end\" is a valid line number specification.\n\ +\n\ +When called with the name of a function, list that script file\n\ +with line numbers.\n\ +@seealso{dbstatus, dbstop}\n\ +@end deftypefn") +{ + octave_value retval; + octave_user_code *dbg_fcn; + + int nargin = args.length (); + string_vector argv = args.make_argv ("dbtype"); + + if (! error_state) + { + switch (nargin) + { + case 0: // dbtype + dbg_fcn = get_user_code (); + + if (dbg_fcn) + do_dbtype (octave_stdout, dbg_fcn->name (), 0, INT_MAX); + else + error ("dbtype: must be inside a user function to give no arguments to dbtype\n"); + break; + + case 1: // (dbtype func) || (dbtype start:end) + { + std::string arg = argv[1]; + + size_t ind = arg.find (':'); + + if (ind != std::string::npos) // (dbtype start:end) + { + dbg_fcn = get_user_code (); + + if (dbg_fcn) + { + std::string start_str = arg.substr (0, ind); + std::string end_str = arg.substr (ind + 1); + + int start, end; + start = atoi (start_str.c_str ()); + if (end_str == "end") + end = INT_MAX; + else + end = atoi (end_str.c_str ()); + + if (std::min (start, end) <= 0) + error ("dbtype: start and end lines must be >= 1\n"); + + if (start <= end) + do_dbtype (octave_stdout, dbg_fcn->name (), start, end); + else + error ("dbtype: start line must be less than end line\n"); + } + } + else // (dbtype func) + { + dbg_fcn = get_user_code (arg); + + if (dbg_fcn) + do_dbtype (octave_stdout, dbg_fcn->name (), 0, INT_MAX); + else + error ("dbtype: function <%s> not found\n", arg.c_str ()); + } + } + break; + + case 2: // (dbtype func start:end) , (dbtype func start) + dbg_fcn = get_user_code (argv[1]); + + if (dbg_fcn) + { + std::string arg = argv[2]; + int start, end; + size_t ind = arg.find (':'); + + if (ind != std::string::npos) + { + std::string start_str = arg.substr (0, ind); + std::string end_str = arg.substr (ind + 1); + + start = atoi (start_str.c_str ()); + if (end_str == "end") + end = INT_MAX; + else + end = atoi (end_str.c_str ()); + } + else + { + start = atoi (arg.c_str ()); + end = start; + } + + if (std::min (start, end) <= 0) + error ("dbtype: start and end lines must be >= 1\n"); + + if (start <= end) + do_dbtype (octave_stdout, dbg_fcn->name (), start, end); + else + error ("dbtype: start line must be less than end line\n"); + } + else + error ("dbtype: function <%s> not found\n", argv[1].c_str ()); + + break; + + default: + error ("dbtype: expecting zero, one, or two arguments\n"); + } + } + + return retval; +} + +static octave_value_list +do_dbstack (const octave_value_list& args, int nargout, std::ostream& os) +{ + octave_value_list retval; + + unwind_protect frame; + + octave_idx_type curr_frame = -1; + + size_t nskip = 0; + + if (args.length () == 1) + { + int n = 0; + + octave_value arg = args(0); + + if (arg.is_string ()) + { + std::string s_arg = arg.string_value (); + + n = atoi (s_arg.c_str ()); + } + else + n = args(0).int_value (); + + if (n > 0) + nskip = n; + else + error ("dbstack: N must be a non-negative integer"); + } + + if (! error_state) + { + octave_map stk = octave_call_stack::backtrace (nskip, curr_frame); + + if (nargout == 0) + { + octave_idx_type nframes_to_display = stk.numel (); + + if (nframes_to_display > 0) + { + os << "stopped in:\n\n"; + + Cell names = stk.contents ("name"); + Cell files = stk.contents ("file"); + Cell lines = stk.contents ("line"); + + bool show_top_level = true; + + size_t max_name_len = 0; + + for (octave_idx_type i = 0; i < nframes_to_display; i++) + { + std::string name = names(i).string_value (); + + max_name_len = std::max (name.length (), max_name_len); + } + + for (octave_idx_type i = 0; i < nframes_to_display; i++) + { + std::string name = names(i).string_value (); + std::string file = files(i).string_value (); + int line = lines(i).int_value (); + + if (show_top_level && i == curr_frame) + show_top_level = false; + + os << (i == curr_frame ? " --> " : " ") + << std::setw (max_name_len) << name + << " at line " << line + << " [" << file << "]" + << std::endl; + } + + if (show_top_level) + os << " --> top level" << std::endl; + } + } + else + { + retval(1) = curr_frame < 0 ? 1 : curr_frame + 1; + retval(0) = stk; + } + } + + return retval; +} + +// A function that can be easily called from a debugger print the Octave +// stack. This can be useful for finding what line of code the +// interpreter is currently executing when the debugger is stopped in +// some C++ function, for example. + +void +show_octave_dbstack (void) +{ + do_dbstack (octave_value_list (), 0, std::cerr); +} + +DEFUN (dbstack, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbstack ()\n\ +@deftypefnx {Built-in Function} {} dbstack (@var{n})\n\ +@deftypefnx {Built-in Function} {[@var{stack}, @var{idx}] =} dbstack (@dots{})\n\ +Display or return current debugging function stack information.\n\ +With optional argument @var{n}, omit the @var{n} innermost stack frames.\n\ +\n\ +The optional return argument @var{stack} is a struct array with the\n\ +following fields:\n\ +\n\ +@table @asis\n\ +@item file\n\ +The name of the m-file where the function code is located.\n\ +\n\ +@item name\n\ +The name of the function with a breakpoint.\n\ +\n\ +@item line\n\ +The line number of an active breakpoint.\n\ +\n\ +@item column\n\ +The column number of the line where the breakpoint begins.\n\ +\n\ +@item scope\n\ +Undocumented.\n\ +\n\ +@item context\n\ +Undocumented.\n\ +@end table\n\ +\n\ +The return argument @var{idx} specifies which element of the @var{stack}\n\ +struct array is currently active.\n\ +@seealso{dbup, dbdown, dbwhere, dbstatus}\n\ +@end deftypefn") +{ + return do_dbstack (args, nargout, octave_stdout); +} + +static void +do_dbupdown (const octave_value_list& args, const std::string& who) +{ + int n = 1; + + if (args.length () == 1) + { + octave_value arg = args(0); + + if (arg.is_string ()) + { + std::string s_arg = arg.string_value (); + + n = atoi (s_arg.c_str ()); + } + else + n = args(0).int_value (); + } + + if (! error_state) + { + if (who == "dbup") + n = -n; + + if (! octave_call_stack::goto_frame_relative (n, true)) + error ("%s: invalid stack frame", who.c_str ()); + } +} + +DEFUN (dbup, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbup\n\ +@deftypefnx {Built-in Function} {} dbup (@var{n})\n\ +In debugging mode, move up the execution stack @var{n} frames.\n\ +If @var{n} is omitted, move up one frame.\n\ +@seealso{dbstack, dbdown}\n\ +@end deftypefn") +{ + octave_value retval; + + do_dbupdown (args, "dbup"); + + return retval; +} + +DEFUN (dbdown, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbdown\n\ +@deftypefnx {Built-in Function} {} dbdown (@var{n})\n\ +In debugging mode, move down the execution stack @var{n} frames.\n\ +If @var{n} is omitted, move down one frame.\n\ +@seealso{dbstack, dbup}\n\ +@end deftypefn") +{ + octave_value retval; + + do_dbupdown (args, "dbdown"); + + return retval; +} + +DEFUN (dbstep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbstep\n\ +@deftypefnx {Command} {} dbstep @var{n}\n\ +@deftypefnx {Command} {} dbstep in\n\ +@deftypefnx {Command} {} dbstep out\n\ +@deftypefnx {Command} {} dbnext @dots{}\n\ +In debugging mode, execute the next @var{n} lines of code.\n\ +If @var{n} is omitted, execute the next single line of code.\n\ +If the next line of code is itself defined in terms of an m-file remain in\n\ +the existing function.\n\ +\n\ +Using @code{dbstep in} will cause execution of the next line to step into\n\ +any m-files defined on the next line. Using @code{dbstep out} will cause\n\ +execution to continue until the current function returns.\n\ +\n\ +@code{dbnext} is an alias for @code{dbstep}.\n\ +@seealso{dbcont, dbquit}\n\ +@end deftypefn") +{ + if (Vdebugging) + { + int nargin = args.length (); + + if (nargin > 1) + print_usage (); + else if (nargin == 1) + { + if (args(0).is_string ()) + { + std::string arg = args(0).string_value (); + + if (! error_state) + { + if (arg == "in") + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = -1; + } + else if (arg == "out") + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = -2; + } + else + { + int n = atoi (arg.c_str ()); + + if (n > 0) + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = n; + } + else + error ("dbstep: invalid argument"); + } + } + } + else + error ("dbstep: input argument must be a character string"); + } + else + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = 1; + } + } + else + error ("dbstep: can only be called in debug mode"); + + return octave_value_list (); +} + +DEFALIAS (dbnext, dbstep); + +DEFUN (dbcont, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbcont\n\ +Leave command-line debugging mode and continue code execution normally.\n\ +@seealso{dbstep, dbquit}\n\ +@end deftypefn") +{ + if (Vdebugging) + { + if (args.length () == 0) + { + Vdebugging = false; + + tree_evaluator::reset_debug_state (); + } + else + print_usage (); + } + else + error ("dbcont: can only be called in debug mode"); + + return octave_value_list (); +} + +DEFUN (dbquit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbquit\n\ +Quit debugging mode immediately without further code execution and\n\ +return to the Octave prompt.\n\ +@seealso{dbcont, dbstep}\n\ +@end deftypefn") +{ + if (Vdebugging) + { + if (args.length () == 0) + { + Vdebugging = false; + + tree_evaluator::reset_debug_state (); + + octave_throw_interrupt_exception (); + } + else + print_usage (); + } + else + error ("dbquit: can only be called in debug mode"); + + return octave_value_list (); +} + +DEFUN (isdebugmode, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isdebugmode ()\n\ +Return true if in debugging mode, otherwise false.\n\ +@seealso{dbwhere, dbstack, dbstatus}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = Vdebugging; + else + print_usage (); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/debug.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/debug.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,134 @@ +/* + +Copyright (C) 2001-2012 Ben Sapp + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_debug_h) +#define octave_debug_h 1 + +#include +#include +#include "ov.h" +#include "dRowVector.h" + +class octave_value_list; +class octave_user_code; + +// Interface to breakpoints,. + +class +OCTINTERP_API +bp_table +{ +private: + + bp_table (void) : bp_set () { } + + ~bp_table (void) { } + +public: + + typedef std::map intmap; + + typedef intmap::const_iterator const_intmap_iterator; + typedef intmap::iterator intmap_iterator; + + typedef std::map fname_line_map; + + typedef fname_line_map::const_iterator const_fname_line_map_iterator; + typedef fname_line_map::iterator fname_line_map_iterator; + + static bool instance_ok (void); + + // Add a breakpoint at the nearest executable line. + static intmap add_breakpoint (const std::string& fname = "", + const intmap& lines = intmap ()) + { + return instance_ok () + ? instance->do_add_breakpoint (fname, lines) : intmap (); + } + + // Remove a breakpoint from a line in file. + static int remove_breakpoint (const std::string& fname = "", + const intmap& lines = intmap ()) + { + return instance_ok () + ? instance->do_remove_breakpoint (fname, lines) : 0; + } + + // Remove all the breakpoints in a specified file. + static intmap remove_all_breakpoints_in_file (const std::string& fname, + bool silent = false) + { + return instance_ok () + ? instance->do_remove_all_breakpoints_in_file (fname, silent) : intmap (); + } + + // Remove all the breakpoints registered with octave. + static void remove_all_breakpoints (void) + { + if (instance_ok ()) + instance->do_remove_all_breakpoints (); + } + + // Return all breakpoints. Each element of the map is a vector + // containing the breakpoints corresponding to a given function name. + static fname_line_map + get_breakpoint_list (const octave_value_list& fname_list) + { + return instance_ok () + ? instance->do_get_breakpoint_list (fname_list) : fname_line_map (); + } + + static bool + have_breakpoints (void) + { + return instance_ok () ? instance->do_have_breakpoints () : 0; + } + +private: + + typedef std::set::const_iterator const_bp_set_iterator; + typedef std::set::iterator bp_set_iterator; + + // Set of function names containing at least one breakpoint. + std::set bp_set; + + static bp_table *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + intmap do_add_breakpoint (const std::string& fname, const intmap& lines); + + int do_remove_breakpoint (const std::string&, const intmap& lines); + + intmap do_remove_all_breakpoints_in_file (const std::string& fname, + bool silent); + + void do_remove_all_breakpoints (void); + + fname_line_map do_get_breakpoint_list (const octave_value_list& fname_list); + + bool do_have_breakpoints (void) { return (! bp_set.empty ()); } +}; + +std::string get_file_line (const std::string& fname, size_t line); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/defaults.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/defaults.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,557 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include +#include + +#include +#include + +#include "dir-ops.h" +#include "oct-env.h" +#include "file-stat.h" +#include "pathsearch.h" +#include "str-vec.h" + +#include +#include "defun.h" +#include "error.h" +#include "file-ops.h" +#include "gripes.h" +#include "help.h" +#include "input.h" +#include "load-path.h" +#include "oct-obj.h" +#include "ov.h" +#include "parse.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "variables.h" +#include + +std::string Voctave_home; + +std::string Vbin_dir; +std::string Vinfo_dir; +std::string Vdata_dir; +std::string Vlibexec_dir; +std::string Varch_lib_dir; +std::string Vlocal_arch_lib_dir; +std::string Vlocal_api_arch_lib_dir; +std::string Vlocal_ver_arch_lib_dir; + +std::string Vlocal_ver_oct_file_dir; +std::string Vlocal_api_oct_file_dir; +std::string Vlocal_oct_file_dir; + +std::string Vlocal_ver_fcn_file_dir; +std::string Vlocal_api_fcn_file_dir; +std::string Vlocal_fcn_file_dir; + +std::string Voct_file_dir; +std::string Vfcn_file_dir; + +std::string Vimage_dir; + +// The path that will be searched for programs that we execute. +// (--exec-path path) +static std::string VEXEC_PATH; + +// Name of the editor to be invoked by the edit_history command. +std::string VEDITOR; + +static std::string VIMAGE_PATH; + +std::string Vlocal_site_defaults_file; +std::string Vsite_defaults_file; + +std::string +subst_octave_home (const std::string& s) +{ + std::string retval; + + std::string prefix = OCTAVE_PREFIX; + + retval = s; + + if (Voctave_home != prefix) + { + octave_idx_type len = prefix.length (); + + if (s.substr (0, len) == prefix) + retval.replace (0, len, Voctave_home); + } + + if (file_ops::dir_sep_char () != '/') + std::replace (retval.begin (), retval.end (), '/', + file_ops::dir_sep_char ()); + + return retval; +} + +static void +set_octave_home (void) +{ + std::string oh = octave_env::getenv ("OCTAVE_HOME"); + + Voctave_home = oh.empty () ? std::string (OCTAVE_PREFIX) : oh; +} + +static void +set_default_info_dir (void) +{ + Vinfo_dir = subst_octave_home (OCTAVE_INFODIR); +} + +static void +set_default_data_dir (void) +{ + Vdata_dir = subst_octave_home (OCTAVE_DATADIR); +} + +static void +set_default_libexec_dir (void) +{ + Vlibexec_dir = subst_octave_home (OCTAVE_LIBEXECDIR); +} + +static void +set_default_arch_lib_dir (void) +{ + Varch_lib_dir = subst_octave_home (OCTAVE_ARCHLIBDIR); +} + +static void +set_default_local_arch_lib_dir (void) +{ + Vlocal_arch_lib_dir = subst_octave_home (OCTAVE_LOCALARCHLIBDIR); +} + +static void +set_default_local_api_arch_lib_dir (void) +{ + Vlocal_api_arch_lib_dir = subst_octave_home (OCTAVE_LOCALAPIARCHLIBDIR); +} + +static void +set_default_local_ver_arch_lib_dir (void) +{ + Vlocal_ver_arch_lib_dir = subst_octave_home (OCTAVE_LOCALVERARCHLIBDIR); +} + +static void +set_default_local_ver_oct_file_dir (void) +{ + Vlocal_ver_oct_file_dir = subst_octave_home (OCTAVE_LOCALVEROCTFILEDIR); +} + +static void +set_default_local_api_oct_file_dir (void) +{ + Vlocal_api_oct_file_dir = subst_octave_home (OCTAVE_LOCALAPIOCTFILEDIR); +} + +static void +set_default_local_oct_file_dir (void) +{ + Vlocal_oct_file_dir = subst_octave_home (OCTAVE_LOCALOCTFILEDIR); +} + +static void +set_default_local_ver_fcn_file_dir (void) +{ + Vlocal_ver_fcn_file_dir = subst_octave_home (OCTAVE_LOCALVERFCNFILEDIR); +} + +static void +set_default_local_api_fcn_file_dir (void) +{ + Vlocal_api_fcn_file_dir = subst_octave_home (OCTAVE_LOCALAPIFCNFILEDIR); +} + +static void +set_default_local_fcn_file_dir (void) +{ + Vlocal_fcn_file_dir = subst_octave_home (OCTAVE_LOCALFCNFILEDIR); +} + +static void +set_default_fcn_file_dir (void) +{ + Vfcn_file_dir = subst_octave_home (OCTAVE_FCNFILEDIR); +} + +static void +set_default_image_dir (void) +{ + Vimage_dir = subst_octave_home (OCTAVE_IMAGEDIR); +} + +static void +set_default_oct_file_dir (void) +{ + Voct_file_dir = subst_octave_home (OCTAVE_OCTFILEDIR); +} + +static void +set_default_bin_dir (void) +{ + Vbin_dir = subst_octave_home (OCTAVE_BINDIR); +} + +void +set_exec_path (const std::string& path_arg) +{ + std::string tpath = path_arg; + + if (tpath.empty ()) + tpath = octave_env::getenv ("OCTAVE_EXEC_PATH"); + + if (tpath.empty ()) + tpath = Vlocal_ver_arch_lib_dir + dir_path::path_sep_str () + + Vlocal_api_arch_lib_dir + dir_path::path_sep_str () + + Vlocal_arch_lib_dir + dir_path::path_sep_str () + + Varch_lib_dir + dir_path::path_sep_str () + + Vbin_dir; + + VEXEC_PATH = tpath; + + // FIXME -- should we really be modifying PATH in the environment? + // The way things are now, Octave will ignore directories set in the + // PATH with calls like + // + // setenv ("PATH", "/my/path"); + // + // To fix this, I think Octave should be searching the combination of + // PATH and EXEC_PATH for programs that it executes instead of setting + // the PATH in the environment and relying on the shell to do the + // searching. + + // This is static so that even if set_exec_path is called more than + // once, shell_path is the original PATH from the environment, + // before we start modifying it. + static std::string shell_path = octave_env::getenv ("PATH"); + + if (! shell_path.empty ()) + tpath = shell_path + dir_path::path_sep_str () + tpath; + + octave_env::putenv ("PATH", tpath); +} + +void +set_image_path (const std::string& path) +{ + VIMAGE_PATH = "."; + + std::string tpath = path; + + if (tpath.empty ()) + tpath = octave_env::getenv ("OCTAVE_IMAGE_PATH"); + + if (! tpath.empty ()) + VIMAGE_PATH += dir_path::path_sep_str () + tpath; + + tpath = genpath (Vimage_dir, ""); + + if (! tpath.empty ()) + VIMAGE_PATH += dir_path::path_sep_str () + tpath; +} + +static void +set_default_doc_cache_file (void) +{ + std::string def_file = subst_octave_home (OCTAVE_DOC_CACHE_FILE); + + std::string env_file = octave_env::getenv ("OCTAVE_DOC_CACHE_FILE"); + + Vdoc_cache_file = env_file.empty () ? def_file : env_file; +} + +static void +set_default_texi_macros_file (void) +{ + std::string def_file = subst_octave_home (OCTAVE_TEXI_MACROS_FILE); + + std::string env_file = octave_env::getenv ("OCTAVE_TEXI_MACROS_FILE"); + + Vtexi_macros_file = env_file.empty () ? def_file : env_file; +} + +static void +set_default_info_file (void) +{ + std::string std_info_file = subst_octave_home (OCTAVE_INFOFILE); + + std::string oct_info_file = octave_env::getenv ("OCTAVE_INFO_FILE"); + + Vinfo_file = oct_info_file.empty () ? std_info_file : oct_info_file; +} + +static void +set_default_info_prog (void) +{ + std::string oct_info_prog = octave_env::getenv ("OCTAVE_INFO_PROGRAM"); + + if (oct_info_prog.empty ()) + Vinfo_program = "info"; + else + Vinfo_program = std::string (oct_info_prog); +} + +static void +set_default_editor (void) +{ + VEDITOR = "emacs"; + + std::string env_editor = octave_env::getenv ("EDITOR"); + + if (! env_editor.empty ()) + VEDITOR = env_editor; +} + +static void +set_local_site_defaults_file (void) +{ + std::string lsf = octave_env::getenv ("OCTAVE_SITE_INITFILE"); + + if (lsf.empty ()) + { + Vlocal_site_defaults_file = subst_octave_home (OCTAVE_LOCALSTARTUPFILEDIR); + Vlocal_site_defaults_file.append ("/octaverc"); + } + else + Vlocal_site_defaults_file = lsf; +} + +static void +set_site_defaults_file (void) +{ + std::string sf = octave_env::getenv ("OCTAVE_VERSION_INITFILE"); + + if (sf.empty ()) + { + Vsite_defaults_file = subst_octave_home (OCTAVE_STARTUPFILEDIR); + Vsite_defaults_file.append ("/octaverc"); + } + else + Vsite_defaults_file = sf; +} + +void +install_defaults (void) +{ + // OCTAVE_HOME must be set first! + + set_octave_home (); + + set_default_info_dir (); + + set_default_data_dir (); + + set_default_libexec_dir (); + + set_default_arch_lib_dir (); + + set_default_local_ver_arch_lib_dir (); + set_default_local_api_arch_lib_dir (); + set_default_local_arch_lib_dir (); + + set_default_local_ver_oct_file_dir (); + set_default_local_api_oct_file_dir (); + set_default_local_oct_file_dir (); + + set_default_local_ver_fcn_file_dir (); + set_default_local_api_fcn_file_dir (); + set_default_local_fcn_file_dir (); + + set_default_fcn_file_dir (); + set_default_oct_file_dir (); + + set_default_image_dir (); + + set_default_bin_dir (); + + set_exec_path (); + + set_image_path (); + + set_default_doc_cache_file (); + + set_default_texi_macros_file (); + + set_default_info_file (); + + set_default_info_prog (); + + set_default_editor (); + + set_local_site_defaults_file (); + + set_site_defaults_file (); +} + +DEFUN (EDITOR, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} EDITOR ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} EDITOR (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} EDITOR (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the editor to\n\ +use with the @code{edit_history} command. The default value is taken from\n\ +the environment variable @w{@env{EDITOR}} when Octave starts. If the\n\ +environment variable is not initialized, @w{@env{EDITOR}} will be set to\n\ +@code{\"emacs\"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{edit_history}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EDITOR); +} + +/* +%!test +%! orig_val = EDITOR (); +%! old_val = EDITOR ("X"); +%! assert (orig_val, old_val); +%! assert (EDITOR (), "X"); +%! EDITOR (orig_val); +%! assert (EDITOR (), orig_val); + +%!error (EDITOR (1, 2)) +*/ + +DEFUN (EXEC_PATH, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} EXEC_PATH ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} EXEC_PATH (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} EXEC_PATH (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies a colon separated\n\ +list of directories to append to the shell PATH when executing external\n\ +programs. The initial value of is taken from the environment variable\n\ +@w{@env{OCTAVE_EXEC_PATH}}, but that value can be overridden by\n\ +the command line argument @option{--exec-path PATH}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + octave_value retval = SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EXEC_PATH); + + if (args.length () > 0) + set_exec_path (VEXEC_PATH); + + return retval; +} + +/* +%!test +%! orig_val = EXEC_PATH (); +%! old_val = EXEC_PATH ("X"); +%! assert (orig_val, old_val); +%! assert (EXEC_PATH (), "X"); +%! EXEC_PATH (orig_val); +%! assert (EXEC_PATH (), orig_val); + +%!error (EXEC_PATH (1, 2)) +*/ + +DEFUN (IMAGE_PATH, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} IMAGE_PATH ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} IMAGE_PATH (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} IMAGE_PATH (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies a colon separated\n\ +list of directories in which to search for image files.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (IMAGE_PATH); +} + +/* +%!test +%! orig_val = IMAGE_PATH (); +%! old_val = IMAGE_PATH ("X"); +%! assert (orig_val, old_val); +%! assert (IMAGE_PATH (), "X"); +%! IMAGE_PATH (orig_val); +%! assert (IMAGE_PATH (), orig_val); + +%!error (IMAGE_PATH (1, 2)) +*/ + +DEFUN (OCTAVE_HOME, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} OCTAVE_HOME ()\n\ +Return the name of the top-level Octave installation directory.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = Voctave_home; + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar (OCTAVE_HOME ())) +%!error OCTAVE_HOME (1) +*/ + +DEFUNX ("OCTAVE_VERSION", FOCTAVE_VERSION, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} OCTAVE_VERSION ()\n\ +Return the version number of Octave, as a string.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = OCTAVE_VERSION; + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar (OCTAVE_VERSION ())) +%!error OCTAVE_VERSION (1) +*/ diff -r d02b229ce693 -r a132d206a36a src/interpfcn/defaults.in.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/defaults.in.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,218 @@ +// DO NOT EDIT! Generated automatically from defaults.in.h by configure +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_defaults_h) +#define octave_defaults_h 1 + +#include + +#include "pathsearch.h" + +#ifndef OCTAVE_CANONICAL_HOST_TYPE +#define OCTAVE_CANONICAL_HOST_TYPE %OCTAVE_CANONICAL_HOST_TYPE% +#endif + +#ifndef OCTAVE_DEFAULT_PAGER +#define OCTAVE_DEFAULT_PAGER %OCTAVE_DEFAULT_PAGER% +#endif + +#ifndef OCTAVE_ARCHLIBDIR +#define OCTAVE_ARCHLIBDIR %OCTAVE_ARCHLIBDIR% +#endif + +#ifndef OCTAVE_BINDIR +#define OCTAVE_BINDIR %OCTAVE_BINDIR% +#endif + +#ifndef OCTAVE_DATADIR +#define OCTAVE_DATADIR %OCTAVE_DATADIR% +#endif + +#ifndef OCTAVE_DATAROOTDIR +#define OCTAVE_DATAROOTDIR %OCTAVE_DATAROOTDIR% +#endif + +#ifndef OCTAVE_DOC_CACHE_FILE +#define OCTAVE_DOC_CACHE_FILE %OCTAVE_DOC_CACHE_FILE% +#endif + +#ifndef OCTAVE_TEXI_MACROS_FILE +#define OCTAVE_TEXI_MACROS_FILE %OCTAVE_TEXI_MACROS_FILE% +#endif + +#ifndef OCTAVE_EXEC_PREFIX +#define OCTAVE_EXEC_PREFIX %OCTAVE_EXEC_PREFIX% +#endif + +#ifndef OCTAVE_FCNFILEDIR +#define OCTAVE_FCNFILEDIR %OCTAVE_FCNFILEDIR% +#endif + +#ifndef OCTAVE_IMAGEDIR +#define OCTAVE_IMAGEDIR %OCTAVE_IMAGEDIR% +#endif + +#ifndef OCTAVE_INCLUDEDIR +#define OCTAVE_INCLUDEDIR %OCTAVE_INCLUDEDIR% +#endif + +#ifndef OCTAVE_INFODIR +#define OCTAVE_INFODIR %OCTAVE_INFODIR% +#endif + +#ifndef OCTAVE_INFOFILE +#define OCTAVE_INFOFILE %OCTAVE_INFOFILE% +#endif + +#ifndef OCTAVE_LIBDIR +#define OCTAVE_LIBDIR %OCTAVE_LIBDIR% +#endif + +#ifndef OCTAVE_LIBEXECDIR +#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% +#endif + +#ifndef OCTAVE_LIBEXECDIR +#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% +#endif + +#ifndef OCTAVE_LOCALAPIFCNFILEDIR +#define OCTAVE_LOCALAPIFCNFILEDIR %OCTAVE_LOCALAPIFCNFILEDIR% +#endif + +#ifndef OCTAVE_LOCALAPIOCTFILEDIR +#define OCTAVE_LOCALAPIOCTFILEDIR %OCTAVE_LOCALAPIOCTFILEDIR% +#endif + +#ifndef OCTAVE_LOCALARCHLIBDIR +#define OCTAVE_LOCALARCHLIBDIR %OCTAVE_LOCALARCHLIBDIR% +#endif + +#ifndef OCTAVE_LOCALFCNFILEDIR +#define OCTAVE_LOCALFCNFILEDIR %OCTAVE_LOCALFCNFILEDIR% +#endif + +#ifndef OCTAVE_LOCALOCTFILEDIR +#define OCTAVE_LOCALOCTFILEDIR %OCTAVE_LOCALOCTFILEDIR% +#endif + +#ifndef OCTAVE_LOCALSTARTUPFILEDIR +#define OCTAVE_LOCALSTARTUPFILEDIR %OCTAVE_LOCALSTARTUPFILEDIR% +#endif + +#ifndef OCTAVE_LOCALAPIARCHLIBDIR +#define OCTAVE_LOCALAPIARCHLIBDIR %OCTAVE_LOCALAPIARCHLIBDIR% +#endif + +#ifndef OCTAVE_LOCALVERARCHLIBDIR +#define OCTAVE_LOCALVERARCHLIBDIR %OCTAVE_LOCALVERARCHLIBDIR% +#endif + +#ifndef OCTAVE_LOCALVERFCNFILEDIR +#define OCTAVE_LOCALVERFCNFILEDIR %OCTAVE_LOCALVERFCNFILEDIR% +#endif + +#ifndef OCTAVE_LOCALVEROCTFILEDIR +#define OCTAVE_LOCALVEROCTFILEDIR %OCTAVE_LOCALVEROCTFILEDIR% +#endif + +#ifndef OCTAVE_MAN1DIR +#define OCTAVE_MAN1DIR %OCTAVE_MAN1DIR% +#endif + +#ifndef OCTAVE_MAN1EXT +#define OCTAVE_MAN1EXT %OCTAVE_MAN1EXT% +#endif + +#ifndef OCTAVE_MANDIR +#define OCTAVE_MANDIR %OCTAVE_MANDIR% +#endif + +#ifndef OCTAVE_OCTFILEDIR +#define OCTAVE_OCTFILEDIR %OCTAVE_OCTFILEDIR% +#endif + +#ifndef OCTAVE_OCTETCDIR +#define OCTAVE_OCTETCDIR %OCTAVE_OCTETCDIR% +#endif + +#ifndef OCTAVE_OCTINCLUDEDIR +#define OCTAVE_OCTINCLUDEDIR %OCTAVE_OCTINCLUDEDIR% +#endif + +#ifndef OCTAVE_OCTLIBDIR +#define OCTAVE_OCTLIBDIR %OCTAVE_OCTLIBDIR% +#endif + +#ifndef OCTAVE_PREFIX +#define OCTAVE_PREFIX %OCTAVE_PREFIX% +#endif + +#ifndef OCTAVE_STARTUPFILEDIR +#define OCTAVE_STARTUPFILEDIR %OCTAVE_STARTUPFILEDIR% +#endif + +#ifndef OCTAVE_RELEASE +#define OCTAVE_RELEASE %OCTAVE_RELEASE% +#endif + +extern std::string Voctave_home; + +extern std::string Vbin_dir; +extern std::string Vinfo_dir; +extern std::string Vdata_dir; +extern std::string Vlibexec_dir; +extern std::string Varch_lib_dir; +extern std::string Vlocal_arch_lib_dir; +extern std::string Vlocal_ver_arch_lib_dir; + +extern std::string Vlocal_ver_oct_file_dir; +extern std::string Vlocal_api_oct_file_dir; +extern std::string Vlocal_oct_file_dir; + +extern std::string Vlocal_ver_fcn_file_dir; +extern std::string Vlocal_api_fcn_file_dir; +extern std::string Vlocal_fcn_file_dir; + +extern std::string Voct_file_dir; +extern std::string Vfcn_file_dir; + +extern std::string Vimage_dir; + +// Name of the editor to be invoked by the edit_history command. +extern std::string VEDITOR; + +extern std::string Vlocal_site_defaults_file; +extern std::string Vsite_defaults_file; + +// Name of the FFTW wisdom program. +extern OCTINTERP_API std::string Vfftw_wisdom_program; + +extern std::string subst_octave_home (const std::string&); + +extern void install_defaults (void); + +extern void set_exec_path (const std::string& path = std::string ()); +extern void set_image_path (const std::string& path = std::string ()); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/defun.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/defun.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,200 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "defun.h" +#include "dynamic-ld.h" +#include "error.h" +#include "help.h" +#include "ov.h" +#include "ov-builtin.h" +#include "ov-dld-fcn.h" +#include "ov-fcn.h" +#include "ov-mex-fcn.h" +#include "ov-usr-fcn.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "pager.h" +#include "symtab.h" +#include "toplev.h" +#include "variables.h" +#include "parse.h" + +// Print the usage part of the doc string of FCN (user-defined or DEFUN). +void +print_usage (void) +{ + const octave_function *cur = octave_call_stack::current (); + if (cur) + print_usage (cur->name ()); + else + error ("print_usage: invalid function"); +} + +void +print_usage (const std::string& name) +{ + feval ("print_usage", octave_value (name), 0); +} + +void +check_version (const std::string& version, const std::string& fcn) +{ + if (version != OCTAVE_API_VERSION) + { + error ("API version %s found in .oct file function `%s'\n" + " does not match the running Octave (API version %s)\n" + " this can lead to incorrect results or other failures\n" + " you can fix this problem by recompiling this .oct file", + version.c_str (), fcn.c_str (), OCTAVE_API_VERSION); + } +} + +// Install variables and functions in the symbol tables. + +void +install_builtin_function (octave_builtin::fcn f, const std::string& name, + const std::string& file, const std::string& doc, + bool /* can_hide_function -- not yet implemented */) +{ + octave_value fcn (new octave_builtin (f, name, file, doc)); + + symbol_table::install_built_in_function (name, fcn); +} + +void +install_dld_function (octave_dld_function::fcn f, const std::string& name, + const octave_shlib& shl, const std::string& doc, + bool relative) +{ + octave_dld_function *fcn = new octave_dld_function (f, shl, name, doc); + + if (relative) + fcn->mark_relative (); + + octave_value fval (fcn); + + symbol_table::install_built_in_function (name, fval); +} + +void +install_mex_function (void *fptr, bool fmex, const std::string& name, + const octave_shlib& shl, bool relative) +{ + octave_mex_function *fcn = new octave_mex_function (fptr, fmex, shl, name); + + if (relative) + fcn->mark_relative (); + + octave_value fval (fcn); + + symbol_table::install_built_in_function (name, fval); +} + +void +alias_builtin (const std::string& alias, const std::string& name) +{ + symbol_table::alias_built_in_function (alias, name); +} + +octave_shlib +get_current_shlib (void) +{ + octave_shlib retval; + + octave_function *curr_fcn = octave_call_stack::current (); + if (curr_fcn) + { + if (curr_fcn->is_dld_function ()) + { + octave_dld_function *dld = dynamic_cast (curr_fcn); + retval = dld->get_shlib (); + } + else if (curr_fcn->is_mex_function ()) + { + octave_mex_function *mex = dynamic_cast (curr_fcn); + retval = mex->get_shlib (); + } + } + + return retval; +} + +bool defun_isargout (int nargout, int iout) +{ + const std::list *lvalue_list = octave_builtin::curr_lvalue_list; + if (iout >= std::max (nargout, 1)) + return false; + else if (lvalue_list) + { + int k = 0; + for (std::list::const_iterator p = lvalue_list->begin (); + p != lvalue_list->end (); p++) + { + if (k == iout) + return ! p->is_black_hole (); + k += p->numel (); + if (k > iout) + break; + } + + return true; + } + else + return true; +} + +void defun_isargout (int nargout, int nout, bool *isargout) +{ + const std::list *lvalue_list = octave_builtin::curr_lvalue_list; + if (lvalue_list) + { + int k = 0; + for (std::list::const_iterator p = lvalue_list->begin (); + p != lvalue_list->end () && k < nout; p++) + { + if (p->is_black_hole ()) + isargout[k++] = false; + else + { + int l = std::min (k + p->numel (), + static_cast (nout)); + while (k < l) + isargout[k++] = true; + } + } + } + else + for (int i = 0; i < nout; i++) + isargout[i] = true; + + for (int i = std::max (nargout, 1); i < nout; i++) + isargout[i] = false; +} + diff -r d02b229ce693 -r a132d206a36a src/interpfcn/defun.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/defun.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,66 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_defun_h) +#define octave_defun_h 1 + +#if defined (octave_defun_dld_h) +#error defun.h and defun-dld.h both included in same file! +#endif + +#include "defun-int.h" + +// Define a builtin function. +// +// name is the name of the function, unqouted. +// +// args_name is the name of the octave_value_list variable used to pass +// the argument list to this function. +// +// nargout_name is the name of the int variable used to pass the +// number of output arguments this function is expected to produce. +// +// doc is the simple help text for the function. + +#define DEFUN(name, args_name, nargout_name, doc) \ + DEFUN_INTERNAL (name, args_name, nargout_name, doc) + +// This one can be used when `name' cannot be used directly (if it is +// already defined as a macro). In that case, name is already a +// quoted string, and the internal name of the function must be passed +// too (the convention is to use a prefix of "F", so "foo" becomes "Ffoo"). + +#define DEFUNX(name, fname, args_name, nargout_name, doc) \ + DEFUNX_INTERNAL (name, fname, args_name, nargout_name, doc) + +// This is a function with a name that can't be hidden by a variable. +#define DEFCONSTFUN(name, args_name, nargout_name, doc) \ + DEFCONSTFUN_INTERNAL (name, args_name, nargout_name, doc) + +// Make alias another name for the existing function name. This macro +// must be used in the same file where name is defined, after the +// definition for name. + +#define DEFALIAS(alias, name) \ + DEFALIAS_INTERNAL (alias, name) + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/dirfns.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/dirfns.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,783 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include + +#include +#include + +#include +#include + +#include "file-ops.h" +#include "file-stat.h" +#include "glob-match.h" +#include "oct-env.h" +#include "pathsearch.h" +#include "str-vec.h" + +#include "Cell.h" +#include "defun.h" +#include "dir-ops.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "load-path.h" +#include "oct-obj.h" +#include "pager.h" +#include "procstream.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// TRUE means we ask for confirmation before recursively removing a +// directory tree. +static bool Vconfirm_recursive_rmdir = true; + +// The time we last time we changed directories. +octave_time Vlast_chdir_time = 0.0; + +static int +octave_change_to_directory (const std::string& newdir) +{ + int cd_ok = octave_env::chdir (file_ops::tilde_expand (newdir)); + + if (cd_ok) + { + Vlast_chdir_time.stamp (); + + // FIXME -- should this be handled as a list of functions + // to call so users can add their own chdir handlers? + + load_path::update (); + } + else + error ("%s: %s", newdir.c_str (), gnulib::strerror (errno)); + + return cd_ok; +} + +DEFUN (cd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} cd dir\n\ +@deftypefnx {Command} {} chdir dir\n\ +Change the current working directory to @var{dir}. If @var{dir} is\n\ +omitted, the current directory is changed to the user's home\n\ +directory. For example,\n\ +\n\ +@example\n\ +cd ~/octave\n\ +@end example\n\ +\n\ +@noindent\n\ +changes the current working directory to @file{~/octave}. If the\n\ +directory does not exist, an error message is printed and the working\n\ +directory is not changed.\n\ +@seealso{mkdir, rmdir, dir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("cd"); + + if (error_state) + return retval; + + if (argc > 1) + { + std::string dirname = argv[1]; + + if (dirname.length () > 0 + && ! octave_change_to_directory (dirname)) + { + return retval; + } + } + else + { + // Behave like Unixy shells for "cd" by itself, but be Matlab + // compatible if doing "current_dir = cd". + + if (nargout == 0) + { + std::string home_dir = octave_env::get_home_directory (); + + if (home_dir.empty () || ! octave_change_to_directory (home_dir)) + return retval; + } + else + retval = octave_value (octave_env::get_current_directory ()); + } + + return retval; +} + +DEFALIAS (chdir, cd); + +DEFUN (pwd, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pwd ()\n\ +Return the current working directory.\n\ +@seealso{dir, ls}\n\ +@end deftypefn") +{ + return octave_value (octave_env::get_current_directory ()); +} + +DEFUN (readdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{files}, @var{err}, @var{msg}] =} readdir (@var{dir})\n\ +Return names of the files in the directory @var{dir} as a cell array of\n\ +strings. If an error occurs, return an empty cell array in @var{files}.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{ls, dir, glob}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = -1.0; + retval(0) = Cell (); + + if (args.length () == 1) + { + std::string dirname = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("readdir", args(0)); + else + { + dir_entry dir (dirname); + + if (dir) + { + string_vector dirlist = dir.read (); + retval(1) = 0.0; + retval(0) = Cell (dirlist.sort ()); + } + else + { + retval(2) = dir.error (); + } + } + } + else + print_usage (); + + return retval; +} + +// FIXME -- should maybe also allow second arg to specify +// mode? OTOH, that might cause trouble with compatibility later... + +DEFUNX ("mkdir", Fmkdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{dir})\n\ +@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{parent}, @var{dir})\n\ +Create a directory named @var{dir} in the directory @var{parent}.\n\ +\n\ +If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ +character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ +system-dependent error message, and @var{msgid} contains a unique\n\ +message identifier.\n\ +@seealso{rmdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = std::string (); + retval(0) = false; + + int nargin = args.length (); + + std::string dirname; + + if (nargin == 2) + { + std::string parent = args(0).string_value (); + std::string dir = args(1).string_value (); + + if (error_state) + { + gripe_wrong_type_arg ("mkdir", args(0)); + return retval; + } + else + dirname = file_ops::concat (parent, dir); + } + else if (nargin == 1) + { + dirname = args(0).string_value (); + + if (error_state) + { + gripe_wrong_type_arg ("mkdir", args(0)); + return retval; + } + } + + if (nargin == 1 || nargin == 2) + { + std::string msg; + + dirname = file_ops::tilde_expand (dirname); + + file_stat fs (dirname); + + if (fs && fs.is_dir ()) + { + // For compatibility with Matlab, we return true when the + // directory already exists. + + retval(2) = "mkdir"; + retval(1) = "directory exists"; + retval(0) = true; + } + else + { + int status = octave_mkdir (dirname, 0777, msg); + + if (status < 0) + { + retval(2) = "mkdir"; + retval(1) = msg; + } + else + retval(0) = true; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("rmdir", Frmdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir})\n\ +@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir}, \"s\")\n\ +Remove the directory named @var{dir}.\n\ +\n\ +If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ +character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ +system-dependent error message, and @var{msgid} contains a unique\n\ +message identifier.\n\ +\n\ +If the optional second parameter is supplied with value @code{\"s\"},\n\ +recursively remove all subdirectories as well.\n\ +@seealso{mkdir, confirm_recursive_rmdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = std::string (); + retval(0) = false; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string dirname = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("rmdir", args(0)); + else + { + std::string fulldir = file_ops::tilde_expand (dirname); + int status = -1; + std::string msg; + + if (nargin == 2) + { + if (args(1).string_value () == "s") + { + bool doit = true; + + if (interactive && Vconfirm_recursive_rmdir) + { + std::string prompt + = "remove entire contents of " + fulldir + "? "; + + doit = octave_yes_or_no (prompt); + } + + if (doit) + status = octave_recursive_rmdir (fulldir, msg); + } + else + error ("rmdir: expecting second argument to be \"s\""); + } + else + status = octave_rmdir (fulldir, msg); + + if (status < 0) + { + retval(2) = "rmdir"; + retval(1) = msg; + } + else + retval(0) = true; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("link", Flink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} link (@var{old}, @var{new})\n\ +Create a new link (also known as a hard link) to an existing file.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{symlink}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1.0; + + if (args.length () == 2) + { + std::string from = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("link", args(0)); + else + { + std::string to = args(1).string_value (); + + if (error_state) + gripe_wrong_type_arg ("link", args(1)); + else + { + std::string msg; + + int status = octave_link (from, to, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("symlink", Fsymlink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} symlink (@var{old}, @var{new})\n\ +Create a symbolic link @var{new} which contains the string @var{old}.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{link, readlink}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1.0; + + if (args.length () == 2) + { + std::string from = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("symlink", args(0)); + else + { + std::string to = args(1).string_value (); + + if (error_state) + gripe_wrong_type_arg ("symlink", args(1)); + else + { + std::string msg; + + int status = octave_symlink (from, to, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("readlink", Freadlink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{result}, @var{err}, @var{msg}] =} readlink (@var{symlink})\n\ +Read the value of the symbolic link @var{symlink}.\n\ +\n\ +If successful, @var{result} contains the contents of the symbolic link\n\ +@var{symlink}, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{link, symlink}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = -1.0; + retval(0) = std::string (); + + if (args.length () == 1) + { + std::string symlink = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("readlink", args(0)); + else + { + std::string result; + std::string msg; + + int status = octave_readlink (symlink, result, msg); + + if (status < 0) + retval(2) = msg; + retval(1) = status; + retval(0) = result; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("rename", Frename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} rename (@var{old}, @var{new})\n\ +Change the name of file @var{old} to @var{new}.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{ls, dir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1.0; + + if (args.length () == 2) + { + std::string from = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("rename", args(0)); + else + { + std::string to = args(1).string_value (); + + if (error_state) + gripe_wrong_type_arg ("rename", args(1)); + else + { + std::string msg; + + int status = octave_rename (from, to, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (glob, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} glob (@var{pattern})\n\ +Given an array of pattern strings (as a char array or a cell array) in\n\ +@var{pattern}, return a cell array of file names that match any of\n\ +them, or an empty cell array if no patterns match. The pattern strings are\n\ +interpreted as filename globbing patterns (as they are used by Unix shells).\n\ +Within a pattern\n\ +\n\ +@table @code\n\ +@itemx *\n\ +matches any string, including the null string,\n\ +@itemx ?\n\ +matches any single character, and\n\ +\n\ +@item [@dots{}]\n\ +matches any of the enclosed characters.\n\ +@end table\n\ +\n\ +Tilde expansion\n\ +is performed on each of the patterns before looking for matching file\n\ +names. For example:\n\ +\n\ +@example\n\ +ls\n\ + @result{}\n\ + file1 file2 file3 myfile1 myfile1b\n\ +glob (\"*file1\")\n\ + @result{}\n\ + @{\n\ + [1,1] = file1\n\ + [2,1] = myfile1\n\ + @}\n\ +glob (\"myfile?\")\n\ + @result{}\n\ + @{\n\ + [1,1] = myfile1\n\ + @}\n\ +glob (\"file[12]\")\n\ + @result{}\n\ + @{\n\ + [1,1] = file1\n\ + [2,1] = file2\n\ + @}\n\ +@end example\n\ +@seealso{ls, dir, readdir}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + string_vector pat = args(0).all_strings (); + + if (error_state) + gripe_wrong_type_arg ("glob", args(0)); + else + { + glob_match pattern (file_ops::tilde_expand (pat)); + + retval = Cell (pattern.glob ()); + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! tmpdir = tmpnam; +%! filename = {"file1", "file2", "file3", "myfile1", "myfile1b"}; +%! if (mkdir (tmpdir)) +%! cwd = pwd; +%! cd (tmpdir); +%! if strcmp (canonicalize_file_name (pwd), canonicalize_file_name (tmpdir)) +%! a = 0; +%! for n = 1:5 +%! save (filename{n}, "a"); +%! endfor +%! else +%! rmdir (tmpdir); +%! error ("Couldn't change to temporary dir"); +%! endif +%! else +%! error ("Couldn't create temporary directory"); +%! endif +%! result1 = glob ("*file1"); +%! result2 = glob ("myfile?"); +%! result3 = glob ("file[12]"); +%! for n = 1:5 +%! delete (filename{n}); +%! endfor +%! cd (cwd); +%! rmdir (tmpdir); +%! assert (result1, {"file1"; "myfile1"}); +%! assert (result2, {"myfile1"}); +%! assert (result3, {"file1"; "file2"}); +*/ + +DEFUNX ("fnmatch", Ffnmatch, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fnmatch (@var{pattern}, @var{string})\n\ +Return 1 or zero for each element of @var{string} that matches any of\n\ +the elements of the string array @var{pattern}, using the rules of\n\ +filename pattern matching. For example:\n\ +\n\ +@example\n\ +@group\n\ +fnmatch (\"a*b\", @{\"ab\"; \"axyzb\"; \"xyzab\"@})\n\ + @result{} [ 1; 1; 0 ]\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + string_vector pat = args(0).all_strings (); + string_vector str = args(1).all_strings (); + + if (error_state) + gripe_wrong_type_arg ("fnmatch", args(0)); + else + { + glob_match pattern (file_ops::tilde_expand (pat)); + + retval = pattern.match (str); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (filesep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} filesep ()\n\ +@deftypefnx {Built-in Function} {} filesep (\"all\")\n\ +Return the system-dependent character used to separate directory names.\n\ +\n\ +If \"all\" is given, the function returns all valid file separators in\n\ +the form of a string. The list of file separators is system-dependent.\n\ +It is @samp{/} (forward slash) under UNIX or @w{Mac OS X}, @samp{/} and\n\ +@samp{\\} (forward and backward slashes) under Windows.\n\ +@seealso{pathsep}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = file_ops::dir_sep_str (); + else if (args.length () == 1) + { + std::string s = args(0).string_value (); + + if (! error_state) + { + if (s == "all") + retval = file_ops::dir_sep_chars (); + else + gripe_wrong_type_arg ("filesep", args(0)); + } + else + gripe_wrong_type_arg ("filesep", args(0)); + } + else + print_usage (); + + return retval; +} + +DEFUN (pathsep, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} pathsep ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} pathsep (@var{new_val})\n\ +Query or set the character used to separate directories in a path.\n\ +@seealso{filesep}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = dir_path::path_sep_str (); + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + switch (sval.length ()) + { + case 1: + dir_path::path_sep_char (sval[0]); + break; + + case 0: + dir_path::path_sep_char ('\0'); + break; + + default: + error ("pathsep: argument must be a single character"); + break; + } + } + else + error ("pathsep: argument must be a single character"); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +DEFUN (confirm_recursive_rmdir, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} confirm_recursive_rmdir ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} confirm_recursive_rmdir (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} confirm_recursive_rmdir (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave\n\ +will ask for confirmation before recursively removing a directory tree.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (confirm_recursive_rmdir); +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/dirfns.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/dirfns.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_dirfns_h) +#define octave_dirfns_h 1 + +#include + +#include + +#include "oct-time.h" + +// The time we last time we changed directories. +extern octave_time Vlast_chdir_time; + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/error.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/error.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1887 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include + +#include "defun.h" +#include "error.h" +#include "input.h" +#include "pager.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "utils.h" +#include "ov.h" +#include "ov-usr-fcn.h" +#include "pt-pr-code.h" +#include "pt-stmt.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "variables.h" + +// TRUE means that Octave will try to beep obnoxiously before printing +// error messages. +static bool Vbeep_on_error = false; + +// TRUE means that Octave will try to enter the debugger when an error +// is encountered. This will also inhibit printing of the normal +// traceback message (you will only see the top-level error message). +bool Vdebug_on_error = false; + +// TRUE means that Octave will try to enter the debugger when a warning +// is encountered. +bool Vdebug_on_warning = false; + +// TRUE means that Octave will try to display a stack trace when a +// warning is encountered. +static bool Vbacktrace_on_warning = false; + +// TRUE means that Octave will print a verbose warning. Currently unused. +static bool Vverbose_warning; + +// TRUE means that Octave will print no warnings, but lastwarn will be +//updated +static bool Vquiet_warning = false; + +// A structure containing (most of) the current state of warnings. +static octave_map warning_options; + +// The text of the last error message. +static std::string Vlast_error_message; + +// The text of the last warning message. +static std::string Vlast_warning_message; + +// The last warning message id. +static std::string Vlast_warning_id; + +// The last error message id. +static std::string Vlast_error_id; + +// The last file in which an error occured +static octave_map Vlast_error_stack; + +// Current error state. +// +// Valid values: +// +// -2: an error has occurred, but don't print any messages. +// -1: an error has occurred, we are printing a traceback +// 0: no error +// 1: an error has occurred +// +int error_state = 0; + +// Current warning state. +// +// Valid values: +// +// 0: no warning +// 1: a warning has occurred +// +int warning_state = 0; + +// Tell the error handler whether to print messages, or just store +// them for later. Used for handling errors in eval() and +// the `unwind_protect' statement. +int buffer_error_messages = 0; + +// TRUE means error messages are turned off. +bool discard_error_messages = false; + +// TRUE means warning messages are turned off. +bool discard_warning_messages = false; + +void +reset_error_handler (void) +{ + error_state = 0; + warning_state = 0; + buffer_error_messages = 0; + discard_error_messages = false; +} + +static void +initialize_warning_options (const std::string& state) +{ + octave_scalar_map initw; + + initw.setfield ("identifier", "all"); + initw.setfield ("state", state); + + warning_options = initw; +} + +static octave_map +initialize_last_error_stack (void) +{ + return octave_call_stack::empty_backtrace (); +} + +// Warning messages are never buffered. + +static void +vwarning (const char *name, const char *id, const char *fmt, va_list args) +{ + if (discard_warning_messages) + return; + + flush_octave_stdout (); + + std::ostringstream output_buf; + + if (name) + output_buf << name << ": "; + + octave_vformat (output_buf, fmt, args); + + output_buf << std::endl; + + // FIXME -- we really want to capture the message before it + // has all the formatting goop attached to it. We probably also + // want just the message, not the traceback information. + + std::string msg_string = output_buf.str (); + + if (! warning_state) + { + // This is the first warning in a possible series. + + Vlast_warning_id = id; + Vlast_warning_message = msg_string; + } + + if (! Vquiet_warning) + { + octave_diary << msg_string; + + std::cerr << msg_string; + } +} + +static void +verror (bool save_last_error, std::ostream& os, + const char *name, const char *id, const char *fmt, va_list args, + bool with_cfn = false) +{ + if (discard_error_messages) + return; + + if (! buffer_error_messages) + flush_octave_stdout (); + + // FIXME -- we really want to capture the message before it + // has all the formatting goop attached to it. We probably also + // want just the message, not the traceback information. + + std::ostringstream output_buf; + + octave_vformat (output_buf, fmt, args); + + std::string base_msg = output_buf.str (); + + bool to_beep_or_not_to_beep_p = Vbeep_on_error && ! error_state; + + std::string msg_string; + + if (to_beep_or_not_to_beep_p) + msg_string = "\a"; + + if (name) + msg_string += std::string (name) + ": "; + + // If with_fcn is specified, we'll attempt to prefix the message with the name + // of the current executing function. But we'll do so only if: + // 1. the name is not empty (anonymous function) + // 2. it is not already there (including the following colon) + if (with_cfn) + { + octave_function *curfcn = octave_call_stack::current (); + if (curfcn) + { + std::string cfn = curfcn->name (); + if (! cfn.empty ()) + { + cfn += ':'; + if (cfn.length () > base_msg.length () + || base_msg.compare (0, cfn.length (), cfn) != 0) + { + msg_string += cfn + ' '; + } + } + } + } + + msg_string += base_msg + "\n"; + + if (! error_state && save_last_error) + { + // This is the first error in a possible series. + + Vlast_error_id = id; + Vlast_error_message = base_msg; + + octave_user_code *fcn = octave_call_stack::caller_user_code (); + + if (fcn) + { + octave_idx_type curr_frame = -1; + + Vlast_error_stack = octave_call_stack::backtrace (0, curr_frame); + } + else + Vlast_error_stack = initialize_last_error_stack (); + } + + if (! buffer_error_messages) + { + octave_diary << msg_string; + os << msg_string; + } +} + +// Note that we don't actually print any message if the error string +// is just "" or "\n". This allows error ("") and error ("\n") to +// just set the error state. + +static void +error_1 (std::ostream& os, const char *name, const char *id, + const char *fmt, va_list args, bool with_cfn = false) +{ + if (error_state != -2) + { + if (fmt) + { + if (*fmt) + { + size_t len = strlen (fmt); + + if (len > 0) + { + if (fmt[len - 1] == '\n') + { + if (len > 1) + { + char *tmp_fmt = strsave (fmt); + tmp_fmt[len - 1] = '\0'; + verror (true, os, name, id, tmp_fmt, args, with_cfn); + delete [] tmp_fmt; + } + + error_state = -2; + } + else + { + verror (true, os, name, id, fmt, args, with_cfn); + + if (! error_state) + error_state = 1; + } + } + } + } + else + panic ("error_1: invalid format"); + } +} + +void +vmessage (const char *name, const char *fmt, va_list args) +{ + verror (false, std::cerr, name, "", fmt, args); +} + +void +message (const char *name, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vmessage (name, fmt, args); + va_end (args); +} + +void +vmessage_with_id (const char *name, const char *id, const char *fmt, + va_list args) +{ + verror (false, std::cerr, name, id, fmt, args); +} + +void +message_with_id (const char *name, const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vmessage_with_id (name, id, fmt, args); + va_end (args); +} + +void +usage_1 (const char *id, const char *fmt, va_list args) +{ + verror (true, std::cerr, "usage", id, fmt, args); + error_state = -1; +} + +void +vusage (const char *fmt, va_list args) +{ + usage_1 ("", fmt, args); +} + +void +usage (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vusage (fmt, args); + va_end (args); +} + +void +vusage_with_id (const char *id, const char *fmt, va_list args) +{ + usage_1 (id, fmt, args); +} + +void +usage_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vusage_with_id (id, fmt, args); + va_end (args); +} + +static void +pr_where_2 (const char *fmt, va_list args) +{ + if (fmt) + { + if (*fmt) + { + size_t len = strlen (fmt); + + if (len > 0) + { + if (fmt[len - 1] == '\n') + { + if (len > 1) + { + char *tmp_fmt = strsave (fmt); + tmp_fmt[len - 1] = '\0'; + verror (false, std::cerr, 0, "", tmp_fmt, args); + delete [] tmp_fmt; + } + } + else + verror (false, std::cerr, 0, "", fmt, args); + } + } + } + else + panic ("pr_where_2: invalid format"); +} + +static void +pr_where_1 (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + pr_where_2 (fmt, args); + va_end (args); +} + +static void +pr_where (const char *who) +{ + octave_idx_type curr_frame = -1; + + octave_map stk = octave_call_stack::backtrace (0, curr_frame); + + octave_idx_type nframes_to_display = stk.numel (); + + if (nframes_to_display > 0) + { + pr_where_1 ("%s: called from\n", who); + + Cell names = stk.contents ("name"); + Cell lines = stk.contents ("line"); + Cell columns = stk.contents ("column"); + + for (octave_idx_type i = 0; i < nframes_to_display; i++) + { + octave_value name = names(i); + octave_value line = lines(i); + octave_value column = columns(i); + + std::string nm = name.string_value (); + + pr_where_1 (" %s at line %d column %d\n", nm.c_str (), + line.int_value (), column.int_value ()); + } + } +} + +static void +error_2 (const char *id, const char *fmt, va_list args, bool with_cfn = false) +{ + int init_state = error_state; + + error_1 (std::cerr, "error", id, fmt, args, with_cfn); + + if ((interactive || forced_interactive) + && Vdebug_on_error && init_state == 0 + && octave_call_stack::caller_user_code ()) + { + unwind_protect frame; + frame.protect_var (Vdebug_on_error); + Vdebug_on_error = false; + + error_state = 0; + + pr_where ("error"); + + do_keyboard (octave_value_list ()); + } +} + +void +verror (const char *fmt, va_list args) +{ + error_2 ("", fmt, args); +} + +void +error (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror (fmt, args); + va_end (args); +} + +void +verror_with_cfn (const char *fmt, va_list args) +{ + error_2 ("", fmt, args, true); +} + +void +error_with_cfn (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror_with_cfn (fmt, args); + va_end (args); +} + +void +verror_with_id (const char *id, const char *fmt, va_list args) +{ + error_2 (id, fmt, args); +} + +void +error_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror_with_id (id, fmt, args); + va_end (args); +} + +void +verror_with_id_cfn (const char *id, const char *fmt, va_list args) +{ + error_2 (id, fmt, args, true); +} + +void +error_with_id_cfn (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror_with_id_cfn (id, fmt, args); + va_end (args); +} + +static int +check_state (const std::string& state) +{ + // -1: not found + // 0: found, "off" + // 1: found, "on" + // 2: found, "error" + + if (state == "off") + return 0; + else if (state == "on") + return 1; + else if (state == "error") + return 2; + else + return -1; +} + +// For given warning ID, return 0 if warnings are disabled, 1 if +// enabled, and 2 if the given ID should be an error instead of a +// warning. + +int +warning_enabled (const std::string& id) +{ + int retval = 0; + + int all_state = -1; + int id_state = -1; + + octave_idx_type nel = warning_options.numel (); + + if (nel > 0) + { + Cell identifier = warning_options.contents ("identifier"); + Cell state = warning_options.contents ("state"); + + bool all_found = false; + bool id_found = false; + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value ov = identifier(i); + std::string ovs = ov.string_value (); + + if (! all_found && ovs == "all") + { + all_state = check_state (state(i).string_value ()); + + if (all_state >= 0) + all_found = true; + } + + if (! id_found && ovs == id) + { + id_state = check_state (state(i).string_value ()); + + if (id_state >= 0) + id_found = true; + } + + if (all_found && id_found) + break; + } + } + + // If "all" is not present, assume warnings are enabled. + if (all_state == -1) + all_state = 1; + + if (all_state == 0) + { + if (id_state >= 0) + retval = id_state; + } + else if (all_state == 1) + { + if (id_state == 0 || id_state == 2) + retval = id_state; + else + retval = all_state; + } + else if (all_state == 2) + { + if (id_state == 0) + retval= id_state; + else + retval = all_state; + } + + return retval; +} + +static void +warning_1 (const char *id, const char *fmt, va_list args) +{ + int warn_opt = warning_enabled (id); + + if (warn_opt == 2) + { + // Handle this warning as an error. + + error_2 (id, fmt, args); + } + else if (warn_opt == 1) + { + vwarning ("warning", id, fmt, args); + + if (! symbol_table::at_top_level () + && Vbacktrace_on_warning + && ! warning_state + && ! discard_warning_messages) + pr_where ("warning"); + + warning_state = 1; + + if ((interactive || forced_interactive) + && Vdebug_on_warning + && octave_call_stack::caller_user_code ()) + { + unwind_protect frame; + frame.protect_var (Vdebug_on_warning); + Vdebug_on_warning = false; + + do_keyboard (octave_value_list ()); + } + } +} + +void +vwarning (const char *fmt, va_list args) +{ + warning_1 ("", fmt, args); +} + +void +warning (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vwarning (fmt, args); + va_end (args); +} + +void +vwarning_with_id (const char *id, const char *fmt, va_list args) +{ + warning_1 (id, fmt, args); +} + +void +warning_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vwarning_with_id (id, fmt, args); + va_end (args); +} + +void +vparse_error (const char *fmt, va_list args) +{ + error_1 (std::cerr, 0, "", fmt, args); +} + +void +parse_error (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vparse_error (fmt, args); + va_end (args); +} + +void +vparse_error_with_id (const char *id, const char *fmt, va_list args) +{ + error_1 (std::cerr, 0, id, fmt, args); +} + +void +parse_error_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vparse_error_with_id (id, fmt, args); + va_end (args); +} + +void +rethrow_error (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + error_1 (std::cerr, 0, id, fmt, args); + va_end (args); +} + +void +panic (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + buffer_error_messages = 0; + discard_error_messages = false; + verror (false, std::cerr, "panic", "", fmt, args); + va_end (args); + abort (); +} + +static void +defun_usage_message_1 (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + error_1 (octave_stdout, 0, "", fmt, args); + va_end (args); +} + +void +defun_usage_message (const std::string& msg) +{ + defun_usage_message_1 ("%s", msg.c_str ()); +} + +typedef void (*error_fun)(const char *, const char *, ...); + +extern octave_value_list Fsprintf (const octave_value_list&, int); + +static std::string +handle_message (error_fun f, const char *id, const char *msg, + const octave_value_list& args, bool have_fmt) +{ + std::string retval; + + std::string tstr; + + int nargin = args.length (); + + if (nargin > 0) + { + octave_value arg; + + if (have_fmt) + { + octave_value_list tmp = Fsprintf (args, 1); + arg = tmp(0); + } + else + arg = args(0); + + if (arg.is_defined ()) + { + if (arg.is_string ()) + { + tstr = arg.string_value (); + msg = tstr.c_str (); + + if (! msg) + return retval; + } + else if (arg.is_empty ()) + return retval; + } + } + +// Ugh. + + size_t len = strlen (msg); + + if (len > 0) + { + if (msg[len - 1] == '\n') + { + if (len > 1) + { + char *tmp_msg = strsave (msg); + tmp_msg[len - 1] = '\0'; + f (id, "%s\n", tmp_msg); + retval = tmp_msg; + delete [] tmp_msg; + } + } + else + { + f (id, "%s", msg); + retval = msg; + } + } + + return retval; +} + +DEFUN (rethrow, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rethrow (@var{err})\n\ +Reissue a previous error as defined by @var{err}. @var{err} is a structure\n\ +that must contain at least the 'message' and 'identifier' fields. @var{err}\n\ +can also contain a field 'stack' that gives information on the assumed\n\ +location of the error. Typically @var{err} is returned from\n\ +@code{lasterror}.\n\ +@seealso{lasterror, lasterr, error}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin != 1) + print_usage (); + else + { + const octave_scalar_map err = args(0).scalar_map_value (); + + if (! error_state) + { + if (err.contains ("message") && err.contains ("identifier")) + { + std::string msg = err.contents ("message").string_value (); + std::string id = err.contents ("identifier").string_value (); + int len = msg.length (); + + std::string file; + std::string nm; + int l = -1; + int c = -1; + + octave_map err_stack = initialize_last_error_stack (); + + if (err.contains ("stack")) + { + err_stack = err.contents ("stack").map_value (); + + if (err_stack.numel () > 0) + { + if (err_stack.contains ("file")) + file = err_stack.contents ("file")(0).string_value (); + + if (err_stack.contains ("name")) + nm = err_stack.contents ("name")(0).string_value (); + + if (err_stack.contains ("line")) + l = err_stack.contents ("line")(0).nint_value (); + + if (err_stack.contains ("column")) + c = err_stack.contents ("column")(0).nint_value (); + } + } + + // Ugh. + char *tmp_msg = strsave (msg.c_str ()); + if (tmp_msg[len-1] == '\n') + { + if (len > 1) + { + tmp_msg[len - 1] = '\0'; + rethrow_error (id.c_str (), "%s\n", tmp_msg); + } + } + else + rethrow_error (id.c_str (), "%s", tmp_msg); + delete [] tmp_msg; + + // FIXME -- is this the right thing to do for + // Vlast_error_stack? Should it be saved and restored + // with unwind_protect? + + Vlast_error_stack = err_stack; + + if (err.contains ("stack")) + { + if (file.empty ()) + { + if (nm.empty ()) + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: near line %d, column %d", + l, c); + else + pr_where_1 ("error: near line %d", l); + } + } + else + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: called from `%s' near line %d, column %d", + nm.c_str (), l, c); + else + pr_where_1 ("error: called from `%d' near line %d", nm.c_str (), l); + } + } + } + else + { + if (nm.empty ()) + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: in file %s near line %d, column %d", + file.c_str (), l, c); + else + pr_where_1 ("error: in file %s near line %d", file.c_str (), l); + } + } + else + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: called from `%s' in file %s near line %d, column %d", + nm.c_str (), file.c_str (), l, c); + else + pr_where_1 ("error: called from `%d' in file %s near line %d", nm.c_str (), file.c_str (), l); + } + } + } + } + } + else + error ("rethrow: ERR structure must contain the fields 'message and 'identifier'"); + } + } + return retval; +} + +// Determine whether the first argument to error or warning function +// should be handled as the message identifier or as the format string. + +static bool +maybe_extract_message_id (const std::string& caller, + const octave_value_list& args, + octave_value_list& nargs, + std::string& id) +{ + nargs = args; + id = std::string (); + + int nargin = args.length (); + + bool have_fmt = nargin > 1; + + if (nargin > 0) + { + std::string arg1 = args(0).string_value (); + + if (! error_state) + { + // For compatibility with Matlab, an identifier must contain + // ':', but not at the beginning or the end, and it must not + // contain '%' (even if it is not a valid conversion + // operator) or whitespace. + + if (arg1.find_first_of ("% \f\n\r\t\v") == std::string::npos + && arg1.find (':') != std::string::npos + && arg1[0] != ':' + && arg1[arg1.length ()-1] != ':') + { + if (nargin > 1) + { + id = arg1; + + nargs.resize (nargin-1); + + for (int i = 1; i < nargin; i++) + nargs(i-1) = args(i); + } + else + nargs(0) = "call to " + caller + + " with message identifier requires message"; + } + } + } + + return have_fmt; +} + +DEFUN (error, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} error (@var{template}, @dots{})\n\ +@deftypefnx {Built-in Function} {} error (@var{id}, @var{template}, @dots{})\n\ +Format the optional arguments under the control of the template string\n\ +@var{template} using the same rules as the @code{printf} family of\n\ +functions (@pxref{Formatted Output}) and print the resulting message\n\ +on the @code{stderr} stream. The message is prefixed by the character\n\ +string @samp{error: }.\n\ +\n\ +Calling @code{error} also sets Octave's internal error state such that\n\ +control will return to the top level without evaluating any more\n\ +commands. This is useful for aborting from functions or scripts.\n\ +\n\ +If the error message does not end with a new line character, Octave will\n\ +print a traceback of all the function calls leading to the error. For\n\ +example, given the following function definitions:\n\ +\n\ +@example\n\ +@group\n\ +function f () g (); end\n\ +function g () h (); end\n\ +function h () nargin == 1 || error (\"nargin != 1\"); end\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +calling the function @code{f} will result in a list of messages that\n\ +can help you to quickly locate the exact location of the error:\n\ +\n\ +@example\n\ +@group\n\ +f ()\n\ +error: nargin != 1\n\ +error: called from:\n\ +error: error at line -1, column -1\n\ +error: h at line 1, column 27\n\ +error: g at line 1, column 15\n\ +error: f at line 1, column 15\n\ +@end group\n\ +@end example\n\ +\n\ +If the error message ends in a new line character, Octave will print the\n\ +message but will not display any traceback messages as it returns\n\ +control to the top level. For example, modifying the error message\n\ +in the previous example to end in a new line causes Octave to only print\n\ +a single message:\n\ +\n\ +@example\n\ +@group\n\ +function h () nargin == 1 || error (\"nargin != 1\\n\"); end\n\ +f ()\n\ +error: nargin != 1\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + octave_value_list nargs = args; + + std::string id; + + if (nargin == 0) + print_usage (); + else + { + bool have_fmt = false; + + if (nargin == 1 && args(0).is_map ()) + { + // empty struct is not an error. return and resume calling function. + if (args(0).is_empty ()) + return retval; + + octave_value_list tmp; + + octave_scalar_map m = args(0).scalar_map_value (); + + // empty struct is not an error. return and resume calling function. + if (m.nfields () == 0) + return retval; + + if (m.contains ("message")) + { + octave_value c = m.getfield ("message"); + + if (c.is_string ()) + nargs(0) = c.string_value (); + } + + if (m.contains ("identifier")) + { + octave_value c = m.getfield ("identifier"); + + if (c.is_string ()) + id = c.string_value (); + } + + // FIXME -- also need to handle "stack" field in error + // structure, but that will require some more significant + // surgery on handle_message, error_with_id, etc. + } + else + { + have_fmt = maybe_extract_message_id ("error", args, nargs, id); + + if (error_state) + return retval; + } + + handle_message (error_with_id, id.c_str (), "unspecified error", + nargs, have_fmt); + } + + return retval; +} + +DEFUN (warning, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} warning (@var{template}, @dots{})\n\ +@deftypefnx {Built-in Function} {} warning (@var{id}, @var{template}, @dots{})\n\ +@deftypefnx {Built-in Function} {} warning (\"on\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"off\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"query\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"error\", @var{id})\n\ +Format the optional arguments under the control of the template string\n\ +@var{template} using the same rules as the @code{printf} family of\n\ +functions (@pxref{Formatted Output}) and print the resulting message\n\ +on the @code{stderr} stream. The message is prefixed by the character\n\ +string @samp{warning: }.\n\ +You should use this function when you want to notify the user\n\ +of an unusual condition, but only when it makes sense for your program\n\ +to go on.\n\ +\n\ +The optional message identifier allows users to enable or disable\n\ +warnings tagged by @var{id}. The special identifier @samp{\"all\"} may\n\ +be used to set the state of all warnings.\n\ +\n\ +If the first argument is @samp{\"on\"} or @samp{\"off\"}, set the state\n\ +of a particular warning using the identifier @var{id}. If the first\n\ +argument is @samp{\"query\"}, query the state of this warning instead.\n\ +If the identifier is omitted, a value of @samp{\"all\"} is assumed. If\n\ +you set the state of a warning to @samp{\"error\"}, the warning named by\n\ +@var{id} is handled as if it were an error instead. So, for example, the\n\ +following handles all warnings as errors:\n\ +\n\ +@example\n\ +@group\n\ +warning (\"error\");\n\ +@end group\n\ +@end example\n\ +@seealso{warning_ids}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + int argc = nargin + 1; + + bool done = false; + + if (argc > 1 && args.all_strings_p ()) + { + string_vector argv = args.make_argv ("warning"); + + if (! error_state) + { + std::string arg1 = argv(1); + std::string arg2 = "all"; + + if (argc == 3) + arg2 = argv(2); + + if (arg1 == "on" || arg1 == "off" || arg1 == "error") + { + octave_map old_warning_options = warning_options; + + if (arg2 == "all") + { + octave_map tmp; + + Cell id (1, 1); + Cell st (1, 1); + + id(0) = arg2; + st(0) = arg1; + + // Since internal Octave functions are not + // compatible, turning all warnings into errors + // should leave the state of + // Octave:matlab-incompatible alone. + + if (arg1 == "error" + && warning_options.contains ("identifier")) + { + octave_idx_type n = 1; + + Cell tid = warning_options.contents ("identifier"); + Cell tst = warning_options.contents ("state"); + + for (octave_idx_type i = 0; i < tid.numel (); i++) + { + octave_value vid = tid(i); + + if (vid.is_string ()) + { + std::string key = vid.string_value (); + + if (key == "Octave:matlab-incompatible" + || key == "Octave:single-quote-string") + { + id.resize (dim_vector (1, n+1)); + st.resize (dim_vector (1, n+1)); + + id(n) = tid(i); + st(n) = tst(i); + + n++; + } + } + } + } + + tmp.assign ("identifier", id); + tmp.assign ("state", st); + + warning_options = tmp; + + done = true; + } + else if (arg2 == "backtrace") + { + if (arg1 != "error") + { + Vbacktrace_on_warning = (arg1 == "on"); + done = true; + } + } + else if (arg2 == "debug") + { + if (arg1 != "error") + { + Vdebug_on_warning = (arg1 == "on"); + done = true; + } + } + else if (arg2 == "verbose") + { + if (arg1 != "error") + { + Vverbose_warning = (arg1 == "on"); + done = true; + } + } + else if (arg2 == "quiet") + { + if (arg1 != "error") + { + Vquiet_warning = (arg1 == "on"); + done = true; + } + } + else + { + if (arg2 == "last") + arg2 = Vlast_warning_id; + + if (arg2 == "all") + initialize_warning_options (arg1); + else + { + Cell ident = warning_options.contents ("identifier"); + Cell state = warning_options.contents ("state"); + + octave_idx_type nel = ident.numel (); + + bool found = false; + + for (octave_idx_type i = 0; i < nel; i++) + { + if (ident(i).string_value () == arg2) + { + // FIXME -- if state for "all" is + // same as arg1, we can simply remove the + // item from the list. + + state(i) = arg1; + warning_options.assign ("state", state); + found = true; + break; + } + } + + if (! found) + { + // FIXME -- if state for "all" is + // same as arg1, we don't need to do anything. + + ident.resize (dim_vector (1, nel+1)); + state.resize (dim_vector (1, nel+1)); + + ident(nel) = arg2; + state(nel) = arg1; + + warning_options.clear (); + + warning_options.assign ("identifier", ident); + warning_options.assign ("state", state); + } + } + + done = true; + } + + if (done && nargout > 0) + retval = old_warning_options; + } + else if (arg1 == "query") + { + if (arg2 == "all") + retval = warning_options; + else if (arg2 == "backtrace" || arg2 == "debug" + || arg2 == "verbose" || arg2 == "quiet") + { + octave_scalar_map tmp; + tmp.assign ("identifier", arg2); + if (arg2 == "backtrace") + tmp.assign ("state", Vbacktrace_on_warning ? "on" : "off"); + else if (arg2 == "debug") + tmp.assign ("state", Vdebug_on_warning ? "on" : "off"); + else if (arg2 == "verbose") + tmp.assign ("state", Vverbose_warning ? "on" : "off"); + else + tmp.assign ("state", Vquiet_warning ? "on" : "off"); + + retval = tmp; + } + else + { + if (arg2 == "last") + arg2 = Vlast_warning_id; + + Cell ident = warning_options.contents ("identifier"); + Cell state = warning_options.contents ("state"); + + octave_idx_type nel = ident.numel (); + + bool found = false; + + std::string val; + + for (octave_idx_type i = 0; i < nel; i++) + { + if (ident(i).string_value () == arg2) + { + val = state(i).string_value (); + found = true; + break; + } + } + + if (! found) + { + for (octave_idx_type i = 0; i < nel; i++) + { + if (ident(i).string_value () == "all") + { + val = state(i).string_value (); + found = true; + break; + } + } + } + + if (found) + { + octave_scalar_map tmp; + + tmp.assign ("identifier", arg2); + tmp.assign ("state", val); + + retval = tmp; + } + else + error ("warning: unable to find default warning state!"); + } + + done = true; + } + } + } + else if (argc == 1) + { + retval = warning_options; + + done = true; + } + else if (argc == 2) + { + octave_value arg = args(0); + + octave_map old_warning_options = warning_options; + + if (arg.is_map ()) + { + octave_map m = arg.map_value (); + + if (m.contains ("identifier") && m.contains ("state")) + warning_options = m; + else + error ("warning: expecting structure with fields `identifier' and `state'"); + + done = true; + + if (nargout > 0) + retval = old_warning_options; + } + } + + if (! (error_state || done)) + { + octave_value_list nargs = args; + + std::string id; + + bool have_fmt = maybe_extract_message_id ("warning", args, nargs, id); + + if (error_state) + return retval; + + std::string prev_msg = Vlast_warning_message; + + std::string curr_msg = handle_message (warning_with_id, id.c_str (), + "unspecified warning", nargs, + have_fmt); + + if (nargout > 0) + retval = prev_msg; + } + + return retval; +} + +octave_value_list +set_warning_state (const std::string& id, const std::string& state) +{ + octave_value_list args; + + args(1) = id; + args(0) = state; + + return Fwarning (args, 1); +} + +octave_value_list +set_warning_state (const octave_value_list& args) +{ + return Fwarning (args, 1); +} + +void +disable_warning (const std::string& id) +{ + set_warning_state (id, "off"); +} + +void +initialize_default_warning_state (void) +{ + initialize_warning_options ("on"); + + // Most people will want to have the following disabled. + + disable_warning ("Octave:array-to-scalar"); + disable_warning ("Octave:array-to-vector"); + disable_warning ("Octave:imag-to-real"); + disable_warning ("Octave:matlab-incompatible"); + disable_warning ("Octave:missing-semicolon"); + disable_warning ("Octave:neg-dim-as-zero"); + disable_warning ("Octave:resize-on-range-error"); + disable_warning ("Octave:separator-insert"); + disable_warning ("Octave:single-quote-string"); + disable_warning ("Octave:str-to-num"); + disable_warning ("Octave:mixed-string-concat"); + disable_warning ("Octave:variable-switch-label"); + + // This should be an error unless we are in maximum braindamage mode. + // FIXME: Not quite right. This sets the error state even for braindamage + // mode. Also, this error is not triggered in normal mode because another + // error handler catches it first and gives: + // error: subscript indices must be either positive integers or logicals + set_warning_state ("Octave:noninteger-range-as-index", "error"); + +} + +DEFUN (lasterror, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{lasterr} =} lasterror ()\n\ +@deftypefnx {Built-in Function} {} lasterror (@var{err})\n\ +@deftypefnx {Built-in Function} {} lasterror (\"reset\")\n\ +Query or set the last error message structure. When called without\n\ +arguments, return a structure containing the last error message and other\n\ +information related to this error. The elements of the structure are:\n\ +\n\ +@table @asis\n\ +@item 'message'\n\ +The text of the last error message\n\ +\n\ +@item 'identifier'\n\ +The message identifier of this error message\n\ +\n\ +@item 'stack'\n\ +A structure containing information on where the message occurred. This may\n\ +be an empty structure if the information cannot\n\ +be obtained. The fields of the structure are:\n\ +\n\ +@table @asis\n\ +@item 'file'\n\ +The name of the file where the error occurred\n\ +\n\ +@item 'name'\n\ +The name of function in which the error occurred\n\ +\n\ +@item 'line'\n\ +The line number at which the error occurred\n\ +\n\ +@item 'column'\n\ +An optional field with the column number at which the error occurred\n\ +@end table\n\ +@end table\n\ +\n\ +The last error structure may be set by passing a scalar structure, @var{err},\n\ +as input. Any fields of @var{err} that match those above are set while any\n\ +unspecified fields are initialized with default values.\n\ +\n\ +If @code{lasterror} is called with the argument \"reset\", all fields are\n\ +set to their default values.\n\ +@seealso{lasterr}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + unwind_protect frame; + + frame.protect_var (error_state); + error_state = 0; + + if (nargin < 2) + { + octave_scalar_map err; + + err.assign ("message", Vlast_error_message); + err.assign ("identifier", Vlast_error_id); + + err.assign ("stack", octave_value (Vlast_error_stack)); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + if (args(0).string_value () == "reset") + { + Vlast_error_message = std::string (); + Vlast_error_id = std::string (); + + Vlast_error_stack = initialize_last_error_stack (); + } + else + error ("lasterror: unrecognized string argument"); + } + else if (args(0).is_map ()) + { + octave_scalar_map new_err = args(0).scalar_map_value (); + std::string new_error_message; + std::string new_error_id; + std::string new_error_file; + std::string new_error_name; + int new_error_line = -1; + int new_error_column = -1; + + if (! error_state && new_err.contains ("message")) + { + const std::string tmp = + new_err.getfield ("message").string_value (); + new_error_message = tmp; + } + + if (! error_state && new_err.contains ("identifier")) + { + const std::string tmp = + new_err.getfield ("identifier").string_value (); + new_error_id = tmp; + } + + if (! error_state && new_err.contains ("stack")) + { + octave_scalar_map new_err_stack = + new_err.getfield ("stack").scalar_map_value (); + + if (! error_state && new_err_stack.contains ("file")) + { + const std::string tmp = + new_err_stack.getfield ("file").string_value (); + new_error_file = tmp; + } + + if (! error_state && new_err_stack.contains ("name")) + { + const std::string tmp = + new_err_stack.getfield ("name").string_value (); + new_error_name = tmp; + } + + if (! error_state && new_err_stack.contains ("line")) + { + const int tmp = + new_err_stack.getfield ("line").nint_value (); + new_error_line = tmp; + } + + if (! error_state && new_err_stack.contains ("column")) + { + const int tmp = + new_err_stack.getfield ("column").nint_value (); + new_error_column = tmp; + } + } + + if (! error_state) + { + Vlast_error_message = new_error_message; + Vlast_error_id = new_error_id; + + octave_idx_type curr_frame = -1; + + Vlast_error_stack + = octave_call_stack::backtrace (0, curr_frame); + } + } + else + error ("lasterror: argument must be a structure or a string"); + } + + if (! error_state) + retval = err; + } + else + print_usage (); + + return retval; +} + +DEFUN (lasterr, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lasterr ()\n\ +@deftypefnx {Built-in Function} {} lasterr (@var{msg})\n\ +@deftypefnx {Built-in Function} {} lasterr (@var{msg}, @var{msgid})\n\ +Query or set the last error message. When called without input arguments,\n\ +return the last error message and message identifier. With one\n\ +argument, set the last error message to @var{msg}. With two arguments,\n\ +also set the last message identifier.\n\ +@seealso{lasterror}\n\ +@end deftypefn") +{ + octave_value_list retval; + + unwind_protect frame; + + frame.protect_var (error_state); + error_state = 0; + + int argc = args.length () + 1; + + if (argc < 4) + { + string_vector argv = args.make_argv ("lasterr"); + + if (! error_state) + { + std::string prev_error_id = Vlast_error_id; + std::string prev_error_message = Vlast_error_message; + + if (argc > 2) + Vlast_error_id = argv(2); + + if (argc > 1) + Vlast_error_message = argv(1); + + if (argc == 1 || nargout > 0) + { + retval(1) = prev_error_id; + retval(0) = prev_error_message; + } + } + else + error ("lasterr: expecting arguments to be character strings"); + } + else + print_usage (); + + return retval; +} + +DEFUN (lastwarn, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lastwarn (@var{msg}, @var{msgid})\n\ +Without any arguments, return the last warning message. With one\n\ +argument, set the last warning message to @var{msg}. With two arguments,\n\ +also set the last message identifier.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + if (argc < 4) + { + string_vector argv = args.make_argv ("lastwarn"); + + if (! error_state) + { + std::string prev_warning_id = Vlast_warning_id; + std::string prev_warning_message = Vlast_warning_message; + + if (argc > 2) + Vlast_warning_id = argv(2); + + if (argc > 1) + Vlast_warning_message = argv(1); + + if (argc == 1 || nargout > 0) + { + warning_state = 0; + retval(1) = prev_warning_id; + retval(0) = prev_warning_message; + } + } + else + error ("lastwarn: expecting arguments to be character strings"); + } + else + print_usage (); + + return retval; +} + +DEFUN (usage, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} usage (@var{msg})\n\ +Print the message @var{msg}, prefixed by the string @samp{usage: }, and\n\ +set Octave's internal error state such that control will return to the\n\ +top level without evaluating any more commands. This is useful for\n\ +aborting from functions.\n\ +\n\ +After @code{usage} is evaluated, Octave will print a traceback of all\n\ +the function calls leading to the usage message.\n\ +\n\ +You should use this function for reporting problems errors that result\n\ +from an improper call to a function, such as calling a function with an\n\ +incorrect number of arguments, or with arguments of the wrong type. For\n\ +example, most functions distributed with Octave begin with code like\n\ +this\n\ +\n\ +@example\n\ +@group\n\ +if (nargin != 2)\n\ + usage (\"foo (a, b)\");\n\ +endif\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +to check for the proper number of arguments.\n\ +@end deftypefn") +{ + octave_value_list retval; + handle_message (usage_with_id, "", "unknown", args, true); + return retval; +} + +DEFUN (beep_on_error, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} beep_on_error ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} beep_on_error (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} beep_on_error (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to ring the terminal bell before printing an error message.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (beep_on_error); +} + +DEFUN (debug_on_error, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} debug_on_error ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_error (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_error (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to enter the debugger when an error is encountered. This will also\n\ +inhibit printing of the normal traceback message (you will only see\n\ +the top-level error message).\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (debug_on_error); +} + +DEFUN (debug_on_warning, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} debug_on_warning ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_warning (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_warning (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to enter the debugger when a warning is encountered.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (debug_on_warning); +} + +std::string +last_error_message (void) +{ + return Vlast_error_message; +} + +std::string +last_error_id (void) +{ + return Vlast_error_id; +} + +std::string +last_warning_message (void) +{ + return Vlast_warning_message; +} + +std::string +last_warning_id (void) +{ + return Vlast_warning_id; +} + +void +interpreter_try (unwind_protect& frame) +{ + frame.protect_var (error_state); + frame.protect_var (buffer_error_messages); + frame.protect_var (Vdebug_on_error); + frame.protect_var (Vdebug_on_warning); + + buffer_error_messages++; + Vdebug_on_error = false; + Vdebug_on_warning = false; +} + + diff -r d02b229ce693 -r a132d206a36a src/interpfcn/error.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/error.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,142 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_error_h) +#define octave_error_h 1 + +#include +#include + +class octave_value_list; +class unwind_protect; + +#define panic_impossible() \ + panic ("impossible state reached in file `%s' at line %d", \ + __FILE__, __LINE__) + +extern OCTINTERP_API void reset_error_handler (void); + +extern OCTINTERP_API int warning_enabled (const std::string& id); + +extern OCTINTERP_API void vmessage (const char *name, const char *fmt, va_list args); +extern OCTINTERP_API void message (const char *name, const char *fmt, ...); + +extern OCTINTERP_API void vusage (const char *fmt, va_list args); +extern OCTINTERP_API void usage (const char *fmt, ...); + +extern OCTINTERP_API void vwarning (const char *fmt, va_list args); +extern OCTINTERP_API void warning (const char *fmt, ...); + +extern OCTINTERP_API void verror (const char *fmt, va_list args); +extern OCTINTERP_API void error (const char *fmt, ...); + +extern OCTINTERP_API void verror_with_cfn (const char *fmt, va_list args); +extern OCTINTERP_API void error_with_cfn (const char *fmt, ...); + +extern OCTINTERP_API void vparse_error (const char *fmt, va_list args); +extern OCTINTERP_API void parse_error (const char *fmt, ...); + +extern OCTINTERP_API void +vmessage_with_id (const char *id, const char *name, const char *fmt, va_list args); + +extern OCTINTERP_API void +message_with_id (const char *id, const char *name, const char *fmt, ...); + +extern OCTINTERP_API void +vusage_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +usage_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +vwarning_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +warning_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +verror_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +error_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +verror_with_id_cfn (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +error_with_id_cfn (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +vparse_error_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +parse_error_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void panic (const char *fmt, ...) GCC_ATTR_NORETURN; + +// Helper function for print_usage defined in defun.cc. +extern OCTINTERP_API void defun_usage_message (const std::string& msg); + +extern OCTINTERP_API octave_value_list +set_warning_state (const std::string& id, const std::string& state); + +extern OCTINTERP_API octave_value_list +set_warning_state (const octave_value_list& args); + +extern OCTINTERP_API void disable_warning (const std::string& id); +extern OCTINTERP_API void initialize_default_warning_state (void); + +// TRUE means that Octave will try to enter the debugger when an error +// is encountered. This will also inhibit printing of the normal +// traceback message (you will only see the top-level error message). +extern OCTINTERP_API bool Vdebug_on_error; + +// TRUE means that Octave will try to enter the debugger when a warning +// is encountered. +extern OCTINTERP_API bool Vdebug_on_warning; + +// Current error state. +extern OCTINTERP_API int error_state; + +// Current warning state. +extern OCTINTERP_API int warning_state; + +// Tell the error handler whether to print messages, or just store +// them for later. Used for handling errors in eval() and +// the `unwind_protect' statement. +extern OCTINTERP_API int buffer_error_messages; + +// TRUE means error messages are turned off. +extern OCTINTERP_API bool discard_error_messages; + +// TRUE means warning messages are turned off. +extern OCTINTERP_API bool discard_warning_messages; + +// Helper functions to pass last error and warning messages and ids +extern OCTINTERP_API std::string last_error_message (void); +extern OCTINTERP_API std::string last_error_id (void); +extern OCTINTERP_API std::string last_warning_message (void); +extern OCTINTERP_API std::string last_warning_id (void); + +extern OCTINTERP_API void interpreter_try (unwind_protect&); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/file-io.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/file-io.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,2335 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Originally written by John C. Campbell +// +// Thomas Baier added the original versions of +// the following functions: +// +// popen +// pclose +// execute (now popen2.m) +// sync_system (now merged with system) +// async_system (now merged with system) + +// Extensively revised by John W. Eaton , +// April 1996. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include +#include + +#include +#include +#include + +#ifdef HAVE_ZLIB_H +#include +#endif + +#include "error.h" +#include "file-ops.h" +#include "file-stat.h" +#include "lo-ieee.h" +#include "oct-env.h" +#include "oct-locbuf.h" + +#include "defun.h" +#include "file-io.h" +#include "load-path.h" +#include "oct-fstrm.h" +#include "oct-iostrm.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "oct-prcstrm.h" +#include "oct-stream.h" +#include "oct-strstrm.h" +#include "pager.h" +#include "sysdep.h" +#include "utils.h" +#include "variables.h" + +static octave_value stdin_file; +static octave_value stdout_file; +static octave_value stderr_file; + +static octave_stream stdin_stream; +static octave_stream stdout_stream; +static octave_stream stderr_stream; + +void +initialize_file_io (void) +{ + stdin_stream = octave_istream::create (&std::cin, "stdin"); + + // This uses octave_stdout (see pager.h), not std::cout so that Octave's + // standard output stream will pass through the pager. + + stdout_stream = octave_ostream::create (&octave_stdout, "stdout"); + + stderr_stream = octave_ostream::create (&std::cerr, "stderr"); + + stdin_file = octave_stream_list::insert (stdin_stream); + stdout_file = octave_stream_list::insert (stdout_stream); + stderr_file = octave_stream_list::insert (stderr_stream); +} + +void +close_files (void) +{ + octave_stream_list::clear (); +} + +// List of files to delete when we exit or crash. +// +// FIXME -- this should really be static, but that causes +// problems on some systems. +std::stack tmp_files; + +void +mark_for_deletion (const std::string& file) +{ + tmp_files.push (file); +} + +void +cleanup_tmp_files (void) +{ + while (! tmp_files.empty ()) + { + std::string filename = tmp_files.top (); + tmp_files.pop (); + gnulib::unlink (filename.c_str ()); + } +} + +static std::ios::openmode +fopen_mode_to_ios_mode (const std::string& mode_arg) +{ + std::ios::openmode retval = std::ios::in; + + if (! mode_arg.empty ()) + { + // Could probably be faster, but does it really matter? + + std::string mode = mode_arg; + + // 'W' and 'R' are accepted as 'w' and 'r', but we warn about + // them because Matlab says they perform "automatic flushing" + // but we don't know precisely what action that implies. + + size_t pos = mode.find ('W'); + + if (pos != std::string::npos) + { + warning ("fopen: treating mode \"W\" as equivalent to \"w\""); + mode[pos] = 'w'; + } + + pos = mode.find ('R'); + + if (pos != std::string::npos) + { + warning ("fopen: treating mode \"R\" as equivalent to \"r\""); + mode[pos] = 'r'; + } + + pos = mode.find ('z'); + + if (pos != std::string::npos) + { +#if defined (HAVE_ZLIB) + mode.erase (pos, 1); +#else + error ("this version of Octave does not support gzipped files"); +#endif + } + + if (! error_state) + { + if (mode == "rt") + retval = std::ios::in; + else if (mode == "wt") + retval = std::ios::out | std::ios::trunc; + else if (mode == "at") + retval = std::ios::out | std::ios::app; + else if (mode == "r+t" || mode == "rt+") + retval = std::ios::in | std::ios::out; + else if (mode == "w+t" || mode == "wt+") + retval = std::ios::in | std::ios::out | std::ios::trunc; + else if (mode == "a+t" || mode == "at+") + retval = std::ios::in | std::ios::out | std::ios::app; + else if (mode == "rb" || mode == "r") + retval = std::ios::in | std::ios::binary; + else if (mode == "wb" || mode == "w") + retval = std::ios::out | std::ios::trunc | std::ios::binary; + else if (mode == "ab" || mode == "a") + retval = std::ios::out | std::ios::app | std::ios::binary; + else if (mode == "r+b" || mode == "rb+" || mode == "r+") + retval = std::ios::in | std::ios::out | std::ios::binary; + else if (mode == "w+b" || mode == "wb+" || mode == "w+") + retval = (std::ios::in | std::ios::out | std::ios::trunc + | std::ios::binary); + else if (mode == "a+b" || mode == "ab+" || mode == "a+") + retval = (std::ios::in | std::ios::out | std::ios::app + | std::ios::binary); + else + ::error ("invalid mode specified"); + } + } + + return retval; +} + +DEFUN (fclose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fclose (@var{fid})\n\ +@deftypefnx {Built-in Function} {} fclose (\"all\")\n\ +Close the specified file. If successful, @code{fclose} returns 0,\n\ +otherwise, it returns -1. The second form of the @code{fclose} call closes\n\ +all open files except @code{stdout}, @code{stderr}, and @code{stdin}.\n\ +@seealso{fopen, freport}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + retval = octave_stream_list::remove (args(0), "fclose"); + else + print_usage (); + + return retval; +} + +DEFUN (fclear, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fclear (@var{fid})\n\ +Clear the stream state for the specified file.\n\ +@seealso{fopen}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + int fid = octave_stream_list::get_file_number (args (0)); + + octave_stream os = octave_stream_list::lookup (fid, "fclear"); + + if (! error_state) + os.clearerr (); + } + else + print_usage (); + + return retval; +} + +DEFUN (fflush, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fflush (@var{fid})\n\ +Flush output to @var{fid}. This is useful for ensuring that all\n\ +pending output makes it to the screen before some other event occurs.\n\ +For example, it is always a good idea to flush the standard output\n\ +stream before calling @code{input}.\n\ +\n\ +@code{fflush} returns 0 on success and an OS dependent error value\n\ +(@minus{}1 on Unix) on error.\n\ +@seealso{fopen, fclose}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + // FIXME -- any way to avoid special case for stdout? + + int fid = octave_stream_list::get_file_number (args (0)); + + if (fid == 1) + { + flush_octave_stdout (); + + retval = 0; + } + else + { + octave_stream os = octave_stream_list::lookup (fid, "fflush"); + + if (! error_state) + retval = os.flush (); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fgetl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{str} =} fgetl (@var{fid})\n\ +@deftypefnx {Built-in Function} {@var{str} =} fgetl (@var{fid}, @var{len})\n\ +Read characters from a file, stopping after a newline, or EOF,\n\ +or @var{len} characters have been read. The characters read, excluding\n\ +the possible trailing newline, are returned as a string.\n\ +\n\ +If @var{len} is omitted, @code{fgetl} reads until the next newline\n\ +character.\n\ +\n\ +If there are no more characters to read, @code{fgetl} returns @minus{}1.\n\ +\n\ +To read a line and return the terminating newline see @code{fgets}.\n\ +@seealso{fgets, fscanf, fread, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fgetl"; + + octave_value_list retval; + + retval(1) = 0; + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); + + bool err = false; + + std::string tmp = os.getl (len_arg, err, who); + + if (! (error_state || err)) + { + retval(1) = tmp.length (); + retval(0) = tmp; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fgets, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{str} =} fgets (@var{fid})\n\ +@deftypefnx {Built-in Function} {@var{str} =} fgets (@var{fid}, @var{len})\n\ +Read characters from a file, stopping after a newline, or EOF,\n\ +or @var{len} characters have been read. The characters read, including\n\ +the possible trailing newline, are returned as a string.\n\ +\n\ +If @var{len} is omitted, @code{fgets} reads until the next newline\n\ +character.\n\ +\n\ +If there are no more characters to read, @code{fgets} returns @minus{}1.\n\ +\n\ +To read a line and discard the terminating newline see @code{fgetl}.\n\ +@seealso{fputs, fgetl, fscanf, fread, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fgets"; + + octave_value_list retval; + + retval(1) = 0.0; + retval(0) = -1.0; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); + + bool err = false; + + std::string tmp = os.gets (len_arg, err, who); + + if (! (error_state || err)) + { + retval(1) = tmp.length (); + retval(0) = tmp; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fskipl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{nlines} =} fskipl (@var{fid})\n\ +@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, @var{count})\n\ +@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, Inf)\n\ +Read and skip @var{count} lines from the file descriptor @var{fid}.\n\ +@code{fskipl} discards characters until an end-of-line is encountered exactly\n\ +@var{count}-times, or until the end-of-file marker is found.\n\ +\n\ +If @var{count} is omitted, it defaults to 1. @var{count} may also be\n\ +@code{Inf}, in which case lines are skipped until the end of the file.\n\ +This form is suitable for counting the number of lines in a file.\n\ +\n\ +Returns the number of lines skipped (end-of-line sequences encountered).\n\ +@seealso{fgetl, fgets, fscanf, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fskipl"; + + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + octave_value count_arg = (nargin == 2) ? args(1) : octave_value (); + + bool err = false; + + long tmp = os.skipl (count_arg, err, who); + + if (! (error_state || err)) + retval = tmp; + } + } + else + print_usage (); + + return retval; +} + + +static octave_stream +do_stream_open (const std::string& name, const std::string& mode, + const std::string& arch, int& fid) +{ + octave_stream retval; + + fid = -1; + + std::ios::openmode md = fopen_mode_to_ios_mode (mode); + + if (! error_state) + { + oct_mach_info::float_format flt_fmt = + oct_mach_info::string_to_float_format (arch); + + if (! error_state) + { + std::string fname = file_ops::tilde_expand (name); + + file_stat fs (fname); + + if (! (md & std::ios::out + || octave_env::absolute_pathname (fname) + || octave_env::rooted_relative_pathname (fname))) + { + if (! fs.exists ()) + { + std::string tmp + = octave_env::make_absolute (load_path::find_file (fname)); + + if (! tmp.empty ()) + { + warning_with_id ("Octave:fopen-file-in-path", + "fopen: file found in load path"); + fname = tmp; + } + } + } + + if (! fs.is_dir ()) + { + std::string tmode = mode; + + // Use binary mode if 't' is not specified, but don't add + // 'b' if it is already present. + + size_t bpos = tmode.find ('b'); + size_t tpos = tmode.find ('t'); + + if (bpos == std::string::npos && tpos == std::string::npos) + tmode += 'b'; + +#if defined (HAVE_ZLIB) + size_t pos = tmode.find ('z'); + + if (pos != std::string::npos) + { + tmode.erase (pos, 1); + + FILE *fptr = gnulib::fopen (fname.c_str (), tmode.c_str ()); + + int fd = fileno (fptr); + + gzFile gzf = ::gzdopen (fd, tmode.c_str ()); + + if (fptr) + retval = octave_zstdiostream::create (fname, gzf, fd, + md, flt_fmt); + else + retval.error (gnulib::strerror (errno)); + } + else +#endif + { + FILE *fptr = gnulib::fopen (fname.c_str (), tmode.c_str ()); + + retval = octave_stdiostream::create (fname, fptr, md, flt_fmt); + + if (! fptr) + retval.error (gnulib::strerror (errno)); + } + + } + } + } + + return retval; +} + +static octave_stream +do_stream_open (const octave_value& tc_name, const octave_value& tc_mode, + const octave_value& tc_arch, const char *fcn, int& fid) +{ + octave_stream retval; + + fid = -1; + + std::string name = tc_name.string_value (); + + if (! error_state) + { + std::string mode = tc_mode.string_value (); + + if (! error_state) + { + std::string arch = tc_arch.string_value (); + + if (! error_state) + retval = do_stream_open (name, mode, arch, fid); + else + ::error ("%s: architecture type must be a string", fcn); + } + else + ::error ("%s: file mode must be a string", fcn); + } + else + ::error ("%s: file name must be a string", fcn); + + return retval; +} + +DEFUN (fopen, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} fopen (@var{name}, @var{mode}, @var{arch})\n\ +@deftypefnx {Built-in Function} {@var{fid_list} =} fopen (\"all\")\n\ +@deftypefnx {Built-in Function} {[@var{file}, @var{mode}, @var{arch}] =} fopen (@var{fid})\n\ +The first form of the @code{fopen} function opens the named file with\n\ +the specified mode (read-write, read-only, etc.) and architecture\n\ +interpretation (IEEE big endian, IEEE little endian, etc.), and returns\n\ +an integer value that may be used to refer to the file later. If an\n\ +error occurs, @var{fid} is set to @minus{}1 and @var{msg} contains the\n\ +corresponding system error message. The @var{mode} is a one or two\n\ +character string that specifies whether the file is to be opened for\n\ +reading, writing, or both.\n\ +\n\ +The second form of the @code{fopen} function returns a vector of file ids\n\ +corresponding to all the currently open files, excluding the\n\ +@code{stdin}, @code{stdout}, and @code{stderr} streams.\n\ +\n\ +The third form of the @code{fopen} function returns information about the\n\ +open file given its file id.\n\ +\n\ +For example,\n\ +\n\ +@example\n\ +myfile = fopen (\"splat.dat\", \"r\", \"ieee-le\");\n\ +@end example\n\ +\n\ +@noindent\n\ +opens the file @file{splat.dat} for reading. If necessary, binary\n\ +numeric values will be read assuming they are stored in IEEE format with\n\ +the least significant bit first, and then converted to the native\n\ +representation.\n\ +\n\ +Opening a file that is already open simply opens it again and returns a\n\ +separate file id. It is not an error to open a file several times,\n\ +though writing to the same file through several different file ids may\n\ +produce unexpected results.\n\ +\n\ +The possible values @samp{mode} may have are\n\ +\n\ +@table @asis\n\ +@item @samp{r}\n\ +Open a file for reading.\n\ +\n\ +@item @samp{w}\n\ +Open a file for writing. The previous contents are discarded.\n\ +\n\ +@item @samp{a}\n\ +Open or create a file for writing at the end of the file.\n\ +\n\ +@item @samp{r+}\n\ +Open an existing file for reading and writing.\n\ +\n\ +@item @samp{w+}\n\ +Open a file for reading or writing. The previous contents are\n\ +discarded.\n\ +\n\ +@item @samp{a+}\n\ +Open or create a file for reading or writing at the end of the\n\ +file.\n\ +@end table\n\ +\n\ +Append a \"t\" to the mode string to open the file in text mode or a\n\ +\"b\" to open in binary mode. On Windows and Macintosh systems, text\n\ +mode reading and writing automatically converts linefeeds to the\n\ +appropriate line end character for the system (carriage-return linefeed\n\ +on Windows, carriage-return on Macintosh). The default if no mode is\n\ +specified is binary mode.\n\ +\n\ +Additionally, you may append a \"z\" to the mode string to open a\n\ +gzipped file for reading or writing. For this to be successful, you\n\ +must also open the file in binary mode.\n\ +\n\ +The parameter @var{arch} is a string specifying the default data format\n\ +for the file. Valid values for @var{arch} are:\n\ +\n\ +@table @asis\n\ +@samp{native}\n\ +The format of the current machine (this is the default).\n\ +\n\ +@samp{ieee-be}\n\ +IEEE big endian format.\n\ +\n\ +@samp{ieee-le}\n\ +IEEE little endian format.\n\ +\n\ +@samp{vaxd}\n\ +VAX D floating format.\n\ +\n\ +@samp{vaxg}\n\ +VAX G floating format.\n\ +\n\ +@samp{cray}\n\ +Cray floating format.\n\ +@end table\n\ +\n\ +@noindent\n\ +however, conversions are currently only supported for @samp{native}\n\ +@samp{ieee-be}, and @samp{ieee-le} formats.\n\ +@seealso{fclose, fgets, fgetl, fscanf, fread, fputs, fdisp, fprintf, fwrite, fskipl, fseek, frewind, ftell, feof, ferror, fclear, fflush, freport}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(0) = -1.0; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + // If there is only one argument and it is a string but it + // is not the string "all", we assume it is a file to open + // with MODE = "r". To open a file called "all", you have + // to supply more than one argument. + + if (nargout < 2 && args(0).string_value () == "all") + return octave_stream_list::open_file_numbers (); + } + else + { + string_vector tmp = octave_stream_list::get_info (args(0)); + + if (! error_state) + { + retval(2) = tmp(2); + retval(1) = tmp(1); + retval(0) = tmp(0); + } + + return retval; + } + } + + if (nargin > 0 && nargin < 4) + { + octave_value mode = (nargin == 2 || nargin == 3) + ? args(1) : octave_value ("r"); + + octave_value arch = (nargin == 3) + ? args(2) : octave_value ("native"); + + int fid = -1; + + octave_stream os = do_stream_open (args(0), mode, arch, "fopen", fid); + + if (os && ! error_state) + { + retval(1) = ""; + retval(0) = octave_stream_list::insert (os); + } + else + { + int error_number = 0; + + retval(1) = os.error (false, error_number); + retval(0) = -1.0; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (freport, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} freport ()\n\ +Print a list of which files have been opened, and whether they are open\n\ +for reading, writing, or both. For example:\n\ +\n\ +@example\n\ +@group\n\ +freport ()\n\ +\n\ + @print{} number mode name\n\ + @print{}\n\ + @print{} 0 r stdin\n\ + @print{} 1 w stdout\n\ + @print{} 2 w stderr\n\ + @print{} 3 r myfile\n\ +@end group\n\ +@end example\n\ +@seealso{fopen, fclose}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + warning ("freport: ignoring extra arguments"); + + octave_stdout << octave_stream_list::list_open_files (); + + return retval; +} + +DEFUN (frewind, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} frewind (@var{fid})\n\ +Move the file pointer to the beginning of the file @var{fid}, returning\n\ +0 for success, and -1 if an error was encountered. It is equivalent to\n\ +@code{fseek (@var{fid}, 0, SEEK_SET)}.\n\ +@seealso{fseek, ftell, fopen}\n\ +@end deftypefn") +{ + octave_value retval; + + int result = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_stream os = octave_stream_list::lookup (args(0), "frewind"); + + if (! error_state) + result = os.rewind (); + } + else + print_usage (); + + if (nargout > 0) + retval = result; + + return retval; +} + +DEFUN (fseek, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fseek (@var{fid}, @var{offset})\n\ +@deftypefnx {Built-in Function} {} fseek (@var{fid}, @var{offset}, @var{origin})\n\ +@deftypefnx {Built-in Function} {@var{status} =} fseek (@dots{})\n\ +Set the file pointer to any location within the file @var{fid}.\n\ +\n\ +The pointer is positioned @var{offset} characters from the @var{origin},\n\ +which may be one of the predefined variables @w{@code{SEEK_CUR}} (current\n\ +position), @w{@code{SEEK_SET}} (beginning), or @w{@code{SEEK_END}} (end of\n\ +file) or strings \"cof\", \"bof\" or \"eof\". If @var{origin} is omitted,\n\ +@w{@code{SEEK_SET}} is assumed. @var{offset} may be positive, negative, or zero but not all combinations of @var{origin} and @var{offset} can be realized.\n\ +\n\ +Return 0 on success and -1 on error.\n\ +@seealso{fskipl, frewind, ftell, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + octave_stream os = octave_stream_list::lookup (args(0), "fseek"); + + if (! error_state) + { + octave_value origin_arg = (nargin == 3) + ? args(2) : octave_value (-1.0); + + retval = os.seek (args(1), origin_arg); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (ftell, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ftell (@var{fid})\n\ +Return the position of the file pointer as the number of characters\n\ +from the beginning of the file @var{fid}.\n\ +@seealso{fseek, feof, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_stream os = octave_stream_list::lookup (args(0), "ftell"); + + if (! error_state) + retval = os.tell (); + } + else + print_usage (); + + return retval; +} + +DEFUN (fprintf, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fprintf (@var{fid}, @var{template}, @dots{})\n\ +This function is just like @code{printf}, except that the output is\n\ +written to the stream @var{fid} instead of @code{stdout}.\n\ +If @var{fid} is omitted, the output is written to @code{stdout}.\n\ +@seealso{fputs, fdisp, fwrite, fscanf, printf, sprintf, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fprintf"; + + octave_value retval; + + int result = -1; + + int nargin = args.length (); + + if (nargin > 1 || (nargin > 0 && args(0).is_string ())) + { + octave_stream os; + int fmt_n = 0; + + if (args(0).is_string ()) + { + os = octave_stream_list::lookup (1, who); + } + else + { + fmt_n = 1; + os = octave_stream_list::lookup (args(0), who); + } + + if (! error_state) + { + if (args(fmt_n).is_string ()) + { + octave_value_list tmp_args; + + if (nargin > 1 + fmt_n) + { + tmp_args.resize (nargin-fmt_n-1, octave_value ()); + + for (int i = fmt_n + 1; i < nargin; i++) + tmp_args(i-fmt_n-1) = args(i); + } + + result = os.printf (args(fmt_n), tmp_args, who); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + } + else + print_usage (); + + if (nargout > 0) + retval = result; + + return retval; +} + +DEFUN (printf, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} printf (@var{template}, @dots{})\n\ +Print optional arguments under the control of the template string\n\ +@var{template} to the stream @code{stdout} and return the number of\n\ +characters printed.\n\ +@ifclear OCTAVE_MANUAL\n\ +\n\ +See the Formatted Output section of the GNU Octave manual for a\n\ +complete description of the syntax of the template string.\n\ +@end ifclear\n\ +@seealso{fprintf, sprintf, scanf}\n\ +@end deftypefn") +{ + static std::string who = "printf"; + + octave_value retval; + + int result = -1; + + int nargin = args.length (); + + if (nargin > 0) + { + if (args(0).is_string ()) + { + octave_value_list tmp_args; + + if (nargin > 1) + { + tmp_args.resize (nargin-1, octave_value ()); + + for (int i = 1; i < nargin; i++) + tmp_args(i-1) = args(i); + } + + result = stdout_stream.printf (args(0), tmp_args, who); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + print_usage (); + + if (nargout > 0) + retval = result; + + return retval; +} + +DEFUN (fputs, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fputs (@var{fid}, @var{string})\n\ +Write a string to a file with no formatting.\n\ +\n\ +Return a non-negative number on success and EOF on error.\n\ +@seealso{fdisp, fprintf, fwrite, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fputs"; + + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + retval = os.puts (args(1), who); + } + else + print_usage (); + + return retval; +} + +DEFUN (puts, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} puts (@var{string})\n\ +Write a string to the standard output with no formatting.\n\ +\n\ +Return a non-negative number on success and EOF on error.\n\ +@seealso{fputs, disp}\n\ +@end deftypefn") +{ + static std::string who = "puts"; + + octave_value retval = -1; + + if (args.length () == 1) + retval = stdout_stream.puts (args(0), who); + else + print_usage (); + + return retval; +} + +DEFUN (sprintf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sprintf (@var{template}, @dots{})\n\ +This is like @code{printf}, except that the output is returned as a\n\ +string. Unlike the C library function, which requires you to provide a\n\ +suitably sized string as an argument, Octave's @code{sprintf} function\n\ +returns the string, automatically sized to hold all of the items\n\ +converted.\n\ +@seealso{printf, fprintf, sscanf}\n\ +@end deftypefn") +{ + static std::string who = "sprintf"; + + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + retval(2) = -1.0; + retval(1) = "unknown error"; + retval(0) = ""; + + octave_ostrstream *ostr = new octave_ostrstream (); + + octave_stream os (ostr); + + if (os.is_valid ()) + { + octave_value fmt_arg = args(0); + + if (fmt_arg.is_string ()) + { + octave_value_list tmp_args; + + if (nargin > 1) + { + tmp_args.resize (nargin-1, octave_value ()); + + for (int i = 1; i < nargin; i++) + tmp_args(i-1) = args(i); + } + + retval(2) = os.printf (fmt_arg, tmp_args, who); + retval(1) = os.error (); + retval(0) = octave_value (ostr->str (), + fmt_arg.is_sq_string () ? '\'' : '"'); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + ::error ("%s: unable to create output buffer", who.c_str ()); + } + else + print_usage (); + + return retval; +} + +DEFUN (fscanf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} fscanf (@var{fid}, @var{template}, @var{locale})\n\ +In the first form, read from @var{fid} according to @var{template},\n\ +returning the result in the matrix @var{val}.\n\ +\n\ +The optional argument @var{size} specifies the amount of data to read\n\ +and may be one of\n\ +\n\ +@table @code\n\ +@item Inf\n\ +Read as much as possible, returning a column vector.\n\ +\n\ +@item @var{nr}\n\ +Read up to @var{nr} elements, returning a column vector.\n\ +\n\ +@item [@var{nr}, Inf]\n\ +Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ +number of elements read is not an exact multiple of @var{nr}, the last\n\ +column is padded with zeros.\n\ +\n\ +@item [@var{nr}, @var{nc}]\n\ +Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ +@var{nr} rows. If the number of elements read is not an exact multiple\n\ +of @var{nr}, the last column is padded with zeros.\n\ +@end table\n\ +\n\ +@noindent\n\ +If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ +\n\ +A string is returned if @var{template} specifies only character\n\ +conversions.\n\ +\n\ +The number of items successfully read is returned in @var{count}.\n\ +\n\ +If an error occurs, @var{errmsg} contains a system-dependent error message.\n\ +\n\ +In the second form, read from @var{fid} according to @var{template},\n\ +with each conversion specifier in @var{template} corresponding to a\n\ +single scalar return value. This form is more `C-like', and also\n\ +compatible with previous versions of Octave. The number of successful\n\ +conversions is returned in @var{count}. It permits to explicitly\n\ +specify a locale to take into account language specific features, \n\ +such as decimal separator. This operation restores the previous locales\n\ +setting at the end of the conversion.\n\ +@ifclear OCTAVE_MANUAL\n\ +\n\ +See the Formatted Input section of the GNU Octave manual for a\n\ +complete description of the syntax of the template string.\n\ +@end ifclear\n\ +@seealso{fgets, fgetl, fread, scanf, sscanf, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fscanf"; + + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 3 && args(2).is_string ()) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + if (args(1).is_string ()) + { + std::locale oldloc; + try + { + // Use args(2) val as the new locale setting. Keep + // old val for restoring afterwards. + oldloc = + os.imbue (std::locale (args(2).string_value ().c_str ())); + + } + catch (std::runtime_error) + { + // Display a warning if the specified locale is unknown + warning ("fscanf: invalid locale. Try `locale -a' for a list of supported values."); + oldloc = std::locale::classic (); + } + retval = os.oscanf (args(1), who); + os.imbue (oldloc); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + } + else + { + retval(2) = "unknown error"; + retval(1) = 0.0; + retval(0) = Matrix (); + + if (nargin == 2 || nargin == 3) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + if (args(1).is_string ()) + { + octave_idx_type count = 0; + + Array size = (nargin == 3) + ? args(2).vector_value () + : Array (dim_vector (1, 1), lo_ieee_inf_value ()); + + if (! error_state) + { + octave_value tmp = os.scanf (args(1), size, count, who); + + if (! error_state) + { + retval(2) = os.error (); + retval(1) = count; + retval(0) = tmp; + } + } + } + else + ::error ("%s: format must be a string", who.c_str ()); + } + } + else + print_usage (); + } + + return retval; +} + +static std::string +get_sscanf_data (const octave_value& val) +{ + std::string retval; + + if (val.is_string ()) + { + octave_value tmp = val.reshape (dim_vector (1, val.numel ())); + + retval = tmp.string_value (); + } + else + ::error ("sscanf: argument STRING must be a string"); + + return retval; +} + +DEFUN (sscanf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}, @var{pos}] =} sscanf (@var{string}, @var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} sscanf (@var{string}, @var{template}, @var{locale})\n\ +This is like @code{fscanf}, except that the characters are taken from the\n\ +string @var{string} instead of from a stream. Reaching the end of the\n\ +string is treated as an end-of-file condition. In addition to the values\n\ +returned by @code{fscanf}, the index of the next character to be read\n\ +is returned in @var{pos}.\n\ +@seealso{fscanf, scanf, sprintf}\n\ +@end deftypefn") +{ + static std::string who = "sscanf"; + + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 3 && args(2).is_string ()) + { + std::string data = get_sscanf_data (args(0)); + + if (! error_state) + { + octave_stream os = octave_istrstream::create (data); + + if (os.is_valid ()) + { + if (args(1).is_string ()) + { + // Use args(2) val as the new locale setting. As the os + // object is short lived, we don't need to restore + // locale afterwards. + try + { + os.imbue (std::locale (args(2).string_value ().c_str ())); + } + catch (std::runtime_error) + { + // Display a warning if the specified locale is unknown + warning ("sscanf: invalid locale. Try `locale -a' for a list of supported values."); + } + retval = os.oscanf (args(1), who); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + ::error ("%s: unable to create temporary input buffer", + who.c_str ()); + } + else + ::error ("%s: argument STRING must be a string", who.c_str ()); + } + else + { + if (nargin == 2 || nargin == 3) + { + retval(3) = -1.0; + retval(2) = "unknown error"; + retval(1) = 0.0; + retval(0) = Matrix (); + + std::string data = get_sscanf_data (args(0)); + + if (! error_state) + { + octave_stream os = octave_istrstream::create (data); + + if (os.is_valid ()) + { + if (args(1).is_string ()) + { + octave_idx_type count = 0; + + Array size = (nargin == 3) + ? args(2).vector_value () + : Array (dim_vector (1, 1), + lo_ieee_inf_value ()); + + octave_value tmp = os.scanf (args(1), size, count, who); + + if (! error_state) + { + // FIXME -- is this the right thing to do? + // Extract error message first, because getting + // position will clear it. + std::string errmsg = os.error (); + + retval(3) + = (os.eof () ? data.length () : os.tell ()) + 1; + retval(2) = errmsg; + retval(1) = count; + retval(0) = tmp; + } + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + ::error ("%s: unable to create temporary input buffer", + who.c_str ()); + } + } + else + print_usage (); + } + + return retval; +} + +/* +%!test +%! assert (sscanf ("1,2", "%f", "C"), 1) +%! assert (sscanf ("1,2", "%f", "fr_FR"), 1.2) +*/ + +DEFUN (scanf, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} scanf (@var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} scanf (@var{template}, @var{locale})\n\ +This is equivalent to calling @code{fscanf} with @var{fid} = @code{stdin}.\n\ +\n\ +It is currently not useful to call @code{scanf} in interactive\n\ +programs.\n\ +@seealso{fscanf, sscanf, printf}\n\ +@end deftypefn") +{ + int nargin = args.length (); + + octave_value_list tmp_args (nargin+1, octave_value ()); + + tmp_args (0) = 0.0; + for (int i = 0; i < nargin; i++) + tmp_args (i+1) = args (i); + + return Ffscanf (tmp_args, nargout); +} + +static octave_value +do_fread (octave_stream& os, const octave_value& size_arg, + const octave_value& prec_arg, const octave_value& skip_arg, + const octave_value& arch_arg, octave_idx_type& count) +{ + octave_value retval; + + count = -1; + + Array size = size_arg.vector_value (); + + if (! error_state) + { + std::string prec = prec_arg.string_value (); + + if (! error_state) + { + int block_size = 1; + oct_data_conv::data_type input_type; + oct_data_conv::data_type output_type; + + oct_data_conv::string_to_data_type (prec, block_size, + input_type, output_type); + + if (! error_state) + { + int skip = skip_arg.int_value (true); + + if (! error_state) + { + std::string arch = arch_arg.string_value (); + + if (! error_state) + { + oct_mach_info::float_format flt_fmt + = oct_mach_info::string_to_float_format (arch); + + if (! error_state) + retval = os.read (size, block_size, input_type, + output_type, skip, flt_fmt, count); + } + else + ::error ("fread: ARCH architecture type must be a string"); + } + else + ::error ("fread: SKIP must be an integer"); + } + else + ::error ("fread: invalid PRECISION specified"); + } + else + ::error ("fread: PRECISION must be a string"); + } + else + ::error ("fread: invalid SIZE specified"); + + return retval; +} + +DEFUN (fread, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}] =} fread (@var{fid}, @var{size}, @var{precision}, @var{skip}, @var{arch})\n\ +Read binary data of type @var{precision} from the specified file ID\n\ +@var{fid}.\n\ +\n\ +The optional argument @var{size} specifies the amount of data to read\n\ +and may be one of\n\ +\n\ +@table @code\n\ +@item Inf\n\ +Read as much as possible, returning a column vector.\n\ +\n\ +@item @var{nr}\n\ +Read up to @var{nr} elements, returning a column vector.\n\ +\n\ +@item [@var{nr}, Inf]\n\ +Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ +number of elements read is not an exact multiple of @var{nr}, the last\n\ +column is padded with zeros.\n\ +\n\ +@item [@var{nr}, @var{nc}]\n\ +Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ +@var{nr} rows. If the number of elements read is not an exact multiple\n\ +of @var{nr}, the last column is padded with zeros.\n\ +@end table\n\ +\n\ +@noindent\n\ +If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ +\n\ +The optional argument @var{precision} is a string specifying the type of\n\ +data to read and may be one of\n\ +\n\ +@table @asis\n\ +@item \"schar\"\n\ +@itemx \"signed char\"\n\ +Signed character.\n\ +\n\ +@item \"uchar\"\n\ +@itemx \"unsigned char\"\n\ +Unsigned character.\n\ +\n\ +@item \"int8\"\n\ +@itemx \"integer*1\"\n\ +\n\ +8-bit signed integer.\n\ +\n\ +@item \"int16\"\n\ +@itemx \"integer*2\"\n\ +16-bit signed integer.\n\ +\n\ +@item \"int32\"\n\ +@itemx \"integer*4\"\n\ +32-bit signed integer.\n\ +\n\ +@item \"int64\"\n\ +@itemx \"integer*8\"\n\ +64-bit signed integer.\n\ +\n\ +@item \"uint8\"\n\ +8-bit unsigned integer.\n\ +\n\ +@item \"uint16\"\n\ +16-bit unsigned integer.\n\ +\n\ +@item \"uint32\"\n\ +32-bit unsigned integer.\n\ +\n\ +@item \"uint64\"\n\ +64-bit unsigned integer.\n\ +\n\ +@item \"single\"\n\ +@itemx \"float32\"\n\ +@itemx \"real*4\"\n\ +32-bit floating point number.\n\ +\n\ +@item \"double\"\n\ +@itemx \"float64\"\n\ +@itemx \"real*8\"\n\ +64-bit floating point number.\n\ +\n\ +@item \"char\"\n\ +@itemx \"char*1\"\n\ +Single character.\n\ +\n\ +@item \"short\"\n\ +Short integer (size is platform dependent).\n\ +\n\ +@item \"int\"\n\ +Integer (size is platform dependent).\n\ +\n\ +@item \"long\"\n\ +Long integer (size is platform dependent).\n\ +\n\ +@item \"ushort\"\n\ +@itemx \"unsigned short\"\n\ +Unsigned short integer (size is platform dependent).\n\ +\n\ +@item \"uint\"\n\ +@itemx \"unsigned int\"\n\ +Unsigned integer (size is platform dependent).\n\ +\n\ +@item \"ulong\"\n\ +@itemx \"unsigned long\"\n\ +Unsigned long integer (size is platform dependent).\n\ +\n\ +@item \"float\"\n\ +Single precision floating point number (size is platform dependent).\n\ +@end table\n\ +\n\ +@noindent\n\ +The default precision is @code{\"uchar\"}.\n\ +\n\ +The @var{precision} argument may also specify an optional repeat\n\ +count. For example, @samp{32*single} causes @code{fread} to read\n\ +a block of 32 single precision floating point numbers. Reading in\n\ +blocks is useful in combination with the @var{skip} argument.\n\ +\n\ +The @var{precision} argument may also specify a type conversion.\n\ +For example, @samp{int16=>int32} causes @code{fread} to read 16-bit\n\ +integer values and return an array of 32-bit integer values. By\n\ +default, @code{fread} returns a double precision array. The special\n\ +form @samp{*TYPE} is shorthand for @samp{TYPE=>TYPE}.\n\ +\n\ +The conversion and repeat counts may be combined. For example, the\n\ +specification @samp{32*single=>single} causes @code{fread} to read\n\ +blocks of single precision floating point values and return an array\n\ +of single precision values instead of the default array of double\n\ +precision values.\n\ +\n\ +The optional argument @var{skip} specifies the number of bytes to skip\n\ +after each element (or block of elements) is read. If it is not\n\ +specified, a value of 0 is assumed. If the final block read is not\n\ +complete, the final skip is omitted. For example,\n\ +\n\ +@example\n\ +fread (f, 10, \"3*single=>single\", 8)\n\ +@end example\n\ +\n\ +@noindent\n\ +will omit the final 8-byte skip because the last read will not be\n\ +a complete block of 3 values.\n\ +\n\ +The optional argument @var{arch} is a string specifying the data format\n\ +for the file. Valid values are\n\ +\n\ +@table @code\n\ +@item \"native\"\n\ +The format of the current machine.\n\ +\n\ +@item \"ieee-be\"\n\ +IEEE big endian.\n\ +\n\ +@item \"ieee-le\"\n\ +IEEE little endian.\n\ +\n\ +@item \"vaxd\"\n\ +VAX D floating format.\n\ +\n\ +@item \"vaxg\"\n\ +VAX G floating format.\n\ +\n\ +@item \"cray\"\n\ +Cray floating format.\n\ +@end table\n\ +\n\ +@noindent\n\ +Conversions are currently only supported for @code{\"ieee-be\"} and\n\ +@code{\"ieee-le\"} formats.\n\ +\n\ +The data read from the file is returned in @var{val}, and the number of\n\ +values read is returned in @code{count}\n\ +@seealso{fwrite, fgets, fgetl, fscanf, fopen}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0 && nargin < 6) + { + retval(1) = -1.0; + retval(0) = Matrix (); + + octave_stream os = octave_stream_list::lookup (args(0), "fread"); + + if (! error_state) + { + octave_value size = lo_ieee_inf_value (); + octave_value prec = "uchar"; + octave_value skip = 0; + octave_value arch = "unknown"; + + int idx = 1; + + if (nargin > idx && ! args(idx).is_string ()) + size = args(idx++); + + if (nargin > idx) + prec = args(idx++); + + if (nargin > idx) + skip = args(idx++); + + if (nargin > idx) + arch = args(idx++); + else if (skip.is_string ()) + { + arch = skip; + skip = 0; + } + + octave_idx_type count = -1; + + octave_value tmp = do_fread (os, size, prec, skip, arch, count); + + retval(1) = count; + retval(0) = tmp; + } + } + else + print_usage (); + + return retval; +} + +static int +do_fwrite (octave_stream& os, const octave_value& data, + const octave_value& prec_arg, const octave_value& skip_arg, + const octave_value& arch_arg) +{ + int retval = -1; + + std::string prec = prec_arg.string_value (); + + if (! error_state) + { + int block_size = 1; + oct_data_conv::data_type output_type; + + oct_data_conv::string_to_data_type (prec, block_size, output_type); + + if (! error_state) + { + int skip = skip_arg.int_value (true); + + if (! error_state) + { + std::string arch = arch_arg.string_value (); + + if (! error_state) + { + oct_mach_info::float_format flt_fmt + = oct_mach_info::string_to_float_format (arch); + + if (! error_state) + retval = os.write (data, block_size, output_type, + skip, flt_fmt); + } + else + ::error ("fwrite: ARCH architecture type must be a string"); + } + else + ::error ("fwrite: SKIP must be an integer"); + } + else + ::error ("fwrite: invalid PRECISION specified"); + } + else + ::error ("fwrite: PRECISION must be a string"); + + return retval; +} + +DEFUN (fwrite, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{count} =} fwrite (@var{fid}, @var{data}, @var{precision}, @var{skip}, @var{arch})\n\ +Write data in binary form of type @var{precision} to the specified file\n\ +ID @var{fid}, returning the number of values successfully written to the\n\ +file.\n\ +\n\ +The argument @var{data} is a matrix of values that are to be written to\n\ +the file. The values are extracted in column-major order.\n\ +\n\ +The remaining arguments @var{precision}, @var{skip}, and @var{arch} are\n\ +optional, and are interpreted as described for @code{fread}.\n\ +\n\ +The behavior of @code{fwrite} is undefined if the values in @var{data}\n\ +are too large to fit in the specified precision.\n\ +@seealso{fread, fputs, fprintf, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin > 1 && nargin < 6) + { + octave_stream os = octave_stream_list::lookup (args(0), "fwrite"); + + if (! error_state) + { + octave_value prec = "uchar"; + octave_value skip = 0; + octave_value arch = "unknown"; + + int idx = 1; + + octave_value data = args(idx++); + + if (nargin > idx) + prec = args(idx++); + + if (nargin > idx) + skip = args(idx++); + + if (nargin > idx) + arch = args(idx++); + else if (skip.is_string ()) + { + arch = skip; + skip = 0; + } + + double status = do_fwrite (os, data, prec, skip, arch); + + retval = status; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("feof", Ffeof, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} feof (@var{fid})\n\ +Return 1 if an end-of-file condition has been encountered for a given\n\ +file and 0 otherwise. Note that it will only return 1 if the end of the\n\ +file has already been encountered, not if the next read operation will\n\ +result in an end-of-file condition.\n\ +@seealso{fread, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_stream os = octave_stream_list::lookup (args(0), "feof"); + + if (! error_state) + retval = os.eof () ? 1.0 : 0.0; + } + else + print_usage (); + + return retval; +} + +DEFUNX ("ferror", Fferror, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid})\n\ +@deftypefnx {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid}, \"clear\")\n\ +Return 1 if an error condition has been encountered for the file ID\n\ +@var{fid} and 0 otherwise. Note that it will only return 1 if an error\n\ +has already been encountered, not if the next operation will result in\n\ +an error condition.\n\ +\n\ +The second argument is optional. If it is supplied, also clear the\n\ +error condition.\n\ +@seealso{fclear, fopen}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), "ferror"); + + if (! error_state) + { + bool clear = false; + + if (nargin == 2) + { + std::string opt = args(1).string_value (); + + if (! error_state) + clear = (opt == "clear"); + else + return retval; + } + + int error_number = 0; + + std::string error_message = os.error (clear, error_number); + + retval(1) = error_number; + retval(0) = error_message; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (popen, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{fid} =} popen (@var{command}, @var{mode})\n\ +Start a process and create a pipe. The name of the command to run is\n\ +given by @var{command}. The file identifier corresponding to the input\n\ +or output stream of the process is returned in @var{fid}. The argument\n\ +@var{mode} may be\n\ +\n\ +@table @code\n\ +@item \"r\"\n\ +The pipe will be connected to the standard output of the process, and\n\ +open for reading.\n\ +\n\ +@item \"w\"\n\ +The pipe will be connected to the standard input of the process, and\n\ +open for writing.\n\ +@end table\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +fid = popen (\"ls -ltr / | tail -3\", \"r\");\n\ +while (ischar (s = fgets (fid)))\n\ + fputs (stdout, s);\n\ +endwhile\n\ +\n\ + @print{} drwxr-xr-x 33 root root 3072 Feb 15 13:28 etc\n\ + @print{} drwxr-xr-x 3 root root 1024 Feb 15 13:28 lib\n\ + @print{} drwxrwxrwt 15 root root 2048 Feb 17 14:53 tmp\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + std::string mode = args(1).string_value (); + + if (! error_state) + { + if (mode == "r") + { + octave_stream ips = octave_iprocstream::create (name); + + retval = octave_stream_list::insert (ips); + } + else if (mode == "w") + { + octave_stream ops = octave_oprocstream::create (name); + + retval = octave_stream_list::insert (ops); + } + else + ::error ("popen: invalid MODE specified"); + } + else + ::error ("popen: MODE must be a string"); + } + else + ::error ("popen: COMMAND must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (pclose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pclose (@var{fid})\n\ +Close a file identifier that was opened by @code{popen}. You may also\n\ +use @code{fclose} for the same purpose.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + retval = octave_stream_list::remove (args(0), "pclose"); + else + print_usage (); + + return retval; +} + +DEFUNX ("tmpnam", Ftmpnam, args, , + "-*- texinfo -*-\n\ +@c List other forms of function in documentation index\n\ +@findex octave_tmp_file_name\n\ +\n\ +@deftypefn {Built-in Function} {} tmpnam ()\n\ +@deftypefnx {Built-in Function} {} tmpnam (@var{dir})\n\ +@deftypefnx {Built-in Function} {} tmpnam (@var{dir}, @var{prefix})\n\ +Return a unique temporary file name as a string.\n\ +\n\ +If @var{prefix} is omitted, a value of @code{\"oct-\"} is used.\n\ +If @var{dir} is also omitted, the default directory for temporary files\n\ +is used. If @var{dir} is provided, it must exist, otherwise the default\n\ +directory for temporary files is used. Since the named file is not\n\ +opened, by @code{tmpnam}, it is possible (though relatively unlikely)\n\ +that it will not be available by the time your program attempts to open it.\n\ +@seealso{tmpfile, mkstemp, P_tmpdir}\n\ +@end deftypefn") +{ + octave_value retval; + + int len = args.length (); + + if (len < 3) + { + std::string dir = len > 0 ? args(0).string_value () : std::string (); + + if (! error_state) + { + std::string pfx + = len > 1 ? args(1).string_value () : std::string ("oct-"); + + if (! error_state) + retval = octave_tempnam (dir, pfx); + else + ::error ("PREFIX must be a string"); + } + else + ::error ("DIR argument must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFALIAS (octave_tmp_file_name, tmpnam); + +DEFUN (tmpfile, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} tmpfile ()\n\ +Return the file ID corresponding to a new temporary file with a unique\n\ +name. The file is opened in binary read/write (@code{\"w+b\"}) mode.\n\ +The file will be deleted automatically when it is closed or when Octave\n\ +exits.\n\ +\n\ +If successful, @var{fid} is a valid file ID and @var{msg} is an empty\n\ +string. Otherwise, @var{fid} is -1 and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{tmpnam, mkstemp, P_tmpdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + FILE *fid = gnulib::tmpfile (); + + if (fid) + { + std::string nm; + + std::ios::openmode md = fopen_mode_to_ios_mode ("w+b"); + + octave_stream s = octave_stdiostream::create (nm, fid, md); + + if (s) + retval(0) = octave_stream_list::insert (s); + else + error ("tmpfile: failed to create octave_stdiostream object"); + + } + else + { + retval(1) = gnulib::strerror (errno); + retval(0) = -1; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (mkstemp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{name}, @var{msg}] =} mkstemp (@var{template}, @var{delete})\n\ +Return the file ID corresponding to a new temporary file with a unique\n\ +name created from @var{template}. The last six characters of @var{template}\n\ +must be @code{XXXXXX} and these are replaced with a string that makes the\n\ +filename unique. The file is then created with mode read/write and\n\ +permissions that are system dependent (on GNU/Linux systems, the permissions\n\ +will be 0600 for versions of glibc 2.0.7 and later). The file is opened\n\ +in binary mode and with the @w{@code{O_EXCL}} flag.\n\ +\n\ +If the optional argument @var{delete} is supplied and is true,\n\ +the file will be deleted automatically when Octave exits, or when\n\ +the function @code{purge_tmp_files} is called.\n\ +\n\ +If successful, @var{fid} is a valid file ID, @var{name} is the name of\n\ +the file, and @var{msg} is an empty string. Otherwise, @var{fid}\n\ +is -1, @var{name} is empty, and @var{msg} contains a system-dependent\n\ +error message.\n\ +@seealso{tmpfile, tmpnam, P_tmpdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string tmpl8 = args(0).string_value (); + + if (! error_state) + { + OCTAVE_LOCAL_BUFFER (char, tmp, tmpl8.size () + 1); + strcpy (tmp, tmpl8.c_str ()); + + int fd = gnulib::mkostemp (tmp, O_BINARY); + + if (fd < 0) + { + retval(2) = gnulib::strerror (errno); + retval(0) = fd; + } + else + { + const char *fopen_mode = "w+b"; + + FILE *fid = fdopen (fd, fopen_mode); + + if (fid) + { + std::string nm = tmp; + + std::ios::openmode md = fopen_mode_to_ios_mode (fopen_mode); + + octave_stream s = octave_stdiostream::create (nm, fid, md); + + if (s) + { + retval(1) = nm; + retval(0) = octave_stream_list::insert (s); + + if (nargin == 2 && args(1).is_true ()) + mark_for_deletion (nm); + } + else + error ("mkstemp: failed to create octave_stdiostream object"); + } + else + { + retval(2) = gnulib::strerror (errno); + retval(0) = -1; + } + } + } + else + error ("mkstemp: TEMPLATE argument must be a string"); + } + else + print_usage (); + + return retval; +} + +static int +convert (int x, int ibase, int obase) +{ + int retval = 0; + + int tmp = x % obase; + + if (tmp > ibase - 1) + ::error ("umask: invalid digit"); + else + { + retval = tmp; + int mult = ibase; + while ((x = (x - tmp) / obase)) + { + tmp = x % obase; + if (tmp > ibase - 1) + { + ::error ("umask: invalid digit"); + break; + } + retval += mult * tmp; + mult *= ibase; + } + } + + return retval; +} + +DEFUNX ("umask", Fumask, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} umask (@var{mask})\n\ +Set the permission mask for file creation. The parameter @var{mask}\n\ +is an integer, interpreted as an octal number. If successful,\n\ +returns the previous value of the mask (as an integer to be\n\ +interpreted as an octal number); otherwise an error message is printed.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int status = 0; + + if (args.length () == 1) + { + int mask = args(0).int_value (true); + + if (! error_state) + { + if (mask < 0) + { + status = -1; + ::error ("umask: MASK must be a positive integer value"); + } + else + { + int oct_mask = convert (mask, 8, 10); + + if (! error_state) + status = convert (octave_umask (oct_mask), 10, 8); + } + } + else + { + status = -1; + ::error ("umask: MASK must be an integer"); + } + } + else + print_usage (); + + if (status >= 0) + retval(0) = status; + + return retval; +} + +static octave_value +const_value (const char *, const octave_value_list& args, int val) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = val; + else + print_usage (); + + return retval; +} + +DEFUNX ("P_tmpdir", FP_tmpdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} P_tmpdir ()\n\ +Return the default name of the directory for temporary files on\n\ +this system. The name of this directory is system dependent.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = get_P_tmpdir (); + else + print_usage (); + + return retval; +} + +// NOTE: the values of SEEK_SET, SEEK_CUR, and SEEK_END have to be +// this way for Matlab compatibility. + +DEFUNX ("SEEK_SET", FSEEK_SET, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SEEK_SET ()\n\ +@deftypefnx {Built-in Function} {} SEEK_CUR ()\n\ +@deftypefnx {Built-in Function} {} SEEK_END ()\n\ +Return the numerical value to pass to @code{fseek} to perform\n\ +one of the following actions:\n\ +\n\ +@table @code\n\ +@item SEEK_SET\n\ +Position file relative to the beginning.\n\ +\n\ +@item SEEK_CUR\n\ +Position file relative to the current position.\n\ +\n\ +@item SEEK_END\n\ +Position file relative to the end.\n\ +@end table\n\ +@seealso{fseek}\n\ +@end deftypefn") +{ + return const_value ("SEEK_SET", args, -1); +} + +DEFUNX ("SEEK_CUR", FSEEK_CUR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SEEK_CUR ()\n\ +Return the numerical value to pass to @code{fseek} to\n\ +position the file pointer relative to the current position.\n\ +@seealso{SEEK_SET, SEEK_END}.\n\ +@end deftypefn") +{ + return const_value ("SEEK_CUR", args, 0); +} + +DEFUNX ("SEEK_END", FSEEK_END, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SEEK_END ()\n\ +Return the numerical value to pass to @code{fseek} to\n\ +position the file pointer relative to the end of the file.\n\ +@seealso{SEEK_SET, SEEK_CUR}.\n\ +@end deftypefn") +{ + return const_value ("SEEK_END", args, 1); +} + +static octave_value +const_value (const char *, const octave_value_list& args, + const octave_value& val) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = val; + else + print_usage (); + + return retval; +} + +DEFUNX ("stdin", Fstdin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} stdin ()\n\ +Return the numeric value corresponding to the standard input stream.\n\ +When Octave is used interactively, this is filtered through the command\n\ +line editing functions.\n\ +@seealso{stdout, stderr}\n\ +@end deftypefn") +{ + return const_value ("stdin", args, stdin_file); +} + +DEFUNX ("stdout", Fstdout, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} stdout ()\n\ +Return the numeric value corresponding to the standard output stream.\n\ +Data written to the standard output is normally filtered through the pager.\n\ +@seealso{stdin, stderr}\n\ +@end deftypefn") +{ + return const_value ("stdout", args, stdout_file); +} + +DEFUNX ("stderr", Fstderr, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} stderr ()\n\ +Return the numeric value corresponding to the standard error stream.\n\ +Even if paging is turned on, the standard error is not sent to the\n\ +pager. It is useful for error messages and prompts.\n\ +@seealso{stdin, stdout}\n\ +@end deftypefn") +{ + return const_value ("stderr", args, stderr_file); +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/file-io.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/file-io.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,36 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Written by John C. Campbell + +#if !defined (octave_file_io_h) +#define octave_file_io_h 1 + +extern OCTINTERP_API void initialize_file_io (void); + +extern OCTINTERP_API void close_files (void); + +extern OCTINTERP_API void mark_for_deletion (const std::string&); + +extern OCTINTERP_API void cleanup_tmp_files (void); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/graphics.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/graphics.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,10278 @@ +/* + +Copyright (C) 2007-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include + +#include "cmd-edit.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-locbuf.h" +#include "singleton-cleanup.h" + +#include "cutils.h" +#include "defun.h" +#include "display.h" +#include "error.h" +#include "graphics.h" +#include "input.h" +#include "ov.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-fcn-handle.h" +#include "pager.h" +#include "parse.h" +#include "toplev.h" +#include "txt-eng-ft.h" +#include "unwind-prot.h" + +// forward declarations +static octave_value xget (const graphics_handle& h, const caseless_str& name); + +static void +gripe_set_invalid (const std::string& pname) +{ + error ("set: invalid value for %s property", pname.c_str ()); +} + +// Check to see that PNAME matches just one of PNAMES uniquely. +// Return the full name of the match, or an empty caseless_str object +// if there is no match, or the match is ambiguous. + +static caseless_str +validate_property_name (const std::string& who, const std::string& what, + const std::set& pnames, + const caseless_str& pname) +{ + size_t len = pname.length (); + std::set matches; + + for (std::set::const_iterator p = pnames.begin (); + p != pnames.end (); p++) + { + if (pname.compare (*p, len)) + { + if (len == p->length ()) + { + // Exact match. + return pname; + } + + matches.insert (*p); + } + } + + size_t num_matches = matches.size (); + + if (num_matches == 0) + { + error ("%s: unknown %s property %s", + who.c_str (), what.c_str (), pname.c_str ()); + } + else if (num_matches > 1) + { + string_vector sv (matches); + + std::ostringstream os; + + sv.list_in_columns (os); + + std::string match_list = os.str (); + + error ("%s: ambiguous %s property name %s; possible matches:\n\n%s", + who.c_str (), what.c_str (), pname.c_str (), match_list.c_str ()); + } + else if (num_matches == 1) + { + // Exact match was handled above. + + std::string possible_match = *(matches.begin ()); + + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s property %s", + who.c_str (), pname.c_str (), what.c_str (), + possible_match.c_str ()); + + return possible_match; + } + + return caseless_str (); +} + +static Matrix +jet_colormap (void) +{ + Matrix cmap (64, 3, 0.0); + + for (octave_idx_type i = 0; i < 64; i++) + { + // This is the jet colormap. It would be nice to be able + // to feval the jet function but since there is a static + // property object that includes a colormap_property + // object, we need to initialize this before main is even + // called, so calling an interpreted function is not + // possible. + + double x = i / 63.0; + + if (x >= 3.0/8.0 && x < 5.0/8.0) + cmap(i,0) = 4.0 * x - 3.0/2.0; + else if (x >= 5.0/8.0 && x < 7.0/8.0) + cmap(i,0) = 1.0; + else if (x >= 7.0/8.0) + cmap(i,0) = -4.0 * x + 9.0/2.0; + + if (x >= 1.0/8.0 && x < 3.0/8.0) + cmap(i,1) = 4.0 * x - 1.0/2.0; + else if (x >= 3.0/8.0 && x < 5.0/8.0) + cmap(i,1) = 1.0; + else if (x >= 5.0/8.0 && x < 7.0/8.0) + cmap(i,1) = -4.0 * x + 7.0/2.0; + + if (x < 1.0/8.0) + cmap(i,2) = 4.0 * x + 1.0/2.0; + else if (x >= 1.0/8.0 && x < 3.0/8.0) + cmap(i,2) = 1.0; + else if (x >= 3.0/8.0 && x < 5.0/8.0) + cmap(i,2) = -4.0 * x + 5.0/2.0; + } + + return cmap; +} + +static double +default_screendepth (void) +{ + return display_info::depth (); +} + +static Matrix +default_screensize (void) +{ + Matrix retval (1, 4, 1.0); + + retval(2) = display_info::width (); + retval(3) = display_info::height (); + + return retval; +} + +static double +default_screenpixelsperinch (void) +{ + return (display_info::x_dpi () + display_info::y_dpi ()) / 2; +} + +static Matrix +default_colororder (void) +{ + Matrix retval (7, 3, 0.0); + + retval(0,2) = 1.0; + + retval(1,1) = 0.5; + + retval(2,0) = 1.0; + + retval(3,1) = 0.75; + retval(3,2) = 0.75; + + retval(4,0) = 0.75; + retval(4,2) = 0.75; + + retval(5,0) = 0.75; + retval(5,1) = 0.75; + + retval(6,0) = 0.25; + retval(6,1) = 0.25; + retval(6,2) = 0.25; + + return retval; +} + +static Matrix +default_lim (bool logscale = false) +{ + Matrix m (1, 2, 0); + + if (logscale) + { + m(0) = 0.1; + m(1) = 1.0; + } + else + m(1) = 1; + + return m; +} + +static Matrix +default_data (void) +{ + Matrix retval (1, 2); + + retval(0) = 0; + retval(1) = 1; + + return retval; +} + +static Matrix +default_axes_position (void) +{ + Matrix m (1, 4, 0.0); + m(0) = 0.13; + m(1) = 0.11; + m(2) = 0.775; + m(3) = 0.815; + return m; +} + +static Matrix +default_axes_outerposition (void) +{ + Matrix m (1, 4, 0.0); + m(2) = m(3) = 1.0; + return m; +} + +static Matrix +default_axes_tick (void) +{ + Matrix m (1, 6, 0.0); + m(0) = 0.0; + m(1) = 0.2; + m(2) = 0.4; + m(3) = 0.6; + m(4) = 0.8; + m(5) = 1.0; + return m; +} + +static Matrix +default_axes_ticklength (void) +{ + Matrix m (1, 2, 0.0); + m(0) = 0.01; + m(1) = 0.025; + return m; +} + +static Matrix +default_figure_position (void) +{ + Matrix m (1, 4, 0.0); + m(0) = 300; + m(1) = 200; + m(2) = 560; + m(3) = 420; + return m; +} + +static Matrix +default_figure_papersize (void) +{ + Matrix m (1, 2, 0.0); + m(0) = 8.5; + m(1) = 11.0; + return m; +} + +static Matrix +default_figure_paperposition (void) +{ + Matrix m (1, 4, 0.0); + m(0) = 0.25; + m(1) = 2.50; + m(2) = 8.00; + m(3) = 6.00; + return m; +} + +static Matrix +default_control_position (void) +{ + Matrix retval (1, 4, 0.0); + + retval(0) = 0; + retval(1) = 0; + retval(2) = 80; + retval(3) = 30; + + return retval; +} + +static Matrix +default_control_sliderstep (void) +{ + Matrix retval (1, 2, 0.0); + + retval(0) = 0.01; + retval(1) = 0.1; + + return retval; +} + +static Matrix +default_panel_position (void) +{ + Matrix retval (1, 4, 0.0); + + retval(0) = 0; + retval(1) = 0; + retval(2) = 0.5; + retval(3) = 0.5; + + return retval; +} + +static double +convert_font_size (double font_size, const caseless_str& from_units, + const caseless_str& to_units, double parent_height = 0) +{ + // Simple case where from_units == to_units + + if (from_units.compare (to_units)) + return font_size; + + // Converts the given fontsize using the following transformation: + // => points => + + double points_size = 0; + double res = 0; + + if (from_units.compare ("points")) + points_size = font_size; + else + { + res = xget (0, "screenpixelsperinch").double_value (); + + if (from_units.compare ("pixels")) + points_size = font_size * 72.0 / res; + else if (from_units.compare ("inches")) + points_size = font_size * 72.0; + else if (from_units.compare ("centimeters")) + points_size = font_size * 72.0 / 2.54; + else if (from_units.compare ("normalized")) + points_size = font_size * parent_height * 72.0 / res; + } + + double new_font_size = 0; + + if (to_units.compare ("points")) + new_font_size = points_size; + else + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + if (to_units.compare ("pixels")) + new_font_size = points_size * res / 72.0; + else if (to_units.compare ("inches")) + new_font_size = points_size / 72.0; + else if (to_units.compare ("centimeters")) + new_font_size = points_size * 2.54 / 72.0; + else if (to_units.compare ("normalized")) + { + // Avoid setting font size to (0/0) = NaN + + if (parent_height > 0) + new_font_size = points_size * res / (parent_height * 72.0); + } + } + + return new_font_size; +} + +static Matrix +convert_position (const Matrix& pos, const caseless_str& from_units, + const caseless_str& to_units, const Matrix& parent_dim) +{ + Matrix retval (1, pos.numel ()); + double res = 0; + bool is_rectangle = (pos.numel () == 4); + bool is_2d = (pos.numel () == 2); + + if (from_units.compare ("pixels")) + retval = pos; + else if (from_units.compare ("normalized")) + { + retval(0) = pos(0) * parent_dim(0) + 1; + retval(1) = pos(1) * parent_dim(1) + 1; + if (is_rectangle) + { + retval(2) = pos(2) * parent_dim(0); + retval(3) = pos(3) * parent_dim(1); + } + else if (! is_2d) + retval(2) = 0; + } + else if (from_units.compare ("characters")) + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + // FIXME -- this assumes the system font is Helvetica 10pt + // (for which "x" requires 6x12 pixels at 74.951 pixels/inch) + f = 12.0 * res / 74.951; + + if (f > 0) + { + retval(0) = 0.5 * pos(0) * f; + retval(1) = pos(1) * f; + if (is_rectangle) + { + retval(2) = 0.5 * pos(2) * f; + retval(3) = pos(3) * f; + } + else if (! is_2d) + retval(2) = 0; + } + } + else + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + if (from_units.compare ("points")) + f = res / 72.0; + else if (from_units.compare ("inches")) + f = res; + else if (from_units.compare ("centimeters")) + f = res / 2.54; + + if (f > 0) + { + retval(0) = pos(0) * f + 1; + retval(1) = pos(1) * f + 1; + if (is_rectangle) + { + retval(2) = pos(2) * f; + retval(3) = pos(3) * f; + } + else if (! is_2d) + retval(2) = 0; + } + } + + if (! to_units.compare ("pixels")) + { + if (to_units.compare ("normalized")) + { + retval(0) = (retval(0) - 1) / parent_dim(0); + retval(1) = (retval(1) - 1) / parent_dim(1); + if (is_rectangle) + { + retval(2) /= parent_dim(0); + retval(3) /= parent_dim(1); + } + else if (! is_2d) + retval(2) = 0; + } + else if (to_units.compare ("characters")) + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + f = 12.0 * res / 74.951; + + if (f > 0) + { + retval(0) = 2 * retval(0) / f; + retval(1) = retval(1) / f; + if (is_rectangle) + { + retval(2) = 2 * retval(2) / f; + retval(3) = retval(3) / f; + } + else if (! is_2d) + retval(2) = 0; + } + } + else + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + if (to_units.compare ("points")) + f = res / 72.0; + else if (to_units.compare ("inches")) + f = res; + else if (to_units.compare ("centimeters")) + f = res / 2.54; + + if (f > 0) + { + retval(0) = (retval(0) - 1) / f; + retval(1) = (retval(1) - 1) / f; + if (is_rectangle) + { + retval(2) /= f; + retval(3) /= f; + } + else if (! is_2d) + retval(2) = 0; + } + } + } + else if (! is_rectangle && ! is_2d) + retval(2) = 0; + + return retval; +} + +static Matrix +convert_text_position (const Matrix& pos, const text::properties& props, + const caseless_str& from_units, + const caseless_str& to_units) +{ + graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); + graphics_object ax = go.get_ancestor ("axes"); + + Matrix retval; + + if (ax.valid_object ()) + { + const axes::properties& ax_props = + dynamic_cast (ax.get_properties ()); + graphics_xform ax_xform = ax_props.get_transform (); + bool is_rectangle = (pos.numel () == 4); + Matrix ax_bbox = ax_props.get_boundingbox (true), + ax_size = ax_bbox.extract_n (0, 2, 1, 2); + + if (from_units.compare ("data")) + { + if (is_rectangle) + { + ColumnVector v1 = ax_xform.transform (pos(0), pos(1), 0), + v2 = ax_xform.transform (pos(0) + pos(2), + pos(1) + pos(3), 0); + + retval.resize (1, 4); + + retval(0) = v1(0) - ax_bbox(0) + 1; + retval(1) = ax_bbox(1) + ax_bbox(3) - v1(1) + 1; + retval(2) = v2(0) - v1(0); + retval(3) = v1(1) - v2(1); + } + else + { + ColumnVector v = ax_xform.transform (pos(0), pos(1), pos(2)); + + retval.resize (1, 3); + + retval(0) = v(0) - ax_bbox(0) + 1; + retval(1) = ax_bbox(1) + ax_bbox(3) - v(1) + 1; + retval(2) = 0; + } + } + else + retval = convert_position (pos, from_units, "pixels", ax_size); + + if (! to_units.compare ("pixels")) + { + if (to_units.compare ("data")) + { + if (is_rectangle) + { + ColumnVector v1 = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, + ax_bbox(1) + ax_bbox(3) - retval(1) + 1), + v2 = ax_xform.untransform (retval(0) + retval(2) + ax_bbox(0) - 1, + ax_bbox(1) + ax_bbox(3) - (retval(1) + retval(3)) + 1); + + retval.resize (1, 4); + + retval(0) = v1(0); + retval(1) = v1(1); + retval(2) = v2(0) - v1(0); + retval(3) = v2(1) - v1(1); + } + else + { + ColumnVector v = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, + ax_bbox(1) + ax_bbox(3) - retval(1) + 1); + + retval.resize (1, 3); + + retval(0) = v(0); + retval(1) = v(1); + retval(2) = v(2); + } + } + else + retval = convert_position (retval, "pixels", to_units, ax_size); + } + } + + return retval; +} + +// This function always returns the screensize in pixels +static Matrix +screen_size_pixels (void) +{ + graphics_object obj = gh_manager::get_object (0); + Matrix sz = obj.get ("screensize").matrix_value (); + return convert_position (sz, obj.get ("units").string_value (), "pixels", sz.extract_n (0, 2, 1, 2)).extract_n (0, 2, 1, 2); +} + +static void +convert_cdata_2 (bool is_scaled, double clim_0, double clim_1, + const double *cmapv, double x, octave_idx_type lda, + octave_idx_type nc, octave_idx_type i, double *av) +{ + if (is_scaled) + x = xround ((nc - 1) * (x - clim_0) / (clim_1 - clim_0)); + else + x = xround (x - 1); + + if (xisnan (x)) + { + av[i] = x; + av[i+lda] = x; + av[i+2*lda] = x; + } + else + { + if (x < 0) + x = 0; + else if (x >= nc) + x = (nc - 1); + + octave_idx_type idx = static_cast (x); + + av[i] = cmapv[idx]; + av[i+lda] = cmapv[idx+nc]; + av[i+2*lda] = cmapv[idx+2*nc]; + } +} + +template +void +convert_cdata_1 (bool is_scaled, double clim_0, double clim_1, + const double *cmapv, const T *cv, octave_idx_type lda, + octave_idx_type nc, double *av) +{ + for (octave_idx_type i = 0; i < lda; i++) + convert_cdata_2 (is_scaled, clim_0, clim_1, cmapv, cv[i], lda, nc, i, av); +} + +static octave_value +convert_cdata (const base_properties& props, const octave_value& cdata, + bool is_scaled, int cdim) +{ + dim_vector dv (cdata.dims ()); + + if (dv.length () == cdim && dv(cdim-1) == 3) + return cdata; + + Matrix cmap (1, 3, 0.0); + Matrix clim (1, 2, 0.0); + + graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); + graphics_object fig = go.get_ancestor ("figure"); + + if (fig.valid_object ()) + { + Matrix _cmap = fig.get (caseless_str ("colormap")).matrix_value (); + + if (! error_state) + cmap = _cmap; + } + + if (is_scaled) + { + graphics_object ax = go.get_ancestor ("axes"); + + if (ax.valid_object ()) + { + Matrix _clim = ax.get (caseless_str ("clim")).matrix_value (); + + if (! error_state) + clim = _clim; + } + } + + dv.resize (cdim); + dv(cdim-1) = 3; + + NDArray a (dv); + + octave_idx_type lda = a.numel () / static_cast (3); + octave_idx_type nc = cmap.rows (); + + double *av = a.fortran_vec (); + const double *cmapv = cmap.data (); + + double clim_0 = clim(0); + double clim_1 = clim(1); + +#define CONVERT_CDATA_1(ARRAY_T, VAL_FN) \ + do \ + { \ + ARRAY_T tmp = cdata. VAL_FN ## array_value (); \ + \ + convert_cdata_1 (is_scaled, clim_0, clim_1, cmapv, \ + tmp.data (), lda, nc, av); \ + } \ + while (0) + + if (cdata.is_uint8_type ()) + CONVERT_CDATA_1 (uint8NDArray, uint8_); + else if (cdata.is_single_type ()) + CONVERT_CDATA_1 (FloatNDArray, float_); + else if (cdata.is_double_type ()) + CONVERT_CDATA_1 (NDArray, ); + else + error ("unsupported type for cdata (= %s)", cdata.type_name ().c_str ()); + +#undef CONVERT_CDATA_1 + + return octave_value (a); +} + +template +static void +get_array_limits (const Array& m, double& emin, double& emax, + double& eminp, double& emaxp) +{ + const T *data = m.data (); + octave_idx_type n = m.numel (); + + for (octave_idx_type i = 0; i < n; i++) + { + double e = double (data[i]); + + // Don't need to test for NaN here as NaN>x and NaN emax) + emax = e; + + if (e > 0 && e < eminp) + eminp = e; + + if (e < 0 && e > emaxp) + emaxp = e; + } + } +} + +static bool +lookup_object_name (const caseless_str& name, caseless_str& go_name, + caseless_str& rest) +{ + int len = name.length (); + int offset = 0; + bool result = false; + + if (len >= 4) + { + caseless_str pfx = name.substr (0, 4); + + if (pfx.compare ("axes") || pfx.compare ("line") + || pfx.compare ("text")) + offset = 4; + else if (len >= 5) + { + pfx = name.substr (0, 5); + + if (pfx.compare ("image") || pfx.compare ("patch")) + offset = 5; + else if (len >= 6) + { + pfx = name.substr (0, 6); + + if (pfx.compare ("figure") || pfx.compare ("uimenu")) + offset = 6; + else if (len >= 7) + { + pfx = name.substr (0, 7); + + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) + offset = 7; + else if (len >= 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len >= 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len >= 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoggletool")) + offset = 12; + else if (len >= 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } + } + } + } + + if (offset > 0) + { + go_name = pfx; + rest = name.substr (offset); + result = true; + } + } + + return result; +} + +static base_graphics_object* +make_graphics_object_from_type (const caseless_str& type, + const graphics_handle& h = graphics_handle (), + const graphics_handle& p = graphics_handle ()) +{ + base_graphics_object *go = 0; + + if (type.compare ("figure")) + go = new figure (h, p); + else if (type.compare ("axes")) + go = new axes (h, p); + else if (type.compare ("line")) + go = new line (h, p); + else if (type.compare ("text")) + go = new text (h, p); + else if (type.compare ("image")) + go = new image (h, p); + else if (type.compare ("patch")) + go = new patch (h, p); + else if (type.compare ("surface")) + go = new surface (h, p); + else if (type.compare ("hggroup")) + go = new hggroup (h, p); + else if (type.compare ("uimenu")) + go = new uimenu (h, p); + else if (type.compare ("uicontrol")) + go = new uicontrol (h, p); + else if (type.compare ("uipanel")) + go = new uipanel (h, p); + else if (type.compare ("uicontextmenu")) + go = new uicontextmenu (h, p); + else if (type.compare ("uitoolbar")) + go = new uitoolbar (h, p); + else if (type.compare ("uipushtool")) + go = new uipushtool (h, p); + else if (type.compare ("uitoggletool")) + go = new uitoggletool (h, p); + return go; +} + +// --------------------------------------------------------------------- + +bool +base_property::set (const octave_value& v, bool do_run, bool do_notify_toolkit) +{ + if (do_set (v)) + { + + // Notify graphics toolkit. + if (id >= 0 && do_notify_toolkit) + { + graphics_object go = gh_manager::get_object (parent); + if (go) + go.update (id); + } + + // run listeners + if (do_run && ! error_state) + run_listeners (POSTSET); + + return true; + } + + return false; +} + + +void +base_property::run_listeners (listener_mode mode) +{ + const octave_value_list& l = listeners[mode]; + + for (int i = 0; i < l.length (); i++) + { + gh_manager::execute_listener (parent, l(i)); + + if (error_state) + break; + } +} + +radio_values::radio_values (const std::string& opt_string) + : default_val (), possible_vals () +{ + size_t beg = 0; + size_t len = opt_string.length (); + bool done = len == 0; + + while (! done) + { + size_t end = opt_string.find ('|', beg); + + if (end == std::string::npos) + { + end = len; + done = true; + } + + std::string t = opt_string.substr (beg, end-beg); + + // Might want more error checking here... + if (t[0] == '{') + { + t = t.substr (1, t.length () - 2); + default_val = t; + } + else if (beg == 0) // ensure default value + default_val = t; + + possible_vals.insert (t); + + beg = end + 1; + } +} + +std::string +radio_values::values_as_string (void) const +{ + std::string retval; + for (std::set::const_iterator it = possible_vals.begin (); + it != possible_vals.end (); it++) + { + if (retval == "") + { + if (*it == default_value ()) + retval = "{" + *it + "}"; + else + retval = *it; + } + else + { + if (*it == default_value ()) + retval += " | {" + *it + "}"; + else + retval += " | " + *it; + } + } + if (retval != "") + retval = "[ " + retval + " ]"; + return retval; +} + +Cell +radio_values::values_as_cell (void) const +{ + octave_idx_type i = 0; + Cell retval (nelem (), 1); + for (std::set::const_iterator it = possible_vals.begin (); + it != possible_vals.end (); it++) + retval(i++) = std::string (*it); + return retval; +} + +bool +color_values::str2rgb (std::string str) +{ + double tmp_rgb[3] = {0, 0, 0}; + bool retval = true; + unsigned int len = str.length (); + + std::transform (str.begin (), str.end (), str.begin (), tolower); + + if (str.compare (0, len, "blue", 0, len) == 0) + tmp_rgb[2] = 1; + else if (str.compare (0, len, "black", 0, len) == 0 + || str.compare (0, len, "k", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 0; + else if (str.compare (0, len, "red", 0, len) == 0) + tmp_rgb[0] = 1; + else if (str.compare (0, len, "green", 0, len) == 0) + tmp_rgb[1] = 1; + else if (str.compare (0, len, "yellow", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[1] = 1; + else if (str.compare (0, len, "magenta", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[2] = 1; + else if (str.compare (0, len, "cyan", 0, len) == 0) + tmp_rgb[1] = tmp_rgb[2] = 1; + else if (str.compare (0, len, "white", 0, len) == 0 + || str.compare (0, len, "w", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 1; + else + retval = false; + + if (retval) + { + for (int i = 0; i < 3; i++) + xrgb(i) = tmp_rgb[i]; + } + + return retval; +} + +bool +color_property::do_set (const octave_value& val) +{ + if (val.is_string ()) + { + std::string s = val.string_value (); + + if (! s.empty ()) + { + std::string match; + + if (radio_val.contains (s, match)) + { + if (current_type != radio_t || match != current_val) + { + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; + current_type = radio_t; + return true; + } + } + else + { + color_values col (s); + if (! error_state) + { + if (current_type != color_t || col != color_val) + { + color_val = col; + current_type = color_t; + return true; + } + } + else + error ("invalid value for color property \"%s\" (value = %s)", + get_name ().c_str (), s.c_str ()); + } + } + else + error ("invalid value for color property \"%s\"", + get_name ().c_str ()); + } + else if (val.is_numeric_type ()) + { + Matrix m = val.matrix_value (); + + if (m.numel () == 3) + { + color_values col (m(0), m(1), m(2)); + if (! error_state) + { + if (current_type != color_t || col != color_val) + { + color_val = col; + current_type = color_t; + return true; + } + } + } + else + error ("invalid value for color property \"%s\"", + get_name ().c_str ()); + } + else + error ("invalid value for color property \"%s\"", + get_name ().c_str ()); + + return false; +} + +bool +double_radio_property::do_set (const octave_value& val) +{ + if (val.is_string ()) + { + std::string s = val.string_value (); + std::string match; + + if (! s.empty () && radio_val.contains (s, match)) + { + if (current_type != radio_t || match != current_val) + { + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; + current_type = radio_t; + return true; + } + } + else + error ("invalid value for double_radio property \"%s\"", + get_name ().c_str ()); + } + else if (val.is_scalar_type () && val.is_real_type ()) + { + double new_dval = val.double_value (); + + if (current_type != double_t || new_dval != dval) + { + dval = new_dval; + current_type = double_t; + return true; + } + } + else + error ("invalid value for double_radio property \"%s\"", + get_name ().c_str ()); + + return false; +} + +bool +array_property::validate (const octave_value& v) +{ + bool xok = false; + + // FIXME -- should we always support []? + if (v.is_empty () && v.is_numeric_type ()) + return true; + + // check value type + if (type_constraints.size () > 0) + { + if(type_constraints.find (v.class_name()) != type_constraints.end()) + xok = true; + + // check if complex is allowed (it's also of class "double", so + // checking that alone is not enough to ensure real type) + if (type_constraints.find ("real") != type_constraints.end () + && v.is_complex_type ()) + xok = false; + } + else + xok = v.is_numeric_type (); + + if (xok) + { + dim_vector vdims = v.dims (); + int vlen = vdims.length (); + + xok = false; + + // check value size + if (size_constraints.size () > 0) + for (std::list::const_iterator it = size_constraints.begin (); + ! xok && it != size_constraints.end (); ++it) + { + dim_vector itdims = (*it); + + if (itdims.length () == vlen) + { + xok = true; + + for (int i = 0; xok && i < vlen; i++) + if (itdims(i) >= 0 && itdims(i) != vdims(i)) + xok = false; + } + } + else + return true; + } + + return xok; +} + +bool +array_property::is_equal (const octave_value& v) const +{ + if (data.type_name () == v.type_name ()) + { + if (data.dims () == v.dims ()) + { + +#define CHECK_ARRAY_EQUAL(T,F,A) \ + { \ + if (data.numel () == 1) \ + return data.F ## scalar_value () == \ + v.F ## scalar_value (); \ + else \ + { \ + /* Keep copy of array_value to allow sparse/bool arrays */ \ + /* that are converted, to not be deallocated early */ \ + const A m1 = data.F ## array_value (); \ + const T* d1 = m1.data (); \ + const A m2 = v.F ## array_value (); \ + const T* d2 = m2.data ();\ + \ + bool flag = true; \ + \ + for (int i = 0; flag && i < data.numel (); i++) \ + if (d1[i] != d2[i]) \ + flag = false; \ + \ + return flag; \ + } \ + } + + if (data.is_double_type () || data.is_bool_type ()) + CHECK_ARRAY_EQUAL (double, , NDArray) + else if (data.is_single_type ()) + CHECK_ARRAY_EQUAL (float, float_, FloatNDArray) + else if (data.is_int8_type ()) + CHECK_ARRAY_EQUAL (octave_int8, int8_, int8NDArray) + else if (data.is_int16_type ()) + CHECK_ARRAY_EQUAL (octave_int16, int16_, int16NDArray) + else if (data.is_int32_type ()) + CHECK_ARRAY_EQUAL (octave_int32, int32_, int32NDArray) + else if (data.is_int64_type ()) + CHECK_ARRAY_EQUAL (octave_int64, int64_, int64NDArray) + else if (data.is_uint8_type ()) + CHECK_ARRAY_EQUAL (octave_uint8, uint8_, uint8NDArray) + else if (data.is_uint16_type ()) + CHECK_ARRAY_EQUAL (octave_uint16, uint16_, uint16NDArray) + else if (data.is_uint32_type ()) + CHECK_ARRAY_EQUAL (octave_uint32, uint32_, uint32NDArray) + else if (data.is_uint64_type ()) + CHECK_ARRAY_EQUAL (octave_uint64, uint64_, uint64NDArray) + } + } + + return false; +} + +void +array_property::get_data_limits (void) +{ + xmin = xminp = octave_Inf; + xmax = xmaxp = -octave_Inf; + + if (! data.is_empty ()) + { + if (data.is_integer_type ()) + { + if (data.is_int8_type ()) + get_array_limits (data.int8_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint8_type ()) + get_array_limits (data.uint8_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_int16_type ()) + get_array_limits (data.int16_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint16_type ()) + get_array_limits (data.uint16_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_int32_type ()) + get_array_limits (data.int32_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint32_type ()) + get_array_limits (data.uint32_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_int64_type ()) + get_array_limits (data.int64_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint64_type ()) + get_array_limits (data.uint64_array_value (), xmin, xmax, xminp, xmaxp); + } + else + get_array_limits (data.array_value (), xmin, xmax, xminp, xmaxp); + } +} + +bool +handle_property::do_set (const octave_value& v) +{ + double dv = v.double_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (dv); + + if (xisnan (gh.value ()) || gh.ok ()) + { + if (current_val != gh) + { + current_val = gh; + return true; + } + } + else + error ("set: invalid graphics handle (= %g) for property \"%s\"", + dv, get_name ().c_str ()); + } + else + error ("set: invalid graphics handle for property \"%s\"", + get_name ().c_str ()); + + return false; +} + +Matrix +children_property::do_get_children (bool return_hidden) const +{ + Matrix retval (children_list.size (), 1); + octave_idx_type k = 0; + + graphics_object go = gh_manager::get_object (0); + + root_figure::properties& props = + dynamic_cast (go.get_properties ()); + + if (! props.is_showhiddenhandles ()) + { + for (const_children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + graphics_handle kid = *p; + + if (gh_manager::is_handle_visible (kid)) + { + if (! return_hidden) + retval(k++) = *p; + } + else if (return_hidden) + retval(k++) = *p; + } + + retval.resize (k, 1); + } + else + { + for (const_children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + retval(k++) = *p; + } + + return retval; +} + +void +children_property::do_delete_children (bool clear) +{ + for (children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + graphics_object go = gh_manager::get_object (*p); + + if (go.valid_object ()) + gh_manager::free (*p); + + } + + if (clear) + children_list.clear (); +} + +bool +callback_property::validate (const octave_value& v) const +{ + // case 1: function handle + // case 2: cell array with first element being a function handle + // case 3: string corresponding to known function name + // case 4: evaluatable string + // case 5: empty matrix + + if (v.is_function_handle ()) + return true; + else if (v.is_string ()) + // complete validation will be done at execution-time + return true; + else if (v.is_cell () && v.length () > 0 + && (v.rows () == 1 || v.columns () == 1) + && v.cell_value ()(0).is_function_handle ()) + return true; + else if (v.is_empty ()) + return true; + + return false; +} + +// If TRUE, we are executing any callback function, or the functions it +// calls. Used to determine handle visibility inside callback +// functions. +static bool executing_callback = false; + +void +callback_property::execute (const octave_value& data) const +{ + unwind_protect frame; + + // We are executing the callback function associated with this + // callback property. When set to true, we avoid recursive calls to + // callback routines. + frame.protect_var (executing); + + // We are executing a callback function, so allow handles that have + // their handlevisibility property set to "callback" to be visible. + frame.protect_var (executing_callback); + + if (! executing) + { + executing = true; + executing_callback = true; + + if (callback.is_defined () && ! callback.is_empty ()) + gh_manager::execute_callback (get_parent (), callback, data); + } +} + +// Used to cache dummy graphics objects from which dynamic +// properties can be cloned. +static std::map dprop_obj_map; + +property +property::create (const std::string& name, const graphics_handle& h, + const caseless_str& type, const octave_value_list& args) +{ + property retval; + + if (type.compare ("string")) + { + std::string val = (args.length () > 0 ? args(0).string_value () : ""); + + if (! error_state) + retval = property (new string_property (name, h, val)); + } + else if (type.compare ("any")) + { + octave_value val = + (args.length () > 0 ? args(0) : octave_value (Matrix ())); + + retval = property (new any_property (name, h, val)); + } + else if (type.compare ("radio")) + { + if (args.length () > 0) + { + std::string vals = args(0).string_value (); + + if (! error_state) + { + retval = property (new radio_property (name, h, vals)); + + if (args.length () > 1) + retval.set (args(1)); + } + else + error ("addproperty: invalid argument for radio property, expected a string value"); + } + else + error ("addproperty: missing possible values for radio property"); + } + else if (type.compare ("double")) + { + double d = (args.length () > 0 ? args(0).double_value () : 0); + + if (! error_state) + retval = property (new double_property (name, h, d)); + } + else if (type.compare ("handle")) + { + double hh = (args.length () > 0 ? args(0).double_value () : octave_NaN); + + if (! error_state) + { + graphics_handle gh (hh); + + retval = property (new handle_property (name, h, gh)); + } + } + else if (type.compare ("boolean")) + { + retval = property (new bool_property (name, h, false)); + + if (args.length () > 0) + retval.set (args(0)); + } + else if (type.compare ("data")) + { + retval = property (new array_property (name, h, Matrix ())); + + if (args.length () > 0) + { + retval.set (args(0)); + + // FIXME -- additional argument could define constraints, + // but is this really useful? + } + } + else if (type.compare ("color")) + { + color_values cv (0, 0, 0); + radio_values rv; + + if (args.length () > 1) + rv = radio_values (args(1).string_value ()); + + if (! error_state) + { + retval = property (new color_property (name, h, cv, rv)); + + if (! error_state) + { + if (args.length () > 0 && ! args(0).is_empty ()) + retval.set (args(0)); + else + retval.set (rv.default_value ()); + } + } + } + else + { + caseless_str go_name, go_rest; + + if (lookup_object_name (type, go_name, go_rest)) + { + graphics_object go; + + std::map::const_iterator it = + dprop_obj_map.find (go_name); + + if (it == dprop_obj_map.end ()) + { + base_graphics_object *bgo = + make_graphics_object_from_type (go_name); + + if (bgo) + { + go = graphics_object (bgo); + + dprop_obj_map[go_name] = go; + } + } + else + go = it->second; + + if (go.valid_object ()) + { + property prop = go.get_properties ().get_property (go_rest); + + if (! error_state) + { + retval = prop.clone (); + + retval.set_parent (h); + retval.set_name (name); + + if (args.length () > 0) + retval.set (args(0)); + } + } + else + error ("addproperty: invalid object type (= %s)", + go_name.c_str ()); + } + else + error ("addproperty: unsupported type for dynamic property (= %s)", + type.c_str ()); + } + + return retval; +} + +static void +finalize_r (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + { + Matrix children = go.get_properties ().get_all_children (); + + for (int k = 0; k < children.numel (); k++) + finalize_r (children(k)); + + go.finalize (); + } +} + +static void +initialize_r (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + { + Matrix children = go.get_properties ().get_all_children (); + + go.initialize (); + + for (int k = 0; k < children.numel (); k++) + initialize_r (children(k)); + } +} + +void +figure::properties::set_toolkit (const graphics_toolkit& b) +{ + if (toolkit) + finalize_r (get___myhandle__ ()); + + toolkit = b; + __graphics_toolkit__ = b.get_name (); + __plot_stream__ = Matrix (); + + if (toolkit) + initialize_r (get___myhandle__ ()); + + mark_modified (); +} + +// --------------------------------------------------------------------- + +void +property_list::set (const caseless_str& name, const octave_value& val) +{ + size_t offset = 0; + + size_t len = name.length (); + + if (len > 4) + { + caseless_str pfx = name.substr (0, 4); + + if (pfx.compare ("axes") || pfx.compare ("line") + || pfx.compare ("text")) + offset = 4; + else if (len > 5) + { + pfx = name.substr (0, 5); + + if (pfx.compare ("image") || pfx.compare ("patch")) + offset = 5; + else if (len > 6) + { + pfx = name.substr (0, 6); + + if (pfx.compare ("figure") || pfx.compare ("uimenu")) + offset = 6; + else if (len > 7) + { + pfx = name.substr (0, 7); + + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) + offset = 7; + else if (len > 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len > 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len > 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoogletool")) + offset = 12; + else if (len > 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } + } + } + } + + if (offset > 0) + { + // FIXME -- should we validate property names and values here? + + std::string pname = name.substr (offset); + + std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); + std::transform (pname.begin (), pname.end (), pname.begin (), tolower); + + bool has_property = false; + if (pfx == "axes") + has_property = axes::properties::has_core_property (pname); + else if (pfx == "line") + has_property = line::properties::has_core_property (pname); + else if (pfx == "text") + has_property = text::properties::has_core_property (pname); + else if (pfx == "image") + has_property = image::properties::has_core_property (pname); + else if (pfx == "patch") + has_property = patch::properties::has_core_property (pname); + else if (pfx == "figure") + has_property = figure::properties::has_core_property (pname); + else if (pfx == "surface") + has_property = surface::properties::has_core_property (pname); + else if (pfx == "hggroup") + has_property = hggroup::properties::has_core_property (pname); + else if (pfx == "uimenu") + has_property = uimenu::properties::has_core_property (pname); + else if (pfx == "uicontrol") + has_property = uicontrol::properties::has_core_property (pname); + else if (pfx == "uipanel") + has_property = uipanel::properties::has_core_property (pname); + else if (pfx == "uicontextmenu") + has_property = uicontextmenu::properties::has_core_property (pname); + else if (pfx == "uitoolbar") + has_property = uitoolbar::properties::has_core_property (pname); + else if (pfx == "uipushtool") + has_property = uipushtool::properties::has_core_property (pname); + + if (has_property) + { + bool remove = false; + if (val.is_string ()) + { + caseless_str tval = val.string_value (); + + remove = tval.compare ("remove"); + } + + pval_map_type& pval_map = plist_map[pfx]; + + if (remove) + { + pval_map_iterator p = pval_map.find (pname); + + if (p != pval_map.end ()) + pval_map.erase (p); + } + else + pval_map[pname] = val; + } + else + error ("invalid %s property `%s'", pfx.c_str (), pname.c_str ()); + } + } + + if (! error_state && offset == 0) + error ("invalid default property specification"); +} + +octave_value +property_list::lookup (const caseless_str& name) const +{ + octave_value retval; + + size_t offset = 0; + + size_t len = name.length (); + + if (len > 4) + { + caseless_str pfx = name.substr (0, 4); + + if (pfx.compare ("axes") || pfx.compare ("line") + || pfx.compare ("text")) + offset = 4; + else if (len > 5) + { + pfx = name.substr (0, 5); + + if (pfx.compare ("image") || pfx.compare ("patch")) + offset = 5; + else if (len > 6) + { + pfx = name.substr (0, 6); + + if (pfx.compare ("figure") || pfx.compare ("uimenu")) + offset = 6; + else if (len > 7) + { + pfx = name.substr (0, 7); + + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) + offset = 7; + else if (len > 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len > 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len > 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoggletool")) + offset = 12; + else if (len > 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } + } + } + } + + if (offset > 0) + { + std::string pname = name.substr (offset); + + std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); + std::transform (pname.begin (), pname.end (), pname.begin (), tolower); + + plist_map_const_iterator p = find (pfx); + + if (p != end ()) + { + const pval_map_type& pval_map = p->second; + + pval_map_const_iterator q = pval_map.find (pname); + + if (q != pval_map.end ()) + retval = q->second; + } + } + } + + return retval; +} + +octave_scalar_map +property_list::as_struct (const std::string& prefix_arg) const +{ + octave_scalar_map m; + + for (plist_map_const_iterator p = begin (); p != end (); p++) + { + std::string prefix = prefix_arg + p->first; + + const pval_map_type pval_map = p->second; + + for (pval_map_const_iterator q = pval_map.begin (); + q != pval_map.end (); + q++) + m.assign (prefix + q->first, q->second); + } + + return m; +} + +graphics_handle::graphics_handle (const octave_value& a) + : val (octave_NaN) +{ + if (a.is_empty ()) + /* do nothing */; + else + { + double tval = a.double_value (); + + if (! error_state) + val = tval; + else + error ("invalid graphics handle"); + } +} + +// Set properties given as a cs-list of name, value pairs. + +void +graphics_object::set (const octave_value_list& args) +{ + int nargin = args.length (); + + if (nargin == 0) + error ("graphics_object::set: Nothing to set"); + else if (nargin % 2 == 0) + { + for (int i = 0; i < nargin; i += 2) + { + caseless_str name = args(i).string_value (); + + if (! error_state) + { + octave_value val = args(i+1); + + set_value_or_default (name, val); + + if (error_state) + break; + } + else + error ("set: expecting argument %d to be a property name", i); + } + } + else + error ("set: invalid number of arguments"); +} + +/* +## test set with name, value pairs +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (h, "linewidth", 10, "marker", "x"); +%! assert (get (h, "linewidth"), 10); +%! assert (get (h, "marker"), "x"); +*/ + +// Set properties given in two cell arrays containing names and values. +void +graphics_object::set (const Array& names, + const Cell& values, octave_idx_type row) +{ + if (names.numel () != values.columns ()) + { + error ("set: number of names must match number of value columns (%d != %d)", + names.numel (), values.columns ()); + } + + octave_idx_type k = names.columns (); + + for (octave_idx_type column = 0; column < k; column++) + { + caseless_str name = names(column); + octave_value val = values(row, column); + + set_value_or_default (name, val); + + if (error_state) + break; + } +} + +/* +## test set with cell array arguments +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (h, {"linewidth", "marker"}, {10, "x"}); +%! assert (get (h, "linewidth"), 10); +%! assert (get (h, "marker"), "x"); + +## test set with multiple handles and cell array arguments +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"}); +%! assert (get (h, "linewidth"), {10; 5}); +%! assert (get (h, "marker"), {"x"; "o"}); +%! set (h, {"linewidth", "marker"}, {10, "x"}); +%! assert (get (h, "linewidth"), {10; 10}); +%! assert (get (h, "marker"), {"x"; "x"}); + +%!error +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"; 7, "."}); + +%!error +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, {"linewidth"}, {10, "x"; 5, "o"}); +*/ + +// Set properties given in a struct array +void +graphics_object::set (const octave_map& m) +{ + for (octave_map::const_iterator p = m.begin (); + p != m.end (); p++) + { + caseless_str name = m.key (p); + + octave_value val = octave_value (m.contents (p).elem (m.numel () - 1)); + + set_value_or_default (name, val); + + if (error_state) + break; + } +} + +/* +## test set with struct arguments +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (h, struct ("linewidth", 10, "marker", "x")); +%! assert (get (h, "linewidth"), 10); +%! assert (get (h, "marker"), "x"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, struct ("linewidth", {5, 10})); +%! assert (get (h, "linewidth"), {10; 10}); +*/ + +// Set a property to a value or to its (factory) default value. + +void +graphics_object::set_value_or_default (const caseless_str& name, + const octave_value& val) +{ + if (val.is_string ()) + { + caseless_str tval = val.string_value (); + + octave_value default_val; + + if (tval.compare ("default")) + { + default_val = get_default (name); + + if (error_state) + return; + + rep->set (name, default_val); + } + else if (tval.compare ("factory")) + { + default_val = get_factory_default (name); + + if (error_state) + return; + + rep->set (name, default_val); + } + else + rep->set (name, val); + } + else + rep->set (name, val); +} + +/* +## test setting of default values +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (0, "defaultlinelinewidth", 20); +%! set (h, "linewidth", "default"); +%! assert (get (h, "linewidth"), 20); +%! set (h, "linewidth", "factory"); +%! assert (get (h, "linewidth"), 0.5); +*/ + +static double +make_handle_fraction (void) +{ + static double maxrand = RAND_MAX + 2.0; + + return (rand () + 1.0) / maxrand; +} + +graphics_handle +gh_manager::do_get_handle (bool integer_figure_handle) +{ + graphics_handle retval; + + if (integer_figure_handle) + { + // Figure handles are positive integers corresponding to the + // figure number. + + // We always want the lowest unused figure number. + + retval = 1; + + while (handle_map.find (retval) != handle_map.end ()) + retval++; + } + else + { + // Other graphics handles are negative integers plus some random + // fractional part. To avoid running out of integers, we + // recycle the integer part but tack on a new random part each + // time. + + free_list_iterator p = handle_free_list.begin (); + + if (p != handle_free_list.end ()) + { + retval = *p; + handle_free_list.erase (p); + } + else + { + retval = graphics_handle (next_handle); + + next_handle = std::ceil (next_handle) - 1.0 - make_handle_fraction (); + } + } + + return retval; +} + +void +gh_manager::do_free (const graphics_handle& h) +{ + if (h.ok ()) + { + if (h.value () != 0) + { + iterator p = handle_map.find (h); + + if (p != handle_map.end ()) + { + base_properties& bp = p->second.get_properties (); + + bp.set_beingdeleted (true); + + bp.delete_children (); + + octave_value val = bp.get_deletefcn (); + + bp.execute_deletefcn (); + + // Notify graphics toolkit. + p->second.finalize (); + + // Note: this will be valid only for first explicitly + // deleted object. All its children will then have an + // unknown graphics toolkit. + + // Graphics handles for non-figure objects are negative + // integers plus some random fractional part. To avoid + // running out of integers, we recycle the integer part + // but tack on a new random part each time. + + handle_map.erase (p); + + if (h.value () < 0) + handle_free_list.insert (std::ceil (h.value ()) - make_handle_fraction ()); + } + else + error ("graphics_handle::free: invalid object %g", h.value ()); + } + else + error ("graphics_handle::free: can't delete root figure"); + } +} + +void +gh_manager::do_renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh) +{ + iterator p = handle_map.find (old_gh); + + if (p != handle_map.end ()) + { + graphics_object go = p->second; + + handle_map.erase (p); + + handle_map[new_gh] = go; + + if (old_gh.value () < 0) + handle_free_list.insert (std::ceil (old_gh.value ()) + - make_handle_fraction ()); + } + else + error ("graphics_handle::free: invalid object %g", old_gh.value ()); + + for (figure_list_iterator q = figure_list.begin (); + q != figure_list.end (); q++) + { + if (*q == old_gh) + { + *q = new_gh; + break; + } + } +} + +gh_manager *gh_manager::instance = 0; + +static void +xset (const graphics_handle& h, const caseless_str& name, + const octave_value& val) +{ + graphics_object obj = gh_manager::get_object (h); + obj.set (name, val); +} + +static void +xset (const graphics_handle& h, const octave_value_list& args) +{ + if (args.length () > 0) + { + graphics_object obj = gh_manager::get_object (h); + obj.set (args); + } +} + +static octave_value +xget (const graphics_handle& h, const caseless_str& name) +{ + graphics_object obj = gh_manager::get_object (h); + return obj.get (name); +} + +static graphics_handle +reparent (const octave_value& ov, const std::string& who, + const std::string& property, const graphics_handle& new_parent, + bool adopt = true) +{ + graphics_handle h = octave_NaN; + + double val = ov.double_value (); + + if (! error_state) + { + h = gh_manager::lookup (val); + + if (h.ok ()) + { + graphics_object obj = gh_manager::get_object (h); + + graphics_handle parent_h = obj.get_parent (); + + graphics_object parent_obj = gh_manager::get_object (parent_h); + + parent_obj.remove_child (h); + + if (adopt) + obj.set ("parent", new_parent.value ()); + else + obj.reparent (new_parent); + } + else + error ("%s: invalid graphics handle (= %g) for %s", + who.c_str (), val, property.c_str ()); + } + else + error ("%s: expecting %s to be a graphics handle", + who.c_str (), property.c_str ()); + + return h; +} + +// This function is NOT equivalent to the scripting language function gcf. +graphics_handle +gcf (void) +{ + octave_value val = xget (0, "currentfigure"); + + return val.is_empty () ? octave_NaN : val.double_value (); +} + +// This function is NOT equivalent to the scripting language function gca. +graphics_handle +gca (void) +{ + octave_value val = xget (gcf (), "currentaxes"); + + return val.is_empty () ? octave_NaN : val.double_value (); +} + +static void +delete_graphics_object (const graphics_handle& h) +{ + if (h.ok ()) + { + graphics_object obj = gh_manager::get_object (h); + + // Don't do recursive deleting, due to callbacks + if (! obj.get_properties ().is_beingdeleted ()) + { + graphics_handle parent_h = obj.get_parent (); + + graphics_object parent_obj = + gh_manager::get_object (parent_h); + + // NOTE: free the handle before removing it from its + // parent's children, such that the object's + // state is correct when the deletefcn callback + // is executed + + gh_manager::free (h); + + // A callback function might have already deleted + // the parent + if (parent_obj.valid_object ()) + parent_obj.remove_child (h); + + Vdrawnow_requested = true; + } + } +} + +static void +delete_graphics_object (double val) +{ + delete_graphics_object (gh_manager::lookup (val)); +} + +static void +delete_graphics_objects (const NDArray vals) +{ + for (octave_idx_type i = 0; i < vals.numel (); i++) + delete_graphics_object (vals.elem (i)); +} + +static void +close_figure (const graphics_handle& handle) +{ + octave_value closerequestfcn = xget (handle, "closerequestfcn"); + + OCTAVE_SAFE_CALL (gh_manager::execute_callback, (handle, closerequestfcn)); +} + +static void +force_close_figure (const graphics_handle& handle) +{ + // Remove the deletefcn and closerequestfcn callbacks and delete the + // object directly. + + xset (handle, "deletefcn", Matrix ()); + xset (handle, "closerequestfcn", Matrix ()); + + delete_graphics_object (handle); +} + +void +gh_manager::do_close_all_figures (void) +{ + // FIXME -- should we process or discard pending events? + + event_queue.clear (); + + // Don't use figure_list_iterator because we'll be removing elements + // from the list elsewhere. + + Matrix hlist = do_figure_handle_list (true); + + for (octave_idx_type i = 0; i < hlist.numel (); i++) + { + graphics_handle h = gh_manager::lookup (hlist(i)); + + if (h.ok ()) + close_figure (h); + } + + // They should all be closed now. If not, force them to close. + + hlist = do_figure_handle_list (true); + + for (octave_idx_type i = 0; i < hlist.numel (); i++) + { + graphics_handle h = gh_manager::lookup (hlist(i)); + + if (h.ok ()) + force_close_figure (h); + } + + // None left now, right? + + hlist = do_figure_handle_list (true); + + assert (hlist.numel () == 0); + + // Clear all callback objects from our list. + + callback_objects.clear (); +} + +static void +adopt (const graphics_handle& p, const graphics_handle& h) +{ + graphics_object parent_obj = gh_manager::get_object (p); + parent_obj.adopt (h); +} + +static bool +is_handle (const graphics_handle& h) +{ + return h.ok (); +} + +static bool +is_handle (double val) +{ + graphics_handle h = gh_manager::lookup (val); + + return h.ok (); +} + +static octave_value +is_handle (const octave_value& val) +{ + octave_value retval = false; + + if (val.is_real_scalar () && is_handle (val.double_value ())) + retval = true; + else if (val.is_numeric_type () && val.is_real_type ()) + { + const NDArray handles = val.array_value (); + + if (! error_state) + { + boolNDArray result (handles.dims ()); + + for (octave_idx_type i = 0; i < handles.numel (); i++) + result.xelem (i) = is_handle (handles (i)); + + retval = result; + } + } + + return retval; +} + +static bool +is_figure (double val) +{ + graphics_object obj = gh_manager::get_object (val); + + return obj && obj.isa ("figure"); +} + +static void +xcreatefcn (const graphics_handle& h) +{ + graphics_object obj = gh_manager::get_object (h); + obj.get_properties ().execute_createfcn (); +} + +static void +xinitialize (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + go.initialize (); +} + +// --------------------------------------------------------------------- + +void +base_graphics_toolkit::update (const graphics_handle& h, int id) +{ + graphics_object go = gh_manager::get_object (h); + + update (go, id); +} + +bool +base_graphics_toolkit::initialize (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + return initialize (go); +} + +void +base_graphics_toolkit::finalize (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + finalize (go); +} + +// --------------------------------------------------------------------- + +void +base_properties::set_from_list (base_graphics_object& obj, + property_list& defaults) +{ + std::string go_name = graphics_object_name (); + + property_list::plist_map_const_iterator p = defaults.find (go_name); + + if (p != defaults.end ()) + { + const property_list::pval_map_type pval_map = p->second; + + for (property_list::pval_map_const_iterator q = pval_map.begin (); + q != pval_map.end (); + q++) + { + std::string pname = q->first; + + obj.set (pname, q->second); + + if (error_state) + { + error ("error setting default property %s", pname.c_str ()); + break; + } + } + } +} + +octave_value +base_properties::get_dynamic (const caseless_str& name) const +{ + octave_value retval; + + std::map::const_iterator it = all_props.find (name); + + if (it != all_props.end ()) + retval = it->second.get (); + else + error ("get: unknown property \"%s\"", name.c_str ()); + + return retval; +} + +octave_value +base_properties::get_dynamic (bool all) const +{ + octave_scalar_map m; + + for (std::map::const_iterator it = all_props.begin (); + it != all_props.end (); ++it) + if (all || ! it->second.is_hidden ()) + m.assign (it->second.get_name (), it->second.get ()); + + return m; +} + +std::set +base_properties::dynamic_property_names (void) const +{ + return dynamic_properties; +} + +bool +base_properties::has_dynamic_property (const std::string& pname) +{ + const std::set& dynprops = dynamic_property_names (); + + if (dynprops.find (pname) != dynprops.end ()) + return true; + else + return all_props.find (pname) != all_props.end (); +} + +void +base_properties::set_dynamic (const caseless_str& pname, + const octave_value& val) +{ + std::map::iterator it = all_props.find (pname); + + if (it != all_props.end ()) + it->second.set (val); + else + error ("set: unknown property \"%s\"", pname.c_str ()); + + if (! error_state) + { + dynamic_properties.insert (pname); + + mark_modified (); + } +} + +property +base_properties::get_property_dynamic (const caseless_str& name) +{ + std::map::const_iterator it = all_props.find (name); + + if (it == all_props.end ()) + { + error ("get_property: unknown property \"%s\"", name.c_str ()); + return property (); + } + else + return it->second; +} + +void +base_properties::set_parent (const octave_value& val) +{ + double tmp = val.double_value (); + + graphics_handle new_parent = octave_NaN; + + if (! error_state) + { + new_parent = gh_manager::lookup (tmp); + + if (new_parent.ok ()) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + parent_obj.remove_child (__myhandle__); + + parent = new_parent.as_octave_value (); + + ::adopt (parent.handle_value (), __myhandle__); + } + else + error ("set: invalid graphics handle (= %g) for parent", tmp); + } + else + error ("set: expecting parent to be a graphics handle"); +} + +void +base_properties::mark_modified (void) +{ + __modified__ = "on"; + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + if (parent_obj) + parent_obj.mark_modified (); +} + +void +base_properties::override_defaults (base_graphics_object& obj) +{ + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj) + parent_obj.override_defaults (obj); +} + +void +base_properties::update_axis_limits (const std::string& axis_type) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + obj.update_axis_limits (axis_type); +} + +void +base_properties::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + obj.update_axis_limits (axis_type, h); +} + +bool +base_properties::is_handle_visible (void) const +{ + return (handlevisibility.is ("on") + || (executing_callback && ! handlevisibility.is ("off"))); +} + +graphics_toolkit +base_properties::get_toolkit (void) const +{ + graphics_object go = gh_manager::get_object (get_parent ()); + + if (go) + return go.get_toolkit (); + else + return graphics_toolkit (); +} + +void +base_properties::update_boundingbox (void) +{ + Matrix kids = get_children (); + + for (int i = 0; i < kids.numel (); i++) + { + graphics_object go = gh_manager::get_object (kids(i)); + + if (go.valid_object ()) + go.get_properties ().update_boundingbox (); + } +} + +void +base_properties::update_autopos (const std::string& elem_type) +{ + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj.valid_object ()) + parent_obj.get_properties ().update_autopos (elem_type); +} + +void +base_properties::add_listener (const caseless_str& nm, const octave_value& v, + listener_mode mode) +{ + property p = get_property (nm); + + if (! error_state && p.ok ()) + p.add_listener (v, mode); +} + +void +base_properties::delete_listener (const caseless_str& nm, + const octave_value& v, listener_mode mode) +{ + property p = get_property (nm); + + if (! error_state && p.ok ()) + p.delete_listener (v, mode); +} + +// --------------------------------------------------------------------- + +void +base_graphics_object::update_axis_limits (const std::string& axis_type) +{ + if (valid_object ()) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj) + parent_obj.update_axis_limits (axis_type); + } + else + error ("base_graphics_object::update_axis_limits: invalid graphics object"); +} + +void +base_graphics_object::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) +{ + if (valid_object ()) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj) + parent_obj.update_axis_limits (axis_type, h); + } + else + error ("base_graphics_object::update_axis_limits: invalid graphics object"); +} + +void +base_graphics_object::remove_all_listeners (void) +{ + octave_map m = get (true).map_value (); + + for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) + { + // FIXME -- there has to be a better way. I think we want to + // ask whether it is OK to delete the listener for the given + // property. How can we know in advance that it will be OK? + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (discard_error_messages); + frame.protect_var (Vdebug_on_error); + frame.protect_var (Vdebug_on_warning); + + discard_error_messages = true; + Vdebug_on_error = false; + Vdebug_on_warning = false; + + property p = get_properties ().get_property (pa->first); + + if (! error_state && p.ok ()) + p.delete_listener (); + } +} + +std::string +base_graphics_object::values_as_string (void) +{ + std::string retval; + + if (valid_object ()) + { + octave_map m = get ().map_value (); + + for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) + { + if (pa->first != "children") + { + property p = get_properties ().get_property (pa->first); + + if (p.ok () && ! p.is_hidden ()) + { + retval += "\n\t" + std::string (pa->first) + ": "; + if (p.is_radio ()) + retval += p.values_as_string (); + } + } + } + if (retval != "") + retval += "\n"; + } + else + error ("base_graphics_object::values_as_string: invalid graphics object"); + + return retval; +} + +octave_scalar_map +base_graphics_object::values_as_struct (void) +{ + octave_scalar_map retval; + + if (valid_object ()) + { + octave_scalar_map m = get ().scalar_map_value (); + + for (octave_scalar_map::const_iterator pa = m.begin (); + pa != m.end (); pa++) + { + if (pa->first != "children") + { + property p = get_properties ().get_property (pa->first); + + if (p.ok () && ! p.is_hidden ()) + { + if (p.is_radio ()) + retval.assign (p.get_name (), p.values_as_cell ()); + else + retval.assign (p.get_name (), Cell ()); + } + } + } + } + else + error ("base_graphics_object::values_as_struct: invalid graphics object"); + + return retval; +} + +graphics_object +graphics_object::get_ancestor (const std::string& obj_type) const +{ + if (valid_object ()) + { + if (isa (obj_type)) + return *this; + else + return gh_manager::get_object (get_parent ()).get_ancestor (obj_type); + } + else + return graphics_object (); +} + +// --------------------------------------------------------------------- + +#include "graphics-props.cc" + +// --------------------------------------------------------------------- + +void +root_figure::properties::set_currentfigure (const octave_value& v) +{ + graphics_handle val (v); + + if (error_state) + return; + + if (xisnan (val.value ()) || is_handle (val)) + { + currentfigure = val; + + if (val.ok ()) + gh_manager::push_figure (val); + } + else + gripe_set_invalid ("currentfigure"); +} + +void +root_figure::properties::set_callbackobject (const octave_value& v) +{ + graphics_handle val (v); + + if (error_state) + return; + + if (xisnan (val.value ())) + { + if (! cbo_stack.empty ()) + { + val = cbo_stack.front (); + + cbo_stack.pop_front (); + } + + callbackobject = val; + } + else if (is_handle (val)) + { + if (get_callbackobject ().ok ()) + cbo_stack.push_front (get_callbackobject ()); + + callbackobject = val; + } + else + gripe_set_invalid ("callbackobject"); +} + +void +figure::properties::set_integerhandle (const octave_value& val) +{ + if (! error_state) + { + if (integerhandle.set (val, true)) + { + bool int_fig_handle = integerhandle.is_on (); + + graphics_object this_go = gh_manager::get_object (__myhandle__); + + graphics_handle old_myhandle = __myhandle__; + + __myhandle__ = gh_manager::get_handle (int_fig_handle); + + gh_manager::renumber_figure (old_myhandle, __myhandle__); + + graphics_object parent_go = gh_manager::get_object (get_parent ()); + + base_properties& props = parent_go.get_properties (); + + props.renumber_child (old_myhandle, __myhandle__); + + Matrix kids = get_children (); + + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_object kid = gh_manager::get_object (kids(i)); + + kid.get_properties ().renumber_parent (__myhandle__); + } + + graphics_handle cf = gh_manager::current_figure (); + + if (__myhandle__ == cf) + xset (0, "currentfigure", __myhandle__.value ()); + + this_go.update (integerhandle.get_id ()); + + mark_modified (); + } + } +} + +// FIXME This should update monitorpositions and pointerlocation, but +// as these properties are yet used, and so it doesn't matter that they +// aren't set yet. +void +root_figure::properties::update_units (void) +{ + caseless_str xunits = get_units (); + + Matrix ss = default_screensize (); + + double dpi = get_screenpixelsperinch (); + + if (xunits.compare ("inches")) + { + ss(0) = 0; + ss(1) = 0; + ss(2) /= dpi; + ss(3) /= dpi; + } + else if (xunits.compare ("centimeters")) + { + ss(0) = 0; + ss(1) = 0; + ss(2) *= 2.54 / dpi; + ss(3) *= 2.54 / dpi; + } + else if (xunits.compare ("normalized")) + { + ss = Matrix (1, 4, 1.0); + ss(0) = 0; + ss(1) = 0; + } + else if (xunits.compare ("points")) + { + ss(0) = 0; + ss(1) = 0; + ss(2) *= 72 / dpi; + ss(3) *= 72 / dpi; + } + + set_screensize (ss); +} + +Matrix +root_figure::properties::get_boundingbox (bool, const Matrix&) const +{ + Matrix screen_size = screen_size_pixels (); + Matrix pos = Matrix (1, 4, 0); + pos(2) = screen_size(0); + pos(3) = screen_size(1); + return pos; +} + +/* +%!test +%! set (0, "units", "pixels"); +%! sz = get (0, "screensize") - [1, 1, 0, 0]; +%! dpi = get (0, "screenpixelsperinch"); +%! set (0, "units", "inches"); +%! assert (get (0, "screensize"), sz / dpi, 0.5 / dpi); +%! set (0, "units", "centimeters"); +%! assert (get (0, "screensize"), sz / dpi * 2.54, 0.5 / dpi * 2.54); +%! set (0, "units", "points"); +%! assert (get (0, "screensize"), sz / dpi * 72, 0.5 / dpi * 72); +%! set (0, "units", "normalized"); +%! assert (get (0, "screensize"), [0.0, 0.0, 1.0, 1.0]); +%! set (0, "units", "pixels"); +%! assert (get (0, "screensize"), sz + [1, 1, 0, 0]); +*/ + +void +root_figure::properties::remove_child (const graphics_handle& gh) +{ + gh_manager::pop_figure (gh); + + graphics_handle cf = gh_manager::current_figure (); + + xset (0, "currentfigure", cf.value ()); + + base_properties::remove_child (gh); +} + +property_list +root_figure::factory_properties = root_figure::init_factory_properties (); + +static void +reset_default_properties (property_list& default_properties) +{ + property_list new_defaults; + + for (property_list::plist_map_const_iterator p = default_properties.begin (); + p != default_properties.end (); p++) + { + const property_list::pval_map_type pval_map = p->second; + std::string prefix = p->first; + + for (property_list::pval_map_const_iterator q = pval_map.begin (); + q != pval_map.end (); + q++) + { + std::string s = q->first; + + if (prefix == "axes" && (s == "position" || s == "units")) + new_defaults.set (prefix + s, q->second); + else if (prefix == "figure" && (s == "position" || s == "units" + || s == "windowstyle" + || s == "paperunits")) + new_defaults.set (prefix + s, q->second); + } + } + + default_properties = new_defaults; +} + +void +root_figure::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +// --------------------------------------------------------------------- + +void +figure::properties::set_currentaxes (const octave_value& v) +{ + graphics_handle val (v); + + if (error_state) + return; + + if (xisnan (val.value ()) || is_handle (val)) + currentaxes = val; + else + gripe_set_invalid ("currentaxes"); +} + +void +figure::properties::remove_child (const graphics_handle& gh) +{ + base_properties::remove_child (gh); + + if (gh == currentaxes.handle_value ()) + { + graphics_handle new_currentaxes; + + Matrix kids = get_children (); + + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_handle kid = kids(i); + + graphics_object go = gh_manager::get_object (kid); + + if (go.isa ("axes")) + { + new_currentaxes = kid; + break; + } + } + + currentaxes = new_currentaxes; + } +} + +void +figure::properties::set_visible (const octave_value& val) +{ + std::string s = val.string_value (); + + if (! error_state) + { + if (s == "on") + xset (0, "currentfigure", __myhandle__.value ()); + + visible = val; + } +} + +Matrix +figure::properties::get_boundingbox (bool internal, const Matrix&) const +{ + Matrix screen_size = screen_size_pixels (); + Matrix pos = (internal ? + get_position ().matrix_value () : + get_outerposition ().matrix_value ()); + + pos = convert_position (pos, get_units (), "pixels", screen_size); + + pos(0)--; + pos(1)--; + pos(1) = screen_size(1) - pos(1) - pos(3); + + return pos; +} + +void +figure::properties::set_boundingbox (const Matrix& bb, bool internal, + bool do_notify_toolkit) +{ + Matrix screen_size = screen_size_pixels (); + Matrix pos = bb; + + pos(1) = screen_size(1) - pos(1) - pos(3); + pos(1)++; + pos(0)++; + pos = convert_position (pos, "pixels", get_units (), screen_size); + + if (internal) + set_position (pos, do_notify_toolkit); + else + set_outerposition (pos, do_notify_toolkit); +} + +Matrix +figure::properties::map_from_boundingbox (double x, double y) const +{ + Matrix bb = get_boundingbox (true); + Matrix pos (1, 2, 0); + + pos(0) = x; + pos(1) = y; + + pos(1) = bb(3) - pos(1); + pos(0)++; + pos = convert_position (pos, "pixels", get_units (), + bb.extract_n (0, 2, 1, 2)); + + return pos; +} + +Matrix +figure::properties::map_to_boundingbox (double x, double y) const +{ + Matrix bb = get_boundingbox (true); + Matrix pos (1, 2, 0); + + pos(0) = x; + pos(1) = y; + + pos = convert_position (pos, get_units (), "pixels", + bb.extract_n (0, 2, 1, 2)); + pos(0)--; + pos(1) = bb(3) - pos(1); + + return pos; +} + +void +figure::properties::set_position (const octave_value& v, + bool do_notify_toolkit) +{ + if (! error_state) + { + Matrix old_bb, new_bb; + bool modified = false; + + old_bb = get_boundingbox (true); + modified = position.set (v, false, do_notify_toolkit); + new_bb = get_boundingbox (true); + + if (old_bb != new_bb) + { + if (old_bb(2) != new_bb(2) || old_bb(3) != new_bb(3)) + { + execute_resizefcn (); + update_boundingbox (); + } + } + + if (modified) + { + position.run_listeners (POSTSET); + mark_modified (); + } + } +} + +void +figure::properties::set_outerposition (const octave_value& v, + bool do_notify_toolkit) +{ + if (! error_state) + { + if (outerposition.set (v, true, do_notify_toolkit)) + { + mark_modified (); + } + } +} + +void +figure::properties::set_paperunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str typ = get_papertype (); + caseless_str punits = v.string_value (); + if (! error_state) + { + if (punits.compare ("normalized") && typ.compare ("")) + error ("set: can't set the paperunits to normalized when the papertype is custom"); + else + { + caseless_str old_paperunits = get_paperunits (); + if (paperunits.set (v, true)) + { + update_paperunits (old_paperunits); + mark_modified (); + } + } + } + } +} + +void +figure::properties::set_papertype (const octave_value& v) +{ + if (! error_state) + { + caseless_str typ = v.string_value (); + caseless_str punits = get_paperunits (); + if (! error_state) + { + if (punits.compare ("normalized") && typ.compare ("")) + error ("set: can't set the paperunits to normalized when the papertype is custom"); + else + { + if (papertype.set (v, true)) + { + update_papertype (); + mark_modified (); + } + } + } + } +} + +static Matrix +papersize_from_type (const caseless_str punits, const caseless_str typ) +{ + Matrix ret (1, 2, 1.0); + + if (! punits.compare ("normalized")) + { + double in2units; + double mm2units; + + if (punits.compare ("inches")) + { + in2units = 1.0; + mm2units = 1 / 25.4 ; + } + else if (punits.compare ("centimeters")) + { + in2units = 2.54; + mm2units = 1 / 10.0; + } + else // points + { + in2units = 72.0; + mm2units = 72.0 / 25.4; + } + + if (typ.compare ("usletter")) + { + ret (0) = 8.5 * in2units; + ret (1) = 11.0 * in2units; + } + else if (typ.compare ("uslegal")) + { + ret (0) = 8.5 * in2units; + ret (1) = 14.0 * in2units; + } + else if (typ.compare ("tabloid")) + { + ret (0) = 11.0 * in2units; + ret (1) = 17.0 * in2units; + } + else if (typ.compare ("a0")) + { + ret (0) = 841.0 * mm2units; + ret (1) = 1189.0 * mm2units; + } + else if (typ.compare ("a1")) + { + ret (0) = 594.0 * mm2units; + ret (1) = 841.0 * mm2units; + } + else if (typ.compare ("a2")) + { + ret (0) = 420.0 * mm2units; + ret (1) = 594.0 * mm2units; + } + else if (typ.compare ("a3")) + { + ret (0) = 297.0 * mm2units; + ret (1) = 420.0 * mm2units; + } + else if (typ.compare ("a4")) + { + ret (0) = 210.0 * mm2units; + ret (1) = 297.0 * mm2units; + } + else if (typ.compare ("a5")) + { + ret (0) = 148.0 * mm2units; + ret (1) = 210.0 * mm2units; + } + else if (typ.compare ("b0")) + { + ret (0) = 1029.0 * mm2units; + ret (1) = 1456.0 * mm2units; + } + else if (typ.compare ("b1")) + { + ret (0) = 728.0 * mm2units; + ret (1) = 1028.0 * mm2units; + } + else if (typ.compare ("b2")) + { + ret (0) = 514.0 * mm2units; + ret (1) = 728.0 * mm2units; + } + else if (typ.compare ("b3")) + { + ret (0) = 364.0 * mm2units; + ret (1) = 514.0 * mm2units; + } + else if (typ.compare ("b4")) + { + ret (0) = 257.0 * mm2units; + ret (1) = 364.0 * mm2units; + } + else if (typ.compare ("b5")) + { + ret (0) = 182.0 * mm2units; + ret (1) = 257.0 * mm2units; + } + else if (typ.compare ("arch-a")) + { + ret (0) = 9.0 * in2units; + ret (1) = 12.0 * in2units; + } + else if (typ.compare ("arch-b")) + { + ret (0) = 12.0 * in2units; + ret (1) = 18.0 * in2units; + } + else if (typ.compare ("arch-c")) + { + ret (0) = 18.0 * in2units; + ret (1) = 24.0 * in2units; + } + else if (typ.compare ("arch-d")) + { + ret (0) = 24.0 * in2units; + ret (1) = 36.0 * in2units; + } + else if (typ.compare ("arch-e")) + { + ret (0) = 36.0 * in2units; + ret (1) = 48.0 * in2units; + } + else if (typ.compare ("a")) + { + ret (0) = 8.5 * in2units; + ret (1) = 11.0 * in2units; + } + else if (typ.compare ("b")) + { + ret (0) = 11.0 * in2units; + ret (1) = 17.0 * in2units; + } + else if (typ.compare ("c")) + { + ret (0) = 17.0 * in2units; + ret (1) = 22.0 * in2units; + } + else if (typ.compare ("d")) + { + ret (0) = 22.0 * in2units; + ret (1) = 34.0 * in2units; + } + else if (typ.compare ("e")) + { + ret (0) = 34.0 * in2units; + ret (1) = 43.0 * in2units; + } + } + + return ret; +} + +void +figure::properties::update_paperunits (const caseless_str& old_paperunits) +{ + Matrix pos = get_paperposition ().matrix_value (); + Matrix sz = get_papersize ().matrix_value (); + + pos(0) /= sz(0); + pos(1) /= sz(1); + pos(2) /= sz(0); + pos(3) /= sz(1); + + std::string porient = get_paperorientation (); + caseless_str punits = get_paperunits (); + caseless_str typ = get_papertype (); + + if (typ.compare ("")) + { + if (old_paperunits.compare ("centimeters")) + { + sz(0) /= 2.54; + sz(1) /= 2.54; + } + else if (old_paperunits.compare ("points")) + { + sz(0) /= 72.0; + sz(1) /= 72.0; + } + + if (punits.compare ("centimeters")) + { + sz(0) *= 2.54; + sz(1) *= 2.54; + } + else if (punits.compare ("points")) + { + sz(0) *= 72.0; + sz(1) *= 72.0; + } + } + else + { + sz = papersize_from_type (punits, typ); + if (porient == "landscape") + std::swap (sz(0), sz(1)); + } + + pos(0) *= sz(0); + pos(1) *= sz(1); + pos(2) *= sz(0); + pos(3) *= sz(1); + + papersize.set (octave_value (sz)); + paperposition.set (octave_value (pos)); +} + +void +figure::properties::update_papertype (void) +{ + caseless_str typ = get_papertype (); + if (! typ.compare ("")) + { + Matrix sz = papersize_from_type (get_paperunits (), typ); + if (get_paperorientation () == "landscape") + std::swap (sz(0), sz(1)); + // Call papersize.set rather than set_papersize to avoid loops + // between update_papersize and update_papertype + papersize.set (octave_value (sz)); + } +} + +void +figure::properties::update_papersize (void) +{ + Matrix sz = get_papersize ().matrix_value (); + if (sz(0) > sz(1)) + { + std::swap (sz(0), sz(1)); + papersize.set (octave_value (sz)); + paperorientation.set (octave_value ("landscape")); + } + else + { + paperorientation.set ("portrait"); + } + std::string punits = get_paperunits (); + if (punits == "centimeters") + { + sz(0) /= 2.54; + sz(1) /= 2.54; + } + else if (punits == "points") + { + sz(0) /= 72.0; + sz(1) /= 72.0; + } + if (punits == "normalized") + { + caseless_str typ = get_papertype (); + if (get_papertype () == "") + error ("set: can't set the papertype to when the paperunits is normalized"); + } + else + { + // TODO - the papersizes info is also in papersize_from_type(). + // Both should be rewritten to avoid the duplication. + std::string typ = ""; + const double mm2in = 1.0 / 25.4; + const double tol = 0.01; + + if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) + typ = "usletter"; + else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 14.0) < tol) + typ = "uslegal"; + else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) + typ = "tabloid"; + else if (std::abs (sz(0) - 841.0 * mm2in) + std::abs (sz(1) - 1198.0 * mm2in) < tol) + typ = "a0"; + else if (std::abs (sz(0) - 594.0 * mm2in) + std::abs (sz(1) - 841.0 * mm2in) < tol) + typ = "a1"; + else if (std::abs (sz(0) - 420.0 * mm2in) + std::abs (sz(1) - 594.0 * mm2in) < tol) + typ = "a2"; + else if (std::abs (sz(0) - 297.0 * mm2in) + std::abs (sz(1) - 420.0 * mm2in) < tol) + typ = "a3"; + else if (std::abs (sz(0) - 210.0 * mm2in) + std::abs (sz(1) - 297.0 * mm2in) < tol) + typ = "a4"; + else if (std::abs (sz(0) - 148.0 * mm2in) + std::abs (sz(1) - 210.0 * mm2in) < tol) + typ = "a5"; + else if (std::abs (sz(0) - 1029.0 * mm2in) + std::abs (sz(1) - 1456.0 * mm2in) < tol) + typ = "b0"; + else if (std::abs (sz(0) - 728.0 * mm2in) + std::abs (sz(1) - 1028.0 * mm2in) < tol) + typ = "b1"; + else if (std::abs (sz(0) - 514.0 * mm2in) + std::abs (sz(1) - 728.0 * mm2in) < tol) + typ = "b2"; + else if (std::abs (sz(0) - 364.0 * mm2in) + std::abs (sz(1) - 514.0 * mm2in) < tol) + typ = "b3"; + else if (std::abs (sz(0) - 257.0 * mm2in) + std::abs (sz(1) - 364.0 * mm2in) < tol) + typ = "b4"; + else if (std::abs (sz(0) - 182.0 * mm2in) + std::abs (sz(1) - 257.0 * mm2in) < tol) + typ = "b5"; + else if (std::abs (sz(0) - 9.0) + std::abs (sz(1) - 12.0) < tol) + typ = "arch-a"; + else if (std::abs (sz(0) - 12.0) + std::abs (sz(1) - 18.0) < tol) + typ = "arch-b"; + else if (std::abs (sz(0) - 18.0) + std::abs (sz(1) - 24.0) < tol) + typ = "arch-c"; + else if (std::abs (sz(0) - 24.0) + std::abs (sz(1) - 36.0) < tol) + typ = "arch-d"; + else if (std::abs (sz(0) - 36.0) + std::abs (sz(1) - 48.0) < tol) + typ = "arch-e"; + else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) + typ = "a"; + else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) + typ = "b"; + else if (std::abs (sz(0) - 17.0) + std::abs (sz(1) - 22.0) < tol) + typ = "c"; + else if (std::abs (sz(0) - 22.0) + std::abs (sz(1) - 34.0) < tol) + typ = "d"; + else if (std::abs (sz(0) - 34.0) + std::abs (sz(1) - 43.0) < tol) + typ = "e"; + // Call papertype.set rather than set_papertype to avoid loops between + // update_papersize and update_papertype + papertype.set (typ); + } + if (punits == "centimeters") + { + sz(0) *= 2.54; + sz(1) *= 2.54; + } + else if (punits == "points") + { + sz(0) *= 72.0; + sz(1) *= 72.0; + } + if (get_paperorientation () == "landscape") + { + std::swap (sz(0), sz(1)); + papersize.set (octave_value (sz)); + } +} + +/* +%!test +%! figure (1, "visible", "off"); +%! set (1, "paperunits", "inches"); +%! set (1, "papersize", [5, 4]) +%! set (1, "paperunits", "points"); +%! assert (get (1, "papersize"), [5, 4] * 72, 1) +%! papersize = get (gcf, "papersize"); +%! set (1, "papersize", papersize + 1); +%! set (1, "papersize", papersize) +%! assert (get (1, "papersize"), [5, 4] * 72, 1) +%! close (1) +%!test +%! figure (1, "visible", "off"); +%! set (1, "paperunits", "inches"); +%! set (1, "papersize", [5, 4]) +%! set (1, "paperunits", "centimeters"); +%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72) +%! papersize = get (gcf, "papersize"); +%! set (1, "papersize", papersize + 1); +%! set (1, "papersize", papersize) +%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72) +%! close (1) +*/ + +void +figure::properties::update_paperorientation (void) +{ + std::string porient = get_paperorientation (); + Matrix sz = get_papersize ().matrix_value (); + Matrix pos = get_paperposition ().matrix_value (); + if ((sz(0) > sz(1) && porient == "portrait") + || (sz(0) < sz(1) && porient == "landscape")) + { + std::swap (sz(0), sz(1)); + std::swap (pos(0), pos(1)); + std::swap (pos(2), pos(3)); + // Call papertype.set rather than set_papertype to avoid loops + // between update_papersize and update_papertype + papersize.set (octave_value (sz)); + paperposition.set (octave_value (pos)); + } +} + +/* +%!test +%! figure (1, "visible", false); +%! tol = 100 * eps (); +%! ## UPPER case and MiXed case is part of test and should not be changed. +%! set (gcf (), "paperorientation", "PORTRAIT"); +%! set (gcf (), "paperunits", "inches"); +%! set (gcf (), "papertype", "USletter"); +%! assert (get (gcf (), "papersize"), [8.5, 11.0], tol); +%! set (gcf (), "paperorientation", "Landscape"); +%! assert (get (gcf (), "papersize"), [11.0, 8.5], tol); +%! set (gcf (), "paperunits", "centimeters"); +%! assert (get (gcf (), "papersize"), [11.0, 8.5] * 2.54, tol); +%! set (gcf (), "papertype", "a4"); +%! assert (get (gcf (), "papersize"), [29.7, 21.0], tol); +%! set (gcf (), "paperunits", "inches", "papersize", [8.5, 11.0]); +%! assert (get (gcf (), "papertype"), "usletter"); +%! assert (get (gcf (), "paperorientation"), "portrait"); +%! set (gcf (), "papersize", [11.0, 8.5]); +%! assert (get (gcf (), "papertype"), "usletter"); +%! assert (get (gcf (), "paperorientation"), "landscape"); +*/ + +void +figure::properties::set_units (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_units = get_units (); + if (units.set (v, true)) + { + update_units (old_units); + mark_modified (); + } + } +} + +void +figure::properties::update_units (const caseless_str& old_units) +{ + position.set (convert_position (get_position ().matrix_value (), old_units, + get_units (), screen_size_pixels ()), false); +} + +/* +%!test +%! figure (1, "visible", false); +%! set (0, "units", "pixels"); +%! rsz = get (0, "screensize"); +%! set (gcf (), "units", "pixels"); +%! fsz = get (gcf (), "position"); +%! set (gcf (), "units", "normalized"); +%! assert (get (gcf (), "position"), (fsz - [1, 1, 0, 0]) ./ rsz([3, 4, 3, 4])); +*/ + +std::string +figure::properties::get_title (void) const +{ + if (is_numbertitle ()) + { + std::ostringstream os; + std::string nm = get_name (); + + os << "Figure " << __myhandle__.value (); + if (! nm.empty ()) + os << ": " << get_name (); + + return os.str (); + } + else + return get_name (); +} + +octave_value +figure::get_default (const caseless_str& name) const +{ + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + retval = parent_obj.get_default (name); + } + + return retval; +} + +void +figure::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +// --------------------------------------------------------------------- + +void +axes::properties::init (void) +{ + position.add_constraint (dim_vector (1, 4)); + position.add_constraint (dim_vector (0, 0)); + outerposition.add_constraint (dim_vector (1, 4)); + colororder.add_constraint (dim_vector (-1, 3)); + dataaspectratio.add_constraint (dim_vector (1, 3)); + plotboxaspectratio.add_constraint (dim_vector (1, 3)); + xlim.add_constraint (2); + ylim.add_constraint (2); + zlim.add_constraint (2); + clim.add_constraint (2); + alim.add_constraint (2); + xtick.add_constraint (dim_vector (1, -1)); + ytick.add_constraint (dim_vector (1, -1)); + ztick.add_constraint (dim_vector (1, -1)); + Matrix vw (1, 2, 0); + vw(1) = 90; + view = vw; + view.add_constraint (dim_vector (1, 2)); + cameraposition.add_constraint (dim_vector (1, 3)); + Matrix upv (1, 3, 0.0); + upv(2) = 1.0; + cameraupvector = upv; + cameraupvector.add_constraint (dim_vector (1, 3)); + currentpoint.add_constraint (dim_vector (2, 3)); + ticklength.add_constraint (dim_vector (1, 2)); + tightinset.add_constraint (dim_vector (1, 4)); + looseinset.add_constraint (dim_vector (1, 4)); + update_font (); + + x_zlim.resize (1, 2); + + sx = "linear"; + sy = "linear"; + sz = "linear"; + + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + + xset (xlabel.handle_value (), "handlevisibility", "off"); + xset (ylabel.handle_value (), "handlevisibility", "off"); + xset (zlabel.handle_value (), "handlevisibility", "off"); + xset (title.handle_value (), "handlevisibility", "off"); + + xset (xlabel.handle_value (), "horizontalalignment", "center"); + xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (ylabel.handle_value (), "horizontalalignment", "center"); + xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (zlabel.handle_value (), "horizontalalignment", "right"); + xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (title.handle_value (), "horizontalalignment", "center"); + xset (title.handle_value (), "horizontalalignmentmode", "auto"); + + xset (xlabel.handle_value (), "verticalalignment", "cap"); + xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (ylabel.handle_value (), "verticalalignment", "bottom"); + xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); + xset (title.handle_value (), "verticalalignment", "bottom"); + xset (title.handle_value (), "verticalalignmentmode", "auto"); + + xset (ylabel.handle_value (), "rotation", 90.0); + xset (ylabel.handle_value (), "rotationmode", "auto"); + + xset (zlabel.handle_value (), "visible", "off"); + + xset (xlabel.handle_value (), "clipping", "off"); + xset (ylabel.handle_value (), "clipping", "off"); + xset (zlabel.handle_value (), "clipping", "off"); + xset (title.handle_value (), "clipping", "off"); + + xset (xlabel.handle_value (), "autopos_tag", "xlabel"); + xset (ylabel.handle_value (), "autopos_tag", "ylabel"); + xset (zlabel.handle_value (), "autopos_tag", "zlabel"); + xset (title.handle_value (), "autopos_tag", "title"); + + adopt (xlabel.handle_value ()); + adopt (ylabel.handle_value ()); + adopt (zlabel.handle_value ()); + adopt (title.handle_value ()); + + Matrix tlooseinset = default_axes_position (); + tlooseinset(2) = 1-tlooseinset(0)-tlooseinset(2); + tlooseinset(3) = 1-tlooseinset(1)-tlooseinset(3); + looseinset = tlooseinset; +} + +Matrix +axes::properties::calc_tightbox (const Matrix& init_pos) +{ + Matrix pos = init_pos; + graphics_object obj = gh_manager::get_object (get_parent ()); + Matrix parent_bb = obj.get_properties ().get_boundingbox (true); + Matrix ext = get_extent (true, true); + ext(1) = parent_bb(3) - ext(1) - ext(3); + ext(0)++; + ext(1)++; + ext = convert_position (ext, "pixels", get_units (), + parent_bb.extract_n (0, 2, 1, 2)); + if (ext(0) < pos(0)) + { + pos(2) += pos(0)-ext(0); + pos(0) = ext(0); + } + if (ext(0)+ext(2) > pos(0)+pos(2)) + pos(2) = ext(0)+ext(2)-pos(0); + + if (ext(1) < pos(1)) + { + pos(3) += pos(1)-ext(1); + pos(1) = ext(1); + } + if (ext(1)+ext(3) > pos(1)+pos(3)) + pos(3) = ext(1)+ext(3)-pos(1); + return pos; +} + +void +axes::properties::sync_positions (void) +{ + Matrix ref_linset = looseinset.get ().matrix_value (); + if (autopos_tag_is ("subplot")) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + if (parent_obj.isa ("figure")) + { + // FIXME: temporarily changed units should be protected + // from interrupts + std::string fig_units = parent_obj.get ("units").string_value (); + parent_obj.set ("units", "pixels"); + + Matrix ref_outbox = outerposition.get ().matrix_value (); + ref_outbox(2) += ref_outbox(0); + ref_outbox(3) += ref_outbox(1); + + // Find those subplots that are left, right, bottom and top aligned + // with the current subplot + Matrix kids = parent_obj.get_properties ().get_children (); + std::vector aligned; + std::vector l_aligned, b_aligned, r_aligned, t_aligned; + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_object go = gh_manager::get_object (kids(i)); + if (go.isa ("axes")) + { + axes::properties& props = + dynamic_cast (go.get_properties ()); + if (props.autopos_tag_is ("subplot")) + { + Matrix outpos = go.get ("outerposition").matrix_value (); + bool l_align = (std::abs (outpos(0)-ref_outbox(0)) < 1e-15); + bool b_align = (std::abs (outpos(1)-ref_outbox(1)) < 1e-15); + bool r_align = (std::abs (outpos(0)+outpos(2)-ref_outbox(2)) < 1e-15); + bool t_align = (std::abs (outpos(1)+outpos(3)-ref_outbox(3)) < 1e-15); + if (l_align || b_align || r_align || t_align) + { + aligned.push_back (kids(i)); + l_aligned.push_back (l_align); + b_aligned.push_back (b_align); + r_aligned.push_back (r_align); + t_aligned.push_back (t_align); + // FIXME: the temporarily deleted tags should be + // protected from interrupts + props.set_autopos_tag ("none"); + } + } + } + } + // Determine a minimum box which aligns the subplots + Matrix ref_box (1, 4, 0.); + ref_box(2) = 1.; + ref_box(3) = 1.; + for (size_t i = 0; i < aligned.size (); i++) + { + graphics_object go = gh_manager::get_object (aligned[i]); + axes::properties& props = + dynamic_cast (go.get_properties ()); + Matrix linset = props.get_looseinset ().matrix_value (); + if (l_aligned[i]) + linset(0) = std::min (0., linset(0)-0.01); + if (b_aligned[i]) + linset(1) = std::min (0., linset(1)-0.01); + if (r_aligned[i]) + linset(2) = std::min (0., linset(2)-0.01); + if (t_aligned[i]) + linset(3) = std::min (0., linset(3)-0.01); + props.set_looseinset (linset); + Matrix pos = props.get_position ().matrix_value (); + if (l_aligned[i]) + ref_box(0) = std::max (ref_box(0), pos(0)); + if (b_aligned[i]) + ref_box(1) = std::max (ref_box(1), pos(1)); + if (r_aligned[i]) + ref_box(2) = std::min (ref_box(2), pos(0)+pos(2)); + if (t_aligned[i]) + ref_box(3) = std::min (ref_box(3), pos(1)+pos(3)); + } + // Set common looseinset values for all aligned subplots and + // revert their tag values + for (size_t i = 0; i < aligned.size (); i++) + { + graphics_object go = gh_manager::get_object (aligned[i]); + axes::properties& props = + dynamic_cast (go.get_properties ()); + Matrix outpos = props.get_outerposition ().matrix_value (); + Matrix linset = props.get_looseinset ().matrix_value (); + if (l_aligned[i]) + linset(0) = (ref_box(0)-outpos(0))/outpos(2); + if (b_aligned[i]) + linset(1) = (ref_box(1)-outpos(1))/outpos(3); + if (r_aligned[i]) + linset(2) = (outpos(0)+outpos(2)-ref_box(2))/outpos(2); + if (t_aligned[i]) + linset(3) = (outpos(1)+outpos(3)-ref_box(3))/outpos(3); + props.set_looseinset (linset); + props.set_autopos_tag ("subplot"); + } + parent_obj.set ("units", fig_units); + } + } + else + sync_positions (ref_linset); +} + +void +axes::properties::sync_positions (const Matrix& linset) +{ + Matrix pos = position.get ().matrix_value (); + Matrix outpos = outerposition.get ().matrix_value (); + double lratio = linset(0); + double bratio = linset(1); + double wratio = 1-linset(0)-linset(2); + double hratio = 1-linset(1)-linset(3); + if (activepositionproperty.is ("outerposition")) + { + pos = outpos; + pos(0) = outpos(0)+lratio*outpos(2); + pos(1) = outpos(1)+bratio*outpos(3); + pos(2) = wratio*outpos(2); + pos(3) = hratio*outpos(3); + + position = pos; + update_transform (); + Matrix tightpos = calc_tightbox (pos); + + double thrshldx = 0.005*outpos(2); + double thrshldy = 0.005*outpos(3); + double minsizex = 0.2*outpos(2); + double minsizey = 0.2*outpos(3); + bool updatex = true, updatey = true; + for (int i = 0; i < 10; i++) + { + double dt; + bool modified = false; + dt = outpos(0)+outpos(2)-tightpos(0)-tightpos(2); + if (dt < -thrshldx && updatex) + { + pos(2) += dt; + modified = true; + } + dt = outpos(1)+outpos(3)-tightpos(1)-tightpos(3); + if (dt < -thrshldy && updatey) + { + pos(3) += dt; + modified = true; + } + dt = outpos(0)-tightpos(0); + if (dt > thrshldx && updatex) + { + pos(0) += dt; + pos(2) -= dt; + modified = true; + } + dt = outpos(1)-tightpos(1); + if (dt > thrshldy && updatey) + { + pos(1) += dt; + pos(3) -= dt; + modified = true; + } + + // Note: checking limit for minimum axes size + if (pos(2) < minsizex) + { + pos(0) -= 0.5*(minsizex-pos(2)); + pos(2) = minsizex; + updatex = false; + } + if (pos(3) < minsizey) + { + pos(1) -= 0.5*(minsizey-pos(3)); + pos(3) = minsizey; + updatey = false; + } + + if (modified) + { + position = pos; + update_transform (); + tightpos = calc_tightbox (pos); + } + else + break; + } + } + else + { + update_transform (); + + outpos(0) = pos(0)-pos(2)*lratio/wratio; + outpos(1) = pos(1)-pos(3)*bratio/hratio; + outpos(2) = pos(2)/wratio; + outpos(3) = pos(3)/hratio; + + outerposition = calc_tightbox (outpos); + } + + Matrix inset (1, 4, 1.0); + inset(0) = pos(0)-outpos(0); + inset(1) = pos(1)-outpos(1); + inset(2) = outpos(0)+outpos(2)-pos(0)-pos(2); + inset(3) = outpos(1)+outpos(3)-pos(1)-pos(3); + + tightinset = inset; +} + +void +axes::properties::set_text_child (handle_property& hp, + const std::string& who, + const octave_value& v) +{ + graphics_handle val; + + if (v.is_string ()) + { + val = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + xset (val, "string", v); + } + else + { + graphics_object go = gh_manager::get_object (gh_manager::lookup (v)); + + if (go.isa ("text")) + val = ::reparent (v, "set", who, __myhandle__, false); + else + { + std::string cname = v.class_name (); + + error ("set: expecting text graphics object or character string for %s property, found %s", + who.c_str (), cname.c_str ()); + } + } + + if (! error_state) + { + xset (val, "handlevisibility", "off"); + + gh_manager::free (hp.handle_value ()); + + base_properties::remove_child (hp.handle_value ()); + + hp = val; + + adopt (hp.handle_value ()); + } +} + +void +axes::properties::set_xlabel (const octave_value& v) +{ + set_text_child (xlabel, "xlabel", v); + xset (xlabel.handle_value (), "positionmode", "auto"); + xset (xlabel.handle_value (), "rotationmode", "auto"); + xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (xlabel.handle_value (), "clipping", "off"); + xset (xlabel.handle_value (), "color", get_xcolor ()); + xset (xlabel.handle_value (), "autopos_tag", "xlabel"); + update_xlabel_position (); +} + +void +axes::properties::set_ylabel (const octave_value& v) +{ + set_text_child (ylabel, "ylabel", v); + xset (ylabel.handle_value (), "positionmode", "auto"); + xset (ylabel.handle_value (), "rotationmode", "auto"); + xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); + xset (ylabel.handle_value (), "clipping", "off"); + xset (ylabel.handle_value (), "color", get_ycolor ()); + xset (ylabel.handle_value (), "autopos_tag", "ylabel"); + update_ylabel_position (); +} + +void +axes::properties::set_zlabel (const octave_value& v) +{ + set_text_child (zlabel, "zlabel", v); + xset (zlabel.handle_value (), "positionmode", "auto"); + xset (zlabel.handle_value (), "rotationmode", "auto"); + xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (zlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (zlabel.handle_value (), "clipping", "off"); + xset (zlabel.handle_value (), "color", get_zcolor ()); + xset (zlabel.handle_value (), "autopos_tag", "zlabel"); + update_zlabel_position (); +} + +void +axes::properties::set_title (const octave_value& v) +{ + set_text_child (title, "title", v); + xset (title.handle_value (), "positionmode", "auto"); + xset (title.handle_value (), "horizontalalignment", "center"); + xset (title.handle_value (), "horizontalalignmentmode", "auto"); + xset (title.handle_value (), "verticalalignment", "bottom"); + xset (title.handle_value (), "verticalalignmentmode", "auto"); + xset (title.handle_value (), "clipping", "off"); + xset (title.handle_value (), "autopos_tag", "title"); + update_title_position (); +} + +void +axes::properties::set_defaults (base_graphics_object& obj, + const std::string& mode) +{ + box = "on"; + colororder = default_colororder (); + dataaspectratio = Matrix (1, 3, 1.0); + dataaspectratiomode = "auto"; + layer = "bottom"; + + Matrix tlim (1, 2, 0.0); + tlim(1) = 1; + xlim = tlim; + ylim = tlim; + zlim = tlim; + + Matrix cl (1, 2, 0); + cl(1) = 1; + clim = cl; + + xlimmode = "auto"; + ylimmode = "auto"; + zlimmode = "auto"; + climmode = "auto"; + + xgrid = "off"; + ygrid = "off"; + zgrid = "off"; + xminorgrid = "off"; + yminorgrid = "off"; + zminorgrid = "off"; + xtick = Matrix (); + ytick = Matrix (); + ztick = Matrix (); + xtickmode = "auto"; + ytickmode = "auto"; + ztickmode = "auto"; + xticklabel = ""; + yticklabel = ""; + zticklabel = ""; + xticklabelmode = "auto"; + yticklabelmode = "auto"; + zticklabelmode = "auto"; + color = color_values ("white"); + xcolor = color_values ("black"); + ycolor = color_values ("black"); + zcolor = color_values ("black"); + xscale = "linear"; + yscale = "linear"; + zscale = "linear"; + xdir = "normal"; + ydir = "normal"; + zdir = "normal"; + yaxislocation = "left"; + xaxislocation = "bottom"; + + // Note: camera properties will be set through update_transform + camerapositionmode = "auto"; + cameratargetmode = "auto"; + cameraupvectormode = "auto"; + cameraviewanglemode = "auto"; + plotboxaspectratio = Matrix (1, 3, 1.0); + drawmode = "normal"; + gridlinestyle = ":"; + linestyleorder = "-"; + linewidth = 0.5; + minorgridlinestyle = ":"; + // Note: plotboxaspectratio will be set through update_aspectratiors + plotboxaspectratiomode = "auto"; + projection = "orthographic"; + tickdir = "in"; + tickdirmode = "auto"; + ticklength = default_axes_ticklength (); + tightinset = Matrix (1, 4, 0.0); + + sx = "linear"; + sy = "linear"; + sz = "linear"; + + Matrix tview (1, 2, 0.0); + tview(1) = 90; + view = tview; + + visible = "on"; + nextplot = "replace"; + + if (mode != "replace") + { + fontangle = "normal"; + fontname = OCTAVE_DEFAULT_FONTNAME; + fontsize = 10; + fontunits = "points"; + fontweight = "normal"; + + Matrix touterposition (1, 4, 0.0); + touterposition(2) = 1; + touterposition(3) = 1; + outerposition = touterposition; + + position = default_axes_position (); + + Matrix tlooseinset = default_axes_position (); + tlooseinset(2) = 1-tlooseinset(0)-tlooseinset(2); + tlooseinset(3) = 1-tlooseinset(1)-tlooseinset(3); + looseinset = tlooseinset; + + activepositionproperty = "outerposition"; + } + + delete_children (true); + + xlabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + ylabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + zlabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + title = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + xset (xlabel.handle_value (), "handlevisibility", "off"); + xset (ylabel.handle_value (), "handlevisibility", "off"); + xset (zlabel.handle_value (), "handlevisibility", "off"); + xset (title.handle_value (), "handlevisibility", "off"); + + xset (xlabel.handle_value (), "horizontalalignment", "center"); + xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (ylabel.handle_value (), "horizontalalignment", "center"); + xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (zlabel.handle_value (), "horizontalalignment", "right"); + xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (title.handle_value (), "horizontalalignment", "center"); + xset (title.handle_value (), "horizontalalignmentmode", "auto"); + + xset (xlabel.handle_value (), "verticalalignment", "cap"); + xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (ylabel.handle_value (), "verticalalignment", "bottom"); + xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); + xset (title.handle_value (), "verticalalignment", "bottom"); + xset (title.handle_value (), "verticalalignmentmode", "auto"); + + xset (ylabel.handle_value (), "rotation", 90.0); + xset (ylabel.handle_value (), "rotationmode", "auto"); + + xset (zlabel.handle_value (), "visible", "off"); + + xset (xlabel.handle_value (), "clipping", "off"); + xset (ylabel.handle_value (), "clipping", "off"); + xset (zlabel.handle_value (), "clipping", "off"); + xset (title.handle_value (), "clipping", "off"); + + xset (xlabel.handle_value (), "autopos_tag", "xlabel"); + xset (ylabel.handle_value (), "autopos_tag", "ylabel"); + xset (zlabel.handle_value (), "autopos_tag", "zlabel"); + xset (title.handle_value (), "autopos_tag", "title"); + + adopt (xlabel.handle_value ()); + adopt (ylabel.handle_value ()); + adopt (zlabel.handle_value ()); + adopt (title.handle_value ()); + + update_transform (); + + override_defaults (obj); +} + +void +axes::properties::delete_text_child (handle_property& hp) +{ + graphics_handle h = hp.handle_value (); + + if (h.ok ()) + { + graphics_object go = gh_manager::get_object (h); + + if (go.valid_object ()) + gh_manager::free (h); + + base_properties::remove_child (h); + } + + // FIXME -- is it necessary to check whether the axes object is + // being deleted now? I think this function is only called when an + // individual child object is delete and not when the parent axes + // object is deleted. + + if (! is_beingdeleted ()) + { + hp = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + xset (hp.handle_value (), "handlevisibility", "off"); + + adopt (hp.handle_value ()); + } +} + +void +axes::properties::remove_child (const graphics_handle& h) +{ + if (xlabel.handle_value ().ok () && h == xlabel.handle_value ()) + delete_text_child (xlabel); + else if (ylabel.handle_value ().ok () && h == ylabel.handle_value ()) + delete_text_child (ylabel); + else if (zlabel.handle_value ().ok () && h == zlabel.handle_value ()) + delete_text_child (zlabel); + else if (title.handle_value ().ok () && h == title.handle_value ()) + delete_text_child (title); + else + base_properties::remove_child (h); +} + +inline Matrix +xform_matrix (void) +{ + Matrix m (4, 4, 0.0); + for (int i = 0; i < 4; i++) + m(i,i) = 1; + return m; +} + +inline ColumnVector +xform_vector (void) +{ + ColumnVector v (4, 0.0); + v(3) = 1; + return v; +} + +inline ColumnVector +xform_vector (double x, double y, double z) +{ + ColumnVector v (4, 1.0); + v(0) = x; v(1) = y; v(2) = z; + return v; +} + +inline ColumnVector +transform (const Matrix& m, double x, double y, double z) +{ + return (m * xform_vector (x, y, z)); +} + +inline Matrix +xform_scale (double x, double y, double z) +{ + Matrix m (4, 4, 0.0); + m(0,0) = x; m(1,1) = y; m(2,2) = z; m(3,3) = 1; + return m; +} + +inline Matrix +xform_translate (double x, double y, double z) +{ + Matrix m = xform_matrix (); + m(0,3) = x; m(1,3) = y; m(2,3) = z; m(3,3) = 1; + return m; +} + +inline void +scale (Matrix& m, double x, double y, double z) +{ + m = m * xform_scale (x, y, z); +} + +inline void +translate (Matrix& m, double x, double y, double z) +{ + m = m * xform_translate (x, y, z); +} + +inline void +xform (ColumnVector& v, const Matrix& m) +{ + v = m*v; +} + +inline void +scale (ColumnVector& v, double x, double y, double z) +{ + v(0) *= x; + v(1) *= y; + v(2) *= z; +} + +inline void +translate (ColumnVector& v, double x, double y, double z) +{ + v(0) += x; + v(1) += y; + v(2) += z; +} + +inline void +normalize (ColumnVector& v) +{ + double fact = 1.0 / sqrt (v(0)*v(0)+v(1)*v(1)+v(2)*v(2)); + scale (v, fact, fact, fact); +} + +inline double +dot (const ColumnVector& v1, const ColumnVector& v2) +{ + return (v1(0)*v2(0)+v1(1)*v2(1)+v1(2)*v2(2)); +} + +inline double +norm (const ColumnVector& v) +{ + return sqrt (dot (v, v)); +} + +inline ColumnVector +cross (const ColumnVector& v1, const ColumnVector& v2) +{ + ColumnVector r = xform_vector (); + r(0) = v1(1)*v2(2)-v1(2)*v2(1); + r(1) = v1(2)*v2(0)-v1(0)*v2(2); + r(2) = v1(0)*v2(1)-v1(1)*v2(0); + return r; +} + +inline Matrix +unit_cube (void) +{ + static double data[32] = { + 0,0,0,1, + 1,0,0,1, + 0,1,0,1, + 0,0,1,1, + 1,1,0,1, + 1,0,1,1, + 0,1,1,1, + 1,1,1,1}; + Matrix m (4, 8); + memcpy (m.fortran_vec (), data, sizeof (double)*32); + return m; +} + +inline ColumnVector +cam2xform (const Array& m) +{ + ColumnVector retval (4, 1.0); + memcpy (retval.fortran_vec (), m.fortran_vec (), sizeof (double)*3); + return retval; +} + +inline RowVector +xform2cam (const ColumnVector& v) +{ + return v.extract_n (0, 3).transpose (); +} + +void +axes::properties::update_camera (void) +{ + double xd = (xdir_is ("normal") ? 1 : -1); + double yd = (ydir_is ("normal") ? 1 : -1); + double zd = (zdir_is ("normal") ? 1 : -1); + + Matrix xlimits = sx.scale (get_xlim ().matrix_value ()); + Matrix ylimits = sy.scale (get_ylim ().matrix_value ()); + Matrix zlimits = sz.scale (get_zlim ().matrix_value ()); + + double xo = xlimits(xd > 0 ? 0 : 1); + double yo = ylimits(yd > 0 ? 0 : 1); + double zo = zlimits(zd > 0 ? 0 : 1); + + Matrix pb = get_plotboxaspectratio ().matrix_value (); + + bool autocam = (camerapositionmode_is ("auto") + && cameratargetmode_is ("auto") + && cameraupvectormode_is ("auto") + && cameraviewanglemode_is ("auto")); + bool dowarp = (autocam && dataaspectratiomode_is ("auto") + && plotboxaspectratiomode_is ("auto")); + + ColumnVector c_eye (xform_vector ()); + ColumnVector c_center (xform_vector ()); + ColumnVector c_upv (xform_vector ()); + + if (cameratargetmode_is ("auto")) + { + c_center(0) = (xlimits(0)+xlimits(1))/2; + c_center(1) = (ylimits(0)+ylimits(1))/2; + c_center(2) = (zlimits(0)+zlimits(1))/2; + + cameratarget = xform2cam (c_center); + } + else + c_center = cam2xform (get_cameratarget ().matrix_value ()); + + if (camerapositionmode_is ("auto")) + { + Matrix tview = get_view ().matrix_value (); + double az = tview(0), el = tview(1); + double d = 5 * sqrt (pb(0)*pb(0)+pb(1)*pb(1)+pb(2)*pb(2)); + + if (el == 90 || el == -90) + c_eye(2) = d*signum (el); + else + { + az *= M_PI/180.0; + el *= M_PI/180.0; + c_eye(0) = d * cos (el) * sin (az); + c_eye(1) = -d* cos (el) * cos (az); + c_eye(2) = d * sin (el); + } + c_eye(0) = c_eye(0)*(xlimits(1)-xlimits(0))/(xd*pb(0))+c_center(0); + c_eye(1) = c_eye(1)*(ylimits(1)-ylimits(0))/(yd*pb(1))+c_center(1); + c_eye(2) = c_eye(2)*(zlimits(1)-zlimits(0))/(zd*pb(2))+c_center(2); + + cameraposition = xform2cam (c_eye); + } + else + c_eye = cam2xform (get_cameraposition ().matrix_value ()); + + if (cameraupvectormode_is ("auto")) + { + Matrix tview = get_view ().matrix_value (); + double az = tview(0), el = tview(1); + + if (el == 90 || el == -90) + { + c_upv(0) = + -signum (el) *sin (az*M_PI/180.0)*(xlimits(1)-xlimits(0))/pb(0); + c_upv(1) = + signum (el) * cos (az*M_PI/180.0)*(ylimits(1)-ylimits(0))/pb(1); + } + else + c_upv(2) = 1; + + cameraupvector = xform2cam (c_upv); + } + else + c_upv = cam2xform (get_cameraupvector ().matrix_value ()); + + Matrix x_view = xform_matrix (); + Matrix x_projection = xform_matrix (); + Matrix x_viewport = xform_matrix (); + Matrix x_normrender = xform_matrix (); + Matrix x_pre = xform_matrix (); + + x_render = xform_matrix (); + x_render_inv = xform_matrix (); + + scale (x_pre, pb(0), pb(1), pb(2)); + translate (x_pre, -0.5, -0.5, -0.5); + scale (x_pre, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), + zd/(zlimits(1)-zlimits(0))); + translate (x_pre, -xo, -yo, -zo); + + xform (c_eye, x_pre); + xform (c_center, x_pre); + scale (c_upv, pb(0)/(xlimits(1)-xlimits(0)), pb(1)/(ylimits(1)-ylimits(0)), + pb(2)/(zlimits(1)-zlimits(0))); + translate (c_center, -c_eye(0), -c_eye(1), -c_eye(2)); + + ColumnVector F (c_center), f (F), UP (c_upv); + normalize (f); + normalize (UP); + + if (std::abs (dot (f, UP)) > 1e-15) + { + double fa = 1 / sqrt(1-f(2)*f(2)); + scale (UP, fa, fa, fa); + } + + ColumnVector s = cross (f, UP); + ColumnVector u = cross (s, f); + + scale (x_view, 1, 1, -1); + Matrix l = xform_matrix (); + l(0,0) = s(0); l(0,1) = s(1); l(0,2) = s(2); + l(1,0) = u(0); l(1,1) = u(1); l(1,2) = u(2); + l(2,0) = -f(0); l(2,1) = -f(1); l(2,2) = -f(2); + x_view = x_view * l; + translate (x_view, -c_eye(0), -c_eye(1), -c_eye(2)); + scale (x_view, pb(0), pb(1), pb(2)); + translate (x_view, -0.5, -0.5, -0.5); + + Matrix x_cube = x_view * unit_cube (); + ColumnVector cmin = x_cube.row_min (), cmax = x_cube.row_max (); + double xM = cmax(0)-cmin(0); + double yM = cmax(1)-cmin(1); + + Matrix bb = get_boundingbox (true); + + double v_angle; + + if (cameraviewanglemode_is ("auto")) + { + double af; + + // FIXME -- was this really needed? When compared to Matlab, it + // does not seem to be required. Need investigation with concrete + // graphics toolkit to see results visually. + if (false && dowarp) + af = 1.0 / (xM > yM ? xM : yM); + else + { + if ((bb(2)/bb(3)) > (xM/yM)) + af = 1.0 / yM; + else + af = 1.0 / xM; + } + v_angle = 2 * (180.0 / M_PI) * atan (1 / (2 * af * norm (F))); + + cameraviewangle = v_angle; + } + else + v_angle = get_cameraviewangle (); + + double pf = 1 / (2 * tan ((v_angle / 2) * M_PI / 180.0) * norm (F)); + scale (x_projection, pf, pf, 1); + + if (dowarp) + { + xM *= pf; + yM *= pf; + translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); + scale (x_viewport, bb(2)/xM, -bb(3)/yM, 1); + } + else + { + double pix = 1; + if (autocam) + { + if ((bb(2)/bb(3)) > (xM/yM)) + pix = bb(3); + else + pix = bb(2); + } + else + pix = (bb(2) < bb(3) ? bb(2) : bb(3)); + translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); + scale (x_viewport, pix, -pix, 1); + } + + x_normrender = x_viewport * x_projection * x_view; + + x_cube = x_normrender * unit_cube (); + cmin = x_cube.row_min (); + cmax = x_cube.row_max (); + x_zlim.resize (1, 2); + x_zlim(0) = cmin(2); + x_zlim(1) = cmax(2); + + x_render = x_normrender; + scale (x_render, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), + zd/(zlimits(1)-zlimits(0))); + translate (x_render, -xo, -yo, -zo); + + x_viewtransform = x_view; + x_projectiontransform = x_projection; + x_viewporttransform = x_viewport; + x_normrendertransform = x_normrender; + x_rendertransform = x_render; + + x_render_inv = x_render.inverse (); + + // Note: these matrices are a slight modified version of the regular + // matrices, more suited for OpenGL rendering (x_gl_mat1 => light + // => x_gl_mat2) + x_gl_mat1 = x_view; + scale (x_gl_mat1, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), + zd/(zlimits(1)-zlimits(0))); + translate (x_gl_mat1, -xo, -yo, -zo); + x_gl_mat2 = x_viewport * x_projection; +} + +static bool updating_axes_layout = false; + +void +axes::properties::update_axes_layout (void) +{ + if (updating_axes_layout) + return; + + graphics_xform xform = get_transform (); + + double xd = (xdir_is ("normal") ? 1 : -1); + double yd = (ydir_is ("normal") ? 1 : -1); + double zd = (zdir_is ("normal") ? 1 : -1); + + const Matrix xlims = xform.xscale (get_xlim ().matrix_value ()); + const Matrix ylims = xform.yscale (get_ylim ().matrix_value ()); + const Matrix zlims = xform.zscale (get_zlim ().matrix_value ()); + double x_min = xlims(0), x_max = xlims(1); + double y_min = ylims(0), y_max = ylims(1); + double z_min = zlims(0), z_max = zlims(1); + + ColumnVector p1, p2, dir (3); + + xstate = ystate = zstate = AXE_ANY_DIR; + + p1 = xform.transform (x_min, (y_min+y_max)/2, (z_min+z_max)/2, false); + p2 = xform.transform (x_max, (y_min+y_max)/2, (z_min+z_max)/2, false); + dir(0) = xround (p2(0)-p1(0)); + dir(1) = xround (p2(1)-p1(1)); + dir(2) = (p2(2)-p1(2)); + if (dir(0) == 0 && dir(1) == 0) + xstate = AXE_DEPTH_DIR; + else if (dir(2) == 0) + { + if (dir(0) == 0) + xstate = AXE_VERT_DIR; + else if (dir(1) == 0) + xstate = AXE_HORZ_DIR; + } + + if (dir(2) == 0) + { + if (dir(1) == 0) + xPlane = (dir(0) > 0 ? x_max : x_min); + else + xPlane = (dir(1) < 0 ? x_max : x_min); + } + else + xPlane = (dir(2) < 0 ? x_min : x_max); + + xPlaneN = (xPlane == x_min ? x_max : x_min); + fx = (x_max-x_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); + + p1 = xform.transform ((x_min+x_max)/2, y_min, (z_min+z_max)/2, false); + p2 = xform.transform ((x_min+x_max)/2, y_max, (z_min+z_max)/2, false); + dir(0) = xround (p2(0)-p1(0)); + dir(1) = xround (p2(1)-p1(1)); + dir(2) = (p2(2)-p1(2)); + if (dir(0) == 0 && dir(1) == 0) + ystate = AXE_DEPTH_DIR; + else if (dir(2) == 0) + { + if (dir(0) == 0) + ystate = AXE_VERT_DIR; + else if (dir(1) == 0) + ystate = AXE_HORZ_DIR; + } + + if (dir(2) == 0) + { + if (dir(1) == 0) + yPlane = (dir(0) > 0 ? y_max : y_min); + else + yPlane = (dir(1) < 0 ? y_max : y_min); + } + else + yPlane = (dir(2) < 0 ? y_min : y_max); + + yPlaneN = (yPlane == y_min ? y_max : y_min); + fy = (y_max-y_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); + + p1 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_min, false); + p2 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_max, false); + dir(0) = xround (p2(0)-p1(0)); + dir(1) = xround (p2(1)-p1(1)); + dir(2) = (p2(2)-p1(2)); + if (dir(0) == 0 && dir(1) == 0) + zstate = AXE_DEPTH_DIR; + else if (dir(2) == 0) + { + if (dir(0) == 0) + zstate = AXE_VERT_DIR; + else if (dir(1) == 0) + zstate = AXE_HORZ_DIR; + } + + if (dir(2) == 0) + { + if (dir(1) == 0) + zPlane = (dir(0) > 0 ? z_min : z_max); + else + zPlane = (dir(1) < 0 ? z_min : z_max); + } + else + zPlane = (dir(2) < 0 ? z_min : z_max); + + zPlaneN = (zPlane == z_min ? z_max : z_min); + fz = (z_max-z_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); + + unwind_protect frame; + frame.protect_var (updating_axes_layout); + updating_axes_layout = true; + + xySym = (xd*yd*(xPlane-xPlaneN)*(yPlane-yPlaneN) > 0); + zSign = (zd*(zPlane-zPlaneN) <= 0); + xyzSym = zSign ? xySym : !xySym; + xpTick = (zSign ? xPlaneN : xPlane); + ypTick = (zSign ? yPlaneN : yPlane); + zpTick = (zSign ? zPlane : zPlaneN); + xpTickN = (zSign ? xPlane : xPlaneN); + ypTickN = (zSign ? yPlane : yPlaneN); + zpTickN = (zSign ? zPlaneN : zPlane); + + /* 2D mode */ + x2Dtop = false; + y2Dright = false; + layer2Dtop = false; + if (xstate == AXE_HORZ_DIR && ystate == AXE_VERT_DIR) + { + if (xaxislocation_is ("top")) + { + double tmp = yPlane; + yPlane = yPlaneN; + yPlaneN = tmp; + x2Dtop = true; + } + ypTick = yPlaneN; + ypTickN = yPlane; + if (yaxislocation_is ("right")) + { + double tmp = xPlane; + xPlane = xPlaneN; + xPlaneN = tmp; + y2Dright = true; + } + xpTick = xPlaneN; + xpTickN = xPlane; + if (layer_is ("top")) + { + zpTick = zPlaneN; + layer2Dtop = true; + } + else + zpTick = zPlane; + } + + Matrix viewmat = get_view ().matrix_value (); + nearhoriz = std::abs (viewmat(1)) <= 5; + + update_ticklength (); +} + +void +axes::properties::update_ticklength (void) +{ + bool mode2d = (((xstate > AXE_DEPTH_DIR ? 1 : 0) + + (ystate > AXE_DEPTH_DIR ? 1 : 0) + + (zstate > AXE_DEPTH_DIR ? 1 : 0)) == 2); + + if (tickdirmode_is ("auto")) + tickdir.set (mode2d ? "in" : "out", true); + + double ticksign = (tickdir_is ("in") ? -1 : 1); + + Matrix bbox = get_boundingbox (true); + Matrix ticklen = get_ticklength ().matrix_value (); + ticklen(0) = ticklen(0) * std::max (bbox(2), bbox(3)); + ticklen(1) = ticklen(1) * std::max (bbox(2), bbox(3)); + + xticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); + yticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); + zticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); + + xtickoffset = (mode2d ? std::max (0., xticklen) : std::abs (xticklen)) + 5; + ytickoffset = (mode2d ? std::max (0., yticklen) : std::abs (yticklen)) + 5; + ztickoffset = (mode2d ? std::max (0., zticklen) : std::abs (zticklen)) + 5; + + update_xlabel_position (); + update_ylabel_position (); + update_zlabel_position (); + update_title_position (); +} + +/* +## FIXME: A demo can't be called in a C++ file. This should be made a test +## or moved to a .m file where it can be called. +%!demo +%! clf; +%! subplot (2,1,1); +%! plot (rand (3)); +%! xlabel xlabel; +%! ylabel ylabel; +%! title title; +%! subplot (2,1,2); +%! plot (rand (3)); +%! set (gca, "ticklength", get (gca, "ticklength") * 2, "tickdir", "out"); +%! xlabel xlabel; +%! ylabel ylabel; +%! title title; +*/ + +static bool updating_xlabel_position = false; + +void +axes::properties::update_xlabel_position (void) +{ + if (updating_xlabel_position) + return; + + text::properties& xlabel_props = reinterpret_cast + (gh_manager::get_object (get_xlabel ()).get_properties ()); + + bool is_empty = xlabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_xlabel_position); + updating_xlabel_position = true; + + if (! is_empty) + { + if (xlabel_props.horizontalalignmentmode_is ("auto")) + { + xlabel_props.set_horizontalalignment + (xstate > AXE_DEPTH_DIR + ? "center" : (xyzSym ? "left" : "right")); + + xlabel_props.set_horizontalalignmentmode ("auto"); + } + + if (xlabel_props.verticalalignmentmode_is ("auto")) + { + xlabel_props.set_verticalalignment + (xstate == AXE_VERT_DIR || x2Dtop ? "bottom" : "top"); + + xlabel_props.set_verticalalignmentmode ("auto"); + } + } + + if (xlabel_props.positionmode_is ("auto") + || xlabel_props.rotationmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_xtick ().matrix_value (), + get_xticklabel ().all_strings (), + get_xlim ().matrix_value ()); + + double wmax = ext(0), hmax = ext(1), angle = 0; + ColumnVector p = + graphics_xform::xform_vector ((xpTickN+xpTick)/2, ypTick, zpTick); + + bool tick_along_z = nearhoriz || xisinf (fy); + if (tick_along_z) + p(2) += (signum (zpTick-zpTickN)*fz*xtickoffset); + else + p(1) += (signum (ypTick-ypTickN)*fy*xtickoffset); + + p = xform.transform (p(0), p(1), p(2), false); + + switch (xstate) + { + case AXE_ANY_DIR: + p(0) += (xyzSym ? wmax : -wmax); + p(1) += hmax; + break; + + case AXE_VERT_DIR: + p(0) -= wmax; + angle = 90; + break; + + case AXE_HORZ_DIR: + p(1) += (x2Dtop ? -hmax : hmax); + break; + } + + if (xlabel_props.positionmode_is ("auto")) + { + p = xform.untransform (p(0), p(1), p(2), true); + xlabel_props.set_position (p.extract_n (0, 3).transpose ()); + xlabel_props.set_positionmode ("auto"); + } + + if (! is_empty && xlabel_props.rotationmode_is ("auto")) + { + xlabel_props.set_rotation (angle); + xlabel_props.set_rotationmode ("auto"); + } + } +} + +static bool updating_ylabel_position = false; + +void +axes::properties::update_ylabel_position (void) +{ + if (updating_ylabel_position) + return; + + text::properties& ylabel_props = reinterpret_cast + (gh_manager::get_object (get_ylabel ()).get_properties ()); + + bool is_empty = ylabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_ylabel_position); + updating_ylabel_position = true; + + if (! is_empty) + { + if (ylabel_props.horizontalalignmentmode_is ("auto")) + { + ylabel_props.set_horizontalalignment + (ystate > AXE_DEPTH_DIR + ? "center" : (!xyzSym ? "left" : "right")); + + ylabel_props.set_horizontalalignmentmode ("auto"); + } + + if (ylabel_props.verticalalignmentmode_is ("auto")) + { + ylabel_props.set_verticalalignment + (ystate == AXE_VERT_DIR && !y2Dright ? "bottom" : "top"); + + ylabel_props.set_verticalalignmentmode ("auto"); + } + } + + if (ylabel_props.positionmode_is ("auto") + || ylabel_props.rotationmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_ytick ().matrix_value (), + get_yticklabel ().all_strings (), + get_ylim ().matrix_value ()); + + double wmax = ext(0), hmax = ext(1), angle = 0; + ColumnVector p = + graphics_xform::xform_vector (xpTick, (ypTickN+ypTick)/2, zpTick); + + bool tick_along_z = nearhoriz || xisinf (fx); + if (tick_along_z) + p(2) += (signum (zpTick-zpTickN)*fz*ytickoffset); + else + p(0) += (signum (xpTick-xpTickN)*fx*ytickoffset); + + p = xform.transform (p(0), p(1), p(2), false); + + switch (ystate) + { + case AXE_ANY_DIR: + p(0) += (!xyzSym ? wmax : -wmax); + p(1) += hmax; + break; + + case AXE_VERT_DIR: + p(0) += (y2Dright ? wmax : -wmax); + angle = 90; + break; + + case AXE_HORZ_DIR: + p(1) += hmax; + break; + } + + if (ylabel_props.positionmode_is ("auto")) + { + p = xform.untransform (p(0), p(1), p(2), true); + ylabel_props.set_position (p.extract_n (0, 3).transpose ()); + ylabel_props.set_positionmode ("auto"); + } + + if (! is_empty && ylabel_props.rotationmode_is ("auto")) + { + ylabel_props.set_rotation (angle); + ylabel_props.set_rotationmode ("auto"); + } + } +} + +static bool updating_zlabel_position = false; + +void +axes::properties::update_zlabel_position (void) +{ + if (updating_zlabel_position) + return; + + text::properties& zlabel_props = reinterpret_cast + (gh_manager::get_object (get_zlabel ()).get_properties ()); + + bool camAuto = cameraupvectormode_is ("auto"); + bool is_empty = zlabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_zlabel_position); + updating_zlabel_position = true; + + if (! is_empty) + { + if (zlabel_props.horizontalalignmentmode_is ("auto")) + { + zlabel_props.set_horizontalalignment + ((zstate > AXE_DEPTH_DIR || camAuto) ? "center" : "right"); + + zlabel_props.set_horizontalalignmentmode ("auto"); + } + + if (zlabel_props.verticalalignmentmode_is ("auto")) + { + zlabel_props.set_verticalalignment + (zstate == AXE_VERT_DIR + ? "bottom" : ((zSign || camAuto) ? "bottom" : "top")); + + zlabel_props.set_verticalalignmentmode ("auto"); + } + } + + if (zlabel_props.positionmode_is ("auto") + || zlabel_props.rotationmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_ztick ().matrix_value (), + get_zticklabel ().all_strings (), + get_zlim ().matrix_value ()); + + double wmax = ext(0), hmax = ext(1), angle = 0; + ColumnVector p; + + if (xySym) + { + p = graphics_xform::xform_vector (xPlaneN, yPlane, + (zpTickN+zpTick)/2); + if (xisinf (fy)) + p(0) += (signum (xPlaneN-xPlane)*fx*ztickoffset); + else + p(1) += (signum (yPlane-yPlaneN)*fy*ztickoffset); + } + else + { + p = graphics_xform::xform_vector (xPlane, yPlaneN, + (zpTickN+zpTick)/2); + if (xisinf (fx)) + p(1) += (signum (yPlaneN-yPlane)*fy*ztickoffset); + else + p(0) += (signum (xPlane-xPlaneN)*fx*ztickoffset); + } + + p = xform.transform (p(0), p(1), p(2), false); + + switch (zstate) + { + case AXE_ANY_DIR: + if (camAuto) + { + p(0) -= wmax; + angle = 90; + } + + // FIXME -- what's the correct offset? + // + // p[0] += (!xySym ? wmax : -wmax); + // p[1] += (zSign ? hmax : -hmax); + + break; + + case AXE_VERT_DIR: + p(0) -= wmax; + angle = 90; + break; + + case AXE_HORZ_DIR: + p(1) += hmax; + break; + } + + if (zlabel_props.positionmode_is ("auto")) + { + p = xform.untransform (p(0), p(1), p(2), true); + zlabel_props.set_position (p.extract_n (0, 3).transpose ()); + zlabel_props.set_positionmode ("auto"); + } + + if (! is_empty && zlabel_props.rotationmode_is ("auto")) + { + zlabel_props.set_rotation (angle); + zlabel_props.set_rotationmode ("auto"); + } + } +} + +static bool updating_title_position = false; + +void +axes::properties::update_title_position (void) +{ + if (updating_title_position) + return; + + text::properties& title_props = reinterpret_cast + (gh_manager::get_object (get_title ()).get_properties ()); + + unwind_protect frame; + frame.protect_var (updating_title_position); + updating_title_position = true; + + if (title_props.positionmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + // FIXME: bbox should be stored in axes::properties + Matrix bbox = get_extent (false); + + ColumnVector p = + graphics_xform::xform_vector (bbox(0)+bbox(2)/2, + bbox(1)-10, + (x_zlim(0)+x_zlim(1))/2); + + if (x2Dtop) + { + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_xtick ().matrix_value (), + get_xticklabel ().all_strings (), + get_xlim ().matrix_value ()); + p(1) -= ext(1); + } + + p = xform.untransform (p(0), p(1), p(2), true); + + title_props.set_position (p.extract_n (0, 3).transpose ()); + title_props.set_positionmode ("auto"); + } +} + +void +axes::properties::update_autopos (const std::string& elem_type) +{ + if (elem_type == "xlabel") + update_xlabel_position (); + else if (elem_type == "ylabel") + update_ylabel_position (); + else if (elem_type == "zlabel") + update_zlabel_position (); + else if (elem_type == "title") + update_title_position (); + else if (elem_type == "sync") + sync_positions (); +} + +static void +normalized_aspectratios (Matrix& aspectratios, const Matrix& scalefactors, + double xlength, double ylength, double zlength) +{ + double xval = xlength/scalefactors(0); + double yval = ylength/scalefactors(1); + double zval = zlength/scalefactors(2); + + double minval = xmin (xmin (xval, yval), zval); + + aspectratios(0) = xval/minval; + aspectratios(1) = yval/minval; + aspectratios(2) = zval/minval; +} + +static void +max_axes_scale (double& s, Matrix& limits, const Matrix& kids, + double pbfactor, double dafactor, char limit_type, bool tight) +{ + if (tight) + { + double minval = octave_Inf; + double maxval = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + get_children_limits (minval, maxval, min_pos, max_neg, kids, limit_type); + if (!xisinf (minval) && !xisnan (minval) + && !xisinf (maxval) && !xisnan (maxval)) + { + limits(0) = minval; + limits(1) = maxval; + s = xmax(s, (maxval - minval) / (pbfactor * dafactor)); + } + } + else + s = xmax(s, (limits(1) - limits(0)) / (pbfactor * dafactor)); +} + +static bool updating_aspectratios = false; + +void +axes::properties::update_aspectratios (void) +{ + if (updating_aspectratios) + return; + + Matrix xlimits = get_xlim ().matrix_value (); + Matrix ylimits = get_ylim ().matrix_value (); + Matrix zlimits = get_zlim ().matrix_value (); + + double dx = (xlimits(1)-xlimits(0)); + double dy = (ylimits(1)-ylimits(0)); + double dz = (zlimits(1)-zlimits(0)); + + Matrix da = get_dataaspectratio ().matrix_value (); + Matrix pba = get_plotboxaspectratio ().matrix_value (); + + if (dataaspectratiomode_is ("auto")) + { + if (plotboxaspectratiomode_is ("auto")) + { + pba = Matrix (1, 3, 1.0); + plotboxaspectratio.set (pba, false); + } + + normalized_aspectratios (da, pba, dx, dy, dz); + dataaspectratio.set (da, false); + } + else if (plotboxaspectratiomode_is ("auto")) + { + normalized_aspectratios (pba, da, dx, dy, dz); + plotboxaspectratio.set (pba, false); + } + else + { + double s = -octave_Inf; + bool modified_limits = false; + Matrix kids; + + if (xlimmode_is ("auto") && ylimmode_is ("auto") && zlimmode_is ("auto")) + { + modified_limits = true; + kids = get_children (); + max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', true); + max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', true); + max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', true); + } + else if (xlimmode_is ("auto") && ylimmode_is ("auto")) + { + modified_limits = true; + max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', false); + } + else if (ylimmode_is ("auto") && zlimmode_is ("auto")) + { + modified_limits = true; + max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', false); + } + else if (zlimmode_is ("auto") && xlimmode_is ("auto")) + { + modified_limits = true; + max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', false); + } + + if (modified_limits) + { + + unwind_protect frame; + frame.protect_var (updating_aspectratios); + + updating_aspectratios = true; + + dx = pba(0) *da(0); + dy = pba(1) *da(1); + dz = pba(2) *da(2); + if (xisinf (s)) + s = 1 / xmin (xmin (dx, dy), dz); + + if (xlimmode_is ("auto")) + { + dx = s * dx; + xlimits(0) = 0.5 * (xlimits(0) + xlimits(1) - dx); + xlimits(1) = xlimits(0) + dx; + set_xlim (xlimits); + set_xlimmode ("auto"); + } + + if (ylimmode_is ("auto")) + { + dy = s * dy; + ylimits(0) = 0.5 * (ylimits(0) + ylimits(1) - dy); + ylimits(1) = ylimits(0) + dy; + set_ylim (ylimits); + set_ylimmode ("auto"); + } + + if (zlimmode_is ("auto")) + { + dz = s * dz; + zlimits(0) = 0.5 * (zlimits(0) + zlimits(1) - dz); + zlimits(1) = zlimits(0) + dz; + set_zlim (zlimits); + set_zlimmode ("auto"); + } + } + else + { + normalized_aspectratios (pba, da, dx, dy, dz); + plotboxaspectratio.set (pba, false); + } + } +} + +void +axes::properties::update_font (void) +{ +#ifdef HAVE_FREETYPE +#ifdef HAVE_FONTCONFIG + text_renderer.set_font (get ("fontname").string_value (), + get ("fontweight").string_value (), + get ("fontangle").string_value (), + get ("fontsize").double_value ()); +#endif +#endif +} + +// The INTERNAL flag defines whether position or outerposition is used. + +Matrix +axes::properties::get_boundingbox (bool internal, + const Matrix& parent_pix_size) const +{ + Matrix pos = (internal ? + get_position ().matrix_value () + : get_outerposition ().matrix_value ()); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + return pos; +} + +Matrix +axes::properties::get_extent (bool with_text, bool only_text_height) const +{ + graphics_xform xform = get_transform (); + + Matrix ext (1, 4, 0.0); + ext(0) = octave_Inf; + ext(1) = octave_Inf; + ext(2) = -octave_Inf; + ext(3) = -octave_Inf; + for (int i = 0; i <= 1; i++) + for (int j = 0; j <= 1; j++) + for (int k = 0; k <= 1; k++) + { + ColumnVector p = xform.transform (i ? xPlaneN : xPlane, + j ? yPlaneN : yPlane, + k ? zPlaneN : zPlane, false); + ext(0) = std::min (ext(0), p(0)); + ext(1) = std::min (ext(1), p(1)); + ext(2) = std::max (ext(2), p(0)); + ext(3) = std::max (ext(3), p(1)); + } + + if (with_text) + { + for (int i = 0; i < 4; i++) + { + graphics_handle text_handle; + if (i == 0) + text_handle = get_title (); + else if (i == 1) + text_handle = get_xlabel (); + else if (i == 2) + text_handle = get_ylabel (); + else if (i == 3) + text_handle = get_zlabel (); + + text::properties& text_props = reinterpret_cast + (gh_manager::get_object (text_handle).get_properties ()); + + Matrix text_pos = text_props.get_data_position (); + text_pos = xform.transform (text_pos(0), text_pos(1), text_pos(2)); + if (text_props.get_string ().is_empty ()) + { + ext(0) = std::min (ext(0), text_pos(0)); + ext(1) = std::min (ext(1), text_pos(1)); + ext(2) = std::max (ext(2), text_pos(0)); + ext(3) = std::max (ext(3), text_pos(1)); + } + else + { + Matrix text_ext = text_props.get_extent_matrix (); + + bool ignore_horizontal = false; + bool ignore_vertical = false; + if (only_text_height) + { + double text_rotation = text_props.get_rotation (); + if (text_rotation == 0. || text_rotation == 180.) + ignore_horizontal = true; + else if (text_rotation == 90. || text_rotation == 270.) + ignore_vertical = true; + } + + if (! ignore_horizontal) + { + ext(0) = std::min (ext(0), text_pos(0)+text_ext(0)); + ext(2) = std::max (ext(2), text_pos(0)+text_ext(0)+text_ext(2)); + } + + if (! ignore_vertical) + { + ext(1) = std::min (ext(1), text_pos(1)-text_ext(1)-text_ext(3)); + ext(3) = std::max (ext(3), text_pos(1)-text_ext(1)); + } + } + } + } + + ext(2) = ext(2)-ext(0); + ext(3) = ext(3)-ext(1); + + return ext; +} + +void +axes::properties::set_units (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_units = get_units (); + if (units.set (v, true)) + { + update_units (old_units); + mark_modified (); + } + } +} + +void +axes::properties::update_units (const caseless_str& old_units) +{ + graphics_object obj = gh_manager::get_object (get_parent ()); + Matrix parent_bb = obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + caseless_str new_units = get_units (); + position.set (octave_value (convert_position (get_position ().matrix_value (), old_units, new_units, parent_bb)), false); + outerposition.set (octave_value (convert_position (get_outerposition ().matrix_value (), old_units, new_units, parent_bb)), false); + tightinset.set (octave_value (convert_position (get_tightinset ().matrix_value (), old_units, new_units, parent_bb)), false); +} + +void +axes::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +axes::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (true).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + set_fontsize (octave_value (fsz)); +} + +double +axes::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (true).elem (3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +ColumnVector +graphics_xform::xform_vector (double x, double y, double z) +{ + return ::xform_vector (x, y, z); +} + +Matrix +graphics_xform::xform_eye (void) +{ + return ::xform_matrix (); +} + +ColumnVector +graphics_xform::transform (double x, double y, double z, + bool use_scale) const +{ + if (use_scale) + { + x = sx.scale (x); + y = sy.scale (y); + z = sz.scale (z); + } + + return ::transform (xform, x, y, z); +} + +ColumnVector +graphics_xform::untransform (double x, double y, double z, + bool use_scale) const +{ + ColumnVector v = ::transform (xform_inv, x, y, z); + + if (use_scale) + { + v(0) = sx.unscale (v(0)); + v(1) = sy.unscale (v(1)); + v(2) = sz.unscale (v(2)); + } + + return v; +} + +octave_value +axes::get_default (const caseless_str& name) const +{ + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + retval = parent_obj.get_default (name); + } + + return retval; +} + +// FIXME -- remove. +// FIXME -- maybe this should go into array_property class? +/* +static void +check_limit_vals (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const array_property& data) +{ + double val = data.min_val (); + if (! (xisinf (val) || xisnan (val)) && val < min_val) + min_val = val; + val = data.max_val (); + if (! (xisinf (val) || xisnan (val)) && val > max_val) + max_val = val; + val = data.min_pos (); + if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) + min_pos = val; + val = data.max_neg (); + if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) + max_neg = val; +} +*/ + +static void +check_limit_vals (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const octave_value& data) +{ + if (data.is_matrix_type ()) + { + Matrix m = data.matrix_value (); + + if (! error_state && m.numel () == 4) + { + double val; + + val = m(0); + if (! (xisinf (val) || xisnan (val)) && val < min_val) + min_val = val; + + val = m(1); + if (! (xisinf (val) || xisnan (val)) && val > max_val) + max_val = val; + + val = m(2); + if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) + min_pos = val; + + val = m(3); + if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) + max_neg = val; + } + } +} + +// magform(x) Returns (a, b), where x = a * 10^b, abs (a) >= 1., and b is +// integer. + +static void +magform (double x, double& a, int& b) +{ + if (x == 0) + { + a = 0; + b = 0; + } + else + { + b = static_cast (gnulib::floor (std::log10 (std::abs (x)))); + a = x / std::pow (10.0, b); + } +} + +// A translation from Tom Holoryd's python code at +// http://kurage.nimh.nih.gov/tomh/tics.py +// FIXME -- add log ticks + +double +axes::properties::calc_tick_sep (double lo, double hi) +{ + int ticint = 5; + + // Reference: Lewart, C. R., "Algorithms SCALE1, SCALE2, and + // SCALE3 for Determination of Scales on Computer Generated + // Plots", Communications of the ACM, 10 (1973), 639-640. + // Also cited as ACM Algorithm 463. + + double a; + int b, x; + + magform ((hi-lo)/ticint, a, b); + + static const double sqrt_2 = sqrt (2.0); + static const double sqrt_10 = sqrt (10.0); + static const double sqrt_50 = sqrt (50.0); + + if (a < sqrt_2) + x = 1; + else if (a < sqrt_10) + x = 2; + else if (a < sqrt_50) + x = 5; + else + x = 10; + + return x * std::pow (10., b); + +} + +// Attempt to make "nice" limits from the actual max and min of the +// data. For log plots, we will also use the smallest strictly positive +// value. + +Matrix +axes::properties::get_axis_limits (double xmin, double xmax, + double min_pos, double max_neg, + bool logscale) +{ + Matrix retval; + + double min_val = xmin; + double max_val = xmax; + + if (xisinf (min_val) && min_val > 0 && xisinf (max_val) && max_val < 0) + { + retval = default_lim (logscale); + return retval; + } + else if (! (xisinf (min_val) || xisinf (max_val))) + { + if (logscale) + { + if (xisinf (min_pos) && xisinf (max_neg)) + { + // TODO -- max_neg is needed for "loglog ([0 -Inf])" + // This is the only place where max_neg is needed. + // Is there another way? + retval = default_lim (); + retval(0) = pow (10., retval(0)); + retval(1) = pow (10., retval(1)); + return retval; + } + if ((min_val <= 0 && max_val > 0)) + { + warning ("axis: omitting non-positive data in log plot"); + min_val = min_pos; + } + // FIXME -- maybe this test should also be relative? + if (std::abs (min_val - max_val) < sqrt (DBL_EPSILON)) + { + // Widen range when too small + if (min_val >= 0) + { + min_val *= 0.9; + max_val *= 1.1; + } + else + { + min_val *= 1.1; + max_val *= 0.9; + } + } + if (min_val > 0) + { + // Log plots with all positive data + min_val = pow (10, gnulib::floor (log10 (min_val))); + max_val = pow (10, std::ceil (log10 (max_val))); + } + else + { + // Log plots with all negative data + min_val = -pow (10, std::ceil (log10 (-min_val))); + max_val = -pow (10, gnulib::floor (log10 (-max_val))); + } + } + else + { + if (min_val == 0 && max_val == 0) + { + min_val = -1; + max_val = 1; + } + // FIXME -- maybe this test should also be relative? + else if (std::abs (min_val - max_val) < sqrt (DBL_EPSILON)) + { + min_val -= 0.1 * std::abs (min_val); + max_val += 0.1 * std::abs (max_val); + } + + double tick_sep = calc_tick_sep (min_val , max_val); + double min_tick = gnulib::floor (min_val / tick_sep); + double max_tick = std::ceil (max_val / tick_sep); + // Prevent round-off from cropping ticks + min_val = std::min (min_val, tick_sep * min_tick); + max_val = std::max (max_val, tick_sep * max_tick); + } + } + + retval.resize (1, 2); + + retval(1) = max_val; + retval(0) = min_val; + + return retval; +} + +void +axes::properties::calc_ticks_and_lims (array_property& lims, + array_property& ticks, + array_property& mticks, + bool limmode_is_auto, bool is_logscale) +{ + // FIXME -- add log ticks and lims + + if (lims.get ().is_empty ()) + return; + + double lo = (lims.get ().matrix_value ()) (0); + double hi = (lims.get ().matrix_value ()) (1); + bool is_negative = lo < 0 && hi < 0; + double tmp; + // FIXME should this be checked for somewhere else? (i.e. set{x,y,z}lim) + if (hi < lo) + { + tmp = hi; + hi = lo; + lo = tmp; + } + + if (is_logscale) + { + if (is_negative) + { + tmp = hi; + hi = std::log10 (-lo); + lo = std::log10 (-tmp); + } + else + { + hi = std::log10 (hi); + lo = std::log10 (lo); + } + } + + double tick_sep = calc_tick_sep (lo , hi); + + if (is_logscale && ! (xisinf (hi) || xisinf (lo))) + { + // FIXME - what if (hi-lo) < tick_sep? + // ex: loglog ([1 1.1]) + tick_sep = std::max (tick_sep, 1.); + tick_sep = std::ceil (tick_sep); + } + + int i1 = static_cast (gnulib::floor (lo / tick_sep)); + int i2 = static_cast (std::ceil (hi / tick_sep)); + + if (limmode_is_auto) + { + // adjust limits to include min and max tics + Matrix tmp_lims (1,2); + tmp_lims(0) = std::min (tick_sep * i1, lo); + tmp_lims(1) = std::max (tick_sep * i2, hi); + + if (is_logscale) + { + tmp_lims(0) = std::pow (10.,tmp_lims(0)); + tmp_lims(1) = std::pow (10.,tmp_lims(1)); + if (tmp_lims(0) <= 0) + tmp_lims(0) = std::pow (10., lo); + if (is_negative) + { + tmp = tmp_lims(0); + tmp_lims(0) = -tmp_lims(1); + tmp_lims(1) = -tmp; + } + } + lims = tmp_lims; + } + + Matrix tmp_ticks (1, i2-i1+1); + for (int i = 0; i <= i2-i1; i++) + { + tmp_ticks (i) = tick_sep * (i+i1); + if (is_logscale) + tmp_ticks (i) = std::pow (10., tmp_ticks (i)); + } + if (is_logscale && is_negative) + { + Matrix rev_ticks (1, i2-i1+1); + rev_ticks = -tmp_ticks; + for (int i = 0; i <= i2-i1; i++) + tmp_ticks (i) = rev_ticks (i2-i1-i); + } + + ticks = tmp_ticks; + + int n = is_logscale ? 8 : 4; + Matrix tmp_mticks (1, n * (tmp_ticks.numel () - 1)); + + for (int i = 0; i < tmp_ticks.numel ()-1; i++) + { + double d = (tmp_ticks (i+1) - tmp_ticks (i)) / (n+1); + for (int j = 0; j < n; j++) + { + tmp_mticks (n*i+j) = tmp_ticks (i) + d * (j+1); + } + } + mticks = tmp_mticks; +} + +void +axes::properties::calc_ticklabels (const array_property& ticks, + any_property& labels, bool logscale) +{ + Matrix values = ticks.get ().matrix_value (); + Cell c (values.dims ()); + std::ostringstream os; + + if (logscale) + { + double significand; + double exponent; + double exp_max = 0.; + double exp_min = 0.; + + for (int i = 0; i < values.numel (); i++) + { + exp_max = std::max (exp_max, std::log10 (values(i))); + exp_min = std::max (exp_min, std::log10 (values(i))); + } + + for (int i = 0; i < values.numel (); i++) + { + if (values(i) < 0.) + exponent = gnulib::floor (std::log10 (-values(i))); + else + exponent = gnulib::floor (std::log10 (values(i))); + significand = values(i) * std::pow (10., -exponent); + os.str (std::string ()); + os << significand; + if (exponent < 0.) + { + os << "e-"; + exponent = -exponent; + } + else + os << "e+"; + if (exponent < 10. && (exp_max > 9 || exp_min < -9)) + os << "0"; + os << exponent; + c(i) = os.str (); + } + } + else + { + for (int i = 0; i < values.numel (); i++) + { + os.str (std::string ()); + os << values(i); + c(i) = os.str (); + } + } + + labels = c; +} + +Matrix +axes::properties::get_ticklabel_extents (const Matrix& ticks, + const string_vector& ticklabels, + const Matrix& limits) +{ +#ifndef HAVE_FREETYPE + double fontsize = get ("fontsize").double_value (); +#endif + + Matrix ext (1, 2, 0.0); + double wmax = 0., hmax = 0.; + int n = std::min (ticklabels.numel (), ticks.numel ()); + for (int i = 0; i < n; i++) + { + double val = ticks(i); + if (limits(0) <= val && val <= limits(1)) + { +#ifdef HAVE_FREETYPE + ext = text_renderer.get_extent (ticklabels(i)); + wmax = std::max (wmax, ext(0)); + hmax = std::max (hmax, ext(1)); +#else + //FIXME: find a better approximation + int len = ticklabels(i).length (); + wmax = std::max (wmax, 0.5*fontsize*len); + hmax = fontsize; +#endif + } + } + + ext(0) = wmax; + ext(1) = hmax; + return ext; +} + +void +get_children_limits (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const Matrix& kids, char limit_type) +{ + octave_idx_type n = kids.numel (); + + switch (limit_type) + { + case 'x': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_xliminclude ()) + { + octave_value lim = obj.get_xlim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'y': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_yliminclude ()) + { + octave_value lim = obj.get_ylim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'z': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_zliminclude ()) + { + octave_value lim = obj.get_zlim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'c': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_climinclude ()) + { + octave_value lim = obj.get_clim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'a': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_aliminclude ()) + { + octave_value lim = obj.get_alim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + default: + break; + } +} + +static bool updating_axis_limits = false; + +void +axes::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) +{ + if (updating_axis_limits) + return; + + Matrix kids = Matrix (1, 1, h.value ()); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + char update_type = 0; + + Matrix limits; + double val; + +#define FIX_LIMITS \ + if (limits.numel () == 4) \ + { \ + val = limits(0); \ + if (! (xisinf (val) || xisnan (val))) \ + min_val = val; \ + val = limits(1); \ + if (! (xisinf (val) || xisnan (val))) \ + max_val = val; \ + val = limits(2); \ + if (! (xisinf (val) || xisnan (val))) \ + min_pos = val; \ + val = limits(3); \ + if (! (xisinf (val) || xisnan (val))) \ + max_neg = val; \ + } \ + else \ + { \ + limits.resize (4, 1); \ + limits(0) = min_val; \ + limits(1) = max_val; \ + limits(2) = min_pos; \ + limits(3) = max_neg; \ + } + + if (axis_type == "xdata" || axis_type == "xscale" + || axis_type == "xlimmode" || axis_type == "xliminclude" + || axis_type == "xlim") + { + if (xproperties.xlimmode_is ("auto")) + { + limits = xproperties.get_xlim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.xscale_is ("log")); + + update_type = 'x'; + } + } + else if (axis_type == "ydata" || axis_type == "yscale" + || axis_type == "ylimmode" || axis_type == "yliminclude" + || axis_type == "ylim") + { + if (xproperties.ylimmode_is ("auto")) + { + limits = xproperties.get_ylim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.yscale_is ("log")); + + update_type = 'y'; + } + } + else if (axis_type == "zdata" || axis_type == "zscale" + || axis_type == "zlimmode" || axis_type == "zliminclude" + || axis_type == "zlim") + { + if (xproperties.zlimmode_is ("auto")) + { + limits = xproperties.get_zlim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.zscale_is ("log")); + + update_type = 'z'; + } + } + else if (axis_type == "cdata" || axis_type == "climmode" + || axis_type == "cdatamapping" || axis_type == "climinclude" + || axis_type == "clim") + { + if (xproperties.climmode_is ("auto")) + { + limits = xproperties.get_clim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + { + max_val = min_val + 1; + min_val -= 1; + } + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'c'; + } + + } + else if (axis_type == "alphadata" || axis_type == "alimmode" + || axis_type == "alphadatamapping" || axis_type == "aliminclude" + || axis_type == "alim") + { + if (xproperties.alimmode_is ("auto")) + { + limits = xproperties.get_alim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + max_val = min_val + 1; + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'a'; + } + + } + +#undef FIX_LIMITS + + unwind_protect frame; + frame.protect_var (updating_axis_limits); + + updating_axis_limits = true; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + xproperties.set_xlimmode ("auto"); + xproperties.update_xlim (); + break; + + case 'y': + xproperties.set_ylim (limits); + xproperties.set_ylimmode ("auto"); + xproperties.update_ylim (); + break; + + case 'z': + xproperties.set_zlim (limits); + xproperties.set_zlimmode ("auto"); + xproperties.update_zlim (); + break; + + case 'c': + xproperties.set_clim (limits); + xproperties.set_climmode ("auto"); + break; + + case 'a': + xproperties.set_alim (limits); + xproperties.set_alimmode ("auto"); + break; + + default: + break; + } + + xproperties.update_transform (); + +} + +void +axes::update_axis_limits (const std::string& axis_type) +{ + if (updating_axis_limits || updating_aspectratios) + return; + + Matrix kids = xproperties.get_children (); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + char update_type = 0; + + Matrix limits; + + if (axis_type == "xdata" || axis_type == "xscale" + || axis_type == "xlimmode" || axis_type == "xliminclude" + || axis_type == "xlim") + { + if (xproperties.xlimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.xscale_is ("log")); + + update_type = 'x'; + } + } + else if (axis_type == "ydata" || axis_type == "yscale" + || axis_type == "ylimmode" || axis_type == "yliminclude" + || axis_type == "ylim") + { + if (xproperties.ylimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.yscale_is ("log")); + + update_type = 'y'; + } + } + else if (axis_type == "zdata" || axis_type == "zscale" + || axis_type == "zlimmode" || axis_type == "zliminclude" + || axis_type == "zlim") + { + if (xproperties.zlimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.zscale_is ("log")); + + update_type = 'z'; + } + } + else if (axis_type == "cdata" || axis_type == "climmode" + || axis_type == "cdatamapping" || axis_type == "climinclude" + || axis_type == "clim") + { + if (xproperties.climmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + { + max_val = min_val + 1; + min_val -= 1; + } + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'c'; + } + + } + else if (axis_type == "alphadata" || axis_type == "alimmode" + || axis_type == "alphadatamapping" || axis_type == "aliminclude" + || axis_type == "alim") + { + if (xproperties.alimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + max_val = min_val + 1; + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'a'; + } + + } + + unwind_protect frame; + frame.protect_var (updating_axis_limits); + + updating_axis_limits = true; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + xproperties.set_xlimmode ("auto"); + xproperties.update_xlim (); + break; + + case 'y': + xproperties.set_ylim (limits); + xproperties.set_ylimmode ("auto"); + xproperties.update_ylim (); + break; + + case 'z': + xproperties.set_zlim (limits); + xproperties.set_zlimmode ("auto"); + xproperties.update_zlim (); + break; + + case 'c': + xproperties.set_clim (limits); + xproperties.set_climmode ("auto"); + break; + + case 'a': + xproperties.set_alim (limits); + xproperties.set_alimmode ("auto"); + break; + + default: + break; + } + + xproperties.update_transform (); +} + +inline +double force_in_range (const double x, const double lower, const double upper) +{ + if (x < lower) + { return lower; } + else if (x > upper) + { return upper; } + else + { return x; } +} + +static Matrix +do_zoom (double val, double factor, const Matrix& lims, bool is_logscale) +{ + Matrix new_lims = lims; + + double lo = lims(0); + double hi = lims(1); + + bool is_negative = lo < 0 && hi < 0; + + if (is_logscale) + { + if (is_negative) + { + double tmp = hi; + hi = std::log10 (-lo); + lo = std::log10 (-tmp); + val = std::log10 (-val); + } + else + { + hi = std::log10 (hi); + lo = std::log10 (lo); + val = std::log10 (val); + } + } + + // Perform the zooming + lo = val + factor * (lo - val); + hi = val + factor * (hi - val); + + if (is_logscale) + { + if (is_negative) + { + double tmp = -std::pow (10.0, hi); + hi = -std::pow (10.0, lo); + lo = tmp; + } + else + { + lo = std::pow (10.0, lo); + hi = std::pow (10.0, hi); + } + } + + new_lims(0) = lo; + new_lims(1) = hi; + + return new_lims; +} + +void +axes::properties::zoom_about_point (double x, double y, double factor, + bool push_to_zoom_stack) +{ + // FIXME: Do we need error checking here? + Matrix xlims = get_xlim ().matrix_value (); + Matrix ylims = get_ylim ().matrix_value (); + + // Get children axes limits + Matrix kids = get_children (); + double minx = octave_Inf; + double maxx = -octave_Inf; + double min_pos_x = octave_Inf; + double max_neg_x = -octave_Inf; + get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); + + double miny = octave_Inf; + double maxy = -octave_Inf; + double min_pos_y = octave_Inf; + double max_neg_y = -octave_Inf; + get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); + + xlims = do_zoom (x, factor, xlims, xscale_is ("log")); + ylims = do_zoom (y, factor, ylims, yscale_is ("log")); + + zoom (xlims, ylims, push_to_zoom_stack); +} + +void +axes::properties::zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack) +{ + if (push_to_zoom_stack) + { + zoom_stack.push_front (xlimmode.get ()); + zoom_stack.push_front (xlim.get ()); + zoom_stack.push_front (ylimmode.get ()); + zoom_stack.push_front (ylim.get ()); + } + + xlim = xl; + xlimmode = "manual"; + ylim = yl; + ylimmode = "manual"; + + update_transform (); + update_xlim (false); + update_ylim (false); +} + +static Matrix +do_translate (double x0, double x1, const Matrix& lims, bool is_logscale) +{ + Matrix new_lims = lims; + + double lo = lims(0); + double hi = lims(1); + + bool is_negative = lo < 0 && hi < 0; + + double delta; + + if (is_logscale) + { + if (is_negative) + { + double tmp = hi; + hi = std::log10 (-lo); + lo = std::log10 (-tmp); + x0 = -x0; + x1 = -x1; + } + else + { + hi = std::log10 (hi); + lo = std::log10 (lo); + } + + delta = std::log10 (x0) - std::log10 (x1); + } + else + { + delta = x0 - x1; + } + + // Perform the translation + lo += delta; + hi += delta; + + if (is_logscale) + { + if (is_negative) + { + double tmp = -std::pow (10.0, hi); + hi = -std::pow (10.0, lo); + lo = tmp; + } + else + { + lo = std::pow (10.0, lo); + hi = std::pow (10.0, hi); + } + } + + new_lims(0) = lo; + new_lims(1) = hi; + + return new_lims; +} + +void +axes::properties::translate_view (double x0, double x1, double y0, double y1) +{ + // FIXME: Do we need error checking here? + Matrix xlims = get_xlim ().matrix_value (); + Matrix ylims = get_ylim ().matrix_value (); + + // Get children axes limits + Matrix kids = get_children (); + double minx = octave_Inf; + double maxx = -octave_Inf; + double min_pos_x = octave_Inf; + double max_neg_x = -octave_Inf; + get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); + + double miny = octave_Inf; + double maxy = -octave_Inf; + double min_pos_y = octave_Inf; + double max_neg_y = -octave_Inf; + get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); + + xlims = do_translate (x0, x1, xlims, xscale_is ("log")); + ylims = do_translate (y0, y1, ylims, yscale_is ("log")); + + zoom (xlims, ylims, false); +} + +void +axes::properties::rotate_view (double delta_el, double delta_az) +{ + Matrix v = get_view ().matrix_value (); + + v(1) += delta_el; + + if (v(1) > 90) + v(1) = 90; + if (v(1) < -90) + v(1) = -90; + + v(0) = fmod (v(0) - delta_az + 720,360); + + set_view (v); + update_transform (); +} + +void +axes::properties::unzoom (void) +{ + if (zoom_stack.size () >= 4) + { + ylim = zoom_stack.front (); + zoom_stack.pop_front (); + ylimmode = zoom_stack.front (); + zoom_stack.pop_front (); + xlim = zoom_stack.front (); + zoom_stack.pop_front (); + xlimmode = zoom_stack.front (); + zoom_stack.pop_front (); + + update_transform (); + update_xlim (false); + update_ylim (false); + } +} + +void +axes::properties::clear_zoom_stack (void) +{ + while (zoom_stack.size () > 4) + zoom_stack.pop_front (); + + unzoom (); +} + +void +axes::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +void +axes::initialize (const graphics_object& go) +{ + base_graphics_object::initialize (go); + + xinitialize (xproperties.get_title ()); + xinitialize (xproperties.get_xlabel ()); + xinitialize (xproperties.get_ylabel ()); + xinitialize (xproperties.get_zlabel ()); +} + +// --------------------------------------------------------------------- + +Matrix +line::properties::compute_xlim (void) const +{ + Matrix m (1, 4); + + m(0) = xdata.min_val (); + m(1) = xdata.max_val (); + m(2) = xdata.min_pos (); + m(3) = xdata.max_neg (); + + return m; +} + +Matrix +line::properties::compute_ylim (void) const +{ + Matrix m (1, 4); + + m(0) = ydata.min_val (); + m(1) = ydata.max_val (); + m(2) = ydata.min_pos (); + m(3) = ydata.max_neg (); + + return m; +} + +// --------------------------------------------------------------------- + +Matrix +text::properties::get_data_position (void) const +{ + Matrix pos = get_position ().matrix_value (); + + if (! units_is ("data")) + pos = convert_text_position (pos, *this, get_units (), "data"); + + return pos; +} + +Matrix +text::properties::get_extent_matrix (void) const +{ + // FIXME: Should this function also add the (x,y) base position? + return extent.get ().matrix_value (); +} + +octave_value +text::properties::get_extent (void) const +{ + // FIXME: This doesn't work right for 3D plots. + // (It doesn't in Matlab either, at least not in version 6.5.) + Matrix m = extent.get ().matrix_value (); + Matrix pos = get_position ().matrix_value (); + Matrix p = convert_text_position (pos, *this, get_units (), "pixels"); + + m(0) += p(0); + m(1) += p(1); + + return convert_text_position (m, *this, "pixels", get_units ()); +} + +void +text::properties::update_font (void) +{ +#ifdef HAVE_FREETYPE +#ifdef HAVE_FONTCONFIG + renderer.set_font (get ("fontname").string_value (), + get ("fontweight").string_value (), + get ("fontangle").string_value (), + get ("fontsize").double_value ()); +#endif + renderer.set_color (get_color_rgb ()); +#endif +} + +void +text::properties::update_text_extent (void) +{ +#ifdef HAVE_FREETYPE + + int halign = 0, valign = 0; + + if (horizontalalignment_is ("center")) + halign = 1; + else if (horizontalalignment_is ("right")) + halign = 2; + + if (verticalalignment_is ("top")) + valign = 2; + else if (verticalalignment_is ("baseline")) + valign = 3; + else if (verticalalignment_is ("middle")) + valign = 1; + + Matrix bbox; + + // FIXME: string should be parsed only when modified, for efficiency + + octave_value string_prop = get_string (); + + string_vector sv = string_prop.all_strings (); + + renderer.text_to_pixels (sv.join ("\n"), pixels, bbox, + halign, valign, get_rotation ()); + /* The bbox is relative to the text's position. + We'll leave it that way, because get_position () does not return + valid results when the text is first constructed. + Conversion to proper coordinates is performed in get_extent. */ + set_extent (bbox); + +#endif + + if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || + autopos_tag_is ("zlabel") || autopos_tag_is ("title")) + update_autopos ("sync"); +} + +void +text::properties::request_autopos (void) +{ + if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || + autopos_tag_is ("zlabel") || autopos_tag_is ("title")) + update_autopos (get_autopos_tag ()); +} + +void +text::properties::update_units (void) +{ + if (! units_is ("data")) + { + set_xliminclude ("off"); + set_yliminclude ("off"); + set_zliminclude ("off"); + } + + Matrix pos = get_position ().matrix_value (); + + pos = convert_text_position (pos, *this, cached_units, get_units ()); + // FIXME: if the current axes view is 2D, then one should + // probably drop the z-component of "pos" and leave "zliminclude" + // to "off". + set_position (pos); + + if (units_is ("data")) + { + set_xliminclude ("on"); + set_yliminclude ("on"); + // FIXME: see above + set_zliminclude ("off"); + } + + cached_units = get_units (); +} + +double +text::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + { + graphics_object go (gh_manager::get_object (get___myhandle__ ())); + graphics_object ax (go.get_ancestor ("axes")); + + parent_height = ax.get_properties ().get_boundingbox (true).elem (3); + } + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +octave_value +image::properties::get_color_data (void) const +{ + return convert_cdata (*this, get_cdata (), + cdatamapping_is ("scaled"), 3); +} + +// --------------------------------------------------------------------- + +octave_value +patch::properties::get_color_data (void) const +{ + octave_value fvc = get_facevertexcdata (); + if (fvc.is_undefined () || fvc.is_empty ()) + return Matrix (); + else + return convert_cdata (*this, fvc,cdatamapping_is ("scaled"), 2); +} + +// --------------------------------------------------------------------- + +octave_value +surface::properties::get_color_data (void) const +{ + return convert_cdata (*this, get_cdata (), cdatamapping_is ("scaled"), 3); +} + +inline void +cross_product (double x1, double y1, double z1, + double x2, double y2, double z2, + double& x, double& y, double& z) +{ + x += (y1 * z2 - z1 * y2); + y += (z1 * x2 - x1 * z2); + z += (x1 * y2 - y1 * x2); +} + +void +surface::properties::update_normals (void) +{ + if (normalmode_is ("auto")) + { + Matrix x = get_xdata ().matrix_value (); + Matrix y = get_ydata ().matrix_value (); + Matrix z = get_zdata ().matrix_value (); + + + int p = z.columns (), q = z.rows (); + int i1 = 0, i2 = 0, i3 = 0; + int j1 = 0, j2 = 0, j3 = 0; + + bool x_mat = (x.rows () == q); + bool y_mat = (y.columns () == p); + + NDArray n (dim_vector (q, p, 3), 0.0); + + for (int i = 0; i < p; i++) + { + if (y_mat) + { + i1 = i - 1; + i2 = i; + i3 = i + 1; + } + + for (int j = 0; j < q; j++) + { + if (x_mat) + { + j1 = j - 1; + j2 = j; + j3 = j + 1; + } + + double& nx = n(j, i, 0); + double& ny = n(j, i, 1); + double& nz = n(j, i, 2); + + if ((j > 0) && (i > 0)) + // upper left quadrangle + cross_product (x(j1,i-1)-x(j2,i), y(j-1,i1)-y(j,i2), z(j-1,i-1)-z(j,i), + x(j2,i-1)-x(j1,i), y(j,i1)-y(j-1,i2), z(j,i-1)-z(j-1,i), + nx, ny, nz); + + if ((j > 0) && (i < (p -1))) + // upper right quadrangle + cross_product (x(j1,i+1)-x(j2,i), y(j-1,i3)-y(j,i2), z(j-1,i+1)-z(j,i), + x(j1,i)-x(j2,i+1), y(j-1,i2)-y(j,i3), z(j-1,i)-z(j,i+1), + nx, ny, nz); + + if ((j < (q - 1)) && (i > 0)) + // lower left quadrangle + cross_product (x(j2,i-1)-x(j3,i), y(j,i1)-y(j+1,i2), z(j,i-1)-z(j+1,i), + x(j3,i-1)-x(j2,i), y(j+1,i1)-y(j,i2), z(j+1,i-1)-z(j,i), + nx, ny, nz); + + if ((j < (q - 1)) && (i < (p -1))) + // lower right quadrangle + cross_product (x(j3,i)-x(j2,i+1), y(j+1,i2)-y(j,i3), z(j+1,i)-z(j,i+1), + x(j3,i+1)-x(j2,i), y(j+1,i3)-y(j,i2), z(j+1,i+1)-z(j,i), + nx, ny, nz); + + double d = -std::max (std::max (fabs (nx), fabs (ny)), fabs (nz)); + + nx /= d; + ny /= d; + nz /= d; + } + } + vertexnormals = n; + } +} + +// --------------------------------------------------------------------- + +void +hggroup::properties::update_limits (void) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + { + obj.update_axis_limits ("xlim"); + obj.update_axis_limits ("ylim"); + obj.update_axis_limits ("zlim"); + obj.update_axis_limits ("clim"); + obj.update_axis_limits ("alim"); + } +} + +void +hggroup::properties::update_limits (const graphics_handle& h) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + { + obj.update_axis_limits ("xlim", h); + obj.update_axis_limits ("ylim", h); + obj.update_axis_limits ("zlim", h); + obj.update_axis_limits ("clim", h); + obj.update_axis_limits ("alim", h); + } +} + +static bool updating_hggroup_limits = false; + +void +hggroup::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) +{ + if (updating_hggroup_limits) + return; + + Matrix kids = Matrix (1, 1, h.value ()); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + Matrix limits; + double val; + + char update_type = 0; + + if (axis_type == "xlim" || axis_type == "xliminclude") + { + limits = xproperties.get_xlim ().matrix_value (); + update_type = 'x'; + } + else if (axis_type == "ylim" || axis_type == "yliminclude") + { + limits = xproperties.get_ylim ().matrix_value (); + update_type = 'y'; + } + else if (axis_type == "zlim" || axis_type == "zliminclude") + { + limits = xproperties.get_zlim ().matrix_value (); + update_type = 'z'; + } + else if (axis_type == "clim" || axis_type == "climinclude") + { + limits = xproperties.get_clim ().matrix_value (); + update_type = 'c'; + } + else if (axis_type == "alim" || axis_type == "aliminclude") + { + limits = xproperties.get_alim ().matrix_value (); + update_type = 'a'; + } + + if (limits.numel () == 4) + { + val = limits(0); + if (! (xisinf (val) || xisnan (val))) + min_val = val; + val = limits(1); + if (! (xisinf (val) || xisnan (val))) + max_val = val; + val = limits(2); + if (! (xisinf (val) || xisnan (val))) + min_pos = val; + val = limits(3); + if (! (xisinf (val) || xisnan (val))) + max_neg = val; + } + else + { + limits.resize (4,1); + limits(0) = min_val; + limits(1) = max_val; + limits(2) = min_pos; + limits(3) = max_neg; + } + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, update_type); + + unwind_protect frame; + frame.protect_var (updating_hggroup_limits); + + updating_hggroup_limits = true; + + if (limits(0) != min_val || limits(1) != max_val + || limits(2) != min_pos || limits(3) != max_neg) + { + limits(0) = min_val; + limits(1) = max_val; + limits(2) = min_pos; + limits(3) = max_neg; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + break; + + case 'y': + xproperties.set_ylim (limits); + break; + + case 'z': + xproperties.set_zlim (limits); + break; + + case 'c': + xproperties.set_clim (limits); + break; + + case 'a': + xproperties.set_alim (limits); + break; + + default: + break; + } + + base_graphics_object::update_axis_limits (axis_type, h); + } +} + +void +hggroup::update_axis_limits (const std::string& axis_type) +{ + if (updating_hggroup_limits) + return; + + Matrix kids = xproperties.get_children (); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + char update_type = 0; + + if (axis_type == "xlim" || axis_type == "xliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + update_type = 'x'; + } + else if (axis_type == "ylim" || axis_type == "yliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + update_type = 'y'; + } + else if (axis_type == "zlim" || axis_type == "zliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + update_type = 'z'; + } + else if (axis_type == "clim" || axis_type == "climinclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); + + update_type = 'c'; + } + else if (axis_type == "alim" || axis_type == "aliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); + + update_type = 'a'; + } + + unwind_protect frame; + frame.protect_var (updating_hggroup_limits); + + updating_hggroup_limits = true; + + Matrix limits (1, 4, 0.0); + + limits(0) = min_val; + limits(1) = max_val; + limits(2) = min_pos; + limits(3) = max_neg; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + break; + + case 'y': + xproperties.set_ylim (limits); + break; + + case 'z': + xproperties.set_zlim (limits); + break; + + case 'c': + xproperties.set_clim (limits); + break; + + case 'a': + xproperties.set_alim (limits); + break; + + default: + break; + } + + base_graphics_object::update_axis_limits (axis_type); +} + +// --------------------------------------------------------------------- + +octave_value +uicontrol::properties::get_extent (void) const +{ + Matrix m = extent.get ().matrix_value (); + + graphics_object parent_obj = + gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + return convert_position (m, "pixels", get_units (), parent_size); +} + +void +uicontrol::properties::update_text_extent (void) +{ +#ifdef HAVE_FREETYPE + + text_element *elt; + ft_render text_renderer; + Matrix box; + + // FIXME: parsed content should be cached for efficiency + // FIXME: support multiline text + + elt = text_parser_none ().parse (get_string_string ()); +#ifdef HAVE_FONTCONFIG + text_renderer.set_font (get_fontname (), + get_fontweight (), + get_fontangle (), + get_fontsize ()); +#endif + box = text_renderer.get_extent (elt, 0); + + Matrix ext (1, 4, 0.0); + + // FIXME: also handle left and bottom components + + ext(0) = ext(1) = 1; + ext(2) = box(0); + ext(3) = box(1); + + set_extent (ext); + +#endif +} + +void +uicontrol::properties::update_units (void) +{ + Matrix pos = get_position ().matrix_value (); + + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + pos = convert_position (pos, cached_units, get_units (), parent_size); + set_position (pos); + + cached_units = get_units (); +} + +void +uicontrol::properties::set_style (const octave_value& st) +{ + if (get___object__ ().is_empty ()) + style = st; + else + error ("set: cannot change the style of a uicontrol object after creation."); +} + +Matrix +uicontrol::properties::get_boundingbox (bool, + const Matrix& parent_pix_size) const +{ + Matrix pos = get_position ().matrix_value (); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + return pos; +} + +void +uicontrol::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +uicontrol::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (false).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + fontsize.set (octave_value (fsz), true); +} + +double +uicontrol::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (false).elem (3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +Matrix +uipanel::properties::get_boundingbox (bool internal, + const Matrix& parent_pix_size) const +{ + Matrix pos = get_position ().matrix_value (); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + if (internal) + { + double outer_height = pos(3); + + pos(0) = pos(1) = 0; + + if (! bordertype_is ("none")) + { + double bw = get_borderwidth (); + double mul = 1.0; + + if (bordertype_is ("etchedin") || bordertype_is ("etchedout")) + mul = 2.0; + + pos(0) += mul * bw; + pos(1) += mul * bw; + pos(2) -= 2 * mul * bw; + pos(3) -= 2 * mul * bw; + } + + if (! get_title ().empty ()) + { + double fs = get_fontsize (); + + if (! fontunits_is ("pixels")) + { + double res = xget (0, "screenpixelsperinch").double_value (); + + if (fontunits_is ("points")) + fs *= (res / 72.0); + else if (fontunits_is ("inches")) + fs *= res; + else if (fontunits_is ("centimeters")) + fs *= (res / 2.54); + else if (fontunits_is ("normalized")) + fs *= outer_height; + } + + if (titleposition_is ("lefttop") || titleposition_is ("centertop") + || titleposition_is ("righttop")) + pos(1) += (fs / 2); + pos(3) -= (fs / 2); + } + } + + return pos; +} + +void +uipanel::properties::set_units (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_units = get_units (); + if (units.set (v, true)) + { + update_units (old_units); + mark_modified (); + } + } +} + +void +uipanel::properties::update_units (const caseless_str& old_units) +{ + Matrix pos = get_position ().matrix_value (); + + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + pos = convert_position (pos, old_units, get_units (), parent_size); + set_position (pos); +} + +void +uipanel::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +uipanel::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (false).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + set_fontsize (octave_value (fsz)); +} + +double +uipanel::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (false).elem (3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +octave_value +uitoolbar::get_default (const caseless_str& name) const +{ + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + retval = parent_obj.get_default (name); + } + + return retval; +} + +void +uitoolbar::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +// --------------------------------------------------------------------- + +octave_value +base_graphics_object::get_default (const caseless_str& name) const +{ + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + return parent_obj.get_default (type () + name); +} + +octave_value +base_graphics_object::get_factory_default (const caseless_str& name) const +{ + graphics_object parent_obj = gh_manager::get_object (0); + + return parent_obj.get_factory_default (type () + name); +} + +// We use a random value for the handle to avoid issues with plots and +// scalar values for the first argument. +gh_manager::gh_manager (void) + : handle_map (), handle_free_list (), + next_handle (-1.0 - (rand () + 1.0) / (RAND_MAX + 2.0)), + figure_list (), graphics_lock (), event_queue (), + callback_objects (), event_processing (0) +{ + handle_map[0] = graphics_object (new root_figure ()); + + // Make sure the default graphics toolkit is registered. + gtk_manager::default_toolkit (); +} + +void +gh_manager::create_instance (void) +{ + instance = new gh_manager (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); +} + +graphics_handle +gh_manager::do_make_graphics_handle (const std::string& go_name, + const graphics_handle& p, + bool integer_figure_handle, + bool do_createfcn, + bool do_notify_toolkit) +{ + graphics_handle h = get_handle (integer_figure_handle); + + base_graphics_object *go = 0; + + go = make_graphics_object_from_type (go_name, h, p); + + if (go) + { + graphics_object obj (go); + + handle_map[h] = obj; + if (do_createfcn) + go->get_properties ().execute_createfcn (); + + // Notify graphics toolkit. + if (do_notify_toolkit) + obj.initialize (); + } + else + error ("gh_manager::do_make_graphics_handle: invalid object type `%s'", + go_name.c_str ()); + + return h; +} + +graphics_handle +gh_manager::do_make_figure_handle (double val, bool do_notify_toolkit) +{ + graphics_handle h = val; + + base_graphics_object* go = new figure (h, 0); + graphics_object obj (go); + + handle_map[h] = obj; + + // Notify graphics toolkit. + if (do_notify_toolkit) + obj.initialize (); + + return h; +} + +void +gh_manager::do_push_figure (const graphics_handle& h) +{ + do_pop_figure (h); + + figure_list.push_front (h); +} + +void +gh_manager::do_pop_figure (const graphics_handle& h) +{ + for (figure_list_iterator p = figure_list.begin (); + p != figure_list.end (); + p++) + { + if (*p == h) + { + figure_list.erase (p); + break; + } + } +} + +class +callback_event : public base_graphics_event +{ +public: + callback_event (const graphics_handle& h, const std::string& name, + const octave_value& data = Matrix ()) + : base_graphics_event (), handle (h), callback_name (name), + callback (), callback_data (data) { } + + callback_event (const graphics_handle& h, const octave_value& cb, + const octave_value& data = Matrix ()) + : base_graphics_event (), handle (h), callback_name (), + callback (cb), callback_data (data) { } + + void execute (void) + { + if (callback.is_defined ()) + gh_manager::execute_callback (handle, callback, callback_data); + else + gh_manager::execute_callback (handle, callback_name, callback_data); + } + +private: + callback_event (void) + : base_graphics_event (), handle (), + callback_name (), callback_data () + { } + +private: + graphics_handle handle; + std::string callback_name; + octave_value callback; + octave_value callback_data; +}; + +class +function_event : public base_graphics_event +{ +public: + function_event (graphics_event::event_fcn fcn, void* data = 0) + : base_graphics_event (), function (fcn), + function_data (data) { } + + void execute (void) + { + function (function_data); + } + +private: + + graphics_event::event_fcn function; + + void* function_data; + + // function_event objects must be created with at least a function. + function_event (void); + + // No copying! + + function_event (const function_event &); + + function_event & operator = (const function_event &); +}; + +class +set_event : public base_graphics_event +{ +public: + set_event (const graphics_handle& h, const std::string& name, + const octave_value& value, bool do_notify_toolkit = true) + : base_graphics_event (), handle (h), property_name (name), + property_value (value), notify_toolkit (do_notify_toolkit) { } + + void execute (void) + { + gh_manager::auto_lock guard; + + graphics_object go = gh_manager::get_object (handle); + + if (go) + { + property p = go.get_properties ().get_property (property_name); + + if (p.ok ()) + p.set (property_value, true, notify_toolkit); + } + } + +private: + set_event (void) + : base_graphics_event (), handle (), property_name (), property_value () + { } + +private: + graphics_handle handle; + std::string property_name; + octave_value property_value; + bool notify_toolkit; +}; + +graphics_event +graphics_event::create_callback_event (const graphics_handle& h, + const std::string& name, + const octave_value& data) +{ + graphics_event e; + + e.rep = new callback_event (h, name, data); + + return e; +} + +graphics_event +graphics_event::create_callback_event (const graphics_handle& h, + const octave_value& cb, + const octave_value& data) +{ + graphics_event e; + + e.rep = new callback_event (h, cb, data); + + return e; +} + +graphics_event +graphics_event::create_function_event (graphics_event::event_fcn fcn, + void *data) +{ + graphics_event e; + + e.rep = new function_event (fcn, data); + + return e; +} + +graphics_event +graphics_event::create_set_event (const graphics_handle& h, + const std::string& name, + const octave_value& data, + bool notify_toolkit) +{ + graphics_event e; + + e.rep = new set_event (h, name, data, notify_toolkit); + + return e; +} + +static void +xset_gcbo (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (0); + root_figure::properties& props = + dynamic_cast (go.get_properties ()); + + props.set_callbackobject (h.as_octave_value ()); +} + +void +gh_manager::do_restore_gcbo (void) +{ + gh_manager::auto_lock guard; + + callback_objects.pop_front (); + + xset_gcbo (callback_objects.empty () + ? graphics_handle () + : callback_objects.front ().get_handle ()); +} + +void +gh_manager::do_execute_listener (const graphics_handle& h, + const octave_value& l) +{ + if (octave_thread::is_octave_thread ()) + gh_manager::execute_callback (h, l, octave_value ()); + else + { + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_callback_event (h, l)); + } +} + +void +gh_manager::do_execute_callback (const graphics_handle& h, + const octave_value& cb_arg, + const octave_value& data) +{ + if (cb_arg.is_defined () && ! cb_arg.is_empty ()) + { + octave_value_list args; + octave_function *fcn = 0; + + args(0) = h.as_octave_value (); + if (data.is_defined ()) + args(1) = data; + else + args(1) = Matrix (); + + unwind_protect_safe frame; + frame.add_fcn (gh_manager::restore_gcbo); + + if (true) + { + gh_manager::auto_lock guard; + + callback_objects.push_front (get_object (h)); + xset_gcbo (h); + } + + BEGIN_INTERRUPT_WITH_EXCEPTIONS; + + // Copy CB because "function_value" method is non-const. + + octave_value cb = cb_arg; + + if (cb.is_function () || cb.is_function_handle ()) + fcn = cb.function_value (); + else if (cb.is_string ()) + { + int status; + std::string s = cb.string_value (); + + eval_string (s, false, status, 0); + } + else if (cb.is_cell () && cb.length () > 0 + && (cb.rows () == 1 || cb.columns () == 1) + && (cb.cell_value ()(0).is_function () + || cb.cell_value ()(0).is_function_handle ())) + { + Cell c = cb.cell_value (); + + fcn = c(0).function_value (); + if (! error_state) + { + for (int i = 1; i < c.length () ; i++) + args(1+i) = c(i); + } + } + else + { + std::string nm = cb.class_name (); + error ("trying to execute non-executable object (class = %s)", + nm.c_str ()); + } + + if (fcn && ! error_state) + feval (fcn, args); + + END_INTERRUPT_WITH_EXCEPTIONS; + } +} + +void +gh_manager::do_post_event (const graphics_event& e) +{ + event_queue.push_back (e); + + command_editor::add_event_hook (gh_manager::process_events); +} + +void +gh_manager::do_post_callback (const graphics_handle& h, const std::string name, + const octave_value& data) +{ + gh_manager::auto_lock guard; + + graphics_object go = get_object (h); + + if (go.valid_object ()) + { + if (callback_objects.empty ()) + do_post_event (graphics_event::create_callback_event (h, name, data)); + else + { + const graphics_object& current = callback_objects.front (); + + if (current.get_properties ().is_interruptible ()) + do_post_event (graphics_event::create_callback_event (h, name, data)); + else + { + caseless_str busy_action (go.get_properties ().get_busyaction ()); + + if (busy_action.compare ("queue")) + do_post_event (graphics_event::create_callback_event (h, name, data)); + else + { + caseless_str cname (name); + + if (cname.compare ("deletefcn") + || cname.compare ("createfcn") + || (go.isa ("figure") + && (cname.compare ("closerequestfcn") + || cname.compare ("resizefcn")))) + do_post_event (graphics_event::create_callback_event (h, name, data)); + } + } + } + } +} + +void +gh_manager::do_post_function (graphics_event::event_fcn fcn, void* fcn_data) +{ + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_function_event (fcn, fcn_data)); +} + +void +gh_manager::do_post_set (const graphics_handle& h, const std::string name, + const octave_value& value, bool notify_toolkit) +{ + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_set_event (h, name, value, + notify_toolkit)); +} + +int +gh_manager::do_process_events (bool force) +{ + graphics_event e; + bool old_Vdrawnow_requested = Vdrawnow_requested; + bool events_executed = false; + + do + { + e = graphics_event (); + + gh_manager::lock (); + + if (! event_queue.empty ()) + { + if (callback_objects.empty () || force) + { + e = event_queue.front (); + + event_queue.pop_front (); + } + else + { + const graphics_object& go = callback_objects.front (); + + if (go.get_properties ().is_interruptible ()) + { + e = event_queue.front (); + + event_queue.pop_front (); + } + } + } + + gh_manager::unlock (); + + if (e.ok ()) + { + e.execute (); + events_executed = true; + } + } + while (e.ok ()); + + gh_manager::lock (); + + if (event_queue.empty () && event_processing == 0) + command_editor::remove_event_hook (gh_manager::process_events); + + gh_manager::unlock (); + + if (events_executed) + flush_octave_stdout (); + + if (Vdrawnow_requested && ! old_Vdrawnow_requested) + { + feval ("drawnow"); + + Vdrawnow_requested = false; + } + + return 0; +} + +void +gh_manager::do_enable_event_processing (bool enable) +{ + gh_manager::auto_lock guard; + + if (enable) + { + event_processing++; + + command_editor::add_event_hook (gh_manager::process_events); + } + else + { + event_processing--; + + if (event_queue.empty () && event_processing == 0) + command_editor::remove_event_hook (gh_manager::process_events); + } +} + +property_list::plist_map_type +root_figure::init_factory_properties (void) +{ + property_list::plist_map_type plist_map; + + plist_map["figure"] = figure::properties::factory_defaults (); + plist_map["axes"] = axes::properties::factory_defaults (); + plist_map["line"] = line::properties::factory_defaults (); + plist_map["text"] = text::properties::factory_defaults (); + plist_map["image"] = image::properties::factory_defaults (); + plist_map["patch"] = patch::properties::factory_defaults (); + plist_map["surface"] = surface::properties::factory_defaults (); + plist_map["hggroup"] = hggroup::properties::factory_defaults (); + plist_map["uimenu"] = uimenu::properties::factory_defaults (); + plist_map["uicontrol"] = uicontrol::properties::factory_defaults (); + plist_map["uipanel"] = uipanel::properties::factory_defaults (); + plist_map["uicontextmenu"] = uicontextmenu::properties::factory_defaults (); + plist_map["uitoolbar"] = uitoolbar::properties::factory_defaults (); + plist_map["uipushtool"] = uipushtool::properties::factory_defaults (); + plist_map["uitoggletool"] = uitoggletool::properties::factory_defaults (); + + return plist_map; +} + +// --------------------------------------------------------------------- + +DEFUN (ishandle, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ishandle (@var{h})\n\ +Return true if @var{h} is a graphics handle and false otherwise.\n\ +@var{h} may also be a matrix of handles in which case a logical\n\ +array is returned that is true where the elements of @var{h} are\n\ +graphics handles and false where they are not.\n\ +@seealso{isfigure}\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () == 1) + retval = is_handle (args(0)); + else + print_usage (); + + return retval; +} + +static bool +is_handle_visible (const graphics_handle& h) +{ + return h.ok () && gh_manager::is_handle_visible (h); +} + +static bool +is_handle_visible (double val) +{ + return is_handle_visible (gh_manager::lookup (val)); +} + +static octave_value +is_handle_visible (const octave_value& val) +{ + octave_value retval = false; + + if (val.is_real_scalar () && is_handle_visible (val.double_value ())) + retval = true; + else if (val.is_numeric_type () && val.is_real_type ()) + { + const NDArray handles = val.array_value (); + + if (! error_state) + { + boolNDArray result (handles.dims ()); + + for (octave_idx_type i = 0; i < handles.numel (); i++) + result.xelem (i) = is_handle_visible (handles (i)); + + retval = result; + } + } + + return retval; +} + +DEFUN (__is_handle_visible__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} __is_handle_visible__ (@var{h})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = is_handle_visible (args(0)); + else + print_usage (); + + return retval; +} + +DEFUN (reset, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} reset (@var{h}, @var{property})\n\ +Remove any defaults set for the handle @var{h}. The default figure\n\ +properties of \"position\", \"units\", \"windowstyle\" and\n\ +\"paperunits\" and the default axes properties of \"position\" and \"units\"\n\ +are not reset.\n\ +@end deftypefn") +{ + int nargin = args.length (); + + if (nargin != 1) + print_usage (); + else + { + // get vector of graphics handles + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + // loop over graphics objects + for (octave_idx_type n = 0; n < hcv.length (); n++) + gh_manager::get_object (hcv(n)).reset_default_properties (); + } + } + + return octave_value (); +} + +DEFUN (set, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} set (@var{h}, @var{property}, @var{value}, @dots{})\n\ +@deftypefnx {Built-in Function} {} set (@var{h}, @var{properties}, @var{values})\n\ +@deftypefnx {Built-in Function} {} set (@var{h}, @var{pv})\n\ +Set named property values for the graphics handle (or vector of graphics\n\ +handles) @var{h}.\n\ +There are three ways how to give the property names and values:\n\ +\n\ +@itemize\n\ +@item as a comma separated list of @var{property}, @var{value} pairs\n\ +\n\ +Here, each @var{property} is a string containing the property name, each\n\ +@var{value} is a value of the appropriate type for the property.\n\ +\n\ +@item as a cell array of strings @var{properties} containing property names\n\ +and a cell array @var{values} containing property values.\n\ +\n\ +In this case, the number of columns of @var{values} must match the number of\n\ +elements in @var{properties}. The first column of @var{values} contains\n\ +values for the first entry in @var{properties}, etc. The number of rows of\n\ +@var{values} must be 1 or match the number of elements of @var{h}. In the\n\ +first case, each handle in @var{h} will be assigned the same values. In the\n\ +latter case, the first handle in @var{h} will be assigned the values from\n\ +the first row of @var{values} and so on.\n\ +\n\ +@item as a structure array @var{pv}\n\ +\n\ +Here, the field names of @var{pv} represent the property names, and the field\n\ +values give the property values. In contrast to the previous case, all\n\ +elements of @var{pv} will be set in all handles in @var{h} independent of\n\ +the dimensions of @var{pv}.\n\ +@end itemize\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + int nargin = args.length (); + + if (nargin > 0) + { + // get vector of graphics handles + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + bool request_drawnow = false; + + // loop over graphics objects + for (octave_idx_type n = 0; n < hcv.length (); n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + if (nargin == 3 && args(1).is_cellstr () + && args(2).is_cell ()) + { + if (args(2).cell_value ().rows () == 1) + { + obj.set (args(1).cellstr_value (), + args(2).cell_value (), 0); + } + else if (hcv.length () == args(2).cell_value ().rows ()) + { + obj.set (args(1).cellstr_value (), + args(2).cell_value (), n); + } + else + { + error ("set: number of graphics handles must match number of value rows (%d != %d)", + hcv.length (), args(2).cell_value ().rows ()); + break; + + } + } + else if (nargin == 2 && args(1).is_map ()) + { + obj.set (args(1).map_value ()); + } + else if (nargin == 1) + { + if (nargout != 0) + retval = obj.values_as_struct (); + else + { + std::string s = obj.values_as_string (); + if (! error_state) + octave_stdout << s; + } + } + else + { + obj.set (args.splice (0, 1)); + request_drawnow = true; + } + } + else + { + error ("set: invalid handle (= %g)", hcv(n)); + break; + } + + if (error_state) + break; + + request_drawnow = true; + } + + if (! error_state && request_drawnow) + Vdrawnow_requested = true; + } + else + error ("set: expecting graphics handle as first argument"); + } + else + print_usage (); + + return retval; +} + +static std::string +get_graphics_object_type (const double val) +{ + std::string retval; + + graphics_object obj = gh_manager::get_object (val); + + if (obj) + retval = obj.type (); + else + error ("get: invalid handle (= %g)", val); + + return retval; +} + +DEFUN (get, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} get (@var{h}, @var{p})\n\ +Return the named property @var{p} from the graphics handle @var{h}.\n\ +If @var{p} is omitted, return the complete property list for @var{h}.\n\ +If @var{h} is a vector, return a cell array including the property\n\ +values or lists respectively.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + Cell vals; + + int nargin = args.length (); + + bool use_cell_format = false; + + if (nargin == 1 || nargin == 2) + { + if (args(0).is_empty ()) + { + retval = Matrix (); + return retval; + } + + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + octave_idx_type len = hcv.length (); + + if (nargin == 1 && len > 1) + { + std::string t0 = get_graphics_object_type (hcv(0)); + + if (! error_state) + { + for (octave_idx_type n = 1; n < len; n++) + { + std::string t = get_graphics_object_type (hcv(n)); + + if (error_state) + break; + + if (t != t0) + { + error ("get: vector of handles must all have same type"); + break; + } + } + + } + } + + if (! error_state) + { + if (nargin > 1 && args(1).is_cellstr ()) + { + Array plist = args(1).cellstr_value (); + + if (! error_state) + { + octave_idx_type plen = plist.numel (); + + use_cell_format = true; + + vals.resize (dim_vector (len, plen)); + + for (octave_idx_type n = 0; ! error_state && n < len; n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + for (octave_idx_type m = 0; ! error_state && m < plen; m++) + { + caseless_str property = plist(m); + + vals(n, m) = obj.get (property); + } + } + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } + } + } + else + error ("get: expecting property name or cell array of property names as second argument"); + } + else + { + caseless_str property; + + if (nargin > 1) + { + property = args(1).string_value (); + + if (error_state) + error ("get: expecting property name or cell array of property names as second argument"); + } + + vals.resize (dim_vector (len, 1)); + + if (! error_state) + { + for (octave_idx_type n = 0; ! error_state && n < len; n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + if (nargin == 1) + vals(n) = obj.get (); + else + vals(n) = obj.get (property); + } + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } + } + } + } + } + } + else + error ("get: expecting graphics handle as first argument"); + } + else + print_usage (); + + if (! error_state) + { + if (use_cell_format) + retval = vals; + else + { + octave_idx_type len = vals.numel (); + + if (len == 0) + retval = Matrix (); + else if (len == 1) + retval = vals(0); + else if (len > 1 && nargin == 1) + { + OCTAVE_LOCAL_BUFFER (octave_scalar_map, tmp, len); + + for (octave_idx_type n = 0; n < len; n++) + tmp[n] = vals(n).scalar_map_value (); + + retval = octave_map::cat (0, len, tmp); + } + else + retval = vals; + } + } + + return retval; +} + +/* +%!assert (get (findobj (0, "Tag", "nonexistenttag"), "nonexistentproperty"), []) +*/ + +// Return all properties from the graphics handle @var{h}. +// If @var{h} is a vector, return a cell array including the +// property values or lists respectively. + +DEFUN (__get__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __get__ (@var{h})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + Cell vals; + + int nargin = args.length (); + + if (nargin == 1) + { + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + octave_idx_type len = hcv.length (); + + vals.resize (dim_vector (len, 1)); + + for (octave_idx_type n = 0; n < len; n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + vals(n) = obj.get (true); + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } + } + } + else + error ("get: expecting graphics handle as first argument"); + } + else + print_usage (); + + if (! error_state) + { + octave_idx_type len = vals.numel (); + + if (len > 1) + retval = vals; + else if (len == 1) + retval = vals(0); + } + + return retval; +} + +static octave_value +make_graphics_object (const std::string& go_name, + bool integer_figure_handle, + const octave_value_list& args) +{ + octave_value retval; + + double val = octave_NaN; + + octave_value_list xargs = args.splice (0, 1); + + caseless_str p ("parent"); + + for (int i = 0; i < xargs.length (); i++) + if (xargs(i).is_string () + && p.compare (xargs(i).string_value ())) + { + if (i < (xargs.length () - 1)) + { + val = xargs(i+1).double_value (); + + if (! error_state) + { + xargs = xargs.splice (i, 2); + break; + } + } + else + error ("__go_%s__: missing value for parent property", + go_name.c_str ()); + } + + if (! error_state && xisnan (val)) + val = args(0).double_value (); + + if (! error_state) + { + graphics_handle parent = gh_manager::lookup (val); + + if (parent.ok ()) + { + graphics_handle h + = gh_manager::make_graphics_handle (go_name, parent, + integer_figure_handle, + false, false); + + if (! error_state) + { + adopt (parent, h); + + xset (h, xargs); + xcreatefcn (h); + xinitialize (h); + + retval = h.value (); + + if (! error_state) + Vdrawnow_requested = true; + } + else + error ("__go%s__: unable to create graphics handle", + go_name.c_str ()); + } + else + error ("__go_%s__: invalid parent", go_name.c_str ()); + } + else + error ("__go_%s__: invalid parent", go_name.c_str ()); + + return retval; +} + +DEFUN (__go_figure__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_figure__ (@var{fignum})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () > 0) + { + double val = args(0).double_value (); + + if (! error_state) + { + if (is_figure (val)) + { + graphics_handle h = gh_manager::lookup (val); + + xset (h, args.splice (0, 1)); + + retval = h.value (); + } + else + { + bool int_fig_handle = true; + + octave_value_list xargs = args.splice (0, 1); + + graphics_handle h = octave_NaN; + + if (xisnan (val)) + { + caseless_str p ("integerhandle"); + + for (int i = 0; i < xargs.length (); i++) + { + if (xargs(i).is_string () + && p.compare (xargs(i).string_value ())) + { + if (i < (xargs.length () - 1)) + { + std::string pval = xargs(i+1).string_value (); + + if (! error_state) + { + caseless_str on ("on"); + int_fig_handle = on.compare (pval); + xargs = xargs.splice (i, 2); + break; + } + } + } + } + + h = gh_manager::make_graphics_handle ("figure", 0, + int_fig_handle, + false, false); + + if (! int_fig_handle) + { + // We need to intiailize the integerhandle + // property without calling the set_integerhandle + // method, because doing that will generate a new + // handle value... + + graphics_object go = gh_manager::get_object (h); + go.get_properties ().init_integerhandle ("off"); + } + } + else if (val > 0 && D_NINT (val) == val) + h = gh_manager::make_figure_handle (val, false); + + if (! error_state && h.ok ()) + { + adopt (0, h); + + gh_manager::push_figure (h); + + xset (h, xargs); + xcreatefcn (h); + xinitialize (h); + + retval = h.value (); + } + else + error ("__go_figure__: failed to create figure handle"); + } + } + else + error ("__go_figure__: expecting figure number to be double value"); + } + else + print_usage (); + + return retval; +} + +#define GO_BODY(TYPE) \ + gh_manager::auto_lock guard; \ + \ + octave_value retval; \ + \ + if (args.length () > 0) \ + retval = make_graphics_object (#TYPE, false, args); \ + else \ + print_usage (); \ + \ + return retval + +int +calc_dimensions (const graphics_object& go) +{ + + int nd = 2; + + if (go.isa ("surface")) + nd = 3; + + if ((go.isa ("line") || go.isa ("patch")) && ! go.get("zdata").is_empty ()) + nd = 3; + + Matrix kids = go.get_properties ().get_children (); + + for (octave_idx_type i = 0; i < kids.length (); i++) + { + graphics_handle hnd = gh_manager::lookup (kids(i)); + + if (hnd.ok ()) + { + const graphics_object& kid = gh_manager::get_object (hnd); + + if (kid.valid_object ()) + nd = calc_dimensions (kid); + + if (nd == 3) + break; + } + } + + return nd; +} + +DEFUN (__calc_dimensions__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __calc_dimensions__ (@var{axes})\n\ +Internal function. Determine the number of dimensions in a graphics\n\ +object, whether 2 or 3.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + double h = args(0).double_value (); + + if (! error_state) + retval = calc_dimensions (gh_manager::get_object (h)); + else + error ("__calc_dimensions__: expecting graphics handle as only argument"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__go_axes__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_axes__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (axes); +} + +DEFUN (__go_line__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_line__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (line); +} + +DEFUN (__go_text__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_text__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (text); +} + +DEFUN (__go_image__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_image__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (image); +} + +DEFUN (__go_surface__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_surface__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (surface); +} + +DEFUN (__go_patch__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_patch__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (patch); +} + +DEFUN (__go_hggroup__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_hggroup__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (hggroup); +} + +DEFUN (__go_uimenu__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uimenu__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uimenu); +} + +DEFUN (__go_uicontrol__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uicontrol__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uicontrol); +} + +DEFUN (__go_uipanel__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uipanel__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uipanel); +} + +DEFUN (__go_uicontextmenu__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uicontextmenu__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uicontextmenu); +} + +DEFUN (__go_uitoolbar__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uitoolbar__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uitoolbar); +} + +DEFUN (__go_uipushtool__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uipushtool__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uipushtool); +} + +DEFUN (__go_uitoggletool__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uitoggletool__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uitoggletool); +} + +DEFUN (__go_delete__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_delete__ (@var{h})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value_list retval; + + if (args.length () == 1) + { + graphics_handle h = octave_NaN; + + const NDArray vals = args (0).array_value (); + + if (! error_state) + { + // Check is all the handles to delete are valid first + // as callbacks might delete one of the handles we + // later want to delete + for (octave_idx_type i = 0; i < vals.numel (); i++) + { + h = gh_manager::lookup (vals.elem (i)); + + if (! h.ok ()) + { + error ("delete: invalid graphics object (= %g)", + vals.elem (i)); + break; + } + } + + if (! error_state) + delete_graphics_objects (vals); + } + else + error ("delete: invalid graphics object"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__go_axes_init__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_axes_init__ (@var{h}, @var{mode})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + int nargin = args.length (); + + std::string mode = ""; + + if (nargin == 2) + { + mode = args(1).string_value (); + + if (error_state) + return retval; + } + + if (nargin == 1 || nargin == 2) + { + graphics_handle h = octave_NaN; + + double val = args(0).double_value (); + + if (! error_state) + { + h = gh_manager::lookup (val); + + if (h.ok ()) + { + graphics_object obj = gh_manager::get_object (h); + + obj.set_defaults (mode); + + h = gh_manager::lookup (val); + if (! h.ok ()) + error ("__go_axes_init__: axis deleted during initialization (= %g)", val); + } + else + error ("__go_axes_init__: invalid graphics object (= %g)", val); + } + else + error ("__go_axes_init__: invalid graphics object"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__go_handles__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_handles__ (@var{show_hidden})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + bool show_hidden = false; + + if (args.length () > 0) + show_hidden = args(0).bool_value (); + + return octave_value (gh_manager::handle_list (show_hidden)); +} + +DEFUN (__go_figure_handles__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_figure_handles__ (@var{show_hidden})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + bool show_hidden = false; + + if (args.length () > 0) + show_hidden = args(0).bool_value (); + + return octave_value (gh_manager::figure_handle_list (show_hidden)); +} + +DEFUN (__go_execute_callback__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name})\n\ +@deftypefnx {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name}, @var{param})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + double val = args(0).double_value (); + + if (! error_state) + { + graphics_handle h = gh_manager::lookup (val); + + if (h.ok ()) + { + std::string name = args(1).string_value (); + + if (! error_state) + { + if (nargin == 2) + gh_manager::execute_callback (h, name); + else + gh_manager::execute_callback (h, name, args(2)); + } + else + error ("__go_execute_callback__: invalid callback name"); + } + else + error ("__go_execute_callback__: invalid graphics object (= %g)", + val); + } + else + error ("__go_execute_callback__: invalid graphics object"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__image_pixel_size__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{px}, @var{py}} __image_pixel_size__ (@var{h})\n\ +Internal function: returns the pixel size of the image in normalized units.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + double h = args(0).double_value (); + + if (! error_state) + { + graphics_object fobj = gh_manager::get_object (h); + if (fobj && fobj.isa ("image")) + { + image::properties& ip = + dynamic_cast (fobj.get_properties ()); + + Matrix dp = Matrix (1, 2, 0); + dp(0, 0) = ip.pixel_xsize (); + dp(0, 1) = ip.pixel_ysize (); + retval = dp; + } + else + error ("__image_pixel_size__: object is not an image"); + } + else + error ("__image_pixel_size__: argument is not a handle"); + } + else + print_usage (); + + return retval; +} + +gtk_manager *gtk_manager::instance = 0; + +void +gtk_manager::create_instance (void) +{ + instance = new gtk_manager (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); +} + +graphics_toolkit +gtk_manager::do_get_toolkit (void) const +{ + graphics_toolkit retval; + + const_loaded_toolkits_iterator pl = loaded_toolkits.find (dtk); + + if (pl == loaded_toolkits.end ()) + { + const_available_toolkits_iterator pa = available_toolkits.find (dtk); + + if (pa != available_toolkits.end ()) + { + octave_value_list args; + args(0) = dtk; + feval ("graphics_toolkit", args); + + if (! error_state) + pl = loaded_toolkits.find (dtk); + + if (error_state || pl == loaded_toolkits.end ()) + error ("failed to load %s graphics toolkit", dtk.c_str ()); + else + retval = pl->second; + } + else + error ("default graphics toolkit `%s' is not available!", + dtk.c_str ()); + } + else + retval = pl->second; + + return retval; +} + +DEFUN (available_graphics_toolkits, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} available_graphics_toolkits ()\n\ +Return a cell array of registered graphics toolkits.\n\ +@seealso{graphics_toolkit, register_graphics_toolkit}\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + return octave_value (gtk_manager::available_toolkits_list ()); +} + +DEFUN (register_graphics_toolkit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} register_graphics_toolkit (@var{toolkit})\n\ +List @var{toolkit} as an available graphics toolkit.\n\ +@seealso{available_graphics_toolkits}\n\ +@end deftypefn") +{ + octave_value retval; + + gh_manager::auto_lock guard; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + gtk_manager::register_toolkit (name); + else + error ("register_graphics_toolkit: expecting character string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (loaded_graphics_toolkits, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} loaded_graphics_toolkits ()\n\ +Return a cell array of the currently loaded graphics toolkits.\n\ +@seealso{available_graphics_toolkits}\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + return octave_value (gtk_manager::loaded_toolkits_list ()); +} + +DEFUN (drawnow, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} drawnow ()\n\ +@deftypefnx {Built-in Function} {} drawnow (\"expose\")\n\ +@deftypefnx {Built-in Function} {} drawnow (@var{term}, @var{file}, @var{mono}, @var{debug_file})\n\ +Update figure windows and their children. The event queue is flushed and\n\ +any callbacks generated are executed. With the optional argument\n\ +@code{\"expose\"}, only graphic objects are updated and no other events or\n\ +callbacks are processed.\n\ +The third calling form of @code{drawnow} is for debugging and is\n\ +undocumented.\n\ +@end deftypefn") +{ + static int drawnow_executing = 0; + + octave_value retval; + + gh_manager::lock (); + + unwind_protect frame; + frame.protect_var (Vdrawnow_requested, false); + + frame.protect_var (drawnow_executing); + + if (++drawnow_executing <= 1) + { + if (args.length () == 0 || args.length () == 1) + { + Matrix hlist = gh_manager::figure_handle_list (true); + + for (int i = 0; ! error_state && i < hlist.length (); i++) + { + graphics_handle h = gh_manager::lookup (hlist(i)); + + if (h.ok () && h != 0) + { + graphics_object go = gh_manager::get_object (h); + figure::properties& fprops = dynamic_cast (go.get_properties ()); + + if (fprops.is_modified ()) + { + if (fprops.is_visible ()) + { + gh_manager::unlock (); + + fprops.get_toolkit ().redraw_figure (go); + + gh_manager::lock (); + } + + fprops.set_modified (false); + } + } + } + + bool do_events = true; + + if (args.length () == 1) + { + caseless_str val (args(0).string_value ()); + + if (! error_state && val.compare ("expose")) + do_events = false; + else + { + error ("drawnow: invalid argument, expected `expose' as argument"); + return retval; + } + } + + if (do_events) + { + gh_manager::unlock (); + + gh_manager::process_events (); + + gh_manager::lock (); + } + } + else if (args.length () >= 2 && args.length () <= 4) + { + std::string term, file, debug_file; + bool mono; + + term = args(0).string_value (); + + if (! error_state) + { + file = args(1).string_value (); + + if (! error_state) + { + size_t pos = file.find_first_not_of ("|"); + if (pos > 0) + file = file.substr (pos); + else + { + pos = file.find_last_of (file_ops::dir_sep_chars ()); + + if (pos != std::string::npos) + { + std::string dirname = file.substr (0, pos+1); + + file_stat fs (dirname); + + if (! (fs && fs.is_dir ())) + { + error ("drawnow: nonexistent directory `%s'", + dirname.c_str ()); + + return retval; + } + } + } + + mono = (args.length () >= 3 ? args(2).bool_value () : false); + + if (! error_state) + { + debug_file = (args.length () > 3 ? args(3).string_value () + : ""); + + if (! error_state) + { + graphics_handle h = gcf (); + + if (h.ok ()) + { + graphics_object go = gh_manager::get_object (h); + + gh_manager::unlock (); + + go.get_toolkit () + .print_figure (go, term, file, mono, debug_file); + + gh_manager::lock (); + } + else + error ("drawnow: nothing to draw"); + } + else + error ("drawnow: invalid DEBUG_FILE, expected a string value"); + } + else + error ("drawnow: invalid colormode MONO, expected a boolean value"); + } + else + error ("drawnow: invalid FILE, expected a string value"); + } + else + error ("drawnow: invalid terminal TERM, expected a string value"); + } + else + print_usage (); + } + + gh_manager::unlock (); + + return retval; +} + +DEFUN (addlistener, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} addlistener (@var{h}, @var{prop}, @var{fcn})\n\ +Register @var{fcn} as listener for the property @var{prop} of the graphics\n\ +object @var{h}. Property listeners are executed (in order of registration)\n\ +when the property is set. The new value is already available when the\n\ +listeners are executed.\n\ +\n\ +@var{prop} must be a string naming a valid property in @var{h}.\n\ +\n\ +@var{fcn} can be a function handle, a string or a cell array whose first\n\ +element is a function handle. If @var{fcn} is a function handle, the\n\ +corresponding function should accept at least 2 arguments, that will be\n\ +set to the object handle and the empty matrix respectively. If @var{fcn}\n\ +is a string, it must be any valid octave expression. If @var{fcn} is a cell\n\ +array, the first element must be a function handle with the same signature\n\ +as described above. The next elements of the cell array are passed\n\ +as additional arguments to the function.\n\ +\n\ +Example:\n\ +\n\ +@example\n\ +@group\n\ +function my_listener (h, dummy, p1)\n\ + fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ +endfunction\n\ +\n\ +addlistener (gcf, \"position\", @{@@my_listener, \"my string\"@})\n\ +@end group\n\ +@end example\n\ +\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () >= 3 && args.length () <= 4) + { + double h = args(0).double_value (); + + if (! error_state) + { + std::string pname = args(1).string_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (h); + + if (gh.ok ()) + { + graphics_object go = gh_manager::get_object (gh); + + go.add_property_listener (pname, args(2), POSTSET); + + if (args.length () == 4) + { + caseless_str persistent = args(3).string_value (); + if (persistent.compare ("persistent")) + go.add_property_listener (pname, args(2), PERSISTENT); + } + } + else + error ("addlistener: invalid graphics object (= %g)", + h); + } + else + error ("addlistener: invalid property name, expected a string value"); + } + else + error ("addlistener: invalid handle"); + } + else + print_usage (); + + return retval; +} + +DEFUN (dellistener, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dellistener (@var{h}, @var{prop}, @var{fcn})\n\ +Remove the registration of @var{fcn} as a listener for the property\n\ +@var{prop} of the graphics object @var{h}. The function @var{fcn} must\n\ +be the same variable (not just the same value), as was passed to the\n\ +original call to @code{addlistener}.\n\ +\n\ +If @var{fcn} is not defined then all listener functions of @var{prop}\n\ +are removed.\n\ +\n\ +Example:\n\ +\n\ +@example\n\ +@group\n\ +function my_listener (h, dummy, p1)\n\ + fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ +endfunction\n\ +\n\ +c = @{@@my_listener, \"my string\"@};\n\ +addlistener (gcf, \"position\", c);\n\ +dellistener (gcf, \"position\", c);\n\ +@end group\n\ +@end example\n\ +\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () == 3 || args.length () == 2) + { + double h = args(0).double_value (); + + if (! error_state) + { + std::string pname = args(1).string_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (h); + + if (gh.ok ()) + { + graphics_object go = gh_manager::get_object (gh); + + if (args.length () == 2) + go.delete_property_listener (pname, octave_value (), POSTSET); + else + { + caseless_str persistent = args(2).string_value (); + if (persistent.compare ("persistent")) + { + go.delete_property_listener (pname, octave_value (), PERSISTENT); + go.delete_property_listener (pname, octave_value (), POSTSET); + } + else + go.delete_property_listener (pname, args(2), POSTSET); + } + } + else + error ("dellistener: invalid graphics object (= %g)", + h); + } + else + error ("dellistener: invalid property name, expected a string value"); + } + else + error ("dellistener: invalid handle"); + } + else + print_usage (); + + return retval; +} + +DEFUN (addproperty, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type})\n\ +@deftypefnx {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type}, @var{arg}, @dots{})\n\ +Create a new property named @var{name} in graphics object @var{h}.\n\ +@var{type} determines the type of the property to create. @var{args}\n\ +usually contains the default value of the property, but additional\n\ +arguments might be given, depending on the type of the property.\n\ +\n\ +The supported property types are:\n\ +\n\ +@table @code\n\ +@item string\n\ +A string property. @var{arg} contains the default string value.\n\ +\n\ +@item any\n\ +An un-typed property. This kind of property can hold any octave\n\ +value. @var{args} contains the default value.\n\ +\n\ +@item radio\n\ +A string property with a limited set of accepted values. The first\n\ +argument must be a string with all accepted values separated by\n\ +a vertical bar ('|'). The default value can be marked by enclosing\n\ +it with a '@{' '@}' pair. The default value may also be given as\n\ +an optional second string argument.\n\ +\n\ +@item boolean\n\ +A boolean property. This property type is equivalent to a radio\n\ +property with \"on|off\" as accepted values. @var{arg} contains\n\ +the default property value.\n\ +\n\ +@item double\n\ +A scalar double property. @var{arg} contains the default value.\n\ +\n\ +@item handle\n\ +A handle property. This kind of property holds the handle of a\n\ +graphics object. @var{arg} contains the default handle value.\n\ +When no default value is given, the property is initialized to\n\ +the empty matrix.\n\ +\n\ +@item data\n\ +A data (matrix) property. @var{arg} contains the default data\n\ +value. When no default value is given, the data is initialized to\n\ +the empty matrix.\n\ +\n\ +@item color\n\ +A color property. @var{arg} contains the default color value.\n\ +When no default color is given, the property is set to black.\n\ +An optional second string argument may be given to specify an\n\ +additional set of accepted string values (like a radio property).\n\ +@end table\n\ +\n\ +@var{type} may also be the concatenation of a core object type and\n\ +a valid property name for that object type. The property created\n\ +then has the same characteristics as the referenced property (type,\n\ +possible values, hidden state@dots{}). This allows to clone an existing\n\ +property into the graphics object @var{h}.\n\ +\n\ +Examples:\n\ +\n\ +@example\n\ +@group\n\ +addproperty (\"my_property\", gcf, \"string\", \"a string value\");\n\ +addproperty (\"my_radio\", gcf, \"radio\", \"val_1|val_2|@{val_3@}\");\n\ +addproperty (\"my_style\", gcf, \"linelinestyle\", \"--\");\n\ +@end group\n\ +@end example\n\ +\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () >= 3) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + double h = args(1).double_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (h); + + if (gh.ok ()) + { + graphics_object go = gh_manager::get_object (gh); + + std::string type = args(2).string_value (); + + if (! error_state) + { + if (! go.get_properties ().has_property (name)) + { + property p = property::create (name, gh, type, + args.splice (0, 3)); + + if (! error_state) + go.get_properties ().insert_property (name, p); + } + else + error ("addproperty: a `%s' property already exists in the graphics object", + name.c_str ()); + } + else + error ("addproperty: invalid property TYPE, expected a string value"); + } + else + error ("addproperty: invalid graphics object (= %g)", h); + } + else + error ("addproperty: invalid handle value"); + } + else + error ("addproperty: invalid property NAME, expected a string value"); + } + else + print_usage (); + + return retval; +} + +octave_value +get_property_from_handle (double handle, const std::string& property, + const std::string& func) +{ + gh_manager::auto_lock guard; + + graphics_object obj = gh_manager::get_object (handle); + octave_value retval; + + if (obj) + retval = obj.get (caseless_str (property)); + else + error ("%s: invalid handle (= %g)", func.c_str (), handle); + + return retval; +} + +bool +set_property_in_handle (double handle, const std::string& property, + const octave_value& arg, const std::string& func) +{ + gh_manager::auto_lock guard; + + graphics_object obj = gh_manager::get_object (handle); + int ret = false; + + if (obj) + { + obj.set (caseless_str (property), arg); + + if (! error_state) + ret = true; + } + else + error ("%s: invalid handle (= %g)", func.c_str (), handle); + + return ret; +} + +static bool +compare_property_values (const octave_value& o1, const octave_value& o2) +{ + octave_value_list args (2); + + args(0) = o1; + args(1) = o2; + + octave_value_list result = feval ("isequal", args, 1); + + if (! error_state && result.length () > 0) + return result(0).bool_value (); + + return false; +} + +static std::map waitfor_results; + +static void +cleanup_waitfor_id (uint32_t id) +{ + waitfor_results.erase (id); +} + +static void +do_cleanup_waitfor_listener (const octave_value& listener, + listener_mode mode = POSTSET) +{ + Cell c = listener.cell_value (); + + if (c.numel () >= 4) + { + double h = c(2).double_value (); + + if (! error_state) + { + caseless_str pname = c(3).string_value (); + + if (! error_state) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + + if (go.get_properties ().has_property (pname)) + { + go.get_properties () + .delete_listener (pname, listener, mode); + if (mode == POSTSET) + go.get_properties () + .delete_listener (pname, listener, PERSISTENT); + } + } + } + } + } +} + +static void +cleanup_waitfor_postset_listener (const octave_value& listener) +{ do_cleanup_waitfor_listener (listener, POSTSET); } + +static void +cleanup_waitfor_predelete_listener (const octave_value& listener) +{ do_cleanup_waitfor_listener (listener, PREDELETE); } + +static octave_value_list +waitfor_listener (const octave_value_list& args, int) +{ + if (args.length () > 3) + { + uint32_t id = args(2).uint32_scalar_value ().value (); + + if (! error_state) + { + if (args.length () > 5) + { + double h = args(0).double_value (); + + if (! error_state) + { + caseless_str pname = args(4).string_value (); + + if (! error_state) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + octave_value pvalue = go.get (pname); + + if (compare_property_values (pvalue, args(5))) + waitfor_results[id] = true; + } + } + } + } + else + waitfor_results[id] = true; + } + } + + return octave_value_list (); +} + +static octave_value_list +waitfor_del_listener (const octave_value_list& args, int) +{ + if (args.length () > 2) + { + uint32_t id = args(2).uint32_scalar_value ().value (); + + if (! error_state) + waitfor_results[id] = true; + } + + return octave_value_list (); +} + +DEFUN (waitfor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} waitfor (@var{h})\n\ +@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop})\n\ +@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop}, @var{value})\n\ +@deftypefnx {Built-in Function} {} waitfor (@dots{}, \"timeout\", @var{timeout})\n\ +Suspend the execution of the current program until a condition is\n\ +satisfied on the graphics handle @var{h}. While the program is suspended\n\ +graphics events are still being processed normally, allowing callbacks to\n\ +modify the state of graphics objects. This function is reentrant and can be\n\ +called from a callback, while another @code{waitfor} call is pending at\n\ +top-level.\n\ +\n\ +In the first form, program execution is suspended until the graphics object\n\ +@var{h} is destroyed. If the graphics handle is invalid, the function\n\ +returns immediately.\n\ +\n\ +In the second form, execution is suspended until the graphics object is\n\ +destroyed or the property named @var{prop} is modified. If the graphics\n\ +handle is invalid or the property does not exist, the function returns\n\ +immediately.\n\ +\n\ +In the third form, execution is suspended until the graphics object is\n\ +destroyed or the property named @var{prop} is set to @var{value}. The\n\ +function @code{isequal} is used to compare property values. If the graphics\n\ +handle is invalid, the property does not exist or the property is already\n\ +set to @var{value}, the function returns immediately.\n\ +\n\ +An optional timeout can be specified using the property @code{timeout}.\n\ +This timeout value is the number of seconds to wait for the condition to be\n\ +true. @var{timeout} must be at least 1. If a smaller value is specified, a\n\ +warning is issued and a value of 1 is used instead. If the timeout value is\n\ +not an integer, it is truncated towards 0.\n\ +\n\ +To define a condition on a property named @code{timeout}, use the string\n\ +@code{\\timeout} instead.\n\ +\n\ +In all cases, typing CTRL-C stops program execution immediately.\n\ +@seealso{isequal}\n\ +@end deftypefn") +{ + if (args.length () > 0) + { + double h = args(0).double_value (); + + if (! error_state) + { + caseless_str pname; + + unwind_protect frame; + + static uint32_t id_counter = 0; + uint32_t id = 0; + + int max_arg_index = 0; + int timeout_index = -1; + + int timeout = 0; + + if (args.length () > 1) + { + pname = args(1).string_value (); + if (! error_state + && ! pname.empty () + && ! pname.compare ("timeout")) + { + if (pname.compare ("\\timeout")) + pname = "timeout"; + + static octave_value wf_listener; + + if (! wf_listener.is_defined ()) + wf_listener = + octave_value (new octave_builtin (waitfor_listener, + "waitfor_listener")); + + max_arg_index++; + if (args.length () > 2) + { + if (args(2).is_string ()) + { + caseless_str s = args(2).string_value (); + + if (! error_state) + { + if (s.compare ("timeout")) + timeout_index = 2; + else + max_arg_index++; + } + } + else + max_arg_index++; + } + + Cell listener (1, max_arg_index >= 2 ? 5 : 4); + + id = id_counter++; + frame.add_fcn (cleanup_waitfor_id, id); + waitfor_results[id] = false; + + listener(0) = wf_listener; + listener(1) = octave_uint32 (id); + listener(2) = h; + listener(3) = pname; + + if (max_arg_index >= 2) + listener(4) = args(2); + + octave_value ov_listener (listener); + + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + + if (max_arg_index >= 2 + && compare_property_values (go.get (pname), + args(2))) + waitfor_results[id] = true; + else + { + + frame.add_fcn (cleanup_waitfor_postset_listener, + ov_listener); + go.add_property_listener (pname, ov_listener, + POSTSET); + go.add_property_listener (pname, ov_listener, + PERSISTENT); + + if (go.get_properties () + .has_dynamic_property (pname)) + { + static octave_value wf_del_listener; + + if (! wf_del_listener.is_defined ()) + wf_del_listener = + octave_value (new octave_builtin + (waitfor_del_listener, + "waitfor_del_listener")); + + Cell del_listener (1, 4); + + del_listener(0) = wf_del_listener; + del_listener(1) = octave_uint32 (id); + del_listener(2) = h; + del_listener(3) = pname; + + octave_value ov_del_listener (del_listener); + + frame.add_fcn (cleanup_waitfor_predelete_listener, + ov_del_listener); + go.add_property_listener (pname, ov_del_listener, + PREDELETE); + } + } + } + } + else if (error_state || pname.empty ()) + error ("waitfor: invalid property name, expected a non-empty string value"); + } + + if (! error_state + && timeout_index < 0 + && args.length () > (max_arg_index + 1)) + { + caseless_str s = args(max_arg_index + 1).string_value (); + + if (! error_state) + { + if (s.compare ("timeout")) + timeout_index = max_arg_index + 1; + else + error ("waitfor: invalid parameter `%s'", s.c_str ()); + } + else + error ("waitfor: invalid parameter, expected `timeout'"); + } + + if (! error_state && timeout_index >= 0) + { + if (args.length () > (timeout_index + 1)) + { + timeout = static_cast + (args(timeout_index + 1).scalar_value ()); + + if (! error_state) + { + if (timeout < 1) + { + warning ("waitfor: the timeout value must be >= 1, using 1 instead"); + timeout = 1; + } + } + else + error ("waitfor: invalid timeout value, expected a value >= 1"); + } + else + error ("waitfor: missing timeout value"); + } + + // FIXME: There is still a "hole" in the following loop. The code + // assumes that an object handle is unique, which is a fair + // assumptions, except for figures. If a figure is destroyed + // then recreated with the same figure ID, within the same + // run of event hooks, then the figure destruction won't be + // caught and the loop will not stop. This is an unlikely + // possibility in practice, though. + // + // Using deletefcn callback is also unreliable as it could be + // modified during a callback execution and the waitfor loop + // would not stop. + // + // The only "good" implementation would require object + // listeners, similar to property listeners. + + time_t start = 0; + + if (timeout > 0) + start = time (0); + + while (! error_state) + { + if (true) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + if (! pname.empty () && waitfor_results[id]) + break; + } + else + break; + } + + octave_usleep (100000); + + OCTAVE_QUIT; + + command_editor::run_event_hooks (); + + if (timeout > 0) + { + if (start + timeout < time (0)) + break; + } + } + } + else + error ("waitfor: invalid handle value."); + } + else + print_usage (); + + return octave_value (); +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/graphics.in.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/graphics.in.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,5831 @@ +/* + +Copyright (C) 2007-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (graphics_h) +#define graphics_h 1 + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include +#include +#include +#include +#include + +#include "caseless-str.h" +#include "lo-ieee.h" + +#include "gripes.h" +#include "oct-map.h" +#include "oct-mutex.h" +#include "oct-refcount.h" +#include "ov.h" +#include "txt-eng-ft.h" + +// FIXME -- maybe this should be a configure option? +// Matlab defaults to "Helvetica", but that causes problems for many +// gnuplot users. +#if !defined (OCTAVE_DEFAULT_FONTNAME) +#define OCTAVE_DEFAULT_FONTNAME "*" +#endif + +// --------------------------------------------------------------------- + +class graphics_handle +{ +public: + graphics_handle (void) : val (octave_NaN) { } + + graphics_handle (const octave_value& a); + + graphics_handle (int a) : val (a) { } + + graphics_handle (double a) : val (a) { } + + graphics_handle (const graphics_handle& a) : val (a.val) { } + + graphics_handle& operator = (const graphics_handle& a) + { + if (&a != this) + val = a.val; + + return *this; + } + + ~graphics_handle (void) { } + + double value (void) const { return val; } + + octave_value as_octave_value (void) const + { + return ok () ? octave_value (val) : octave_value (Matrix ()); + } + + // Prefix increment/decrement operators. + graphics_handle& operator ++ (void) + { + ++val; + return *this; + } + + graphics_handle& operator -- (void) + { + --val; + return *this; + } + + // Postfix increment/decrement operators. + const graphics_handle operator ++ (int) + { + graphics_handle old_value = *this; + ++(*this); + return old_value; + } + + const graphics_handle operator -- (int) + { + graphics_handle old_value = *this; + --(*this); + return old_value; + } + + bool ok (void) const { return ! xisnan (val); } + +private: + double val; +}; + +inline bool +operator == (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () == b.value (); +} + +inline bool +operator != (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () != b.value (); +} + +inline bool +operator < (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () < b.value (); +} + +inline bool +operator <= (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () <= b.value (); +} + +inline bool +operator >= (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () >= b.value (); +} + +inline bool +operator > (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () > b.value (); +} + +// --------------------------------------------------------------------- + +class base_scaler +{ +public: + base_scaler (void) { } + + virtual ~base_scaler (void) { } + + virtual Matrix scale (const Matrix& m) const + { + error ("invalid axis scale"); + return m; + } + + virtual NDArray scale (const NDArray& m) const + { + error ("invalid axis scale"); + return m; + } + + virtual double scale (double d) const + { + error ("invalid axis scale"); + return d; + } + + virtual double unscale (double d) const + { + error ("invalid axis scale"); + return d; + } + + virtual base_scaler* clone () const + { return new base_scaler (); } + + virtual bool is_linear (void) const + { return false; } +}; + +class lin_scaler : public base_scaler +{ +public: + lin_scaler (void) { } + + Matrix scale (const Matrix& m) const { return m; } + + NDArray scale (const NDArray& m) const { return m; } + + double scale (double d) const { return d; } + + double unscale (double d) const { return d; } + + base_scaler* clone (void) const { return new lin_scaler (); } + + bool is_linear (void) const { return true; } +}; + +class log_scaler : public base_scaler +{ +public: + log_scaler (void) { } + + Matrix scale (const Matrix& m) const + { + Matrix retval (m.rows (), m.cols ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + NDArray scale (const NDArray& m) const + { + NDArray retval (m.dims ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + double scale (double d) const + { return log10 (d); } + + double unscale (double d) const + { return pow (10.0, d); } + + base_scaler* clone (void) const + { return new log_scaler (); } + +private: + void do_scale (const double *src, double *dest, int n) const + { + for (int i = 0; i < n; i++) + dest[i] = log10 (src[i]); + } +}; + +class neg_log_scaler : public base_scaler +{ +public: + neg_log_scaler (void) { } + + Matrix scale (const Matrix& m) const + { + Matrix retval (m.rows (), m.cols ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + NDArray scale (const NDArray& m) const + { + NDArray retval (m.dims ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + double scale (double d) const + { return -log10 (-d); } + + double unscale (double d) const + { return -pow (10.0, -d); } + + base_scaler* clone (void) const + { return new neg_log_scaler (); } + +private: + void do_scale (const double *src, double *dest, int n) const + { + for (int i = 0; i < n; i++) + dest[i] = -log10 (-src[i]); + } +}; + +class scaler +{ +public: + scaler (void) : rep (new base_scaler ()) { } + + scaler (const scaler& s) : rep (s.rep->clone ()) { } + + scaler (const std::string& s) + : rep (s == "log" + ? new log_scaler () + : (s == "neglog" ? new neg_log_scaler () + : (s == "linear" ? new lin_scaler () : new base_scaler ()))) + { } + + ~scaler (void) { delete rep; } + + Matrix scale (const Matrix& m) const + { return rep->scale (m); } + + NDArray scale (const NDArray& m) const + { return rep->scale (m); } + + double scale (double d) const + { return rep->scale (d); } + + double unscale (double d) const + { return rep->unscale (d); } + + bool is_linear (void) const + { return rep->is_linear (); } + + scaler& operator = (const scaler& s) + { + if (rep) + { + delete rep; + rep = 0; + } + + rep = s.rep->clone (); + + return *this; + } + + scaler& operator = (const std::string& s) + { + if (rep) + { + delete rep; + rep = 0; + } + + if (s == "log") + rep = new log_scaler (); + else if (s == "neglog") + rep = new neg_log_scaler (); + else if (s == "linear") + rep = new lin_scaler (); + else + rep = new base_scaler (); + + return *this; + } + +private: + base_scaler *rep; +}; + +// --------------------------------------------------------------------- + +class property; + +enum listener_mode { POSTSET, PERSISTENT, PREDELETE }; + +class base_property +{ +public: + friend class property; + +public: + base_property (void) + : id (-1), count (1), name (), parent (), hidden (), listeners () + { } + + base_property (const std::string& s, const graphics_handle& h) + : id (-1), count (1), name (s), parent (h), hidden (false), listeners () + { } + + base_property (const base_property& p) + : id (-1), count (1), name (p.name), parent (p.parent), + hidden (p.hidden), listeners () + { } + + virtual ~base_property (void) { } + + bool ok (void) const { return parent.ok (); } + + std::string get_name (void) const { return name; } + + void set_name (const std::string& s) { name = s; } + + graphics_handle get_parent (void) const { return parent; } + + void set_parent (const graphics_handle &h) { parent = h; } + + bool is_hidden (void) const { return hidden; } + + void set_hidden (bool flag) { hidden = flag; } + + virtual bool is_radio (void) const { return false; } + + int get_id (void) const { return id; } + + void set_id (int d) { id = d; } + + // Sets property value, notifies graphics toolkit. + // If do_run is true, runs associated listeners. + OCTINTERP_API bool set (const octave_value& v, bool do_run = true, + bool do_notify_toolkit = true); + + virtual octave_value get (void) const + { + error ("get: invalid property \"%s\"", name.c_str ()); + return octave_value (); + } + + + virtual std::string values_as_string (void) const + { + error ("values_as_string: invalid property \"%s\"", name.c_str ()); + return std::string (); + } + + virtual Cell values_as_cell (void) const + { + error ("values_as_cell: invalid property \"%s\"", name.c_str ()); + return Cell (); + } + + base_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + void add_listener (const octave_value& v, listener_mode mode = POSTSET) + { + octave_value_list& l = listeners[mode]; + l.resize (l.length () + 1, v); + } + + void delete_listener (const octave_value& v = octave_value (), + listener_mode mode = POSTSET) + { + octave_value_list& l = listeners[mode]; + + if (v.is_defined ()) + { + bool found = false; + int i; + + for (i = 0; i < l.length (); i++) + { + if (v.internal_rep () == l(i).internal_rep ()) + { + found = true; + break; + } + } + if (found) + { + for (int j = i; j < l.length () - 1; j++) + l(j) = l(j + 1); + + l.resize (l.length () - 1); + } + } + else + { + if (mode == PERSISTENT) + l.resize (0); + else + { + octave_value_list lnew (0); + octave_value_list& lp = listeners[PERSISTENT]; + for (int i = l.length () - 1; i >= 0 ; i--) + { + for (int j = 0; j < lp.length (); j++) + { + if (l(i).internal_rep () == lp(j).internal_rep ()) + { + lnew.resize (lnew.length () + 1, l(i)); + break; + } + } + } + l = lnew; + } + } + + } + + OCTINTERP_API void run_listeners (listener_mode mode = POSTSET); + + virtual base_property* clone (void) const + { return new base_property (*this); } + +protected: + virtual bool do_set (const octave_value&) + { + error ("set: invalid property \"%s\"", name.c_str ()); + return false; + } + +private: + typedef std::map listener_map; + typedef std::map::iterator listener_map_iterator; + typedef std::map::const_iterator listener_map_const_iterator; + +private: + int id; + octave_refcount count; + std::string name; + graphics_handle parent; + bool hidden; + listener_map listeners; +}; + +// --------------------------------------------------------------------- + +class string_property : public base_property +{ +public: + string_property (const std::string& s, const graphics_handle& h, + const std::string& val = "") + : base_property (s, h), str (val) { } + + string_property (const string_property& p) + : base_property (p), str (p.str) { } + + octave_value get (void) const + { return octave_value (str); } + + std::string string_value (void) const { return str; } + + string_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new string_property (*this); } + +protected: + bool do_set (const octave_value& val) + { + if (val.is_string ()) + { + std::string new_str = val.string_value (); + + if (new_str != str) + { + str = new_str; + return true; + } + } + else + error ("set: invalid string property value for \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + std::string str; +}; + +// --------------------------------------------------------------------- + +class string_array_property : public base_property +{ +public: + enum desired_enum { string_t, cell_t }; + + string_array_property (const std::string& s, const graphics_handle& h, + const std::string& val = "", const char& sep = '|', + const desired_enum& typ = string_t) + : base_property (s, h), desired_type (typ), separator (sep), str () + { + size_t pos = 0; + + while (true) + { + size_t new_pos = val.find_first_of (separator, pos); + + if (new_pos == std::string::npos) + { + str.append (val.substr (pos)); + break; + } + else + str.append (val.substr (pos, new_pos - pos)); + + pos = new_pos + 1; + } + } + + string_array_property (const std::string& s, const graphics_handle& h, + const Cell& c, const char& sep = '|', + const desired_enum& typ = string_t) + : base_property (s, h), desired_type (typ), separator (sep), str () + { + if (c.is_cellstr ()) + { + string_vector strings (c.numel ()); + + for (octave_idx_type i = 0; i < c.numel (); i++) + strings[i] = c(i).string_value (); + + str = strings; + } + else + error ("set: invalid order property value for \"%s\"", + get_name ().c_str ()); + } + + string_array_property (const string_array_property& p) + : base_property (p), desired_type (p.desired_type), + separator (p.separator), str (p.str) { } + + octave_value get (void) const + { + if (desired_type == string_t) + return octave_value (string_value ()); + else + return octave_value (cell_value ()); + } + + std::string string_value (void) const + { + std::string s; + + for (octave_idx_type i = 0; i < str.length (); i++) + { + s += str[i]; + if (i != str.length () - 1) + s += separator; + } + + return s; + } + + Cell cell_value (void) const {return Cell (str);} + + string_vector string_vector_value (void) const { return str; } + + string_array_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new string_array_property (*this); } + +protected: + bool do_set (const octave_value& val) + { + if (val.is_string ()) + { + bool replace = false; + std::string new_str = val.string_value (); + string_vector strings; + size_t pos = 0; + + while (pos != std::string::npos) + { + size_t new_pos = new_str.find_first_of (separator, pos); + + if (new_pos == std::string::npos) + { + strings.append (new_str.substr (pos)); + break; + } + else + strings.append (new_str.substr (pos, new_pos - pos)); + + pos = new_pos + 1; + } + + if (str.numel () == strings.numel ()) + { + for (octave_idx_type i = 0; i < str.numel (); i++) + if (strings[i] != str[i]) + { + replace = true; + break; + } + } + else + replace = true; + + desired_type = string_t; + + if (replace) + { + str = strings; + return true; + } + } + else if (val.is_cellstr ()) + { + bool replace = false; + Cell new_cell = val.cell_value (); + + string_vector strings = new_cell.cellstr_value (); + + octave_idx_type nel = strings.length (); + + if (nel != str.length ()) + replace = true; + else + { + for (octave_idx_type i = 0; i < nel; i++) + { + if (strings[i] != str[i]) + { + replace = true; + break; + } + } + } + + desired_type = cell_t; + + if (replace) + { + str = strings; + return true; + } + } + else + error ("set: invalid string property value for \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + desired_enum desired_type; + char separator; + string_vector str; +}; + +// --------------------------------------------------------------------- + +class text_label_property : public base_property +{ +public: + enum type { char_t, cellstr_t }; + + text_label_property (const std::string& s, const graphics_handle& h, + const std::string& val = "") + : base_property (s, h), value (val), stored_type (char_t) + { } + + text_label_property (const std::string& s, const graphics_handle& h, + const NDArray& nda) + : base_property (s, h), stored_type (char_t) + { + octave_idx_type nel = nda.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::ostringstream buf; + buf << nda(i); + value[i] = buf.str (); + } + } + + text_label_property (const std::string& s, const graphics_handle& h, + const Cell& c) + : base_property (s, h), stored_type (cellstr_t) + { + octave_idx_type nel = c.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value tmp = c(i); + + if (tmp.is_string ()) + value[i] = c(i).string_value (); + else + { + double d = c(i).double_value (); + + if (! error_state) + { + std::ostringstream buf; + buf << d; + value[i] = buf.str (); + } + else + break; + } + } + } + + text_label_property (const text_label_property& p) + : base_property (p), value (p.value), stored_type (p.stored_type) + { } + + bool empty (void) const + { + octave_value tmp = get (); + return tmp.is_empty (); + } + + octave_value get (void) const + { + if (stored_type == char_t) + return octave_value (char_value ()); + else + return octave_value (cell_value ()); + } + + std::string string_value (void) const + { + return value.empty () ? std::string () : value[0]; + } + + string_vector string_vector_value (void) const { return value; } + + charMatrix char_value (void) const { return charMatrix (value, ' '); } + + Cell cell_value (void) const {return Cell (value); } + + text_label_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new text_label_property (*this); } + +protected: + + bool do_set (const octave_value& val) + { + if (val.is_string ()) + { + value = val.all_strings (); + + stored_type = char_t; + } + else if (val.is_cell ()) + { + Cell c = val.cell_value (); + + octave_idx_type nel = c.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value tmp = c(i); + + if (tmp.is_string ()) + value[i] = c(i).string_value (); + else + { + double d = c(i).double_value (); + + if (! error_state) + { + std::ostringstream buf; + buf << d; + value[i] = buf.str (); + } + else + return false; + } + } + + stored_type = cellstr_t; + } + else + { + NDArray nda = val.array_value (); + + if (! error_state) + { + octave_idx_type nel = nda.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::ostringstream buf; + buf << nda(i); + value[i] = buf.str (); + } + + stored_type = char_t; + } + else + { + error ("set: invalid string property value for \"%s\"", + get_name ().c_str ()); + + return false; + } + } + + return true; + } + +private: + string_vector value; + type stored_type; +}; + +// --------------------------------------------------------------------- + +class radio_values +{ +public: + OCTINTERP_API radio_values (const std::string& opt_string = std::string ()); + + radio_values (const radio_values& a) + : default_val (a.default_val), possible_vals (a.possible_vals) { } + + radio_values& operator = (const radio_values& a) + { + if (&a != this) + { + default_val = a.default_val; + possible_vals = a.possible_vals; + } + + return *this; + } + + std::string default_value (void) const { return default_val; } + + bool validate (const std::string& val, std::string& match) + { + bool retval = true; + + if (! contains (val, match)) + { + error ("invalid value = %s", val.c_str ()); + retval = false; + } + + return retval; + } + + bool contains (const std::string& val, std::string& match) + { + size_t k = 0; + + size_t len = val.length (); + + std::string first_match; + + for (std::set::const_iterator p = possible_vals.begin (); + p != possible_vals.end (); p++) + { + if (p->compare (val, len)) + { + if (len == p->length ()) + { + // We found a full match (consider the case of val == + // "replace" with possible values "replace" and + // "replacechildren"). Any other matches are + // irrelevant, so set match and return now. + + match = *p; + return true; + } + else + { + if (k == 0) + first_match = *p; + + k++; + } + } + } + + if (k == 1) + { + match = first_match; + return true; + } + else + return false; + } + + std::string values_as_string (void) const; + + Cell values_as_cell (void) const; + + octave_idx_type nelem (void) const { return possible_vals.size (); } + +private: + // Might also want to cache + std::string default_val; + std::set possible_vals; +}; + +class radio_property : public base_property +{ +public: + radio_property (const std::string& nm, const graphics_handle& h, + const radio_values& v = radio_values ()) + : base_property (nm, h), + vals (v), current_val (v.default_value ()) { } + + radio_property (const std::string& nm, const graphics_handle& h, + const std::string& v) + : base_property (nm, h), + vals (v), current_val (vals.default_value ()) { } + + radio_property (const std::string& nm, const graphics_handle& h, + const radio_values& v, const std::string& def) + : base_property (nm, h), + vals (v), current_val (def) { } + + radio_property (const radio_property& p) + : base_property (p), vals (p.vals), current_val (p.current_val) { } + + octave_value get (void) const { return octave_value (current_val); } + + const std::string& current_value (void) const { return current_val; } + + std::string values_as_string (void) const { return vals.values_as_string (); } + + Cell values_as_cell (void) const { return vals.values_as_cell (); } + + bool is (const caseless_str& v) const + { return v.compare (current_val); } + + bool is_radio (void) const { return true; } + + radio_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new radio_property (*this); } + +protected: + bool do_set (const octave_value& newval) + { + if (newval.is_string ()) + { + std::string s = newval.string_value (); + + std::string match; + + if (vals.validate (s, match)) + { + if (match != current_val) + { + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; + return true; + } + } + else + error ("set: invalid value for radio property \"%s\" (value = %s)", + get_name ().c_str (), s.c_str ()); + } + else + error ("set: invalid value for radio property \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + radio_values vals; + std::string current_val; +}; + +// --------------------------------------------------------------------- + +class color_values +{ +public: + color_values (double r = 0, double g = 0, double b = 1) + : xrgb (1, 3) + { + xrgb(0) = r; + xrgb(1) = g; + xrgb(2) = b; + + validate (); + } + + color_values (std::string str) + : xrgb (1, 3) + { + if (! str2rgb (str)) + error ("invalid color specification: %s", str.c_str ()); + } + + color_values (const color_values& c) + : xrgb (c.xrgb) + { } + + color_values& operator = (const color_values& c) + { + if (&c != this) + xrgb = c.xrgb; + + return *this; + } + + bool operator == (const color_values& c) const + { + return (xrgb(0) == c.xrgb(0) + && xrgb(1) == c.xrgb(1) + && xrgb(2) == c.xrgb(2)); + } + + bool operator != (const color_values& c) const + { return ! (*this == c); } + + Matrix rgb (void) const { return xrgb; } + + operator octave_value (void) const { return xrgb; } + + void validate (void) const + { + for (int i = 0; i < 3; i++) + { + if (xrgb(i) < 0 || xrgb(i) > 1) + { + error ("invalid RGB color specification"); + break; + } + } + } + +private: + Matrix xrgb; + + OCTINTERP_API bool str2rgb (std::string str); +}; + +class color_property : public base_property +{ +public: + color_property (const color_values& c, const radio_values& v) + : base_property ("", graphics_handle ()), + current_type (color_t), color_val (c), radio_val (v), + current_val (v.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const color_values& c = color_values (), + const radio_values& v = radio_values ()) + : base_property (nm, h), + current_type (color_t), color_val (c), radio_val (v), + current_val (v.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const radio_values& v) + : base_property (nm, h), + current_type (radio_t), color_val (color_values ()), radio_val (v), + current_val (v.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const std::string& v) + : base_property (nm, h), + current_type (radio_t), color_val (color_values ()), radio_val (v), + current_val (radio_val.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const color_property& v) + : base_property (nm, h), + current_type (v.current_type), color_val (v.color_val), + radio_val (v.radio_val), current_val (v.current_val) + { } + + color_property (const color_property& p) + : base_property (p), current_type (p.current_type), + color_val (p.color_val), radio_val (p.radio_val), + current_val (p.current_val) { } + + octave_value get (void) const + { + if (current_type == color_t) + return color_val.rgb (); + + return current_val; + } + + bool is_rgb (void) const { return (current_type == color_t); } + + bool is_radio (void) const { return (current_type == radio_t); } + + bool is (const std::string& v) const + { return (is_radio () && current_val == v); } + + Matrix rgb (void) const + { + if (current_type != color_t) + error ("color has no rgb value"); + + return color_val.rgb (); + } + + const std::string& current_value (void) const + { + if (current_type != radio_t) + error ("color has no radio value"); + + return current_val; + } + + color_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + operator octave_value (void) const { return get (); } + + base_property* clone (void) const { return new color_property (*this); } + + std::string values_as_string (void) const { return radio_val.values_as_string (); } + + Cell values_as_cell (void) const { return radio_val.values_as_cell (); } + +protected: + OCTINTERP_API bool do_set (const octave_value& newval); + +private: + enum current_enum { color_t, radio_t } current_type; + color_values color_val; + radio_values radio_val; + std::string current_val; +}; + +// --------------------------------------------------------------------- + +class double_property : public base_property +{ +public: + double_property (const std::string& nm, const graphics_handle& h, + double d = 0) + : base_property (nm, h), + current_val (d) { } + + double_property (const double_property& p) + : base_property (p), current_val (p.current_val) { } + + octave_value get (void) const { return octave_value (current_val); } + + double double_value (void) const { return current_val; } + + double_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new double_property (*this); } + +protected: + bool do_set (const octave_value& v) + { + if (v.is_scalar_type () && v.is_real_type ()) + { + double new_val = v.double_value (); + + if (new_val != current_val) + { + current_val = new_val; + return true; + } + } + else + error ("set: invalid value for double property \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + double current_val; +}; + +// --------------------------------------------------------------------- + +class double_radio_property : public base_property +{ +public: + double_radio_property (double d, const radio_values& v) + : base_property ("", graphics_handle ()), + current_type (double_t), dval (d), radio_val (v), + current_val (v.default_value ()) + { } + + double_radio_property (const std::string& nm, const graphics_handle& h, + const std::string& v) + : base_property (nm, h), + current_type (radio_t), dval (0), radio_val (v), + current_val (radio_val.default_value ()) + { } + + double_radio_property (const std::string& nm, const graphics_handle& h, + const double_radio_property& v) + : base_property (nm, h), + current_type (v.current_type), dval (v.dval), + radio_val (v.radio_val), current_val (v.current_val) + { } + + double_radio_property (const double_radio_property& p) + : base_property (p), current_type (p.current_type), + dval (p.dval), radio_val (p.radio_val), + current_val (p.current_val) { } + + octave_value get (void) const + { + if (current_type == double_t) + return dval; + + return current_val; + } + + bool is_double (void) const { return (current_type == double_t); } + + bool is_radio (void) const { return (current_type == radio_t); } + + bool is (const std::string& v) const + { return (is_radio () && current_val == v); } + + double double_value (void) const + { + if (current_type != double_t) + error ("%s: property has no double", get_name ().c_str ()); + + return dval; + } + + const std::string& current_value (void) const + { + if (current_type != radio_t) + error ("%s: property has no radio value"); + + return current_val; + } + + double_radio_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + operator octave_value (void) const { return get (); } + + base_property* clone (void) const + { return new double_radio_property (*this); } + +protected: + OCTINTERP_API bool do_set (const octave_value& v); + +private: + enum current_enum { double_t, radio_t } current_type; + double dval; + radio_values radio_val; + std::string current_val; +}; + +// --------------------------------------------------------------------- + +class array_property : public base_property +{ +public: + array_property (void) + : base_property ("", graphics_handle ()), data (Matrix ()), + xmin (), xmax (), xminp (), xmaxp (), + type_constraints (), size_constraints () + { + get_data_limits (); + } + + array_property (const std::string& nm, const graphics_handle& h, + const octave_value& m) + : base_property (nm, h), data (m), + xmin (), xmax (), xminp (), xmaxp (), + type_constraints (), size_constraints () + { + get_data_limits (); + } + + // This copy constructor is only intended to be used + // internally to access min/max values; no need to + // copy constraints. + array_property (const array_property& p) + : base_property (p), data (p.data), + xmin (p.xmin), xmax (p.xmax), xminp (p.xminp), xmaxp (p.xmaxp), + type_constraints (), size_constraints () + { } + + octave_value get (void) const { return data; } + + void add_constraint (const std::string& type) + { type_constraints.insert (type); } + + void add_constraint (const dim_vector& dims) + { size_constraints.push_back (dims); } + + double min_val (void) const { return xmin; } + double max_val (void) const { return xmax; } + double min_pos (void) const { return xminp; } + double max_neg (void) const { return xmaxp; } + + Matrix get_limits (void) const + { + Matrix m (1, 4); + + m(0) = min_val (); + m(1) = max_val (); + m(2) = min_pos (); + m(3) = max_neg (); + + return m; + } + + array_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const + { + array_property *p = new array_property (*this); + + p->type_constraints = type_constraints; + p->size_constraints = size_constraints; + + return p; + } + +protected: + bool do_set (const octave_value& v) + { + if (validate (v)) + { + // FIXME -- should we check for actual data change? + if (! is_equal (v)) + { + data = v; + + get_data_limits (); + + return true; + } + } + else + error ("invalid value for array property \"%s\"", + get_name ().c_str ()); + + return false; + } + +private: + OCTINTERP_API bool validate (const octave_value& v); + + OCTINTERP_API bool is_equal (const octave_value& v) const; + + OCTINTERP_API void get_data_limits (void); + +protected: + octave_value data; + double xmin; + double xmax; + double xminp; + double xmaxp; + std::set type_constraints; + std::list size_constraints; +}; + +class row_vector_property : public array_property +{ +public: + row_vector_property (const std::string& nm, const graphics_handle& h, + const octave_value& m) + : array_property (nm, h, m) + { + add_constraint (dim_vector (-1, 1)); + add_constraint (dim_vector (1, -1)); + } + + row_vector_property (const row_vector_property& p) + : array_property (p) + { + add_constraint (dim_vector (-1, 1)); + add_constraint (dim_vector (1, -1)); + } + + void add_constraint (const std::string& type) + { + array_property::add_constraint (type); + } + + void add_constraint (const dim_vector& dims) + { + array_property::add_constraint (dims); + } + + void add_constraint (octave_idx_type len) + { + size_constraints.remove (dim_vector (1, -1)); + size_constraints.remove (dim_vector (-1, 1)); + + add_constraint (dim_vector (1, len)); + add_constraint (dim_vector (len, 1)); + } + + row_vector_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const + { + row_vector_property *p = new row_vector_property (*this); + + p->type_constraints = type_constraints; + p->size_constraints = size_constraints; + + return p; + } + +protected: + bool do_set (const octave_value& v) + { + bool retval = array_property::do_set (v); + + if (! error_state) + { + dim_vector dv = data.dims (); + + if (dv(0) > 1 && dv(1) == 1) + { + int tmp = dv(0); + dv(0) = dv(1); + dv(1) = tmp; + + data = data.reshape (dv); + } + + return retval; + } + + return false; + } + +private: + OCTINTERP_API bool validate (const octave_value& v); +}; + +// --------------------------------------------------------------------- + +class bool_property : public radio_property +{ +public: + bool_property (const std::string& nm, const graphics_handle& h, + bool val) + : radio_property (nm, h, radio_values (val ? "{on}|off" : "on|{off}")) + { } + + bool_property (const std::string& nm, const graphics_handle& h, + const char* val) + : radio_property (nm, h, radio_values ("on|off"), val) + { } + + bool_property (const bool_property& p) + : radio_property (p) { } + + bool is_on (void) const { return is ("on"); } + + bool_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new bool_property (*this); } + +protected: + bool do_set (const octave_value& val) + { + if (val.is_bool_scalar ()) + return radio_property::do_set (val.bool_value () ? "on" : "off"); + else + return radio_property::do_set (val); + } +}; + +// --------------------------------------------------------------------- + +class handle_property : public base_property +{ +public: + handle_property (const std::string& nm, const graphics_handle& h, + const graphics_handle& val = graphics_handle ()) + : base_property (nm, h), + current_val (val) { } + + handle_property (const handle_property& p) + : base_property (p), current_val (p.current_val) { } + + octave_value get (void) const { return current_val.as_octave_value (); } + + graphics_handle handle_value (void) const { return current_val; } + + handle_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + handle_property& operator = (const graphics_handle& h) + { + set (octave_value (h.value ())); + return *this; + } + + base_property* clone (void) const { return new handle_property (*this); } + +protected: + OCTINTERP_API bool do_set (const octave_value& v); + +private: + graphics_handle current_val; +}; + +// --------------------------------------------------------------------- + +class any_property : public base_property +{ +public: + any_property (const std::string& nm, const graphics_handle& h, + const octave_value& m = Matrix ()) + : base_property (nm, h), data (m) { } + + any_property (const any_property& p) + : base_property (p), data (p.data) { } + + octave_value get (void) const { return data; } + + any_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new any_property (*this); } + +protected: + bool do_set (const octave_value& v) + { + data = v; + return true; + } + +private: + octave_value data; +}; + +// --------------------------------------------------------------------- + +class children_property : public base_property +{ +public: + children_property (void) + : base_property ("", graphics_handle ()), children_list () + { + do_init_children (Matrix ()); + } + + children_property (const std::string& nm, const graphics_handle& h, + const Matrix &val) + : base_property (nm, h), children_list () + { + do_init_children (val); + } + + children_property (const children_property& p) + : base_property (p), children_list () + { + do_init_children (p.children_list); + } + + children_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new children_property (*this); } + + bool remove_child (const double &val) + { + return do_remove_child (val); + } + + void adopt (const double &val) + { + do_adopt_child (val); + } + + Matrix get_children (void) const + { + return do_get_children (false); + } + + Matrix get_hidden (void) const + { + return do_get_children (true); + } + + Matrix get_all (void) const + { + return do_get_all_children (); + } + + octave_value get (void) const + { + return octave_value (get_children ()); + } + + void delete_children (bool clear = false) + { + do_delete_children (clear); + } + + void renumber (graphics_handle old_gh, graphics_handle new_gh) + { + for (children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + if (*p == old_gh) + { + *p = new_gh.value (); + return; + } + } + + error ("children_list::renumber: child not found!"); + } + +private: + typedef std::list::iterator children_list_iterator; + typedef std::list::const_iterator const_children_list_iterator; + std::list children_list; + +protected: + bool do_set (const octave_value& val) + { + const Matrix new_kids = val.matrix_value (); + + octave_idx_type nel = new_kids.numel (); + + const Matrix new_kids_column = new_kids.reshape (dim_vector (nel, 1)); + + bool is_ok = true; + + if (! error_state) + { + const Matrix visible_kids = do_get_children (false); + + if (visible_kids.numel () == new_kids.numel ()) + { + Matrix t1 = visible_kids.sort (); + Matrix t2 = new_kids_column.sort (); + + if (t1 != t2) + is_ok = false; + } + else + is_ok = false; + + if (! is_ok) + error ("set: new children must be a permutation of existing children"); + } + else + { + is_ok = false; + error ("set: expecting children to be array of graphics handles"); + } + + if (is_ok) + { + Matrix tmp = new_kids_column.stack (get_hidden ()); + + children_list.clear (); + + // Don't use do_init_children here, as that reverses the + // order of the list, and we don't want to do that if setting + // the child list directly. + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + children_list.push_back (tmp.xelem (i)); + } + + return is_ok; + } + +private: + void do_init_children (const Matrix &val) + { + children_list.clear (); + for (octave_idx_type i = 0; i < val.numel (); i++) + children_list.push_front (val.xelem (i)); + } + + void do_init_children (const std::list &val) + { + children_list.clear (); + for (const_children_list_iterator p = val.begin (); p != val.end (); p++) + children_list.push_front (*p); + } + + Matrix do_get_children (bool return_hidden) const; + + Matrix do_get_all_children (void) const + { + Matrix retval (children_list.size (), 1); + octave_idx_type i = 0; + + for (const_children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + retval(i++) = *p; + return retval; + } + + bool do_remove_child (double child) + { + for (children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + if (*p == child) + { + children_list.erase (p); + return true; + } + } + return false; + } + + void do_adopt_child (const double &val) + { + children_list.push_front (val); + } + + void do_delete_children (bool clear); +}; + + + +// --------------------------------------------------------------------- + +class callback_property : public base_property +{ +public: + callback_property (const std::string& nm, const graphics_handle& h, + const octave_value& m) + : base_property (nm, h), callback (m), executing (false) { } + + callback_property (const callback_property& p) + : base_property (p), callback (p.callback), executing (false) { } + + octave_value get (void) const { return callback; } + + OCTINTERP_API void execute (const octave_value& data = octave_value ()) const; + + bool is_defined (void) const + { + return (callback.is_defined () && ! callback.is_empty ()); + } + + callback_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new callback_property (*this); } + +protected: + bool do_set (const octave_value& v) + { + if (validate (v)) + { + callback = v; + return true; + } + else + error ("invalid value for callback property \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + OCTINTERP_API bool validate (const octave_value& v) const; + +private: + octave_value callback; + + // If TRUE, we are executing this callback. + mutable bool executing; +}; + +// --------------------------------------------------------------------- + +class property +{ +public: + property (void) : rep (new base_property ("", graphics_handle ())) + { } + + property (base_property *bp, bool persist = false) : rep (bp) + { if (persist) rep->count++; } + + property (const property& p) : rep (p.rep) + { + rep->count++; + } + + ~property (void) + { + if (--rep->count == 0) + delete rep; + } + + bool ok (void) const + { return rep->ok (); } + + std::string get_name (void) const + { return rep->get_name (); } + + void set_name (const std::string& name) + { rep->set_name (name); } + + graphics_handle get_parent (void) const + { return rep->get_parent (); } + + void set_parent (const graphics_handle& h) + { rep->set_parent (h); } + + bool is_hidden (void) const + { return rep->is_hidden (); } + + void set_hidden (bool flag) + { rep->set_hidden (flag); } + + bool is_radio (void) const + { return rep->is_radio (); } + + int get_id (void) const + { return rep->get_id (); } + + void set_id (int d) + { rep->set_id (d); } + + octave_value get (void) const + { return rep->get (); } + + bool set (const octave_value& val, bool do_run = true, + bool do_notify_toolkit = true) + { return rep->set (val, do_run, do_notify_toolkit); } + + std::string values_as_string (void) const + { return rep->values_as_string (); } + + Cell values_as_cell (void) const + { return rep->values_as_cell (); } + + property& operator = (const octave_value& val) + { + *rep = val; + return *this; + } + + property& operator = (const property& p) + { + if (rep && --rep->count == 0) + delete rep; + + rep = p.rep; + rep->count++; + + return *this; + } + + void add_listener (const octave_value& v, listener_mode mode = POSTSET) + { rep->add_listener (v, mode); } + + void delete_listener (const octave_value& v = octave_value (), + listener_mode mode = POSTSET) + { rep->delete_listener (v, mode); } + + void run_listeners (listener_mode mode = POSTSET) + { rep->run_listeners (mode); } + + OCTINTERP_API static + property create (const std::string& name, const graphics_handle& parent, + const caseless_str& type, + const octave_value_list& args); + + property clone (void) const + { return property (rep->clone ()); } + + /* + const string_property& as_string_property (void) const + { return *(dynamic_cast (rep)); } + + const radio_property& as_radio_property (void) const + { return *(dynamic_cast (rep)); } + + const color_property& as_color_property (void) const + { return *(dynamic_cast (rep)); } + + const double_property& as_double_property (void) const + { return *(dynamic_cast (rep)); } + + const bool_property& as_bool_property (void) const + { return *(dynamic_cast (rep)); } + + const handle_property& as_handle_property (void) const + { return *(dynamic_cast (rep)); } + */ + +private: + base_property *rep; +}; + +// --------------------------------------------------------------------- + +class property_list +{ +public: + typedef std::map pval_map_type; + typedef std::map plist_map_type; + + typedef pval_map_type::iterator pval_map_iterator; + typedef pval_map_type::const_iterator pval_map_const_iterator; + + typedef plist_map_type::iterator plist_map_iterator; + typedef plist_map_type::const_iterator plist_map_const_iterator; + + property_list (const plist_map_type& m = plist_map_type ()) + : plist_map (m) { } + + ~property_list (void) { } + + void set (const caseless_str& name, const octave_value& val); + + octave_value lookup (const caseless_str& name) const; + + plist_map_iterator begin (void) { return plist_map.begin (); } + plist_map_const_iterator begin (void) const { return plist_map.begin (); } + + plist_map_iterator end (void) { return plist_map.end (); } + plist_map_const_iterator end (void) const { return plist_map.end (); } + + plist_map_iterator find (const std::string& go_name) + { + return plist_map.find (go_name); + } + + plist_map_const_iterator find (const std::string& go_name) const + { + return plist_map.find (go_name); + } + + octave_scalar_map as_struct (const std::string& prefix_arg) const; + +private: + plist_map_type plist_map; +}; + +// --------------------------------------------------------------------- + +class graphics_toolkit; +class graphics_object; + +class base_graphics_toolkit +{ +public: + friend class graphics_toolkit; + +public: + base_graphics_toolkit (const std::string& nm) + : name (nm), count (0) { } + + virtual ~base_graphics_toolkit (void) { } + + std::string get_name (void) const { return name; } + + virtual bool is_valid (void) const { return false; } + + virtual void redraw_figure (const graphics_object&) const + { gripe_invalid ("redraw_figure"); } + + virtual void print_figure (const graphics_object&, const std::string&, + const std::string&, bool, + const std::string& = "") const + { gripe_invalid ("print_figure"); } + + virtual Matrix get_canvas_size (const graphics_handle&) const + { + gripe_invalid ("get_canvas_size"); + return Matrix (1, 2, 0.0); + } + + virtual double get_screen_resolution (void) const + { + gripe_invalid ("get_screen_resolution"); + return 72.0; + } + + virtual Matrix get_screen_size (void) const + { + gripe_invalid ("get_screen_size"); + return Matrix (1, 2, 0.0); + } + + // Callback function executed when the given graphics object + // changes. This allows the graphics toolkit to act on property + // changes if needed. + virtual void update (const graphics_object&, int) + { gripe_invalid ("base_graphics_toolkit::update"); } + + void update (const graphics_handle&, int); + + // Callback function executed when the given graphics object is + // created. This allows the graphics toolkit to do toolkit-specific + // initializations for a newly created object. + virtual bool initialize (const graphics_object&) + { gripe_invalid ("base_graphics_toolkit::initialize"); return false; } + + bool initialize (const graphics_handle&); + + // Callback function executed just prior to deleting the given + // graphics object. This allows the graphics toolkit to perform + // toolkit-specific cleanup operations before an object is deleted. + virtual void finalize (const graphics_object&) + { gripe_invalid ("base_graphics_toolkit::finalize"); } + + void finalize (const graphics_handle&); + + // Close the graphics toolkit. + virtual void close (void) + { gripe_invalid ("base_graphics_toolkit::close"); } + +private: + std::string name; + octave_refcount count; + +private: + void gripe_invalid (const std::string& fname) const + { + if (! is_valid ()) + error ("%s: invalid graphics toolkit", fname.c_str ()); + } +}; + +class graphics_toolkit +{ +public: + graphics_toolkit (void) + : rep (new base_graphics_toolkit ("unknown")) + { + rep->count++; + } + + graphics_toolkit (base_graphics_toolkit* b) + : rep (b) + { + rep->count++; + } + + graphics_toolkit (const graphics_toolkit& b) + : rep (b.rep) + { + rep->count++; + } + + ~graphics_toolkit (void) + { + if (--rep->count == 0) + delete rep; + } + + graphics_toolkit& operator = (const graphics_toolkit& b) + { + if (rep != b.rep) + { + if (--rep->count == 0) + delete rep; + + rep = b.rep; + rep->count++; + } + + return *this; + } + + operator bool (void) const { return rep->is_valid (); } + + std::string get_name (void) const { return rep->get_name (); } + + void redraw_figure (const graphics_object& go) const + { rep->redraw_figure (go); } + + void print_figure (const graphics_object& go, const std::string& term, + const std::string& file, bool mono, + const std::string& debug_file = "") const + { rep->print_figure (go, term, file, mono, debug_file); } + + Matrix get_canvas_size (const graphics_handle& fh) const + { return rep->get_canvas_size (fh); } + + double get_screen_resolution (void) const + { return rep->get_screen_resolution (); } + + Matrix get_screen_size (void) const + { return rep->get_screen_size (); } + + // Notifies graphics toolkit that object't property has changed. + void update (const graphics_object& go, int id) + { rep->update (go, id); } + + void update (const graphics_handle& h, int id) + { rep->update (h, id); } + + // Notifies graphics toolkit that new object was created. + bool initialize (const graphics_object& go) + { return rep->initialize (go); } + + bool initialize (const graphics_handle& h) + { return rep->initialize (h); } + + // Notifies graphics toolkit that object was destroyed. + // This is called only for explicitly deleted object. Children are + // deleted implicitly and graphics toolkit isn't notified. + void finalize (const graphics_object& go) + { rep->finalize (go); } + + void finalize (const graphics_handle& h) + { rep->finalize (h); } + + // Close the graphics toolkit. + void close (void) { rep->close (); } + +private: + + base_graphics_toolkit *rep; +}; + +class gtk_manager +{ +public: + + static graphics_toolkit get_toolkit (void) + { + return instance_ok () ? instance->do_get_toolkit () : graphics_toolkit (); + } + + static void register_toolkit (const std::string& name) + { + if (instance_ok ()) + instance->do_register_toolkit (name); + } + + static void unregister_toolkit (const std::string& name) + { + if (instance_ok ()) + instance->do_unregister_toolkit (name); + } + + static void load_toolkit (const graphics_toolkit& tk) + { + if (instance_ok ()) + instance->do_load_toolkit (tk); + } + + static void unload_toolkit (const std::string& name) + { + if (instance_ok ()) + instance->do_unload_toolkit (name); + } + + static graphics_toolkit find_toolkit (const std::string& name) + { + return instance_ok () + ? instance->do_find_toolkit (name) : graphics_toolkit (); + } + + static Cell available_toolkits_list (void) + { + return instance_ok () ? instance->do_available_toolkits_list () : Cell (); + } + + static Cell loaded_toolkits_list (void) + { + return instance_ok () ? instance->do_loaded_toolkits_list () : Cell (); + } + + static void unload_all_toolkits (void) + { + if (instance_ok ()) + instance->do_unload_all_toolkits (); + } + + static std::string default_toolkit (void) + { + return instance_ok () ? instance->do_default_toolkit () : std::string (); + } + +private: + + // FIXME -- default toolkit should be configurable. + + gtk_manager (void) + : dtk ("gnuplot"), available_toolkits (), loaded_toolkits () { } + + ~gtk_manager (void) { } + + OCTINTERP_API static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create gh_manager!"); + + retval = false; + } + + return retval; + } + + static void cleanup_instance (void) { delete instance; instance = 0; } + + OCTINTERP_API static gtk_manager *instance; + + // The name of the default toolkit. + std::string dtk; + + // The list of toolkits that we know about. + std::set available_toolkits; + + // The list of toolkits we have actually loaded. + std::map loaded_toolkits; + + typedef std::set::iterator available_toolkits_iterator; + + typedef std::set::const_iterator + const_available_toolkits_iterator; + + typedef std::map::iterator + loaded_toolkits_iterator; + + typedef std::map::const_iterator + const_loaded_toolkits_iterator; + + graphics_toolkit do_get_toolkit (void) const; + + void do_register_toolkit (const std::string& name) + { + available_toolkits.insert (name); + } + + void do_unregister_toolkit (const std::string& name) + { + available_toolkits.erase (name); + } + + void do_load_toolkit (const graphics_toolkit& tk) + { + loaded_toolkits[tk.get_name ()] = tk; + } + + void do_unload_toolkit (const std::string& name) + { + loaded_toolkits.erase (name); + } + + graphics_toolkit do_find_toolkit (const std::string& name) const + { + const_loaded_toolkits_iterator p = loaded_toolkits.find (name); + + if (p != loaded_toolkits.end ()) + return p->second; + else + return graphics_toolkit (); + } + + Cell do_available_toolkits_list (void) const + { + Cell m (1 , available_toolkits.size ()); + + octave_idx_type i = 0; + for (const_available_toolkits_iterator p = available_toolkits.begin (); + p != available_toolkits.end (); p++) + m(i++) = *p; + + return m; + } + + Cell do_loaded_toolkits_list (void) const + { + Cell m (1 , loaded_toolkits.size ()); + + octave_idx_type i = 0; + for (const_loaded_toolkits_iterator p = loaded_toolkits.begin (); + p != loaded_toolkits.end (); p++) + m(i++) = p->first; + + return m; + } + + void do_unload_all_toolkits (void) + { + while (! loaded_toolkits.empty ()) + { + loaded_toolkits_iterator p = loaded_toolkits.begin (); + + std::string name = p->first; + + p->second.close (); + + // The toolkit may have unloaded itself. If not, we'll do + // it here. + if (loaded_toolkits.find (name) != loaded_toolkits.end ()) + unload_toolkit (name); + } + } + + std::string do_default_toolkit (void) { return dtk; } +}; + +// --------------------------------------------------------------------- + +class base_graphics_object; +class graphics_object; + +class OCTINTERP_API base_properties +{ +public: + base_properties (const std::string& ty = "unknown", + const graphics_handle& mh = graphics_handle (), + const graphics_handle& p = graphics_handle ()); + + virtual ~base_properties (void) { } + + virtual std::string graphics_object_name (void) const { return "unknonwn"; } + + void mark_modified (void); + + void override_defaults (base_graphics_object& obj); + + virtual void init_integerhandle (const octave_value&) + { + panic_impossible (); + } + + // Look through DEFAULTS for properties with given CLASS_NAME, and + // apply them to the current object with set (virtual method). + + void set_from_list (base_graphics_object& obj, property_list& defaults); + + void insert_property (const std::string& name, property p) + { + p.set_name (name); + p.set_parent (__myhandle__); + all_props[name] = p; + } + + virtual void set (const caseless_str&, const octave_value&); + + virtual octave_value get (const caseless_str& pname) const; + + virtual octave_value get (const std::string& pname) const + { + return get (caseless_str (pname)); + } + + virtual octave_value get (const char *pname) const + { + return get (caseless_str (pname)); + } + + virtual octave_value get (bool all = false) const; + + virtual property get_property (const caseless_str& pname); + + virtual bool has_property (const caseless_str&) const + { + panic_impossible (); + return false; + } + + bool is_modified (void) const { return is___modified__ (); } + + virtual void remove_child (const graphics_handle& h) + { + if (children.remove_child (h.value ())) + mark_modified (); + } + + virtual void adopt (const graphics_handle& h) + { + children.adopt (h.value ()); + mark_modified (); + } + + virtual graphics_toolkit get_toolkit (void) const; + + virtual Matrix get_boundingbox (bool /*internal*/ = false, + const Matrix& /*parent_pix_size*/ = Matrix ()) const + { return Matrix (1, 4, 0.0); } + + virtual void update_boundingbox (void); + + virtual void update_autopos (const std::string& elem_type); + + virtual void add_listener (const caseless_str&, const octave_value&, + listener_mode = POSTSET); + + virtual void delete_listener (const caseless_str&, const octave_value&, + listener_mode = POSTSET); + + void set_tag (const octave_value& val) { tag = val; } + + void set_parent (const octave_value& val); + + Matrix get_children (void) const + { + return children.get_children (); + } + + Matrix get_all_children (void) const + { + return children.get_all (); + } + + Matrix get_hidden_children (void) const + { + return children.get_hidden (); + } + + void set_modified (const octave_value& val) { set___modified__ (val); } + + void set___modified__ (const octave_value& val) { __modified__ = val; } + + void reparent (const graphics_handle& new_parent) { parent = new_parent; } + + // Update data limits for AXIS_TYPE (xdata, ydata, etc.) in the parent + // axes object. + + virtual void update_axis_limits (const std::string& axis_type) const; + + virtual void update_axis_limits (const std::string& axis_type, + const graphics_handle& h) const; + + virtual void delete_children (bool clear = false) + { + children.delete_children (clear); + } + + void renumber_child (graphics_handle old_gh, graphics_handle new_gh) + { + children.renumber (old_gh, new_gh); + } + + void renumber_parent (graphics_handle new_gh) + { + parent = new_gh; + } + + static property_list::pval_map_type factory_defaults (void); + + // FIXME -- these functions should be generated automatically by the + // genprops.awk script. + // + // EMIT_BASE_PROPERTIES_GET_FUNCTIONS + + virtual octave_value get_xlim (void) const { return octave_value (); } + virtual octave_value get_ylim (void) const { return octave_value (); } + virtual octave_value get_zlim (void) const { return octave_value (); } + virtual octave_value get_clim (void) const { return octave_value (); } + virtual octave_value get_alim (void) const { return octave_value (); } + + virtual bool is_xliminclude (void) const { return false; } + virtual bool is_yliminclude (void) const { return false; } + virtual bool is_zliminclude (void) const { return false; } + virtual bool is_climinclude (void) const { return false; } + virtual bool is_aliminclude (void) const { return false; } + + bool is_handle_visible (void) const; + + std::set dynamic_property_names (void) const; + + bool has_dynamic_property (const std::string& pname); + +protected: + std::set dynamic_properties; + + void set_dynamic (const caseless_str& pname, const octave_value& val); + + octave_value get_dynamic (const caseless_str& pname) const; + + octave_value get_dynamic (bool all = false) const; + + property get_property_dynamic (const caseless_str& pname); + + BEGIN_BASE_PROPERTIES + // properties common to all objects + bool_property beingdeleted , "off" + radio_property busyaction , "{queue}|cancel" + callback_property buttondownfcn , Matrix () + children_property children gf , Matrix () + bool_property clipping , "on" + callback_property createfcn , Matrix () + callback_property deletefcn , Matrix () + radio_property handlevisibility , "{on}|callback|off" + bool_property hittest , "on" + bool_property interruptible , "on" + handle_property parent fs , p + bool_property selected , "off" + bool_property selectionhighlight , "on" + string_property tag s , "" + string_property type frs , ty + any_property userdata , Matrix () + bool_property visible , "on" + // additional (octave-specific) properties + bool_property __modified__ s , "on" + graphics_handle __myhandle__ fhrs , mh + // FIXME -- should this really be here? + handle_property uicontextmenu , graphics_handle () + END_PROPERTIES + +protected: + struct cmp_caseless_str + { + bool operator () (const caseless_str &a, const caseless_str &b) const + { + std::string a1 = a; + std::transform (a1.begin (), a1.end (), a1.begin (), tolower); + std::string b1 = b; + std::transform (b1.begin (), b1.end (), b1.begin (), tolower); + + return a1 < b1; + } + }; + + std::map all_props; + +protected: + void insert_static_property (const std::string& name, base_property& p) + { insert_property (name, property (&p, true)); } + + virtual void init (void) { } +}; + +class OCTINTERP_API base_graphics_object +{ +public: + friend class graphics_object; + + base_graphics_object (void) : count (1), toolkit_flag (false) { } + + virtual ~base_graphics_object (void) { } + + virtual void mark_modified (void) + { + if (valid_object ()) + get_properties ().mark_modified (); + else + error ("base_graphics_object::mark_modified: invalid graphics object"); + } + + virtual void override_defaults (base_graphics_object& obj) + { + if (valid_object ()) + get_properties ().override_defaults (obj); + else + error ("base_graphics_object::override_defaults: invalid graphics object"); + } + + virtual void set_from_list (property_list& plist) + { + if (valid_object ()) + get_properties ().set_from_list (*this, plist); + else + error ("base_graphics_object::set_from_list: invalid graphics object"); + } + + virtual void set (const caseless_str& pname, const octave_value& pval) + { + if (valid_object ()) + get_properties ().set (pname, pval); + else + error ("base_graphics_object::set: invalid graphics object"); + } + + virtual void set_defaults (const std::string&) + { + error ("base_graphics_object::set_defaults: invalid graphics object"); + } + + virtual octave_value get (bool all = false) const + { + if (valid_object ()) + return get_properties ().get (all); + else + { + error ("base_graphics_object::get: invalid graphics object"); + return octave_value (); + } + } + + virtual octave_value get (const caseless_str& pname) const + { + if (valid_object ()) + return get_properties ().get (pname); + else + { + error ("base_graphics_object::get: invalid graphics object"); + return octave_value (); + } + } + + virtual octave_value get_default (const caseless_str&) const; + + virtual octave_value get_factory_default (const caseless_str&) const; + + virtual octave_value get_defaults (void) const + { + error ("base_graphics_object::get_defaults: invalid graphics object"); + return octave_value (); + } + + virtual octave_value get_factory_defaults (void) const + { + error ("base_graphics_object::get_factory_defaults: invalid graphics object"); + return octave_value (); + } + + virtual std::string values_as_string (void); + + virtual octave_scalar_map values_as_struct (void); + + virtual graphics_handle get_parent (void) const + { + if (valid_object ()) + return get_properties ().get_parent (); + else + { + error ("base_graphics_object::get_parent: invalid graphics object"); + return graphics_handle (); + } + } + + graphics_handle get_handle (void) const + { + if (valid_object ()) + return get_properties ().get___myhandle__ (); + else + { + error ("base_graphics_object::get_handle: invalid graphics object"); + return graphics_handle (); + } + } + + virtual void remove_child (const graphics_handle& h) + { + if (valid_object ()) + get_properties ().remove_child (h); + else + error ("base_graphics_object::remove_child: invalid graphics object"); + } + + virtual void adopt (const graphics_handle& h) + { + if (valid_object ()) + get_properties ().adopt (h); + else + error ("base_graphics_object::adopt: invalid graphics object"); + } + + virtual void reparent (const graphics_handle& np) + { + if (valid_object ()) + get_properties ().reparent (np); + else + error ("base_graphics_object::reparent: invalid graphics object"); + } + + virtual void defaults (void) const + { + if (valid_object ()) + { + std::string msg = (type () + "::defaults"); + gripe_not_implemented (msg.c_str ()); + } + else + error ("base_graphics_object::default: invalid graphics object"); + } + + virtual base_properties& get_properties (void) + { + static base_properties properties; + error ("base_graphics_object::get_properties: invalid graphics object"); + return properties; + } + + virtual const base_properties& get_properties (void) const + { + static base_properties properties; + error ("base_graphics_object::get_properties: invalid graphics object"); + return properties; + } + + virtual void update_axis_limits (const std::string& axis_type); + + virtual void update_axis_limits (const std::string& axis_type, + const graphics_handle& h); + + virtual bool valid_object (void) const { return false; } + + bool valid_toolkit_object (void) const { return toolkit_flag; } + + virtual std::string type (void) const + { + return (valid_object () ? get_properties ().graphics_object_name () + : "unknown"); + } + + bool isa (const std::string& go_name) const + { + return type () == go_name; + } + + virtual graphics_toolkit get_toolkit (void) const + { + if (valid_object ()) + return get_properties ().get_toolkit (); + else + { + error ("base_graphics_object::get_toolkit: invalid graphics object"); + return graphics_toolkit (); + } + } + + virtual void add_property_listener (const std::string& nm, + const octave_value& v, + listener_mode mode = POSTSET) + { + if (valid_object ()) + get_properties ().add_listener (nm, v, mode); + } + + virtual void delete_property_listener (const std::string& nm, + const octave_value& v, + listener_mode mode = POSTSET) + { + if (valid_object ()) + get_properties ().delete_listener (nm, v, mode); + } + + virtual void remove_all_listeners (void); + + virtual void reset_default_properties (void) + { + if (valid_object ()) + { + std::string msg = (type () + "::reset_default_properties"); + gripe_not_implemented (msg.c_str ()); + } + else + error ("base_graphics_object::default: invalid graphics object"); + } + +protected: + virtual void initialize (const graphics_object& go) + { + if (! toolkit_flag) + toolkit_flag = get_toolkit ().initialize (go); + } + + virtual void finalize (const graphics_object& go) + { + if (toolkit_flag) + { + get_toolkit ().finalize (go); + toolkit_flag = false; + } + } + + virtual void update (const graphics_object& go, int id) + { + if (toolkit_flag) + get_toolkit ().update (go, id); + } + +protected: + // A reference count. + octave_refcount count; + + // A flag telling whether this object is a valid object + // in the backend context. + bool toolkit_flag; + + // No copying! + + base_graphics_object (const base_graphics_object&) : count (0) { } + + base_graphics_object& operator = (const base_graphics_object&) + { + return *this; + } +}; + +class OCTINTERP_API graphics_object +{ +public: + graphics_object (void) : rep (new base_graphics_object ()) { } + + graphics_object (base_graphics_object *new_rep) + : rep (new_rep) { } + + graphics_object (const graphics_object& obj) : rep (obj.rep) + { + rep->count++; + } + + graphics_object& operator = (const graphics_object& obj) + { + if (rep != obj.rep) + { + if (--rep->count == 0) + delete rep; + + rep = obj.rep; + rep->count++; + } + + return *this; + } + + ~graphics_object (void) + { + if (--rep->count == 0) + delete rep; + } + + void mark_modified (void) { rep->mark_modified (); } + + void override_defaults (base_graphics_object& obj) + { + rep->override_defaults (obj); + } + + void set_from_list (property_list& plist) { rep->set_from_list (plist); } + + void set (const caseless_str& name, const octave_value& val) + { + rep->set (name, val); + } + + void set (const octave_value_list& args); + + void set (const Array& names, const Cell& values, + octave_idx_type row); + + void set (const octave_map& m); + + void set_value_or_default (const caseless_str& name, + const octave_value& val); + + void set_defaults (const std::string& mode) { rep->set_defaults (mode); } + + octave_value get (bool all = false) const { return rep->get (all); } + + octave_value get (const caseless_str& name) const + { + return name.compare ("default") + ? get_defaults () + : (name.compare ("factory") + ? get_factory_defaults () : rep->get (name)); + } + + octave_value get (const std::string& name) const + { + return get (caseless_str (name)); + } + + octave_value get (const char *name) const + { + return get (caseless_str (name)); + } + + octave_value get_default (const caseless_str& name) const + { + return rep->get_default (name); + } + + octave_value get_factory_default (const caseless_str& name) const + { + return rep->get_factory_default (name); + } + + octave_value get_defaults (void) const { return rep->get_defaults (); } + + octave_value get_factory_defaults (void) const + { + return rep->get_factory_defaults (); + } + + std::string values_as_string (void) { return rep->values_as_string (); } + + octave_map values_as_struct (void) { return rep->values_as_struct (); } + + graphics_handle get_parent (void) const { return rep->get_parent (); } + + graphics_handle get_handle (void) const { return rep->get_handle (); } + + graphics_object get_ancestor (const std::string& type) const; + + void remove_child (const graphics_handle& h) { rep->remove_child (h); } + + void adopt (const graphics_handle& h) { rep->adopt (h); } + + void reparent (const graphics_handle& h) { rep->reparent (h); } + + void defaults (void) const { rep->defaults (); } + + bool isa (const std::string& go_name) const { return rep->isa (go_name); } + + base_properties& get_properties (void) { return rep->get_properties (); } + + const base_properties& get_properties (void) const + { + return rep->get_properties (); + } + + void update_axis_limits (const std::string& axis_type) + { + rep->update_axis_limits (axis_type); + } + + void update_axis_limits (const std::string& axis_type, + const graphics_handle& h) + { + rep->update_axis_limits (axis_type, h); + } + + bool valid_object (void) const { return rep->valid_object (); } + + std::string type (void) const { return rep->type (); } + + operator bool (void) const { return rep->valid_object (); } + + // FIXME -- these functions should be generated automatically by the + // genprops.awk script. + // + // EMIT_GRAPHICS_OBJECT_GET_FUNCTIONS + + octave_value get_xlim (void) const + { return get_properties ().get_xlim (); } + + octave_value get_ylim (void) const + { return get_properties ().get_ylim (); } + + octave_value get_zlim (void) const + { return get_properties ().get_zlim (); } + + octave_value get_clim (void) const + { return get_properties ().get_clim (); } + + octave_value get_alim (void) const + { return get_properties ().get_alim (); } + + bool is_xliminclude (void) const + { return get_properties ().is_xliminclude (); } + + bool is_yliminclude (void) const + { return get_properties ().is_yliminclude (); } + + bool is_zliminclude (void) const + { return get_properties ().is_zliminclude (); } + + bool is_climinclude (void) const + { return get_properties ().is_climinclude (); } + + bool is_aliminclude (void) const + { return get_properties ().is_aliminclude (); } + + bool is_handle_visible (void) const + { return get_properties ().is_handle_visible (); } + + graphics_toolkit get_toolkit (void) const { return rep->get_toolkit (); } + + void add_property_listener (const std::string& nm, const octave_value& v, + listener_mode mode = POSTSET) + { rep->add_property_listener (nm, v, mode); } + + void delete_property_listener (const std::string& nm, const octave_value& v, + listener_mode mode = POSTSET) + { rep->delete_property_listener (nm, v, mode); } + + void initialize (void) { rep->initialize (*this); } + + void finalize (void) { rep->finalize (*this); } + + void update (int id) { rep->update (*this, id); } + + void reset_default_properties (void) + { rep->reset_default_properties (); } + +private: + base_graphics_object *rep; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API root_figure : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void remove_child (const graphics_handle& h); + + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + // FIXME -- it seems strange to me that the diary, diaryfile, + // echo, format, formatspacing, language, and recursionlimit + // properties are here. WTF do they have to do with graphics? + // Also note that these properties (and the monitorpositions, + // pointerlocation, and pointerwindow properties) are not yet used + // by Octave, so setting them will have no effect, and changes + // made elswhere (say, the diary or format functions) will not + // cause these properties to be updated. + + BEGIN_PROPERTIES (root_figure, root) + handle_property callbackobject Sr , graphics_handle () + array_property commandwindowsize r , Matrix (1, 2, 0) + handle_property currentfigure S , graphics_handle () + bool_property diary , "off" + string_property diaryfile , "diary" + bool_property echo , "off" + radio_property format , "+|bank|bit|debug|hex|long|longe|longeng|longg|native-bit|native-hex|rational|{short}|shorte|shorteng|shortg" + radio_property formatspacing , "{loose}|compact" + string_property language , "ascii" + array_property monitorpositions , Matrix (1, 4, 0) + array_property pointerlocation , Matrix (1, 2, 0) + double_property pointerwindow , 0.0 + double_property recursionlimit , 256.0 + double_property screendepth r , default_screendepth () + double_property screenpixelsperinch r , default_screenpixelsperinch () + array_property screensize r , default_screensize () + bool_property showhiddenhandles , "off" + radio_property units U , "inches|centimeters|normalized|points|{pixels}" + END_PROPERTIES + + private: + std::list cbo_stack; + }; + +private: + properties xproperties; + +public: + + root_figure (void) : xproperties (0, graphics_handle ()), default_properties () { } + + ~root_figure (void) { } + + void mark_modified (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + if (name.compare ("default", 7)) + return get_default (name.substr (7)); + else if (name.compare ("factory", 7)) + return get_factory_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const + { + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + // no default property found, use factory default + retval = factory_properties.lookup (name); + + if (retval.is_undefined ()) + error ("get: invalid default property `%s'", name.c_str ()); + } + + return retval; + } + + octave_value get_factory_default (const caseless_str& name) const + { + octave_value retval = factory_properties.lookup (name); + + if (retval.is_undefined ()) + error ("get: invalid factory default property `%s'", name.c_str ()); + + return retval; + } + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + octave_value get_factory_defaults (void) const + { + return factory_properties.as_struct ("factory"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +private: + property_list default_properties; + + static property_list factory_properties; + + static property_list::plist_map_type init_factory_properties (void); +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API figure : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void init_integerhandle (const octave_value& val) + { + integerhandle = val; + } + + void remove_child (const graphics_handle& h); + + void set_visible (const octave_value& val); + + graphics_toolkit get_toolkit (void) const + { + if (! toolkit) + toolkit = gtk_manager::get_toolkit (); + + return toolkit; + } + + void set_toolkit (const graphics_toolkit& b); + + void set___graphics_toolkit__ (const octave_value& val) + { + if (! error_state) + { + if (val.is_string ()) + { + std::string nm = val.string_value (); + graphics_toolkit b = gtk_manager::find_toolkit (nm); + if (b.get_name () != nm) + { + error ("set___graphics_toolkit__: invalid graphics toolkit"); + } + else + { + set_toolkit (b); + mark_modified (); + } + } + else + error ("set___graphics_toolkit__ must be a string"); + } + } + + void set_position (const octave_value& val, + bool do_notify_toolkit = true); + + void set_outerposition (const octave_value& val, + bool do_notify_toolkit = true); + + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + void set_boundingbox (const Matrix& bb, bool internal = false, + bool do_notify_toolkit = true); + + Matrix map_from_boundingbox (double x, double y) const; + + Matrix map_to_boundingbox (double x, double y) const; + + void update_units (const caseless_str& old_units); + + void update_paperunits (const caseless_str& old_paperunits); + + std::string get_title (void) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (figure) + any_property __plot_stream__ h , Matrix () + bool_property __enhanced__ h , "on" + radio_property nextplot , "new|{add}|replacechildren|replace" + callback_property closerequestfcn , "closereq" + handle_property currentaxes S , graphics_handle () + array_property colormap , jet_colormap () + radio_property paperorientation U , "{portrait}|landscape|rotated" + color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) + array_property alphamap , Matrix (64, 1, 1) + string_property currentcharacter r , "" + handle_property currentobject r , graphics_handle () + array_property currentpoint r , Matrix (2, 1, 0) + bool_property dockcontrols , "off" + bool_property doublebuffer , "on" + string_property filename , "" + bool_property integerhandle S , "on" + bool_property inverthardcopy , "off" + callback_property keypressfcn , Matrix () + callback_property keyreleasefcn , Matrix () + radio_property menubar , "none|{figure}" + double_property mincolormap , 64 + string_property name , "" + bool_property numbertitle , "on" + array_property outerposition s , Matrix (1, 4, -1.0) + radio_property paperunits Su , "{inches}|centimeters|normalized|points" + array_property paperposition , default_figure_paperposition () + radio_property paperpositionmode , "auto|{manual}" + array_property papersize U , default_figure_papersize () + radio_property papertype SU , "{usletter}|uslegal|a0|a1|a2|a3|a4|a5|b0|b1|b2|b3|b4|b5|arch-a|arch-b|arch-c|arch-d|arch-e|a|b|c|d|e|tabloid|" + radio_property pointer , "crosshair|fullcrosshair|{arrow}|ibeam|watch|topl|topr|botl|botr|left|top|right|bottom|circle|cross|fleur|custom|hand" + array_property pointershapecdata , Matrix (16, 16, 0) + array_property pointershapehotspot , Matrix (1, 2, 0) + array_property position s , default_figure_position () + radio_property renderer , "{painters}|zbuffer|opengl|none" + radio_property renderermode , "{auto}|manual" + bool_property resize , "on" + callback_property resizefcn , Matrix () + radio_property selectiontype , "{normal}|open|alt|extend" + radio_property toolbar , "none|{auto}|figure" + radio_property units Su , "inches|centimeters|normalized|points|{pixels}|characters" + callback_property windowbuttondownfcn , Matrix () + callback_property windowbuttonmotionfcn , Matrix () + callback_property windowbuttonupfcn , Matrix () + callback_property windowbuttonwheelfcn , Matrix () + radio_property windowstyle , "{normal}|modal|docked" + string_property wvisual , "" + radio_property wvisualmode , "{auto}|manual" + string_property xdisplay , "" + string_property xvisual , "" + radio_property xvisualmode , "{auto}|manual" + callback_property buttondownfcn , Matrix () + string_property __graphics_toolkit__ s , "gnuplot" + any_property __guidata__ h , Matrix () + END_PROPERTIES + + protected: + void init (void) + { + colormap.add_constraint (dim_vector (-1, 3)); + alphamap.add_constraint (dim_vector (-1, 1)); + paperposition.add_constraint (dim_vector (1, 4)); + pointershapecdata.add_constraint (dim_vector (16, 16)); + pointershapehotspot.add_constraint (dim_vector (1, 2)); + position.add_constraint (dim_vector (1, 4)); + outerposition.add_constraint (dim_vector (1, 4)); + } + + private: + mutable graphics_toolkit toolkit; + }; + +private: + properties xproperties; + +public: + figure (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p), default_properties () + { + xproperties.override_defaults (*this); + } + + ~figure (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Allow parent (root figure) to override first (properties knows how + // to find the parent object). + xproperties.override_defaults (obj); + + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + if (name.compare ("default", 7)) + retval = get_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const; + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +private: + property_list default_properties; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API graphics_xform +{ +public: + graphics_xform (void) + : xform (xform_eye ()), xform_inv (xform_eye ()), + sx ("linear"), sy ("linear"), sz ("linear"), zlim (1, 2, 0.0) + { + zlim(1) = 1.0; + } + + graphics_xform (const Matrix& xm, const Matrix& xim, + const scaler& x, const scaler& y, const scaler& z, + const Matrix& zl) + : xform (xm), xform_inv (xim), sx (x), sy (y), sz (z), zlim (zl) { } + + graphics_xform (const graphics_xform& g) + : xform (g.xform), xform_inv (g.xform_inv), sx (g.sx), + sy (g.sy), sz (g.sz), zlim (g.zlim) { } + + ~graphics_xform (void) { } + + graphics_xform& operator = (const graphics_xform& g) + { + xform = g.xform; + xform_inv = g.xform_inv; + sx = g.sx; + sy = g.sy; + sz = g.sz; + zlim = g.zlim; + + return *this; + } + + static ColumnVector xform_vector (double x, double y, double z); + + static Matrix xform_eye (void); + + ColumnVector transform (double x, double y, double z, + bool use_scale = true) const; + + ColumnVector untransform (double x, double y, double z, + bool use_scale = true) const; + + ColumnVector untransform (double x, double y, bool use_scale = true) const + { return untransform (x, y, (zlim(0)+zlim(1))/2, use_scale); } + + Matrix xscale (const Matrix& m) const { return sx.scale (m); } + Matrix yscale (const Matrix& m) const { return sy.scale (m); } + Matrix zscale (const Matrix& m) const { return sz.scale (m); } + + Matrix scale (const Matrix& m) const + { + bool has_z = (m.columns () > 2); + + if (sx.is_linear () && sy.is_linear () + && (! has_z || sz.is_linear ())) + return m; + + Matrix retval (m.dims ()); + + int r = m.rows (); + + for (int i = 0; i < r; i++) + { + retval(i,0) = sx.scale (m(i,0)); + retval(i,1) = sy.scale (m(i,1)); + if (has_z) + retval(i,2) = sz.scale (m(i,2)); + } + + return retval; + } + +private: + Matrix xform; + Matrix xform_inv; + scaler sx, sy, sz; + Matrix zlim; +}; + +enum { + AXE_ANY_DIR = 0, + AXE_DEPTH_DIR = 1, + AXE_HORZ_DIR = 2, + AXE_VERT_DIR = 3 +}; + +class OCTINTERP_API axes : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void set_defaults (base_graphics_object& obj, const std::string& mode); + + void remove_child (const graphics_handle& h); + + const scaler& get_x_scaler (void) const { return sx; } + const scaler& get_y_scaler (void) const { return sy; } + const scaler& get_z_scaler (void) const { return sz; } + + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + Matrix get_extent (bool with_text = false, bool only_text_height=false) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + void update_boundingbox (void) + { + if (units_is ("normalized")) + { + sync_positions (); + base_properties::update_boundingbox (); + } + } + + void update_camera (void); + void update_axes_layout (void); + void update_aspectratios (void); + void update_transform (void) + { + update_aspectratios (); + update_camera (); + update_axes_layout (); + } + + void update_autopos (const std::string& elem_type); + void update_xlabel_position (void); + void update_ylabel_position (void); + void update_zlabel_position (void); + void update_title_position (void); + + graphics_xform get_transform (void) const + { return graphics_xform (x_render, x_render_inv, sx, sy, sz, x_zlim); } + + Matrix get_transform_matrix (void) const { return x_render; } + Matrix get_inverse_transform_matrix (void) const { return x_render_inv; } + Matrix get_opengl_matrix_1 (void) const { return x_gl_mat1; } + Matrix get_opengl_matrix_2 (void) const { return x_gl_mat2; } + Matrix get_transform_zlim (void) const { return x_zlim; } + + int get_xstate (void) const { return xstate; } + int get_ystate (void) const { return ystate; } + int get_zstate (void) const { return zstate; } + double get_xPlane (void) const { return xPlane; } + double get_xPlaneN (void) const { return xPlaneN; } + double get_yPlane (void) const { return yPlane; } + double get_yPlaneN (void) const { return yPlaneN; } + double get_zPlane (void) const { return zPlane; } + double get_zPlaneN (void) const { return zPlaneN; } + double get_xpTick (void) const { return xpTick; } + double get_xpTickN (void) const { return xpTickN; } + double get_ypTick (void) const { return ypTick; } + double get_ypTickN (void) const { return ypTickN; } + double get_zpTick (void) const { return zpTick; } + double get_zpTickN (void) const { return zpTickN; } + double get_x_min (void) const { return std::min (xPlane, xPlaneN); } + double get_x_max (void) const { return std::max (xPlane, xPlaneN); } + double get_y_min (void) const { return std::min (yPlane, yPlaneN); } + double get_y_max (void) const { return std::max (yPlane, yPlaneN); } + double get_z_min (void) const { return std::min (zPlane, zPlaneN); } + double get_z_max (void) const { return std::max (zPlane, zPlaneN); } + double get_fx (void) const { return fx; } + double get_fy (void) const { return fy; } + double get_fz (void) const { return fz; } + double get_xticklen (void) const { return xticklen; } + double get_yticklen (void) const { return yticklen; } + double get_zticklen (void) const { return zticklen; } + double get_xtickoffset (void) const { return xtickoffset; } + double get_ytickoffset (void) const { return ytickoffset; } + double get_ztickoffset (void) const { return ztickoffset; } + bool get_x2Dtop (void) const { return x2Dtop; } + bool get_y2Dright (void) const { return y2Dright; } + bool get_layer2Dtop (void) const { return layer2Dtop; } + bool get_xySym (void) const { return xySym; } + bool get_xyzSym (void) const { return xyzSym; } + bool get_zSign (void) const { return zSign; } + bool get_nearhoriz (void) const { return nearhoriz; } + + ColumnVector pixel2coord (double px, double py) const + { return get_transform ().untransform (px, py, (x_zlim(0)+x_zlim(1))/2); } + + ColumnVector coord2pixel (double x, double y, double z) const + { return get_transform ().transform (x, y, z); } + + void zoom_about_point (double x, double y, double factor, + bool push_to_zoom_stack = true); + void zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack = true); + void translate_view (double x0, double x1, double y0, double y1); + void rotate_view (double delta_az, double delta_el); + void unzoom (void); + void clear_zoom_stack (void); + + void update_units (const caseless_str& old_units); + + void update_fontunits (const caseless_str& old_fontunits); + + private: + scaler sx, sy, sz; + Matrix x_render, x_render_inv; + Matrix x_gl_mat1, x_gl_mat2; + Matrix x_zlim; + std::list zoom_stack; + + // Axes layout data + int xstate, ystate, zstate; + double xPlane, xPlaneN, yPlane, yPlaneN, zPlane, zPlaneN; + double xpTick, xpTickN, ypTick, ypTickN, zpTick, zpTickN; + double fx, fy, fz; + double xticklen, yticklen, zticklen; + double xtickoffset, ytickoffset, ztickoffset; + bool x2Dtop, y2Dright, layer2Dtop; + bool xySym, xyzSym, zSign, nearhoriz; + +#if HAVE_FREETYPE + // freetype renderer, used for calculation of text (tick labels) size + ft_render text_renderer; +#endif + + void set_text_child (handle_property& h, const std::string& who, + const octave_value& v); + + void delete_text_child (handle_property& h); + + // See the genprops.awk script for an explanation of the + // properties declarations. + + // properties which are not in matlab: interpreter + + BEGIN_PROPERTIES (axes) + array_property position u , default_axes_position () + bool_property box , "on" + array_property colororder , default_colororder () + array_property dataaspectratio mu , Matrix (1, 3, 1.0) + radio_property dataaspectratiomode u , "{auto}|manual" + radio_property layer u , "{bottom}|top" + row_vector_property xlim mu , default_lim () + row_vector_property ylim mu , default_lim () + row_vector_property zlim mu , default_lim () + row_vector_property clim m , default_lim () + row_vector_property alim m , default_lim () + radio_property xlimmode al , "{auto}|manual" + radio_property ylimmode al , "{auto}|manual" + radio_property zlimmode al , "{auto}|manual" + radio_property climmode al , "{auto}|manual" + radio_property alimmode , "{auto}|manual" + handle_property xlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property ylabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property zlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property title SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + bool_property xgrid , "off" + bool_property ygrid , "off" + bool_property zgrid , "off" + bool_property xminorgrid , "off" + bool_property yminorgrid , "off" + bool_property zminorgrid , "off" + row_vector_property xtick mu , default_axes_tick () + row_vector_property ytick mu , default_axes_tick () + row_vector_property ztick mu , default_axes_tick () + radio_property xtickmode u , "{auto}|manual" + radio_property ytickmode u , "{auto}|manual" + radio_property ztickmode u , "{auto}|manual" + bool_property xminortick , "off" + bool_property yminortick , "off" + bool_property zminortick , "off" + // FIXME -- should be kind of string array. + any_property xticklabel m , "" + any_property yticklabel m , "" + any_property zticklabel m , "" + radio_property xticklabelmode u , "{auto}|manual" + radio_property yticklabelmode u , "{auto}|manual" + radio_property zticklabelmode u , "{auto}|manual" + radio_property interpreter , "tex|{none}|latex" + color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) + color_property xcolor , color_values (0, 0, 0) + color_property ycolor , color_values (0, 0, 0) + color_property zcolor , color_values (0, 0, 0) + radio_property xscale alu , "{linear}|log" + radio_property yscale alu , "{linear}|log" + radio_property zscale alu , "{linear}|log" + radio_property xdir u , "{normal}|reverse" + radio_property ydir u , "{normal}|reverse" + radio_property zdir u , "{normal}|reverse" + radio_property yaxislocation u , "{left}|right|zero" + radio_property xaxislocation u , "{bottom}|top|zero" + array_property view u , Matrix () + bool_property __hold_all__ h , "off" + radio_property nextplot , "new|add|replacechildren|{replace}" + array_property outerposition u , default_axes_outerposition () + radio_property activepositionproperty , "{outerposition}|position" + color_property ambientlightcolor , color_values (1, 1, 1) + array_property cameraposition m , Matrix (1, 3, 0.0) + array_property cameratarget m , Matrix (1, 3, 0.0) + array_property cameraupvector m , Matrix () + double_property cameraviewangle m , 10.0 + radio_property camerapositionmode , "{auto}|manual" + radio_property cameratargetmode , "{auto}|manual" + radio_property cameraupvectormode , "{auto}|manual" + radio_property cameraviewanglemode , "{auto}|manual" + array_property currentpoint , Matrix (2, 3, 0.0) + radio_property drawmode , "{normal}|fast" + radio_property fontangle u , "{normal}|italic|oblique" + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 + radio_property fontunits SU , "{points}|normalized|inches|centimeters|pixels" + radio_property fontweight u , "{normal}|light|demi|bold" + radio_property gridlinestyle , "-|--|{:}|-.|none" + string_array_property linestyleorder , "-" + double_property linewidth , 0.5 + radio_property minorgridlinestyle , "-|--|{:}|-.|none" + array_property plotboxaspectratio mu , Matrix (1, 3, 1.0) + radio_property plotboxaspectratiomode u , "{auto}|manual" + radio_property projection , "{orthographic}|perpective" + radio_property tickdir mu , "{in}|out" + radio_property tickdirmode u , "{auto}|manual" + array_property ticklength u , default_axes_ticklength () + array_property tightinset r , Matrix (1, 4, 0.0) + // FIXME -- uicontextmenu should be moved here. + radio_property units SU , "{normalized}|inches|centimeters|points|pixels|characters" + // hidden properties for transformation computation + array_property x_viewtransform h , Matrix (4, 4, 0.0) + array_property x_projectiontransform h , Matrix (4, 4, 0.0) + array_property x_viewporttransform h , Matrix (4, 4, 0.0) + array_property x_normrendertransform h , Matrix (4, 4, 0.0) + array_property x_rendertransform h , Matrix (4, 4, 0.0) + // hidden properties for minor ticks + row_vector_property xmtick h , Matrix () + row_vector_property ymtick h , Matrix () + row_vector_property zmtick h , Matrix () + // hidden properties for inset + array_property looseinset hu , Matrix (1, 4, 0.0) + // hidden properties for alignment of subplots + radio_property autopos_tag h , "{none}|subplot" + END_PROPERTIES + + protected: + void init (void); + + private: + + std::string + get_scale (const std::string& scale, const Matrix& lims) + { + std::string retval = scale; + + if (scale == "log" && lims.numel () > 1 && lims(0) < 0 && lims(1) < 0) + retval = "neglog"; + + return retval; + } + + void update_xscale (void) + { + sx = get_scale (get_xscale (), xlim.get ().matrix_value ()); + } + + void update_yscale (void) + { + sy = get_scale (get_yscale (), ylim.get ().matrix_value ()); + } + + void update_zscale (void) + { + sz = get_scale (get_zscale (), zlim.get ().matrix_value ()); + } + + void update_view (void) { sync_positions (); } + void update_dataaspectratio (void) { sync_positions (); } + void update_dataaspectratiomode (void) { sync_positions (); } + void update_plotboxaspectratio (void) { sync_positions (); } + void update_plotboxaspectratiomode (void) { sync_positions (); } + + void update_layer (void) { update_axes_layout (); } + void update_yaxislocation (void) + { + update_axes_layout (); + update_ylabel_position (); + } + void update_xaxislocation (void) + { + update_axes_layout (); + update_xlabel_position (); + } + + void update_xdir (void) { update_camera (); update_axes_layout (); } + void update_ydir (void) { update_camera (); update_axes_layout (); } + void update_zdir (void) { update_camera (); update_axes_layout (); } + + void update_ticklength (void); + void update_tickdir (void) { update_ticklength (); } + void update_tickdirmode (void) { update_ticklength (); } + + void update_xtick (void) + { + if (xticklabelmode.is ("auto")) + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + } + void update_ytick (void) + { + if (yticklabelmode.is ("auto")) + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + } + void update_ztick (void) + { + if (zticklabelmode.is ("auto")) + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + } + + void update_xtickmode (void) + { + if (xtickmode.is ("auto")) + { + calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); + update_xtick (); + } + } + void update_ytickmode (void) + { + if (ytickmode.is ("auto")) + { + calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); + update_ytick (); + } + } + void update_ztickmode (void) + { + if (ztickmode.is ("auto")) + { + calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); + update_ztick (); + } + } + + void update_xticklabelmode (void) + { + if (xticklabelmode.is ("auto")) + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + } + void update_yticklabelmode (void) + { + if (yticklabelmode.is ("auto")) + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + } + void update_zticklabelmode (void) + { + if (zticklabelmode.is ("auto")) + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + } + + void update_font (void); + void update_fontname (void) { update_font (); } + void update_fontsize (void) { update_font (); } + void update_fontangle (void) { update_font (); } + void update_fontweight (void) { update_font (); } + + void sync_positions (const Matrix& linset); + void sync_positions (void); + + void update_outerposition (void) + { + set_activepositionproperty ("outerposition"); + sync_positions (); + } + + void update_position (void) + { + set_activepositionproperty ("position"); + sync_positions (); + } + + void update_looseinset (void) { sync_positions (); } + + double calc_tick_sep (double minval, double maxval); + void calc_ticks_and_lims (array_property& lims, array_property& ticks, array_property& mticks, + bool limmode_is_auto, bool is_logscale); + void calc_ticklabels (const array_property& ticks, any_property& labels, bool is_logscale); + Matrix get_ticklabel_extents (const Matrix& ticks, + const string_vector& ticklabels, + const Matrix& limits); + + void fix_limits (array_property& lims) + { + if (lims.get ().is_empty ()) + return; + + Matrix l = lims.get ().matrix_value (); + if (l(0) > l(1)) + { + l(0) = 0; + l(1) = 1; + lims = l; + } + else if (l(0) == l(1)) + { + l(0) -= 0.5; + l(1) += 0.5; + lims = l; + } + } + + Matrix calc_tightbox (const Matrix& init_pos); + + public: + Matrix get_axis_limits (double xmin, double xmax, + double min_pos, double max_neg, + bool logscale); + + void update_xlim (bool do_clr_zoom = true) + { + if (xtickmode.is ("auto")) + calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); + if (xticklabelmode.is ("auto")) + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + + fix_limits (xlim); + + update_xscale (); + + if (do_clr_zoom) + zoom_stack.clear (); + + update_axes_layout (); + } + + void update_ylim (bool do_clr_zoom = true) + { + if (ytickmode.is ("auto")) + calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); + if (yticklabelmode.is ("auto")) + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + + fix_limits (ylim); + + update_yscale (); + + if (do_clr_zoom) + zoom_stack.clear (); + + update_axes_layout (); + } + + void update_zlim (void) + { + if (ztickmode.is ("auto")) + calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); + if (zticklabelmode.is ("auto")) + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + + fix_limits (zlim); + + update_zscale (); + + zoom_stack.clear (); + + update_axes_layout (); + } + + }; + +private: + properties xproperties; + +public: + axes (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p), default_properties () + { + xproperties.override_defaults (*this); + xproperties.update_transform (); + } + + ~axes (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Allow parent (figure) to override first (properties knows how + // to find the parent object). + xproperties.override_defaults (obj); + + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + void set_defaults (const std::string& mode) + { + remove_all_listeners (); + xproperties.set_defaults (*this, mode); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + // FIXME -- finish this. + if (name.compare ("default", 7)) + retval = get_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const; + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + void update_axis_limits (const std::string& axis_type); + + void update_axis_limits (const std::string& axis_type, + const graphics_handle& h); + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +protected: + void initialize (const graphics_object& go); + +private: + property_list default_properties; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API line : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + // properties which are not in matlab: interpreter + + BEGIN_PROPERTIES (line) + row_vector_property xdata u , default_data () + row_vector_property ydata u , default_data () + row_vector_property zdata u , Matrix () + string_property xdatasource , "" + string_property ydatasource , "" + string_property zdatasource , "" + color_property color , color_values (0, 0, 0) + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" + color_property markeredgecolor , "{auto}|none" + color_property markerfacecolor , "auto|{none}" + double_property markersize , 6 + radio_property interpreter , "{tex}|none|latex" + string_property displayname , "" + radio_property erasemode , "{normal}|none|xor|background" + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property zliminclude hl , "off" + END_PROPERTIES + + private: + Matrix compute_xlim (void) const; + Matrix compute_ylim (void) const; + + void update_xdata (void) { set_xlim (compute_xlim ()); } + + void update_ydata (void) { set_ylim (compute_ylim ()); } + + void update_zdata (void) + { + set_zlim (zdata.get_limits ()); + set_zliminclude (get_zdata ().numel () > 0); + } + }; + +private: + properties xproperties; + +public: + line (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~line (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API text : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + double get_fontsize_points (double box_pix_height = 0) const; + + void set_position (const octave_value& val) + { + if (! error_state) + { + octave_value new_val (val); + + if (new_val.numel () == 2) + { + dim_vector dv (1, 3); + + new_val = new_val.resize (dv, true); + } + + if (position.set (new_val, false)) + { + set_positionmode ("manual"); + update_position (); + position.run_listeners (POSTSET); + mark_modified (); + } + else + set_positionmode ("manual"); + } + } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (text) + text_label_property string u , "" + radio_property units u , "{data}|pixels|normalized|inches|centimeters|points" + array_property position smu , Matrix (1, 3, 0.0) + double_property rotation mu , 0 + radio_property horizontalalignment mu , "{left}|center|right" + color_property color u , color_values (0, 0, 0) + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 + radio_property fontangle u , "{normal}|italic|oblique" + radio_property fontweight u , "light|{normal}|demi|bold" + radio_property interpreter u , "{tex}|none|latex" + color_property backgroundcolor , "{none}" + string_property displayname , "" + color_property edgecolor , "{none}" + radio_property erasemode , "{normal}|none|xor|background" + bool_property editing , "off" + radio_property fontunits , "inches|centimeters|normalized|{points}|pixels" + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + double_property margin , 1 + radio_property verticalalignment mu , "top|cap|{middle}|baseline|bottom" + array_property extent rG , Matrix (1, 4, 0.0) + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + bool_property xliminclude hl , "off" + bool_property yliminclude hl , "off" + bool_property zliminclude hl , "off" + // hidden properties for auto-positioning + radio_property positionmode hu , "{auto}|manual" + radio_property rotationmode hu , "{auto}|manual" + radio_property horizontalalignmentmode hu , "{auto}|manual" + radio_property verticalalignmentmode hu , "{auto}|manual" + radio_property autopos_tag h , "{none}|xlabel|ylabel|zlabel|title" + END_PROPERTIES + + Matrix get_data_position (void) const; + Matrix get_extent_matrix (void) const; + const uint8NDArray& get_pixels (void) const { return pixels; } +#if HAVE_FREETYPE + // freetype renderer, used for calculation of text size + ft_render renderer; +#endif + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 3)); + cached_units = get_units (); + update_font (); + } + + private: + void update_position (void) + { + Matrix pos = get_data_position (); + Matrix lim; + + lim = Matrix (1, 3, pos(0)); + lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); + set_xlim (lim); + + lim = Matrix (1, 3, pos(1)); + lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); + set_ylim (lim); + + if (pos.numel () == 3) + { + lim = Matrix (1, 3, pos(2)); + lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); + set_zliminclude ("on"); + set_zlim (lim); + } + else + set_zliminclude ("off"); + } + + void update_text_extent (void); + + void request_autopos (void); + void update_positionmode (void) { request_autopos (); } + void update_rotationmode (void) { request_autopos (); } + void update_horizontalalignmentmode (void) { request_autopos (); } + void update_verticalalignmentmode (void) { request_autopos (); } + + void update_font (void); + void update_string (void) { request_autopos (); update_text_extent (); } + void update_rotation (void) { update_text_extent (); } + void update_color (void) { update_font (); } + void update_fontname (void) { update_font (); update_text_extent (); } + void update_fontsize (void) { update_font (); update_text_extent (); } + void update_fontangle (void) { update_font (); update_text_extent (); } + void update_fontweight (void) { update_font (); update_text_extent (); } + void update_interpreter (void) { update_text_extent (); } + void update_horizontalalignment (void) { update_text_extent (); } + void update_verticalalignment (void) { update_text_extent (); } + + void update_units (void); + + private: + std::string cached_units; + uint8NDArray pixels; + }; + +private: + properties xproperties; + +public: + text (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.set_clipping ("off"); + xproperties.override_defaults (*this); + } + + ~text (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API image : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + bool is_climinclude (void) const + { return (climinclude.is_on () && cdatamapping.is ("scaled")); } + std::string get_climinclude (void) const + { return climinclude.current_value (); } + + octave_value get_color_data (void) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (image) + row_vector_property xdata u , Matrix () + row_vector_property ydata u , Matrix () + array_property cdata u , Matrix () + radio_property cdatamapping al , "{scaled}|direct" + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property clim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property climinclude hlg , "on" + END_PROPERTIES + + protected: + void init (void) + { + xdata.add_constraint (2); + ydata.add_constraint (2); + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("logical"); + cdata.add_constraint ("uint8"); + cdata.add_constraint ("uint16"); + cdata.add_constraint ("int16"); + cdata.add_constraint ("real"); + cdata.add_constraint (dim_vector (-1, -1)); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + + private: + void update_xdata (void) + { + Matrix limits = xdata.get_limits (); + float dp = pixel_xsize (); + + limits(0) = limits(0) - dp; + limits(1) = limits(1) + dp; + set_xlim (limits); + } + + void update_ydata (void) + { + Matrix limits = ydata.get_limits (); + float dp = pixel_ysize (); + + limits(0) = limits(0) - dp; + limits(1) = limits(1) + dp; + set_ylim (limits); + } + + void update_cdata (void) + { + if (cdatamapping_is ("scaled")) + set_clim (cdata.get_limits ()); + else + clim = cdata.get_limits (); + } + + float pixel_size (octave_idx_type dim, const Matrix limits) + { + octave_idx_type l = dim - 1; + float dp; + + if (l > 0 && limits(0) != limits(1)) + dp = (limits(1) - limits(0))/(2*l); + else + { + if (limits(1) == limits(2)) + dp = 0.5; + else + dp = (limits(1) - limits(0))/2; + } + return dp; + } + + public: + float pixel_xsize (void) + { + return pixel_size ((get_cdata ().dims ())(1), xdata.get_limits ()); + } + + float pixel_ysize (void) + { + return pixel_size ((get_cdata ().dims ())(0), ydata.get_limits ()); + } + }; + +private: + properties xproperties; + +public: + image (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~image (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API patch : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + octave_value get_color_data (void) const; + + bool is_climinclude (void) const + { return (climinclude.is_on () && cdatamapping.is ("scaled")); } + std::string get_climinclude (void) const + { return climinclude.current_value (); } + + bool is_aliminclude (void) const + { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } + std::string get_aliminclude (void) const + { return aliminclude.current_value (); } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (patch) + array_property xdata u , Matrix () + array_property ydata u , Matrix () + array_property zdata u , Matrix () + array_property cdata u , Matrix () + radio_property cdatamapping l , "{scaled}|direct" + array_property faces , Matrix () + array_property facevertexalphadata , Matrix () + array_property facevertexcdata , Matrix () + array_property vertices , Matrix () + array_property vertexnormals , Matrix () + radio_property normalmode , "{auto}|manual" + color_property facecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) + double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) + radio_property facelighting , "flat|{none}|gouraud|phong" + color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) + double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) + radio_property edgelighting , "{none}|flat|gouraud|phong" + radio_property backfacelighting , "{reverselit}|unlit|lit" + double_property ambientstrength , 0.3 + double_property diffusestrength , 0.6 + double_property specularstrength , 0.6 + double_property specularexponent , 10.0 + double_property specularcolorreflectance , 1.0 + radio_property erasemode , "{normal}|background|xor|none" + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" + color_property markeredgecolor , "{auto}|none|flat" + color_property markerfacecolor , "auto|{none}|flat" + double_property markersize , 6 + radio_property interpreter , "{tex}|none|latex" + string_property displayname , "" + radio_property alphadatamapping l , "none|{scaled}|direct" + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + row_vector_property clim hlr , Matrix () + row_vector_property alim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property zliminclude hl , "on" + bool_property climinclude hlg , "on" + bool_property aliminclude hlg , "on" + END_PROPERTIES + + protected: + void init (void) + { + xdata.add_constraint (dim_vector (-1, -1)); + ydata.add_constraint (dim_vector (-1, -1)); + zdata.add_constraint (dim_vector (-1, -1)); + vertices.add_constraint (dim_vector (-1, 2)); + vertices.add_constraint (dim_vector (-1, 3)); + cdata.add_constraint (dim_vector (-1, -1)); + cdata.add_constraint (dim_vector (-1, -1, 3)); + facevertexcdata.add_constraint (dim_vector (-1, 1)); + facevertexcdata.add_constraint (dim_vector (-1, 3)); + facevertexalphadata.add_constraint (dim_vector (-1, 1)); + } + + private: + void update_xdata (void) { set_xlim (xdata.get_limits ()); } + void update_ydata (void) { set_ylim (ydata.get_limits ()); } + void update_zdata (void) { set_zlim (zdata.get_limits ()); } + + void update_cdata (void) + { + if (cdatamapping_is ("scaled")) + set_clim (cdata.get_limits ()); + else + clim = cdata.get_limits (); + } + }; + +private: + properties xproperties; + +public: + patch (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~patch (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API surface : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + octave_value get_color_data (void) const; + + bool is_climinclude (void) const + { return (climinclude.is_on () && cdatamapping.is ("scaled")); } + std::string get_climinclude (void) const + { return climinclude.current_value (); } + + bool is_aliminclude (void) const + { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } + std::string get_aliminclude (void) const + { return aliminclude.current_value (); } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (surface) + array_property xdata u , Matrix () + array_property ydata u , Matrix () + array_property zdata u , Matrix () + array_property cdata u , Matrix () + radio_property cdatamapping al , "{scaled}|direct" + string_property xdatasource , "" + string_property ydatasource , "" + string_property zdatasource , "" + string_property cdatasource , "" + color_property facecolor , "{flat}|none|interp|texturemap" + double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) + color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" + color_property markeredgecolor , "{auto}|none" + color_property markerfacecolor , "auto|{none}" + double_property markersize , 6 + radio_property interpreter , "{tex}|none|latex" + string_property displayname , "" + array_property alphadata u , Matrix () + radio_property alphadatamapping l , "none|direct|{scaled}" + double_property ambientstrength , 0.3 + radio_property backfacelighting , "unlit|lit|{reverselit}" + double_property diffusestrength , 0.6 + double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) + radio_property edgelighting , "{none}|flat|gouraud|phong" + radio_property erasemode , "{normal}|none|xor|background" + radio_property facelighting , "{none}|flat|gouraud|phong" + radio_property meshstyle , "{both}|row|column" + radio_property normalmode u , "{auto}|manual" + double_property specularcolorreflectance , 1 + double_property specularexponent , 10 + double_property specularstrength , 0.9 + array_property vertexnormals u , Matrix () + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + row_vector_property clim hlr , Matrix () + row_vector_property alim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property zliminclude hl , "on" + bool_property climinclude hlg , "on" + bool_property aliminclude hlg , "on" + END_PROPERTIES + + protected: + void init (void) + { + xdata.add_constraint (dim_vector (-1, -1)); + ydata.add_constraint (dim_vector (-1, -1)); + zdata.add_constraint (dim_vector (-1, -1)); + alphadata.add_constraint ("single"); + alphadata.add_constraint ("double"); + alphadata.add_constraint ("uint8"); + alphadata.add_constraint (dim_vector (-1, -1)); + vertexnormals.add_constraint (dim_vector (-1, -1, 3)); + cdata.add_constraint ("single"); + cdata.add_constraint ("double"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1)); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + + private: + void update_normals (void); + + void update_xdata (void) + { + update_normals (); + set_xlim (xdata.get_limits ()); + } + + void update_ydata (void) + { + update_normals (); + set_ylim (ydata.get_limits ()); + } + + void update_zdata (void) + { + update_normals (); + set_zlim (zdata.get_limits ()); + } + + void update_cdata (void) + { + if (cdatamapping_is ("scaled")) + set_clim (cdata.get_limits ()); + else + clim = cdata.get_limits (); + } + + void update_alphadata (void) + { + if (alphadatamapping_is ("scaled")) + set_alim (alphadata.get_limits ()); + else + alim = alphadata.get_limits (); + } + + void update_normalmode (void) + { update_normals (); } + + void update_vertexnormals (void) + { set_normalmode ("manual"); } + }; + +private: + properties xproperties; + +public: + surface (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~surface (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API hggroup : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void remove_child (const graphics_handle& h) + { + base_properties::remove_child (h); + update_limits (); + } + + void adopt (const graphics_handle& h) + { + + base_properties::adopt (h); + update_limits (h); + } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (hggroup) + // hidden properties for limit computation + row_vector_property xlim hr , Matrix () + row_vector_property ylim hr , Matrix () + row_vector_property zlim hr , Matrix () + row_vector_property clim hr , Matrix () + row_vector_property alim hr , Matrix () + bool_property xliminclude h , "on" + bool_property yliminclude h , "on" + bool_property zliminclude h , "on" + bool_property climinclude h , "on" + bool_property aliminclude h , "on" + END_PROPERTIES + + private: + void update_limits (void) const; + + void update_limits (const graphics_handle& h) const; + + protected: + void init (void) + { } + + }; + +private: + properties xproperties; + +public: + hggroup (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~hggroup (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void update_axis_limits (const std::string& axis_type); + + void update_axis_limits (const std::string& axis_type, + const graphics_handle& h); + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uimenu : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void remove_child (const graphics_handle& h) + { + base_properties::remove_child (h); + } + + void adopt (const graphics_handle& h) + { + base_properties::adopt (h); + } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uimenu) + any_property __object__ , Matrix () + string_property accelerator , "" + callback_property callback , Matrix () + bool_property checked , "off" + bool_property enable , "on" + color_property foregroundcolor , color_values (0, 0, 0) + string_property label , "" + double_property position , 9 + bool_property separator , "off" + string_property fltk_label h , "" + END_PROPERTIES + + protected: + void init (void) + { } + }; + +private: + properties xproperties; + +public: + uimenu (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uimenu (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uicontextmenu : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uicontextmenu) + any_property __object__ , Matrix () + callback_property callback , Matrix () + array_property position , Matrix (1, 2, 0.0) + END_PROPERTIES + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 2)); + position.add_constraint (dim_vector (2, 1)); + visible.set (octave_value (true)); + } + }; + +private: + properties xproperties; + +public: + uicontextmenu (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uicontextmenu (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uicontrol : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uicontrol) + any_property __object__ , Matrix () + color_property backgroundcolor , color_values (1, 1, 1) + callback_property callback , Matrix () + array_property cdata , Matrix () + bool_property clipping , "on" + radio_property enable , "{on}|inactive|off" + array_property extent rG , Matrix (1, 4, 0.0) + radio_property fontangle u , "{normal}|italic|oblique" + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 + radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" + radio_property fontweight u , "light|{normal}|demi|bold" + color_property foregroundcolor , color_values (0, 0, 0) + radio_property horizontalalignment , "{left}|center|right" + callback_property keypressfcn , Matrix () + double_property listboxtop , 1 + double_property max , 1 + double_property min , 0 + array_property position , default_control_position () + array_property sliderstep , default_control_sliderstep () + string_array_property string u , "" + radio_property style S , "{pushbutton}|togglebutton|radiobutton|checkbox|edit|text|slider|frame|listbox|popupmenu" + string_property tooltipstring , "" + radio_property units u , "normalized|inches|centimeters|points|{pixels}|characters" + row_vector_property value , Matrix (1, 1, 1.0) + radio_property verticalalignment , "top|{middle}|bottom" + END_PROPERTIES + + private: + std::string cached_units; + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + position.add_constraint (dim_vector (1, 4)); + sliderstep.add_constraint (dim_vector (1, 2)); + cached_units = get_units (); + } + + void update_text_extent (void); + + void update_string (void) { update_text_extent (); } + void update_fontname (void) { update_text_extent (); } + void update_fontsize (void) { update_text_extent (); } + void update_fontangle (void) { update_text_extent (); } + void update_fontweight (void) { update_text_extent (); } + void update_fontunits (const caseless_str& old_units); + + void update_units (void); + + }; + +private: + properties xproperties; + +public: + uicontrol (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uicontrol (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uipanel : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uipanel) + any_property __object__ , Matrix () + color_property backgroundcolor , color_values (1, 1, 1) + radio_property bordertype , "none|{etchedin}|etchedout|beveledin|beveledout|line" + double_property borderwidth , 1 + radio_property fontangle , "{normal}|italic|oblique" + string_property fontname , OCTAVE_DEFAULT_FONTNAME + double_property fontsize , 10 + radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" + radio_property fontweight , "light|{normal}|demi|bold" + color_property foregroundcolor , color_values (0, 0, 0) + color_property highlightcolor , color_values (1, 1, 1) + array_property position , default_panel_position () + callback_property resizefcn , Matrix () + color_property shadowcolor , color_values (0, 0, 0) + string_property title , "" + radio_property titleposition , "{lefttop}|centertop|righttop|leftbottom|centerbottom|rightbottom" + radio_property units S , "{normalized}|inches|centimeters|points|pixels|characters" + END_PROPERTIES + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 4)); + } + + void update_units (const caseless_str& old_units); + void update_fontunits (const caseless_str& old_units); + + }; + +private: + properties xproperties; + +public: + uipanel (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uipanel (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uitoolbar : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uitoolbar) + any_property __object__ , Matrix () + END_PROPERTIES + + protected: + void init (void) + { } + }; + +private: + properties xproperties; + +public: + uitoolbar (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p), default_properties () + { + xproperties.override_defaults (*this); + } + + ~uitoolbar (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Allow parent (figure) to override first (properties knows how + // to find the parent object). + xproperties.override_defaults (obj); + + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + if (name.compare ("default", 7)) + retval = get_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const; + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +private: + property_list default_properties; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uipushtool : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uipushtool) + any_property __object__ , Matrix () + array_property cdata , Matrix () + callback_property clickedcallback , Matrix () + bool_property enable , "on" + bool_property separator , "off" + string_property tooltipstring , "" + END_PROPERTIES + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + }; + +private: + properties xproperties; + +public: + uipushtool (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uipushtool (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uitoggletool : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uitoggletool) + any_property __object__ , Matrix () + array_property cdata , Matrix () + callback_property clickedcallback , Matrix () + bool_property enable , "on" + callback_property offcallback , Matrix () + callback_property oncallback , Matrix () + bool_property separator , "off" + bool_property state , "off" + string_property tooltipstring , "" + END_PROPERTIES + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + }; + +private: + properties xproperties; + +public: + uitoggletool (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uitoggletool (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +octave_value +get_property_from_handle (double handle, const std::string &property, + const std::string &func); +bool +set_property_in_handle (double handle, const std::string &property, + const octave_value &arg, const std::string &func); + +// --------------------------------------------------------------------- + +class graphics_event; + +class +base_graphics_event +{ +public: + friend class graphics_event; + + base_graphics_event (void) : count (1) { } + + virtual ~base_graphics_event (void) { } + + virtual void execute (void) = 0; + +private: + octave_refcount count; +}; + +class +graphics_event +{ +public: + typedef void (*event_fcn) (void*); + + graphics_event (void) : rep (0) { } + + graphics_event (const graphics_event& e) : rep (e.rep) + { + rep->count++; + } + + ~graphics_event (void) + { + if (rep && --rep->count == 0) + delete rep; + } + + graphics_event& operator = (const graphics_event& e) + { + if (rep != e.rep) + { + if (rep && --rep->count == 0) + delete rep; + + rep = e.rep; + if (rep) + rep->count++; + } + + return *this; + } + + void execute (void) + { if (rep) rep->execute (); } + + bool ok (void) const + { return (rep != 0); } + + static graphics_event + create_callback_event (const graphics_handle& h, + const std::string& name, + const octave_value& data = Matrix ()); + + static graphics_event + create_callback_event (const graphics_handle& h, + const octave_value& cb, + const octave_value& data = Matrix ()); + + static graphics_event + create_function_event (event_fcn fcn, void *data = 0); + + static graphics_event + create_set_event (const graphics_handle& h, const std::string& name, + const octave_value& value, + bool notify_toolkit = true); +private: + base_graphics_event *rep; +}; + +class OCTINTERP_API gh_manager +{ +protected: + + gh_manager (void); + +public: + + static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create gh_manager!"); + + retval = false; + } + + return retval; + } + + static void cleanup_instance (void) { delete instance; instance = 0; } + + static graphics_handle get_handle (bool integer_figure_handle) + { + return instance_ok () + ? instance->do_get_handle (integer_figure_handle) : graphics_handle (); + } + + static void free (const graphics_handle& h) + { + if (instance_ok ()) + instance->do_free (h); + } + + static void renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh) + { + if (instance_ok ()) + instance->do_renumber_figure (old_gh, new_gh); + } + + static graphics_handle lookup (double val) + { + return instance_ok () ? instance->do_lookup (val) : graphics_handle (); + } + + static graphics_handle lookup (const octave_value& val) + { + return val.is_real_scalar () + ? lookup (val.double_value ()) : graphics_handle (); + } + + static graphics_object get_object (double val) + { + return get_object (lookup (val)); + } + + static graphics_object get_object (const graphics_handle& h) + { + return instance_ok () ? instance->do_get_object (h) : graphics_object (); + } + + static graphics_handle + make_graphics_handle (const std::string& go_name, + const graphics_handle& parent, + bool integer_figure_handle = false, + bool do_createfcn = true, + bool do_notify_toolkit = true) + { + return instance_ok () + ? instance->do_make_graphics_handle (go_name, parent, + integer_figure_handle, + do_createfcn, do_notify_toolkit) + : graphics_handle (); + } + + static graphics_handle make_figure_handle (double val, + bool do_notify_toolkit = true) + { + return instance_ok () + ? instance->do_make_figure_handle (val, do_notify_toolkit) + : graphics_handle (); + } + + static void push_figure (const graphics_handle& h) + { + if (instance_ok ()) + instance->do_push_figure (h); + } + + static void pop_figure (const graphics_handle& h) + { + if (instance_ok ()) + instance->do_pop_figure (h); + } + + static graphics_handle current_figure (void) + { + return instance_ok () + ? instance->do_current_figure () : graphics_handle (); + } + + static Matrix handle_list (bool show_hidden = false) + { + return instance_ok () + ? instance->do_handle_list (show_hidden) : Matrix (); + } + + static void lock (void) + { + if (instance_ok ()) + instance->do_lock (); + } + + static bool try_lock (void) + { + if (instance_ok ()) + return instance->do_try_lock (); + else + return false; + } + + static void unlock (void) + { + if (instance_ok ()) + instance->do_unlock (); + } + + static Matrix figure_handle_list (bool show_hidden = false) + { + return instance_ok () + ? instance->do_figure_handle_list (show_hidden) : Matrix (); + } + + static void execute_listener (const graphics_handle& h, + const octave_value& l) + { + if (instance_ok ()) + instance->do_execute_listener (h, l); + } + + static void execute_callback (const graphics_handle& h, + const std::string& name, + const octave_value& data = Matrix ()) + { + octave_value cb; + + if (true) + { + gh_manager::auto_lock lock; + + graphics_object go = get_object (h); + + if (go.valid_object ()) + cb = go.get (name); + } + + if (! error_state) + execute_callback (h, cb, data); + } + + static void execute_callback (const graphics_handle& h, + const octave_value& cb, + const octave_value& data = Matrix ()) + { + if (instance_ok ()) + instance->do_execute_callback (h, cb, data); + } + + static void post_callback (const graphics_handle& h, + const std::string& name, + const octave_value& data = Matrix ()) + { + if (instance_ok ()) + instance->do_post_callback (h, name, data); + } + + static void post_function (graphics_event::event_fcn fcn, void* data = 0) + { + if (instance_ok ()) + instance->do_post_function (fcn, data); + } + + static void post_set (const graphics_handle& h, const std::string& name, + const octave_value& value, bool notify_toolkit = true) + { + if (instance_ok ()) + instance->do_post_set (h, name, value, notify_toolkit); + } + + static int process_events (void) + { + return (instance_ok () ? instance->do_process_events () : 0); + } + + static int flush_events (void) + { + return (instance_ok () ? instance->do_process_events (true) : 0); + } + + static void enable_event_processing (bool enable = true) + { + if (instance_ok ()) + instance->do_enable_event_processing (enable); + } + + static bool is_handle_visible (const graphics_handle& h) + { + bool retval = false; + + graphics_object go = get_object (h); + + if (go.valid_object ()) + retval = go.is_handle_visible (); + + return retval; + } + + static void close_all_figures (void) + { + if (instance_ok ()) + instance->do_close_all_figures (); + } + +public: + class auto_lock : public octave_autolock + { + public: + auto_lock (bool wait = true) + : octave_autolock (instance_ok () + ? instance->graphics_lock + : octave_mutex (), + wait) + { } + + private: + + // No copying! + auto_lock (const auto_lock&); + auto_lock& operator = (const auto_lock&); + }; + +private: + + static gh_manager *instance; + + typedef std::map::iterator iterator; + typedef std::map::const_iterator const_iterator; + + typedef std::set::iterator free_list_iterator; + typedef std::set::const_iterator const_free_list_iterator; + + typedef std::list::iterator figure_list_iterator; + typedef std::list::const_iterator const_figure_list_iterator; + + // A map of handles to graphics objects. + std::map handle_map; + + // The available graphics handles. + std::set handle_free_list; + + // The next handle available if handle_free_list is empty. + double next_handle; + + // The allocated figure handles. Top of the stack is most recently + // created. + std::list figure_list; + + // The lock for accessing the graphics sytsem. + octave_mutex graphics_lock; + + // The list of events queued by graphics toolkits. + std::list event_queue; + + // The stack of callback objects. + std::list callback_objects; + + // A flag telling whether event processing must be constantly on. + int event_processing; + + graphics_handle do_get_handle (bool integer_figure_handle); + + void do_free (const graphics_handle& h); + + void do_renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh); + + graphics_handle do_lookup (double val) + { + iterator p = (xisnan (val) ? handle_map.end () : handle_map.find (val)); + + return (p != handle_map.end ()) ? p->first : graphics_handle (); + } + + graphics_object do_get_object (const graphics_handle& h) + { + iterator p = (h.ok () ? handle_map.find (h) : handle_map.end ()); + + return (p != handle_map.end ()) ? p->second : graphics_object (); + } + + graphics_handle do_make_graphics_handle (const std::string& go_name, + const graphics_handle& p, + bool integer_figure_handle, + bool do_createfcn, + bool do_notify_toolkit); + + graphics_handle do_make_figure_handle (double val, bool do_notify_toolkit); + + Matrix do_handle_list (bool show_hidden) + { + Matrix retval (1, handle_map.size ()); + + octave_idx_type i = 0; + for (const_iterator p = handle_map.begin (); p != handle_map.end (); p++) + { + graphics_handle h = p->first; + + if (show_hidden || is_handle_visible (h)) + retval(i++) = h.value (); + } + + retval.resize (1, i); + + return retval; + } + + Matrix do_figure_handle_list (bool show_hidden) + { + Matrix retval (1, figure_list.size ()); + + octave_idx_type i = 0; + for (const_figure_list_iterator p = figure_list.begin (); + p != figure_list.end (); + p++) + { + graphics_handle h = *p; + + if (show_hidden || is_handle_visible (h)) + retval(i++) = h.value (); + } + + retval.resize (1, i); + + return retval; + } + + void do_push_figure (const graphics_handle& h); + + void do_pop_figure (const graphics_handle& h); + + graphics_handle do_current_figure (void) const + { + graphics_handle retval; + + for (const_figure_list_iterator p = figure_list.begin (); + p != figure_list.end (); + p++) + { + graphics_handle h = *p; + + if (is_handle_visible (h)) + retval = h; + } + + return retval; + } + + void do_lock (void) { graphics_lock.lock (); } + + bool do_try_lock (void) { return graphics_lock.try_lock (); } + + void do_unlock (void) { graphics_lock.unlock (); } + + void do_execute_listener (const graphics_handle& h, const octave_value& l); + + void do_execute_callback (const graphics_handle& h, const octave_value& cb, + const octave_value& data); + + void do_post_callback (const graphics_handle& h, const std::string name, + const octave_value& data); + + void do_post_function (graphics_event::event_fcn fcn, void* fcn_data); + + void do_post_set (const graphics_handle& h, const std::string name, + const octave_value& value, bool notify_toolkit = true); + + int do_process_events (bool force = false); + + void do_close_all_figures (void); + + static void restore_gcbo (void) + { + if (instance_ok ()) + instance->do_restore_gcbo (); + } + + void do_restore_gcbo (void); + + void do_post_event (const graphics_event& e); + + void do_enable_event_processing (bool enable = true); +}; + +void get_children_limits (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const Matrix& kids, char limit_type); + +OCTINTERP_API int calc_dimensions (const graphics_object& gh); + +// This function is NOT equivalent to the scripting language function gcf. +OCTINTERP_API graphics_handle gcf (void); + +// This function is NOT equivalent to the scripting language function gca. +OCTINTERP_API graphics_handle gca (void); + +OCTINTERP_API void close_all_figures (void); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/help.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/help.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1405 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "str-vec.h" + +#include +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "help.h" +#include "input.h" +#include "load-path.h" +#include "oct-obj.h" +#include "ov-usr-fcn.h" +#include "pager.h" +#include "parse.h" +#include "pathsearch.h" +#include "procstream.h" +#include "pt-pr-code.h" +#include "sighandlers.h" +#include "symtab.h" +#include "syswait.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "quit.h" + +// Name of the doc cache file specified on the command line. +// (--doc-cache-file file) +std::string Vdoc_cache_file; + +// Name of the file containing local Texinfo macros that are prepended +// to doc strings before processing. +// (--texi-macros-file) +std::string Vtexi_macros_file; + +// Name of the info file specified on command line. +// (--info-file file) +std::string Vinfo_file; + +// Name of the info reader we'd like to use. +// (--info-program program) +std::string Vinfo_program; + +// Name of the makeinfo program to run. +static std::string Vmakeinfo_program = "makeinfo"; + +// If TRUE, don't print additional help message in help and usage +// functions. +static bool Vsuppress_verbose_help_message = false; + +#include + +typedef std::map map_type; +typedef map_type::value_type pair_type; +typedef map_type::const_iterator map_iter; + +template +std::size_t +size (T const (&)[z]) +{ + return z; +} + +const static pair_type operators[] = +{ + pair_type ("!", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} !\n\ +Logical 'not' operator.\n\ +@seealso{~, not}\n\ +@end deftypefn"), + + pair_type ("~", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ~\n\ +Logical 'not' operator.\n\ +@seealso{!, not}\n\ +@end deftypefn"), + + pair_type ("!=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} !=\n\ +Logical 'not equals' operator.\n\ +@seealso{~=, ne}\n\ +@end deftypefn"), + + pair_type ("~=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ~=\n\ +Logical 'not equals' operator.\n\ +@seealso{!=, ne}\n\ +@end deftypefn"), + + pair_type ("\"", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} \"\n\ +String delimiter.\n\ +@end deftypefn"), + + pair_type ("#", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #\n\ +Begin comment character.\n\ +@seealso{%, #@\\{}\n\ +@end deftypefn"), + + pair_type ("%", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %\n\ +Begin comment character.\n\ +@seealso{#, %@\\{}\n\ +@end deftypefn"), + + pair_type ("#{", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #@{\n\ +Begin block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{#@{}.\n\ +It is possible to nest block comments.\n\ +@seealso{%@\\{, #@\\}, #}\n\ +@end deftypefn"), + + pair_type ("%{", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %@{\n\ +Begin block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{%@{}.\n\ +It is possible to nest block comments.\n\ +@seealso{#@\\{, %@\\}, %}\n\ +@end deftypefn"), + + pair_type ("#}", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #@}\n\ +Close block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{#@}}.\n\ +It is possible to nest block comments.\n\ +@seealso{%@\\}, #@\\{, #}\n\ +@end deftypefn"), + + pair_type ("%}", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %@}\n\ +Close block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{%@}}.\n\ +It is possible to nest block comments.\n\ +@seealso{#@\\}, %@\\{, %}\n\ +@end deftypefn"), + + pair_type ("...", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ...\n\ +Continuation marker. Joins current line with following line.\n\ +@end deftypefn"), + + pair_type ("&", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} &\n\ +Element by element logical 'and' operator.\n\ +@seealso{&&, and}\n\ +@end deftypefn"), + + pair_type ("&&", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} &&\n\ +Logical 'and' operator (with short-circuit evaluation).\n\ +@seealso{&, and}\n\ +@end deftypefn"), + + pair_type ("'", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} '\n\ +Matrix transpose operator. For complex matrices, computes the\n\ +complex conjugate (Hermitian) transpose.\n\ +\n\ +The single quote character may also be used to delimit strings, but\n\ +it is better to use the double quote character, since that is never\n\ +ambiguous.\n\ +@seealso{.', transpose}\n\ +@end deftypefn"), + + pair_type ("(", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} (\n\ +Array index or function argument delimiter.\n\ +@end deftypefn"), + + pair_type (")", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} )\n\ +Array index or function argument delimiter.\n\ +@end deftypefn"), + + pair_type ("*", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} *\n\ +Multiplication operator.\n\ +@seealso{.*, times}\n\ +@end deftypefn"), + + pair_type ("**", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} **\n\ +Power operator. This may return complex results for real inputs. Use\n\ +@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ +real results when possible.\n\ +@seealso{power, ^, .**, .^, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type ("^", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ^\n\ +Power operator. This may return complex results for real inputs. Use\n\ +@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ +real results when possible.\n\ +@seealso{power, **, .^, .**, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type ("+", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} +\n\ +Addition operator.\n\ +@seealso{plus}\n\ +@end deftypefn"), + + pair_type ("++", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ++\n\ +Increment operator. As in C, may be applied as a prefix or postfix\n\ +operator.\n\ +@seealso{--}\n\ +@end deftypefn"), + + pair_type (",", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ,\n\ +Array index, function argument, or command separator.\n\ +@end deftypefn"), + + pair_type ("-", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} -\n\ +Subtraction or unary negation operator.\n\ +@seealso{minus}\n\ +@end deftypefn"), + + pair_type ("--", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} --\n\ +Decrement operator. As in C, may be applied as a prefix or postfix\n\ +operator.\n\ +@seealso{++}\n\ +@end deftypefn"), + + pair_type (".'", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .'\n\ +Matrix transpose operator. For complex matrices, computes the\n\ +transpose, @emph{not} the complex conjugate transpose.\n\ +@seealso{', transpose}\n\ +@end deftypefn"), + + pair_type (".*", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .*\n\ +Element by element multiplication operator.\n\ +@seealso{*, times}\n\ +@end deftypefn"), + + pair_type (".**", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .*\n\ +Element by element power operator. If several complex results are possible,\n\ +returns the one with smallest non-negative argument (angle). Use\n\ +@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ +real result is preferred.\n\ +@seealso{**, ^, .^, power, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type (".^", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .^\n\ +Element by element power operator. If several complex results are possible,\n\ +returns the one with smallest non-negative argument (angle). Use\n\ +@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ +real result is preferred.\n\ +@seealso{.**, ^, **, power, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type ("./", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ./\n\ +Element by element right division operator.\n\ +@seealso{/, .\\, rdivide, mrdivide}\n\ +@end deftypefn"), + + pair_type ("/", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} /\n\ +Right division operator.\n\ +@seealso{./, \\, rdivide, mrdivide}\n\ +@end deftypefn"), + + pair_type (".\\", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .\\\n\ +Element by element left division operator.\n\ +@seealso{\\, ./, rdivide, mrdivide}\n\ +@end deftypefn"), + + pair_type ("\\", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} \\\n\ +Left division operator.\n\ +@seealso{.\\, /, ldivide, mldivide}\n\ +@end deftypefn"), + + pair_type (":", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} :\n\ +Select entire rows or columns of matrices.\n\ +@end deftypefn"), + + pair_type (";", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ;\n\ +Array row or command separator.\n\ +@seealso{,}\n\ +@end deftypefn"), + + pair_type ("<", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} <\n\ +'Less than' operator.\n\ +@seealso{lt}\n\ +@end deftypefn"), + + pair_type ("<=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} <=\n\ +'Less than' or 'equals' operator.\n\ +@seealso{le}\n\ +@end deftypefn"), + + pair_type ("=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} =\n\ +Assignment operator.\n\ +@end deftypefn"), + + pair_type ("==", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ==\n\ +Equality test operator.\n\ +@seealso{eq}\n\ +@end deftypefn"), + + pair_type (">", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} >\n\ +'Greater than' operator.\n\ +@seealso{gt}\n\ +@end deftypefn"), + + pair_type (">=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} >=\n\ +'Greater than' or 'equals' operator.\n\ +@seealso{ge}\n\ +@end deftypefn"), + + pair_type ("[", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} [\n\ +Return list delimiter.\n\ +@seealso{]}\n\ +@end deftypefn"), + + pair_type ("]", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ]\n\ +Return list delimiter.\n\ +@seealso{[}\n\ +@end deftypefn"), + + pair_type ("|", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} |\n\ +Element by element logical 'or' operator.\n\ +@seealso{||, or}\n\ +@end deftypefn"), + + pair_type ("||", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ||\n\ +Logical 'or' (with short-circuit evaluation) operator.\n\ +@seealso{|, or}\n\ +@end deftypefn"), +}; + +const static pair_type keywords[] = +{ + pair_type ("break", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} break\n\ +Exit the innermost enclosing do, while or for loop.\n\ +@seealso{do, while, for, parfor, continue}\n\ +@end deftypefn"), + + pair_type ("case", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} case @{@var{value}@}\n\ +A case statement in an switch. Octave cases are exclusive and do not\n\ +fall-through as do C-language cases. A switch statement must have at least\n\ +one case. See @code{switch} for an example.\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("catch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} catch\n\ +Begin the cleanup part of a try-catch block.\n\ +@seealso{try}\n\ +@end deftypefn"), + + pair_type ("continue", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} continue\n\ +Jump to the end of the innermost enclosing do, while or for loop.\n\ +@seealso{do, while, for, parfor, break}\n\ +@end deftypefn"), + + pair_type ("do", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} do\n\ +Begin a do-until loop. This differs from a do-while loop in that the\n\ +body of the loop is executed at least once.\n\ +@seealso{while}\n\ +@end deftypefn"), + + pair_type ("else", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} else\n\ +Alternate action for an if block. See @code{if} for an example.\n\ +@seealso{if}\n\ +@end deftypefn"), + + pair_type ("elseif", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} elseif (@var{condition})\n\ +Alternate conditional test for an if block. See @code{if} for an example.\n\ +@seealso{if}\n\ +@end deftypefn"), + + pair_type ("end", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} end\n\ +Mark the end of any @code{for}, @code{if}, @code{do}, @code{while}, or\n\ +@code{function} block.\n\ +@seealso{for, parfor, if, do, while, function}\n\ +@end deftypefn"), + + pair_type ("end_try_catch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} end_try_catch\n\ +Mark the end of an @code{try-catch} block.\n\ +@seealso{try, catch}\n\ +@end deftypefn"), + + pair_type ("end_unwind_protect", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} end_unwind_protect\n\ +Mark the end of an unwind_protect block.\n\ +@seealso{unwind_protect}\n\ +@end deftypefn"), + + pair_type ("endfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endfor\n\ +Mark the end of a for loop. See @code{for} for an example.\n\ +@seealso{for}\n\ +@end deftypefn"), + + pair_type ("endfunction", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endfunction\n\ +Mark the end of a function.\n\ +@seealso{function}\n\ +@end deftypefn"), + + pair_type ("endif", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endif\n\ +Mark the end of an if block. See @code{if} for an example.\n\ +@seealso{if}\n\ +@end deftypefn"), + + pair_type ("endparfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endparfor\n\ +Mark the end of a parfor loop. See @code{parfor} for an example.\n\ +@seealso{parfor}\n\ +@end deftypefn"), + + pair_type ("endswitch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endswitch\n\ +Mark the end of a switch block. See @code{switch} for an example.\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("endwhile", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endwhile\n\ +Mark the end of a while loop. See @code{while} for an example.\n\ +@seealso{do, while}\n\ +@end deftypefn"), + + pair_type ("for", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ +Begin a for loop.\n\ +\n\ +@example\n\ +@group\n\ +for i = 1:10\n\ + i\n\ +endfor\n\ +@end group\n\ +@end example\n\ +@seealso{do, parfor, while}\n\ +@end deftypefn"), + + pair_type ("function", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} function @var{outputs} = function (@var{input}, @dots{})\n\ +@deftypefnx {Keyword} {} function {} function (@var{input}, @dots{})\n\ +@deftypefnx {Keyword} {} function @var{outputs} = function\n\ +Begin a function body with @var{outputs} as results and @var{inputs} as\n\ +parameters.\n\ +@seealso{return}\n\ +@end deftypefn"), + + pair_type ("global", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} global\n\ +Declare variables to have global scope.\n\ +\n\ +@example\n\ +@group\n\ +global @var{x};\n\ +if (isempty (@var{x}))\n\ + x = 1;\n\ +endif\n\ +@end group\n\ +@end example\n\ +@seealso{persistent}\n\ +@end deftypefn"), + + pair_type ("if", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} if (@var{cond}) @dots{} endif\n\ +@deftypefnx {Keyword} {} if (@var{cond}) @dots{} else @dots{} endif\n\ +@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} endif\n\ +@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} else @dots{} endif\n\ +Begin an if block.\n\ +\n\ +@example\n\ +@group\n\ +x = 1;\n\ +if (x == 1)\n\ + disp (\"one\");\n\ +elseif (x == 2)\n\ + disp (\"two\");\n\ +else\n\ + disp (\"not one or two\");\n\ +endif\n\ +@end group\n\ +@end example\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("otherwise", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} otherwise\n\ +The default statement in a switch block (similar to else in an if block).\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("parfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ +@deftypefnx {Keyword} {} for (@var{i} = @var{range}, @var{maxproc})\n\ +Begin a for loop that may execute in parallel.\n\ +\n\ +@example\n\ +@group\n\ +parfor i = 1:10\n\ + i\n\ +endparfor\n\ +@end group\n\ +@end example\n\ +@seealso{for, do, while}\n\ +@end deftypefn"), + + pair_type ("persistent", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} persistent @var{var}\n\ +Declare variables as persistent. A variable that has been declared\n\ +persistent within a function will retain its contents in memory between\n\ +subsequent calls to the same function. The difference between persistent\n\ +variables and global variables is that persistent variables are local in \n\ +scope to a particular function and are not visible elsewhere.\n\ +@seealso{global}\n\ +@end deftypefn"), + + pair_type ("return", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} return\n\ +Return from a function.\n\ +@seealso{function}\n\ +@end deftypefn"), + + pair_type ("static", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} static\n\ +This function has been deprecated in favor of persistent.\n\ +@seealso{persistent}\n\ +@end deftypefn"), + + pair_type ("switch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} switch @var{statement}\n\ +Begin a switch block.\n\ +\n\ +@example\n\ +@group\n\ +yesno = \"yes\"\n\ +\n\ +switch yesno\n\ + case @{\"Yes\" \"yes\" \"YES\" \"y\" \"Y\"@}\n\ + value = 1;\n\ + case @{\"No\" \"no\" \"NO\" \"n\" \"N\"@}\n\ + value = 0;\n\ + otherwise\n\ + error (\"invalid value\");\n\ +endswitch\n\ +@end group\n\ +@end example\n\ +@seealso{if, case, otherwise}\n\ +@end deftypefn"), + + pair_type ("try", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} try\n\ +Begin a try-catch block.\n\ +\n\ +If an error occurs within a try block, then the catch code will be run and\n\ +execution will proceed after the catch block (though it is often\n\ +recommended to use the lasterr function to re-throw the error after cleanup\n\ +is completed).\n\ +@seealso{catch, unwind_protect}\n\ +@end deftypefn"), + + pair_type ("until", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} until\n\ +End a do-until loop.\n\ +@seealso{do}\n\ +@end deftypefn"), + + pair_type ("unwind_protect", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} unwind_protect\n\ +Begin an unwind_protect block.\n\ +\n\ +If an error occurs within the first part of an unwind_protect block\n\ +the commands within the unwind_protect_cleanup block are executed before\n\ +the error is thrown. If an error is not thrown, then the\n\ +unwind_protect_cleanup block is still executed (in other words, the\n\ +unwind_protect_cleanup will be run with or without an error in the\n\ +unwind_protect block).\n\ +@seealso{unwind_protect_cleanup, try}\n\ +@end deftypefn"), + + pair_type ("unwind_protect_cleanup", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} unwind_protect_cleanup\n\ +Begin the cleanup section of an unwind_protect block.\n\ +@seealso{unwind_protect}\n\ +@end deftypefn"), + + pair_type ("varargin", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} varargin\n\ +Pass an arbitrary number of arguments into a function.\n\ +@seealso{varargout, nargin, isargout, nargout, nthargout}\n\ +@end deftypefn"), + + pair_type ("varargout", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} varargout\n\ +Pass an arbitrary number of arguments out of a function.\n\ +@seealso{varargin, nargin, isargout, nargout, nthargout}\n\ +@end deftypefn"), + + pair_type ("while", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} while\n\ +Begin a while loop.\n\ +@seealso{do}\n\ +@end deftypefn"), +}; + +// Return a copy of the operator or keyword names. +static string_vector +names (const map_type& lst) +{ + string_vector retval (lst.size ()); + int j = 0; + for (map_iter iter = lst.begin (); iter != lst.end (); iter ++) + retval[j++] = iter->first; + return retval; +} + +const static map_type operators_map (operators, operators + size (operators)); +const static map_type keywords_map (keywords, keywords + size (keywords)); +const static string_vector keyword_names = names (keywords_map); + +// FIXME -- It's not likely that this does the right thing now. + +string_vector +make_name_list (void) +{ + const int key_len = keyword_names.length (); + + const string_vector bif = symbol_table::built_in_function_names (); + const int bif_len = bif.length (); + + const string_vector cfl = symbol_table::cmdline_function_names (); + const int cfl_len = cfl.length (); + + const string_vector lcl = symbol_table::variable_names (); + const int lcl_len = lcl.length (); + + const string_vector ffl = load_path::fcn_names (); + const int ffl_len = ffl.length (); + + const string_vector afl = autoloaded_functions (); + const int afl_len = afl.length (); + + const int total_len + = key_len + bif_len + cfl_len + lcl_len + ffl_len + afl_len; + + string_vector list (total_len); + + // Put all the symbols in one big list. + + int j = 0; + int i = 0; + for (i = 0; i < key_len; i++) + list[j++] = keyword_names[i]; + + for (i = 0; i < bif_len; i++) + list[j++] = bif[i]; + + for (i = 0; i < cfl_len; i++) + list[j++] = cfl[i]; + + for (i = 0; i < lcl_len; i++) + list[j++] = lcl[i]; + + for (i = 0; i < ffl_len; i++) + list[j++] = ffl[i]; + + for (i = 0; i < afl_len; i++) + list[j++] = afl[i]; + + return list; +} + +static bool +looks_like_html (const std::string& msg) +{ + const size_t p1 = msg.find ('\n'); + std::string t = msg.substr (0, p1); + const size_t p2 = t.find ("doc_string (); + + retval = true; + + w = fcn->fcn_file_name (); + + if (w.empty ()) + w = fcn->is_user_function () + ? "command-line function" : "built-in function"; + } + } + + return retval; +} + +static bool +raw_help_from_file (const std::string& nm, std::string& h, + std::string& file, bool& symbol_found) +{ + bool retval = false; + + // FIXME -- this is a bit of a kluge... + unwind_protect frame; + frame.protect_var (reading_script_file); + reading_script_file = true; + + h = get_help_from_file (nm, symbol_found, file); + + if (h.length () > 0) + retval = true; + + return retval; +} + +static bool +raw_help_from_map (const std::string& nm, std::string& h, + const map_type& map, bool& symbol_found) +{ + map_iter idx = map.find (nm); + symbol_found = (idx != map.end ()); + h = (symbol_found) ? idx->second : ""; + return symbol_found; +} + +std::string +raw_help (const std::string& nm, bool& symbol_found) +{ + std::string h; + std::string w; + std::string f; + + (raw_help_from_symbol_table (nm, h, w, symbol_found) + || raw_help_from_file (nm, h, f, symbol_found) + || raw_help_from_map (nm, h, operators_map, symbol_found) + || raw_help_from_map (nm, h, keywords_map, symbol_found)); + + return h; +} + +static void +do_get_help_text (const std::string& name, std::string& text, + std::string& format) +{ + bool symbol_found = false; + text = raw_help (name, symbol_found); + + format = "Not found"; + if (symbol_found) + { + size_t idx = -1; + if (text.empty ()) + { + format = "Not documented"; + } + else if (looks_like_texinfo (text, idx)) + { + format = "texinfo"; + text.erase (0, idx); + } + else if (looks_like_html (text)) + { + format = "html"; + } + else + { + format = "plain text"; + } + } +} + +DEFUN (get_help_text, args, , "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text (@var{name})\n\ +Return the raw help text of function @var{name}.\n\ +\n\ +The raw help text is returned in @var{text} and the format in @var{format}\n\ +The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ +@t{\"plain text\"}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + const std::string name = args (0).string_value (); + + if (! error_state) + { + std::string text; + std::string format; + + do_get_help_text (name, text, format); + + retval(1) = format; + retval(0) = text; + } + else + error ("get_help_text: invalid input"); + } + else + print_usage (); + + return retval; +} + +static void +do_get_help_text_from_file (const std::string& fname, std::string& text, + std::string& format) +{ + bool symbol_found = false; + + std::string f; + + raw_help_from_file (fname, text, f, symbol_found); + + format = "Not found"; + if (symbol_found) + { + size_t idx = -1; + if (text.empty ()) + { + format = "Not documented"; + } + else if (looks_like_texinfo (text, idx)) + { + format = "texinfo"; + text.erase (0, idx); + } + else if (looks_like_html (text)) + { + format = "html"; + } + else + { + format = "plain text"; + } + } +} + +DEFUN (get_help_text_from_file, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text_from_file (@var{fname})\n\ +Return the raw help text from the file @var{fname}.\n\ +\n\ +The raw help text is returned in @var{text} and the format in @var{format}\n\ +The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ +@t{\"plain text\"}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + const std::string fname = args(0).string_value (); + + if (! error_state) + { + std::string text; + std::string format; + + do_get_help_text_from_file (fname, text, format); + + retval(1) = format; + retval(0) = text; + } + else + error ("get_help_text_from_file: invalid input"); + } + else + print_usage (); + + return retval; +} + +// Return a cell array of strings containing the names of all +// operators. + +DEFUN (__operators__, , , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __operators__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return octave_value (Cell (names (operators_map))); +} + +// Return a cell array of strings containing the names of all +// keywords. + +DEFUN (__keywords__, , , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __keywords__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return octave_value (Cell (names (keywords_map))); +} + +// Return a cell array of strings containing the names of all builtin +// functions. + +DEFUN (__builtins__, , , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __builtins__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + const string_vector bif = symbol_table::built_in_function_names (); + + return octave_value (Cell (bif)); +} + +static std::string +do_which (const std::string& name, std::string& type) +{ + std::string file; + + type = std::string (); + + octave_value val = symbol_table::find_function (name); + + if (name.find_first_of ('.') == std::string::npos) + { + if (val.is_defined ()) + { + octave_function *fcn = val.function_value (); + + if (fcn) + { + file = fcn->fcn_file_name (); + + if (file.empty ()) + { + if (fcn->is_user_function ()) + type = "command-line function"; + else + { + file = fcn->src_file_name (); + type = "built-in function"; + } + } + else + type = val.is_user_script () + ? std::string ("script") : std::string ("function"); + } + } + else + { + // We might find a file that contains only a doc string. + + file = load_path::find_fcn_file (name); + } + } + else + { + // File query. + + // For compatibility: "file." queries "file". + if (name.size () > 1 && name[name.size () - 1] == '.') + file = load_path::find_file (name.substr (0, name.size () - 1)); + else + file = load_path::find_file (name); + } + + + return file; +} + +std::string +do_which (const std::string& name) +{ + std::string retval; + + std::string type; + + retval = do_which (name, type); + + return retval; +} + +DEFUN (__which__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __which__ (@var{name}, @dots{})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + string_vector argv = args.make_argv ("which"); + + if (! error_state) + { + int argc = argv.length (); + + if (argc > 1) + { + octave_map m (dim_vector (1, argc-1)); + + Cell names (1, argc-1); + Cell files (1, argc-1); + Cell types (1, argc-1); + + for (int i = 1; i < argc; i++) + { + std::string name = argv[i]; + + std::string type; + + std::string file = do_which (name, type); + + names(i-1) = name; + files(i-1) = file; + types(i-1) = type; + } + + m.assign ("name", names); + m.assign ("file", files); + m.assign ("type", types); + + retval = m; + } + else + print_usage (); + } + + return retval; +} + +// FIXME -- Are we sure this function always does the right thing? +inline bool +file_is_in_dir (const std::string filename, const std::string dir) +{ + if (filename.find (dir) == 0) + { + const int dir_len = dir.size (); + const int filename_len = filename.size (); + const int max_allowed_seps = file_ops::is_dir_sep (dir[dir_len-1]) ? 0 : 1; + + int num_seps = 0; + for (int i = dir_len; i < filename_len; i++) + if (file_ops::is_dir_sep (filename[i])) + num_seps ++; + + return (num_seps <= max_allowed_seps); + } + else + return false; +} + +// Return a cell array of strings containing the names of all +// functions available in DIRECTORY. If no directory is given, search +// the current path. + +DEFUN (__list_functions__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} {@var{retval} =} __list_functions__ ()\n\ +@deftypefnx {Function File} {@var{retval} =} __list_functions__ (@var{directory})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + // Get list of functions + string_vector ffl = load_path::fcn_names (); + string_vector afl = autoloaded_functions (); + + if (args.length () == 0) + retval = Cell (ffl.append (afl)); + else + { + std::string dir = args (0).string_value (); + + if (! error_state) + { + string_vector fl = load_path::files (dir, true); + + if (! error_state) + { + // Return a sorted list with unique entries (in case of + // .m and .oct versions of the same function in a given + // directory, for example). + fl.sort (true); + + retval = Cell (fl); + } + } + else + error ("__list_functions__: DIRECTORY argument must be a string"); + } + + return retval; +} + +DEFUN (doc_cache_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} doc_cache_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} doc_cache_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} doc_cache_file (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +Octave documentation cache file. A cache file significantly improves\n\ +the performance of the @code{lookfor} command. The default value is \n\ +@file{@var{octave-home}/share/octave/@var{version}/etc/doc-cache},\n\ +in which @var{octave-home} is the root directory of the Octave installation,\n\ +and @var{version} is the Octave version number.\n\ +The default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_DOC_CACHE_FILE}}, or the command line argument\n\ +@samp{--doc-cache-file NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{lookfor, info_program, doc, help, makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (doc_cache_file); +} + +DEFUN (texi_macros_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} texi_macros_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} texi_macros_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} texi_macros_file (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +file containing Texinfo macros that are prepended to documentation strings\n\ +before they are passed to makeinfo. The default value is \n\ +@file{@var{octave-home}/share/octave/@var{version}/etc/macros.texi},\n\ +in which @var{octave-home} is the root directory of the Octave installation,\n\ +and @var{version} is the Octave version number.\n\ +The default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_TEXI_MACROS_FILE}}, or the command line argument\n\ +@samp{--texi-macros-file NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (texi_macros_file); +} + +DEFUN (info_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} info_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} info_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} info_file (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +Octave info file. The default value is\n\ +@file{@var{octave-home}/info/octave.info}, in\n\ +which @var{octave-home} is the root directory of the Octave installation.\n\ +The default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_INFO_FILE}}, or the command line argument\n\ +@samp{--info-file NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{info_program, doc, help, makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_file); +} + +DEFUN (info_program, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} info_program ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} info_program (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} info_program (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +info program to run. The default value is\n\ +@file{@var{octave-home}/libexec/octave/@var{version}/exec/@var{arch}/info}\n\ +in which @var{octave-home} is the root directory of the Octave installation,\n\ +@var{version} is the Octave version number, and @var{arch}\n\ +is the system type (for example, @code{i686-pc-linux-gnu}). The\n\ +default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_INFO_PROGRAM}}, or the command line argument\n\ +@samp{--info-program NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{info_file, doc, help, makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_program); +} + +DEFUN (makeinfo_program, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} makeinfo_program ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} makeinfo_program (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} makeinfo_program (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +program that Octave runs to format help text containing\n\ +Texinfo markup commands. The default value is @code{makeinfo}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{texi_macros_file, info_file, info_program, doc, help}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (makeinfo_program); +} + +DEFUN (suppress_verbose_help_message, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} suppress_verbose_help_message ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} suppress_verbose_help_message (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} suppress_verbose_help_message (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave\n\ +will add additional help information to the end of the output from\n\ +the @code{help} command and usage messages for built-in commands.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (suppress_verbose_help_message); +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/help.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/help.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,54 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_help_h) +#define octave_help_h 1 + +#include +#include + +class string_vector; + +extern string_vector make_name_list (void); + +extern OCTINTERP_API std::string raw_help (const std::string&, bool&); + +// Name of the doc cache file specified on the command line. +// (--doc-cache-file file) +extern std::string Vdoc_cache_file; + +// Name of the file containing local Texinfo macros that are prepended +// to doc strings before processing. +// (--texi-macros-file) +extern std::string Vtexi_macros_file; + +// Name of the info file specified on command line. +// (--info-file file) +extern std::string Vinfo_file; + +// Name of the info reader we'd like to use. +// (--info-program program) +extern std::string Vinfo_program; + +extern std::string do_which (const std::string& name); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/input.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/input.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1570 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Get command input interactively or from files. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include + +#include +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "file-ops.h" +#include "quit.h" +#include "str-vec.h" + +#include "debug.h" +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "help.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "oct-map.h" +#include "oct-hist.h" +#include "toplev.h" +#include "oct-obj.h" +#include "pager.h" +#include "parse.h" +#include "pathlen.h" +#include "pt.h" +#include "pt-const.h" +#include "pt-eval.h" +#include "pt-stmt.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Primary prompt string. +static std::string VPS1 = "\\s:\\#> "; + +// Secondary prompt string. +static std::string VPS2 = "> "; + +// String printed before echoed input (enabled by --echo-input). +std::string VPS4 = "+ "; + +// Echo commands as they are executed? +// +// 1 ==> echo commands read from script files +// 2 ==> echo commands from functions +// 4 ==> echo commands read from command line +// +// more than one state can be active at once. +int Vecho_executing_commands = ECHO_OFF; + +// The time we last printed a prompt. +octave_time Vlast_prompt_time = 0.0; + +// Character to append after successful command-line completion attempts. +static char Vcompletion_append_char = ' '; + +// Global pointer for eval(). +std::string current_eval_string; + +// TRUE means get input from current_eval_string. +bool get_input_from_eval_string = false; + +// TRUE means we haven't been asked for the input from +// current_eval_string yet. +bool input_from_eval_string_pending = false; + +// TRUE means that input is coming from a file that was named on +// the command line. +bool input_from_command_line_file = false; + +// TRUE means that stdin is a terminal, not a pipe or redirected file. +bool stdin_is_tty = false; + +// TRUE means we're parsing a function file. +bool reading_fcn_file = false; + +// TRUE means we're parsing a classdef file. +bool reading_classdef_file = false; + +// Simple name of function file we are reading. +std::string curr_fcn_file_name; + +// Full name of file we are reading. +std::string curr_fcn_file_full_name; + +// TRUE means we're parsing a script file. +bool reading_script_file = false; + +// If we are reading from an M-file, this is it. +FILE *ff_instream = 0; + +// TRUE means this is an interactive shell. +bool interactive = false; + +// TRUE means the user forced this shell to be interactive (-i). +bool forced_interactive = false; + +// Should we issue a prompt? +int promptflag = 1; + +// The current line of input, from wherever. +std::string current_input_line; + +// TRUE after a call to completion_matches. +bool octave_completion_matches_called = false; + +// TRUE if the plotting system has requested a call to drawnow at +// the next user prompt. +bool Vdrawnow_requested = false; + +// TRUE if we are in debugging mode. +bool Vdebugging = false; + +// If we are in debugging mode, this is the last command entered, so +// that we can repeat the previous command if the user just types RET. +static std::string last_debugging_command; + +// TRUE if we are running in the Emacs GUD mode. +static bool Vgud_mode = false; + +// The filemarker used to separate filenames from subfunction names +char Vfilemarker = '>'; + +static void +do_input_echo (const std::string& input_string) +{ + int do_echo = reading_script_file ? + (Vecho_executing_commands & ECHO_SCRIPTS) + : (Vecho_executing_commands & ECHO_CMD_LINE) && ! forced_interactive; + + if (do_echo) + { + if (forced_interactive) + { + if (promptflag > 0) + octave_stdout << command_editor::decode_prompt_string (VPS1); + else + octave_stdout << command_editor::decode_prompt_string (VPS2); + } + else + octave_stdout << command_editor::decode_prompt_string (VPS4); + + if (! input_string.empty ()) + { + octave_stdout << input_string; + + if (input_string[input_string.length () - 1] != '\n') + octave_stdout << "\n"; + } + } +} + +std::string +gnu_readline (const std::string& s, bool force_readline) +{ + octave_quit (); + + std::string retval; + + if (line_editing || force_readline) + { + bool eof; + + retval = command_editor::readline (s, eof); + + if (! eof && retval.empty ()) + retval = "\n"; + } + else + { + if (! s.empty () && (interactive || forced_interactive)) + { + FILE *stream = command_editor::get_output_stream (); + + gnulib::fputs (s.c_str (), stream); + gnulib::fflush (stream); + } + + FILE *curr_stream = command_editor::get_input_stream (); + + if (reading_fcn_file || reading_script_file || reading_classdef_file) + curr_stream = ff_instream; + + retval = octave_fgets (curr_stream); + } + + return retval; +} + +static inline std::string +interactive_input (const std::string& s, bool force_readline = false) +{ + Vlast_prompt_time.stamp (); + + if (Vdrawnow_requested && (interactive || forced_interactive)) + { + feval ("drawnow"); + + flush_octave_stdout (); + + // We set Vdrawnow_requested to false even if there is an error + // in drawnow so that the error doesn't reappear at every prompt. + + Vdrawnow_requested = false; + + if (error_state) + return "\n"; + } + + return gnu_readline (s, force_readline); +} + +static std::string +octave_gets (void) +{ + octave_quit (); + + std::string retval; + + bool history_skip_auto_repeated_debugging_command = false; + + if ((interactive || forced_interactive) + && (! (reading_fcn_file + || reading_classdef_file + || reading_script_file + || get_input_from_eval_string + || input_from_startup_file + || input_from_command_line_file))) + { + std::string ps = (promptflag > 0) ? VPS1 : VPS2; + + std::string prompt = command_editor::decode_prompt_string (ps); + + pipe_handler_error_count = 0; + + flush_octave_stdout (); + + octave_pager_stream::reset (); + octave_diary_stream::reset (); + + octave_diary << prompt; + + retval = interactive_input (prompt); + + // There is no need to update the load_path cache if there is no + // user input. + if (! retval.empty () + && retval.find_first_not_of (" \t\n\r") != std::string::npos) + { + load_path::update (); + + if (Vdebugging) + last_debugging_command = retval; + else + last_debugging_command = std::string (); + } + else if (Vdebugging) + { + retval = last_debugging_command; + history_skip_auto_repeated_debugging_command = true; + } + } + else + retval = gnu_readline (""); + + current_input_line = retval; + + if (! current_input_line.empty ()) + { + if (! (input_from_startup_file || input_from_command_line_file + || history_skip_auto_repeated_debugging_command)) + command_history::add (current_input_line); + + if (! (reading_fcn_file || reading_script_file || reading_classdef_file)) + { + octave_diary << current_input_line; + + if (current_input_line[current_input_line.length () - 1] != '\n') + octave_diary << "\n"; + } + + do_input_echo (current_input_line); + } + else if (! (reading_fcn_file || reading_script_file || reading_classdef_file)) + octave_diary << "\n"; + + return retval; +} + +// Read a line from the input stream. + +static std::string +get_user_input (void) +{ + octave_quit (); + + std::string retval; + + if (get_input_from_eval_string) + { + if (input_from_eval_string_pending) + { + input_from_eval_string_pending = false; + + retval = current_eval_string; + + size_t len = retval.length (); + + if (len > 0 && retval[len-1] != '\n') + retval.append ("\n"); + } + } + else + retval = octave_gets (); + + current_input_line = retval; + + return retval; +} + +int +octave_read (char *buf, unsigned max_size) +{ + // FIXME -- is this a safe way to buffer the input? + + static const char * const eol = "\n"; + static std::string input_buf; + static const char *pos = 0; + static size_t chars_left = 0; + + int status = 0; + if (chars_left == 0) + { + pos = 0; + + input_buf = get_user_input (); + + chars_left = input_buf.length (); + + pos = input_buf.c_str (); + } + + if (chars_left > 0) + { + size_t len = max_size > chars_left ? chars_left : max_size; + assert (len > 0); + + memcpy (buf, pos, len); + + chars_left -= len; + pos += len; + + // Make sure input ends with a new line character. + if (chars_left == 0 && buf[len-1] != '\n') + { + if (len < max_size) + { + // There is enough room to plug the newline character in + // the buffer. + buf[len++] = '\n'; + } + else + { + // There isn't enough room to plug the newline character + // in the buffer so make sure it is returned on the next + // octave_read call. + pos = eol; + chars_left = 1; + } + } + + status = len; + + } + else if (chars_left == 0) + { + status = 0; + } + else + status = -1; + + return status; +} + +// Fix things up so that input can come from file `name', printing a +// warning if the file doesn't exist. + +FILE * +get_input_from_file (const std::string& name, int warn) +{ + FILE *instream = 0; + + if (name.length () > 0) + instream = gnulib::fopen (name.c_str (), "rb"); + + if (! instream && warn) + warning ("%s: no such file or directory", name.c_str ()); + + if (reading_fcn_file || reading_script_file || reading_classdef_file) + ff_instream = instream; + else + command_editor::set_input_stream (instream); + + return instream; +} + +// Fix things up so that input can come from the standard input. This +// may need to become much more complicated, which is why it's in a +// separate function. + +FILE * +get_input_from_stdin (void) +{ + command_editor::set_input_stream (stdin); + return command_editor::get_input_stream (); +} + +// FIXME -- make this generate file names when appropriate. + +static string_vector +generate_possible_completions (const std::string& text, std::string& prefix, + std::string& hint) +{ + string_vector names; + + prefix = ""; + + if (looks_like_struct (text)) + names = generate_struct_completions (text, prefix, hint); + else + names = make_name_list (); + + // Sort and remove duplicates. + + names.sort (true); + + return names; +} + +static bool +is_completing_dirfns (void) +{ + static std::string dirfns_commands[] = {"cd", "ls"}; + static const size_t dirfns_commands_length = 2; + + bool retval = false; + + std::string line = command_editor::get_line_buffer (); + + for (size_t i = 0; i < dirfns_commands_length; i++) + { + int index = line.find (dirfns_commands[i] + " "); + + if (index == 0) + { + retval = true; + break; + } + } + + return retval; +} + +static std::string +generate_completion (const std::string& text, int state) +{ + std::string retval; + + static std::string prefix; + static std::string hint; + + static size_t hint_len = 0; + + static int list_index = 0; + static int name_list_len = 0; + static int name_list_total_len = 0; + static string_vector name_list; + static string_vector file_name_list; + + static int matches = 0; + + if (state == 0) + { + list_index = 0; + + prefix = ""; + + hint = text; + + // No reason to display symbols while completing a + // file/directory operation. + + if (is_completing_dirfns ()) + name_list = string_vector (); + else + name_list = generate_possible_completions (text, prefix, hint); + + name_list_len = name_list.length (); + + file_name_list = command_editor::generate_filename_completions (text); + + name_list.append (file_name_list); + + name_list_total_len = name_list.length (); + + hint_len = hint.length (); + + matches = 0; + + for (int i = 0; i < name_list_len; i++) + if (hint == name_list[i].substr (0, hint_len)) + matches++; + } + + if (name_list_total_len > 0 && matches > 0) + { + while (list_index < name_list_total_len) + { + std::string name = name_list[list_index]; + + list_index++; + + if (hint == name.substr (0, hint_len)) + { + if (list_index <= name_list_len && ! prefix.empty ()) + retval = prefix + "." + name; + else + retval = name; + + // FIXME -- looks_like_struct is broken for now, + // so it always returns false. + + if (matches == 1 && looks_like_struct (retval)) + { + // Don't append anything, since we don't know + // whether it should be '(' or '.'. + + command_editor::set_completion_append_character ('\0'); + } + else + command_editor::set_completion_append_character + (Vcompletion_append_char); + + break; + } + } + } + + return retval; +} + +static std::string +quoting_filename (const std::string &text, int, char quote) +{ + if (quote) + return text; + else + return (std::string ("'") + text); +} + +void +initialize_command_input (void) +{ + // If we are using readline, this allows conditional parsing of the + // .inputrc file. + + command_editor::set_name ("Octave"); + + // FIXME -- this needs to include a comma too, but that + // causes trouble for the new struct element completion code. + + static const char *s = "\t\n !\"\'*+-/:;<=>(){}[\\]^`~"; + + command_editor::set_basic_word_break_characters (s); + + command_editor::set_completer_word_break_characters (s); + + command_editor::set_basic_quote_characters ("\""); + + command_editor::set_filename_quote_characters (" \t\n\\\"'@<>=;|&()#$`?*[!:{"); + command_editor::set_completer_quote_characters ("'\""); + + command_editor::set_completion_function (generate_completion); + + command_editor::set_quoting_function (quoting_filename); +} + +static void +get_debug_input (const std::string& prompt) +{ + octave_user_code *caller = octave_call_stack::caller_user_code (); + std::string nm; + + int curr_debug_line = octave_call_stack::current_line (); + + bool have_file = false; + + if (caller) + { + nm = caller->fcn_file_name (); + + if (nm.empty ()) + nm = caller->name (); + else + have_file = true; + } + else + curr_debug_line = -1; + + std::ostringstream buf; + + if (! nm.empty ()) + { + if (Vgud_mode) + { + static char ctrl_z = 'Z' & 0x1f; + + buf << ctrl_z << ctrl_z << nm << ":" << curr_debug_line; + } + else + { + // FIXME -- we should come up with a clean way to detect + // that we are stopped on the no-op command that marks the + // end of a function or script. + + buf << "stopped in " << nm; + + if (curr_debug_line > 0) + buf << " at line " << curr_debug_line; + + if (have_file) + { + std::string line_buf + = get_file_line (nm, curr_debug_line); + + if (! line_buf.empty ()) + buf << "\n" << curr_debug_line << ": " << line_buf; + } + } + } + + std::string msg = buf.str (); + + if (! msg.empty ()) + std::cerr << msg << std::endl; + + unwind_protect frame; + + frame.protect_var (VPS1); + VPS1 = prompt; + + if (! (interactive || forced_interactive) + || (reading_fcn_file + || reading_classdef_file + || reading_script_file + || get_input_from_eval_string + || input_from_startup_file + || input_from_command_line_file)) + { + frame.protect_var (forced_interactive); + forced_interactive = true; + + frame.protect_var (reading_fcn_file); + reading_fcn_file = false; + + frame.protect_var (reading_classdef_file); + reading_classdef_file = false; + + frame.protect_var (reading_script_file); + reading_script_file = false; + + frame.protect_var (input_from_startup_file); + input_from_startup_file = false; + + frame.protect_var (input_from_command_line_file); + input_from_command_line_file = false; + + frame.protect_var (get_input_from_eval_string); + get_input_from_eval_string = false; + + YY_BUFFER_STATE old_buf = current_buffer (); + YY_BUFFER_STATE new_buf = create_buffer (get_input_from_stdin ()); + + // FIXME: are these safe? + frame.add_fcn (switch_to_buffer, old_buf); + frame.add_fcn (delete_buffer, new_buf); + + switch_to_buffer (new_buf); + } + + while (Vdebugging) + { + reset_error_handler (); + + reset_parser (); + + // Save current value of global_command. + frame.protect_var (global_command); + + global_command = 0; + + // Do this with an unwind-protect cleanup function so that the + // forced variables will be unmarked in the event of an interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); + + // This is the same as yyparse in parse.y. + int retval = octave_parse (); + + if (retval == 0 && global_command) + { + unwind_protect inner_frame; + + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of an + // interrupt. + + inner_frame.add_fcn (cleanup_statement_list, &global_command); + + global_command->accept (*current_evaluator); + + if (octave_completion_matches_called) + octave_completion_matches_called = false; + } + + // Unmark forced variables. + // Restore previous value of global_command. + frame.run_top (2); + + octave_quit (); + } +} + +// If the user simply hits return, this will produce an empty matrix. + +static octave_value_list +get_user_input (const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + int nargin = args.length (); + + int read_as_string = 0; + + if (nargin == 2) + read_as_string++; + + std::string prompt = args(0).string_value (); + + if (error_state) + { + error ("input: unrecognized argument"); + return retval; + } + + flush_octave_stdout (); + + octave_pager_stream::reset (); + octave_diary_stream::reset (); + + octave_diary << prompt; + + std::string input_buf = interactive_input (prompt.c_str (), true); + + if (! (error_state || input_buf.empty ())) + { + if (! input_from_startup_file) + command_history::add (input_buf); + + size_t len = input_buf.length (); + + octave_diary << input_buf; + + if (input_buf[len - 1] != '\n') + octave_diary << "\n"; + + if (len < 1) + return read_as_string ? octave_value ("") : octave_value (Matrix ()); + + if (read_as_string) + { + // FIXME -- fix gnu_readline and octave_gets instead! + if (input_buf.length () == 1 && input_buf[0] == '\n') + retval(0) = ""; + else + retval(0) = input_buf; + } + else + { + int parse_status = 0; + + retval = eval_string (input_buf, true, parse_status, nargout); + + if (! Vdebugging && retval.length () == 0) + retval(0) = Matrix (); + } + } + else + error ("input: reading user-input failed!"); + + return retval; +} + +DEFUN (input, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} input (@var{prompt})\n\ +@deftypefnx {Built-in Function} {} input (@var{prompt}, \"s\")\n\ +Print a prompt and wait for user input. For example,\n\ +\n\ +@example\n\ +input (\"Pick a number, any number! \")\n\ +@end example\n\ +\n\ +@noindent\n\ +prints the prompt\n\ +\n\ +@example\n\ +Pick a number, any number!\n\ +@end example\n\ +\n\ +@noindent\n\ +and waits for the user to enter a value. The string entered by the user\n\ +is evaluated as an expression, so it may be a literal constant, a\n\ +variable name, or any other valid expression.\n\ +\n\ +Currently, @code{input} only returns one value, regardless of the number\n\ +of values produced by the evaluation of the expression.\n\ +\n\ +If you are only interested in getting a literal string value, you can\n\ +call @code{input} with the character string @code{\"s\"} as the second\n\ +argument. This tells Octave to return the string entered by the user\n\ +directly, without evaluating it first.\n\ +\n\ +Because there may be output waiting to be displayed by the pager, it is\n\ +a good idea to always call @code{fflush (stdout)} before calling\n\ +@code{input}. This will ensure that all pending output is written to\n\ +the screen before your prompt. @xref{Input and Output}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + retval = get_user_input (args, nargout); + else + print_usage (); + + return retval; +} + +bool +octave_yes_or_no (const std::string& prompt) +{ + std::string prompt_string = prompt + "(yes or no) "; + + while (1) + { + std::string input_buf = interactive_input (prompt_string, true); + + if (input_buf == "yes") + return true; + else if (input_buf == "no") + return false; + else + message (0, "Please answer yes or no."); + } +} + +DEFUN (yes_or_no, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} yes_or_no (@var{prompt})\n\ +Ask the user a yes-or-no question. Return 1 if the answer is yes.\n\ +Takes one argument, which is the string to display to ask the\n\ +question. It should end in a space; @samp{yes-or-no-p} adds\n\ +@samp{(yes or no) } to it. The user must confirm the answer with\n\ +RET and can edit it until it has been confirmed.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0 || nargin == 1) + { + std::string prompt; + + if (nargin == 1) + { + prompt = args(0).string_value (); + + if (error_state) + { + error ("yes_or_no: PROMPT must be a character string"); + return retval; + } + } + + retval = octave_yes_or_no (prompt); + } + else + print_usage (); + + return retval; +} + +octave_value +do_keyboard (const octave_value_list& args) +{ + octave_value retval; + + int nargin = args.length (); + + assert (nargin == 0 || nargin == 1); + + unwind_protect frame; + + frame.add_fcn (command_history::ignore_entries, + command_history::ignoring_entries ()); + + command_history::ignore_entries (false); + + frame.protect_var (Vdebugging); + + frame.add_fcn (octave_call_stack::restore_frame, + octave_call_stack::current_frame ()); + + // FIXME -- probably we just want to print one line, not the + // entire statement, which might span many lines... + // + // tree_print_code tpc (octave_stdout); + // stmt.accept (tpc); + + Vdebugging = true; + + std::string prompt = "debug> "; + if (nargin > 0) + prompt = args(0).string_value (); + + if (! error_state) + get_debug_input (prompt); + + return retval; +} + +DEFUN (keyboard, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} keyboard ()\n\ +@deftypefnx {Built-in Function} {} keyboard (@var{prompt})\n\ +This function is normally used for simple debugging. When the\n\ +@code{keyboard} function is executed, Octave prints a prompt and waits\n\ +for user input. The input strings are then evaluated and the results\n\ +are printed. This makes it possible to examine the values of variables\n\ +within a function, and to assign new values if necessary. To leave the\n\ +prompt and return to normal execution type @samp{return} or @samp{dbcont}.\n\ +The @code{keyboard} function does not return an exit status.\n\ +\n\ +If @code{keyboard} is invoked without arguments, a default prompt of\n\ +@samp{debug> } is used.\n\ +@seealso{dbcont, dbquit}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 0 || nargin == 1) + { + unwind_protect frame; + + frame.add_fcn (octave_call_stack::restore_frame, + octave_call_stack::current_frame ()); + + // Skip the frame assigned to the keyboard function. + octave_call_stack::goto_frame_relative (0); + + tree_evaluator::debug_mode = true; + + tree_evaluator::current_frame = octave_call_stack::current_frame (); + + do_keyboard (args); + } + else + print_usage (); + + return retval; +} + +DEFUN (echo, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} echo options\n\ +Control whether commands are displayed as they are executed. Valid\n\ +options are:\n\ +\n\ +@table @code\n\ +@item on\n\ +Enable echoing of commands as they are executed in script files.\n\ +\n\ +@item off\n\ +Disable echoing of commands as they are executed in script files.\n\ +\n\ +@item on all\n\ +Enable echoing of commands as they are executed in script files and\n\ +functions.\n\ +\n\ +@item off all\n\ +Disable echoing of commands as they are executed in script files and\n\ +functions.\n\ +@end table\n\ +\n\ +@noindent\n\ +With no arguments, @code{echo} toggles the current echo state.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("echo"); + + if (error_state) + return retval; + + switch (argc) + { + case 1: + { + if ((Vecho_executing_commands & ECHO_SCRIPTS) + || (Vecho_executing_commands & ECHO_FUNCTIONS)) + Vecho_executing_commands = ECHO_OFF; + else + Vecho_executing_commands = ECHO_SCRIPTS; + } + break; + + case 2: + { + std::string arg = argv[1]; + + if (arg == "on") + Vecho_executing_commands = ECHO_SCRIPTS; + else if (arg == "off") + Vecho_executing_commands = ECHO_OFF; + else + print_usage (); + } + break; + + case 3: + { + std::string arg = argv[1]; + + if (arg == "on" && argv[2] == "all") + { + int tmp = (ECHO_SCRIPTS | ECHO_FUNCTIONS); + Vecho_executing_commands = tmp; + } + else if (arg == "off" && argv[2] == "all") + Vecho_executing_commands = ECHO_OFF; + else + print_usage (); + } + break; + + default: + print_usage (); + break; + } + + return retval; +} + +DEFUN (completion_matches, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} completion_matches (@var{hint})\n\ +Generate possible completions given @var{hint}.\n\ +\n\ +This function is provided for the benefit of programs like Emacs which\n\ +might be controlling Octave and handling user input. The current\n\ +command number is not incremented when this function is called. This is\n\ +a feature, not a bug.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + std::string hint = args(0).string_value (); + + if (! error_state) + { + int n = 32; + + string_vector list (n); + + int k = 0; + + for (;;) + { + std::string cmd = generate_completion (hint, k); + + if (! cmd.empty ()) + { + if (k == n) + { + n *= 2; + list.resize (n); + } + + list[k++] = cmd; + } + else + { + list.resize (k); + break; + } + } + + if (nargout > 0) + { + if (! list.empty ()) + retval = list; + else + retval = ""; + } + else + { + // We don't use string_vector::list_in_columns here + // because it will be easier for Emacs if the names + // appear in a single column. + + int len = list.length (); + + for (int i = 0; i < len; i++) + octave_stdout << list[i] << "\n"; + } + + octave_completion_matches_called = true; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (read_readline_init_file, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} read_readline_init_file (@var{file})\n\ +Read the readline library initialization file @var{file}. If\n\ +@var{file} is omitted, read the default initialization file (normally\n\ +@file{~/.inputrc}).\n\ +\n\ +@xref{Readline Init File, , , readline, GNU Readline Library},\n\ +for details.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 0) + command_editor::read_init_file (); + else if (nargin == 1) + { + std::string file = args(0).string_value (); + + if (! error_state) + command_editor::read_init_file (file); + } + else + print_usage (); + + return retval; +} + +DEFUN (re_read_readline_init_file, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} re_read_readline_init_file ()\n\ +Re-read the last readline library initialization file that was read.\n\ +@xref{Readline Init File, , , readline, GNU Readline Library},\n\ +for details.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 0) + command_editor::re_read_init_file (); + else + print_usage (); + + return retval; +} + +typedef std::map hook_fcn_map_type; + +static hook_fcn_map_type hook_fcn_map; + +static int +input_event_hook (void) +{ + if (! lexer_flags.defining_func) + { + hook_fcn_map_type::iterator p = hook_fcn_map.begin (); + + while (p != hook_fcn_map.end ()) + { + std::string hook_fcn = p->first; + octave_value user_data = p->second; + + hook_fcn_map_type::iterator q = p++; + + if (is_valid_function (hook_fcn)) + { + if (user_data.is_defined ()) + feval (hook_fcn, user_data, 0); + else + feval (hook_fcn, octave_value_list (), 0); + } + else + hook_fcn_map.erase (q); + } + + if (hook_fcn_map.empty ()) + command_editor::remove_event_hook (input_event_hook); + } + + return 0; +} + +DEFUN (add_input_event_hook, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} add_input_event_hook (@var{fcn})\n\ +@deftypefnx {Built-in Function} {} add_input_event_hook (@var{fcn}, @var{data})\n\ +Add the named function @var{fcn} to the list of functions to call\n\ +periodically when Octave is waiting for input. The function should\n\ +have the form\n\ +\n\ +@example\n\ +@var{fcn} (@var{data})\n\ +@end example\n\ +\n\ +If @var{data} is omitted, Octave calls the function without any\n\ +arguments.\n\ +@seealso{remove_input_event_hook}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_value user_data; + + if (nargin == 2) + user_data = args(1); + + std::string hook_fcn = args(0).string_value (); + + if (! error_state) + { + if (hook_fcn_map.empty ()) + command_editor::add_event_hook (input_event_hook); + + hook_fcn_map[hook_fcn] = user_data; + } + else + error ("add_input_event_hook: expecting string as first arg"); + } + else + print_usage (); + + return retval; +} + +DEFUN (remove_input_event_hook, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} remove_input_event_hook (@var{fcn})\n\ +Remove the named function @var{fcn} from the list of functions to call\n\ +periodically when Octave is waiting for input.\n\ +@seealso{add_input_event_hook}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1) + { + std::string hook_fcn = args(0).string_value (); + + if (! error_state) + { + hook_fcn_map_type::iterator p = hook_fcn_map.find (hook_fcn); + + if (p != hook_fcn_map.end ()) + hook_fcn_map.erase (p); + else + error ("remove_input_event_hook: %s not found in list", + hook_fcn.c_str ()); + + if (hook_fcn_map.empty ()) + command_editor::remove_event_hook (input_event_hook); + } + else + error ("remove_input_event_hook: expecting string as first arg"); + } + else + print_usage (); + + return retval; +} + +DEFUN (PS1, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PS1 ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PS1 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS1 (@var{new_val}, \"local\")\n\ +Query or set the primary prompt string. When executing interactively,\n\ +Octave displays the primary prompt when it is ready to read a command.\n\ +\n\ +The default value of the primary prompt string is @code{\"\\s:\\#> \"}.\n\ +To change it, use a command like\n\ +\n\ +@example\n\ +PS1 (\"\\\\u@@\\\\H> \")\n\ +@end example\n\ +\n\ +@noindent\n\ +which will result in the prompt @samp{boris@@kremvax> } for the user\n\ +@samp{boris} logged in on the host @samp{kremvax.kgb.su}. Note that two\n\ +backslashes are required to enter a backslash into a double-quoted\n\ +character string. @xref{Strings}.\n\ +\n\ +You can also use ANSI escape sequences if your terminal supports them.\n\ +This can be useful for coloring the prompt. For example,\n\ +\n\ +@example\n\ +PS1 (\"\\\\[\\\\033[01;31m\\\\]\\\\s:\\\\#> \\\\[\\\\033[0m\\\\]\")\n\ +@end example\n\ +\n\ +@noindent\n\ +will give the default Octave prompt a red coloring.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PS2, PS4}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (PS1); +} + +DEFUN (PS2, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PS2 ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PS2 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS2 (@var{new_val}, \"local\")\n\ +Query or set the secondary prompt string. The secondary prompt is\n\ +printed when Octave is expecting additional input to complete a\n\ +command. For example, if you are typing a @code{for} loop that spans several\n\ +lines, Octave will print the secondary prompt at the beginning of\n\ +each line after the first. The default value of the secondary prompt\n\ +string is @code{\"> \"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PS1, PS4}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (PS2); +} + +DEFUN (PS4, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PS4 ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PS4 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS4 (@var{new_val}, \"local\")\n\ +Query or set the character string used to prefix output produced\n\ +when echoing commands is enabled.\n\ +The default value is @code{\"+ \"}.\n\ +@xref{Diary and Echo Commands}, for a description of echoing commands.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{echo, echo_executing_commands, PS1, PS2}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (PS4); +} + +DEFUN (completion_append_char, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} completion_append_char ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} completion_append_char (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} completion_append_char (@var{new_val}, \"local\")\n\ +Query or set the internal character variable that is appended to\n\ +successful command-line completion attempts. The default\n\ +value is @code{\" \"} (a single space).\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (completion_append_char); +} + +DEFUN (echo_executing_commands, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} echo_executing_commands ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} echo_executing_commands (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} echo_executing_commands (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls the echo state.\n\ +It may be the sum of the following values:\n\ +\n\ +@table @asis\n\ +@item 1\n\ +Echo commands read from script files.\n\ +\n\ +@item 2\n\ +Echo commands from functions.\n\ +\n\ +@item 4\n\ +Echo commands read from command line.\n\ +@end table\n\ +\n\ +More than one state can be active at once. For example, a value of 3 is\n\ +equivalent to the command @kbd{echo on all}.\n\ +\n\ +The value of @code{echo_executing_commands} may be set by the @kbd{echo}\n\ +command or the command line option @option{--echo-commands}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (echo_executing_commands); +} + +DEFUN (__request_drawnow__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __request_drawnow__ ()\n\ +@deftypefnx {Built-in Function} {} __request_drawnow__ (@var{flag})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + Vdrawnow_requested = true; + else if (nargin == 1) + Vdrawnow_requested = args(0).bool_value (); + else + print_usage (); + + return retval; +} + +DEFUN (__gud_mode__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __gud_mode__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = Vgud_mode; + else if (nargin == 1) + Vgud_mode = args(0).bool_value (); + else + print_usage (); + + return retval; +} + +DEFUN (filemarker, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} filemarker ()\n\ +@deftypefnx {Built-in Function} {} filemarker (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} filemarker (@var{new_val}, \"local\")\n\ +Query or set the character used to separate filename from the\n\ +the subfunction names contained within the file. This can be used in\n\ +a generic manner to interact with subfunctions. For example,\n\ +\n\ +@example\n\ +help ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ +@end example\n\ +\n\ +@noindent\n\ +returns the help string associated with the subfunction @code{mysubfunc}\n\ +of the function @code{myfunc}. Another use of @code{filemarker} is when\n\ +debugging it allows easier placement of breakpoints within subfunctions.\n\ +For example,\n\ +\n\ +@example\n\ +dbstop ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ +@end example\n\ +\n\ +@noindent\n\ +will set a breakpoint at the first line of the subfunction @code{mysubfunc}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + char tmp = Vfilemarker; + octave_value retval = SET_INTERNAL_VARIABLE (filemarker); + + // The character passed must not be a legal character for a function name + if (! error_state && (::isalnum (Vfilemarker) || Vfilemarker == '_')) + { + Vfilemarker = tmp; + error ("filemarker: character can not be a valid character for a function name"); + } + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/input.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/input.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,123 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Use the GNU readline library for command line editing and hisory. + +#if !defined (octave_input_h) +#define octave_input_h 1 + +#include + +#include + +#include "oct-time.h" +#include "oct-obj.h" +#include "pager.h" + +class octave_value; + +extern OCTINTERP_API int octave_read (char *buf, unsigned max_size); +extern OCTINTERP_API FILE *get_input_from_file (const std::string& name, int warn = 1); +extern OCTINTERP_API FILE *get_input_from_stdin (void); + +// Global pointer for eval(). +extern std::string current_eval_string; + +// TRUE means get input from current_eval_string. +extern bool get_input_from_eval_string; + +// TRUE means we haven't been asked for the input from +// current_eval_string yet. +extern bool input_from_eval_string_pending; + +// TRUE means that input is coming from a file that was named on +// the command line. +extern bool input_from_command_line_file; + +// TRUE means that stdin is a terminal, not a pipe or redirected file. +extern bool stdin_is_tty; + +// TRUE means we're parsing a function file. +extern bool reading_fcn_file; + +// Simple name of function file we are reading. +extern std::string curr_fcn_file_name; + +// Full name of file we are reading. +extern std::string curr_fcn_file_full_name; + +// TRUE means we're parsing a script file. +extern bool reading_script_file; + +// TRUE means we're parsing a classdef file. +extern bool reading_classdef_file; + +// If we are reading from an M-file, this is it. +extern FILE *ff_instream; + +// TRUE means this is an interactive shell. +extern bool interactive; + +// TRUE means the user forced this shell to be interactive (-i). +extern bool forced_interactive; + +// Should we issue a prompt? +extern int promptflag; + +// A line of input. +extern std::string current_input_line; + +// TRUE after a call to completion_matches. +extern bool octave_completion_matches_called; + +// TRUE if the plotting system has requested a call to drawnow at +// the next user prompt. +extern OCTINTERP_API bool Vdrawnow_requested; + +// TRUE if we are in debugging mode. +extern OCTINTERP_API bool Vdebugging; + +extern std::string gnu_readline (const std::string& s, bool force_readline = false); + +extern void initialize_command_input (void); + +extern bool octave_yes_or_no (const std::string& prompt); + +extern octave_value do_keyboard (const octave_value_list& args = octave_value_list ()); + +extern std::string VPS4; + +extern char Vfilemarker; + +enum echo_state +{ + ECHO_OFF = 0, + ECHO_SCRIPTS = 1, + ECHO_FUNCTIONS = 2, + ECHO_CMD_LINE = 4 +}; + +extern int Vecho_executing_commands; + +extern octave_time Vlast_prompt_time; + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/load-path.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/load-path.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,2327 @@ +/* + +Copyright (C) 2006-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "dir-ops.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "pathsearch.h" +#include "singleton-cleanup.h" + +#include "defaults.h" +#include "defun.h" +#include "input.h" +#include "load-path.h" +#include "pager.h" +#include "parse.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" + +load_path *load_path::instance = 0; +load_path::hook_fcn_ptr load_path::add_hook = execute_pkg_add; +load_path::hook_fcn_ptr load_path::remove_hook = execute_pkg_del; +std::string load_path::command_line_path; +std::string load_path::sys_path; +load_path::abs_dir_cache_type load_path::abs_dir_cache; + +void +load_path::dir_info::update (void) +{ + file_stat fs (dir_name); + + if (fs) + { + if (is_relative) + { + try + { + std::string abs_name = octave_env::make_absolute (dir_name); + + abs_dir_cache_iterator p = abs_dir_cache.find (abs_name); + + if (p != abs_dir_cache.end ()) + { + // The directory is in the cache of all directories + // we have visited (indexed by its absolute name). + // If it is out of date, initialize it. Otherwise, + // copy the info from the cache. By doing that, we + // avoid unnecessary calls to stat that can slow + // things down tremendously for large directories. + + const dir_info& di = p->second; + + if (fs.mtime () + fs.time_resolution () > di.dir_time_last_checked) + initialize (); + else + *this = di; + } + else + { + // We haven't seen this directory before. + + initialize (); + } + } + catch (octave_execution_exception) + { + // Skip updating if we don't know where we are, but + // don't treat it as an error. + + error_state = 0; + } + } + else if (fs.mtime () + fs.time_resolution () > dir_time_last_checked) + initialize (); + } + else + { + std::string msg = fs.error (); + warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); + } +} + +void +load_path::dir_info::initialize (void) +{ + is_relative = ! octave_env::absolute_pathname (dir_name); + + dir_time_last_checked = octave_time (static_cast (0)); + + file_stat fs (dir_name); + + if (fs) + { + method_file_map.clear (); + + dir_mtime = fs.mtime (); + dir_time_last_checked = octave_time (); + + get_file_list (dir_name); + + try + { + std::string abs_name = octave_env::make_absolute (dir_name); + + // FIXME -- nothing is ever removed from this cache of + // directory information, so there could be some resource + // problems. Perhaps it should be pruned from time to time. + + abs_dir_cache[abs_name] = *this; + } + catch (octave_execution_exception) + { + // Skip updating if we don't know where we are. + } + } + else + { + std::string msg = fs.error (); + warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); + } +} + +void +load_path::dir_info::get_file_list (const std::string& d) +{ + dir_entry dir (d); + + if (dir) + { + string_vector flist = dir.read (); + + octave_idx_type len = flist.length (); + + all_files.resize (len); + fcn_files.resize (len); + + octave_idx_type all_files_count = 0; + octave_idx_type fcn_files_count = 0; + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = flist[i]; + + std::string full_name = file_ops::concat (d, fname); + + file_stat fs (full_name); + + if (fs) + { + if (fs.is_dir ()) + { + if (fname == "private") + get_private_file_map (full_name); + else if (fname[0] == '@') + get_method_file_map (full_name, fname.substr (1)); + } + else + { + all_files[all_files_count++] = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + std::string ext = fname.substr (pos); + + if (ext == ".m" || ext == ".oct" || ext == ".mex") + { + std::string base = fname.substr (0, pos); + + if (valid_identifier (base)) + fcn_files[fcn_files_count++] = fname; + } + } + } + } + } + + all_files.resize (all_files_count); + fcn_files.resize (fcn_files_count); + } + else + { + std::string msg = dir.error (); + warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); + } +} + +load_path::dir_info::fcn_file_map_type +get_fcn_files (const std::string& d) +{ + load_path::dir_info::fcn_file_map_type retval; + + dir_entry dir (d); + + if (dir) + { + string_vector flist = dir.read (); + + octave_idx_type len = flist.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = flist[i]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + + if (valid_identifier (base)) + { + int t = 0; + + if (ext == ".m") + t = load_path::M_FILE; + else if (ext == ".oct") + t = load_path::OCT_FILE; + else if (ext == ".mex") + t = load_path::MEX_FILE; + + retval[base] |= t; + } + } + } + } + else + { + std::string msg = dir.error (); + warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); + } + + return retval; +} + +void +load_path::dir_info::get_private_file_map (const std::string& d) +{ + private_file_map = get_fcn_files (d); +} + +void +load_path::dir_info::get_method_file_map (const std::string& d, + const std::string& class_name) +{ + method_file_map[class_name].method_file_map = get_fcn_files (d); + + std::string pd = file_ops::concat (d, "private"); + + file_stat fs (pd); + + if (fs && fs.is_dir ()) + method_file_map[class_name].private_file_map = get_fcn_files (pd); +} + +bool +load_path::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new load_path (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create load path object!"); + + retval = false; + } + + return retval; +} + +// FIXME -- maybe we should also maintain a map to speed up this +// method of access. + +load_path::const_dir_info_list_iterator +load_path::find_dir_info (const std::string& dir_arg) const +{ + std::string dir = file_ops::tilde_expand (dir_arg); + + const_dir_info_list_iterator retval = dir_info_list.begin (); + + while (retval != dir_info_list.end ()) + { + if (retval->dir_name == dir) + break; + + retval++; + } + + return retval; +} + +load_path::dir_info_list_iterator +load_path::find_dir_info (const std::string& dir_arg) +{ + std::string dir = file_ops::tilde_expand (dir_arg); + + dir_info_list_iterator retval = dir_info_list.begin (); + + while (retval != dir_info_list.end ()) + { + if (retval->dir_name == dir) + break; + + retval++; + } + + return retval; +} + +bool +load_path::contains (const std::string& dir) const +{ + return find_dir_info (dir) != dir_info_list.end (); +} + +void +load_path::move_fcn_map (const std::string& dir_name, + const string_vector& fcn_files, bool at_end) +{ + octave_idx_type len = fcn_files.length (); + + for (octave_idx_type k = 0; k < len; k++) + { + std::string fname = fcn_files[k]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + } + + file_info_list_type& file_info_list = fcn_map[base]; + + if (file_info_list.size () == 1) + continue; + else + { + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == dir_name) + { + file_info fi = *p; + + file_info_list.erase (p); + + if (at_end) + file_info_list.push_back (fi); + else + file_info_list.push_front (fi); + + break; + } + } + } + } +} + +void +load_path::move_method_map (const std::string& dir_name, bool at_end) +{ + for (method_map_iterator i = method_map.begin (); + i != method_map.end (); + i++) + { + std::string class_name = i->first; + + fcn_map_type& fm = i->second; + + std::string full_dir_name + = file_ops::concat (dir_name, "@" + class_name); + + for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) + { + file_info_list_type& file_info_list = q->second; + + if (file_info_list.size () == 1) + continue; + else + { + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == full_dir_name) + { + file_info fi = *p; + + file_info_list.erase (p); + + if (at_end) + file_info_list.push_back (fi); + else + file_info_list.push_front (fi); + + break; + } + } + } + } + } +} + +void +load_path::move (dir_info_list_iterator i, bool at_end) +{ + if (dir_info_list.size () > 1) + { + dir_info di = *i; + + dir_info_list.erase (i); + + if (at_end) + dir_info_list.push_back (di); + else + dir_info_list.push_front (di); + + std::string dir_name = di.dir_name; + + move_fcn_map (dir_name, di.fcn_files, at_end); + + // No need to move elements of private function map. + + move_method_map (dir_name, at_end); + } +} + +static void +maybe_add_path_elts (std::string& path, const std::string& dir) +{ + std::string tpath = genpath (dir); + + if (! tpath.empty ()) + { + if (path.empty ()) + path = tpath; + else + path += dir_path::path_sep_str () + tpath; + } +} + +void +load_path::do_initialize (bool set_initial_path) +{ + sys_path = ""; + + if (set_initial_path) + { + maybe_add_path_elts (sys_path, Vlocal_ver_oct_file_dir); + maybe_add_path_elts (sys_path, Vlocal_api_oct_file_dir); + maybe_add_path_elts (sys_path, Vlocal_oct_file_dir); + maybe_add_path_elts (sys_path, Vlocal_ver_fcn_file_dir); + maybe_add_path_elts (sys_path, Vlocal_api_fcn_file_dir); + maybe_add_path_elts (sys_path, Vlocal_fcn_file_dir); + maybe_add_path_elts (sys_path, Voct_file_dir); + maybe_add_path_elts (sys_path, Vfcn_file_dir); + } + + std::string tpath = load_path::command_line_path; + + if (tpath.empty ()) + tpath = octave_env::getenv ("OCTAVE_PATH"); + + std::string xpath; + + if (! tpath.empty ()) + { + xpath = tpath; + + if (! sys_path.empty ()) + xpath += dir_path::path_sep_str () + sys_path; + } + else + xpath = sys_path; + + do_set (xpath, false, true); +} + +void +load_path::do_clear (void) +{ + dir_info_list.clear (); + fcn_map.clear (); + private_fcn_map.clear (); + method_map.clear (); +} + +static std::list +split_path (const std::string& p) +{ + std::list retval; + + size_t beg = 0; + size_t end = p.find (dir_path::path_sep_char ()); + + size_t len = p.length (); + + while (end != std::string::npos) + { + std::string elt = p.substr (beg, end-beg); + + if (! elt.empty ()) + retval.push_back (elt); + + beg = end + 1; + + if (beg == len) + break; + + end = p.find (dir_path::path_sep_char (), beg); + } + + std::string elt = p.substr (beg); + + if (! elt.empty ()) + retval.push_back (elt); + + return retval; +} + +void +load_path::do_set (const std::string& p, bool warn, bool is_init) +{ + // Use a list when we need to preserve order. + std::list elts = split_path (p); + + // Use a set when we need to search and order is not important. + std::set elts_set (elts.begin (), elts.end ()); + + if (is_init) + init_dirs = elts_set; + else + { + for (std::set::const_iterator it = init_dirs.begin (); + it != init_dirs.end (); it++) + { + if (elts_set.find (*it) == elts_set.end ()) + { + warning_with_id ("Octave:remove-init-dir", + "default load path altered. Some built-in functions may not be found. Try restoredefaultpath() to recover it."); + break; + } + } + } + + // Temporarily disable add hook. + + unwind_protect frame; + frame.protect_var (add_hook); + + add_hook = 0; + + do_clear (); + + for (std::list::const_iterator i = elts.begin (); + i != elts.end (); i++) + do_append (*i, warn); + + // Restore add hook and execute for all newly added directories. + frame.run_top (); + + for (dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + { + if (add_hook) + add_hook (i->dir_name); + } + + // Always prepend current directory. + do_prepend (".", warn); +} + +void +load_path::do_append (const std::string& dir, bool warn) +{ + if (! dir.empty ()) + do_add (dir, true, warn); +} + +void +load_path::do_prepend (const std::string& dir, bool warn) +{ + if (! dir.empty ()) + do_add (dir, false, warn); +} + +// Strip trailing directory separators. + +static std::string +strip_trailing_separators (const std::string& dir_arg) +{ + std::string dir = dir_arg; + + size_t k = dir.length (); + + while (k > 1 && file_ops::is_dir_sep (dir[k-1])) + k--; + + if (k < dir.length ()) + dir.resize (k); + + return dir; +} + +void +load_path::do_add (const std::string& dir_arg, bool at_end, bool warn) +{ + size_t len = dir_arg.length (); + + if (len > 1 && dir_arg.substr (len-2) == "//") + warning_with_id ("Octave:recursive-path-search", + "trailing `//' is no longer special in search path elements"); + + std::string dir = file_ops::tilde_expand (dir_arg); + + dir = strip_trailing_separators (dir); + + dir_info_list_iterator i = find_dir_info (dir); + + if (i != dir_info_list.end ()) + move (i, at_end); + else + { + file_stat fs (dir); + + if (fs) + { + if (fs.is_dir ()) + { + dir_info di (dir); + + if (! error_state) + { + if (at_end) + dir_info_list.push_back (di); + else + dir_info_list.push_front (di); + + add_to_fcn_map (di, at_end); + + add_to_private_fcn_map (di); + + add_to_method_map (di, at_end); + + if (add_hook) + add_hook (dir); + } + } + else if (warn) + warning ("addpath: %s: not a directory", dir_arg.c_str ()); + } + else if (warn) + { + std::string msg = fs.error (); + warning ("addpath: %s: %s", dir_arg.c_str (), msg.c_str ()); + } + } + + // FIXME -- is there a better way to do this? + + i = find_dir_info ("."); + + if (i != dir_info_list.end ()) + move (i, false); +} + +void +load_path::remove_fcn_map (const std::string& dir, + const string_vector& fcn_files) +{ + octave_idx_type len = fcn_files.length (); + + for (octave_idx_type k = 0; k < len; k++) + { + std::string fname = fcn_files[k]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + } + + file_info_list_type& file_info_list = fcn_map[base]; + + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == dir) + { + file_info_list.erase (p); + + if (file_info_list.empty ()) + fcn_map.erase (fname); + + break; + } + } + } +} + +void +load_path::remove_private_fcn_map (const std::string& dir) +{ + private_fcn_map_iterator p = private_fcn_map.find (dir); + + if (p != private_fcn_map.end ()) + private_fcn_map.erase (p); +} + +void +load_path::remove_method_map (const std::string& dir) +{ + for (method_map_iterator i = method_map.begin (); + i != method_map.end (); + i++) + { + std::string class_name = i->first; + + fcn_map_type& fm = i->second; + + std::string full_dir_name = file_ops::concat (dir, "@" + class_name); + + for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) + { + file_info_list_type& file_info_list = q->second; + + if (file_info_list.size () == 1) + continue; + else + { + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == full_dir_name) + { + file_info_list.erase (p); + + // FIXME -- if there are no other elements, we + // should remove this element of fm but calling + // erase here would invalidate the iterator q. + + break; + } + } + } + } + } +} + +bool +load_path::do_remove (const std::string& dir_arg) +{ + bool retval = false; + + if (! dir_arg.empty ()) + { + if (dir_arg == ".") + { + warning ("rmpath: can't remove \".\" from path"); + + // Avoid additional warnings. + retval = true; + } + else + { + std::string dir = file_ops::tilde_expand (dir_arg); + + dir = strip_trailing_separators (dir); + + dir_info_list_iterator i = find_dir_info (dir); + + if (i != dir_info_list.end ()) + { + retval = true; + + if (remove_hook) + remove_hook (dir); + + string_vector fcn_files = i->fcn_files; + + dir_info_list.erase (i); + + remove_fcn_map (dir, fcn_files); + + remove_private_fcn_map (dir); + + remove_method_map (dir); + } + } + } + + return retval; +} + +void +load_path::do_update (void) const +{ + // I don't see a better way to do this because we need to + // preserve the correct directory ordering for new files that + // have appeared. + + fcn_map.clear (); + + private_fcn_map.clear (); + + method_map.clear (); + + for (dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + dir_info& di = *p; + + di.update (); + + add_to_fcn_map (di, true); + + add_to_private_fcn_map (di); + + add_to_method_map (di, true); + } +} + +bool +load_path::check_file_type (std::string& fname, int type, int possible_types, + const std::string& fcn, const char *who) +{ + bool retval = false; + + if (type == load_path::OCT_FILE) + { + if ((type & possible_types) == load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + } + else if (type == load_path::M_FILE) + { + if ((type & possible_types) == load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else if (type == load_path::MEX_FILE) + { + if ((type & possible_types) == load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + } + else if (type == (load_path::M_FILE | load_path::OCT_FILE)) + { + if (possible_types & load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + else if (possible_types & load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else if (type == (load_path::M_FILE | load_path::MEX_FILE)) + { + if (possible_types & load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + else if (possible_types & load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else if (type == (load_path::OCT_FILE | load_path::MEX_FILE)) + { + if (possible_types & load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + else if (possible_types & load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + } + else if (type == (load_path::M_FILE | load_path::OCT_FILE + | load_path::MEX_FILE)) + { + if (possible_types & load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + else if (possible_types & load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + else if (possible_types & load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else + error ("%s: %s: invalid type code = %d", who, fcn.c_str (), type); + + return retval; +} + +std::string +load_path::do_find_fcn (const std::string& fcn, std::string& dir_name, + int type) const +{ + std::string retval; + + // update (); + + if (fcn.length () > 0 && fcn[0] == '@') + { + size_t pos = fcn.find ('/'); + + if (pos != std::string::npos) + { + std::string class_name = fcn.substr (1, pos-1); + std::string meth = fcn.substr (pos+1); + + retval = do_find_method (class_name, meth, dir_name); + } + else + retval = std::string (); + } + else + { + dir_name = std::string (); + + const_fcn_map_iterator p = fcn_map.find (fcn); + + if (p != fcn_map.end ()) + { + const file_info_list_type& file_info_list = p->second; + + for (const_file_info_list_iterator i = file_info_list.begin (); + i != file_info_list.end (); + i++) + { + const file_info& fi = *i; + + retval = file_ops::concat (fi.dir_name, fcn); + + if (check_file_type (retval, type, fi.types, + fcn, "load_path::do_find_fcn")) + { + dir_name = fi.dir_name; + break; + } + else + retval = std::string (); + } + } + } + + return retval; +} + +std::string +load_path::do_find_private_fcn (const std::string& dir, + const std::string& fcn, int type) const +{ + std::string retval; + + // update (); + + const_private_fcn_map_iterator q = private_fcn_map.find (dir); + + if (q != private_fcn_map.end ()) + { + const dir_info::fcn_file_map_type& m = q->second; + + dir_info::const_fcn_file_map_iterator p = m.find (fcn); + + if (p != m.end ()) + { + std::string fname + = file_ops::concat (file_ops::concat (dir, "private"), fcn); + + if (check_file_type (fname, type, p->second, fcn, + "load_path::find_private_fcn")) + retval = fname; + } + } + + return retval; +} + +std::string +load_path::do_find_method (const std::string& class_name, + const std::string& meth, + std::string& dir_name, int type) const +{ + std::string retval; + + // update (); + + dir_name = std::string (); + + const_method_map_iterator q = method_map.find (class_name); + + if (q != method_map.end ()) + { + const fcn_map_type& m = q->second; + + const_fcn_map_iterator p = m.find (meth); + + if (p != m.end ()) + { + const file_info_list_type& file_info_list = p->second; + + for (const_file_info_list_iterator i = file_info_list.begin (); + i != file_info_list.end (); + i++) + { + const file_info& fi = *i; + + retval = file_ops::concat (fi.dir_name, meth); + + bool found = check_file_type (retval, type, fi.types, + meth, "load_path::do_find_method"); + + if (found) + { + dir_name = fi.dir_name; + break; + } + else + retval = std::string (); + } + } + } + + return retval; +} + +std::list +load_path::do_methods (const std::string& class_name) const +{ + std::list retval; + + // update (); + + const_method_map_iterator q = method_map.find (class_name); + + if (q != method_map.end ()) + { + const fcn_map_type& m = q->second; + + for (const_fcn_map_iterator p = m.begin (); p != m.end (); p++) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; +} + +std::list +load_path::do_overloads (const std::string& meth) const +{ + std::list retval; + + // update (); + + for (const_method_map_iterator q = method_map.begin (); + q != method_map.end (); q++) + { + const fcn_map_type& m = q->second; + + if (m.find (meth) != m.end ()) + retval.push_back (q->first); + } + + return retval; +} + +std::string +load_path::do_find_file (const std::string& file) const +{ + std::string retval; + + if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) + { + if (octave_env::absolute_pathname (file) + || octave_env::rooted_relative_pathname (file)) + { + file_stat fs (file); + + if (fs.exists ()) + return file; + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string tfile = file_ops::concat (p->dir_name, file); + + file_stat fs (tfile); + + if (fs.exists ()) + return tfile; + } + } + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + string_vector all_files = p->all_files; + + octave_idx_type len = all_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + if (all_files[i] == file) + return file_ops::concat (p->dir_name, file); + } + } + } + + return retval; +} + +std::string +load_path::do_find_dir (const std::string& dir) const +{ + std::string retval; + + if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos + && (octave_env::absolute_pathname (dir) + || octave_env::rooted_relative_pathname (dir))) + { + file_stat fs (dir); + + if (fs.exists () && fs.is_dir ()) + return dir; + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string dname = octave_env::make_absolute (p->dir_name); + + size_t dname_len = dname.length (); + + if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) + { + dname = dname.substr (0, dname_len - 1); + dname_len--; + } + + size_t dir_len = dir.length (); + + if (dname_len >= dir_len + && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) + && dir.compare (dname.substr (dname_len - dir_len)) == 0) + { + file_stat fs (p->dir_name); + + if (fs.exists () && fs.is_dir ()) + return p->dir_name; + } + } + } + + return retval; +} + +string_vector +load_path::do_find_matching_dirs (const std::string& dir) const +{ + std::list retlist; + + if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos + && (octave_env::absolute_pathname (dir) + || octave_env::rooted_relative_pathname (dir))) + { + file_stat fs (dir); + + if (fs.exists () && fs.is_dir ()) + retlist.push_back (dir); + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string dname = octave_env::make_absolute (p->dir_name); + + size_t dname_len = dname.length (); + + if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) + { + dname = dname.substr (0, dname_len - 1); + dname_len--; + } + + size_t dir_len = dir.length (); + + if (dname_len >= dir_len + && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) + && dir.compare (dname.substr (dname_len - dir_len)) == 0) + { + file_stat fs (p->dir_name); + + if (fs.exists () && fs.is_dir ()) + retlist.push_back (p->dir_name); + } + } + } + + return retlist; +} + +std::string +load_path::do_find_first_of (const string_vector& flist) const +{ + std::string retval; + + std::string dir_name; + std::string file_name; + + octave_idx_type flen = flist.length (); + octave_idx_type rel_flen = 0; + + string_vector rel_flist (flen); + + for (octave_idx_type i = 0; i < flen; i++) + { + std::string file = flist[i]; + + if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) + { + if (octave_env::absolute_pathname (file) + || octave_env::rooted_relative_pathname (file)) + { + file_stat fs (file); + + if (fs.exists ()) + return file; + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string tfile = file_ops::concat (p->dir_name, file); + + file_stat fs (tfile); + + if (fs.exists ()) + return tfile; + } + } + } + else + rel_flist[rel_flen++] = file; + } + + rel_flist.resize (rel_flen); + + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + string_vector all_files = p->all_files; + + octave_idx_type len = all_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + for (octave_idx_type j = 0; j < rel_flen; j++) + { + if (all_files[i] == rel_flist[j]) + { + dir_name = p->dir_name; + file_name = rel_flist[j]; + + goto done; + } + } + } + } + + done: + + if (! dir_name.empty ()) + retval = file_ops::concat (dir_name, file_name); + + return retval; +} + +string_vector +load_path::do_find_all_first_of (const string_vector& flist) const +{ + std::list retlist; + + std::string dir_name; + std::string file_name; + + octave_idx_type flen = flist.length (); + octave_idx_type rel_flen = 0; + + string_vector rel_flist (flen); + + for (octave_idx_type i = 0; i < flen; i++) + { + std::string file = flist[i]; + + if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) + { + if (octave_env::absolute_pathname (file) + || octave_env::rooted_relative_pathname (file)) + { + file_stat fs (file); + + if (fs.exists ()) + retlist.push_back (file); + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string tfile = file_ops::concat (p->dir_name, file); + + file_stat fs (tfile); + + if (fs.exists ()) + retlist.push_back (tfile); + } + } + } + else + rel_flist[rel_flen++] = file; + } + + rel_flist.resize (rel_flen); + + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + string_vector all_files = p->all_files; + + octave_idx_type len = all_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + for (octave_idx_type j = 0; j < rel_flen; j++) + { + if (all_files[i] == rel_flist[j]) + retlist.push_back + (file_ops::concat (p->dir_name, rel_flist[j])); + } + } + } + + return retlist; +} + +string_vector +load_path::do_dirs (void) const +{ + size_t len = dir_info_list.size (); + + string_vector retval (len); + + octave_idx_type k = 0; + + for (const_dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + retval[k++] = i->dir_name; + + return retval; +} + +std::list +load_path::do_dir_list (void) const +{ + std::list retval; + + for (const_dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + retval.push_back (i->dir_name); + + return retval; +} + +string_vector +load_path::do_files (const std::string& dir, bool omit_exts) const +{ + string_vector retval; + + const_dir_info_list_iterator p = find_dir_info (dir); + + if (p != dir_info_list.end ()) + retval = p->fcn_files; + + if (omit_exts) + { + octave_idx_type len = retval.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = retval[i]; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + retval[i] = fname.substr (0, pos); + } + } + + return retval; +} + +string_vector +load_path::do_fcn_names (void) const +{ + size_t len = fcn_map.size (); + + string_vector retval (len); + + octave_idx_type count = 0; + + for (const_fcn_map_iterator p = fcn_map.begin (); + p != fcn_map.end (); + p++) + retval[count++] = p->first; + + return retval; +} + +std::string +load_path::do_path (void) const +{ + std::string xpath; + + string_vector xdirs = load_path::dirs (); + + octave_idx_type len = xdirs.length (); + + if (len > 0) + xpath = xdirs[0]; + + for (octave_idx_type i = 1; i < len; i++) + xpath += dir_path::path_sep_str () + xdirs[i]; + + return xpath; +} + +void +print_types (std::ostream& os, int types) +{ + bool printed_type = false; + + if (types & load_path::OCT_FILE) + { + os << "oct"; + printed_type = true; + } + + if (types & load_path::MEX_FILE) + { + if (printed_type) + os << "|"; + os << "mex"; + printed_type = true; + } + + if (types & load_path::M_FILE) + { + if (printed_type) + os << "|"; + os << "m"; + printed_type = true; + } +} + +void +print_fcn_list (std::ostream& os, + const load_path::dir_info::fcn_file_map_type& lst) +{ + for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); + p != lst.end (); + p++) + { + os << " " << p->first << " ("; + + print_types (os, p->second); + + os << ")\n"; + } +} + +string_vector +get_file_list (const load_path::dir_info::fcn_file_map_type& lst) +{ + octave_idx_type n = lst.size (); + + string_vector retval (n); + + octave_idx_type count = 0; + + for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); + p != lst.end (); + p++) + { + std::string nm = p->first; + + int types = p->second; + + if (types & load_path::OCT_FILE) + nm += ".oct"; + else if (types & load_path::MEX_FILE) + nm += ".mex"; + else + nm += ".m"; + + retval[count++] = nm; + } + + return retval; +} + +void +load_path::do_display (std::ostream& os) const +{ + for (const_dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + { + string_vector fcn_files = i->fcn_files; + + if (! fcn_files.empty ()) + { + os << "\n*** function files in " << i->dir_name << ":\n\n"; + + fcn_files.list_in_columns (os); + } + + const dir_info::method_file_map_type& method_file_map + = i->method_file_map; + + if (! method_file_map.empty ()) + { + for (dir_info::const_method_file_map_iterator p = method_file_map.begin (); + p != method_file_map.end (); + p++) + { + os << "\n*** methods in " << i->dir_name + << "/@" << p->first << ":\n\n"; + + const dir_info::class_info& ci = p->second; + + string_vector method_files = get_file_list (ci.method_file_map); + + method_files.list_in_columns (os); + } + } + } + + for (const_private_fcn_map_iterator i = private_fcn_map.begin (); + i != private_fcn_map.end (); i++) + { + os << "\n*** private functions in " + << file_ops::concat (i->first, "private") << ":\n\n"; + + print_fcn_list (os, i->second); + } + +#if defined (DEBUG_LOAD_PATH) + + for (const_fcn_map_iterator i = fcn_map.begin (); + i != fcn_map.end (); + i++) + { + os << i->first << ":\n"; + + const file_info_list_type& file_info_list = i->second; + + for (const_file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + os << " " << p->dir_name << " ("; + + print_types (os, p->types); + + os << ")\n"; + } + } + + for (const_method_map_iterator i = method_map.begin (); + i != method_map.end (); + i++) + { + os << "CLASS " << i->first << ":\n"; + + const fcn_map_type& fm = i->second; + + for (const_fcn_map_iterator q = fm.begin (); + q != fm.end (); + q++) + { + os << " " << q->first << ":\n"; + + const file_info_list_type& file_info_list = q->second; + + for (const_file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + os << " " << p->dir_name << " ("; + + print_types (os, p->types); + + os << ")\n"; + } + } + } + + os << "\n"; + +#endif +} + +// True if a path is contained in a path list separated by path_sep_char +static bool +in_path_list (const std::string& path_list, const std::string& path) +{ + size_t ps = path.size (), pls = path_list.size (), pos = path_list.find (path); + char psc = dir_path::path_sep_char (); + while (pos != std::string::npos) + { + if ((pos == 0 || path_list[pos-1] == psc) + && (pos + ps == pls || path_list[pos + ps] == psc)) + return true; + else + pos = path_list.find (path, pos + 1); + } + + return false; +} + +void +load_path::add_to_fcn_map (const dir_info& di, bool at_end) const +{ + std::string dir_name = di.dir_name; + + string_vector fcn_files = di.fcn_files; + + octave_idx_type len = fcn_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = fcn_files[i]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + } + + file_info_list_type& file_info_list = fcn_map[base]; + + file_info_list_iterator p = file_info_list.begin (); + + while (p != file_info_list.end ()) + { + if (p->dir_name == dir_name) + break; + + p++; + } + + int t = 0; + if (ext == ".m") + t = load_path::M_FILE; + else if (ext == ".oct") + t = load_path::OCT_FILE; + else if (ext == ".mex") + t = load_path::MEX_FILE; + + if (p == file_info_list.end ()) + { + file_info fi (dir_name, t); + + if (at_end) + file_info_list.push_back (fi); + else + { + // Warn if a built-in or library function is being shadowed. + + if (! file_info_list.empty ()) + { + file_info& old = file_info_list.front (); + + // FIXME -- do we need to be more careful about the + // way we look for old.dir_name in sys_path to avoid + // partial matches? + + // Don't warn about Contents.m files since we expect + // more than one to exist in the load path. + + if (fname != "Contents.m" + && sys_path.find (old.dir_name) != std::string::npos + && in_path_list (sys_path, old.dir_name)) + { + std::string fcn_path = file_ops::concat (dir_name, fname); + + warning_with_id ("Octave:shadowed-function", + "function %s shadows a core library function", + fcn_path.c_str ()); + } + } + else if (symbol_table::is_built_in_function_name (base)) + { + std::string fcn_path = file_ops::concat (dir_name, fname); + warning_with_id ("Octave:shadowed-function", + "function %s shadows a built-in function", + fcn_path.c_str ()); + } + + file_info_list.push_front (fi); + } + } + else + { + file_info& fi = *p; + + fi.types |= t; + } + } +} + +void +load_path::add_to_private_fcn_map (const dir_info& di) const +{ + dir_info::fcn_file_map_type private_file_map = di.private_file_map; + + if (! private_file_map.empty ()) + private_fcn_map[di.dir_name] = private_file_map; +} + +void +load_path::add_to_method_map (const dir_info& di, bool at_end) const +{ + std::string dir_name = di.dir_name; + + // + dir_info::method_file_map_type method_file_map = di.method_file_map; + + for (dir_info::const_method_file_map_iterator q = method_file_map.begin (); + q != method_file_map.end (); + q++) + { + std::string class_name = q->first; + + fcn_map_type& fm = method_map[class_name]; + + std::string full_dir_name + = file_ops::concat (dir_name, "@" + class_name); + + const dir_info::class_info& ci = q->second; + + // + const dir_info::fcn_file_map_type& m = ci.method_file_map; + + for (dir_info::const_fcn_file_map_iterator p = m.begin (); + p != m.end (); + p++) + { + std::string base = p->first; + + int types = p->second; + + file_info_list_type& file_info_list = fm[base]; + + file_info_list_iterator p2 = file_info_list.begin (); + + while (p2 != file_info_list.end ()) + { + if (p2->dir_name == full_dir_name) + break; + + p2++; + } + + if (p2 == file_info_list.end ()) + { + file_info fi (full_dir_name, types); + + if (at_end) + file_info_list.push_back (fi); + else + file_info_list.push_front (fi); + } + else + { + // FIXME -- is this possible? + + file_info& fi = *p2; + + fi.types = types; + } + } + + // + dir_info::fcn_file_map_type private_file_map = ci.private_file_map; + + if (! private_file_map.empty ()) + private_fcn_map[full_dir_name] = private_file_map; + } +} + +std::string +genpath (const std::string& dirname, const string_vector& skip) +{ + std::string retval; + + dir_entry dir (dirname); + + if (dir) + { + retval = dirname; + + string_vector dirlist = dir.read (); + + octave_idx_type len = dirlist.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string elt = dirlist[i]; + + bool skip_p = (elt == "." || elt == ".." || elt[0] == '@'); + + if (! skip_p) + { + for (octave_idx_type j = 0; j < skip.length (); j++) + { + skip_p = (elt == skip[j]); + if (skip_p) + break; + } + + if (! skip_p) + { + std::string nm = file_ops::concat (dirname, elt); + + file_stat fs (nm); + + if (fs && fs.is_dir ()) + retval += dir_path::path_sep_str () + genpath (nm, skip); + } + } + } + } + + return retval; +} + +static void +execute_pkg_add_or_del (const std::string& dir, + const std::string& script_file) +{ + if (! octave_interpreter_ready) + return; + + unwind_protect frame; + + frame.protect_var (input_from_startup_file); + + input_from_startup_file = true; + + std::string file = file_ops::concat (dir, script_file); + + file_stat fs (file); + + if (fs.exists ()) + source_file (file, "base"); +} + +void +execute_pkg_add (const std::string& dir) +{ + execute_pkg_add_or_del (dir, "PKG_ADD"); +} + +void +execute_pkg_del (const std::string& dir) +{ + execute_pkg_add_or_del (dir, "PKG_DEL"); +} + +DEFUN (genpath, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} genpath (@var{dir})\n\ +@deftypefnx {Built-in Function} {} genpath (@var{dir}, @var{skip}, @dots{})\n\ +Return a path constructed from @var{dir} and all its subdirectories.\n\ +If additional string parameters are given, the resulting path will\n\ +exclude directories with those names.\n\ +@end deftypefn") +{ + octave_value retval; + + octave_idx_type nargin = args.length (); + + if (nargin == 1) + { + std::string dirname = args(0).string_value (); + + if (! error_state) + retval = genpath (dirname); + else + error ("genpath: DIR must be a character string"); + } + else if (nargin > 1) + { + std::string dirname = args(0).string_value (); + + string_vector skip (nargin - 1); + + for (octave_idx_type i = 1; i < nargin; i++) + { + skip[i-1] = args(i).string_value (); + + if (error_state) + break; + } + + if (! error_state) + retval = genpath (dirname, skip); + else + error ("genpath: all arguments must be character strings"); + } + else + print_usage (); + + return retval; +} + +static void +rehash_internal (void) +{ + load_path::update (); + + // FIXME -- maybe we should rename this variable since it is being + // used for more than keeping track of the prompt time. + + // This will force updated functions to be found. + Vlast_prompt_time.stamp (); +} + +DEFUN (rehash, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rehash ()\n\ +Reinitialize Octave's load path directory cache.\n\ +@end deftypefn") +{ + octave_value_list retval; + + rehash_internal (); + + return retval; +} + +DEFUN (command_line_path, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} command_line_path (@dots{})\n\ +Return the command line path variable.\n\ +\n\ +@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + return octave_value (load_path::get_command_line_path ()); +} + +DEFUN (restoredefaultpath, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} restoredefaultpath (@dots{})\n\ +Restore Octave's path to its initial state at startup.\n\ +\n\ +@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + load_path::initialize (true); + + return octave_value (load_path::system_path ()); +} + +// Return Octave's original default list of directories in which to +// search for function files. This corresponds to the path that +// exists prior to running the system's octaverc file or the user's +// ~/.octaverc file + +DEFUN (__pathorig__, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} __pathorig__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return octave_value (load_path::system_path ()); +} + +DEFUN (path, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} path (@dots{})\n\ +Modify or display Octave's load path.\n\ +\n\ +If @var{nargin} and @var{nargout} are zero, display the elements of\n\ +Octave's load path in an easy to read format.\n\ +\n\ +If @var{nargin} is zero and nargout is greater than zero, return the\n\ +current load path.\n\ +\n\ +If @var{nargin} is greater than zero, concatenate the arguments,\n\ +separating them with @code{pathsep}. Set the internal search path\n\ +to the result and return it.\n\ +\n\ +No checks are made for duplicate elements.\n\ +@seealso{addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + octave_value retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("path"); + + if (! error_state) + { + if (argc > 1) + { + std::string path = argv[1]; + + for (int i = 2; i < argc; i++) + path += dir_path::path_sep_str () + argv[i]; + + load_path::set (path, true); + + rehash_internal (); + } + + if (nargout > 0) + retval = load_path::path (); + else if (argc == 1 && nargout == 0) + { + octave_stdout << "\nOctave's search path contains the following directories:\n\n"; + + string_vector dirs = load_path::dirs (); + + dirs.list_in_columns (octave_stdout); + + octave_stdout << "\n"; + } + } + + return retval; +} + +DEFUN (addpath, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} addpath (@var{dir1}, @dots{})\n\ +@deftypefnx {Built-in Function} {} addpath (@var{dir1}, @dots{}, @var{option})\n\ +Add @var{dir1}, @dots{} to the current function search path. If\n\ +@var{option} is \"-begin\" or 0 (the default), prepend the\n\ +directory name to the current path. If @var{option} is \"-end\"\n\ +or 1, append the directory name to the current path.\n\ +Directories added to the path must exist.\n\ +\n\ +In addition to accepting individual directory arguments, lists of\n\ +directory names separated by @code{pathsep} are also accepted. For example:\n\ +\n\ +@example\n\ +addpath (\"dir1:/dir2:~/dir3\")\n\ +@end example\n\ +@seealso{path, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + octave_value retval; + + // Originally written by Bill Denney and Etienne Grossman. Heavily + // modified and translated to C++ by jwe. + + if (nargout > 0) + retval = load_path::path (); + + int nargin = args.length (); + + if (nargin > 0) + { + bool append = false; + + octave_value option_arg = args(nargin-1); + + if (option_arg.is_string ()) + { + std::string option = option_arg.string_value (); + + if (option == "-end") + { + append = true; + nargin--; + } + else if (option == "-begin") + nargin--; + } + else if (option_arg.is_numeric_type ()) + { + int val = option_arg.int_value (); + + if (! error_state) + { + if (val == 0) + nargin--; + else if (val == 1) + { + append = true; + nargin--; + } + else + { + error ("addpath: expecting final argument to be 1 or 0"); + return retval; + } + } + else + { + error ("addpath: expecting final argument to be 1 or 0"); + return retval; + } + } + + bool need_to_update = false; + + for (int i = 0; i < nargin; i++) + { + std::string arg = args(i).string_value (); + + if (! error_state) + { + std::list dir_elts = split_path (arg); + + if (! append) + std::reverse (dir_elts.begin (), dir_elts.end ()); + + for (std::list::const_iterator p = dir_elts.begin (); + p != dir_elts.end (); + p++) + { + std::string dir = *p; + + //dir = regexprep (dir_elts{j}, '//+', "/"); + //dir = regexprep (dir, '/$', ""); + + if (append) + load_path::append (dir, true); + else + load_path::prepend (dir, true); + + need_to_update = true; + } + } + else + error ("addpath: all arguments must be character strings"); + } + + if (need_to_update) + rehash_internal (); + } + else + print_usage (); + + return retval; +} + +DEFUN (rmpath, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rmpath (@var{dir1}, @dots{})\n\ +Remove @var{dir1}, @dots{} from the current function search path.\n\ +\n\ +In addition to accepting individual directory arguments, lists of\n\ +directory names separated by @code{pathsep} are also accepted. For example:\n\ +\n\ +@example\n\ +rmpath (\"dir1:/dir2:~/dir3\")\n\ +@end example\n\ +@seealso{path, addpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + // Originally by Etienne Grossmann. Heavily modified and translated + // to C++ by jwe. + + octave_value retval; + + if (nargout > 0) + retval = load_path::path (); + + int nargin = args.length (); + + if (nargin > 0) + { + bool need_to_update = false; + + for (int i = 0; i < nargin; i++) + { + std::string arg = args(i).string_value (); + + if (! error_state) + { + std::list dir_elts = split_path (arg); + + for (std::list::const_iterator p = dir_elts.begin (); + p != dir_elts.end (); + p++) + { + std::string dir = *p; + + //dir = regexprep (dir_elts{j}, '//+', "/"); + //dir = regexprep (dir, '/$', ""); + + if (! load_path::remove (dir)) + warning ("rmpath: %s: not found", dir.c_str ()); + else + need_to_update = true; + } + } + else + error ("addpath: all arguments must be character strings"); + } + + if (need_to_update) + rehash_internal (); + } + else + print_usage (); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/load-path.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/load-path.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,566 @@ +/* + +Copyright (C) 2006-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_load_path_h) +#define octave_load_path_h 1 + +#include +#include +#include +#include + +#include "pathsearch.h" +#include "str-vec.h" + +class +OCTINTERP_API +load_path +{ +protected: + + load_path (void) + : dir_info_list (), fcn_map (), private_fcn_map (), method_map (), + init_dirs () { } + +public: + + typedef void (*hook_fcn_ptr) (const std::string& dir); + + ~load_path (void) { } + + static void initialize (bool set_initial_path = false) + { + if (instance_ok ()) + instance->do_initialize (set_initial_path); + } + + static void clear (void) + { + if (instance_ok ()) + instance->do_clear (); + } + + static void set (const std::string& p, bool warn = false) + { + if (instance_ok ()) + instance->do_set (p, warn); + } + + static void append (const std::string& dir, bool warn = false) + { + if (instance_ok ()) + instance->do_append (dir, warn); + } + + static void prepend (const std::string& dir, bool warn = false) + { + if (instance_ok ()) + instance->do_prepend (dir, warn); + } + + static bool remove (const std::string& dir) + { + return instance_ok () ? instance->do_remove (dir) : false; + } + + static void update (void) + { + if (instance_ok ()) + instance->do_update (); + } + + static std::string find_method (const std::string& class_name, + const std::string& meth, + std::string& dir_name) + { + return instance_ok () + ? instance->do_find_method (class_name, meth, dir_name) : std::string (); + } + + static std::string find_method (const std::string& class_name, + const std::string& meth) + { + std::string dir_name; + return find_method (class_name, meth, dir_name); + } + + static std::list methods (const std::string& class_name) + { + return instance_ok () + ? instance->do_methods (class_name) : std::list (); + } + + static std::list overloads (const std::string& meth) + { + return instance_ok () + ? instance->do_overloads (meth) : std::list (); + } + + static std::string find_fcn (const std::string& fcn, std::string& dir_name) + { + return instance_ok () + ? instance->do_find_fcn (fcn, dir_name) : std::string (); + } + + static std::string find_fcn (const std::string& fcn) + { + std::string dir_name; + return find_fcn (fcn, dir_name); + } + + static std::string find_private_fcn (const std::string& dir, + const std::string& fcn) + { + return instance_ok () + ? instance->do_find_private_fcn (dir, fcn) : std::string (); + } + + static std::string find_fcn_file (const std::string& fcn) + { + std::string dir_name; + + return instance_ok () ? + instance->do_find_fcn (fcn, dir_name, M_FILE) : std::string (); + } + + static std::string find_oct_file (const std::string& fcn) + { + std::string dir_name; + + return instance_ok () ? + instance->do_find_fcn (fcn, dir_name, OCT_FILE) : std::string (); + } + + static std::string find_mex_file (const std::string& fcn) + { + std::string dir_name; + + return instance_ok () ? + instance->do_find_fcn (fcn, dir_name, MEX_FILE) : std::string (); + } + + static std::string find_file (const std::string& file) + { + return instance_ok () + ? instance->do_find_file (file) : std::string (); + } + + static std::string find_dir (const std::string& dir) + { + return instance_ok () + ? instance->do_find_dir (dir) : std::string (); + } + + static string_vector find_matching_dirs (const std::string& dir) + { + return instance_ok () + ? instance->do_find_matching_dirs (dir) : string_vector (); + } + + static std::string find_first_of (const string_vector& files) + { + return instance_ok () ? + instance->do_find_first_of (files) : std::string (); + } + + static string_vector find_all_first_of (const string_vector& files) + { + return instance_ok () ? + instance->do_find_all_first_of (files) : string_vector (); + } + + static string_vector dirs (void) + { + return instance_ok () ? instance->do_dirs () : string_vector (); + } + + static std::list dir_list (void) + { + return instance_ok () + ? instance->do_dir_list () : std::list (); + } + + static string_vector files (const std::string& dir, bool omit_exts = false) + { + return instance_ok () + ? instance->do_files (dir, omit_exts) : string_vector (); + } + + static string_vector fcn_names (void) + { + return instance_ok () ? instance->do_fcn_names () : string_vector (); + } + + static std::string path (void) + { + return instance_ok () ? instance->do_path () : std::string (); + } + + static void display (std::ostream& os) + { + if (instance_ok ()) + instance->do_display (os); + } + + static void set_add_hook (hook_fcn_ptr f) { add_hook = f; } + + static void set_remove_hook (hook_fcn_ptr f) { remove_hook = f; } + + static void set_command_line_path (const std::string& p) + { + if (command_line_path.empty ()) + command_line_path = p; + else + command_line_path += dir_path::path_sep_str () + p; + } + + static std::string get_command_line_path (void) + { + return instance_ok () ? instance->do_get_command_line_path () : std::string (); + } + + static std::string system_path (void) + { + return instance_ok () ? instance->do_system_path () : std::string (); + } + +private: + + static const int M_FILE = 1; + static const int OCT_FILE = 2; + static const int MEX_FILE = 4; + + class dir_info + { + public: + + // + typedef std::map fcn_file_map_type; + + typedef fcn_file_map_type::const_iterator const_fcn_file_map_iterator; + typedef fcn_file_map_type::iterator fcn_file_map_iterator; + + struct class_info + { + class_info (void) : method_file_map (), private_file_map () { } + + class_info (const class_info& ci) + : method_file_map (ci.method_file_map), + private_file_map (ci.private_file_map) { } + + class_info& operator = (const class_info& ci) + { + if (this != &ci) + { + method_file_map = ci.method_file_map; + private_file_map = ci.private_file_map; + } + return *this; + } + + ~class_info (void) { } + + fcn_file_map_type method_file_map; + fcn_file_map_type private_file_map; + }; + + // + typedef std::map method_file_map_type; + + typedef method_file_map_type::const_iterator const_method_file_map_iterator; + typedef method_file_map_type::iterator method_file_map_iterator; + + // This default constructor is only provided so we can create a + // std::map of dir_info objects. You should not use this + // constructor for any other purpose. + dir_info (void) + : dir_name (), abs_dir_name (), is_relative (false), + dir_mtime (), dir_time_last_checked (), + all_files (), fcn_files (), private_file_map (), method_file_map () + { } + + dir_info (const std::string& d) + : dir_name (d), abs_dir_name (), is_relative (false), + dir_mtime (), dir_time_last_checked (), + all_files (), fcn_files (), private_file_map (), method_file_map () + { + initialize (); + } + + dir_info (const dir_info& di) + : dir_name (di.dir_name), abs_dir_name (di.abs_dir_name), + is_relative (di.is_relative), + dir_mtime (di.dir_mtime), + dir_time_last_checked (di.dir_time_last_checked), + all_files (di.all_files), fcn_files (di.fcn_files), + private_file_map (di.private_file_map), + method_file_map (di.method_file_map) { } + + ~dir_info (void) { } + + dir_info& operator = (const dir_info& di) + { + if (&di != this) + { + dir_name = di.dir_name; + abs_dir_name = di.abs_dir_name; + is_relative = di.is_relative; + dir_mtime = di.dir_mtime; + dir_time_last_checked = di.dir_time_last_checked; + all_files = di.all_files; + fcn_files = di.fcn_files; + private_file_map = di.private_file_map; + method_file_map = di.method_file_map; + } + + return *this; + } + + void update (void); + + std::string dir_name; + std::string abs_dir_name; + bool is_relative; + octave_time dir_mtime; + octave_time dir_time_last_checked; + string_vector all_files; + string_vector fcn_files; + fcn_file_map_type private_file_map; + method_file_map_type method_file_map; + + private: + + void initialize (void); + + void get_file_list (const std::string& d); + + void get_private_file_map (const std::string& d); + + void get_method_file_map (const std::string& d, + const std::string& class_name); + + friend fcn_file_map_type get_fcn_files (const std::string& d); + }; + + class file_info + { + public: + + file_info (const std::string& d, int t) : dir_name (d), types (t) { } + + file_info (const file_info& fi) + : dir_name (fi.dir_name), types (fi.types) { } + + ~file_info (void) { } + + file_info& operator = (const file_info& fi) + { + if (&fi != this) + { + dir_name = fi.dir_name; + types = fi.types; + } + + return *this; + } + + std::string dir_name; + int types; + }; + + // We maintain two ways of looking at the same information. + // + // First, a list of directories and the set of "public" files and + // private files (those found in the special "private" subdirectory) + // in each directory. + // + // Second, a map from file names (the union of all "public" files for all + // directories, but without filename extensions) to a list of + // corresponding information (directory name and file types). This + // way, we can quickly find shadowed file names and look up all + // overloaded functions (in the "@" directories used to implement + // classes). + + typedef std::list dir_info_list_type; + + typedef dir_info_list_type::const_iterator const_dir_info_list_iterator; + typedef dir_info_list_type::iterator dir_info_list_iterator; + + typedef std::map abs_dir_cache_type; + + typedef abs_dir_cache_type::const_iterator const_abs_dir_cache_iterator; + typedef abs_dir_cache_type::iterator abs_dir_cache_iterator; + + typedef std::list file_info_list_type; + + typedef file_info_list_type::const_iterator const_file_info_list_iterator; + typedef file_info_list_type::iterator file_info_list_iterator; + + // + typedef std::map fcn_map_type; + + typedef fcn_map_type::const_iterator const_fcn_map_iterator; + typedef fcn_map_type::iterator fcn_map_iterator; + + // > + typedef std::map private_fcn_map_type; + + typedef private_fcn_map_type::const_iterator const_private_fcn_map_iterator; + typedef private_fcn_map_type::iterator private_fcn_map_iterator; + + // > + typedef std::map method_map_type; + + typedef method_map_type::const_iterator const_method_map_iterator; + typedef method_map_type::iterator method_map_iterator; + + mutable dir_info_list_type dir_info_list; + + mutable fcn_map_type fcn_map; + + mutable private_fcn_map_type private_fcn_map; + + mutable method_map_type method_map; + + mutable std::set init_dirs; + + static load_path *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + static hook_fcn_ptr add_hook; + + static hook_fcn_ptr remove_hook; + + static std::string command_line_path; + + static std::string sys_path; + + static abs_dir_cache_type abs_dir_cache; + + static bool instance_ok (void); + + const_dir_info_list_iterator find_dir_info (const std::string& dir) const; + dir_info_list_iterator find_dir_info (const std::string& dir); + + bool contains (const std::string& dir) const; + + void move_fcn_map (const std::string& dir, + const string_vector& fcn_files, bool at_end); + + void move_method_map (const std::string& dir, bool at_end); + + void move (std::list::iterator i, bool at_end); + + void do_initialize (bool set_initial_path); + + void do_clear (void); + + void do_set (const std::string& p, bool warn, bool is_init = false); + + void do_append (const std::string& dir, bool warn); + + void do_prepend (const std::string& dir, bool warn); + + void do_add (const std::string& dir, bool at_end, bool warn); + + void remove_fcn_map (const std::string& dir, const string_vector& fcn_files); + + void remove_private_fcn_map (const std::string& dir); + + void remove_method_map (const std::string& dir); + + bool do_remove (const std::string& dir); + + void do_update (void) const; + + static bool + check_file_type (std::string& fname, int type, int possible_types, + const std::string& fcn, const char *who); + + std::string do_find_fcn (const std::string& fcn, + std::string& dir_name, + int type = M_FILE | OCT_FILE | MEX_FILE) const; + + std::string do_find_private_fcn (const std::string& dir, + const std::string& fcn, + int type = M_FILE | OCT_FILE | MEX_FILE) const; + + std::string do_find_method (const std::string& class_name, + const std::string& meth, + std::string& dir_name, + int type = M_FILE | OCT_FILE | MEX_FILE) const; + + std::list do_methods (const std::string& class_name) const; + + std::list do_overloads (const std::string& meth) const; + + std::string do_find_file (const std::string& file) const; + + std::string do_find_dir (const std::string& dir) const; + + string_vector do_find_matching_dirs (const std::string& dir) const; + + std::string do_find_first_of (const string_vector& files) const; + + string_vector do_find_all_first_of (const string_vector& files) const; + + string_vector do_dirs (void) const; + + std::list do_dir_list (void) const; + + string_vector do_files (const std::string& dir, bool omit_exts) const; + + string_vector do_fcn_names (void) const; + + std::string do_path (void) const; + + friend void print_types (std::ostream& os, int types); + + friend string_vector get_file_list (const dir_info::fcn_file_map_type& lst); + + friend void + print_fcn_list (std::ostream& os, const dir_info::fcn_file_map_type& lst); + + void do_display (std::ostream& os) const; + + std::string do_system_path (void) const { return sys_path; } + + std::string do_get_command_line_path (void) const { return command_line_path; } + + void add_to_fcn_map (const dir_info& di, bool at_end) const; + + void add_to_private_fcn_map (const dir_info& di) const; + + void add_to_method_map (const dir_info& di, bool at_end) const; + + friend dir_info::fcn_file_map_type get_fcn_files (const std::string& d); +}; + +extern std::string +genpath (const std::string& dir, const string_vector& skip = "private"); + +extern void execute_pkg_add (const std::string& dir); +extern void execute_pkg_del (const std::string& dir); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/load-save.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/load-save.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1872 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: John W. Eaton. +// HDF5 support by Steven G. Johnson +// Matlab v5 support by James R. Van Zandt + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include +#include + +#include "strftime.h" + +#include "byte-swap.h" +#include "data-conv.h" +#include "file-ops.h" +#include "file-stat.h" +#include "glob-match.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" +#include "str-vec.h" +#include "oct-locbuf.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "load-path.h" +#include "load-save.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-cell.h" +#include "pager.h" +#include "pt-exp.h" +#include "symtab.h" +#include "sysdep.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "dMatrix.h" + +#include "ls-hdf5.h" +#include "ls-mat-ascii.h" +#include "ls-mat4.h" +#include "ls-mat5.h" +#include "ls-oct-ascii.h" +#include "ls-oct-binary.h" + +// Remove gnulib definitions, if any. +#ifdef close +#undef close +#endif +#ifdef open +#undef open +#endif + +#ifdef HAVE_ZLIB +#include "zfstream.h" +#endif + +// Write octave-workspace file if Octave crashes or is killed by a signal. +static bool Vcrash_dumps_octave_core = true; + +// The maximum amount of memory (in kilobytes) that we will attempt to +// write to the Octave core file. +static double Voctave_core_file_limit = -1.0; + +// The name of the Octave core file. +static std::string Voctave_core_file_name = "octave-workspace"; + +// The default output format. May be one of "binary", "text", +// "mat-binary", or "hdf5". +static std::string Vdefault_save_options = "-text"; + +// The output format for Octave core files. +static std::string Voctave_core_file_options = "-binary"; + +static std::string +default_save_header_format (void) +{ + return + std::string ("# Created by Octave " OCTAVE_VERSION + ", %a %b %d %H:%M:%S %Y %Z <") + + octave_env::get_user_name () + + std::string ("@") + + octave_env::get_host_name () + + std::string (">"); +} + +// The format string for the comment line at the top of text-format +// save files. Passed to strftime. Should begin with `#' and contain +// no newline characters. +static std::string Vsave_header_format_string = default_save_header_format (); + +static void +gripe_file_open (const std::string& fcn, const std::string& file) +{ + if (fcn == "load") + error ("%s: unable to open input file `%s'", fcn.c_str (), file.c_str ()); + else if (fcn == "save") + error ("%s: unable to open output file `%s'", fcn.c_str (), file.c_str ()); + else + error ("%s: unable to open file `%s'", fcn.c_str (), file.c_str ()); +} + +// Install a variable with name NAME and the value VAL in the +// symbol table. If GLOBAL is TRUE, make the variable global. + +static void +install_loaded_variable (const std::string& name, + const octave_value& val, + bool global, const std::string& /*doc*/) +{ + if (global) + { + symbol_table::symbol_record& sr = symbol_table::insert (name); + sr.clear (); + sr.mark_global (); + sr.varref () = val; + } + else + symbol_table::varref (name) = val; +} + +// Return TRUE if NAME matches one of the given globbing PATTERNS. + +static bool +matches_patterns (const string_vector& patterns, int pat_idx, + int num_pat, const std::string& name) +{ + for (int i = pat_idx; i < num_pat; i++) + { + glob_match pattern (patterns[i]); + + if (pattern.match (name)) + return true; + } + + return false; +} + +int +read_binary_file_header (std::istream& is, bool& swap, + oct_mach_info::float_format& flt_fmt, bool quiet) +{ + const int magic_len = 10; + char magic[magic_len+1]; + is.read (magic, magic_len); + magic[magic_len] = '\0'; + + if (strncmp (magic, "Octave-1-L", magic_len) == 0) + swap = oct_mach_info::words_big_endian (); + else if (strncmp (magic, "Octave-1-B", magic_len) == 0) + swap = ! oct_mach_info::words_big_endian (); + else + { + if (! quiet) + error ("load: unable to read read binary file"); + return -1; + } + + char tmp = 0; + is.read (&tmp, 1); + + flt_fmt = mopt_digit_to_float_format (tmp); + + if (flt_fmt == oct_mach_info::flt_fmt_unknown) + { + if (! quiet) + error ("load: unrecognized binary format!"); + + return -1; + } + + return 0; +} + +#ifdef HAVE_ZLIB +static bool +check_gzip_magic (const std::string& fname) +{ + bool retval = false; + std::ifstream file (fname.c_str ()); + OCTAVE_LOCAL_BUFFER (unsigned char, magic, 2); + + if (file.read (reinterpret_cast (magic), 2) && magic[0] == 0x1f && + magic[1] == 0x8b) + retval = true; + + file.close (); + return retval; +} +#endif + +static load_save_format +get_file_format (std::istream& file, const std::string& filename) +{ + load_save_format retval = LS_UNKNOWN; + + oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; + + bool swap = false; + + if (read_binary_file_header (file, swap, flt_fmt, true) == 0) + retval = LS_BINARY; + else + { + file.clear (); + file.seekg (0, std::ios::beg); + + int32_t mopt, nr, nc, imag, len; + + int err = read_mat_file_header (file, swap, mopt, nr, nc, imag, len, 1); + + if (! err) + retval = LS_MAT_BINARY; + else + { + file.clear (); + file.seekg (0, std::ios::beg); + + err = read_mat5_binary_file_header (file, swap, true, filename); + + if (! err) + { + file.clear (); + file.seekg (0, std::ios::beg); + retval = LS_MAT5_BINARY; + } + else + { + file.clear (); + file.seekg (0, std::ios::beg); + + std::string tmp = extract_keyword (file, "name"); + + if (! tmp.empty ()) + retval = LS_ASCII; + } + } + } + + return retval; +} + +static load_save_format +get_file_format (const std::string& fname, const std::string& orig_fname, + bool &use_zlib) +{ + load_save_format retval = LS_UNKNOWN; + +#ifdef HAVE_HDF5 + // check this before we open the file + if (H5Fis_hdf5 (fname.c_str ()) > 0) + return LS_HDF5; +#endif /* HAVE_HDF5 */ + + std::ifstream file (fname.c_str ()); + use_zlib = false; + + if (file) + { + retval = get_file_format (file, orig_fname); + file.close (); + +#ifdef HAVE_ZLIB + if (retval == LS_UNKNOWN && check_gzip_magic (fname)) + { + gzifstream gzfile (fname.c_str ()); + use_zlib = true; + + if (gzfile) + { + retval = get_file_format (gzfile, orig_fname); + gzfile.close (); + } + } +#endif + + if (retval == LS_UNKNOWN) + { + // Try reading the file as numbers only, determining the + // number of rows and columns from the data. We don't + // even bother to check to see if the first item in the + // file is a number, so that get_complete_line() can + // skip any comments that might appear at the top of the + // file. + + retval = LS_MAT_ASCII; + } + } + else + gripe_file_open ("load", orig_fname); + + return retval; +} + +octave_value +do_load (std::istream& stream, const std::string& orig_fname, + load_save_format format, oct_mach_info::float_format flt_fmt, + bool list_only, bool swap, bool verbose, + const string_vector& argv, int argv_idx, int argc, int nargout) +{ + octave_value retval; + + octave_scalar_map retstruct; + + std::ostringstream output_buf; + std::list symbol_names; + + octave_idx_type count = 0; + + for (;;) + { + bool global = false; + octave_value tc; + + std::string name; + std::string doc; + + switch (format.type) + { + case LS_ASCII: + name = read_ascii_data (stream, orig_fname, global, tc, count); + break; + + case LS_BINARY: + name = read_binary_data (stream, swap, flt_fmt, orig_fname, + global, tc, doc); + break; + + case LS_MAT_ASCII: + name = read_mat_ascii_data (stream, orig_fname, tc); + break; + + case LS_MAT_BINARY: + name = read_mat_binary_data (stream, orig_fname, tc); + break; + +#ifdef HAVE_HDF5 + case LS_HDF5: + name = read_hdf5_data (stream, orig_fname, global, tc, doc); + break; +#endif /* HAVE_HDF5 */ + + case LS_MAT5_BINARY: + case LS_MAT7_BINARY: + name = read_mat5_binary_element (stream, orig_fname, swap, + global, tc); + break; + + default: + gripe_unrecognized_data_fmt ("load"); + break; + } + + if (error_state || stream.eof () || name.empty ()) + break; + else if (! error_state && ! name.empty ()) + { + if (tc.is_defined ()) + { + if (format == LS_MAT_ASCII && argv_idx < argc) + warning ("load: loaded ASCII file `%s' -- ignoring extra args", + orig_fname.c_str ()); + + if (format == LS_MAT_ASCII + || argv_idx == argc + || matches_patterns (argv, argv_idx, argc, name)) + { + count++; + if (list_only) + { + if (verbose) + { + if (count == 1) + output_buf + << "type rows cols name\n" + << "==== ==== ==== ====\n"; + + output_buf + << std::setiosflags (std::ios::left) + << std::setw (16) << tc.type_name () . c_str () + << std::setiosflags (std::ios::right) + << std::setw (7) << tc.rows () + << std::setw (7) << tc.columns () + << " " << name << "\n"; + } + else + symbol_names.push_back (name); + } + else + { + if (nargout == 1) + { + if (format == LS_MAT_ASCII) + retval = tc; + else + retstruct.assign (name, tc); + } + else + install_loaded_variable (name, tc, global, doc); + } + } + + // Only attempt to read one item from a headless text file. + + if (format == LS_MAT_ASCII) + break; + } + else + error ("load: unable to load variable `%s'", name.c_str ()); + } + else + { + if (count == 0) + error ("load: are you sure `%s' is an Octave data file?", + orig_fname.c_str ()); + + break; + } + } + + if (list_only && count) + { + if (verbose) + { + std::string msg = output_buf.str (); + + if (nargout > 0) + retval = msg; + else + octave_stdout << msg; + } + else + { + if (nargout > 0) + retval = Cell (string_vector (symbol_names)); + else + { + string_vector names (symbol_names); + + names.list_in_columns (octave_stdout); + + octave_stdout << "\n"; + } + } + } + else if (retstruct.nfields () != 0) + retval = retstruct; + + return retval; +} + +std::string +find_file_to_load (const std::string& name, const std::string& orig_name) +{ + std::string fname = name; + + if (! (octave_env::absolute_pathname (fname) + || octave_env::rooted_relative_pathname (fname))) + { + file_stat fs (fname); + + if (! (fs.exists () && fs.is_reg ())) + { + std::string tmp + = octave_env::make_absolute (load_path::find_file (fname)); + + if (! tmp.empty ()) + { + warning_with_id ("Octave:load-file-in-path", + "load: file found in load path"); + fname = tmp; + } + } + } + + size_t dot_pos = fname.rfind ("."); + size_t sep_pos = fname.find_last_of (file_ops::dir_sep_chars ()); + + if (dot_pos == std::string::npos + || (sep_pos != std::string::npos && dot_pos < sep_pos)) + { + // Either no '.' in name or no '.' appears after last directory + // separator. + + file_stat fs (fname); + + if (! (fs.exists () && fs.is_reg ())) + fname = find_file_to_load (fname + ".mat", orig_name); + } + else + { + file_stat fs (fname); + + if (! (fs.exists () && fs.is_reg ())) + { + fname = ""; + + error ("load: unable to find file %s", orig_name.c_str ()); + } + } + + return fname; +} + + +DEFUN (load, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} load file\n\ +@deftypefnx {Command} {} load options file\n\ +@deftypefnx {Command} {} load options file v1 v2 @dots{}\n\ +@deftypefnx {Command} {S =} load (\"options\", \"file\", \"v1\", \"v2\", @dots{})\n\ +@deftypefnx {Command} {} load file options\n\ +@deftypefnx {Command} {} load file options v1 v2 @dots{}\n\ +@deftypefnx {Command} {S =} load (\"file\", \"options\", \"v1\", \"v2\", @dots{})\n\ +Load the named variables @var{v1}, @var{v2}, @dots{}, from the file\n\ +@var{file}. If no variables are specified then all variables found in the\n\ +file will be loaded. As with @code{save}, the list of variables to extract\n\ +can be full names or use a pattern syntax. The format of the file is\n\ +automatically detected but may be overridden by supplying the appropriate\n\ +option.\n\ +\n\ +If load is invoked using the functional form\n\ +\n\ +@example\n\ +load (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ +@end example\n\ +\n\ +@noindent\n\ +then the @var{options}, @var{file}, and variable name arguments\n\ +(@var{v1}, @dots{}) must be specified as character strings.\n\ +\n\ +If a variable that is not marked as global is loaded from a file when a\n\ +global symbol with the same name already exists, it is loaded in the\n\ +global symbol table. Also, if a variable is marked as global in a file\n\ +and a local symbol exists, the local symbol is moved to the global\n\ +symbol table and given the value from the file.\n\ +\n\ +If invoked with a single output argument, Octave returns data instead\n\ +of inserting variables in the symbol table. If the data file contains\n\ +only numbers (TAB- or space-delimited columns), a matrix of values is\n\ +returned. Otherwise, @code{load} returns a structure with members\n\ + corresponding to the names of the variables in the file.\n\ +\n\ +The @code{load} command can read data stored in Octave's text and\n\ +binary formats, and @sc{matlab}'s binary format. If compiled with zlib\n\ +support, it can also load gzip-compressed files. It will automatically\n\ +detect the type of file and do conversion from different floating point\n\ +formats (currently only IEEE big and little endian, though other formats\n\ +may be added in the future).\n\ +\n\ +Valid options for @code{load} are listed in the following table.\n\ +\n\ +@table @code\n\ +@item -force\n\ +This option is accepted for backward compatibility but is ignored.\n\ +Octave now overwrites variables currently in memory with\n\ +those of the same name found in the file.\n\ +\n\ +@item -ascii\n\ +Force Octave to assume the file contains columns of numbers in text format\n\ +without any header or other information. Data in the file will be loaded\n\ +as a single numeric matrix with the name of the variable derived from the\n\ +name of the file.\n\ +\n\ +@item -binary\n\ +Force Octave to assume the file is in Octave's binary format.\n\ +\n\ +@item -hdf5\n\ +Force Octave to assume the file is in @sc{hdf5} format.\n\ +(@sc{hdf5} is a free, portable binary format developed by the National\n\ +Center for Supercomputing Applications at the University of Illinois.)\n\ +Note that Octave can read @sc{hdf5} files not created by itself, but may\n\ +skip some datasets in formats that it cannot support. This format is\n\ +only available if Octave was built with a link to the @sc{hdf5} libraries.\n\ +\n\ +@item -import\n\ +This option is accepted for backward compatibility but is ignored.\n\ +Octave can now support multi-dimensional HDF data and automatically\n\ +modifies variable names if they are invalid Octave identifiers.\n\ +\n\ +@item -mat\n\ +@itemx -mat-binary\n\ +@itemx -6\n\ +@itemx -v6\n\ +@itemx -7\n\ +@itemx -v7\n\ +Force Octave to assume the file is in @sc{matlab}'s version 6 or 7 binary\n\ +format.\n\ +\n\ +@item -mat4-binary\n\ +@itemx -4\n\ +@itemx -v4\n\ +@itemx -V4\n\ +Force Octave to assume the file is in the binary format written by\n\ +@sc{matlab} version 4.\n\ +\n\ +@item -text\n\ +Force Octave to assume the file is in Octave's text format.\n\ +@end table\n\ +@seealso{save, dlmwrite, csvwrite, fwrite}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("load"); + + if (error_state) + return retval; + + int i = 1; + std::string orig_fname = ""; + + // Function called with Matlab-style ["filename", options] syntax + if (argc > 1 && ! argv[1].empty () && argv[1].at (0) != '-') + { + orig_fname = argv[1]; + i++; + } + + // It isn't necessary to have the default load format stored in a + // user preference variable since we can determine the type of file + // as we are reading. + + load_save_format format = LS_UNKNOWN; + + bool list_only = false; + bool verbose = false; + + //for (i; i < argc; i++) + for (; i < argc; i++) + { + if (argv[i] == "-force" || argv[i] == "-f") + { + // Silently ignore this + // warning ("load: -force ignored"); + } + else if (argv[i] == "-list" || argv[i] == "-l") + { + list_only = true; + } + else if (argv[i] == "-verbose" || argv[i] == "-v") + { + verbose = true; + } + else if (argv[i] == "-ascii" || argv[i] == "-a") + { + format = LS_MAT_ASCII; + } + else if (argv[i] == "-binary" || argv[i] == "-b") + { + format = LS_BINARY; + } + else if (argv[i] == "-mat-binary" || argv[i] == "-mat" || argv[i] == "-m" + || argv[i] == "-6" || argv[i] == "-v6") + { + format = LS_MAT5_BINARY; + } + else if (argv[i] == "-7" || argv[i] == "-v7") + { + format = LS_MAT7_BINARY; + } + else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" + || argv[i] == "-v4" || argv[i] == "-4") + { + format = LS_MAT_BINARY; + } + else if (argv[i] == "-hdf5" || argv[i] == "-h") + { +#ifdef HAVE_HDF5 + format = LS_HDF5; +#else /* ! HAVE_HDF5 */ + error ("load: octave executable was not linked with HDF5 library"); + return retval; +#endif /* ! HAVE_HDF5 */ + } + else if (argv[i] == "-import" || argv[i] == "-i") + { + warning ("load: -import ignored"); + } + else if (argv[i] == "-text" || argv[i] == "-t") + { + format = LS_ASCII; + } + else + break; + } + + if (orig_fname == "") + { + if (i == argc) + { + print_usage (); + return retval; + } + else + orig_fname = argv[i]; + } + else + i--; + + oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; + + bool swap = false; + + if (orig_fname == "-") + { + i++; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + error ("load: cannot read HDF5 format from stdin"); + else +#endif /* HAVE_HDF5 */ + if (format != LS_UNKNOWN) + { + // FIXME -- if we have already seen EOF on a + // previous call, how do we fix up the state of std::cin so + // that we can get additional input? I'm afraid that we + // can't fix this using std::cin only. + + retval = do_load (std::cin, orig_fname, format, flt_fmt, + list_only, swap, verbose, argv, i, argc, + nargout); + } + else + error ("load: must specify file format if reading from stdin"); + } + else + { + std::string fname = file_ops::tilde_expand (orig_fname); + + fname = find_file_to_load (fname, orig_fname); + + if (error_state) + return retval; + + bool use_zlib = false; + + if (format == LS_UNKNOWN) + format = get_file_format (fname, orig_fname, use_zlib); + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + i++; + + hdf5_ifstream hdf5_file (fname.c_str ()); + + if (hdf5_file.file_id >= 0) + { + retval = do_load (hdf5_file, orig_fname, format, + flt_fmt, list_only, swap, verbose, + argv, i, argc, nargout); + + hdf5_file.close (); + } + else + gripe_file_open ("load", orig_fname); + } + else +#endif /* HAVE_HDF5 */ + // don't insert any statements here; the "else" above has to + // go with the "if" below!!!!! + if (format != LS_UNKNOWN) + { + i++; + + // Always open in binary mode and handle various + // line-endings explicitly. + std::ios::openmode mode = std::ios::in | std::ios::binary; + +#ifdef HAVE_ZLIB + if (use_zlib) + { + gzifstream file (fname.c_str (), mode); + + if (file) + { + if (format == LS_BINARY) + { + if (read_binary_file_header (file, swap, flt_fmt) < 0) + { + if (file) file.close (); + return retval; + } + } + else if (format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + { + if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) + { + if (file) file.close (); + return retval; + } + } + + retval = do_load (file, orig_fname, format, + flt_fmt, list_only, swap, verbose, + argv, i, argc, nargout); + + file.close (); + } + else + gripe_file_open ("load", orig_fname); + } + else +#endif + { + std::ifstream file (fname.c_str (), mode); + + if (file) + { + if (format == LS_BINARY) + { + if (read_binary_file_header (file, swap, flt_fmt) < 0) + { + if (file) file.close (); + return retval; + } + } + else if (format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + { + if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) + { + if (file) file.close (); + return retval; + } + } + + retval = do_load (file, orig_fname, format, + flt_fmt, list_only, swap, verbose, + argv, i, argc, nargout); + + file.close (); + } + else + error ("load: unable to open input file `%s'", + orig_fname.c_str ()); + } + } + } + + return retval; +} + +// Return TRUE if PATTERN has any special globbing chars in it. + +static bool +glob_pattern_p (const std::string& pattern) +{ + int open = 0; + + int len = pattern.length (); + + for (int i = 0; i < len; i++) + { + char c = pattern[i]; + + switch (c) + { + case '?': + case '*': + return true; + + case '[': // Only accept an open brace if there is a close + open++; // brace to match it. Bracket expressions must be + continue; // complete, according to Posix.2 + + case ']': + if (open) + return true; + continue; + + case '\\': + if (i == len - 1) + return false; + + default: + continue; + } + } + + return false; +} + +static void +do_save (std::ostream& os, const octave_value& tc, + const std::string& name, const std::string& help, + bool global, load_save_format fmt, bool save_as_floats) +{ + switch (fmt.type) + { + case LS_ASCII: + save_ascii_data (os, tc, name, global, 0); + break; + + case LS_BINARY: + save_binary_data (os, tc, name, help, global, save_as_floats); + break; + + case LS_MAT_ASCII: + if (! save_mat_ascii_data (os, tc, fmt.opts & LS_MAT_ASCII_LONG ? 16 : 8, + fmt.opts & LS_MAT_ASCII_TABS)) + warning ("save: unable to save %s in ASCII format", name.c_str ()); + break; + + case LS_MAT_BINARY: + save_mat_binary_data (os, tc, name); + break; + +#ifdef HAVE_HDF5 + case LS_HDF5: + save_hdf5_data (os, tc, name, help, global, save_as_floats); + break; +#endif /* HAVE_HDF5 */ + + case LS_MAT5_BINARY: + save_mat5_binary_element (os, tc, name, global, false, save_as_floats); + break; + + case LS_MAT7_BINARY: + save_mat5_binary_element (os, tc, name, global, true, save_as_floats); + break; + + default: + gripe_unrecognized_data_fmt ("save"); + break; + } +} + +// Save the info from SR on stream OS in the format specified by FMT. + +void +do_save (std::ostream& os, const symbol_table::symbol_record& sr, + load_save_format fmt, bool save_as_floats) +{ + octave_value val = sr.varval (); + + if (val.is_defined ()) + { + std::string name = sr.name (); + std::string help; + bool global = sr.is_global (); + + do_save (os, val, name, help, global, fmt, save_as_floats); + } +} + +// save fields of a scalar structure STR matching PATTERN on stream OS +// in the format specified by FMT. + +static size_t +save_fields (std::ostream& os, const octave_scalar_map& m, + const std::string& pattern, + load_save_format fmt, bool save_as_floats) +{ + glob_match pat (pattern); + + size_t saved = 0; + + for (octave_scalar_map::const_iterator p = m.begin (); p != m.end (); p++) + { + std::string empty_str; + + if (pat.match (m.key (p))) + { + do_save (os, m.contents (p), m.key (p), empty_str, + 0, fmt, save_as_floats); + + saved++; + } + } + + return saved; +} + +// Save variables with names matching PATTERN on stream OS in the +// format specified by FMT. + +static size_t +save_vars (std::ostream& os, const std::string& pattern, + load_save_format fmt, bool save_as_floats) +{ + std::list vars = symbol_table::glob (pattern); + + size_t saved = 0; + + typedef std::list::const_iterator const_vars_iterator; + + for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) + { + do_save (os, *p, fmt, save_as_floats); + + if (error_state) + break; + + saved++; + } + + return saved; +} + +static string_vector +parse_save_options (const string_vector &argv, + load_save_format &format, bool &append, + bool &save_as_floats, bool &use_zlib) +{ + string_vector retval; + int argc = argv.length (); + + bool do_double = false, do_tabs = false; + + for (int i = 0; i < argc; i++) + { + if (argv[i] == "-append") + { + append = true; + } + else if (argv[i] == "-ascii" || argv[i] == "-a") + { + format = LS_MAT_ASCII; + } + else if (argv[i] == "-double") + { + do_double = true; + } + else if (argv[i] == "-tabs") + { + do_tabs = true; + } + else if (argv[i] == "-text" || argv[i] == "-t") + { + format = LS_ASCII; + } + else if (argv[i] == "-binary" || argv[i] == "-b") + { + format = LS_BINARY; + } + else if (argv[i] == "-hdf5" || argv[i] == "-h") + { +#ifdef HAVE_HDF5 + format = LS_HDF5; +#else /* ! HAVE_HDF5 */ + error ("save: octave executable was not linked with HDF5 library"); +#endif /* ! HAVE_HDF5 */ + } + else if (argv[i] == "-mat-binary" || argv[i] == "-mat" + || argv[i] == "-m" || argv[i] == "-6" || argv[i] == "-v6" + || argv[i] == "-V6") + { + format = LS_MAT5_BINARY; + } +#ifdef HAVE_ZLIB + else if (argv[i] == "-mat7-binary" || argv[i] == "-7" + || argv[i] == "-v7" || argv[i] == "-V7") + { + format = LS_MAT7_BINARY; + } +#endif + else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" + || argv[i] == "-v4" || argv[i] == "-4") + { + format = LS_MAT_BINARY; + } + else if (argv[i] == "-float-binary" || argv[i] == "-f") + { + format = LS_BINARY; + save_as_floats = true; + } + else if (argv[i] == "-float-hdf5") + { +#ifdef HAVE_HDF5 + format = LS_HDF5; + save_as_floats = true; +#else /* ! HAVE_HDF5 */ + error ("save: octave executable was not linked with HDF5 library"); +#endif /* ! HAVE_HDF5 */ + } +#ifdef HAVE_ZLIB + else if (argv[i] == "-zip" || argv[i] == "-z") + { + use_zlib = true; + } +#endif + else + retval.append (argv[i]); + } + + if (do_double) + { + if (format == LS_MAT_ASCII) + format.opts |= LS_MAT_ASCII_LONG; + else + warning ("save: \"-double\" option only has an effect with \"-ascii\""); + } + + if (do_tabs) + { + if (format == LS_MAT_ASCII) + format.opts |= LS_MAT_ASCII_TABS; + else + warning ("save: \"-tabs\" option only has an effect with \"-ascii\""); + } + + return retval; +} + +static string_vector +parse_save_options (const std::string &arg, load_save_format &format, + bool &append, bool &save_as_floats, + bool &use_zlib) +{ + std::istringstream is (arg); + std::string str; + string_vector argv; + + while (! is.eof ()) + { + is >> str; + argv.append (str); + } + + return parse_save_options (argv, format, append, save_as_floats, + use_zlib); +} + +void +write_header (std::ostream& os, load_save_format format) +{ + switch (format.type) + { + case LS_BINARY: + { + os << (oct_mach_info::words_big_endian () + ? "Octave-1-B" : "Octave-1-L"); + + oct_mach_info::float_format flt_fmt = + oct_mach_info::native_float_format (); + + char tmp = static_cast (float_format_to_mopt_digit (flt_fmt)); + + os.write (&tmp, 1); + } + break; + + case LS_MAT5_BINARY: + case LS_MAT7_BINARY: + { + char const * versionmagic; + int16_t number = *(reinterpret_cast("\x00\x01")); + struct tm bdt; + time_t now; + char headertext[128]; + + time (&now); + bdt = *gmtime (&now); + memset (headertext, ' ', 124); + // ISO 8601 format date + nstrftime (headertext, 124, "MATLAB 5.0 MAT-file, written by Octave " + OCTAVE_VERSION ", %Y-%m-%d %T UTC", &bdt, 1, 0); + + // The first pair of bytes give the version of the MAT file + // format. The second pair of bytes form a magic number which + // signals a MAT file. MAT file data are always written in + // native byte order. The order of the bytes in the second + // pair indicates whether the file was written by a big- or + // little-endian machine. However, the version number is + // written in the *opposite* byte order from everything else! + if (number == 1) + versionmagic = "\x01\x00\x4d\x49"; // this machine is big endian + else + versionmagic = "\x00\x01\x49\x4d"; // this machine is little endian + + memcpy (headertext+124, versionmagic, 4); + os.write (headertext, 128); + } + + break; + +#ifdef HAVE_HDF5 + case LS_HDF5: +#endif /* HAVE_HDF5 */ + case LS_ASCII: + { + octave_localtime now; + + std::string comment_string = now.strftime (Vsave_header_format_string); + + if (! comment_string.empty ()) + { +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + hdf5_ofstream& hs = dynamic_cast (os); + H5Gset_comment (hs.file_id, "/", comment_string.c_str ()); + } + else +#endif /* HAVE_HDF5 */ + os << comment_string << "\n"; + } + } + break; + + default: + break; + } +} + +static void +save_vars (const string_vector& argv, int argv_idx, int argc, + std::ostream& os, load_save_format fmt, + bool save_as_floats, bool write_header_info) +{ + if (write_header_info) + write_header (os, fmt); + + if (argv_idx == argc) + { + save_vars (os, "*", fmt, save_as_floats); + } + else if (argv[argv_idx] == "-struct") + { + if (++argv_idx >= argc) + { + error ("save: missing struct name"); + return; + } + + std::string struct_name = argv[argv_idx]; + + if (! symbol_table::is_variable (struct_name)) + { + error ("save: no such variable: `%s'", struct_name.c_str ()); + return; + } + + octave_value struct_var = symbol_table::varref (struct_name); + + if (! struct_var.is_map () || struct_var.numel () != 1) + { + error ("save: `%s' is not a scalar structure", + struct_name.c_str ()); + return; + } + octave_scalar_map struct_var_map = struct_var.scalar_map_value (); + + ++argv_idx; + + if (argv_idx < argc) + { + for (int i = argv_idx; i < argc; i++) + { + if (! save_fields (os, struct_var_map, argv[i], fmt, + save_as_floats)) + { + warning ("save: no such field `%s.%s'", + struct_name.c_str (), argv[i].c_str ()); + } + } + } + else + save_fields (os, struct_var_map, "*", fmt, save_as_floats); + } + else + { + for (int i = argv_idx; i < argc; i++) + { + if (! save_vars (os, argv[i], fmt, save_as_floats)) + warning ("save: no such variable `%s'", argv[i].c_str ()); + } + } +} + +static void +dump_octave_core (std::ostream& os, const char *fname, load_save_format fmt, + bool save_as_floats) +{ + write_header (os, fmt); + + std::list vars + = symbol_table::all_variables (symbol_table::top_scope (), 0); + + double save_mem_size = 0; + + typedef std::list::const_iterator const_vars_iterator; + + for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) + { + octave_value val = p->varval (); + + if (val.is_defined ()) + { + std::string name = p->name (); + std::string help; + bool global = p->is_global (); + + double val_size = val.byte_size () / 1024; + + // FIXME -- maybe we should try to throw out the largest first... + + if (Voctave_core_file_limit < 0 + || save_mem_size + val_size < Voctave_core_file_limit) + { + save_mem_size += val_size; + + do_save (os, val, name, help, global, fmt, save_as_floats); + + if (error_state) + break; + } + } + } + + message (0, "save to `%s' complete", fname); +} + +void +dump_octave_core (void) +{ + if (Vcrash_dumps_octave_core) + { + // FIXME -- should choose better file name? + + const char *fname = Voctave_core_file_name.c_str (); + + message (0, "attempting to save variables to `%s'...", fname); + + load_save_format format = LS_BINARY; + + bool save_as_floats = false; + + bool append = false; + + bool use_zlib = false; + + parse_save_options (Voctave_core_file_options, format, append, + save_as_floats, use_zlib); + + std::ios::openmode mode = std::ios::out; + + // Matlab v7 files are always compressed + if (format == LS_MAT7_BINARY) + use_zlib = false; + + if (format == LS_BINARY +#ifdef HAVE_HDF5 + || format == LS_HDF5 +#endif + || format == LS_MAT_BINARY + || format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + mode |= std::ios::binary; + + mode |= append ? std::ios::ate : std::ios::trunc; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + hdf5_ofstream file (fname, mode); + + if (file.file_id >= 0) + { + dump_octave_core (file, fname, format, save_as_floats); + + file.close (); + } + else + warning ("unable to open `%s' for writing...", fname); + } + else +#endif /* HAVE_HDF5 */ + // don't insert any commands here! The open brace below must + // go with the else above! + { +#ifdef HAVE_ZLIB + if (use_zlib) + { + gzofstream file (fname, mode); + + if (file) + { + dump_octave_core (file, fname, format, save_as_floats); + + file.close (); + } + else + warning ("unable to open `%s' for writing...", fname); + } + else +#endif + { + std::ofstream file (fname, mode); + + if (file) + { + dump_octave_core (file, fname, format, save_as_floats); + + file.close (); + } + else + warning ("unable to open `%s' for writing...", fname); + } + } + } +} + + +DEFUN (save, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} save file\n\ +@deftypefnx {Command} {} save options file\n\ +@deftypefnx {Command} {} save options file @var{v1} @var{v2} @dots{}\n\ +@deftypefnx {Command} {} save options file -struct @var{STRUCT} @var{f1} @var{f2} @dots{}\n\ +Save the named variables @var{v1}, @var{v2}, @dots{}, in the file\n\ +@var{file}. The special filename @samp{-} may be used to write\n\ +output to the terminal. If no variable names are listed, Octave saves\n\ +all the variables in the current scope. Otherwise, full variable names or\n\ +pattern syntax can be used to specify the variables to save.\n\ +If the @option{-struct} modifier is used, fields @var{f1} @var{f2} @dots{}\n\ +of the scalar structure @var{STRUCT} are saved as if they were variables\n\ +with corresponding names.\n\ +Valid options for the @code{save} command are listed in the following table.\n\ +Options that modify the output format override the format specified by\n\ +@code{default_save_options}.\n\ +\n\ +If save is invoked using the functional form\n\ +\n\ +@example\n\ +save (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ +@end example\n\ +\n\ +@noindent\n\ +then the @var{options}, @var{file}, and variable name arguments\n\ +(@var{v1}, @dots{}) must be specified as character strings.\n\ +\n\ +@table @code\n\ +@item -append\n\ +Append to the destination instead of overwriting.\n\ +\n\ +@item -ascii\n\ +Save a single matrix in a text file without header or any other information.\n\ +\n\ +@item -binary\n\ +Save the data in Octave's binary data format.\n\ +\n\ +@item -float-binary\n\ +Save the data in Octave's binary data format but only using single\n\ +precision. Only use this format if you know that all the\n\ +values to be saved can be represented in single precision.\n\ +\n\ +@item -hdf5\n\ +Save the data in @sc{hdf5} format.\n\ +(HDF5 is a free, portable binary format developed by the National\n\ +Center for Supercomputing Applications at the University of Illinois.)\n\ +This format is only available if Octave was built with a link to the\n\ +@sc{hdf5} libraries.\n\ +\n\ +@item -float-hdf5\n\ +Save the data in @sc{hdf5} format but only using single precision.\n\ +Only use this format if you know that all the\n\ +values to be saved can be represented in single precision.\n\ +\n\ +@item -V7\n\ +@itemx -v7\n\ +@itemx -7\n\ +@itemx -mat7-binary\n\ +Save the data in @sc{matlab}'s v7 binary data format.\n\ +\n\ +@item -V6\n\ +@itemx -v6\n\ +@itemx -6\n\ +@itemx -mat\n\ +@itemx -mat-binary\n\ +Save the data in @sc{matlab}'s v6 binary data format.\n\ +\n\ +@item -V4\n\ +@itemx -v4\n\ +@itemx -4\n\ +@itemx -mat4-binary\n\ +Save the data in the binary format written by @sc{matlab} version 4.\n\ +\n\ +@item -text\n\ +Save the data in Octave's text data format. (default).\n\ +\n\ +@item -zip\n\ +@itemx -z\n\ +Use the gzip algorithm to compress the file. This works equally on files\n\ +that are compressed with gzip outside of octave, and gzip can equally be\n\ +used to convert the files for backward compatibility.\n\ +This option is only available if Octave was built with a link to the zlib\n\ +libraries.\n\ +@end table\n\ +\n\ +The list of variables to save may use wildcard patterns containing\n\ +the following special characters:\n\ +\n\ +@table @code\n\ +@item ?\n\ +Match any single character.\n\ +\n\ +@item *\n\ +Match zero or more characters.\n\ +\n\ +@item [ @var{list} ]\n\ +Match the list of characters specified by @var{list}. If the first\n\ +character is @code{!} or @code{^}, match all characters except those\n\ +specified by @var{list}. For example, the pattern @code{[a-zA-Z]} will\n\ +match all lower and uppercase alphabetic characters.\n\ +\n\ +Wildcards may also be used in the field name specifications when using\n\ +the @option{-struct} modifier (but not in the struct name itself).\n\ +\n\ +@end table\n\ +\n\ +Except when using the @sc{matlab} binary data file format or the\n\ +@samp{-ascii} format, saving global\n\ +variables also saves the global status of the variable. If the variable\n\ +is restored at a later time using @samp{load}, it will be restored as a\n\ +global variable.\n\ +\n\ +The command\n\ +\n\ +@example\n\ +save -binary data a b*\n\ +@end example\n\ +\n\ +@noindent\n\ +saves the variable @samp{a} and all variables beginning with @samp{b} to\n\ +the file @file{data} in Octave's binary format.\n\ +@seealso{load, default_save_options, save_header_format_string, dlmread, csvread, fread}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length (); + + string_vector argv = args.make_argv (); + + if (error_state) + return retval; + + // Here is where we would get the default save format if it were + // stored in a user preference variable. + + bool save_as_floats = false; + + load_save_format format = LS_ASCII; + + bool append = false; + + bool use_zlib = false; + + // get default options + parse_save_options (Vdefault_save_options, format, append, save_as_floats, + use_zlib); + + // override from command line + argv = parse_save_options (argv, format, append, save_as_floats, + use_zlib); + argc = argv.length (); + int i = 0; + + if (error_state) + return retval; + + if (i == argc) + { + print_usage (); + return retval; + } + + if (save_as_floats && format == LS_ASCII) + { + error ("save: cannot specify both -ascii and -float-binary"); + return retval; + } + + if (argv[i] == "-") + { + i++; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + error ("save: cannot write HDF5 format to stdout"); + else +#endif /* HAVE_HDF5 */ + // don't insert any commands here! the brace below must go + // with the "else" above! + { + if (append) + warning ("save: ignoring -append option for output to stdout"); + + // FIXME -- should things intended for the screen end up + // in a octave_value (string)? + + save_vars (argv, i, argc, octave_stdout, format, + save_as_floats, true); + } + } + + // Guard against things like `save a*', which are probably mistakes... + + else if (i == argc - 1 && glob_pattern_p (argv[i])) + { + print_usage (); + return retval; + } + else + { + std::string fname = file_ops::tilde_expand (argv[i]); + + i++; + + // Matlab v7 files are always compressed + if (format == LS_MAT7_BINARY) + use_zlib = false; + + std::ios::openmode mode + = append ? (std::ios::app | std::ios::ate) : std::ios::out; + + if (format == LS_BINARY +#ifdef HAVE_HDF5 + || format == LS_HDF5 +#endif + || format == LS_MAT_BINARY + || format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + mode |= std::ios::binary; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + // FIXME. It should be possible to append to HDF5 files. + if (append) + { + error ("save: appending to HDF5 files is not implemented"); + return retval; + } + + bool write_header_info = ! (append && + H5Fis_hdf5 (fname.c_str ()) > 0); + + hdf5_ofstream hdf5_file (fname.c_str (), mode); + + if (hdf5_file.file_id != -1) + { + save_vars (argv, i, argc, hdf5_file, format, + save_as_floats, write_header_info); + + hdf5_file.close (); + } + else + { + gripe_file_open ("save", fname); + return retval; + } + } + else +#endif /* HAVE_HDF5 */ + // don't insert any statements here! The brace below must go + // with the "else" above! + { +#ifdef HAVE_ZLIB + if (use_zlib) + { + gzofstream file (fname.c_str (), mode); + + if (file) + { + bool write_header_info = ! file.tellp (); + + save_vars (argv, i, argc, file, format, + save_as_floats, write_header_info); + + file.close (); + } + else + { + gripe_file_open ("save", fname); + return retval; + } + } + else +#endif + { + std::ofstream file (fname.c_str (), mode); + + if (file) + { + bool write_header_info = ! file.tellp (); + + save_vars (argv, i, argc, file, format, + save_as_floats, write_header_info); + + file.close (); + } + else + { + gripe_file_open ("save", fname); + return retval; + } + } + } + } + + return retval; +} + +DEFUN (crash_dumps_octave_core, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} crash_dumps_octave_core ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} crash_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} crash_dumps_octave_core (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave tries\n\ +to save all current variables to the file \"octave-workspace\" if it\n\ +crashes or receives a hangup, terminate or similar signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{octave_core_file_limit, octave_core_file_name, octave_core_file_options}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (crash_dumps_octave_core); +} + +DEFUN (default_save_options, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} default_save_options ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} default_save_options (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} default_save_options (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the default options\n\ +for the @code{save} command, and defines the default format.\n\ +Typical values include @code{\"-ascii\"}, @code{\"-text -zip\"}.\n\ +The default value is @option{-text}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{save}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (default_save_options); +} + +DEFUN (octave_core_file_limit, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} octave_core_file_limit ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_limit (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_limit (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the maximum amount\n\ +of memory (in kilobytes) of the top-level workspace that Octave will\n\ +attempt to save when writing data to the crash dump file (the name of\n\ +the file is specified by @var{octave_core_file_name}). If\n\ +@var{octave_core_file_options} flags specify a binary format,\n\ +then @var{octave_core_file_limit} will be approximately the maximum\n\ +size of the file. If a text file format is used, then the file could\n\ +be much larger than the limit. The default value is -1 (unlimited)\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (octave_core_file_limit); +} + +DEFUN (octave_core_file_name, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} octave_core_file_name ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_name (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_name (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the file\n\ +used for saving data from the top-level workspace if Octave aborts.\n\ +The default value is @code{\"octave-workspace\"}\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_name); +} + +DEFUN (octave_core_file_options, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} octave_core_file_options ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_options (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_options (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the options used for\n\ +saving the workspace data if Octave aborts. The value of\n\ +@code{octave_core_file_options} should follow the same format as the\n\ +options for the @code{save} function. The default value is Octave's binary\n\ +format.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_limit}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_options); +} + +DEFUN (save_header_format_string, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} save_header_format_string ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} save_header_format_string (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} save_header_format_string (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the format\n\ +string used for the comment line written at the beginning of\n\ +text-format data files saved by Octave. The format string is\n\ +passed to @code{strftime} and should begin with the character\n\ +@samp{#} and contain no newline characters. If the value of\n\ +@code{save_header_format_string} is the empty string,\n\ +the header comment is omitted from text-format data files. The\n\ +default value is\n\ +@c Set example in small font to prevent overfull line\n\ +\n\ +@smallexample\n\ +\"# Created by Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ +@end smallexample\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{strftime, save}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (save_header_format_string); +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/load-save.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/load-save.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,90 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_load_save_h) +#define octave_load_save_h 1 + +#include +#include + +class octave_value; + +// FIXME: maybe MAT5 and MAT7 should be options to MAT_BINARY. +// Similarly, save_as_floats may be an option for LS_BINARY, LS_HDF5 etc. +enum load_save_format_type + { + LS_ASCII, + LS_BINARY, + LS_MAT_ASCII, + LS_MAT_BINARY, + LS_MAT5_BINARY, + LS_MAT7_BINARY, +#ifdef HAVE_HDF5 + LS_HDF5, +#endif /* HAVE_HDF5 */ + LS_UNKNOWN + }; + +enum load_save_format_options +{ + // LS_MAT_ASCII options (not exclusive) + LS_MAT_ASCII_LONG = 1, + LS_MAT_ASCII_TABS = 2, + // LS_MAT_BINARY options + LS_MAT_BINARY_V5 = 1, + LS_MAT_BINARY_V7, + // zero means no option. + LS_NO_OPTION = 0 +}; + +class load_save_format +{ +public: + load_save_format (load_save_format_type t, + load_save_format_options o = LS_NO_OPTION) + : type (t), opts (o) { } + operator int (void) const + { return type; } + int type, opts; +}; + +extern void dump_octave_core (void); + +extern int +read_binary_file_header (std::istream& is, bool& swap, + oct_mach_info::float_format& flt_fmt, + bool quiet = false); + +extern octave_value +do_load (std::istream& stream, const std::string& orig_fname, + load_save_format format, oct_mach_info::float_format flt_fmt, + bool list_only, bool swap, bool verbose, + const string_vector& argv, int argv_idx, int argc, int nargout); + +extern void +do_save (std::ostream& os, const symbol_table::symbol_record& sr, + load_save_format fmt, bool save_as_floats); + +extern void +write_header (std::ostream& os, load_save_format format); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/ls-oct-ascii.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/ls-oct-ascii.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,432 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Author: John W. Eaton. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include +#include +#include + +#include "byte-swap.h" +#include "data-conv.h" +#include "file-ops.h" +#include "glob-match.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" +#include "str-vec.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "load-save.h" +#include "ls-ascii-helper.h" +#include "ls-oct-ascii.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-cell.h" +#include "pager.h" +#include "pt-exp.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "dMatrix.h" + +// The number of decimal digits to use when writing ascii data. +static int Vsave_precision = 16; + +// Functions for reading ascii data. + +// Extract a KEYWORD and its value from stream IS, returning the +// associated value in a new string. +// +// Input should look something like: +// +// [%#][ \t]*keyword[ \t]*:[ \t]*string-value[ \t]*\n + +std::string +extract_keyword (std::istream& is, const char *keyword, const bool next_only) +{ + std::string retval; + + int ch = is.peek (); + if (next_only && ch != '%' && ch != '#') + return retval; + + char c; + while (is.get (c)) + { + if (c == '%' || c == '#') + { + std::ostringstream buf; + + while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) + ; // Skip whitespace and comment characters. + + if (isalpha (c)) + buf << c; + + while (is.get (c) && isalpha (c)) + buf << c; + + std::string tmp = buf.str (); + bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); + + if (match) + { + std::ostringstream value; + while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) + ; // Skip whitespace and the colon. + + is.putback (c); + retval = read_until_newline (is, false); + break; + } + else if (next_only) + break; + else + skip_until_newline (is, false); + } + } + + int len = retval.length (); + + if (len > 0) + { + while (len) + { + c = retval[len-1]; + + if (c == ' ' || c == '\t') + len--; + else + { + retval.resize (len); + break; + } + } + } + + return retval; +} + +// Extract one value (scalar, matrix, string, etc.) from stream IS and +// place it in TC, returning the name of the variable. If the value +// is tagged as global in the file, return TRUE in GLOBAL. +// +// Each type supplies its own function to load the data, and so this +// function is extensible. +// +// FILENAME is used for error messages. +// +// The data is expected to be in the following format: +// +// The input file must have a header followed by some data. +// +// All lines in the header must begin with a `#' character. +// +// The header must contain a list of keyword and value pairs with the +// keyword and value separated by a colon. +// +// Keywords must appear in the following order: +// +// # name: +// # type: +// # +// +// Where, for the built in types are: +// +// : a valid identifier +// +// : +// | global +// +// : scalar +// | complex scalar +// | matrix +// | complex matrix +// | bool +// | bool matrix +// | string +// | range +// +// : +// | +// +// : # rows: +// : # columns: +// +// : # elements: +// : # length: (once before each string) +// +// For backward compatibility the type "string array" is treated as a +// "string" type. Also "string" can have a single element with no elements +// line such that +// +// : # length: +// +// Formatted ASCII data follows the header. +// +// Example: +// +// # name: foo +// # type: matrix +// # rows: 2 +// # columns: 2 +// 2 4 +// 1 3 +// +// Example: +// +// # name: foo +// # type: string +// # elements: 5 +// # length: 4 +// this +// # length: 2 +// is +// # length: 1 +// a +// # length: 6 +// string +// # length: 5 +// array +// +// FIXME -- this format is fairly rigid, and doesn't allow for +// arbitrary comments. Someone should fix that. It does allow arbitrary +// types however. + +// Ugh. The signature of the compare method is not standard in older +// versions of the GNU libstdc++. Do this instead: + +#define SUBSTRING_COMPARE_EQ(s, pos, n, t) (s.substr (pos, n) == t) + +std::string +read_ascii_data (std::istream& is, const std::string& filename, bool& global, + octave_value& tc, octave_idx_type count) +{ + // Read name for this entry or break on EOF. + + std::string name = extract_keyword (is, "name"); + + if (name.empty ()) + { + if (count == 0) + error ("load: empty name keyword or no data found in file `%s'", + filename.c_str ()); + + return std::string (); + } + + if (! (name == ".nargin." || name == ".nargout." + || name == CELL_ELT_TAG || valid_identifier (name))) + { + error ("load: bogus identifier `%s' found in file `%s'", + name.c_str (), filename.c_str ()); + return std::string (); + } + + // Look for type keyword. + + std::string tag = extract_keyword (is, "type"); + + if (! tag.empty ()) + { + std::string typ; + size_t pos = tag.rfind (' '); + + if (pos != std::string::npos) + { + global = SUBSTRING_COMPARE_EQ (tag, 0, 6, "global"); + + typ = global ? tag.substr (7) : tag; + } + else + typ = tag; + + // Special case for backward compatiablity. A small bit of cruft + if (SUBSTRING_COMPARE_EQ (typ, 0, 12, "string array")) + tc = charMatrix (); + else + tc = octave_value_typeinfo::lookup_type (typ); + + if (! tc.load_ascii (is)) + error ("load: trouble reading ascii file `%s'", filename.c_str ()); + } + else + error ("load: failed to extract keyword specifying value type"); + + if (error_state) + { + error ("load: reading file %s", filename.c_str ()); + return std::string (); + } + + return name; +} + +// 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 empty, the name: line is not +// generated. PRECISION specifies the number of decimal digits to print. +// +// Assumes ranges and strings cannot contain Inf or NaN values. +// +// Returns 1 for success and 0 for failure. + +// FIXME -- should probably write the help string here too. + +bool +save_ascii_data (std::ostream& os, const octave_value& val_arg, + const std::string& name, bool mark_as_global, + int precision) +{ + bool success = true; + + if (! name.empty ()) + os << "# name: " << name << "\n"; + + octave_value val = val_arg; + + if (mark_as_global) + os << "# type: global " << val.type_name () << "\n"; + else + os << "# type: " << val.type_name () << "\n"; + + if (! precision) + precision = Vsave_precision; + + long old_precision = os.precision (); + os.precision (precision); + + success = val.save_ascii (os); + + // Insert an extra pair of newline characters after the data so that + // multiple data elements may be handled separately by gnuplot (see + // the description of the index qualifier for the plot command in the + // gnuplot documentation). + os << "\n\n"; + + os.precision (old_precision); + + return (os && success); +} + +bool +save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, + const std::string& name) +{ + return save_ascii_data (os, t, name, false, 6); +} + +// Maybe this should be a static function in tree-plot.cc? + +// If TC is matrix, save it on stream OS in a format useful for +// making a 3-dimensional plot with gnuplot. If PARAMETRIC is +// TRUE, assume a parametric 3-dimensional plot will be generated. + +bool +save_three_d (std::ostream& os, const octave_value& tc, bool parametric) +{ + bool fail = false; + + octave_idx_type nr = tc.rows (); + octave_idx_type nc = tc.columns (); + + if (tc.is_real_matrix ()) + { + os << "# 3D data...\n" + << "# type: matrix\n" + << "# total rows: " << nr << "\n" + << "# total columns: " << nc << "\n"; + + long old_precision = os.precision (); + os.precision (6); + + if (parametric) + { + octave_idx_type extras = nc % 3; + if (extras) + warning ("ignoring last %d columns", extras); + + Matrix tmp = tc.matrix_value (); + nr = tmp.rows (); + + for (octave_idx_type i = 0; i < nc-extras; i += 3) + { + os << tmp.extract (0, i, nr-1, i+2); + if (i+3 < nc-extras) + os << "\n"; + } + } + else + { + Matrix tmp = tc.matrix_value (); + nr = tmp.rows (); + + for (octave_idx_type i = 0; i < nc; i++) + { + os << tmp.extract (0, i, nr-1, i); + if (i+1 < nc) + os << "\n"; + } + } + + os.precision (old_precision); + } + else + { + ::error ("for now, I can only save real matrices in 3D format"); + fail = true; + } + + return (os && ! fail); +} + +DEFUN (save_precision, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} save_precision ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} save_precision (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} save_precision (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the number of\n\ +digits to keep when saving data in text format.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE_WITH_LIMITS (save_precision, -1, INT_MAX); +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/ls-oct-ascii.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/ls-oct-ascii.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,189 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_ls_oct_ascii_h) +#define octave_ls_oct_ascii_h 1 + +#include + +#include +#include + +#include "str-vec.h" + +#include "ls-ascii-helper.h" + +// Flag for cell elements +#define CELL_ELT_TAG "" + +// Used when converting Inf to something that gnuplot can read. + +#ifndef OCT_RBV +#define OCT_RBV DBL_MAX / 100.0 +#endif + +extern OCTINTERP_API std::string +extract_keyword (std::istream& is, const char *keyword, + const bool next_only = false); + +extern OCTINTERP_API std::string +read_ascii_data (std::istream& is, const std::string& filename, bool& global, + octave_value& tc, octave_idx_type count); + +extern OCTINTERP_API bool +save_ascii_data (std::ostream& os, const octave_value& val_arg, + const std::string& name, bool mark_as_global, int precision); + +extern OCTINTERP_API bool +save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, + const std::string& name); + +extern OCTINTERP_API bool +save_three_d (std::ostream& os, const octave_value& t, + bool parametric = false); + +// Match KEYWORD on stream IS, placing the associated value in VALUE, +// returning TRUE if successful and FALSE otherwise. +// +// Input should look something like: +// +// [%#][ \t]*keyword[ \t]*int-value.*\n + +template +bool +extract_keyword (std::istream& is, const char *keyword, T& value, + const bool next_only = false) +{ + bool status = false; + value = T (); + + char c; + while (is.get (c)) + { + if (c == '%' || c == '#') + { + std::ostringstream buf; + + while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) + ; // Skip whitespace and comment characters. + + if (isalpha (c)) + buf << c; + + while (is.get (c) && isalpha (c)) + buf << c; + + std::string tmp = buf.str (); + bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); + + if (match) + { + while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) + ; // Skip whitespace and the colon. + + is.putback (c); + if (c != '\n' && c != '\r') + is >> value; + if (is) + status = true; + skip_until_newline (is, false); + break; + } + else if (next_only) + break; + } + } + return status; +} + +template +bool +extract_keyword (std::istream& is, const std::string& kw, T& value, + const bool next_only = false) +{ + return extract_keyword (is, kw.c_str (), value, next_only); +} + +// Match one of the elements in KEYWORDS on stream IS, placing the +// matched keyword in KW and the associated value in VALUE, +// returning TRUE if successful and FALSE otherwise. +// +// Input should look something like: +// +// [%#][ \t]*keyword[ \t]*int-value.*\n + +template +bool +extract_keyword (std::istream& is, const string_vector& keywords, + std::string& kw, T& value, const bool next_only = false) +{ + bool status = false; + kw = ""; + value = 0; + + char c; + while (is.get (c)) + { + if (c == '%' || c == '#') + { + std::ostringstream buf; + + while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) + ; // Skip whitespace and comment characters. + + if (isalpha (c)) + buf << c; + + while (is.get (c) && isalpha (c)) + buf << c; + + std::string tmp = buf.str (); + + for (int i = 0; i < keywords.length (); i++) + { + int match = (tmp == keywords[i]); + + if (match) + { + kw = keywords[i]; + + while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) + ; // Skip whitespace and the colon. + + is.putback (c); + if (c != '\n' && c != '\r') + is >> value; + if (is) + status = true; + skip_until_newline (is, false); + return status; + } + } + + if (next_only) + break; + } + } + return status; +} + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/module.mk --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/module.mk Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,65 @@ +EXTRA_DIST += \ + interpfcn/module.mk + +INTERPFCN_INCLUDES = \ + interpfcn/data.h \ + interpfcn/debug.h \ + interpfcn/defun.h \ + interpfcn/dirfns.h \ + interpfcn/error.h \ + interpfcn/file-io.h \ + interpfcn/help.h \ + interpfcn/input.h \ + interpfcn/load-path.h \ + interpfcn/load-save.h \ + interpfcn/ls-oct-ascii.h \ + interpfcn/oct-hist.h \ + interpfcn/pager.h \ + interpfcn/pr-output.h \ + interpfcn/profiler.h \ + interpfcn/sighandlers.h \ + interpfcn/symtab.h \ + interpfcn/sysdep.h \ + interpfcn/toplev.h \ + interpfcn/utils.h \ + interpfcn/variables.h + +INTERPFCN_SRC = \ + interpfcn/data.cc \ + interpfcn/debug.cc \ + interpfcn/defaults.cc \ + interpfcn/defun.cc \ + interpfcn/dirfns.cc \ + interpfcn/error.cc \ + interpfcn/file-io.cc \ + interpfcn/graphics.cc \ + interpfcn/help.cc \ + interpfcn/input.cc \ + interpfcn/load-path.cc \ + interpfcn/load-save.cc \ + interpfcn/ls-oct-ascii.cc \ + interpfcn/oct-hist.cc \ + interpfcn/pager.cc \ + interpfcn/pr-output.cc \ + interpfcn/profiler.cc \ + interpfcn/sighandlers.cc \ + interpfcn/symtab.cc \ + interpfcn/sysdep.cc \ + interpfcn/toplev.cc \ + interpfcn/utils.cc \ + interpfcn/variables.cc + +## defaults.h and graphics.h must depend on Makefile. Calling configure +## may change default/config values. However, calling configure will also +## regenerate the Makefiles from Makefile.am and trigger the rules below. +interpfcn/defaults.h: interpfcn/defaults.in.h Makefile + @$(do_subst_default_vals) + +interpfcn/graphics.h: interpfcn/graphics.in.h genprops.awk Makefile + $(AWK) -f $(srcdir)/genprops.awk $< > $@-t + mv $@-t $@ + +interpfcn/graphics-props.cc: interpfcn/graphics.in.h genprops.awk Makefile + $(AWK) -v emit_graphics_props=1 -f $(srcdir)/genprops.awk $< > $@-t + mv $@-t $@ + diff -r d02b229ce693 -r a132d206a36a src/interpfcn/oct-hist.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/oct-hist.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,781 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + +The functions listed below were adapted from similar functions from +GNU Bash, the Bourne Again SHell, copyright (C) 1987, 1989, 1991 Free +Software Foundation, Inc. + + do_history edit_history_readline + do_edit_history edit_history_add_hist + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include + +#include + +#include +#include + +#include "cmd-hist.h" +#include "file-ops.h" +#include "lo-mappers.h" +#include "oct-env.h" +#include "oct-time.h" +#include "str-vec.h" + +#include +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "oct-hist.h" +#include "oct-obj.h" +#include "pager.h" +#include "parse.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// TRUE means input is coming from temporary history file. +bool input_from_tmp_history_file = false; + +static std::string +default_history_file (void) +{ + std::string file; + + std::string env_file = octave_env::getenv ("OCTAVE_HISTFILE"); + + if (! env_file.empty ()) + file = env_file; + + if (file.empty ()) + file = file_ops::concat (octave_env::get_home_directory (), + ".octave_hist"); + + return file; +} + +static int +default_history_size (void) +{ + int size = 1024; + + std::string env_size = octave_env::getenv ("OCTAVE_HISTSIZE"); + + if (! env_size.empty ()) + { + int val; + + if (sscanf (env_size.c_str (), "%d", &val) == 1) + size = val > 0 ? val : 0; + } + + return size; +} + +static std::string +default_history_timestamp_format (void) +{ + return + std::string ("# Octave " OCTAVE_VERSION ", %a %b %d %H:%M:%S %Y %Z <") + + octave_env::get_user_name () + + std::string ("@") + + octave_env::get_host_name () + + std::string (">"); +} + +// The format of the timestamp marker written to the history file when +// Octave exits. +static std::string Vhistory_timestamp_format_string + = default_history_timestamp_format (); + +// Display, save, or load history. Stolen and modified from bash. +// +// Arg of -w FILENAME means write file, arg of -r FILENAME +// means read file, arg of -q means don't number lines. Arg of N +// means only display that many items. + +static void +do_history (int argc, const string_vector& argv) +{ + int numbered_output = 1; + + unwind_protect frame; + + frame.add_fcn (command_history::set_file, command_history::file ()); + + int i; + for (i = 1; i < argc; i++) + { + std::string option = argv[i]; + + if (option == "-r" || option == "-w" || option == "-a" + || option == "-n") + { + if (i < argc - 1) + command_history::set_file (argv[i+1]); + + if (option == "-a") + // Append `new' lines to file. + command_history::append (); + + else if (option == "-w") + // Write entire history. + command_history::write (); + + else if (option == "-r") + // Read entire file. + command_history::read (); + + else if (option == "-n") + // Read `new' history from file. + command_history::read_range (); + + else + panic_impossible (); + + return; + } + else if (argv[i] == "-q") + numbered_output = 0; + else if (argv[i] == "--") + { + i++; + break; + } + else + break; + } + + int limit = -1; + + if (i < argc) + { + if (sscanf (argv[i].c_str (), "%d", &limit) != 1) + { + if (argv[i][0] == '-') + error ("history: unrecognized option `%s'", argv[i].c_str ()); + else + error ("history: bad non-numeric arg `%s'", argv[i].c_str ()); + + return; + } + + if (limit < 0) + limit = -limit; + } + + string_vector hlist = command_history::list (limit, numbered_output); + + int len = hlist.length (); + + for (i = 0; i < len; i++) + octave_stdout << hlist[i] << "\n"; +} + +// Read the edited history lines from STREAM and return them +// one at a time. This can read unlimited length lines. The +// caller should free the storage. + +static char * +edit_history_readline (std::fstream& stream) +{ + char c; + int line_len = 128; + int lindex = 0; + char *line = new char [line_len]; + line[0] = '\0'; + + while (stream.get (c)) + { + if (lindex + 2 >= line_len) + { + char *tmp_line = new char [line_len += 128]; + strcpy (tmp_line, line); + delete [] line; + line = tmp_line; + } + + if (c == '\n') + { + line[lindex++] = '\n'; + line[lindex++] = '\0'; + return line; + } + else + line[lindex++] = c; + } + + if (! lindex) + { + delete [] line; + return 0; + } + + if (lindex + 2 >= line_len) + { + char *tmp_line = new char [lindex+3]; + strcpy (tmp_line, line); + delete [] line; + line = tmp_line; + } + + // Finish with newline if none in file. + + line[lindex++] = '\n'; + line[lindex++] = '\0'; + return line; +} + +// Use `command' to replace the last entry in the history list, which, +// by this time, is `run_history blah...'. The intent is that the +// new command becomes the history entry, and that `fc' should never +// appear in the history list. This way you can do `run_history' to +// your heart's content. + +static void +edit_history_repl_hist (const std::string& command) +{ + if (! command.empty ()) + { + string_vector hlist = command_history::list (); + + int len = hlist.length (); + + if (len > 0) + { + int i = len - 1; + + std::string histent = command_history::get_entry (i); + + if (! histent.empty ()) + { + std::string cmd = command; + + int cmd_len = cmd.length (); + + if (cmd[cmd_len - 1] == '\n') + cmd.resize (cmd_len - 1); + + if (! cmd.empty ()) + command_history::replace_entry (i, cmd); + } + } + } +} + +static void +edit_history_add_hist (const std::string& line) +{ + if (! line.empty ()) + { + std::string tmp = line; + + int len = tmp.length (); + + if (len > 0 && tmp[len-1] == '\n') + tmp.resize (len - 1); + + if (! tmp.empty ()) + command_history::add (tmp); + } +} + +static std::string +mk_tmp_hist_file (int argc, const string_vector& argv, + int insert_curr, const char *warn_for) +{ + std::string retval; + + string_vector hlist = command_history::list (); + + int hist_count = hlist.length (); + + // The current command line is already part of the history list by + // the time we get to this point. Delete it from the list. + + hist_count -= 2; + + if (! insert_curr) + command_history::remove (hist_count); + + hist_count--; + + // If no numbers have been specified, the default is to edit the + // last command in the history list. + + int hist_end = hist_count; + int hist_beg = hist_count; + int reverse = 0; + + // Process options. + + int usage_error = 0; + if (argc == 3) + { + if (sscanf (argv[1].c_str (), "%d", &hist_beg) != 1 + || sscanf (argv[2].c_str (), "%d", &hist_end) != 1) + usage_error = 1; + else + { + hist_beg--; + hist_end--; + } + } + else if (argc == 2) + { + if (sscanf (argv[1].c_str (), "%d", &hist_beg) != 1) + usage_error = 1; + else + { + hist_beg--; + hist_end = hist_beg; + } + } + + if (hist_beg < 0 || hist_end < 0 || hist_beg > hist_count + || hist_end > hist_count) + { + error ("%s: history specification out of range", warn_for); + return retval; + } + + if (usage_error) + { + usage ("%s [first] [last]", warn_for); + return retval; + } + + if (hist_end < hist_beg) + { + int t = hist_end; + hist_end = hist_beg; + hist_beg = t; + reverse = 1; + } + + std::string name = octave_tempnam ("", "oct-"); + + std::fstream file (name.c_str (), std::ios::out); + + if (! file) + { + error ("%s: couldn't open temporary file `%s'", warn_for, + name.c_str ()); + return retval; + } + + if (reverse) + { + for (int i = hist_end; i >= hist_beg; i--) + file << hlist[i] << "\n"; + } + else + { + for (int i = hist_beg; i <= hist_end; i++) + file << hlist[i] << "\n"; + } + + file.close (); + + return name; +} + +static void +unlink_cleanup (const char *file) +{ + gnulib::unlink (file); +} + +static void +do_edit_history (int argc, const string_vector& argv) +{ + std::string name = mk_tmp_hist_file (argc, argv, 0, "edit_history"); + + if (name.empty ()) + return; + + // Call up our favorite editor on the file of commands. + + std::string cmd = VEDITOR; + cmd.append (" \""); + cmd.append (name); + cmd.append ("\""); + + // Ignore interrupts while we are off editing commands. Should we + // maybe avoid using system()? + + volatile octave_interrupt_handler old_interrupt_handler + = octave_ignore_interrupts (); + + system (cmd.c_str ()); + + octave_set_interrupt_handler (old_interrupt_handler); + + // Write the commands to the history file since source_file + // disables command line history while it executes. + + std::fstream file (name.c_str (), std::ios::in); + + char *line; + int first = 1; + while ((line = edit_history_readline (file)) != 0) + { + // Skip blank lines. + + if (line[0] == '\n') + { + delete [] line; + continue; + } + + if (first) + { + first = 0; + edit_history_repl_hist (line); + } + else + edit_history_add_hist (line); + } + + file.close (); + + // Turn on command echo, so the output from this will make better + // sense. + + unwind_protect frame; + + frame.add_fcn (unlink_cleanup, name.c_str ()); + frame.protect_var (Vecho_executing_commands); + frame.protect_var (input_from_tmp_history_file); + + Vecho_executing_commands = ECHO_CMD_LINE; + input_from_tmp_history_file = true; + + source_file (name); +} + +static void +do_run_history (int argc, const string_vector& argv) +{ + std::string name = mk_tmp_hist_file (argc, argv, 1, "run_history"); + + if (name.empty ()) + return; + + // Turn on command echo so the output from this will make better + // sense. + + unwind_protect frame; + + frame.add_fcn (unlink_cleanup, name.c_str ()); + frame.protect_var (Vecho_executing_commands); + frame.protect_var (input_from_tmp_history_file); + + Vecho_executing_commands = ECHO_CMD_LINE; + input_from_tmp_history_file = true; + + source_file (name); +} + +void +initialize_history (bool read_history_file) +{ + command_history::initialize (read_history_file, + default_history_file (), + default_history_size (), + octave_env::getenv ("OCTAVE_HISTCONTROL")); +} + +void +octave_history_write_timestamp (void) +{ + octave_localtime now; + + std::string timestamp = now.strftime (Vhistory_timestamp_format_string); + + if (! timestamp.empty ()) + command_history::add (timestamp); +} + +DEFUN (edit_history, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} edit_history [@var{first}] [@var{last}]\n\ +If invoked with no arguments, @code{edit_history} allows you to edit the\n\ +history list using the editor named by the variable @w{@env{EDITOR}}. The\n\ +commands to be edited are first copied to a temporary file. When you\n\ +exit the editor, Octave executes the commands that remain in the file.\n\ +It is often more convenient to use @code{edit_history} to define functions\n\ +rather than attempting to enter them directly on the command line.\n\ +By default, the block of commands is executed as soon as you exit the\n\ +editor. To avoid executing any commands, simply delete all the lines\n\ +from the buffer before exiting the editor.\n\ +\n\ +The @code{edit_history} command takes two optional arguments specifying\n\ +the history numbers of first and last commands to edit. For example,\n\ +the command\n\ +\n\ +@example\n\ +edit_history 13\n\ +@end example\n\ +\n\ +@noindent\n\ +extracts all the commands from the 13th through the last in the history\n\ +list. The command\n\ +\n\ +@example\n\ +edit_history 13 169\n\ +@end example\n\ +\n\ +@noindent\n\ +only extracts commands 13 through 169. Specifying a larger number for\n\ +the first command than the last command reverses the list of commands\n\ +before placing them in the buffer to be edited. If both arguments are\n\ +omitted, the previous command in the history list is used.\n\ +@seealso{run_history}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("edit_history"); + + if (error_state) + return retval; + + do_edit_history (argc, argv); + + return retval; +} + +DEFUN (history, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} history options\n\ +If invoked with no arguments, @code{history} displays a list of commands\n\ +that you have executed. Valid options are:\n\ +\n\ +@table @code\n\ +@item -w @var{file}\n\ +Write the current history to the file @var{file}. If the name is\n\ +omitted, use the default history file (normally @file{~/.octave_hist}).\n\ +\n\ +@item -r @var{file}\n\ +Read the file @var{file}, appending its contents to the current\n\ +history list. If the name is omitted, use the default history file\n\ +(normally @file{~/.octave_hist}).\n\ +\n\ +@item @var{n}\n\ +Display only the most recent @var{n} lines of history.\n\ +\n\ +@item -q\n\ +Don't number the displayed lines of history. This is useful for cutting\n\ +and pasting commands using the X Window System.\n\ +@end table\n\ +\n\ +For example, to display the five most recent commands that you have\n\ +typed without displaying line numbers, use the command\n\ +@kbd{history -q 5}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("history"); + + if (error_state) + return retval; + + do_history (argc, argv); + + return retval; +} + +DEFUN (run_history, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} run_history [@var{first}] [@var{last}]\n\ +Similar to @code{edit_history}, except that the editor is not invoked,\n\ +and the commands are simply executed as they appear in the history list.\n\ +@seealso{edit_history}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("run_history"); + + if (error_state) + return retval; + + do_run_history (argc, argv); + + return retval; +} + +DEFUN (history_control, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_control ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_control (@var{new_val})\n\ +Query or set the internal variable that specifies how commands are saved\n\ +to the history list. The default value is an empty character string,\n\ +but may be overridden by the environment variable\n\ +@w{@env{OCTAVE_HISTCONTROL}}.\n\ +\n\ +The value of @code{history_control} is a colon-separated list of values\n\ +controlling how commands are saved on the history list. If the list\n\ +of values includes @code{ignorespace}, lines which begin with a space\n\ +character are not saved in the history list. A value of @code{ignoredups}\n\ +causes lines matching the previous history entry to not be saved.\n\ +A value of @code{ignoreboth} is shorthand for @code{ignorespace} and\n\ +@code{ignoredups}. A value of @code{erasedups} causes all previous lines\n\ +matching the current line to be removed from the history list before that\n\ +line is saved. Any value not in the above list is ignored. If\n\ +@code{history_control} is the empty string, all commands are saved on\n\ +the history list, subject to the value of @code{saving_history}.\n\ +@seealso{history_file, history_size, history_timestamp_format_string, saving_history}\n\ +@end deftypefn") +{ + std::string old_history_control = command_history::histcontrol (); + + std::string tmp = old_history_control; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_control"); + + if (tmp != old_history_control) + command_history::process_histcontrol (tmp); + + return retval; +} + +DEFUN (history_size, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_size ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_size (@var{new_val})\n\ +Query or set the internal variable that specifies how many entries\n\ +to store in the history file. The default value is @code{1024},\n\ +but may be overridden by the environment variable @w{@env{OCTAVE_HISTSIZE}}.\n\ +@seealso{history_file, history_timestamp_format_string, saving_history}\n\ +@end deftypefn") +{ + int old_history_size = command_history::size (); + + int tmp = old_history_size; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_size", -1, INT_MAX); + + if (tmp != old_history_size) + command_history::set_size (tmp); + + return retval; +} + +DEFUN (history_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_file (@var{new_val})\n\ +Query or set the internal variable that specifies the name of the\n\ +file used to store command history. The default value is\n\ +@file{~/.octave_hist}, but may be overridden by the environment\n\ +variable @w{@env{OCTAVE_HISTFILE}}.\n\ +@seealso{history_size, saving_history, history_timestamp_format_string}\n\ +@end deftypefn") +{ + std::string old_history_file = command_history::file (); + + std::string tmp = old_history_file; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_file"); + + if (tmp != old_history_file) + command_history::set_file (tmp); + + return retval; +} + +DEFUN (history_timestamp_format_string, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_timestamp_format_string ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_timestamp_format_string (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} history_timestamp_format_string (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the format string\n\ +for the comment line that is written to the history file when Octave\n\ +exits. The format string is passed to @code{strftime}. The default\n\ +value is\n\ +\n\ +@example\n\ +\"# Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ +@end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{strftime, history_file, history_size, saving_history}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (history_timestamp_format_string); +} + +DEFUN (saving_history, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} saving_history ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} saving_history (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} saving_history (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether commands entered\n\ +on the command line are saved in the history file.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{history_control, history_file, history_size, history_timestamp_format_string}\n\ +@end deftypefn") +{ + bool old_saving_history = ! command_history::ignoring_entries (); + + bool tmp = old_saving_history; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "saving_history"); + + if (tmp != old_saving_history) + command_history::ignore_entries (! tmp); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/oct-hist.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/oct-hist.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,38 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_octave_hist_h) +#define octave_octave_hist_h 1 + +#include + +#include "cmd-hist.h" + +extern void initialize_history (bool read_history_file = false); + +// Write timestamp to history file. +extern void octave_history_write_timestamp (void); + +// TRUE means input is coming from temporary history file. +extern bool input_from_tmp_history_file; + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/pager.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/pager.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,715 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "cmd-edit.h" +#include "oct-env.h" +#include "singleton-cleanup.h" + +#include "defaults.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "oct-obj.h" +#include "pager.h" +#include "procstream.h" +#include "sighandlers.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Our actual connection to the external pager. +static oprocstream *external_pager = 0; + +// TRUE means we write to the diary file. +static bool write_to_diary_file = false; + +// The name of the current diary file. +static std::string diary_file; + +// The diary file. +static std::ofstream external_diary_file; + +static std::string +default_pager (void) +{ + std::string pager_binary = octave_env::getenv ("PAGER"); + +#ifdef OCTAVE_DEFAULT_PAGER + if (pager_binary.empty ()) + pager_binary = OCTAVE_DEFAULT_PAGER; +#endif + + return pager_binary; +} + +// The shell command to run as the pager. +static std::string VPAGER = default_pager (); + +// The options to pass to the pager. +static std::string VPAGER_FLAGS; + +// TRUE means that if output is going to the pager, it is sent as soon +// as it is available. Otherwise, it is buffered and only sent to the +// pager when it is time to print another prompt. +static bool Vpage_output_immediately = false; + +// TRUE means all output intended for the screen should be passed +// through the pager. +static bool Vpage_screen_output = true; + +static bool really_flush_to_pager = false; + +static bool flushing_output_to_pager = false; + +static void +clear_external_pager (void) +{ + if (external_pager) + { + octave_child_list::remove (external_pager->pid ()); + + delete external_pager; + external_pager = 0; + } +} + +static bool +pager_event_handler (pid_t pid, int status) +{ + bool retval = false; + + if (pid > 0) + { + if (WIFEXITED (status) || WIFSIGNALLED (status)) + { + // Avoid warning() since that will put us back in the pager, + // which would be bad news. + + std::cerr << "warning: connection to external pager lost (pid = " + << pid << ")" << std::endl; + std::cerr << "warning: flushing pending output (please wait)" + << std::endl; + + // Request removal of this PID from the list of child + // processes. + + retval = true; + } + } + + return retval; +} + +static std::string +pager_command (void) +{ + std::string cmd = VPAGER; + + if (! (cmd.empty () || VPAGER_FLAGS.empty ())) + cmd += " " + VPAGER_FLAGS; + + return cmd; +} + +static void +do_sync (const char *msg, int len, bool bypass_pager) +{ + if (msg && len > 0) + { + if (bypass_pager) + { + std::cout.write (msg, len); + std::cout.flush (); + } + else + { + if (! external_pager) + { + std::string pgr = pager_command (); + + if (! pgr.empty ()) + { + external_pager = new oprocstream (pgr.c_str ()); + + if (external_pager) + octave_child_list::insert (external_pager->pid (), + pager_event_handler); + } + } + + if (external_pager) + { + if (external_pager->good ()) + { + external_pager->write (msg, len); + + external_pager->flush (); + +#if defined (EPIPE) + if (errno == EPIPE) + external_pager->setstate (std::ios::failbit); +#endif + } + else + { + // FIXME -- omething is not right with the + // pager. If it died then we should receive a + // signal for that. If there is some other problem, + // then what? + } + } + else + { + std::cout.write (msg, len); + std::cout.flush (); + } + } + } +} + +// Assume our terminal wraps long lines. + +static bool +more_than_a_screenful (const char *s, int len) +{ + if (s) + { + int available_rows = command_editor::terminal_rows () - 2; + + int cols = command_editor::terminal_cols (); + + int count = 0; + + int chars_this_line = 0; + + for (int i = 0; i < len; i++) + { + if (*s++ == '\n') + { + count += chars_this_line / cols + 1; + chars_this_line = 0; + } + else + chars_this_line++; + } + + if (count > available_rows) + return true; + } + + return false; +} + +int +octave_pager_buf::sync (void) +{ + if (! interactive + || really_flush_to_pager + || (Vpage_screen_output && Vpage_output_immediately) + || ! Vpage_screen_output) + { + char *buf = eback (); + + int len = pptr () - buf; + + bool bypass_pager = (! interactive + || ! Vpage_screen_output + || (really_flush_to_pager + && Vpage_screen_output + && ! Vpage_output_immediately + && ! more_than_a_screenful (buf, len))); + + if (len > 0) + { + do_sync (buf, len, bypass_pager); + + flush_current_contents_to_diary (); + + seekoff (0, std::ios::beg); + } + } + + return 0; +} + +void +octave_pager_buf::flush_current_contents_to_diary (void) +{ + char *buf = eback () + diary_skip; + + size_t len = pptr () - buf; + + octave_diary.write (buf, len); + + diary_skip = 0; +} + +void +octave_pager_buf::set_diary_skip (void) +{ + diary_skip = pptr () - eback (); +} + +int +octave_diary_buf::sync (void) +{ + if (write_to_diary_file && external_diary_file) + { + char *buf = eback (); + + int len = pptr () - buf; + + if (len > 0) + external_diary_file.write (buf, len); + } + + seekoff (0, std::ios::beg); + + return 0; +} + +octave_pager_stream *octave_pager_stream::instance = 0; + +octave_pager_stream::octave_pager_stream (void) : std::ostream (0), pb (0) +{ + pb = new octave_pager_buf (); + rdbuf (pb); + setf (unitbuf); +} + +octave_pager_stream::~octave_pager_stream (void) +{ + flush (); + delete pb; +} + +std::ostream& +octave_pager_stream::stream (void) +{ + return instance_ok () ? *instance : std::cout; +} + +void +octave_pager_stream::flush_current_contents_to_diary (void) +{ + if (instance_ok ()) + instance->do_flush_current_contents_to_diary (); +} + +void +octave_pager_stream::set_diary_skip (void) +{ + if (instance_ok ()) + instance->do_set_diary_skip (); +} + +// Reinitialize the pager buffer to avoid hanging on to large internal +// buffers when they might not be needed. This function should only be +// called when the pager is not in use. For example, just before +// getting command-line input. + +void +octave_pager_stream::reset (void) +{ + if (instance_ok ()) + instance->do_reset (); +} + +void +octave_pager_stream::do_flush_current_contents_to_diary (void) +{ + if (pb) + pb->flush_current_contents_to_diary (); +} + +void +octave_pager_stream::do_set_diary_skip (void) +{ + if (pb) + pb->set_diary_skip (); +} + +void +octave_pager_stream::do_reset (void) +{ + delete pb; + pb = new octave_pager_buf (); + rdbuf (pb); + setf (unitbuf); +} + +bool +octave_pager_stream::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_pager_stream (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create pager_stream object!"); + + retval = false; + } + + return retval; +} + +octave_diary_stream *octave_diary_stream::instance = 0; + +octave_diary_stream::octave_diary_stream (void) : std::ostream (0), db (0) +{ + db = new octave_diary_buf (); + rdbuf (db); + setf (unitbuf); +} + +octave_diary_stream::~octave_diary_stream (void) +{ + flush (); + delete db; +} + +std::ostream& +octave_diary_stream::stream (void) +{ + return instance_ok () ? *instance : std::cout; +} + +// Reinitialize the diary buffer to avoid hanging on to large internal +// buffers when they might not be needed. This function should only be +// called when the pager is not in use. For example, just before +// getting command-line input. + +void +octave_diary_stream::reset (void) +{ + if (instance_ok ()) + instance->do_reset (); +} + +void +octave_diary_stream::do_reset (void) +{ + delete db; + db = new octave_diary_buf (); + rdbuf (db); + setf (unitbuf); +} + +bool +octave_diary_stream::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_diary_stream (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create diary_stream object!"); + + retval = false; + } + + return retval; +} + +void +flush_octave_stdout (void) +{ + if (! flushing_output_to_pager) + { + unwind_protect frame; + + frame.protect_var (really_flush_to_pager); + frame.protect_var (flushing_output_to_pager); + + really_flush_to_pager = true; + flushing_output_to_pager = true; + + octave_stdout.flush (); + + clear_external_pager (); + } +} + +static void +close_diary_file (void) +{ + // Try to flush the current buffer to the diary now, so that things + // like + // + // function foo () + // diary on; + // ... + // diary off; + // endfunction + // + // will do the right thing. + + octave_pager_stream::flush_current_contents_to_diary (); + + if (external_diary_file.is_open ()) + { + octave_diary.flush (); + external_diary_file.close (); + } +} + +static void +open_diary_file (void) +{ + close_diary_file (); + + // If there is pending output in the pager buf, it should not go + // into the diary file. + + octave_pager_stream::set_diary_skip (); + + external_diary_file.open (diary_file.c_str (), std::ios::app); + + if (! external_diary_file) + error ("diary: can't open diary file `%s'", diary_file.c_str ()); +} + +DEFUN (diary, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} diary options\n\ +Record a list of all commands @emph{and} the output they produce, mixed\n\ +together just as you see them on your terminal. Valid options are:\n\ +\n\ +@table @code\n\ +@item on\n\ +Start recording your session in a file called @file{diary} in your\n\ +current working directory.\n\ +\n\ +@item off\n\ +Stop recording your session in the diary file.\n\ +\n\ +@item @var{file}\n\ +Record your session in the file named @var{file}.\n\ +@end table\n\ +\n\ +With no arguments, @code{diary} toggles the current diary state.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("diary"); + + if (error_state) + return retval; + + if (diary_file.empty ()) + diary_file = "diary"; + + switch (argc) + { + case 1: + write_to_diary_file = ! write_to_diary_file; + open_diary_file (); + break; + + case 2: + { + std::string arg = argv[1]; + + if (arg == "on") + { + write_to_diary_file = true; + open_diary_file (); + } + else if (arg == "off") + { + close_diary_file (); + write_to_diary_file = false; + } + else + { + diary_file = arg; + write_to_diary_file = true; + open_diary_file (); + } + } + break; + + default: + print_usage (); + break; + } + + return retval; +} + +DEFUN (more, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} more\n\ +@deftypefnx {Command} {} more on\n\ +@deftypefnx {Command} {} more off\n\ +Turn output pagination on or off. Without an argument, @code{more}\n\ +toggles the current state.\n\ +The current state can be determined via @code{page_screen_output}.\n\ +@seealso{page_screen_output, page_output_immediately, PAGER, PAGER_FLAGS}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("more"); + + if (error_state) + return retval; + + if (argc == 2) + { + std::string arg = argv[1]; + + if (arg == "on") + Vpage_screen_output = true; + else if (arg == "off") + Vpage_screen_output = false; + else + error ("more: unrecognized argument `%s'", arg.c_str ()); + } + else if (argc == 1) + Vpage_screen_output = ! Vpage_screen_output; + else + print_usage (); + + return retval; +} + +DEFUN (terminal_size, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} terminal_size ()\n\ +Return a two-element row vector containing the current size of the\n\ +terminal window in characters (rows and columns).\n\ +@seealso{list_in_columns}\n\ +@end deftypefn") +{ + RowVector size (2, 0.0); + + size(0) = command_editor::terminal_rows (); + size(1) = command_editor::terminal_cols (); + + return octave_value (size); +} + +DEFUN (page_output_immediately, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} page_output_immediately ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} page_output_immediately (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} page_output_immediately (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave sends\n\ +output to the pager as soon as it is available. Otherwise, Octave\n\ +buffers its output and waits until just before the prompt is printed to\n\ +flush it to the pager.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{page_screen_output, more, PAGER, PAGER_FLAGS}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (page_output_immediately); +} + +DEFUN (page_screen_output, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} page_screen_output ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} page_screen_output (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} page_screen_output (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether output intended\n\ +for the terminal window that is longer than one page is sent through a\n\ +pager. This allows you to view one screenful at a time. Some pagers\n\ +(such as @code{less}---see @ref{Installation}) are also capable of moving\n\ +backward on the output.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{more, page_output_immediately, PAGER, PAGER_FLAGS}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (page_screen_output); +} + +DEFUN (PAGER, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PAGER ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PAGER (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PAGER (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the program to use\n\ +to display terminal output on your system. The default value is\n\ +normally @code{\"less\"}, @code{\"more\"}, or\n\ +@code{\"pg\"}, depending on what programs are installed on your system.\n\ +@xref{Installation}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PAGER_FLAGS, page_output_immediately, more, page_screen_output}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER); +} + +DEFUN (PAGER_FLAGS, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PAGER_FLAGS ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PAGER_FLAGS (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PAGER_FLAGS (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the options to pass\n\ +to the pager.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PAGER, more, page_screen_output, page_output_immediately}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER_FLAGS); +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/pager.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/pager.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,150 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_pager_h) +#define octave_pager_h 1 + +#include +#include +#include + +#include + +class +OCTINTERP_API +octave_pager_buf : public std::stringbuf +{ +public: + + octave_pager_buf (void) : std::stringbuf (), diary_skip (0) { } + + void flush_current_contents_to_diary (void); + + void set_diary_skip (void); + +protected: + + int sync (void); + +private: + + size_t diary_skip; +}; + +class +OCTINTERP_API +octave_pager_stream : public std::ostream +{ +protected: + + octave_pager_stream (void); + +public: + + ~octave_pager_stream (void); + + static void flush_current_contents_to_diary (void); + + static void set_diary_skip (void); + + static std::ostream& stream (void); + + static void reset (void); + +private: + + void do_flush_current_contents_to_diary (void); + + void do_set_diary_skip (void); + + void do_reset (void); + + static octave_pager_stream *instance; + + static bool instance_ok (void); + + static void cleanup_instance (void) { delete instance; instance = 0; } + + octave_pager_buf *pb; + + // No copying! + + octave_pager_stream (const octave_pager_stream&); + + octave_pager_stream& operator = (const octave_pager_stream&); +}; + +class +OCTINTERP_API +octave_diary_buf : public std::stringbuf +{ +public: + + octave_diary_buf (void) : std::stringbuf () { } + +protected: + + int sync (void); +}; + +class +OCTINTERP_API +octave_diary_stream : public std::ostream +{ +protected: + + octave_diary_stream (void); + +public: + + ~octave_diary_stream (void); + + static std::ostream& stream (void); + + static void reset (void); + +private: + + void do_reset (void); + + static octave_diary_stream *instance; + + static bool instance_ok (void); + + static void cleanup_instance (void) { delete instance; instance = 0; } + + octave_diary_buf *db; + + // No copying! + + octave_diary_stream (const octave_diary_stream&); + + octave_diary_stream& operator = (const octave_diary_stream&); +}; + +#define octave_stdout (octave_pager_stream::stream ()) + +#define octave_diary (octave_diary_stream::stream ()) + +extern OCTINTERP_API void flush_octave_stdout (void); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/pr-output.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/pr-output.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,4089 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include + +#include "Array-util.h" +#include "CMatrix.h" +#include "Range.h" +#include "cmd-edit.h" +#include "dMatrix.h" +#include "lo-mappers.h" +#include "lo-math.h" +#include "mach-info.h" +#include "oct-cmplx.h" +#include "quit.h" +#include "str-vec.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-stream.h" +#include "pager.h" +#include "pr-output.h" +#include "sysdep.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// TRUE means use a scaled fixed point format for `format long' and +// `format short'. +static bool Vfixed_point_format = false; + +// The maximum field width for a number printed by the default output +// routines. +static int Voutput_max_field_width = 10; + +// The precision of the numbers printed by the default output +// routines. +static int Voutput_precision = 5; + +// TRUE means that the dimensions of empty objects should be printed +// like this: x = [](2x0). +bool Vprint_empty_dimensions = true; + +// TRUE means that the rows of big matrices should be split into +// smaller slices that fit on the screen. +static bool Vsplit_long_rows = true; + +// TRUE means don't do any fancy formatting. +static bool free_format = false; + +// TRUE means print plus sign for nonzero, blank for zero. +static bool plus_format = false; + +// First char for > 0, second for < 0, third for == 0. +static std::string plus_format_chars = "+ "; + +// TRUE means always print in a rational approximation +static bool rat_format = false; + +// Used to force the length of the rational approximation string for Frats +static int rat_string_len = -1; + +// TRUE means always print like dollars and cents. +static bool bank_format = false; + +// TRUE means print data in hexadecimal format. +static int hex_format = 0; + +// TRUE means print data in binary-bit-pattern format. +static int bit_format = 0; + +// TRUE means don't put newlines around the column number headers. +bool Vcompact_format = false; + +// TRUE means use an e format. +static bool print_e = false; + +// TRUE means use a g format. +static bool print_g = false; + +// TRUE means print E instead of e for exponent field. +static bool print_big_e = false; + +// TRUE means use an engineering format. +static bool print_eng = false; + +class pr_engineering_float; +class pr_formatted_float; +class pr_rational_float; + +static int +current_output_max_field_width (void) +{ + return Voutput_max_field_width; +} + +static int +current_output_precision (void) +{ + return Voutput_precision; +} + +class +float_format +{ +public: + + float_format (int w = current_output_max_field_width (), + int p = current_output_precision (), int f = 0) + : fw (w), ex (0), prec (p), fmt (f), up (0), sp (0) { } + + float_format (int w, int e, int p, int f) + : fw (w), ex (e), prec (p), fmt (f), up (0), sp (0) { } + + float_format (const float_format& ff) + : fw (ff.fw), ex (ff.ex), prec (ff.prec), fmt (ff.fmt), up (ff.up), sp (ff.sp) { } + + float_format& operator = (const float_format& ff) + { + if (&ff != this) + { + fw = ff.fw; + ex = ff.ex; + prec = ff.prec; + fmt = ff.fmt; + up = ff.up; + sp = ff.sp; + } + + return *this; + } + + ~float_format (void) { } + + float_format& scientific (void) { fmt = std::ios::scientific; return *this; } + float_format& fixed (void) { fmt = std::ios::fixed; return *this; } + float_format& general (void) { fmt = 0; return *this; } + + float_format& uppercase (void) { up = std::ios::uppercase; return *this; } + float_format& lowercase (void) { up = 0; return *this; } + + float_format& precision (int p) { prec = p; return *this; } + + float_format& width (int w) { fw = w; return *this; } + + float_format& trailing_zeros (bool tz = true) + { sp = tz ? std::ios::showpoint : 0; return *this; } + + friend std::ostream& operator << (std::ostream& os, + const pr_engineering_float& pef); + + friend std::ostream& operator << (std::ostream& os, + const pr_formatted_float& pff); + + friend std::ostream& operator << (std::ostream& os, + const pr_rational_float& prf); + +private: + + // Field width. Zero means as wide as necessary. + int fw; + + // Exponent Field width. Zero means as wide as necessary. + int ex; + + // Precision. + int prec; + + // Format. + int fmt; + + // E or e. + int up; + + // Show trailing zeros. + int sp; +}; + +static int +calc_scale_exp (const int& x) +{ + if (! print_eng) + return x; + else + return x - 3*static_cast (x/3); + /* The expression above is equivalent to x - (x % 3). + * According to the ISO specification for C++ the modulo operator is + * compiler dependent if any of the arguments are negative. Since this + * function will need to work on negative arguments, and we want to avoid + * portability issues, we re-implement the modulo function to the desired + * behavior (truncation). There may be a gnulib replacement. + * + * ISO/IEC 14882:2003 : Programming languages -- C++. 5.6.4: ISO, IEC. 2003 . + * "the binary % operator yields the remainder from the division of the first + * expression by the second. .... If both operands are nonnegative then the + * remainder is nonnegative; if not, the sign of the remainder is + * implementation-defined". */ +} + +static int +engineering_exponent (const double& x) +{ + int ex = 0; + if (x != 0) + { + double absval = (x < 0.0 ? -x : x); + int logabsval = static_cast (gnulib::floor (log10 (absval))); + /* Avoid using modulo function with negative arguments for portability. + * See extended comment at calc_scale_exp */ + if (logabsval < 0.0) + ex = logabsval - 2 + ((-logabsval + 2) % 3); + else + ex = logabsval - (logabsval % 3); + } + return ex; +} + +static int +num_digits (const double& x) +{ + return 1 + (print_eng + ? engineering_exponent (x) + : static_cast (gnulib::floor (log10 (x)))); +} + +class +pr_engineering_float +{ +public: + + const float_format& f; + + double val; + + int exponent (void) const + { + return engineering_exponent (val); + } + + double mantissa (void) const + { + return val / std::pow (10.0, exponent ()); + } + + pr_engineering_float (const float_format& f_arg, double val_arg) + : f (f_arg), val (val_arg) { } +}; + +std::ostream& +operator << (std::ostream& os, const pr_engineering_float& pef) +{ + if (pef.f.fw >= 0) + os << std::setw (pef.f.fw - pef.f.ex); + + if (pef.f.prec >= 0) + os << std::setprecision (pef.f.prec); + + std::ios::fmtflags oflags = + os.flags (static_cast + (pef.f.fmt | pef.f.up | pef.f.sp)); + + os << pef.mantissa (); + + int ex = pef.exponent (); + if (ex < 0) + { + os << std::setw (0) << "e-"; + ex = -ex; + } + else + os << std::setw (0) << "e+"; + + os << std::setw (pef.f.ex - 2) << std::setfill ('0') << ex + << std::setfill (' '); + + os.flags (oflags); + + return os; +} + +class +pr_formatted_float +{ +public: + + const float_format& f; + + double val; + + pr_formatted_float (const float_format& f_arg, double val_arg) + : f (f_arg), val (val_arg) { } +}; + +std::ostream& +operator << (std::ostream& os, const pr_formatted_float& pff) +{ + if (pff.f.fw >= 0) + os << std::setw (pff.f.fw); + + if (pff.f.prec >= 0) + os << std::setprecision (pff.f.prec); + + std::ios::fmtflags oflags = + os.flags (static_cast + (pff.f.fmt | pff.f.up | pff.f.sp)); + + os << pff.val; + + os.flags (oflags); + + return os; +} + +static inline std::string +rational_approx (double val, int len) +{ + std::string s; + + if (len <= 0) + len = 10; + + if (xisinf (val)) + s = "1/0"; + else if (xisnan (val)) + s = "0/0"; + else if (val < INT_MIN || val > INT_MAX || D_NINT (val) == val) + { + std::ostringstream buf; + buf.flags (std::ios::fixed); + buf << std::setprecision (0) << xround (val); + s = buf.str (); + } + else + { + double lastn = 1.; + double lastd = 0.; + double n = xround (val); + double d = 1.; + double frac = val - n; + int m = 0; + + std::ostringstream buf2; + buf2.flags (std::ios::fixed); + buf2 << std::setprecision (0) << static_cast(n); + s = buf2.str (); + + while (1) + { + double flip = 1. / frac; + double step = xround (flip); + double nextn = n; + double nextd = d; + + // Have we converged to 1/intmax ? + if (m > 100 || fabs (frac) < 1 / static_cast(INT_MAX)) + { + lastn = n; + lastd = d; + break; + } + + frac = flip - step; + n = n * step + lastn; + d = d * step + lastd; + lastn = nextn; + lastd = nextd; + + std::ostringstream buf; + buf.flags (std::ios::fixed); + buf << std::setprecision (0) << static_cast(n) + << "/" << static_cast(d); + m++; + + if (n < 0 && d < 0) + { + // Double negative, string can be two characters longer.. + if (buf.str ().length () > static_cast(len + 2) && + m > 1) + break; + } + else if (buf.str ().length () > static_cast(len) && + m > 1) + break; + + s = buf.str (); + } + + if (lastd < 0.) + { + // Move sign to the top + lastd = - lastd; + lastn = - lastn; + std::ostringstream buf; + buf.flags (std::ios::fixed); + buf << std::setprecision (0) << static_cast(lastn) + << "/" << static_cast(lastd); + s = buf.str (); + } + } + + return s; +} + +class +pr_rational_float +{ +public: + + const float_format& f; + + double val; + + pr_rational_float (const float_format& f_arg, double val_arg) + : f (f_arg), val (val_arg) { } +}; + +std::ostream& +operator << (std::ostream& os, const pr_rational_float& prf) +{ + int fw = (rat_string_len > 0 ? rat_string_len : prf.f.fw); + std::string s = rational_approx (prf.val, fw); + + if (fw >= 0) + os << std::setw (fw); + + std::ios::fmtflags oflags = + os.flags (static_cast + (prf.f.fmt | prf.f.up | prf.f.sp)); + + if (fw > 0 && s.length () > static_cast(fw)) + os << "*"; + else + os << s; + + os.flags (oflags); + + return os; +} + +// Current format for real numbers and the real part of complex +// numbers. +static float_format *curr_real_fmt = 0; + +// Current format for the imaginary part of complex numbers. +static float_format *curr_imag_fmt = 0; + +static double +pr_max_internal (const Matrix& m) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + double result = -DBL_MAX; + + bool all_inf_or_nan = true; + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + double val = m(i,j); + if (xisinf (val) || xisnan (val)) + continue; + + all_inf_or_nan = false; + + if (val > result) + result = val; + } + + if (all_inf_or_nan) + result = 0.0; + + return result; +} + +static double +pr_min_internal (const Matrix& m) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + double result = DBL_MAX; + + bool all_inf_or_nan = true; + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + double val = m(i,j); + if (xisinf (val) || xisnan (val)) + continue; + + all_inf_or_nan = false; + + if (val < result) + result = val; + } + + if (all_inf_or_nan) + result = 0.0; + + return result; +} + +// FIXME -- it would be nice to share more code among these +// functions,.. + +static void +set_real_format (int digits, bool inf_or_nan, bool int_only, int &fw) +{ + static float_format fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + fw = 0; + rd = 0; + } + else if (bank_format) + { + fw = digits < 0 ? 4 : digits + 3; + if (inf_or_nan && fw < 4) + fw = 4; + rd = 2; + } + else if (hex_format) + { + fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + fw = 8 * sizeof (double); + rd = 0; + } + else if (inf_or_nan || int_only) + { + fw = 1 + digits; + if (inf_or_nan && fw < 4) + fw = 4; + rd = fw; + } + else + { + if (digits > 0) + { + ld = digits; + rd = prec > digits ? prec - digits : prec; + digits++; + } + else + { + ld = 1; + rd = prec > digits ? prec - digits : prec; + digits = -digits + 1; + } + + fw = 1 + ld + 1 + rd; + if (inf_or_nan && fw < 4) + fw = 4; + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (fw > Voutput_max_field_width || print_e || print_g || print_eng)) + { + if (print_g) + fmt = float_format (); + else + { + int ex = 4; + if (digits > 100) + ex++; + + if (print_eng) + { + fw = 4 + prec + ex; + if (inf_or_nan && fw < 6) + fw = 6; + fmt = float_format (fw, ex, prec - 1, std::ios::fixed); + } + else + { + fw = 2 + prec + ex; + if (inf_or_nan && fw < 4) + fw = 4; + fmt = float_format (fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + fmt.uppercase (); + } + else if (! bank_format && (inf_or_nan || int_only)) + fmt = float_format (fw, rd); + else + fmt = float_format (fw, rd, std::ios::fixed); + + curr_real_fmt = &fmt; +} + +static void +set_format (double d, int& fw) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + bool inf_or_nan = (xisinf (d) || xisnan (d)); + + bool int_only = (! inf_or_nan && D_NINT (d) == d); + + double d_abs = d < 0.0 ? -d : d; + + int digits = (inf_or_nan || d_abs == 0.0) + ? 0 : num_digits (d_abs); + + set_real_format (digits, inf_or_nan, int_only, fw); +} + +static inline void +set_format (double d) +{ + int fw; + set_format (d, fw); +} + +static void +set_real_matrix_format (int x_max, int x_min, bool inf_or_nan, + int int_or_inf_or_nan, int& fw) +{ + static float_format fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + fw = 9; + rd = 0; + } + else if (bank_format) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits <= 0 ? 4 : digits + 3; + if (inf_or_nan && fw < 4) + fw = 4; + rd = 2; + } + else if (hex_format) + { + fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + fw = 8 * sizeof (double); + rd = 0; + } + else if (Vfixed_point_format && ! print_g) + { + rd = prec; + fw = rd + 2; + if (inf_or_nan && fw < 4) + fw = 4; + } + else if (int_or_inf_or_nan) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits <= 0 ? 2 : digits + 1; + if (inf_or_nan && fw < 4) + fw = 4; + rd = fw; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + fw = 1 + ld + 1 + rd; + if (inf_or_nan && fw < 4) + fw = 4; + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (print_e + || print_eng || print_g + || (! Vfixed_point_format && fw > Voutput_max_field_width))) + { + if (print_g) + fmt = float_format (); + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + fw = 4 + prec + ex; + if (inf_or_nan && fw < 6) + fw = 6; + fmt = float_format (fw, ex, prec - 1, std::ios::fixed); + } + else + { + fw = 2 + prec + ex; + if (inf_or_nan && fw < 4) + fw = 4; + fmt = float_format (fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + fmt.uppercase (); + } + else if (! bank_format && int_or_inf_or_nan) + fmt = float_format (fw, rd); + else + fmt = float_format (fw, rd, std::ios::fixed); + + curr_real_fmt = &fmt; +} + +static void +set_format (const Matrix& m, int& fw, double& scale) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + bool inf_or_nan = m.any_element_is_inf_or_nan (); + + bool int_or_inf_or_nan = m.all_elements_are_int_or_inf_or_nan (); + + Matrix m_abs = m.abs (); + double max_abs = pr_max_internal (m_abs); + double min_abs = pr_min_internal (m_abs); + + int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); + + int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); + + scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 + : std::pow (10.0, calc_scale_exp (x_max - 1)); + + set_real_matrix_format (x_max, x_min, inf_or_nan, int_or_inf_or_nan, fw); +} + +static inline void +set_format (const Matrix& m) +{ + int fw; + double scale; + set_format (m, fw, scale); +} + +static void +set_complex_format (int x_max, int x_min, int r_x, bool inf_or_nan, + int int_only, int& r_fw, int& i_fw) +{ + static float_format r_fmt; + static float_format i_fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + i_fw = 0; + r_fw = 0; + rd = 0; + } + else if (bank_format) + { + int digits = r_x; + i_fw = 0; + r_fw = digits <= 0 ? 4 : digits + 3; + if (inf_or_nan && r_fw < 4) + r_fw = 4; + rd = 2; + } + else if (hex_format) + { + r_fw = 2 * sizeof (double); + i_fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + r_fw = 8 * sizeof (double); + i_fw = 8 * sizeof (double); + rd = 0; + } + else if (inf_or_nan || int_only) + { + int digits = x_max > x_min ? x_max : x_min; + i_fw = digits <= 0 ? 1 : digits; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + rd = r_fw; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + i_fw = ld + 1 + rd; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (r_fw > Voutput_max_field_width || print_e || print_eng || print_g)) + { + if (print_g) + { + r_fmt = float_format (); + i_fmt = float_format (); + } + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + i_fw = 3 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 5) + { + i_fw = 5; + r_fw = 6; + } + r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); + i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); + } + else + { + i_fw = 1 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); + i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + { + r_fmt.uppercase (); + i_fmt.uppercase (); + } + } + else if (! bank_format && (inf_or_nan || int_only)) + { + r_fmt = float_format (r_fw, rd); + i_fmt = float_format (i_fw, rd); + } + else + { + r_fmt = float_format (r_fw, rd, std::ios::fixed); + i_fmt = float_format (i_fw, rd, std::ios::fixed); + } + + curr_real_fmt = &r_fmt; + curr_imag_fmt = &i_fmt; +} + +static void +set_format (const Complex& c, int& r_fw, int& i_fw) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + double rp = c.real (); + double ip = c.imag (); + + bool inf_or_nan = (xisinf (c) || xisnan (c)); + + bool int_only = (D_NINT (rp) == rp && D_NINT (ip) == ip); + + double r_abs = rp < 0.0 ? -rp : rp; + double i_abs = ip < 0.0 ? -ip : ip; + + int r_x = (xisinf (rp) || xisnan (rp) || r_abs == 0.0) + ? 0 : num_digits (r_abs); + + int i_x = (xisinf (ip) || xisnan (ip) || i_abs == 0.0) + ? 0 : num_digits (i_abs); + + int x_max, x_min; + + if (r_x > i_x) + { + x_max = r_x; + x_min = i_x; + } + else + { + x_max = i_x; + x_min = r_x; + } + + set_complex_format (x_max, x_min, r_x, inf_or_nan, int_only, r_fw, i_fw); +} + +static inline void +set_format (const Complex& c) +{ + int r_fw, i_fw; + set_format (c, r_fw, i_fw); +} + +static void +set_complex_matrix_format (int x_max, int x_min, int r_x_max, + int r_x_min, bool inf_or_nan, + int int_or_inf_or_nan, int& r_fw, int& i_fw) +{ + static float_format r_fmt; + static float_format i_fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + i_fw = 9; + r_fw = 9; + rd = 0; + } + else if (bank_format) + { + int digits = r_x_max > r_x_min ? r_x_max : r_x_min; + i_fw = 0; + r_fw = digits <= 0 ? 4 : digits + 3; + if (inf_or_nan && r_fw < 4) + r_fw = 4; + rd = 2; + } + else if (hex_format) + { + r_fw = 2 * sizeof (double); + i_fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + r_fw = 8 * sizeof (double); + i_fw = 8 * sizeof (double); + rd = 0; + } + else if (Vfixed_point_format && ! print_g) + { + rd = prec; + i_fw = rd + 1; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + } + else if (int_or_inf_or_nan) + { + int digits = x_max > x_min ? x_max : x_min; + i_fw = digits <= 0 ? 1 : digits; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + rd = r_fw; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + i_fw = ld + 1 + rd; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (print_e + || print_eng || print_g + || (! Vfixed_point_format && r_fw > Voutput_max_field_width))) + { + if (print_g) + { + r_fmt = float_format (); + i_fmt = float_format (); + } + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + i_fw = 3 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 5) + { + i_fw = 5; + r_fw = 6; + } + r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); + i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); + } + else + { + i_fw = 1 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); + i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + { + r_fmt.uppercase (); + i_fmt.uppercase (); + } + } + else if (! bank_format && int_or_inf_or_nan) + { + r_fmt = float_format (r_fw, rd); + i_fmt = float_format (i_fw, rd); + } + else + { + r_fmt = float_format (r_fw, rd, std::ios::fixed); + i_fmt = float_format (i_fw, rd, std::ios::fixed); + } + + curr_real_fmt = &r_fmt; + curr_imag_fmt = &i_fmt; +} + +static void +set_format (const ComplexMatrix& cm, int& r_fw, int& i_fw, double& scale) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + Matrix rp = real (cm); + Matrix ip = imag (cm); + + bool inf_or_nan = cm.any_element_is_inf_or_nan (); + + bool int_or_inf_or_nan = (rp.all_elements_are_int_or_inf_or_nan () + && ip.all_elements_are_int_or_inf_or_nan ()); + + Matrix r_m_abs = rp.abs (); + double r_max_abs = pr_max_internal (r_m_abs); + double r_min_abs = pr_min_internal (r_m_abs); + + Matrix i_m_abs = ip.abs (); + double i_max_abs = pr_max_internal (i_m_abs); + double i_min_abs = pr_min_internal (i_m_abs); + + int r_x_max = r_max_abs == 0.0 ? 0 : num_digits (r_max_abs); + + int r_x_min = r_min_abs == 0.0 ? 0 : num_digits (r_min_abs); + + int i_x_max = i_max_abs == 0.0 ? 0 : num_digits (i_max_abs); + + int i_x_min = i_min_abs == 0.0 ? 0 : num_digits (i_min_abs); + + int x_max = r_x_max > i_x_max ? r_x_max : i_x_max; + int x_min = r_x_min > i_x_min ? r_x_min : i_x_min; + + scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 + : std::pow (10.0, calc_scale_exp (x_max - 1)); + + set_complex_matrix_format (x_max, x_min, r_x_max, r_x_min, inf_or_nan, + int_or_inf_or_nan, r_fw, i_fw); +} + +static inline void +set_format (const ComplexMatrix& cm) +{ + int r_fw, i_fw; + double scale; + set_format (cm, r_fw, i_fw, scale); +} + +static void +set_range_format (int x_max, int x_min, int all_ints, int& fw) +{ + static float_format fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + fw = 9; + rd = 0; + } + else if (bank_format) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits < 0 ? 5 : digits + 4; + rd = 2; + } + else if (hex_format) + { + fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + fw = 8 * sizeof (double); + rd = 0; + } + else if (all_ints) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits + 1; + rd = fw; + } + else if (Vfixed_point_format && ! print_g) + { + rd = prec; + fw = rd + 3; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + fw = ld + rd + 3; + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (print_e + || print_eng || print_g + || (! Vfixed_point_format && fw > Voutput_max_field_width))) + { + if (print_g) + fmt = float_format (); + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + fw = 5 + prec + ex; + fmt = float_format (fw, ex, prec - 1, std::ios::fixed); + } + else + { + fw = 3 + prec + ex; + fmt = float_format (fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + fmt.uppercase (); + } + else if (! bank_format && all_ints) + fmt = float_format (fw, rd); + else + fmt = float_format (fw, rd, std::ios::fixed); + + curr_real_fmt = &fmt; +} + +static void +set_format (const Range& r, int& fw, double& scale) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + double r_min = r.base (); + double r_max = r.limit (); + + if (r_max < r_min) + { + double tmp = r_max; + r_max = r_min; + r_min = tmp; + } + + bool all_ints = r.all_elements_are_ints (); + + double max_abs = r_max < 0.0 ? -r_max : r_max; + double min_abs = r_min < 0.0 ? -r_min : r_min; + + int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); + + int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); + + scale = (x_max == 0 || all_ints) ? 1.0 + : std::pow (10.0, calc_scale_exp (x_max - 1)); + + set_range_format (x_max, x_min, all_ints, fw); +} + +static inline void +set_format (const Range& r) +{ + int fw; + double scale; + set_format (r, fw, scale); +} + +union equiv +{ + double d; + unsigned char i[sizeof (double)]; +}; + +#define PRINT_CHAR_BITS(os, c) \ + do \ + { \ + unsigned char ctmp = c; \ + char stmp[9]; \ + stmp[0] = (ctmp & 0x80) ? '1' : '0'; \ + stmp[1] = (ctmp & 0x40) ? '1' : '0'; \ + stmp[2] = (ctmp & 0x20) ? '1' : '0'; \ + stmp[3] = (ctmp & 0x10) ? '1' : '0'; \ + stmp[4] = (ctmp & 0x08) ? '1' : '0'; \ + stmp[5] = (ctmp & 0x04) ? '1' : '0'; \ + stmp[6] = (ctmp & 0x02) ? '1' : '0'; \ + stmp[7] = (ctmp & 0x01) ? '1' : '0'; \ + stmp[8] = '\0'; \ + os << stmp; \ + } \ + while (0) + +#define PRINT_CHAR_BITS_SWAPPED(os, c) \ + do \ + { \ + unsigned char ctmp = c; \ + char stmp[9]; \ + stmp[0] = (ctmp & 0x01) ? '1' : '0'; \ + stmp[1] = (ctmp & 0x02) ? '1' : '0'; \ + stmp[2] = (ctmp & 0x04) ? '1' : '0'; \ + stmp[3] = (ctmp & 0x08) ? '1' : '0'; \ + stmp[4] = (ctmp & 0x10) ? '1' : '0'; \ + stmp[5] = (ctmp & 0x20) ? '1' : '0'; \ + stmp[6] = (ctmp & 0x40) ? '1' : '0'; \ + stmp[7] = (ctmp & 0x80) ? '1' : '0'; \ + stmp[8] = '\0'; \ + os << stmp; \ + } \ + while (0) + +static void +pr_any_float (const float_format *fmt, std::ostream& os, double d, int fw = 0) +{ + if (fmt) + { + // Unless explicitly asked for, always print in big-endian + // format for hex and bit formats. + // + // {bit,hex}_format == 1: print big-endian + // {bit,hex}_format == 2: print native + + if (hex_format) + { + equiv tmp; + tmp.d = d; + + // Unless explicitly asked for, always print in big-endian + // format. + + // FIXME -- is it correct to swap bytes for VAX + // formats and not for Cray? + + // FIXME -- will bad things happen if we are + // interrupted before resetting the format flags and fill + // character? + + oct_mach_info::float_format flt_fmt = + oct_mach_info::native_float_format (); + + char ofill = os.fill ('0'); + + std::ios::fmtflags oflags + = os.flags (std::ios::right | std::ios::hex); + + if (hex_format > 1 + || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian + || flt_fmt == oct_mach_info::flt_fmt_cray + || flt_fmt == oct_mach_info::flt_fmt_unknown) + { + for (size_t i = 0; i < sizeof (double); i++) + os << std::setw (2) << static_cast (tmp.i[i]); + } + else + { + for (int i = sizeof (double) - 1; i >= 0; i--) + os << std::setw (2) << static_cast (tmp.i[i]); + } + + os.fill (ofill); + os.setf (oflags); + } + else if (bit_format) + { + equiv tmp; + tmp.d = d; + + // FIXME -- is it correct to swap bytes for VAX + // formats and not for Cray? + + oct_mach_info::float_format flt_fmt = + oct_mach_info::native_float_format (); + + if (flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian + || flt_fmt == oct_mach_info::flt_fmt_cray + || flt_fmt == oct_mach_info::flt_fmt_unknown) + { + for (size_t i = 0; i < sizeof (double); i++) + PRINT_CHAR_BITS (os, tmp.i[i]); + } + else + { + if (bit_format > 1) + { + for (size_t i = 0; i < sizeof (double); i++) + PRINT_CHAR_BITS_SWAPPED (os, tmp.i[i]); + } + else + { + for (int i = sizeof (double) - 1; i >= 0; i--) + PRINT_CHAR_BITS (os, tmp.i[i]); + } + } + } + else if (octave_is_NA (d)) + { + if (fw > 0) + os << std::setw (fw) << "NA"; + else + os << "NA"; + } + else if (rat_format) + os << pr_rational_float (*fmt, d); + else if (xisinf (d)) + { + const char *s; + if (d < 0.0) + s = "-Inf"; + else + s = "Inf"; + + if (fw > 0) + os << std::setw (fw) << s; + else + os << s; + } + else if (xisnan (d)) + { + if (fw > 0) + os << std::setw (fw) << "NaN"; + else + os << "NaN"; + } + else if (print_eng) + os << pr_engineering_float (*fmt, d); + else + os << pr_formatted_float (*fmt, d); + } + else + os << d; +} + +static inline void +pr_float (std::ostream& os, double d, int fw = 0, double scale = 1.0) +{ + if (Vfixed_point_format && ! print_g && scale != 1.0) + d /= scale; + + pr_any_float (curr_real_fmt, os, d, fw); +} + +static inline void +pr_imag_float (std::ostream& os, double d, int fw = 0) +{ + pr_any_float (curr_imag_fmt, os, d, fw); +} + +static void +pr_complex (std::ostream& os, const Complex& c, int r_fw = 0, + int i_fw = 0, double scale = 1.0) +{ + Complex tmp + = (Vfixed_point_format && ! print_g && scale != 1.0) ? c / scale : c; + + double r = tmp.real (); + + pr_float (os, r, r_fw); + + if (! bank_format) + { + double i = tmp.imag (); + if (! (hex_format || bit_format) && lo_ieee_signbit (i)) + { + os << " - "; + i = -i; + pr_imag_float (os, i, i_fw); + } + else + { + if (hex_format || bit_format) + os << " "; + else + os << " + "; + + pr_imag_float (os, i, i_fw); + } + os << "i"; + } +} + +static void +print_empty_matrix (std::ostream& os, octave_idx_type nr, octave_idx_type nc, bool pr_as_read_syntax) +{ + assert (nr == 0 || nc == 0); + + if (pr_as_read_syntax) + { + if (nr == 0 && nc == 0) + os << "[]"; + else + os << "zeros (" << nr << ", " << nc << ")"; + } + else + { + os << "[]"; + + if (Vprint_empty_dimensions) + os << "(" << nr << "x" << nc << ")"; + } +} + +static void +print_empty_nd_array (std::ostream& os, const dim_vector& dims, + bool pr_as_read_syntax) +{ + assert (dims.any_zero ()); + + if (pr_as_read_syntax) + os << "zeros (" << dims.str (',') << ")"; + else + { + os << "[]"; + + if (Vprint_empty_dimensions) + os << "(" << dims.str () << ")"; + } +} + +static void +pr_scale_header (std::ostream& os, double scale) +{ + if (Vfixed_point_format && ! print_g && scale != 1.0) + { + os << " " + << std::setw (8) << std::setprecision (1) + << std::setiosflags (std::ios::scientific|std::ios::left) + << scale + << std::resetiosflags (std::ios::scientific|std::ios::left) + << " *\n"; + + if (! Vcompact_format) + os << "\n"; + } +} + +static void +pr_col_num_header (std::ostream& os, octave_idx_type total_width, int max_width, + octave_idx_type lim, octave_idx_type col, int extra_indent) +{ + if (total_width > max_width && Vsplit_long_rows) + { + if (col != 0) + { + if (Vcompact_format) + os << "\n"; + else + os << "\n\n"; + } + + octave_idx_type num_cols = lim - col; + + os << std::setw (extra_indent) << ""; + + if (num_cols == 1) + os << " Column " << col + 1 << ":\n"; + else if (num_cols == 2) + os << " Columns " << col + 1 << " and " << lim << ":\n"; + else + os << " Columns " << col + 1 << " through " << lim << ":\n"; + + if (! Vcompact_format) + os << "\n"; + } +} + +template +/* static */ inline void +pr_plus_format (std::ostream& os, const T& val) +{ + if (val > T (0)) + os << plus_format_chars[0]; + else if (val < T (0)) + os << plus_format_chars[1]; + else + os << plus_format_chars[2]; +} + +void +octave_print_internal (std::ostream& os, double d, + bool /* pr_as_read_syntax */) +{ + if (plus_format) + { + pr_plus_format (os, d); + } + else + { + set_format (d); + if (free_format) + os << d; + else + pr_float (os, d); + } +} + +void +octave_print_internal (std::ostream& os, const Matrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, m(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int fw; + double scale = 1.0; + set_format (m, fw, scale); + int column_width = fw + 2; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << m; + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (i == 0 && j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_float (os, m(i,j)); + } + + col += inc; + + if (col >= nc) + { + if (i == nr - 1) + os << " ]"; + else + os << ";\n"; + } + else + os << " ...\n"; + } + } + } + else + { + pr_scale_header (os, scale); + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + pr_float (os, m(i,j), fw, scale); + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const DiagMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, m(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int fw; + double scale = 1.0; + set_format (Matrix (m.diag ()), fw, scale); + int column_width = fw + 2; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << Matrix (m); + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + os << "diag ("; + + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_float (os, m(j,j)); + } + + col += inc; + + if (col >= nc) + os << " ]"; + else + os << " ...\n"; + } + os << ")"; + } + else + { + os << "Diagonal Matrix\n"; + if (! Vcompact_format) + os << "\n"; + + pr_scale_header (os, scale); + + // kluge. Get the true width of a number. + int zero_fw; + + { + std::ostringstream tmp_oss; + pr_float (tmp_oss, 0.0, fw, scale); + zero_fw = tmp_oss.str ().length (); + } + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + if (i == j) + pr_float (os, m(i,j), fw, scale); + else + os << std::setw (zero_fw) << '0'; + + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +template +void print_nd_array (std::ostream& os, const NDA_T& nda, + bool pr_as_read_syntax) +{ + + if (nda.is_empty ()) + print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); + else + { + + int ndims = nda.ndims (); + + dim_vector dims = nda.dims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + for (octave_idx_type i = 0; i < m; i++) + { + octave_quit (); + + std::string nm = "ans"; + + if (m > 1) + { + nm += "(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + octave_value page + = MAT_T (Array (nda.index (idx), dim_vector (nr, nc))); + + if (i != m - 1) + { + page.print_with_name (os, nm); + } + else + { + page.print_name_tag (os, nm); + page.print_raw (os); + } + + if (i < m) + NDA_T::increment_index (ra_idx, dims, 2); + } + } +} + +void +octave_print_internal (std::ostream& os, const NDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +template <> +/* static */ inline void +pr_plus_format<> (std::ostream& os, const Complex& c) +{ + double rp = c.real (); + double ip = c.imag (); + + if (rp == 0.0) + { + if (ip == 0.0) + os << " "; + else + os << "i"; + } + else if (ip == 0.0) + pr_plus_format (os, rp); + else + os << "c"; +} + +void +octave_print_internal (std::ostream& os, const Complex& c, + bool /* pr_as_read_syntax */) +{ + if (plus_format) + { + pr_plus_format (os, c); + } + else + { + set_format (c); + if (free_format) + os << c; + else + pr_complex (os, c); + } +} + +void +octave_print_internal (std::ostream& os, const ComplexMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = cm.rows (); + octave_idx_type nc = cm.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, cm(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int r_fw, i_fw; + double scale = 1.0; + set_format (cm, r_fw, i_fw, scale); + int column_width = i_fw + r_fw; + column_width += (rat_format || bank_format || hex_format + || bit_format) ? 2 : 7; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << cm; + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (i == 0 && j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_complex (os, cm(i,j)); + } + + col += inc; + + if (col >= nc) + { + if (i == nr - 1) + os << " ]"; + else + os << ";\n"; + } + else + os << " ...\n"; + } + } + } + else + { + pr_scale_header (os, scale); + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + pr_complex (os, cm(i,j), r_fw, i_fw, scale); + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = cm.rows (); + octave_idx_type nc = cm.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, cm(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int r_fw, i_fw; + double scale = 1.0; + set_format (ComplexMatrix (cm.diag ()), r_fw, i_fw, scale); + int column_width = i_fw + r_fw; + column_width += (rat_format || bank_format || hex_format + || bit_format) ? 2 : 7; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << ComplexMatrix (cm); + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + os << "diag ("; + + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_complex (os, cm(j,j)); + } + + col += inc; + + if (col >= nc) + os << " ]"; + else + os << " ...\n"; + } + os << ")"; + } + else + { + os << "Diagonal Matrix\n"; + if (! Vcompact_format) + os << "\n"; + + pr_scale_header (os, scale); + + // kluge. Get the true width of a number. + int zero_fw; + + { + std::ostringstream tmp_oss; + pr_complex (tmp_oss, Complex (0.0), r_fw, i_fw, scale); + zero_fw = tmp_oss.str ().length (); + } + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + if (i == j) + pr_complex (os, cm(i,j), r_fw, i_fw, scale); + else + os << std::setw (zero_fw) << '0'; + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const PermMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, m(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int fw = 2; + int column_width = fw + 2; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << Matrix (m); + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + Array pvec = m.pvec (); + bool colp = m.is_col_perm (); + + os << "eye ("; + if (colp) os << ":, "; + + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + os << pvec (j); + } + + col += inc; + + if (col >= nc) + os << " ]"; + else + os << " ...\n"; + } + if (! colp) os << ", :"; + os << ")"; + } + else + { + os << "Permutation Matrix\n"; + if (! Vcompact_format) + os << "\n"; + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + os << std::setw (fw) << m(i,j); + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const ComplexNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +void +octave_print_internal (std::ostream& os, bool d, bool pr_as_read_syntax) +{ + octave_print_internal (os, double (d), pr_as_read_syntax); +} + +// FIXME -- write single precision versions of the printing functions. + +void +octave_print_internal (std::ostream& os, float d, bool pr_as_read_syntax) +{ + octave_print_internal (os, double (d), pr_as_read_syntax); +} + +void +octave_print_internal (std::ostream& os, const FloatMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, Matrix (m), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, DiagMatrix (m), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, NDArray (nda), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatComplex& c, + bool pr_as_read_syntax) +{ + octave_print_internal (os, Complex (c), pr_as_read_syntax); +} + +void +octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, ComplexMatrix (cm), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, ComplexDiagMatrix (cm), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, ComplexNDArray (nda), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const Range& r, + bool pr_as_read_syntax, int extra_indent) +{ + double base = r.base (); + double increment = r.inc (); + double limit = r.limit (); + octave_idx_type num_elem = r.nelem (); + + if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < num_elem; i++) + { + octave_quit (); + + double val = base + i * increment; + + pr_plus_format (os, val); + } + } + else + { + int fw = 0; + double scale = 1.0; + set_format (r, fw, scale); + + if (pr_as_read_syntax) + { + if (free_format) + { + os << base << " : "; + if (increment != 1.0) + os << increment << " : "; + os << limit; + } + else + { + pr_float (os, base, fw); + os << " : "; + if (increment != 1.0) + { + pr_float (os, increment, fw); + os << " : "; + } + pr_float (os, limit, fw); + } + } + else + { + int column_width = fw + 2; + octave_idx_type total_width = num_elem * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (free_format) + { + os << r; + return; + } + + octave_idx_type inc = num_elem; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + pr_scale_header (os, scale); + + octave_idx_type col = 0; + while (col < num_elem) + { + octave_idx_type lim = col + inc < num_elem ? col + inc : num_elem; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + os << std::setw (extra_indent) << ""; + + for (octave_idx_type i = col; i < lim; i++) + { + octave_quit (); + + double val = base + i * increment; + + if (i == num_elem - 1) + { + // See the comments in Range::matrix_value. + + if ((increment > 0 && val > limit) + || (increment < 0 && val < limit)) + val = limit; + } + + os << " "; + + pr_float (os, val, fw, scale); + } + + col += inc; + } + } + } +} + +void +octave_print_internal (std::ostream& os, const boolMatrix& bm, + bool pr_as_read_syntax, + int extra_indent) +{ + Matrix tmp (bm); + octave_print_internal (os, tmp, pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const boolNDArray& nda, + bool pr_as_read_syntax, + int extra_indent) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +void +octave_print_internal (std::ostream& os, const charMatrix& chm, + bool pr_as_read_syntax, + int /* extra_indent FIXME */, + bool pr_as_string) +{ + if (pr_as_string) + { + octave_idx_type nstr = chm.rows (); + + if (pr_as_read_syntax && nstr > 1) + os << "[ "; + + if (nstr != 0) + { + for (octave_idx_type i = 0; i < nstr; i++) + { + octave_quit (); + + std::string row = chm.row_as_string (i); + + if (pr_as_read_syntax) + { + os << "\"" << undo_string_escapes (row) << "\""; + + if (i < nstr - 1) + os << "; "; + } + else + { + os << row; + + if (i < nstr - 1) + os << "\n"; + } + } + } + + if (pr_as_read_syntax && nstr > 1) + os << " ]"; + } + else + { + os << "sorry, printing char matrices not implemented yet\n"; + } +} + +void +octave_print_internal (std::ostream& os, const charNDArray& nda, + bool pr_as_read_syntax, int extra_indent, + bool pr_as_string) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent, pr_as_string); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +void +octave_print_internal (std::ostream& os, const std::string& s, + bool pr_as_read_syntax, int extra_indent) +{ + Array nda (dim_vector (1, 1), s); + + octave_print_internal (os, nda, pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const Array& nda, + bool pr_as_read_syntax, int /* extra_indent */) +{ + // FIXME -- this mostly duplicates the code in the print_nd_array<> + // function. Can fix this with std::is_same from C++11. + + if (nda.is_empty ()) + print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); + else if (nda.length () == 1) + { + os << nda(0); + } + else + { + int ndims = nda.ndims (); + + dim_vector dims = nda.dims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + for (octave_idx_type i = 0; i < m; i++) + { + std::string nm = "ans"; + + if (m > 1) + { + nm += "(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + Array page (nda.index (idx), dim_vector (nr, nc)); + + // FIXME -- need to do some more work to put these + // in neatly aligned columns... + + octave_idx_type n_rows = page.rows (); + octave_idx_type n_cols = page.cols (); + + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; + + for (octave_idx_type ii = 0; ii < n_rows; ii++) + { + for (octave_idx_type jj = 0; jj < n_cols; jj++) + os << " " << page(ii,jj); + + os << "\n"; + } + + if (i < m - 1) + os << "\n"; + + if (i < m) + increment_index (ra_idx, dims, 2); + } + } +} + +template +class +octave_print_conv +{ +public: + typedef T print_conv_type; +}; + +#define PRINT_CONV(T1, T2) \ + template <> \ + class \ + octave_print_conv \ + { \ + public: \ + typedef T2 print_conv_type; \ + } + +PRINT_CONV (octave_int8, octave_int16); +PRINT_CONV (octave_uint8, octave_uint16); + +#undef PRINT_CONV + +template +/* static */ inline void +pr_int (std::ostream& os, const T& d, int fw = 0) +{ + size_t sz = d.byte_size (); + const unsigned char * tmpi = d.iptr (); + + // Unless explicitly asked for, always print in big-endian + // format for hex and bit formats. + // + // {bit,hex}_format == 1: print big-endian + // {bit,hex}_format == 2: print native + + if (hex_format) + { + char ofill = os.fill ('0'); + + std::ios::fmtflags oflags + = os.flags (std::ios::right | std::ios::hex); + + if (hex_format > 1 || oct_mach_info::words_big_endian ()) + { + for (size_t i = 0; i < sz; i++) + os << std::setw (2) << static_cast (tmpi[i]); + } + else + { + for (int i = sz - 1; i >= 0; i--) + os << std::setw (2) << static_cast (tmpi[i]); + } + + os.fill (ofill); + os.setf (oflags); + } + else if (bit_format) + { + if (oct_mach_info::words_big_endian ()) + { + for (size_t i = 0; i < sz; i++) + PRINT_CHAR_BITS (os, tmpi[i]); + } + else + { + if (bit_format > 1) + { + for (size_t i = 0; i < sz; i++) + PRINT_CHAR_BITS_SWAPPED (os, tmpi[i]); + } + else + { + for (int i = sz - 1; i >= 0; i--) + PRINT_CHAR_BITS (os, tmpi[i]); + } + } + } + else + { + os << std::setw (fw) + << typename octave_print_conv::print_conv_type (d); + + if (bank_format) + os << ".00"; + } +} + +// FIXME -- all this mess with abs is an attempt to avoid seeing +// +// warning: comparison of unsigned expression < 0 is always false +// +// from GCC. Isn't there a better way + +template +/* static */ inline T +abs (T x) +{ + return x < 0 ? -x : x; +} + +#define INSTANTIATE_ABS(T) \ + template /* static */ T abs (T) + +INSTANTIATE_ABS(signed char); +INSTANTIATE_ABS(short); +INSTANTIATE_ABS(int); +INSTANTIATE_ABS(long); +INSTANTIATE_ABS(long long); + +#define SPECIALIZE_UABS(T) \ + template <> \ + /* static */ inline unsigned T \ + abs (unsigned T x) \ + { \ + return x; \ + } + +SPECIALIZE_UABS(char) +SPECIALIZE_UABS(short) +SPECIALIZE_UABS(int) +SPECIALIZE_UABS(long) +SPECIALIZE_UABS(long long) + +template void +pr_int (std::ostream&, const octave_int8&, int); + +template void +pr_int (std::ostream&, const octave_int16&, int); + +template void +pr_int (std::ostream&, const octave_int32&, int); + +template void +pr_int (std::ostream&, const octave_int64&, int); + +template void +pr_int (std::ostream&, const octave_uint8&, int); + +template void +pr_int (std::ostream&, const octave_uint16&, int); + +template void +pr_int (std::ostream&, const octave_uint32&, int); + +template void +pr_int (std::ostream&, const octave_uint64&, int); + +template +void +octave_print_internal_template (std::ostream& os, const octave_int& val, + bool) +{ + if (plus_format) + { + pr_plus_format (os, val); + } + else + { + if (free_format) + os << typename octave_print_conv >::print_conv_type (val); + else + pr_int (os, val); + } +} + +#define PRINT_INT_SCALAR_INTERNAL(TYPE) \ + OCTINTERP_API void \ + octave_print_internal (std::ostream& os, const octave_int& val, bool dummy) \ + { \ + octave_print_internal_template (os, val, dummy); \ + } + +PRINT_INT_SCALAR_INTERNAL (int8_t) +PRINT_INT_SCALAR_INTERNAL (uint8_t) +PRINT_INT_SCALAR_INTERNAL (int16_t) +PRINT_INT_SCALAR_INTERNAL (uint16_t) +PRINT_INT_SCALAR_INTERNAL (int32_t) +PRINT_INT_SCALAR_INTERNAL (uint32_t) +PRINT_INT_SCALAR_INTERNAL (int64_t) +PRINT_INT_SCALAR_INTERNAL (uint64_t) + +template +/* static */ inline void +octave_print_internal_template (std::ostream& os, const intNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + // FIXME -- this mostly duplicates the code in the print_nd_array<> + // function. Can fix this with std::is_same from C++11. + + if (nda.is_empty ()) + print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); + else if (nda.length () == 1) + octave_print_internal_template (os, nda(0), pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + int ndims = nda.ndims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + dim_vector dims = nda.dims (); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + for (octave_idx_type i = 0; i < m; i++) + { + if (m > 1) + { + std::string nm = "ans(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + Array page (nda.index (idx), dim_vector (nr, nc)); + + for (octave_idx_type ii = 0; ii < nr; ii++) + { + for (octave_idx_type jj = 0; jj < nc; jj++) + { + octave_quit (); + + pr_plus_format (os, page(ii,jj)); + } + + if ((ii < nr - 1) || (i < m -1)) + os << "\n"; + } + + if (i < m - 1) + { + os << "\n"; + increment_index (ra_idx, dims, 2); + } + } + } + else + { + int ndims = nda.ndims (); + + dim_vector dims = nda.dims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + int fw = 0; + if (hex_format) + fw = 2 * nda(0).byte_size (); + else if (bit_format) + fw = nda(0).nbits (); + else + { + bool isneg = false; + int digits = 0; + + for (octave_idx_type i = 0; i < dims.numel (); i++) + { + int new_digits = static_cast + (gnulib::floor (log10 (double (abs (nda(i).value ()))) + 1.0)); + + if (new_digits > digits) + digits = new_digits; + + if (! isneg) + isneg = (abs (nda(i).value ()) != nda(i).value ()); + } + + fw = digits + isneg; + } + + int column_width = fw + (rat_format ? 0 : (bank_format ? 5 : 2)); + octave_idx_type total_width = nc * column_width; + int max_width = command_editor::terminal_cols () - extra_indent; + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + for (octave_idx_type i = 0; i < m; i++) + { + if (m > 1) + { + std::string nm = "ans(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + Array page (nda.index (idx), dim_vector (nr, nc)); + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + for (octave_idx_type ii = 0; ii < nr; ii++) + { + for (octave_idx_type jj = 0; jj < nc; jj++) + { + octave_quit (); + os << " "; + os << typename octave_print_conv::print_conv_type (page(ii,jj)); + } + os << "\n"; + } + + if (pr_as_read_syntax) + os << "]"; + } + else + { + octave_idx_type n_rows = page.rows (); + octave_idx_type n_cols = page.cols (); + + for (octave_idx_type col = 0; col < n_cols; col += inc) + { + octave_idx_type lim = col + inc < n_cols ? col + inc : n_cols; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type ii = 0; ii < n_rows; ii++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type jj = col; jj < lim; jj++) + { + octave_quit (); + os << " "; + pr_int (os, page(ii,jj), fw); + } + if ((ii < n_rows - 1) || (i < m -1)) + os << "\n"; + } + } + } + + if (i < m - 1) + { + os << "\n"; + increment_index (ra_idx, dims, 2); + } + } + } +} + +#define PRINT_INT_ARRAY_INTERNAL(TYPE) \ + OCTINTERP_API void \ + octave_print_internal (std::ostream& os, const intNDArray& nda, \ + bool pr_as_read_syntax, int extra_indent) \ + { \ + octave_print_internal_template (os, nda, pr_as_read_syntax, extra_indent); \ + } + +PRINT_INT_ARRAY_INTERNAL (octave_int8) +PRINT_INT_ARRAY_INTERNAL (octave_uint8) +PRINT_INT_ARRAY_INTERNAL (octave_int16) +PRINT_INT_ARRAY_INTERNAL (octave_uint16) +PRINT_INT_ARRAY_INTERNAL (octave_int32) +PRINT_INT_ARRAY_INTERNAL (octave_uint32) +PRINT_INT_ARRAY_INTERNAL (octave_int64) +PRINT_INT_ARRAY_INTERNAL (octave_uint64) + +void +octave_print_internal (std::ostream&, const Cell&, bool, int, bool) +{ + panic_impossible (); +} + +DEFUN (rats, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rats (@var{x}, @var{len})\n\ +Convert @var{x} into a rational approximation represented as a string.\n\ +You can convert the string back into a matrix as follows:\n\ +\n\ +@example\n\ +@group\n\ +r = rats (hilb (4));\n\ +x = str2num (r)\n\ +@end group\n\ +@end example\n\ +\n\ +The optional second argument defines the maximum length of the string\n\ +representing the elements of @var{x}. By default @var{len} is 9.\n\ +@seealso{format, rat}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 2 || nargout > 1) + print_usage (); + else + { + unwind_protect frame; + + frame.protect_var (rat_string_len); + + rat_string_len = 9; + + if (nargin == 2) + rat_string_len = args(1).nint_value (); + + if (! error_state) + { + octave_value arg = args(0); + + if (arg.is_numeric_type ()) + { + frame.protect_var (rat_format); + + rat_format = true; + + std::ostringstream buf; + args(0).print (buf); + std::string s = buf.str (); + + std::list lst; + + size_t n = 0; + size_t s_len = s.length (); + + while (n < s_len) + { + size_t m = s.find ('\n', n); + + if (m == std::string::npos) + { + lst.push_back (s.substr (n)); + break; + } + else + { + lst.push_back (s.substr (n, m - n)); + n = m + 1; + } + } + + retval = string_vector (lst); + } + else + error ("rats: X must be numeric"); + } + } + + return retval; +} + +DEFUN (disp, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} disp (@var{x})\n\ +Display the value of @var{x}. For example:\n\ +\n\ +@example\n\ +@group\n\ +disp (\"The value of pi is:\"), disp (pi)\n\ +\n\ + @print{} the value of pi is:\n\ + @print{} 3.1416\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Note that the output from @code{disp} always ends with a newline.\n\ +\n\ +If an output value is requested, @code{disp} prints nothing and\n\ +returns the formatted output in a string.\n\ +@seealso{fdisp}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 && nargout < 2) + { + if (nargout == 0) + args(0).print (octave_stdout); + else + { + octave_value arg = args(0); + std::ostringstream buf; + arg.print (buf); + retval = octave_value (buf.str (), arg.is_dq_string () ? '"' : '\''); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fdisp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fdisp (@var{fid}, @var{x})\n\ +Display the value of @var{x} on the stream @var{fid}. For example:\n\ +\n\ +@example\n\ +@group\n\ +fdisp (stdout, \"The value of pi is:\"), fdisp (stdout, pi)\n\ +\n\ + @print{} the value of pi is:\n\ + @print{} 3.1416\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Note that the output from @code{fdisp} always ends with a newline.\n\ +@seealso{disp}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 2) + { + int fid = octave_stream_list::get_file_number (args (0)); + + octave_stream os = octave_stream_list::lookup (fid, "fdisp"); + + if (! error_state) + { + std::ostream *osp = os.output_stream (); + + if (osp) + args(1).print (*osp); + else + error ("fdisp: stream FID not open for writing"); + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! format short +%! fd = tmpfile (); +%! for r = [0, Inf -Inf, NaN] +%! for i = [0, Inf -Inf, NaN] +%! fdisp (fd, complex (r, i)); +%! endfor +%! endfor +%! fclose (fd); + +%!test +%! foo.real = pi * ones (3,20,3); +%! foo.complex = pi * ones (3,20,3) + 1i; +%! foo.char = repmat ("- Hello World -", [3, 20]); +%! foo.cell = {foo.real, foo.complex, foo.char}; +%! fields = fieldnames (foo); +%! for f = 1:numel (fields) +%! format loose; +%! loose = disp (foo.(fields{f})); +%! format compact; +%! compact = disp (foo.(fields{f})); +%! expected = strrep (loose, "\n\n", "\n"); +%! assert (expected, compact); +%! endfor +*/ + +static void +init_format_state (void) +{ + free_format = false; + plus_format = false; + rat_format = false; + bank_format = false; + hex_format = 0; + bit_format = 0; + Vcompact_format = false; + print_e = false; + print_big_e = false; + print_g = false; + print_eng = false; +} + +static void +set_output_prec_and_fw (int prec, int fw) +{ + Voutput_precision = prec; + Voutput_max_field_width = fw; +} + +static void +set_format_style (int argc, const string_vector& argv) +{ + int idx = 1; + + if (--argc > 0) + { + std::string arg = argv[idx++]; + + if (arg == "short") + { + if (--argc > 0) + { + arg = argv[idx++]; + + if (arg == "e") + { + init_format_state (); + print_e = true; + } + else if (arg == "E") + { + init_format_state (); + print_e = true; + print_big_e = true; + } + else if (arg == "g") + { + init_format_state (); + print_g = true; + } + else if (arg == "G") + { + init_format_state (); + print_g = true; + print_big_e = true; + } + else if (arg == "eng") + { + init_format_state (); + print_eng = true; + } + else + { + error ("format: unrecognized option `short %s'", + arg.c_str ()); + return; + } + } + else + init_format_state (); + + set_output_prec_and_fw (5, 10); + } + else if (arg == "long") + { + if (--argc > 0) + { + arg = argv[idx++]; + + if (arg == "e") + { + init_format_state (); + print_e = true; + } + else if (arg == "E") + { + init_format_state (); + print_e = true; + print_big_e = true; + } + else if (arg == "g") + { + init_format_state (); + print_g = true; + } + else if (arg == "G") + { + init_format_state (); + print_g = true; + print_big_e = true; + } + else if (arg == "eng") + { + init_format_state (); + print_eng = true; + } + else + { + error ("format: unrecognized option `long %s'", + arg.c_str ()); + return; + } + } + else + init_format_state (); + + set_output_prec_and_fw (15, 20); + } + else if (arg == "hex") + { + init_format_state (); + hex_format = 1; + } + else if (arg == "native-hex") + { + init_format_state (); + hex_format = 2; + } + else if (arg == "bit") + { + init_format_state (); + bit_format = 1; + } + else if (arg == "native-bit") + { + init_format_state (); + bit_format = 2; + } + else if (arg == "+" || arg == "plus") + { + if (--argc > 0) + { + arg = argv[idx++]; + + if (arg.length () == 3) + plus_format_chars = arg; + else + { + error ("format: invalid option for plus format"); + return; + } + } + else + plus_format_chars = "+ "; + + init_format_state (); + plus_format = true; + } + else if (arg == "rat") + { + init_format_state (); + rat_format = true; + } + else if (arg == "bank") + { + init_format_state (); + bank_format = true; + } + else if (arg == "free") + { + init_format_state (); + free_format = true; + } + else if (arg == "none") + { + init_format_state (); + free_format = true; + } + else if (arg == "compact") + { + Vcompact_format = true; + } + else if (arg == "loose") + { + Vcompact_format = false; + } + else + error ("format: unrecognized format state `%s'", arg.c_str ()); + } + else + { + init_format_state (); + set_output_prec_and_fw (5, 10); + } +} + +DEFUN (format, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} format\n\ +@deftypefnx {Command} {} format options\n\ +Reset or specify the format of the output produced by @code{disp} and\n\ +Octave's normal echoing mechanism. This command only affects the display\n\ +of numbers but not how they are stored or computed. To change the internal\n\ +representation from the default double use one of the conversion functions\n\ +such as @code{single}, @code{uint8}, @code{int64}, etc.\n\ +\n\ +By default, Octave displays 5 significant digits in a human readable form\n\ +(option @samp{short} paired with @samp{loose} format for matrices).\n\ +If @code{format} is invoked without any options, this default format\n\ +is restored.\n\ +\n\ +Valid formats for floating point numbers are listed in the following\n\ +table.\n\ +\n\ +@table @code\n\ +@item short\n\ +Fixed point format with 5 significant figures in a field that is a maximum\n\ +of 10 characters wide. (default).\n\ +\n\ +If Octave is unable to format a matrix so that columns line up on the\n\ +decimal point and all numbers fit within the maximum field width then\n\ +it switches to an exponential @samp{e} format.\n\ +\n\ +@item long\n\ +Fixed point format with 15 significant figures in a field that is a maximum\n\ +of 20 characters wide.\n\ +\n\ +As with the @samp{short} format, Octave will switch to an exponential\n\ +@samp{e} format if it is unable to format a matrix properly using the\n\ +current format.\n\ +\n\ +@item short e\n\ +@itemx long e\n\ +Exponential format. The number to be represented is split between a mantissa\n\ +and an exponent (power of 10). The mantissa has 5 significant digits in the\n\ +short format and 15 digits in the long format.\n\ +For example, with the @samp{short e} format, @code{pi} is displayed as\n\ +@code{3.1416e+00}.\n\ +\n\ +@item short E\n\ +@itemx long E\n\ +Identical to @samp{short e} or @samp{long e} but displays an uppercase\n\ +@samp{E} to indicate the exponent.\n\ +For example, with the @samp{long E} format, @code{pi} is displayed as\n\ +@code{3.14159265358979E+00}.\n\ +\n\ +@item short g\n\ +@itemx long g\n\ +Optimally choose between fixed point and exponential format based on\n\ +the magnitude of the number.\n\ +For example, with the @samp{short g} format,\n\ +@code{pi .^ [2; 4; 8; 16; 32]} is displayed as\n\ +\n\ +@example\n\ +@group\n\ +ans =\n\ +\n\ + 9.8696\n\ + 97.409\n\ + 9488.5\n\ + 9.0032e+07\n\ + 8.1058e+15\n\ +@end group\n\ +@end example\n\ +\n\ +@item short eng\n\ +@itemx long eng\n\ +Identical to @samp{short e} or @samp{long e} but displays the value\n\ +using an engineering format, where the exponent is divisible by 3. For\n\ +example, with the @samp{short eng} format, @code{10 * pi} is displayed as\n\ +@code{31.4159e+00}.\n\ +\n\ +@item long G\n\ +@itemx short G\n\ +Identical to @samp{short g} or @samp{long g} but displays an uppercase\n\ +@samp{E} to indicate the exponent.\n\ +\n\ +@item free\n\ +@itemx none\n\ +Print output in free format, without trying to line up columns of\n\ +matrices on the decimal point. This also causes complex numbers to be\n\ +formatted as numeric pairs like this @samp{(0.60419, 0.60709)} instead\n\ +of like this @samp{0.60419 + 0.60709i}.\n\ +@end table\n\ +\n\ +The following formats affect all numeric output (floating point and\n\ +integer types).\n\ +\n\ +@table @code\n\ +@item +\n\ +@itemx + @var{chars}\n\ +@itemx plus\n\ +@itemx plus @var{chars}\n\ +Print a @samp{+} symbol for nonzero matrix elements and a space for zero\n\ +matrix elements. This format can be very useful for examining the\n\ +structure of a large sparse matrix.\n\ +\n\ +The optional argument @var{chars} specifies a list of 3 characters to use\n\ +for printing values greater than zero, less than zero and equal to zero.\n\ +For example, with the @samp{+ \"+-.\"} format, @code{[1, 0, -1; -1, 0, 1]}\n\ +is displayed as\n\ +\n\ +@example\n\ +@group\n\ +ans =\n\ +\n\ ++.-\n\ +-.+\n\ +@end group\n\ +@end example\n\ +\n\ +@item bank\n\ +Print in a fixed format with two digits to the right of the decimal\n\ +point.\n\ +\n\ +@item native-hex\n\ +Print the hexadecimal representation of numbers as they are stored in\n\ +memory. For example, on a workstation which stores 8 byte real values\n\ +in IEEE format with the least significant byte first, the value of\n\ +@code{pi} when printed in @code{native-hex} format is\n\ +@code{400921fb54442d18}.\n\ +\n\ +@item hex\n\ +The same as @code{native-hex}, but always print the most significant\n\ +byte first.\n\ +\n\ +@item native-bit\n\ +Print the bit representation of numbers as stored in memory.\n\ +For example, the value of @code{pi} is\n\ +\n\ +@example\n\ +@group\n\ +01000000000010010010000111111011\n\ +01010100010001000010110100011000\n\ +@end group\n\ +@end example\n\ +\n\ +(shown here in two 32 bit sections for typesetting purposes) when\n\ +printed in native-bit format on a workstation which stores 8 byte real values\n\ +in IEEE format with the least significant byte first.\n\ +\n\ +@item bit\n\ +The same as @code{native-bit}, but always print the most significant\n\ +bits first.\n\ +\n\ +@item rat\n\ +Print a rational approximation, i.e., values are approximated\n\ +as the ratio of small integers.\n\ +For example, with the @samp{rat} format,\n\ +@code{pi} is displayed as @code{355/113}.\n\ +@end table\n\ +\n\ +The following two options affect the display of all matrices.\n\ +\n\ +@table @code\n\ +@item compact\n\ +Remove blank lines around column number labels and between\n\ +matrices producing more compact output with more data per page.\n\ +\n\ +@item loose\n\ +Insert blank lines above and below column number labels and between matrices\n\ +to produce a more readable output with less data per page. (default).\n\ +@end table\n\ +@seealso{fixed_point_format, output_max_field_width, output_precision, split_long_rows, rats}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("format"); + + if (error_state) + return retval; + + set_format_style (argc, argv); + + return retval; +} + +DEFUN (fixed_point_format, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} fixed_point_format ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} fixed_point_format (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} fixed_point_format (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will\n\ +use a scaled format to print matrix values such that the largest\n\ +element may be written with a single leading digit with the scaling\n\ +factor is printed on the first line of output. For example:\n\ +\n\ +@example\n\ +@group\n\ +octave:1> logspace (1, 7, 5)'\n\ +ans =\n\ +\n\ + 1.0e+07 *\n\ +\n\ + 0.00000\n\ + 0.00003\n\ + 0.00100\n\ + 0.03162\n\ + 1.00000\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Notice that first value appears to be zero when it is actually 1. For\n\ +this reason, you should be careful when setting\n\ +@code{fixed_point_format} to a nonzero value.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format, output_max_field_width, output_precision}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (fixed_point_format); +} + +DEFUN (print_empty_dimensions, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} print_empty_dimensions ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} print_empty_dimensions (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} print_empty_dimensions (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether the\n\ +dimensions of empty matrices are printed along with the empty matrix\n\ +symbol, @samp{[]}. For example, the expression\n\ +\n\ +@example\n\ +zeros (3, 0)\n\ +@end example\n\ +\n\ +@noindent\n\ +will print\n\ +\n\ +@example\n\ +ans = [](3x0)\n\ +@end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (print_empty_dimensions); +} + +DEFUN (split_long_rows, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} split_long_rows ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} split_long_rows (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} split_long_rows (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether rows of a matrix\n\ +may be split when displayed to a terminal window. If the rows are split,\n\ +Octave will display the matrix in a series of smaller pieces, each of\n\ +which can fit within the limits of your terminal width and each set of\n\ +rows is labeled so that you can easily see which columns are currently\n\ +being displayed. For example:\n\ +\n\ +@example\n\ +@group\n\ +octave:13> rand (2,10)\n\ +ans =\n\ +\n\ + Columns 1 through 6:\n\ +\n\ + 0.75883 0.93290 0.40064 0.43818 0.94958 0.16467\n\ + 0.75697 0.51942 0.40031 0.61784 0.92309 0.40201\n\ +\n\ + Columns 7 through 10:\n\ +\n\ + 0.90174 0.11854 0.72313 0.73326\n\ + 0.44672 0.94303 0.56564 0.82150\n\ +@end group\n\ +@end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (split_long_rows); +} + +DEFUN (output_max_field_width, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} output_max_field_width ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} output_max_field_width (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} output_max_field_width (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the maximum width\n\ +of a numeric output field.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format, fixed_point_format, output_precision}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_max_field_width, 0, INT_MAX); +} + +DEFUN (output_precision, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} output_precision ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} output_precision (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} output_precision (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the minimum number of\n\ +significant figures to display for numeric output.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format, fixed_point_format, output_max_field_width}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_precision, -1, INT_MAX); +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/pr-output.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/pr-output.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,262 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_pr_output_h) +#define octave_pr_output_h 1 + +#include + +#include "oct-cmplx.h" + +template class Array; +class ComplexMatrix; +class FloatComplexMatrix; +class ComplexDiagMatrix; +class FloatComplexDiagMatrix; +class ComplexNDArray; +class FloatComplexNDArray; +class Matrix; +class FloatMatrix; +class DiagMatrix; +class FloatDiagMatrix; +class NDArray; +class FloatNDArray; +class Range; +class boolMatrix; +class boolNDArray; +class charMatrix; +class charNDArray; +class PermMatrix; +class Cell; + +#include "intNDArray.h" +#include "oct-inttypes.h" + + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, bool d, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, double d, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, float d, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Matrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const DiagMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const NDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Complex& c, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplex& c, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const ComplexMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const ComplexNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const PermMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Range& r, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const boolMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const boolNDArray& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const charMatrix& chm, + bool pr_as_read_syntax = false, + int extra_indent = 0, + bool pr_as_string = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const charNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0, + bool pr_as_string = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const std::string& s, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Array& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Cell& cell, + bool pr_as_read_syntax = false, + int extra_indent = 0, + bool pr_as_string = false); + +// TRUE means that the dimensions of empty objects should be printed +// like this: x = [](2x0). +extern bool Vprint_empty_dimensions; + +// TRUE means don't put empty lines in output +extern bool Vcompact_format; + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/profiler.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/profiler.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,470 @@ +/* + +Copyright (C) 2012 Daniel Kraft + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "defun.h" +#include "oct-time.h" +#include "ov-struct.h" +#include "pager.h" +#include "profiler.h" + +profile_data_accumulator::enter::enter (profile_data_accumulator& a, + const std::string& f) + : acc (a) +{ + if (acc.is_active ()) + { + fcn = f; + acc.enter_function (fcn); + } + else + fcn = ""; +} + +profile_data_accumulator::enter::~enter () +{ + if (fcn != "") + acc.exit_function (fcn); +} + +profile_data_accumulator::stats::stats () + : time (0.0), calls (0), recursive (false), + parents (), children () +{} + +octave_value +profile_data_accumulator::stats::function_set_value (const function_set& list) +{ + const octave_idx_type n = list.size (); + + RowVector retval (n); + octave_idx_type i = 0; + for (function_set::const_iterator p = list.begin (); p != list.end (); ++p) + { + retval(i) = *p; + ++i; + } + assert (i == n); + + return retval; +} + +profile_data_accumulator::tree_node::tree_node (tree_node* p, octave_idx_type f) + : parent (p), fcn_id (f), children (), time (0.0), calls (0) +{} + +profile_data_accumulator::tree_node::~tree_node () +{ + for (child_map::iterator i = children.begin (); i != children.end (); ++i) + delete i->second; +} + +profile_data_accumulator::tree_node* +profile_data_accumulator::tree_node::enter (octave_idx_type fcn) +{ + tree_node* retval; + + child_map::iterator pos = children.find (fcn); + if (pos == children.end ()) + { + retval = new tree_node (this, fcn); + children[fcn] = retval; + } + else + retval = pos->second; + + ++retval->calls; + return retval; +} + +profile_data_accumulator::tree_node* +profile_data_accumulator::tree_node::exit (octave_idx_type fcn) +{ + assert (parent); + assert (fcn_id == fcn); + + return parent; +} + +void +profile_data_accumulator::tree_node::build_flat (flat_profile& data) const +{ + // If this is not the top-level node, update profile entry for this function. + if (fcn_id != 0) + { + stats& entry = data[fcn_id - 1]; + + entry.time += time; + entry.calls += calls; + + assert (parent); + if (parent->fcn_id != 0) + { + entry.parents.insert (parent->fcn_id); + data[parent->fcn_id - 1].children.insert (fcn_id); + } + + if (!entry.recursive) + for (const tree_node* i = parent; i; i = i->parent) + if (i->fcn_id == fcn_id) + { + entry.recursive = true; + break; + } + } + + // Recurse on children. + for (child_map::const_iterator i = children.begin (); + i != children.end (); ++i) + i->second->build_flat (data); +} + +octave_value +profile_data_accumulator::tree_node::get_hierarchical (double* total) const +{ + /* Note that we don't generate the entry just for this node, but rather + a struct-array with entries for all children. This way, the top-node + (for which we don't want a real entry) generates already the final + hierarchical profile data. */ + + const octave_idx_type n = children.size (); + + Cell rv_indices (n, 1); + Cell rv_times (n, 1); + Cell rv_totals (n, 1); + Cell rv_calls (n, 1); + Cell rv_children (n, 1); + + octave_idx_type i = 0; + for (child_map::const_iterator p = children.begin (); + p != children.end (); ++p) + { + const tree_node& entry = *p->second; + double child_total = entry.time; + + rv_indices(i) = octave_value (p->first); + rv_times(i) = octave_value (entry.time); + rv_calls(i) = octave_value (entry.calls); + rv_children(i) = entry.get_hierarchical (&child_total); + rv_totals(i) = octave_value (child_total); + + if (total) + *total += child_total; + + ++i; + } + assert (i == n); + + octave_map retval; + + retval.assign ("Index", rv_indices); + retval.assign ("SelfTime", rv_times); + retval.assign ("TotalTime", rv_totals); + retval.assign ("NumCalls", rv_calls); + retval.assign ("Children", rv_children); + + return retval; +} + +profile_data_accumulator::profile_data_accumulator () + : known_functions (), fcn_index (), + enabled (false), call_tree (NULL), last_time (-1.0) +{} + +profile_data_accumulator::~profile_data_accumulator () +{ + if (call_tree) + delete call_tree; +} + +void +profile_data_accumulator::set_active (bool value) +{ + if (value) + { + // Create a call-tree top-node if there isn't yet one. + if (!call_tree) + call_tree = new tree_node (NULL, 0); + + // Let the top-node be the active one. This ensures we have a clean + // fresh start collecting times. + active_fcn = call_tree; + } + else + { + // Make sure we start with fresh timing if we're re-enabled later. + last_time = -1.0; + } + + enabled = value; +} + +void +profile_data_accumulator::enter_function (const std::string& fcn) +{ + // The enter class will check and only call us if the profiler is active. + assert (is_active ()); + assert (call_tree); + + // If there is already an active function, add to its time before + // pushing the new one. + if (active_fcn != call_tree) + add_current_time (); + + // Map the function's name to its index. + octave_idx_type fcn_idx; + fcn_index_map::iterator pos = fcn_index.find (fcn); + if (pos == fcn_index.end ()) + { + known_functions.push_back (fcn); + fcn_idx = known_functions.size (); + fcn_index[fcn] = fcn_idx; + } + else + fcn_idx = pos->second; + + active_fcn = active_fcn->enter (fcn_idx); + last_time = query_time (); +} + +void +profile_data_accumulator::exit_function (const std::string& fcn) +{ + assert (call_tree); + assert (active_fcn != call_tree); + + // Usually, if we are disabled this function is not even called. But the + // call disabling the profiler is an exception. So also check here + // and only record the time if enabled. + if (is_active ()) + add_current_time (); + + fcn_index_map::iterator pos = fcn_index.find (fcn); + assert (pos != fcn_index.end ()); + active_fcn = active_fcn->exit (pos->second); + + // If this was an "inner call", we resume executing the parent function + // up the stack. So note the start-time for this! + last_time = query_time (); +} + +void +profile_data_accumulator::reset (void) +{ + if (is_active ()) + { + error ("Can't reset active profiler."); + return; + } + + known_functions.clear (); + fcn_index.clear (); + + if (call_tree) + { + delete call_tree; + call_tree = NULL; + } + + last_time = -1.0; +} + +octave_value +profile_data_accumulator::get_flat (void) const +{ + octave_value retval; + + const octave_idx_type n = known_functions.size (); + + flat_profile flat (n); + + if (call_tree) + { + call_tree->build_flat (flat); + + Cell rv_names (n, 1); + Cell rv_times (n, 1); + Cell rv_calls (n, 1); + Cell rv_recursive (n, 1); + Cell rv_parents (n, 1); + Cell rv_children (n, 1); + + for (octave_idx_type i = 0; i != n; ++i) + { + rv_names(i) = octave_value (known_functions[i]); + rv_times(i) = octave_value (flat[i].time); + rv_calls(i) = octave_value (flat[i].calls); + rv_recursive(i) = octave_value (flat[i].recursive); + rv_parents(i) = stats::function_set_value (flat[i].parents); + rv_children(i) = stats::function_set_value (flat[i].children); + } + + octave_map m; + + m.assign ("FunctionName", rv_names); + m.assign ("TotalTime", rv_times); + m.assign ("NumCalls", rv_calls); + m.assign ("IsRecursive", rv_recursive); + m.assign ("Parents", rv_parents); + m.assign ("Children", rv_children); + + retval = m; + } + else + { + static const char *fn[] = + { + "FunctionName", + "TotalTime", + "NumCalls", + "IsRecursive", + "Parents", + "Children", + 0 + }; + + static octave_map m (dim_vector (0, 1), string_vector (fn)); + + retval = m; + } + + return retval; +} + +octave_value +profile_data_accumulator::get_hierarchical (void) const +{ + octave_value retval; + + if (call_tree) + retval = call_tree->get_hierarchical (); + else + { + static const char *fn[] = + { + "Index", + "SelfTime", + "NumCalls", + "Children", + 0 + }; + + static octave_map m (dim_vector (0, 1), string_vector (fn)); + + retval = m; + } + + return retval; +} + +double +profile_data_accumulator::query_time (void) const +{ + octave_time now; + + // FIXME -- is this volatile declaration really needed? + // See bug #34210 for additional details. + volatile double dnow = now.double_value (); + + return dnow; +} + +void +profile_data_accumulator::add_current_time (void) +{ + const double t = query_time (); + assert (last_time >= 0.0 && last_time <= t); + + assert (call_tree && active_fcn != call_tree); + active_fcn->add_time (t - last_time); +} + +profile_data_accumulator profiler; + +// Enable or disable the profiler data collection. +DEFUN (__profiler_enable__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_enable ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + const int nargin = args.length (); + if (nargin > 0) + { + if (nargin > 1) + { + print_usage (); + return retval; + } + + profiler.set_active (args(0).bool_value ()); + } + + retval(0) = profiler.is_active (); + + return retval; +} + +// Clear all collected profiling data. +DEFUN (__profiler_reset__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_reset ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + const int nargin = args.length (); + + if (nargin > 0) + warning ("profiler_reset: ignoring extra arguments"); + + profiler.reset (); + + return retval; +} + +// Query the timings collected by the profiler. +DEFUN (__profiler_data__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_data ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + const int nargin = args.length (); + + if (nargin > 0) + warning ("profiler_data: ignoring extra arguments"); + + retval(0) = profiler.get_flat (); + if (nargout > 1) + retval(1) = profiler.get_hierarchical (); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/profiler.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/profiler.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,190 @@ +/* + +Copyright (C) 2012 Daniel Kraft + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_profiler_h) +#define octave_profiler_h 1 + +#include +#include +#include +#include +#include + +class octave_value; + +class +OCTINTERP_API +profile_data_accumulator +{ +public: + + // This is a utility class that can be used to call the enter/exit + // functions in a manner protected from stack unwinding. + class enter + { + private: + + profile_data_accumulator& acc; + std::string fcn; + + public: + + enter (profile_data_accumulator&, const std::string&); + virtual ~enter (void); + + private: + + // No copying! + enter (const enter&); + enter& operator = (const enter&); + }; + + profile_data_accumulator (void); + virtual ~profile_data_accumulator (); + + bool is_active (void) const { return enabled; } + void set_active (bool); + + void reset (void); + + octave_value get_flat (void) const; + octave_value get_hierarchical (void) const; + +private: + + // One entry in the flat profile (i.e., a collection of data for a single + // function). This is filled in when building the flat profile from the + // hierarchical call tree. + struct stats + { + stats (); + + double time; + unsigned calls; + + bool recursive; + + typedef std::set function_set; + function_set parents; + function_set children; + + // Convert a function_set list to an Octave array of indices. + static octave_value function_set_value (const function_set&); + }; + + typedef std::vector flat_profile; + + // Store data for one node in the call-tree of the hierarchical profiler + // data we collect. + class tree_node + { + public: + + tree_node (tree_node*, octave_idx_type); + virtual ~tree_node (); + + void add_time (double dt) { time += dt; } + + // Enter a child function. It is created in the list of children if it + // wasn't already there. The now-active child node is returned. + tree_node* enter (octave_idx_type); + + // Exit function. As a sanity-check, it is verified that the currently + // active function actually is the one handed in here. Returned is the + // then-active node, which is our parent. + tree_node* exit (octave_idx_type); + + void build_flat (flat_profile&) const; + + // Get the hierarchical profile for this node and its children. If total + // is set, accumulate total time of the subtree in that variable as + // additional return value. + octave_value get_hierarchical (double* total = NULL) const; + + private: + + tree_node* parent; + octave_idx_type fcn_id; + + typedef std::map child_map; + child_map children; + + // This is only time spent *directly* on this level, excluding children! + double time; + + unsigned calls; + + // No copying! + tree_node (const tree_node&); + tree_node& operator = (const tree_node&); + }; + + // Each function we see in the profiler is given a unique index (which + // simply counts starting from 1). We thus have to map profiler-names to + // those indices. For all other stuff, we identify functions by their index. + + typedef std::vector function_set; + typedef std::map fcn_index_map; + + function_set known_functions; + fcn_index_map fcn_index; + + bool enabled; + + tree_node* call_tree; + tree_node* active_fcn; + + // Store last timestamp we had, when the currently active function was called. + double last_time; + + // These are private as only the unwind-protecting inner class enter + // should be allowed to call them. + void enter_function (const std::string&); + void exit_function (const std::string&); + + // Query a timestamp, used for timing calls (obviously). + // This is not static because in the future, maybe we want a flag + // in the profiler or something to choose between cputime, wall-time, + // user-time, system-time, ... + double query_time () const; + + // Add the time elapsed since last_time to the function we're currently in. + // This is called from two different positions, thus it is useful to have + // it as a seperate function. + void add_current_time (void); + + // No copying! + profile_data_accumulator (const profile_data_accumulator&); + profile_data_accumulator& operator = (const profile_data_accumulator&); +}; + +// The instance used. +extern OCTINTERP_API profile_data_accumulator profiler; + +// Helper macro to profile a block of code. +#define BEGIN_PROFILER_BLOCK(name) \ + { \ + profile_data_accumulator::enter pe (profiler, (name)); +#define END_PROFILER_BLOCK \ + } + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/sighandlers.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/sighandlers.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1054 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "oct-syscalls.h" +#include "quit.h" +#include "singleton-cleanup.h" + +#include "debug.h" +#include "defun.h" +#include "error.h" +#include "input.h" +#include "load-save.h" +#include "oct-map.h" +#include "pager.h" +#include "pt-bp.h" +#include "pt-eval.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "syswait.h" +#include "toplev.h" +#include "utils.h" +#include "variables.h" + +// Nonzero means we have already printed a message for this series of +// SIGPIPES. We assume that the writer will eventually give up. +int pipe_handler_error_count = 0; + +// TRUE means we can be interrupted. +bool can_interrupt = false; + +// TRUE means we should try to enter the debugger on SIGINT. +static bool Vdebug_on_interrupt = false; + +// Allow users to avoid writing octave-workspace for SIGHUP (sent by +// closing gnome-terminal, for example). Note that this variable has +// no effect if Vcrash_dumps_octave_core is FALSE. +static bool Vsighup_dumps_octave_core = true; + +// Similar to Vsighup_dumps_octave_core, but for SIGTERM signal. +static bool Vsigterm_dumps_octave_core = true; + +// List of signals we have caught since last call to octave_signal_handler. +static bool octave_signals_caught[NSIG]; + +// Signal handler return type. +#ifndef BADSIG +#define BADSIG (void (*)(int))-1 +#endif + +// The following is a workaround for an apparent bug in GCC 4.1.2 and +// possibly earlier versions. See Octave bug report #30685 for details. +#if defined (__GNUC__) +# if ! (__GNUC__ > 4 \ + || (__GNUC__ == 4 && (__GNUC_MINOR__ > 1 \ + || (__GNUC_MINOR__ == 1 && __GNUC_PATCHLEVEL__ > 2)))) +# undef GNULIB_NAMESPACE +# define GNULIB_NAMESPACE +# warning "disabling GNULIB_NAMESPACE for signal functions -- consider upgrading to a current version of GCC" +# endif +#endif + +#define BLOCK_SIGNAL(sig, nvar, ovar) \ + do \ + { \ + GNULIB_NAMESPACE::sigemptyset (&nvar); \ + GNULIB_NAMESPACE::sigaddset (&nvar, sig); \ + GNULIB_NAMESPACE::sigemptyset (&ovar); \ + GNULIB_NAMESPACE::sigprocmask (SIG_BLOCK, &nvar, &ovar); \ + } \ + while (0) + +#if !defined (SIGCHLD) && defined (SIGCLD) +#define SIGCHLD SIGCLD +#endif + +#define BLOCK_CHILD(nvar, ovar) BLOCK_SIGNAL (SIGCHLD, nvar, ovar) +#define UNBLOCK_CHILD(ovar) GNULIB_NAMESPACE::sigprocmask (SIG_SETMASK, &ovar, 0) + +// Called from octave_quit () to actually do something about the signals +// we have caught. + +void +octave_signal_handler (void) +{ + // The list of signals is relatively short, so we will just go + // linearly through the list. + + for (int i = 0; i < NSIG; i++) + { + if (octave_signals_caught[i]) + { + octave_signals_caught[i] = false; + + switch (i) + { +#ifdef SIGCHLD + case SIGCHLD: + { + volatile octave_interrupt_handler saved_interrupt_handler + = octave_ignore_interrupts (); + + sigset_t set, oset; + + BLOCK_CHILD (set, oset); + + octave_child_list::wait (); + + octave_set_interrupt_handler (saved_interrupt_handler); + + UNBLOCK_CHILD (oset); + + octave_child_list::reap (); + } + break; +#endif + + case SIGFPE: + std::cerr << "warning: floating point exception" << std::endl; + break; + +#ifdef SIGPIPE + case SIGPIPE: + std::cerr << "warning: broken pipe" << std::endl; + break; +#endif + } + } + } +} + +static void +my_friendly_exit (const char *sig_name, int sig_number, + bool save_vars = true) +{ + static bool been_there_done_that = false; + + if (been_there_done_that) + { +#if defined (SIGABRT) + octave_set_signal_handler (SIGABRT, SIG_DFL); +#endif + + std::cerr << "panic: attempted clean up apparently failed -- aborting...\n"; + + MINGW_SIGNAL_CLEANUP (); + + abort (); + } + else + { + been_there_done_that = true; + + std::cerr << "panic: " << sig_name << " -- stopping myself...\n"; + + if (save_vars) + dump_octave_core (); + + if (sig_number < 0) + { + MINGW_SIGNAL_CLEANUP (); + + exit (1); + } + else + { + octave_set_signal_handler (sig_number, SIG_DFL); + + GNULIB_NAMESPACE::raise (sig_number); + } + } +} + +sig_handler * +octave_set_signal_handler (int sig, sig_handler *handler, + bool restart_syscalls) +{ + struct sigaction act, oact; + + act.sa_handler = handler; + act.sa_flags = 0; + +#if defined (SIGALRM) + if (sig == SIGALRM) + { +#if defined (SA_INTERRUPT) + act.sa_flags |= SA_INTERRUPT; +#endif + } +#endif +#if defined (SA_RESTART) +#if defined (SIGALRM) + else +#endif + // FIXME -- Do we also need to explicitly disable SA_RESTART? + if (restart_syscalls) + act.sa_flags |= SA_RESTART; +#endif + + GNULIB_NAMESPACE::sigemptyset (&act.sa_mask); + GNULIB_NAMESPACE::sigemptyset (&oact.sa_mask); + + GNULIB_NAMESPACE::sigaction (sig, &act, &oact); + + return oact.sa_handler; +} + +static void +generic_sig_handler (int sig) +{ + my_friendly_exit (strsignal (sig), sig); +} + +// Handle SIGCHLD. + +#ifdef SIGCHLD +static void +sigchld_handler (int /* sig */) +{ + octave_signal_caught = 1; + + octave_signals_caught[SIGCHLD] = true; +} +#endif /* defined (SIGCHLD) */ + +#ifdef SIGFPE +#if defined (__alpha__) +static void +sigfpe_handler (int /* sig */) +{ + if (can_interrupt && octave_interrupt_state >= 0) + { + octave_signal_caught = 1; + + octave_signals_caught[SIGFPE] = true; + + octave_interrupt_state++; + } +} +#endif /* defined (__alpha__) */ +#endif /* defined (SIGFPE) */ + +#if defined (SIGHUP) || defined (SIGTERM) +static void +sig_hup_or_term_handler (int sig) +{ + switch (sig) + { +#if defined (SIGHUP) + case SIGHUP: + { + if (Vsighup_dumps_octave_core) + dump_octave_core (); + } + break; +#endif + +#if defined (SIGTERM) + case SIGTERM: + { + if (Vsigterm_dumps_octave_core) + dump_octave_core (); + } + break; +#endif + + default: + break; + } + + clean_up_and_exit (0); +} +#endif + +#if 0 +#if defined (SIGWINCH) +static void +sigwinch_handler (int /* sig */) +{ + command_editor::resize_terminal (); +} +#endif +#endif + +// Handle SIGINT by restarting the parser (see octave.cc). +// +// This also has to work for SIGBREAK (on systems that have it), so we +// use the value of sig, instead of just assuming that it is called +// for SIGINT only. + +static void +user_abort (const char *sig_name, int sig_number) +{ + if (! octave_initialized) + exit (1); + + if (can_interrupt) + { + if (Vdebug_on_interrupt) + { + if (! octave_debug_on_interrupt_state) + { + tree_evaluator::debug_mode = true; + octave_debug_on_interrupt_state = true; + + return; + } + else + { + // Clear the flag and do normal interrupt stuff. + + tree_evaluator::debug_mode + = bp_table::have_breakpoints () || Vdebugging; + octave_debug_on_interrupt_state = false; + } + } + + if (octave_interrupt_immediately) + { + if (octave_interrupt_state == 0) + octave_interrupt_state = 1; + + octave_jump_to_enclosing_context (); + } + else + { + // If we are already cleaning up from a previous interrupt, + // take note of the fact that another interrupt signal has + // arrived. + + if (octave_interrupt_state < 0) + octave_interrupt_state = 0; + + octave_signal_caught = 1; + octave_interrupt_state++; + + if (interactive && octave_interrupt_state == 2) + std::cerr << "Press Control-C again to abort." << std::endl; + + if (octave_interrupt_state >= 3) + my_friendly_exit (sig_name, sig_number, true); + } + } + +} + +static void +sigint_handler (int sig) +{ +#ifdef USE_W32_SIGINT + if (w32_in_main_thread ()) + user_abort (strsignal (sig), sig); + else + w32_raise (sig); +#else + user_abort (strsignal (sig), sig); +#endif +} + +#ifdef SIGPIPE +static void +sigpipe_handler (int /* sig */) +{ + octave_signal_caught = 1; + + octave_signals_caught[SIGPIPE] = true; + + // Don't loop forever on account of this. + + if (pipe_handler_error_count++ > 100 && octave_interrupt_state >= 0) + octave_interrupt_state++; +} +#endif /* defined (SIGPIPE) */ + +#ifdef USE_W32_SIGINT +static BOOL CALLBACK +w32_sigint_handler (DWORD sig) +{ + const char *sig_name; + + switch (sig) + { + case CTRL_BREAK_EVENT: + sig_name = "Ctrl-Break"; + break; + case CTRL_C_EVENT: + sig_name = "Ctrl-C"; + break; + case CTRL_CLOSE_EVENT: + sig_name = "close console"; + break; + case CTRL_LOGOFF_EVENT: + sig_name = "logoff"; + break; + case CTRL_SHUTDOWN_EVENT: + sig_name = "shutdown"; + break; + default: + sig_name = "unknown console event"; + break; + } + + switch (sig) + { + case CTRL_BREAK_EVENT: + case CTRL_C_EVENT: + w32_raise (SIGINT); + break; + + case CTRL_CLOSE_EVENT: + clean_up_and_exit (0); + break; + case CTRL_LOGOFF_EVENT: + case CTRL_SHUTDOWN_EVENT: + default: + // We should do the following: + // clean_up_and_exit (0); + // We can't because we aren't running in the normal Octave thread. + user_abort (sig_name, sig); + break; + } + + // Return TRUE if the event was handled, or FALSE if another handler + // should be called. + // FIXME check that windows terminates the thread. + return TRUE; +} +#endif /* w32_sigint_handler */ + + +octave_interrupt_handler +octave_catch_interrupts (void) +{ + octave_interrupt_handler retval; + +#ifdef SIGINT + retval.int_handler = octave_set_signal_handler (SIGINT, sigint_handler); +#endif + +#ifdef SIGBREAK + retval.brk_handler = octave_set_signal_handler (SIGBREAK, sigint_handler); +#endif + +#ifdef USE_W32_SIGINT + + // Intercept windows console control events. + // Note that the windows console signal handlers chain, so if + // install_signal_handlers is called more than once in the same program, + // then first call the following to avoid duplicates: + // + // SetConsoleCtrlHandler (w32_sigint_handler, FALSE); + + if (! SetConsoleCtrlHandler (w32_sigint_handler, TRUE)) + error ("SetConsoleCtrlHandler failed with %ld\n", GetLastError ()); + + w32_set_quiet_shutdown (); + +#endif + + return retval; +} + +octave_interrupt_handler +octave_ignore_interrupts (void) +{ + octave_interrupt_handler retval; + +#ifdef SIGINT + retval.int_handler = octave_set_signal_handler (SIGINT, SIG_IGN); +#endif + +#ifdef SIGBREAK + retval.brk_handler = octave_set_signal_handler (SIGBREAK, SIG_IGN); +#endif + + return retval; +} + +octave_interrupt_handler +octave_set_interrupt_handler (const volatile octave_interrupt_handler& h, + bool restart_syscalls) +{ + octave_interrupt_handler retval; + +#ifdef SIGINT + retval.int_handler = octave_set_signal_handler (SIGINT, h.int_handler, + restart_syscalls); +#endif + +#ifdef SIGBREAK + retval.brk_handler = octave_set_signal_handler (SIGBREAK, h.brk_handler, + restart_syscalls); +#endif + + return retval; +} + +// Install all the handlers for the signals we might care about. + +void +install_signal_handlers (void) +{ + for (int i = 0; i < NSIG; i++) + octave_signals_caught[i] = false; + + octave_catch_interrupts (); + +#ifdef SIGABRT + octave_set_signal_handler (SIGABRT, generic_sig_handler); +#endif + +#ifdef SIGALRM + octave_set_signal_handler (SIGALRM, generic_sig_handler); +#endif + +#ifdef SIGBUS + octave_set_signal_handler (SIGBUS, generic_sig_handler); +#endif + +#ifdef SIGCHLD + octave_set_signal_handler (SIGCHLD, sigchld_handler); +#endif + + // SIGCLD + // SIGCONT + +#ifdef SIGEMT + octave_set_signal_handler (SIGEMT, generic_sig_handler); +#endif + +#ifdef SIGFPE +#if defined (__alpha__) + octave_set_signal_handler (SIGFPE, sigfpe_handler); +#else + octave_set_signal_handler (SIGFPE, generic_sig_handler); +#endif +#endif + +#ifdef SIGHUP + octave_set_signal_handler (SIGHUP, sig_hup_or_term_handler); +#endif + +#ifdef SIGILL + octave_set_signal_handler (SIGILL, generic_sig_handler); +#endif + + // SIGINFO + // SIGINT + +#ifdef SIGIOT + octave_set_signal_handler (SIGIOT, generic_sig_handler); +#endif + +#ifdef SIGLOST + octave_set_signal_handler (SIGLOST, generic_sig_handler); +#endif + +#ifdef SIGPIPE + octave_set_signal_handler (SIGPIPE, sigpipe_handler); +#endif + +#ifdef SIGPOLL + octave_set_signal_handler (SIGPOLL, SIG_IGN); +#endif + + // SIGPROF + // SIGPWR + +#ifdef SIGQUIT + octave_set_signal_handler (SIGQUIT, generic_sig_handler); +#endif + +#ifdef SIGSEGV + octave_set_signal_handler (SIGSEGV, generic_sig_handler); +#endif + + // SIGSTOP + +#ifdef SIGSYS + octave_set_signal_handler (SIGSYS, generic_sig_handler); +#endif + +#ifdef SIGTERM + octave_set_signal_handler (SIGTERM, sig_hup_or_term_handler); +#endif + +#ifdef SIGTRAP + octave_set_signal_handler (SIGTRAP, generic_sig_handler); +#endif + + // SIGTSTP + // SIGTTIN + // SIGTTOU + // SIGURG + +#ifdef SIGUSR1 + octave_set_signal_handler (SIGUSR1, generic_sig_handler); +#endif + +#ifdef SIGUSR2 + octave_set_signal_handler (SIGUSR2, generic_sig_handler); +#endif + +#ifdef SIGVTALRM + octave_set_signal_handler (SIGVTALRM, generic_sig_handler); +#endif + +#ifdef SIGIO + octave_set_signal_handler (SIGIO, SIG_IGN); +#endif + +#if 0 +#ifdef SIGWINCH + octave_set_signal_handler (SIGWINCH, sigwinch_handler); +#endif +#endif + +#ifdef SIGXCPU + octave_set_signal_handler (SIGXCPU, generic_sig_handler); +#endif + +#ifdef SIGXFSZ + octave_set_signal_handler (SIGXFSZ, generic_sig_handler); +#endif + +} + +static octave_scalar_map +make_sig_struct (void) +{ + octave_scalar_map m; + +#ifdef SIGABRT + m.assign ("ABRT", SIGABRT); +#endif + +#ifdef SIGALRM + m.assign ("ALRM", SIGALRM); +#endif + +#ifdef SIGBUS + m.assign ("BUS", SIGBUS); +#endif + +#ifdef SIGCHLD + m.assign ("CHLD", SIGCHLD); +#endif + +#ifdef SIGCLD + m.assign ("CLD", SIGCLD); +#endif + +#ifdef SIGCONT + m.assign ("CONT", SIGCONT); +#endif + +#ifdef SIGEMT + m.assign ("EMT", SIGEMT); +#endif + +#ifdef SIGFPE + m.assign ("FPE", SIGFPE); +#endif + +#ifdef SIGHUP + m.assign ("HUP", SIGHUP); +#endif + +#ifdef SIGILL + m.assign ("ILL", SIGILL); +#endif + +#ifdef SIGINFO + m.assign ("INFO", SIGINFO); +#endif + +#ifdef SIGINT + m.assign ("INT", SIGINT); +#endif + +#ifdef SIGIOT + m.assign ("IOT", SIGIOT); +#endif + +#ifdef SIGLOST + m.assign ("LOST", SIGLOST); +#endif + +#ifdef SIGPIPE + m.assign ("PIPE", SIGPIPE); +#endif + +#ifdef SIGPOLL + m.assign ("POLL", SIGPOLL); +#endif + +#ifdef SIGPROF + m.assign ("PROF", SIGPROF); +#endif + +#ifdef SIGPWR + m.assign ("PWR", SIGPWR); +#endif + +#ifdef SIGQUIT + m.assign ("QUIT", SIGQUIT); +#endif + +#ifdef SIGSEGV + m.assign ("SEGV", SIGSEGV); +#endif + +#ifdef SIGSTOP + m.assign ("STOP", SIGSTOP); +#endif + +#ifdef SIGSYS + m.assign ("SYS", SIGSYS); +#endif + +#ifdef SIGTERM + m.assign ("TERM", SIGTERM); +#endif + +#ifdef SIGTRAP + m.assign ("TRAP", SIGTRAP); +#endif + +#ifdef SIGTSTP + m.assign ("TSTP", SIGTSTP); +#endif + +#ifdef SIGTTIN + m.assign ("TTIN", SIGTTIN); +#endif + +#ifdef SIGTTOU + m.assign ("TTOU", SIGTTOU); +#endif + +#ifdef SIGURG + m.assign ("URG", SIGURG); +#endif + +#ifdef SIGUSR1 + m.assign ("USR1", SIGUSR1); +#endif + +#ifdef SIGUSR2 + m.assign ("USR2", SIGUSR2); +#endif + +#ifdef SIGVTALRM + m.assign ("VTALRM", SIGVTALRM); +#endif + +#ifdef SIGIO + m.assign ("IO", SIGIO); +#endif + +#ifdef SIGWINCH + m.assign ("WINCH", SIGWINCH); +#endif + +#ifdef SIGXCPU + m.assign ("XCPU", SIGXCPU); +#endif + +#ifdef SIGXFSZ + m.assign ("XFSZ", SIGXFSZ); +#endif + + return m; +} + +octave_child_list::octave_child_list_rep *octave_child_list::instance = 0; + +bool +octave_child_list::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_child_list_rep (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create child list object!"); + + retval = false; + } + + return retval; +} + +void +octave_child_list::insert (pid_t pid, octave_child::child_event_handler f) +{ + if (instance_ok ()) + instance->insert (pid, f); +} + +void +octave_child_list::reap (void) +{ + if (instance_ok ()) + instance->reap (); +} + +bool +octave_child_list::wait (void) +{ + return (instance_ok ()) ? instance->wait () : false; +} + +class pid_equal +{ +public: + + pid_equal (pid_t v) : val (v) { } + + bool operator () (const octave_child& oc) const { return oc.pid == val; } + +private: + + pid_t val; +}; + +void +octave_child_list::remove (pid_t pid) +{ + if (instance_ok ()) + instance->remove_if (pid_equal (pid)); +} + +#define OCL_REP octave_child_list::octave_child_list_rep + +void +OCL_REP::insert (pid_t pid, octave_child::child_event_handler f) +{ + append (octave_child (pid, f)); +} + +void +OCL_REP::reap (void) +{ + // Mark the record for PID invalid. + + for (iterator p = begin (); p != end (); p++) + { + // The call to the octave_child::child_event_handler might + // invalidate the iterator (for example, by calling + // octave_child_list::remove), so we increment the iterator + // here. + + octave_child& oc = *p; + + if (oc.have_status) + { + oc.have_status = 0; + + octave_child::child_event_handler f = oc.handler; + + if (f && f (oc.pid, oc.status)) + oc.pid = -1; + } + } + + remove_if (pid_equal (-1)); +} + +// Wait on our children and record any changes in their status. + +bool +OCL_REP::wait (void) +{ + bool retval = false; + + for (iterator p = begin (); p != end (); p++) + { + octave_child& oc = *p; + + pid_t pid = oc.pid; + + if (pid > 0) + { + int status; + + if (octave_syscalls::waitpid (pid, &status, WNOHANG) > 0) + { + oc.have_status = 1; + + oc.status = status; + + retval = true; + + break; + } + } + } + + return retval; +} + +DEFUN (SIG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SIG ()\n\ +Return a structure containing Unix signal names and their defined values.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + { + static octave_scalar_map m = make_sig_struct (); + + retval = m; + } + else + print_usage (); + + return retval; +} + +/* +%!assert (isstruct (SIG ())) +%!assert (! isempty (SIG ())) + +%!error SIG (1) +*/ + +DEFUN (debug_on_interrupt, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} debug_on_interrupt ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_interrupt (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_interrupt (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to enter debugging mode when it receives an interrupt signal (typically\n\ +generated with @kbd{C-c}). If a second interrupt signal is received\n\ +before reaching the debugging mode, a normal interrupt will occur.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (debug_on_interrupt); +} + +/* +%!test +%! orig_val = debug_on_interrupt (); +%! old_val = debug_on_interrupt (! orig_val); +%! assert (orig_val, old_val); +%! assert (debug_on_interrupt (), ! orig_val); +%! debug_on_interrupt (orig_val); +%! assert (debug_on_interrupt (), orig_val); + +%!error (debug_on_interrupt (1, 2)) +*/ + +DEFUN (sighup_dumps_octave_core, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} sighup_dumps_octave_core ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} sighup_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} sighup_dumps_octave_core (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave tries\n\ +to save all current variables to the file \"octave-workspace\" if it receives\n\ +a hangup signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (sighup_dumps_octave_core); +} + +/* +%!test +%! orig_val = sighup_dumps_octave_core (); +%! old_val = sighup_dumps_octave_core (! orig_val); +%! assert (orig_val, old_val); +%! assert (sighup_dumps_octave_core (), ! orig_val); +%! sighup_dumps_octave_core (orig_val); +%! assert (sighup_dumps_octave_core (), orig_val); + +%!error (sighup_dumps_octave_core (1, 2)) +*/ + +DEFUN (sigterm_dumps_octave_core, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} sigterm_dumps_octave_core ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} sigterm_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} sigterm_dumps_octave_core (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave tries\n\ +to save all current variables to the file \"octave-workspace\" if it receives\n\ +a terminate signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (sigterm_dumps_octave_core); +} + +/* +%!test +%! orig_val = sigterm_dumps_octave_core (); +%! old_val = sigterm_dumps_octave_core (! orig_val); +%! assert (orig_val, old_val); +%! assert (sigterm_dumps_octave_core (), ! orig_val); +%! sigterm_dumps_octave_core (orig_val); +%! assert (sigterm_dumps_octave_core (), orig_val); + +%!error (sigterm_dumps_octave_core (1, 2)) +*/ diff -r d02b229ce693 -r a132d206a36a src/interpfcn/sighandlers.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/sighandlers.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,177 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +/* + +The signal blocking macros defined below were adapted from similar +functions from GNU Bash, the Bourne Again SHell, copyright (C) 1994 +Free Software Foundation, Inc. + +*/ + +// This file should always be included after config.h! + +#if !defined (octave_sighandlers_h) +#define octave_sighandlers_h 1 + +// Include signal.h, not csignal since the latter might only define +// the ANSI standard C signal interface. + +#include + +#include "syswait.h" +#include "siglist.h" + +#include "base-list.h" + +typedef void sig_handler (int); + +// FIXME -- the data should probably be private... + +struct +octave_interrupt_handler +{ +#ifdef SIGINT + sig_handler *int_handler; +#endif + +#ifdef SIGBREAK + sig_handler *brk_handler; +#endif +}; + +// Nonzero means we have already printed a message for this series of +// SIGPIPES. We assume that the writer will eventually give up. +extern int pipe_handler_error_count; + +// TRUE means we can be interrupted. +extern OCTINTERP_API bool can_interrupt; + +extern OCTINTERP_API sig_handler *octave_set_signal_handler (int, sig_handler *, + bool restart_syscalls = true); + +extern OCTINTERP_API void install_signal_handlers (void); + +extern OCTINTERP_API void octave_signal_handler (void); + +extern OCTINTERP_API octave_interrupt_handler octave_catch_interrupts (void); + +extern OCTINTERP_API octave_interrupt_handler octave_ignore_interrupts (void); + +extern OCTINTERP_API octave_interrupt_handler +octave_set_interrupt_handler (const volatile octave_interrupt_handler&, + bool restart_syscalls = true); + +// extern void ignore_sigchld (void); + +// Maybe this should be in a separate file? + +class +OCTINTERP_API +octave_child +{ +public: + + // Do whatever to handle event for child with PID (might not + // actually be dead, could just be stopped). Return true if + // the list element corresponding to PID should be removed from + // list. This function should not call any functions that modify + // the octave_child_list. + + typedef bool (*child_event_handler) (pid_t, int); + + octave_child (pid_t id = -1, child_event_handler f = 0) + : pid (id), handler (f), have_status (0), status (0) { } + + octave_child (const octave_child& oc) + : pid (oc.pid), handler (oc.handler), + have_status (oc.have_status), status (oc.status) { } + + octave_child& operator = (const octave_child& oc) + { + if (&oc != this) + { + pid = oc.pid; + handler = oc.handler; + have_status = oc.have_status; + status = oc.status; + } + return *this; + } + + ~octave_child (void) { } + + // The process id of this child. + pid_t pid; + + // The function we call if an event happens for this child. + child_event_handler handler; + + // Nonzero if this child has stopped or terminated. + sig_atomic_t have_status; + + // The status of this child; 0 if running, otherwise a status value + // from waitpid. + int status; +}; + +class +OCTINTERP_API +octave_child_list +{ +protected: + + octave_child_list (void) { } + + class octave_child_list_rep : public octave_base_list + { + public: + + void insert (pid_t pid, octave_child::child_event_handler f); + + void reap (void); + + bool wait (void); + }; + +public: + + ~octave_child_list (void) { } + + static void insert (pid_t pid, octave_child::child_event_handler f); + + static void reap (void); + + static bool wait (void); + + static void remove (pid_t pid); + +private: + + static bool instance_ok (void); + + static octave_child_list_rep *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/symtab.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/symtab.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1744 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague, a.s. + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "oct-time.h" +#include "singleton-cleanup.h" + +#include "debug.h" +#include "defun.h" +#include "dirfns.h" +#include "input.h" +#include "load-path.h" +#include "ov-fcn.h" +#include "ov-usr-fcn.h" +#include "pager.h" +#include "parse.h" +#include "pt-arg-list.h" +#include "symtab.h" +#include "unwind-prot.h" +#include "utils.h" + +symbol_table *symbol_table::instance = 0; + +symbol_table::scope_id_cache *symbol_table::scope_id_cache::instance = 0; + +std::map symbol_table::all_instances; + +std::map symbol_table::global_table; + +std::map symbol_table::fcn_table; + +std::map > symbol_table::class_precedence_table; + +std::map > symbol_table::parent_map; + +const symbol_table::scope_id symbol_table::xglobal_scope = 0; +const symbol_table::scope_id symbol_table::xtop_scope = 1; + +symbol_table::scope_id symbol_table::xcurrent_scope = 1; + +symbol_table::context_id symbol_table::xcurrent_context = 0; + +// Should Octave always check to see if function files have changed +// since they were last compiled? +static int Vignore_function_time_stamp = 1; + +void +symbol_table::scope_id_cache::create_instance (void) +{ + instance = new scope_id_cache (); + + singleton_cleanup_list::add (cleanup_instance); +} + +symbol_table::context_id +symbol_table::symbol_record::symbol_record_rep::active_context (void) const +{ + octave_user_function *fcn = curr_fcn; + + // FIXME -- If active_context () == -1, then it does not make much + // sense to use this symbol_record. This means an attempt at accessing + // a variable from a function that has not been called yet is + // happening. This should be cleared up when an implementing closures. + + return fcn && fcn->active_context () != static_cast (-1) + ? fcn->active_context () : xcurrent_context; +} + +void +symbol_table::symbol_record::symbol_record_rep::dump + (std::ostream& os, const std::string& prefix) const +{ + octave_value val = varval (); + + os << prefix << name; + + if (val.is_defined ()) + { + os << " [" + << (is_local () ? "l" : "") + << (is_automatic () ? "a" : "") + << (is_formal () ? "f" : "") + << (is_hidden () ? "h" : "") + << (is_inherited () ? "i" : "") + << (is_global () ? "g" : "") + << (is_persistent () ? "p" : "") + << "] "; + val.dump (os); + } + + os << "\n"; +} + +octave_value +symbol_table::symbol_record::find (const octave_value_list& args) const +{ + octave_value retval; + + if (is_global ()) + retval = symbol_table::global_varref (name ()); + else + { + retval = varval (); + + if (retval.is_undefined ()) + { + // Use cached fcn_info pointer if possible. + if (rep->finfo) + retval = rep->finfo->find (args); + else + { + retval = symbol_table::find_function (name (), args); + + if (retval.is_defined ()) + rep->finfo = get_fcn_info (name ()); + } + } + } + + return retval; +} + +// Check the load path to see if file that defined this is still +// visible. If the file is no longer visible, then erase the +// definition and move on. If the file is visible, then we also +// need to check to see whether the file has changed since the the +// function was loaded/parsed. However, this check should only +// happen once per prompt (for files found from relative path +// elements, we also check if the working directory has changed +// since the last time the function was loaded/parsed). +// +// FIXME -- perhaps this should be done for all loaded functions when +// the prompt is printed or the directory has changed, and then we +// would not check for it when finding symbol definitions. + +static inline bool +load_out_of_date_fcn (const std::string& ff, const std::string& dir_name, + octave_value& function, + const std::string& dispatch_type = std::string ()) +{ + bool retval = false; + + octave_function *fcn = load_fcn_from_file (ff, dir_name, dispatch_type); + + if (fcn) + { + retval = true; + + function = octave_value (fcn); + } + else + function = octave_value (); + + return retval; +} + +bool +out_of_date_check (octave_value& function, + const std::string& dispatch_type, + bool check_relative) +{ + bool retval = false; + + octave_function *fcn = function.function_value (true); + + if (fcn) + { + // FIXME -- we need to handle subfunctions properly here. + + if (! fcn->is_subfunction ()) + { + std::string ff = fcn->fcn_file_name (); + + if (! ff.empty ()) + { + octave_time tc = fcn->time_checked (); + + bool relative = check_relative && fcn->is_relative (); + + if (tc < Vlast_prompt_time + || (relative && tc < Vlast_chdir_time)) + { + bool clear_breakpoints = false; + std::string nm = fcn->name (); + + bool is_same_file = false; + + std::string file; + std::string dir_name; + + if (check_relative) + { + int nm_len = nm.length (); + + if (octave_env::absolute_pathname (nm) + && ((nm_len > 4 && (nm.substr (nm_len-4) == ".oct" + || nm.substr (nm_len-4) == ".mex")) + || (nm_len > 2 && nm.substr (nm_len-2) == ".m"))) + file = nm; + else + { + // We don't want to make this an absolute name, + // because load_fcn_file looks at the name to + // decide whether it came from a relative lookup. + + if (! dispatch_type.empty ()) + { + file = load_path::find_method (dispatch_type, nm, + dir_name); + + if (file.empty ()) + { + const std::list& plist + = symbol_table::parent_classes (dispatch_type); + std::list::const_iterator it + = plist.begin (); + + while (it != plist.end ()) + { + file = load_path::find_method (*it, nm, dir_name); + if (! file.empty ()) + break; + + it++; + } + } + } + + // Maybe it's an autoload? + if (file.empty ()) + file = lookup_autoload (nm); + + if (file.empty ()) + file = load_path::find_fcn (nm, dir_name); + } + + if (! file.empty ()) + is_same_file = same_file (file, ff); + } + else + { + is_same_file = true; + file = ff; + } + + if (file.empty ()) + { + // Can't see this function from current + // directory, so we should clear it. + + function = octave_value (); + + clear_breakpoints = true; + } + else if (is_same_file) + { + // Same file. If it is out of date, then reload it. + + octave_time ottp = fcn->time_parsed (); + time_t tp = ottp.unix_time (); + + fcn->mark_fcn_file_up_to_date (octave_time ()); + + if (! (Vignore_function_time_stamp == 2 + || (Vignore_function_time_stamp + && fcn->is_system_fcn_file ()))) + { + file_stat fs (ff); + + if (fs) + { + if (fs.is_newer (tp)) + { + retval = load_out_of_date_fcn (ff, dir_name, + function, + dispatch_type); + + clear_breakpoints = true; + } + } + else + { + function = octave_value (); + + clear_breakpoints = true; + } + } + } + else + { + // Not the same file, so load the new file in + // place of the old. + + retval = load_out_of_date_fcn (file, dir_name, function, + dispatch_type); + + clear_breakpoints = true; + } + + // If the function has been replaced then clear any + // breakpoints associated with it + if (clear_breakpoints) + bp_table::remove_all_breakpoints_in_file (nm, true); + } + } + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::load_private_function + (const std::string& dir_name) +{ + octave_value retval; + + std::string file_name = load_path::find_private_fcn (dir_name, name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name); + + if (fcn) + { + std::string class_name; + + size_t pos = dir_name.find_last_of (file_ops::dir_sep_chars ()); + + if (pos != std::string::npos) + { + std::string tmp = dir_name.substr (pos+1); + + if (tmp[0] == '@') + class_name = tmp.substr (1); + } + + fcn->mark_as_private_function (class_name); + + retval = octave_value (fcn); + + private_functions[dir_name] = retval; + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::load_class_constructor (void) +{ + octave_value retval; + + std::string dir_name; + + std::string file_name = load_path::find_method (name, name, dir_name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name, name); + + if (fcn) + { + retval = octave_value (fcn); + + class_constructors[name] = retval; + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::load_class_method + (const std::string& dispatch_type) +{ + octave_value retval; + + if (name == dispatch_type) + retval = load_class_constructor (); + else + { + std::string dir_name; + + std::string file_name = load_path::find_method (dispatch_type, name, + dir_name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name, + dispatch_type); + + if (fcn) + { + retval = octave_value (fcn); + + class_methods[dispatch_type] = retval; + } + } + + if (retval.is_undefined ()) + { + // Search parent classes + + const std::list& plist = parent_classes (dispatch_type); + + std::list::const_iterator it = plist.begin (); + + while (it != plist.end ()) + { + retval = find_method (*it); + + if (retval.is_defined ()) + { + class_methods[dispatch_type] = retval; + break; + } + + it++; + } + } + } + + return retval; +} + +void +symbol_table::fcn_info::fcn_info_rep:: mark_subfunction_in_scope_as_private + (scope_id scope, const std::string& class_name) +{ + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + { + octave_function *fcn = p->second.function_value (); + + if (fcn) + fcn->mark_as_private_function (class_name); + } +} + +void +symbol_table::fcn_info::fcn_info_rep::print_dispatch (std::ostream& os) const +{ + if (dispatch_map.empty ()) + os << "dispatch: " << name << " is not overloaded" << std::endl; + else + { + os << "Overloaded function " << name << ":\n\n"; + + for (dispatch_map_const_iterator p = dispatch_map.begin (); + p != dispatch_map.end (); p++) + os << " " << name << " (" << p->first << ", ...) -> " + << p->second << " (" << p->first << ", ...)\n"; + + os << std::endl; + } +} + +std::string +symbol_table::fcn_info::fcn_info_rep::help_for_dispatch (void) const +{ + std::string retval; + + if (! dispatch_map.empty ()) + { + retval = "Overloaded function:\n\n"; + + for (dispatch_map_const_iterator p = dispatch_map.begin (); + p != dispatch_map.end (); p++) + retval += " " + p->second + " (" + p->first + ", ...)\n\n"; + } + + return retval; +} + +// :-) JWE, can you parse this? Returns a 2D array with second dimension equal +// to btyp_num_types (static constant). Only the leftmost dimension can be +// variable in C/C++. Typedefs are boring. + +static builtin_type_t (*build_sup_table (void))[btyp_num_types] +{ + static builtin_type_t sup_table[btyp_num_types][btyp_num_types]; + for (int i = 0; i < btyp_num_types; i++) + for (int j = 0; j < btyp_num_types; j++) + { + builtin_type_t ityp = static_cast (i); + builtin_type_t jtyp = static_cast (j); + // FIXME: Is this really right? + bool use_j = + (jtyp == btyp_func_handle || ityp == btyp_bool + || (btyp_isarray (ityp) + && (! btyp_isarray (jtyp) + || (btyp_isinteger (jtyp) && ! btyp_isinteger (ityp)) + || ((ityp == btyp_double || ityp == btyp_complex || ityp == btyp_char) + && (jtyp == btyp_float || jtyp == btyp_float_complex))))); + + sup_table[i][j] = use_j ? jtyp : ityp; + } + + return sup_table; +} + +std::string +get_dispatch_type (const octave_value_list& args, + builtin_type_t& builtin_type) +{ + static builtin_type_t (*sup_table)[btyp_num_types] = build_sup_table (); + std::string dispatch_type; + + int n = args.length (); + + if (n > 0) + { + int i = 0; + builtin_type = args(0).builtin_type (); + if (builtin_type != btyp_unknown) + { + for (i = 1; i < n; i++) + { + builtin_type_t bti = args(i).builtin_type (); + if (bti != btyp_unknown) + builtin_type = sup_table[builtin_type][bti]; + else + { + builtin_type = btyp_unknown; + break; + } + } + } + + if (builtin_type == btyp_unknown) + { + // There's a non-builtin class in the argument list. + dispatch_type = args(i).class_name (); + + for (int j = i+1; j < n; j++) + { + octave_value arg = args(j); + + if (arg.builtin_type () == btyp_unknown) + { + std::string cname = arg.class_name (); + + // Only switch to type of ARG if it is marked superior + // to the current DISPATCH_TYPE. + if (! symbol_table::is_superiorto (dispatch_type, cname) + && symbol_table::is_superiorto (cname, dispatch_type)) + dispatch_type = cname; + } + } + } + else + dispatch_type = btyp_class_name[builtin_type]; + } + else + builtin_type = btyp_unknown; + + return dispatch_type; +} + +std::string +get_dispatch_type (const octave_value_list& args) +{ + builtin_type_t builtin_type; + return get_dispatch_type (args, builtin_type); +} + +// Find the definition of NAME according to the following precedence +// list: +// +// variable +// subfunction +// private function +// class method +// class constructor +// legacy dispatch +// command-line function +// autoload function +// function on the path +// built-in function +// +// Matlab documentation states that constructors have higher precedence +// than methods, but that does not seem to be the case. + +octave_value +symbol_table::fcn_info::fcn_info_rep::find (const octave_value_list& args, + bool local_funcs) +{ + octave_value retval = xfind (args, local_funcs); + + if (! (error_state || retval.is_defined ())) + { + // It is possible that the user created a file on the fly since + // the last prompt or chdir, so try updating the load path and + // searching again. + + load_path::update (); + + retval = xfind (args, local_funcs); + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::xfind (const octave_value_list& args, + bool local_funcs) +{ + if (local_funcs) + { + // Subfunction. I think it only makes sense to check for + // subfunctions if we are currently executing a function defined + // from a .m file. + + octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); + + for (scope_id scope = xcurrent_scope; scope >= 0;) + { + scope_val_iterator r = subfunctions.find (scope); + if (r != subfunctions.end ()) + { + // FIXME -- out-of-date check here. + + return r->second; + } + + octave_user_function *scope_curr_fcn = get_curr_fcn (scope); + if (scope_curr_fcn) + scope = scope_curr_fcn->parent_fcn_scope (); + else + scope = -1; + } + + // Private function. + + if (curr_fcn) + { + std::string dir_name = curr_fcn->dir_name (); + + if (! dir_name.empty ()) + { + str_val_iterator q = private_functions.find (dir_name); + + if (q == private_functions.end ()) + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval, "", false); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + } + } + } + } + + // Class methods. + + if (! args.empty ()) + { + std::string dispatch_type = get_dispatch_type (args); + + octave_value fcn = find_method (dispatch_type); + + if (fcn.is_defined ()) + return fcn; + } + + // Class constructors. The class name and function name are the same. + + str_val_iterator q = class_constructors.find (name); + + if (q == class_constructors.end ()) + { + octave_value val = load_class_constructor (); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval, name); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_class_constructor (); + + if (val.is_defined ()) + return val; + } + } + + // Legacy dispatch. + + if (! args.empty () && ! dispatch_map.empty ()) + { + std::string dispatch_type = args(0).type_name (); + + std::string fname; + + dispatch_map_iterator p = dispatch_map.find (dispatch_type); + + if (p == dispatch_map.end ()) + p = dispatch_map.find ("any"); + + if (p != dispatch_map.end ()) + { + fname = p->second; + + octave_value fcn + = symbol_table::find_function (fname, args); + + if (fcn.is_defined ()) + return fcn; + } + } + + // Command-line function. + + if (cmdline_function.is_defined ()) + return cmdline_function; + + // Autoload? + + octave_value fcn = find_autoload (); + + if (fcn.is_defined ()) + return fcn; + + // Function on the path. + + fcn = find_user_function (); + + if (fcn.is_defined ()) + return fcn; + + // Built-in function (might be undefined). + + return built_in_function; +} + +// Find the definition of NAME according to the following precedence +// list: +// +// built-in function +// function on the path +// autoload function +// command-line function +// private function +// subfunction + +// This function is used to implement the "builtin" function, which +// searches for "built-in" functions. In Matlab, "builtin" only +// returns functions that are actually built-in to the interpreter. +// But since the list of built-in functions is different in Octave and +// Matlab, we also search up the precedence list until we find +// something that matches. Note that we are only searching by name, +// so class methods, constructors, and legacy dispatch functions are +// skipped. + +octave_value +symbol_table::fcn_info::fcn_info_rep::builtin_find (void) +{ + octave_value retval = x_builtin_find (); + + if (! retval.is_defined ()) + { + // It is possible that the user created a file on the fly since + // the last prompt or chdir, so try updating the load path and + // searching again. + + load_path::update (); + + retval = x_builtin_find (); + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::x_builtin_find (void) +{ + // Built-in function. + if (built_in_function.is_defined ()) + return built_in_function; + + // Function on the path. + + octave_value fcn = find_user_function (); + + if (fcn.is_defined ()) + return fcn; + + // Autoload? + + fcn = find_autoload (); + + if (fcn.is_defined ()) + return fcn; + + // Command-line function. + + if (cmdline_function.is_defined ()) + return cmdline_function; + + // Private function. + + octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); + + if (curr_fcn) + { + std::string dir_name = curr_fcn->dir_name (); + + if (! dir_name.empty ()) + { + str_val_iterator q = private_functions.find (dir_name); + + if (q == private_functions.end ()) + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + } + } + } + + // Subfunction. I think it only makes sense to check for + // subfunctions if we are currently executing a function defined + // from a .m file. + + for (scope_id scope = xcurrent_scope; scope >= 0;) + { + scope_val_iterator r = subfunctions.find (scope); + if (r != subfunctions.end ()) + { + // FIXME -- out-of-date check here. + + return r->second; + } + + octave_user_function *scope_curr_fcn = get_curr_fcn (scope); + if (scope_curr_fcn) + scope = scope_curr_fcn->parent_fcn_scope (); + else + scope = -1; + } + + return octave_value (); +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::find_method (const std::string& dispatch_type) +{ + octave_value retval; + + str_val_iterator q = class_methods.find (dispatch_type); + + if (q == class_methods.end ()) + { + octave_value val = load_class_method (dispatch_type); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval, dispatch_type); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_class_method (dispatch_type); + + if (val.is_defined ()) + return val; + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::find_autoload (void) +{ + octave_value retval; + + // Autoloaded function. + + if (autoload_function.is_defined ()) + out_of_date_check (autoload_function); + + if (! autoload_function.is_defined ()) + { + std::string file_name = lookup_autoload (name); + + if (! file_name.empty ()) + { + size_t pos = file_name.find_last_of (file_ops::dir_sep_chars ()); + + std::string dir_name = file_name.substr (0, pos); + + octave_function *fcn = load_fcn_from_file (file_name, dir_name, + "", name, true); + + if (fcn) + autoload_function = octave_value (fcn); + } + } + + return autoload_function; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::find_user_function (void) +{ + // Function on the path. + + if (function_on_path.is_defined ()) + out_of_date_check (function_on_path); + + if (! (error_state || function_on_path.is_defined ())) + { + std::string dir_name; + + std::string file_name = load_path::find_fcn (name, dir_name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name); + + if (fcn) + function_on_path = octave_value (fcn); + } + } + + return function_on_path; +} + +// Insert INF_CLASS in the set of class names that are considered +// inferior to SUP_CLASS. Return FALSE if INF_CLASS is currently +// marked as superior to SUP_CLASS. + +bool +symbol_table::set_class_relationship (const std::string& sup_class, + const std::string& inf_class) +{ + class_precedence_table_const_iterator p + = class_precedence_table.find (inf_class); + + if (p != class_precedence_table.end ()) + { + const std::set& inferior_classes = p->second; + + std::set::const_iterator q + = inferior_classes.find (sup_class); + + if (q != inferior_classes.end ()) + return false; + } + + class_precedence_table[sup_class].insert (inf_class); + + return true; +} + +// Has class A been marked as superior to class B? Also returns +// TRUE if B has been marked as inferior to A, since we only keep +// one table, and convert inferiort information to a superiorto +// relationship. Two calls are required to determine whether there +// is no relationship between two classes: +// +// if (symbol_table::is_superiorto (a, b)) +// // A is superior to B, or B has been marked inferior to A. +// else if (symbol_table::is_superiorto (b, a)) +// // B is superior to A, or A has been marked inferior to B. +// else +// // No relation. + +bool +symbol_table::is_superiorto (const std::string& a, const std::string& b) +{ + bool retval = false; + + class_precedence_table_const_iterator p = class_precedence_table.find (a); + + if (p != class_precedence_table.end ()) + { + const std::set& inferior_classes = p->second; + std::set::const_iterator q = inferior_classes.find (b); + + if (q != inferior_classes.end ()) + retval = true; + } + + return retval; +} + +static std::string +fcn_file_name (const octave_value& fcn) +{ + const octave_function *f = fcn.function_value (); + + return f ? f->fcn_file_name () : std::string (); +} + +void +symbol_table::fcn_info::fcn_info_rep::dump + (std::ostream& os, const std::string& prefix) const +{ + os << prefix << name + << " [" + << (cmdline_function.is_defined () ? "c" : "") + << (built_in_function.is_defined () ? "b" : "") + << "]\n"; + + std::string tprefix = prefix + " "; + + if (autoload_function.is_defined ()) + os << tprefix << "autoload: " + << fcn_file_name (autoload_function) << "\n"; + + if (function_on_path.is_defined ()) + os << tprefix << "function from path: " + << fcn_file_name (function_on_path) << "\n"; + + if (! subfunctions.empty ()) + { + for (scope_val_const_iterator p = subfunctions.begin (); + p != subfunctions.end (); p++) + os << tprefix << "subfunction: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! private_functions.empty ()) + { + for (str_val_const_iterator p = private_functions.begin (); + p != private_functions.end (); p++) + os << tprefix << "private: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! class_constructors.empty ()) + { + for (str_val_const_iterator p = class_constructors.begin (); + p != class_constructors.end (); p++) + os << tprefix << "constructor: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! class_methods.empty ()) + { + for (str_val_const_iterator p = class_methods.begin (); + p != class_methods.end (); p++) + os << tprefix << "method: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! dispatch_map.empty ()) + { + for (dispatch_map_const_iterator p = dispatch_map.begin (); + p != dispatch_map.end (); p++) + os << tprefix << "dispatch: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } +} + +void +symbol_table::install_nestfunction (const std::string& name, + const octave_value& fcn, + scope_id parent_scope) +{ + install_subfunction (name, fcn, parent_scope); + + // Stash the nest_parent for resolving variables after parsing is done. + octave_function *fv = fcn.function_value (); + + symbol_table *fcn_table_loc = get_instance (fv->scope ()); + + symbol_table *parent_table = get_instance (parent_scope); + + parent_table->add_nest_child (*fcn_table_loc); +} + +octave_value +symbol_table::find (const std::string& name, + const octave_value_list& args, + bool skip_variables, + bool local_funcs) +{ + symbol_table *inst = get_instance (xcurrent_scope); + + return inst + ? inst->do_find (name, args, skip_variables, local_funcs) + : octave_value (); +} + +octave_value +symbol_table::builtin_find (const std::string& name) +{ + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_builtin_find (name) : octave_value (); +} + +octave_value +symbol_table::find_function (const std::string& name, + const octave_value_list& args, + bool local_funcs) +{ + octave_value retval; + + if (! name.empty () && name[0] == '@') + { + // Look for a class specific function. + std::string dispatch_type = + name.substr (1, name.find_first_of (file_ops::dir_sep_str ()) - 1); + + std::string method = + name.substr (name.find_last_of (file_ops::dir_sep_str ()) + 1, + std::string::npos); + + retval = find_method (method, dispatch_type); + } + else + { + size_t pos = name.find_first_of (Vfilemarker); + + if (pos == std::string::npos) + retval = find (name, args, true, local_funcs); + else + { + std::string fcn_scope = name.substr (0, pos); + scope_id stored_scope = xcurrent_scope; + xcurrent_scope = xtop_scope; + octave_value parent = find_function (name.substr (0, pos), + octave_value_list (), false); + + if (parent.is_defined ()) + { + octave_function *parent_fcn = parent.function_value (); + + if (parent_fcn) + { + xcurrent_scope = parent_fcn->scope (); + + if (xcurrent_scope > 1) + retval = find_function (name.substr (pos + 1), args); + } + } + + xcurrent_scope = stored_scope; + } + } + + return retval; +} + +void +symbol_table::dump (std::ostream& os, scope_id scope) +{ + if (scope == xglobal_scope) + dump_global (os); + else + { + symbol_table *inst = get_instance (scope, false); + + if (inst) + { + os << "*** dumping symbol table scope " << scope + << " (" << inst->table_name << ")\n\n"; + + std::map sfuns + = symbol_table::subfunctions_defined_in_scope (scope); + + if (! sfuns.empty ()) + { + os << " subfunctions defined in this scope:\n"; + + for (std::map::const_iterator p = sfuns.begin (); + p != sfuns.end (); p++) + os << " " << p->first << "\n"; + + os << "\n"; + } + + inst->do_dump (os); + } + } +} + +void +symbol_table::dump_global (std::ostream& os) +{ + if (! global_table.empty ()) + { + os << "*** dumping global symbol table\n\n"; + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + { + std::string nm = p->first; + octave_value val = p->second; + + os << " " << nm << " "; + val.dump (os); + os << "\n"; + } + } +} + +void +symbol_table::dump_functions (std::ostream& os) +{ + if (! fcn_table.empty ()) + { + os << "*** dumping globally visible functions from symbol table\n" + << " (c=commandline, b=built-in)\n\n"; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + p->second.dump (os, " "); + + os << "\n"; + } +} + +void +symbol_table::stash_dir_name_for_subfunctions (scope_id scope, + const std::string& dir_name) +{ + // FIXME -- is this the best way to do this? Maybe it would be + // better if we had a map from scope to list of subfunctions + // stored with the function. Do we? + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + std::pair tmp + = p->second.subfunction_defined_in_scope (scope); + + std::string nm = tmp.first; + + if (! nm.empty ()) + { + octave_value& fcn = tmp.second; + + octave_user_function *f = fcn.user_function_value (); + + if (f) + f->stash_dir_name (dir_name); + } + } +} + +octave_value +symbol_table::do_find (const std::string& name, + const octave_value_list& args, + bool skip_variables, + bool local_funcs) +{ + octave_value retval; + + // Variable. + + if (! skip_variables) + { + table_iterator p = table.find (name); + + if (p != table.end ()) + { + symbol_record sr = p->second; + + // FIXME -- should we be using something other than varref here? + + if (sr.is_global ()) + return symbol_table::global_varref (name); + else + { + octave_value& val = sr.varref (); + + if (val.is_defined ()) + return val; + } + } + } + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + return p->second.find (args, local_funcs); + else + { + fcn_info finfo (name); + + octave_value fcn = finfo.find (args, local_funcs); + + if (fcn.is_defined ()) + fcn_table[name] = finfo; + + return fcn; + } + + return retval; +} + +octave_value +symbol_table::do_builtin_find (const std::string& name) +{ + octave_value retval; + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + return p->second.builtin_find (); + else + { + fcn_info finfo (name); + + octave_value fcn = finfo.builtin_find (); + + if (fcn.is_defined ()) + fcn_table[name] = finfo; + + return fcn; + } + + return retval; +} + +void +symbol_table::do_dump (std::ostream& os) +{ + if (! persistent_table.empty ()) + { + os << " persistent variables in this scope:\n\n"; + + for (persistent_table_const_iterator p = persistent_table.begin (); + p != persistent_table.end (); p++) + { + std::string nm = p->first; + octave_value val = p->second; + + os << " " << nm << " "; + val.dump (os); + os << "\n"; + } + + os << "\n"; + } + + if (! table.empty ()) + { + os << " other symbols in this scope (l=local; a=auto; f=formal\n" + << " h=hidden; i=inherited; g=global; p=persistent)\n\n"; + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + p->second.dump (os, " "); + + os << "\n"; + } +} + +void symbol_table::cleanup (void) +{ + // Clear variables in top scope. + all_instances[xtop_scope]->clear_variables (); + + // Clear function table. This is a hard clear, ignoring mlocked functions. + fcn_table.clear (); + + // Clear variables in global scope. + // FIXME: are there any? + all_instances[xglobal_scope]->clear_variables (); + + // Clear global variables. + global_table.clear (); + + // Delete all possibly remaining scopes. + for (all_instances_iterator iter = all_instances.begin (); + iter != all_instances.end (); iter++) + { + scope_id scope = iter->first; + if (scope != xglobal_scope && scope != xtop_scope) + scope_id_cache::free (scope); + + // First zero the table entry to avoid possible duplicate delete. + symbol_table *inst = iter->second; + iter->second = 0; + + // Now delete the scope. Note that there may be side effects, such as + // deleting other scopes. + delete inst; + } +} + +void +symbol_table::do_update_nest (void) +{ + if (nest_parent || nest_children.size ()) + curr_fcn->mark_as_nested_function (); + + if (nest_parent) + { + // fix bad symbol_records + for (table_iterator ti = table.begin (); ti != table.end (); ++ti) + { + symbol_record &ours = ti->second; + symbol_record parents; + if (! ours.is_formal () + && nest_parent->look_nonlocal (ti->first, parents)) + { + if (ours.is_global () || ours.is_persistent ()) + ::error ("global and persistent may only be used in the topmost level in which a nested variable is used"); + + if (! ours.is_formal ()) + { + ours.invalidate (); + ti->second = parents; + } + } + else + ours.set_curr_fcn (curr_fcn); + } + } + else if (nest_children.size ()) + for (table_iterator ti = table.begin (); ti != table.end (); ++ti) + ti->second.set_curr_fcn (curr_fcn); + + for (std::vector::iterator iter = nest_children.begin (); + iter != nest_children.end (); ++iter) + (*iter)->do_update_nest (); +} + +DEFUN (ignore_function_time_stamp, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} ignore_function_time_stamp ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} ignore_function_time_stamp (@var{new_val})\n\ +Query or set the internal variable that controls whether Octave checks\n\ +the time stamp on files each time it looks up functions defined in\n\ +function files. If the internal variable is set to @code{\"system\"},\n\ +Octave will not automatically recompile function files in subdirectories of\n\ +@file{@var{octave-home}/lib/@var{version}} if they have changed since\n\ +they were last compiled, but will recompile other function files in the\n\ +search path if they change. If set to @code{\"all\"}, Octave will not\n\ +recompile any function files unless their definitions are removed with\n\ +@code{clear}. If set to \"none\", Octave will always check time stamps\n\ +on files to determine whether functions defined in function files\n\ +need to recompiled.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + { + switch (Vignore_function_time_stamp) + { + case 1: + retval = "system"; + break; + + case 2: + retval = "all"; + break; + + default: + retval = "none"; + break; + } + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + if (sval == "all") + Vignore_function_time_stamp = 2; + else if (sval == "system") + Vignore_function_time_stamp = 1; + else if (sval == "none") + Vignore_function_time_stamp = 0; + else + error ("ignore_function_time_stamp: expecting argument to be \"all\", \"system\", or \"none\""); + } + else + error ("ignore_function_time_stamp: expecting argument to be character string"); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +/* +%!shared old_state +%! old_state = ignore_function_time_stamp (); +%!test +%! state = ignore_function_time_stamp ("all"); +%! assert (state, old_state); +%! assert (ignore_function_time_stamp (), "all"); +%! state = ignore_function_time_stamp ("system"); +%! assert (state, "all"); +%! assert (ignore_function_time_stamp (), "system"); +%! ignore_function_time_stamp (old_state); + +## Test input validation +%!error (ignore_function_time_stamp ("all", "all")) +%!error (ignore_function_time_stamp ("UNKNOWN_VALUE")) +%!error (ignore_function_time_stamp (42)) +*/ + +DEFUN (__current_scope__, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{scope}, @var{context}]} __dump_symtab_info__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = symbol_table::current_context (); + retval(0) = symbol_table::current_scope (); + + return retval; +} + +DEFUN (__dump_symtab_info__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __dump_symtab_info__ ()\n\ +@deftypefnx {Built-in Function} {} __dump_symtab_info__ (@var{scope})\n\ +@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"scopes\")\n\ +@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"functions\")\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + { + symbol_table::dump_functions (octave_stdout); + + symbol_table::dump_global (octave_stdout); + + std::list lst = symbol_table::scopes (); + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + symbol_table::dump (octave_stdout, *p); + } + else if (nargin == 1) + { + octave_value arg = args(0); + + if (arg.is_string ()) + { + std::string s_arg = arg.string_value (); + + if (s_arg == "scopes") + { + std::list lst = symbol_table::scopes (); + + RowVector v (lst.size ()); + + octave_idx_type k = 0; + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + v.xelem (k++) = *p; + + retval = v; + } + else if (s_arg == "functions") + { + symbol_table::dump_functions (octave_stdout); + } + else + error ("__dump_symtab_info__: expecting \"functions\" or \"scopes\""); + } + else + { + int s = arg.int_value (); + + if (! error_state) + symbol_table::dump (octave_stdout, s); + else + error ("__dump_symtab_info__: expecting string or scope id"); + } + } + else + print_usage (); + + return retval; +} + +#if 0 + +// FIXME -- should we have functions like this in Octave? + +DEFUN (set_variable, args, , "set_variable (NAME, VALUE)") +{ + octave_value retval; + + if (args.length () == 2) + { + std::string name = args(0).string_value (); + + if (! error_state) + symbol_table::varref (name) = args(1); + else + error ("set_variable: expecting variable name as first argument"); + } + else + print_usage (); + + return retval; +} + +DEFUN (variable_value, args, , "VALUE = variable_value (NAME)") +{ + octave_value retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + retval = symbol_table::varval (name); + + if (retval.is_undefined ()) + error ("variable_value: `%s' is not a variable in the current scope", + name.c_str ()); + } + else + error ("variable_value: expecting variable name as first argument"); + } + else + print_usage (); + + return retval; +} +#endif + + +/* +bug #34497: 'clear -f' does not work for command line functions + +This test relies on bar being a core function that is implemented in an m-file. +If the first assert fails, this is no longer the case and the tests need to be +updated to use some other function. + +%!assert (! strcmp (which ("bar"), "")); + +%!function x = bar () +%! x = 5; +%!endfunction +%!test +%! assert (bar == 5); +%! assert (strcmp (which ("bar"), "")); +%! clear -f bar; +%! assert (! strcmp (which ("bar"), "")); + +%!function x = bar () +%! x = 5; +%!endfunction +%!test +%! assert (bar == 5); +%! assert (strcmp (which ("bar"), "")); +%! clear bar; +%! assert (! strcmp (which ("bar"), "")); + */ diff -r d02b229ce693 -r a132d206a36a src/interpfcn/symtab.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/symtab.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,2660 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_symtab_h) +#define octave_symtab_h 1 + +#include +#include +#include +#include +#include + +#include "glob-match.h" +#include "regexp.h" + +class tree_argument_list; +class octave_user_function; + +#include "oct-obj.h" +#include "oct-refcount.h" +#include "ov.h" + +class +OCTINTERP_API +symbol_table +{ +public: + + typedef int scope_id; + typedef size_t context_id; + + class + scope_id_cache + { + protected: + + typedef std::set::iterator set_iterator; + typedef std::set::const_iterator set_const_iterator; + + // We start with 2 because we allocate 0 for the global symbols + // and 1 for the top-level workspace. + + scope_id_cache (void) : next_available (2), in_use (), free_list () { } + + public: + + ~scope_id_cache (void) { } + + static scope_id alloc (void) + { + return instance_ok () ? instance->do_alloc () : -1; + } + + static void free (scope_id scope) + { + if (instance_ok ()) + return instance->do_free (scope); + } + + static std::list scopes (void) + { + return instance_ok () ? instance->do_scopes () : std::list (); + } + + static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create scope_id_cache object!"); + + retval = false; + } + + return retval; + } + + private: + + // No copying! + + scope_id_cache (const scope_id_cache&); + + scope_id_cache& operator = (const scope_id_cache&); + + static scope_id_cache *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + // The next available scope not in the free list. + scope_id next_available; + + // The set of scope IDs that are currently allocated. + std::set in_use; + + // The set of scope IDs that are currently available. + std::set free_list; + + scope_id do_alloc (void) + { + scope_id retval; + + set_iterator p = free_list.begin (); + + if (p != free_list.end ()) + { + retval = *p; + free_list.erase (p); + } + else + retval = next_available++; + + in_use.insert (retval); + + return retval; + } + + void do_free (scope_id scope) + { + set_iterator p = in_use.find (scope); + + if (p != in_use.end ()) + { + in_use.erase (p); + free_list.insert (scope); + } + else + error ("free_scope: scope %d not found!", scope); + } + + std::list do_scopes (void) const + { + std::list retval; + + for (set_const_iterator p = in_use.begin (); p != in_use.end (); p++) + retval.push_back (*p); + + retval.sort (); + + return retval; + } + }; + + class fcn_info; + + class + symbol_record + { + public: + + // generic variable + static const unsigned int local = 1; + + // varargin, argn, .nargin., .nargout. + // (FIXME -- is this really used now?) + static const unsigned int automatic = 2; + + // formal parameter + static const unsigned int formal = 4; + + // not listed or cleared (.nargin., .nargout.) + static const unsigned int hidden = 8; + + // inherited from parent scope; not cleared at function exit + static const unsigned int inherited = 16; + + // global (redirects to global scope) + static const unsigned int global = 32; + + // not cleared at function exit + static const unsigned int persistent = 64; + + // temporary variables forced into symbol table for parsing + static const unsigned int forced = 128; + + private: + + class + symbol_record_rep + { + public: + + symbol_record_rep (scope_id s, const std::string& nm, + const octave_value& v, unsigned int sc) + : decl_scope (s), curr_fcn (0), name (nm), value_stack (), + storage_class (sc), finfo (), valid (true), count (1) + { + value_stack.push_back (v); + } + + void force_variable (context_id context = xdefault_context) + { + if (context == xdefault_context) + context = active_context (); + + octave_value& val = varref (context); + + if (! val.is_defined ()) + mark_forced (); + } + + octave_value& varref (context_id context = xdefault_context) + { + if (is_global ()) + return symbol_table::global_varref (name); + else if (is_persistent ()) + return symbol_table::persistent_varref (name); + else + { + if (context == xdefault_context) + context = active_context (); + + context_id n = value_stack.size (); + while (n++ <= context) + value_stack.push_back (octave_value ()); + + return value_stack[context]; + } + } + + octave_value varval (context_id context = xdefault_context) const + { + if (is_global ()) + return symbol_table::global_varval (name); + else if (is_persistent ()) + return symbol_table::persistent_varval (name); + else + { + if (context == xdefault_context) + context = active_context (); + + if (context < value_stack.size ()) + return value_stack[context]; + else + return octave_value (); + } + } + + void push_context (scope_id s) + { + if (! (is_persistent () || is_global ()) + && s == scope ()) + value_stack.push_back (octave_value ()); + } + + // If pop_context returns 0, we are out of values and this element + // of the symbol table should be deleted. This can happen for + // functions like + // + // function foo (n) + // if (n > 0) + // foo (n-1); + // else + // eval ("x = 1"); + // endif + // endfunction + // + // Here, X should only exist in the final stack frame. + + size_t pop_context (scope_id s) + { + size_t retval = 1; + + if (! (is_persistent () || is_global ()) + && s == scope ()) + { + value_stack.pop_back (); + retval = value_stack.size (); + } + + return retval; + } + + void clear (void) { clear (scope ()); } + + void clear (scope_id s) + { + if (! (is_hidden () || is_inherited ()) + && s == scope ()) + { + if (is_global ()) + unmark_global (); + + if (is_persistent ()) + { + symbol_table::persistent_varref (name) + = varval (); + + unmark_persistent (); + } + + varref () = octave_value (); + } + } + + bool is_defined (context_id context = xdefault_context) const + { + if (context == xdefault_context) + context = active_context (); + + return varval (context).is_defined (); + } + + bool is_valid (void) const + { + return valid; + } + + bool is_variable (context_id context) const + { + if (context == xdefault_context) + context = active_context (); + + return (! is_local () || is_defined (context) || is_forced ()); + } + + bool is_local (void) const { return storage_class & local; } + bool is_automatic (void) const { return storage_class & automatic; } + bool is_formal (void) const { return storage_class & formal; } + bool is_hidden (void) const { return storage_class & hidden; } + bool is_inherited (void) const { return storage_class & inherited; } + bool is_global (void) const { return storage_class & global; } + bool is_persistent (void) const { return storage_class & persistent; } + bool is_forced (void) const { return storage_class & forced; } + + void mark_local (void) { storage_class |= local; } + void mark_automatic (void) { storage_class |= automatic; } + void mark_formal (void) { storage_class |= formal; } + void mark_hidden (void) { storage_class |= hidden; } + void mark_inherited (void) { storage_class |= inherited; } + void mark_global (void) + { + if (is_persistent ()) + error ("can't make persistent variable %s global", name.c_str ()); + else + storage_class |= global; + } + void mark_persistent (void) + { + if (is_global ()) + error ("can't make global variable %s persistent", name.c_str ()); + else + storage_class |= persistent; + } + void mark_forced (void) { storage_class |= forced; } + + void unmark_local (void) { storage_class &= ~local; } + void unmark_automatic (void) { storage_class &= ~automatic; } + void unmark_formal (void) { storage_class &= ~formal; } + void unmark_hidden (void) { storage_class &= ~hidden; } + void unmark_inherited (void) { storage_class &= ~inherited; } + void unmark_global (void) { storage_class &= ~global; } + void unmark_persistent (void) { storage_class &= ~persistent; } + void unmark_forced (void) { storage_class &= ~forced; } + + void init_persistent (void) + { + if (! is_defined ()) + { + mark_persistent (); + + varref () = symbol_table::persistent_varval (name); + } + // FIXME -- this causes trouble with recursive calls. + // else + // error ("unable to declare existing variable persistent"); + } + + void invalidate (void) + { + valid = false; + } + + void erase_persistent (void) + { + unmark_persistent (); + symbol_table::erase_persistent (name); + } + + context_id active_context (void) const; + + scope_id scope (void) const { return decl_scope; } + + void set_curr_fcn (octave_user_function *fcn) + { + curr_fcn = fcn; + } + + symbol_record_rep *dup (scope_id new_scope) const + { + return new symbol_record_rep (new_scope, name, varval (), + storage_class); + } + + void dump (std::ostream& os, const std::string& prefix) const; + + scope_id decl_scope; + + octave_user_function* curr_fcn; + + std::string name; + + std::deque value_stack; + + unsigned int storage_class; + + fcn_info *finfo; + + bool valid; + + octave_refcount count; + + private: + + // No copying! + + symbol_record_rep (const symbol_record_rep& ov); + + symbol_record_rep& operator = (const symbol_record_rep&); + }; + + public: + + symbol_record (scope_id s = xcurrent_scope, + const std::string& nm = std::string (), + const octave_value& v = octave_value (), + unsigned int sc = local) + : rep (new symbol_record_rep (s, nm, v, sc)) { } + + symbol_record (const symbol_record& sr) + : rep (sr.rep) + { + rep->count++; + } + + symbol_record& operator = (const symbol_record& sr) + { + if (this != &sr) + { + if (--rep->count == 0) + delete rep; + + rep = sr.rep; + rep->count++; + } + + return *this; + } + + ~symbol_record (void) + { + if (--rep->count == 0) + delete rep; + } + + symbol_record dup (scope_id new_scope) const + { + return symbol_record (rep->dup (new_scope)); + } + + const std::string& name (void) const { return rep->name; } + + octave_value + find (const octave_value_list& args = octave_value_list ()) const; + + void force_variable (context_id context = xdefault_context) + { + rep->force_variable (context); + } + + octave_value& varref (context_id context = xdefault_context) + { + return rep->varref (context); + } + + octave_value varval (context_id context = xdefault_context) const + { + return rep->varval (context); + } + + void push_context (scope_id s) { rep->push_context (s); } + + size_t pop_context (scope_id s) { return rep->pop_context (s); } + + void clear (void) { rep->clear (); } + + void clear (scope_id s) { rep->clear (s); } + + bool is_defined (context_id context = xdefault_context) const + { + return rep->is_defined (context); + } + + bool is_valid (void) const + { + return rep->is_valid (); + } + + bool is_variable (context_id context = xdefault_context) const + { + return rep->is_variable (context); + } + + bool is_local (void) const { return rep->is_local (); } + bool is_automatic (void) const { return rep->is_automatic (); } + bool is_formal (void) const { return rep->is_formal (); } + bool is_global (void) const { return rep->is_global (); } + bool is_hidden (void) const { return rep->is_hidden (); } + bool is_inherited (void) const { return rep->is_inherited (); } + bool is_persistent (void) const { return rep->is_persistent (); } + bool is_forced (void) const { return rep->is_forced (); } + + void mark_local (void) { rep->mark_local (); } + void mark_automatic (void) { rep->mark_automatic (); } + void mark_formal (void) { rep->mark_formal (); } + void mark_hidden (void) { rep->mark_hidden (); } + void mark_inherited (void) { rep->mark_inherited (); } + void mark_global (void) { rep->mark_global (); } + void mark_persistent (void) { rep->mark_persistent (); } + void mark_forced (void) { rep->mark_forced (); } + + void unmark_local (void) { rep->unmark_local (); } + void unmark_automatic (void) { rep->unmark_automatic (); } + void unmark_formal (void) { rep->unmark_formal (); } + void unmark_hidden (void) { rep->unmark_hidden (); } + void unmark_inherited (void) { rep->unmark_inherited (); } + void unmark_global (void) { rep->unmark_global (); } + void unmark_persistent (void) { rep->unmark_persistent (); } + void unmark_forced (void) { rep->unmark_forced (); } + + void init_persistent (void) { rep->init_persistent (); } + + void erase_persistent (void) { rep->erase_persistent (); } + + void invalidate (void) { rep->invalidate (); } + + context_id active_context (void) const { return rep->active_context (); } + + scope_id scope (void) const { return rep->scope (); } + + unsigned int xstorage_class (void) const { return rep->storage_class; } + + void set_curr_fcn (octave_user_function *fcn) { rep->set_curr_fcn (fcn); } + + void + dump (std::ostream& os, const std::string& prefix = std::string ()) const + { + rep->dump (os, prefix); + } + + private: + + symbol_record_rep *rep; + + symbol_record (symbol_record_rep *new_rep) : rep (new_rep) { } + }; + + // Always access a symbol from the current scope. + // Useful for scripts, as they may be executed in more than one scope. + class + symbol_reference + { + public: + symbol_reference (void) : scope (-1) {} + + symbol_reference (symbol_record record, + scope_id curr_scope = symbol_table::current_scope ()) + : scope (curr_scope), sym (record) + {} + + symbol_reference& operator = (const symbol_reference& ref) + { + scope = ref.scope; + sym = ref.sym; + return *this; + } + + // The name is the same regardless of scope. + const std::string& name (void) const { return sym.name (); } + + symbol_record *operator-> (void) + { + update (); + return &sym; + } + + symbol_record *operator-> (void) const + { + update (); + return &sym; + } + + // can be used to place symbol_reference in maps, we don't overload < as + // it doesn't make any sense for symbol_reference + struct comparator + { + bool operator ()(const symbol_reference& lhs, + const symbol_reference& rhs) const + { + return lhs.name () < rhs.name (); + } + }; + private: + void update (void) const + { + scope_id curr_scope = symbol_table::current_scope (); + if (scope != curr_scope || ! sym.is_valid ()) + { + scope = curr_scope; + sym = symbol_table::insert (sym.name ()); + } + } + + mutable scope_id scope; + mutable symbol_record sym; + }; + + class + fcn_info + { + public: + + typedef std::map dispatch_map_type; + + typedef std::map::const_iterator scope_val_const_iterator; + typedef std::map::iterator scope_val_iterator; + + typedef std::map::const_iterator str_val_const_iterator; + typedef std::map::iterator str_val_iterator; + + typedef dispatch_map_type::const_iterator dispatch_map_const_iterator; + typedef dispatch_map_type::iterator dispatch_map_iterator; + + private: + + class + fcn_info_rep + { + public: + + fcn_info_rep (const std::string& nm) + : name (nm), subfunctions (), private_functions (), + class_constructors (), class_methods (), dispatch_map (), + cmdline_function (), autoload_function (), function_on_path (), + built_in_function (), count (1) { } + + octave_value load_private_function (const std::string& dir_name); + + octave_value load_class_constructor (void); + + octave_value load_class_method (const std::string& dispatch_type); + + octave_value find (const octave_value_list& args, bool local_funcs); + + octave_value builtin_find (void); + + octave_value find_method (const std::string& dispatch_type); + + octave_value find_autoload (void); + + octave_value find_user_function (void); + + bool is_user_function_defined (void) const + { + return function_on_path.is_defined (); + } + + octave_value find_function (const octave_value_list& args, bool local_funcs) + { + return find (args, local_funcs); + } + + void lock_subfunction (scope_id scope) + { + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + p->second.lock (); + } + + void unlock_subfunction (scope_id scope) + { + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + p->second.unlock (); + } + + std::pair + subfunction_defined_in_scope (scope_id scope) const + { + scope_val_const_iterator p = subfunctions.find (scope); + + return p == subfunctions.end () + ? std::pair () + : std::pair (name, p->second); + } + + void erase_subfunction (scope_id scope) + { + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + subfunctions.erase (p); + } + + void mark_subfunction_in_scope_as_private (scope_id scope, + const std::string& class_name); + + void install_cmdline_function (const octave_value& f) + { + cmdline_function = f; + } + + void install_subfunction (const octave_value& f, scope_id scope) + { + subfunctions[scope] = f; + } + + void install_user_function (const octave_value& f) + { + function_on_path = f; + } + + void install_built_in_function (const octave_value& f) + { + built_in_function = f; + } + + template + void + clear_unlocked (std::map& map) + { + typename std::map::iterator p = map.begin (); + + while (p != map.end ()) + { + if (p->second.islocked ()) + p++; + else + map.erase (p++); + } + } + + void clear_autoload_function (void) + { + if (! autoload_function.islocked ()) + autoload_function = octave_value (); + } + + // We also clear command line functions here, as these are both + // "user defined" + void clear_user_function (void) + { + if (! function_on_path.islocked ()) + { + function_on_path.erase_subfunctions (); + + function_on_path = octave_value (); + } + + if (! cmdline_function.islocked ()) + cmdline_function = octave_value (); + } + + void clear_mex_function (void) + { + if (function_on_path.is_mex_function ()) + clear_user_function (); + } + + void clear (void) + { + clear_unlocked (subfunctions); + clear_unlocked (private_functions); + clear_unlocked (class_constructors); + clear_unlocked (class_methods); + clear_autoload_function (); + clear_user_function (); + } + + void add_dispatch (const std::string& type, const std::string& fname) + { + dispatch_map[type] = fname; + } + + void clear_dispatch (const std::string& type) + { + dispatch_map_iterator p = dispatch_map.find (type); + + if (p != dispatch_map.end ()) + dispatch_map.erase (p); + } + + void print_dispatch (std::ostream& os) const; + + std::string help_for_dispatch (void) const; + + dispatch_map_type get_dispatch (void) const { return dispatch_map; } + + void dump (std::ostream& os, const std::string& prefix) const; + + std::string name; + + // Scope id to function object. + std::map subfunctions; + + // Directory name to function object. + std::map private_functions; + + // Class name to function object. + std::map class_constructors; + + // Dispatch type to function object. + std::map class_methods; + + // Legacy dispatch map (dispatch type name to function name). + dispatch_map_type dispatch_map; + + octave_value cmdline_function; + + octave_value autoload_function; + + octave_value function_on_path; + + octave_value built_in_function; + + octave_refcount count; + + private: + + octave_value xfind (const octave_value_list& args, bool local_funcs); + + octave_value x_builtin_find (void); + + // No copying! + + fcn_info_rep (const fcn_info_rep&); + + fcn_info_rep& operator = (const fcn_info_rep&); + }; + + public: + + fcn_info (const std::string& nm = std::string ()) + : rep (new fcn_info_rep (nm)) { } + + fcn_info (const fcn_info& fi) : rep (fi.rep) + { + rep->count++; + } + + fcn_info& operator = (const fcn_info& fi) + { + if (this != &fi) + { + if (--rep->count == 0) + delete rep; + + rep = fi.rep; + rep->count++; + } + + return *this; + } + + ~fcn_info (void) + { + if (--rep->count == 0) + delete rep; + } + + octave_value find (const octave_value_list& args = octave_value_list (), + bool local_funcs = true) + { + return rep->find (args, local_funcs); + } + + octave_value builtin_find (void) + { + return rep->builtin_find (); + } + + octave_value find_method (const std::string& dispatch_type) const + { + return rep->find_method (dispatch_type); + } + + octave_value find_built_in_function (void) const + { + return rep->built_in_function; + } + + octave_value find_cmdline_function (void) const + { + return rep->cmdline_function; + } + + octave_value find_autoload (void) + { + return rep->find_autoload (); + } + + octave_value find_user_function (void) + { + return rep->find_user_function (); + } + + bool is_user_function_defined (void) const + { + return rep->is_user_function_defined (); + } + + octave_value find_function (const octave_value_list& args = octave_value_list (), + bool local_funcs = true) + { + return rep->find_function (args, local_funcs); + } + + void lock_subfunction (scope_id scope) + { + rep->lock_subfunction (scope); + } + + void unlock_subfunction (scope_id scope) + { + rep->unlock_subfunction (scope); + } + + std::pair + subfunction_defined_in_scope (scope_id scope = xcurrent_scope) const + { + return rep->subfunction_defined_in_scope (scope); + } + + void erase_subfunction (scope_id scope) + { + rep->erase_subfunction (scope); + } + + void mark_subfunction_in_scope_as_private (scope_id scope, + const std::string& class_name) + { + rep->mark_subfunction_in_scope_as_private (scope, class_name); + } + + void install_cmdline_function (const octave_value& f) + { + rep->install_cmdline_function (f); + } + + void install_subfunction (const octave_value& f, scope_id scope) + { + rep->install_subfunction (f, scope); + } + + void install_user_function (const octave_value& f) + { + rep->install_user_function (f); + } + + void install_built_in_function (const octave_value& f) + { + rep->install_built_in_function (f); + } + + void clear (void) { rep->clear (); } + + void clear_user_function (void) { rep->clear_user_function (); } + + void clear_autoload_function (void) { rep->clear_autoload_function (); } + + void clear_mex_function (void) { rep->clear_mex_function (); } + + void add_dispatch (const std::string& type, const std::string& fname) + { + rep->add_dispatch (type, fname); + } + + void clear_dispatch (const std::string& type) + { + rep->clear_dispatch (type); + } + + void print_dispatch (std::ostream& os) const + { + rep->print_dispatch (os); + } + + std::string help_for_dispatch (void) const { return rep->help_for_dispatch (); } + + dispatch_map_type get_dispatch (void) const + { + return rep->get_dispatch (); + } + + void + dump (std::ostream& os, const std::string& prefix = std::string ()) const + { + rep->dump (os, prefix); + } + + private: + + fcn_info_rep *rep; + }; + + static scope_id global_scope (void) { return xglobal_scope; } + static scope_id top_scope (void) { return xtop_scope; } + + static scope_id current_scope (void) { return xcurrent_scope; } + + static context_id current_context (void) { return xcurrent_context; } + + static scope_id alloc_scope (void) { return scope_id_cache::alloc (); } + + static void set_scope (scope_id scope) + { + if (scope == xglobal_scope) + error ("can't set scope to global"); + else if (scope != xcurrent_scope) + { + all_instances_iterator p = all_instances.find (scope); + + if (p == all_instances.end ()) + { + symbol_table *inst = new symbol_table (scope); + + if (inst) + all_instances[scope] = instance = inst; + } + else + instance = p->second; + + xcurrent_scope = scope; + xcurrent_context = 0; + } + } + + static void set_scope_and_context (scope_id scope, context_id context) + { + if (scope == xglobal_scope) + error ("can't set scope to global"); + else + { + if (scope != xcurrent_scope) + { + all_instances_iterator p = all_instances.find (scope); + + if (p == all_instances.end ()) + error ("scope not found!"); + else + { + instance = p->second; + + xcurrent_scope = scope; + + xcurrent_context = context; + } + } + else + xcurrent_context = context; + } + } + + static void erase_scope (scope_id scope) + { + assert (scope != xglobal_scope); + + all_instances_iterator p = all_instances.find (scope); + + if (p != all_instances.end ()) + { + delete p->second; + + all_instances.erase (p); + + free_scope (scope); + } + } + + static void erase_subfunctions_in_scope (scope_id scope) + { + for (fcn_table_iterator q = fcn_table.begin (); + q != fcn_table.end (); q++) + q->second.erase_subfunction (scope); + } + + static void + mark_subfunctions_in_scope_as_private (scope_id scope, + const std::string& class_name) + { + for (fcn_table_iterator q = fcn_table.begin (); + q != fcn_table.end (); q++) + q->second.mark_subfunction_in_scope_as_private (scope, class_name); + } + + static scope_id dup_scope (scope_id scope) + { + scope_id retval = -1; + + symbol_table *inst = get_instance (scope); + + if (inst) + { + scope_id new_scope = alloc_scope (); + + symbol_table *new_symbol_table = new symbol_table (scope); + + if (new_symbol_table) + { + all_instances[new_scope] = new_symbol_table; + + inst->do_dup_scope (*new_symbol_table); + + retval = new_scope; + } + } + + return retval; + } + + static std::list scopes (void) + { + return scope_id_cache::scopes (); + } + + static symbol_record + find_symbol (const std::string& name, scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + + return inst ? inst->do_find_symbol (name) : + symbol_record (scope); + } + + static void + inherit (scope_id scope, scope_id donor_scope, context_id donor_context) + { + symbol_table *inst = get_instance (scope); + + if (inst) + { + symbol_table *donor_symbol_table = get_instance (donor_scope); + + if (donor_symbol_table) + inst->do_inherit (*donor_symbol_table, donor_context); + } + } + + static bool at_top_level (void) { return xcurrent_scope == xtop_scope; } + + // Find a value corresponding to the given name in the table. + static octave_value + find (const std::string& name, + const octave_value_list& args = octave_value_list (), + bool skip_variables = false, + bool local_funcs = true); + + static octave_value builtin_find (const std::string& name); + + // Insert a new name in the table. + static symbol_record& insert (const std::string& name) + { + static symbol_record foobar; + + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_insert (name) : foobar; + } + + static void force_variable (const std::string& name, + scope_id scope = xcurrent_scope, + context_id context = xdefault_context) + { + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_force_variable (name, context); + } + + static octave_value& varref (const std::string& name, + scope_id scope = xcurrent_scope, + context_id context = xdefault_context) + { + static octave_value foobar; + + symbol_table *inst = get_instance (scope); + + return inst ? inst->do_varref (name, context) : foobar; + } + + static octave_value varval (const std::string& name, + scope_id scope = xcurrent_scope, + context_id context = xdefault_context) + { + symbol_table *inst = get_instance (scope); + + return inst ? inst->do_varval (name, context) : octave_value (); + } + + static octave_value& + global_varref (const std::string& name) + { + global_table_iterator p = global_table.find (name); + + return (p == global_table.end ()) ? global_table[name] : p->second; + } + + static octave_value + global_varval (const std::string& name) + { + global_table_const_iterator p = global_table.find (name); + + return (p != global_table.end ()) ? p->second : octave_value (); + } + + static octave_value& + top_level_varref (const std::string& name) + { + return varref (name, top_scope (), 0); + } + + static octave_value + top_level_varval (const std::string& name) + { + return varval (name, top_scope (), 0); + } + + static octave_value& persistent_varref (const std::string& name) + { + static octave_value foobar; + + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_persistent_varref (name) : foobar; + } + + static octave_value persistent_varval (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_persistent_varval (name) : octave_value (); + } + + static void erase_persistent (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_erase_persistent (name); + } + + static bool is_variable (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_is_variable (name) : false; + } + + static bool + is_built_in_function_name (const std::string& name) + { + octave_value val = find_built_in_function (name); + + return val.is_defined (); + } + + static octave_value + find_method (const std::string& name, const std::string& dispatch_type) + { + fcn_table_const_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + return p->second.find_method (dispatch_type); + else + { + fcn_info finfo (name); + + octave_value fcn = finfo.find_method (dispatch_type); + + if (fcn.is_defined ()) + fcn_table[name] = finfo; + + return fcn; + } + } + + static octave_value + find_built_in_function (const std::string& name) + { + fcn_table_const_iterator p = fcn_table.find (name); + + return (p != fcn_table.end ()) + ? p->second.find_built_in_function () : octave_value (); + } + + static octave_value + find_autoload (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + return (p != fcn_table.end ()) + ? p->second.find_autoload () : octave_value (); + } + + static octave_value + find_function (const std::string& name, + const octave_value_list& args = octave_value_list (), + bool local_funcs = true); + + static octave_value find_user_function (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + return (p != fcn_table.end ()) + ? p->second.find_user_function () : octave_value (); + } + + static void install_cmdline_function (const std::string& name, + const octave_value& fcn) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_cmdline_function (fcn); + } + else + { + fcn_info finfo (name); + + finfo.install_cmdline_function (fcn); + + fcn_table[name] = finfo; + } + } + + static void install_subfunction (const std::string& name, + const octave_value& fcn, + scope_id scope) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_subfunction (fcn, scope); + } + else + { + fcn_info finfo (name); + + finfo.install_subfunction (fcn, scope); + + fcn_table[name] = finfo; + } + } + + static void install_nestfunction (const std::string& name, + const octave_value& fcn, + scope_id parent_scope); + + static void update_nest (scope_id scope) + { + symbol_table *inst = get_instance (scope); + if (inst) + inst->do_update_nest (); + } + + static void install_user_function (const std::string& name, + const octave_value& fcn) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_user_function (fcn); + } + else + { + fcn_info finfo (name); + + finfo.install_user_function (fcn); + + fcn_table[name] = finfo; + } + } + + static void install_built_in_function (const std::string& name, + const octave_value& fcn) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_built_in_function (fcn); + } + else + { + fcn_info finfo (name); + + finfo.install_built_in_function (fcn); + + fcn_table[name] = finfo; + } + } + + static void clear (const std::string& name) + { + clear_variable (name); + } + + static void clear_all (void) + { + clear_variables (); + + clear_global_pattern ("*"); + + clear_functions (); + } + + static void clear_variables (scope_id scope) + { + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_clear_variables (); + } + + // This is split for unwind_protect. + static void clear_variables (void) + { + clear_variables (xcurrent_scope); + } + + static void clear_objects (scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_clear_objects (); + } + + static void unmark_forced_variables (scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_unmark_forced_variables (); + } + + static void clear_functions (void) + { + for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) + p->second.clear (); + } + + static void clear_function (const std::string& name) + { + clear_user_function (name); + } + + static void clear_global (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_global (name); + } + + static void clear_variable (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_variable (name); + } + + static void clear_symbol (const std::string& name) + { + // FIXME -- are we supposed to do both here? + + clear_variable (name); + clear_function (name); + } + + static void clear_function_pattern (const std::string& pat) + { + glob_match pattern (pat); + + for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) + { + if (pattern.match (p->first)) + p->second.clear_user_function (); + } + } + + static void clear_global_pattern (const std::string& pat) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_global_pattern (pat); + } + + static void clear_variable_pattern (const std::string& pat) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_variable_pattern (pat); + } + + static void clear_variable_regexp (const std::string& pat) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_variable_regexp (pat); + } + + static void clear_symbol_pattern (const std::string& pat) + { + // FIXME -- are we supposed to do both here? + + clear_variable_pattern (pat); + clear_function_pattern (pat); + } + + static void clear_user_function (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.clear_user_function (); + } + // FIXME -- is this necessary, or even useful? + // else + // error ("clear: no such function `%s'", name.c_str ()); + } + + // This clears oct and mex files, incl. autoloads. + static void clear_dld_function (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.clear_autoload_function (); + finfo.clear_user_function (); + } + } + + static void clear_mex_functions (void) + { + for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) + { + fcn_info& finfo = p->second; + + finfo.clear_mex_function (); + } + } + + static bool set_class_relationship (const std::string& sup_class, + const std::string& inf_class); + + static bool is_superiorto (const std::string& a, const std::string& b); + + static void alias_built_in_function (const std::string& alias, + const std::string& name) + { + octave_value fcn = find_built_in_function (name); + + if (fcn.is_defined ()) + { + fcn_info finfo (alias); + + finfo.install_built_in_function (fcn); + + fcn_table[alias] = finfo; + } + else + panic ("alias: `%s' is undefined", name.c_str ()); + } + + static void add_dispatch (const std::string& name, const std::string& type, + const std::string& fname) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.add_dispatch (type, fname); + } + else + { + fcn_info finfo (name); + + finfo.add_dispatch (type, fname); + + fcn_table[name] = finfo; + } + } + + static void clear_dispatch (const std::string& name, const std::string& type) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.clear_dispatch (type); + } + } + + static void print_dispatch (std::ostream& os, const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.print_dispatch (os); + } + } + + static fcn_info::dispatch_map_type get_dispatch (const std::string& name) + { + fcn_info::dispatch_map_type retval; + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + retval = finfo.get_dispatch (); + } + + return retval; + } + + static std::string help_for_dispatch (const std::string& name) + { + std::string retval; + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + retval = finfo.help_for_dispatch (); + } + + return retval; + } + + static void push_context (void) + { + if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) + error ("invalid call to xymtab::push_context"); + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_push_context (); + } + } + + static void pop_context (void) + { + if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) + error ("invalid call to xymtab::pop_context"); + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_pop_context (); + } + } + + // For unwind_protect. + static void pop_context (void *) { pop_context (); } + + static void mark_automatic (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_mark_automatic (name); + } + + static void mark_hidden (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_mark_hidden (name); + } + + static void mark_global (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_mark_global (name); + } + + static std::list + all_variables (scope_id scope = xcurrent_scope, + context_id context = xdefault_context, + bool defined_only = true) + { + symbol_table *inst = get_instance (scope); + + return inst + ? inst->do_all_variables (context, defined_only) : std::list (); + } + + static std::list glob (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_glob (pattern) : std::list (); + } + + static std::list regexp (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_regexp (pattern) : std::list (); + } + + static std::list glob_variables (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_glob (pattern, true) : std::list (); + } + + static std::list regexp_variables (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_regexp (pattern, true) : std::list (); + } + + static std::list + glob_global_variables (const std::string& pattern) + { + std::list retval; + + glob_match pat (pattern); + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + { + // We generate a list of symbol_record objects so that + // the results from glob_variables and glob_global_variables + // may be handled the same way. + + if (pat.match (p->first)) + retval.push_back (symbol_record (xglobal_scope, + p->first, p->second, + symbol_record::global)); + } + + return retval; + } + + static std::list + regexp_global_variables (const std::string& pattern) + { + std::list retval; + + ::regexp pat (pattern); + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + { + // We generate a list of symbol_record objects so that + // the results from regexp_variables and regexp_global_variables + // may be handled the same way. + + if (pat.is_match (p->first)) + retval.push_back (symbol_record (xglobal_scope, + p->first, p->second, + symbol_record::global)); + } + + return retval; + } + + static std::list glob_variables (const string_vector& patterns) + { + std::list retval; + + size_t len = patterns.length (); + + for (size_t i = 0; i < len; i++) + { + std::list tmp = glob_variables (patterns[i]); + + retval.insert (retval.begin (), tmp.begin (), tmp.end ()); + } + + return retval; + } + + static std::list regexp_variables + (const string_vector& patterns) + { + std::list retval; + + size_t len = patterns.length (); + + for (size_t i = 0; i < len; i++) + { + std::list tmp = regexp_variables (patterns[i]); + + retval.insert (retval.begin (), tmp.begin (), tmp.end ()); + } + + return retval; + } + + static std::list user_function_names (void) + { + std::list retval; + + for (fcn_table_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + if (p->second.is_user_function_defined ()) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; + } + + static std::list global_variable_names (void) + { + std::list retval; + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + retval.push_back (p->first); + + retval.sort (); + + return retval; + } + + static std::list top_level_variable_names (void) + { + symbol_table *inst = get_instance (xtop_scope); + + return inst ? inst->do_variable_names () : std::list (); + } + + static std::list variable_names (void) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_variable_names () : std::list (); + } + + static std::list built_in_function_names (void) + { + std::list retval; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + octave_value fcn = p->second.find_built_in_function (); + + if (fcn.is_defined ()) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; + } + + static std::list cmdline_function_names (void) + { + std::list retval; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + octave_value fcn = p->second.find_cmdline_function (); + + if (fcn.is_defined ()) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; + } + + static bool is_local_variable (const std::string& name) + { + if (xcurrent_scope == xglobal_scope) + return false; + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_is_local_variable (name) : false; + } + } + + static bool is_global (const std::string& name) + { + if (xcurrent_scope == xglobal_scope) + return true; + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_is_global (name) : false; + } + } + + static void dump (std::ostream& os, scope_id scope = xcurrent_scope); + + static void dump_global (std::ostream& os); + + static void dump_functions (std::ostream& os); + + static void cache_name (scope_id scope, const std::string& name) + { + symbol_table *inst = get_instance (scope, false); + + if (inst) + inst->do_cache_name (name); + } + + static void lock_subfunctions (scope_id scope = xcurrent_scope) + { + for (fcn_table_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + p->second.lock_subfunction (scope); + } + + static void unlock_subfunctions (scope_id scope = xcurrent_scope) + { + for (fcn_table_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + p->second.unlock_subfunction (scope); + } + + static void free_scope (scope_id scope) + { + if (scope == xglobal_scope || scope == xtop_scope) + error ("can't free global or top-level scopes!"); + else + symbol_table::scope_id_cache::free (scope); + } + + static void stash_dir_name_for_subfunctions (scope_id scope, + const std::string& dir_name); + + static void add_to_parent_map (const std::string& classname, + const std::list& parent_list) + { + parent_map[classname] = parent_list; + } + + static std::list + parent_classes (const std::string& dispatch_type) + { + std::list retval; + + const_parent_map_iterator it = parent_map.find (dispatch_type); + + if (it != parent_map.end ()) + retval = it->second; + + for (std::list::const_iterator lit = retval.begin (); + lit != retval.end (); lit++) + { + // Search for parents of parents and append them to the list. + + // FIXME -- should we worry about a circular inheritance graph? + + std::list parents = parent_classes (*lit); + + if (! parents.empty ()) + retval.insert (retval.end (), parents.begin (), parents.end ()); + } + + return retval; + } + + static octave_user_function *get_curr_fcn (scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + return inst->curr_fcn; + } + + static void set_curr_fcn (octave_user_function *curr_fcn, + scope_id scope = xcurrent_scope) + { + assert (scope != xtop_scope && scope != xglobal_scope); + symbol_table *inst = get_instance (scope); + // FIXME: normally, functions should not usurp each other's scope. + // If for any incredible reason this is needed, call + // set_user_function (0, scope) first. This may cause problems with + // nested functions, as the curr_fcn of symbol_records must be updated. + assert (inst->curr_fcn == 0 || curr_fcn == 0); + inst->curr_fcn = curr_fcn; + } + + static void cleanup (void); + +private: + + // No copying! + + symbol_table (const symbol_table&); + + symbol_table& operator = (const symbol_table&); + + typedef std::map::const_iterator table_const_iterator; + typedef std::map::iterator table_iterator; + + typedef std::map::const_iterator global_table_const_iterator; + typedef std::map::iterator global_table_iterator; + + typedef std::map::const_iterator persistent_table_const_iterator; + typedef std::map::iterator persistent_table_iterator; + + typedef std::map::const_iterator all_instances_const_iterator; + typedef std::map::iterator all_instances_iterator; + + typedef std::map::const_iterator fcn_table_const_iterator; + typedef std::map::iterator fcn_table_iterator; + + // The scope of this symbol table. + scope_id my_scope; + + // Name for this table (usually the file name of the function + // corresponding to the scope); + std::string table_name; + + // Map from symbol names to symbol info. + std::map table; + + // Child nested functions. + std::vector nest_children; + + // Parent nested function (may be null). + symbol_table *nest_parent; + + // The associated user code (may be null). + octave_user_function *curr_fcn; + + // Map from names of global variables to values. + static std::map global_table; + + // Map from names of persistent variables to values. + std::map persistent_table; + + // Pointer to symbol table for current scope (variables only). + static symbol_table *instance; + + // Map from scope id to symbol table instances. + static std::map all_instances; + + // Map from function names to function info (subfunctions, private + // functions, class constructors, class methods, etc.) + static std::map fcn_table; + + // Mape from class names to set of classes that have lower + // precedence. + static std::map > class_precedence_table; + + typedef std::map >::const_iterator class_precedence_table_const_iterator; + typedef std::map >::iterator class_precedence_table_iterator; + + // Map from class names to parent class names. + static std::map > parent_map; + + typedef std::map >::const_iterator const_parent_map_iterator; + typedef std::map >::iterator parent_map_iterator; + + static const scope_id xglobal_scope; + static const scope_id xtop_scope; + + static scope_id xcurrent_scope; + + static context_id xcurrent_context; + + static const context_id xdefault_context = static_cast (-1); + + symbol_table (scope_id scope) + : my_scope (scope), table_name (), table (), nest_children (), nest_parent (0), + curr_fcn (0), persistent_table () { } + + ~symbol_table (void) { } + + static symbol_table *get_instance (scope_id scope, bool create = true) + { + symbol_table *retval = 0; + + bool ok = true; + + if (scope != xglobal_scope) + { + if (scope == xcurrent_scope) + { + if (! instance && create) + { + symbol_table *inst = new symbol_table (scope); + + if (inst) + { + all_instances[scope] = instance = inst; + + if (scope == xtop_scope) + instance->do_cache_name ("top-level"); + } + } + + if (! instance) + ok = false; + + retval = instance; + } + else + { + all_instances_iterator p = all_instances.find (scope); + + if (p == all_instances.end ()) + { + if (create) + { + retval = new symbol_table (scope); + + if (retval) + all_instances[scope] = retval; + else + ok = false; + } + else + ok = false; + } + else + retval = p->second; + } + } + + if (! ok) + error ("unable to %s symbol_table object for scope %d!", + create ? "create" : "find", scope); + + return retval; + } + + void add_nest_child (symbol_table& st) + { + assert (!st.nest_parent); + nest_children.push_back (&st); + st.nest_parent = this; + } + + void insert_symbol_record (const symbol_record& sr) + { + table[sr.name ()] = sr; + } + + void + do_dup_scope (symbol_table& new_symbol_table) const + { + for (table_const_iterator p = table.begin (); p != table.end (); p++) + new_symbol_table.insert_symbol_record (p->second.dup (new_symbol_table.my_scope)); + } + + symbol_record do_find_symbol (const std::string& name) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + return do_insert (name); + else + return p->second; + } + + void do_inherit (symbol_table& donor_table, context_id donor_context) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (! (sr.is_automatic () || sr.is_formal ())) + { + std::string nm = sr.name (); + + if (nm != "__retval__") + { + octave_value val = donor_table.do_varval (nm, donor_context); + + if (val.is_defined ()) + { + sr.varref (0) = val; + + sr.mark_inherited (); + } + } + } + } + } + + static fcn_info *get_fcn_info (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + return p != fcn_table.end () ? &p->second : 0; + } + + octave_value + do_find (const std::string& name, const octave_value_list& args, + bool skip_variables, bool local_funcs); + + octave_value do_builtin_find (const std::string& name); + + symbol_record& do_insert (const std::string& name) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + { + symbol_record parent_symbol; + + if (nest_parent && nest_parent->look_nonlocal (name, parent_symbol)) + return table[name] = parent_symbol; + else + return table[name] = symbol_record (my_scope, name, octave_value ()); + } + else + return p->second; + } + + void do_force_variable (const std::string& name, context_id context) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + { + symbol_record& sr = do_insert (name); + + sr.force_variable (context); + } + else + p->second.force_variable (context); + } + + octave_value& do_varref (const std::string& name, context_id context) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + { + symbol_record& sr = do_insert (name); + + return sr.varref (context); + } + else + return p->second.varref (context); + } + + octave_value do_varval (const std::string& name, context_id context) const + { + table_const_iterator p = table.find (name); + + return (p != table.end ()) ? p->second.varval (context) : octave_value (); + } + + octave_value& do_persistent_varref (const std::string& name) + { + persistent_table_iterator p = persistent_table.find (name); + + return (p == persistent_table.end ()) + ? persistent_table[name] : p->second; + } + + octave_value do_persistent_varval (const std::string& name) + { + persistent_table_const_iterator p = persistent_table.find (name); + + return (p != persistent_table.end ()) ? p->second : octave_value (); + } + + void do_erase_persistent (const std::string& name) + { + persistent_table_iterator p = persistent_table.find (name); + + if (p != persistent_table.end ()) + persistent_table.erase (p); + } + + bool do_is_variable (const std::string& name) const + { + bool retval = false; + + table_const_iterator p = table.find (name); + + if (p != table.end ()) + { + const symbol_record& sr = p->second; + + retval = sr.is_variable (); + } + + return retval; + } + + void do_push_context (void) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + p->second.push_context (my_scope); + } + + void do_pop_context (void) + { + for (table_iterator p = table.begin (); p != table.end (); ) + { + if (p->second.pop_context (my_scope) == 0) + table.erase (p++); + else + p++; + } + } + + void do_clear_variables (void) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + p->second.clear (my_scope); + } + + void do_clear_objects (void) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + octave_value& val = sr.varref (); + if (val.is_object ()) + p->second.clear (my_scope); + } + } + + void do_unmark_forced_variables (void) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + p->second.unmark_forced (); + } + + void do_clear_global (const std::string& name) + { + table_iterator p = table.find (name); + + if (p != table.end ()) + { + symbol_record& sr = p->second; + + if (sr.is_global ()) + sr.unmark_global (); + } + + global_table_iterator q = global_table.find (name); + + if (q != global_table.end ()) + global_table.erase (q); + + } + + void do_clear_variable (const std::string& name) + { + table_iterator p = table.find (name); + + if (p != table.end ()) + p->second.clear (my_scope); + } + + void do_clear_global_pattern (const std::string& pat) + { + glob_match pattern (pat); + + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (sr.is_global () && pattern.match (sr.name ())) + sr.unmark_global (); + } + + + for (global_table_iterator q = global_table.begin (); + q != global_table.end ();) + { + if (pattern.match (q->first)) + global_table.erase (q++); //Gotta be careful to not + //invalidate iterators + else + q++; + } + + + } + + void do_clear_variable_pattern (const std::string& pat) + { + glob_match pattern (pat); + + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (sr.is_defined () || sr.is_global ()) + { + if (pattern.match (sr.name ())) + sr.clear (my_scope); + } + } + } + + void do_clear_variable_regexp (const std::string& pat) + { + ::regexp pattern (pat); + + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (sr.is_defined () || sr.is_global ()) + { + if (pattern.is_match (sr.name ())) + sr.clear (my_scope); + } + } + } + + void do_mark_automatic (const std::string& name) + { + do_insert (name).mark_automatic (); + } + + void do_mark_hidden (const std::string& name) + { + do_insert (name).mark_hidden (); + } + + void do_mark_global (const std::string& name) + { + do_insert (name).mark_global (); + } + + std::list + do_all_variables (context_id context, bool defined_only) const + { + std::list retval; + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + const symbol_record& sr = p->second; + + if (defined_only && ! sr.is_defined (context)) + continue; + + retval.push_back (sr); + } + + return retval; + } + + std::list do_glob (const std::string& pattern, + bool vars_only = false) const + { + std::list retval; + + glob_match pat (pattern); + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + if (pat.match (p->first)) + { + const symbol_record& sr = p->second; + + if (vars_only && ! sr.is_variable ()) + continue; + + retval.push_back (sr); + } + } + + return retval; + } + + std::list do_regexp (const std::string& pattern, + bool vars_only = false) const + { + std::list retval; + + ::regexp pat (pattern); + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + if (pat.is_match (p->first)) + { + const symbol_record& sr = p->second; + + if (vars_only && ! sr.is_variable ()) + continue; + + retval.push_back (sr); + } + } + + return retval; + } + + std::list do_variable_names (void) + { + std::list retval; + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + if (p->second.is_variable ()) + retval.push_back (p->first); + } + + retval.sort (); + + return retval; + } + + static std::map + subfunctions_defined_in_scope (scope_id scope = xcurrent_scope) + { + std::map retval; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + std::pair tmp + = p->second.subfunction_defined_in_scope (scope); + + std::string nm = tmp.first; + + if (! nm.empty ()) + retval[nm] = tmp.second; + } + + return retval; + } + + bool do_is_local_variable (const std::string& name) const + { + table_const_iterator p = table.find (name); + + return (p != table.end () + && ! p->second.is_global () + && p->second.is_defined ()); + } + + bool do_is_global (const std::string& name) const + { + table_const_iterator p = table.find (name); + + return p != table.end () && p->second.is_global (); + } + + void do_dump (std::ostream& os); + + void do_cache_name (const std::string& name) { table_name = name; } + + void do_update_nest (void); + + bool look_nonlocal (const std::string& name, symbol_record& result) + { + table_iterator p = table.find (name); + if (p == table.end ()) + { + if (nest_parent) + return nest_parent->look_nonlocal (name, result); + } + else if (! p->second.is_automatic ()) + { + result = p->second; + return true; + } + + return false; + } +}; + +extern bool out_of_date_check (octave_value& function, + const std::string& dispatch_type = std::string (), + bool check_relative = true); + +extern OCTINTERP_API std::string +get_dispatch_type (const octave_value_list& args); +extern OCTINTERP_API std::string +get_dispatch_type (const octave_value_list& args, builtin_type_t& builtin_type); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/sysdep.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/sysdep.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,905 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include + +#include +#include + +#include +#include + +#if defined (HAVE_TERMIOS_H) +#include +#elif defined (HAVE_TERMIO_H) +#include +#elif defined (HAVE_SGTTY_H) +#include +#endif + +#if defined (HAVE_CONIO_H) +#include +#endif + +#if defined (HAVE_SYS_IOCTL_H) +#include +#endif + +#if defined (HAVE_FLOATINGPOINT_H) +#include +#endif + +#if defined (HAVE_IEEEFP_H) +#include +#endif + +#include "cmd-edit.h" +#include "file-ops.h" +#include "lo-mappers.h" +#include "lo-math.h" +#include "mach-info.h" +#include "oct-env.h" +#include "quit.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "input.h" +#include "oct-obj.h" +#include "ov.h" +#include "pager.h" +#include "parse.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "toplev.h" +#include "utils.h" +#include "file-stat.h" + +#ifndef STDIN_FILENO +#define STDIN_FILENO 1 +#endif + +#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) +static void +BSD_init (void) +{ +#if defined (HAVE_FLOATINGPOINT_H) + // Disable trapping on common exceptions. +#ifndef FP_X_DNML +#define FP_X_DNML 0 +#endif + fpsetmask (~(FP_X_OFL|FP_X_INV|FP_X_DZ|FP_X_DNML|FP_X_UFL|FP_X_IMP)); +#endif +} +#endif + +#if defined (__WIN32__) && ! defined (_POSIX_VERSION) + +#define WIN32_LEAN_AND_MEAN +#include + +static void +w32_set_octave_home (void) +{ + std::string bin_dir; + + HANDLE h = CreateToolhelp32Snapshot (TH32CS_SNAPMODULE +#ifdef TH32CS_SNAPMODULE32 + | TH32CS_SNAPMODULE32 +#endif + , 0); + + if (h != INVALID_HANDLE_VALUE) + { + MODULEENTRY32 mod_info; + + ZeroMemory (&mod_info, sizeof (mod_info)); + mod_info.dwSize = sizeof (mod_info); + + if (Module32First (h, &mod_info)) + { + do + { + std::string mod_name (mod_info.szModule); + + if (mod_name.find ("octinterp") != std::string::npos) + { + bin_dir = mod_info.szExePath; + if (bin_dir[bin_dir.length () - 1] != '\\') + bin_dir.append (1, '\\'); + break; + } + } + while (Module32Next (h, &mod_info)); + } + + CloseHandle (h); + } + + if (! bin_dir.empty ()) + { + size_t pos = bin_dir.rfind ("\\bin\\"); + + if (pos != std::string::npos) + octave_env::putenv ("OCTAVE_HOME", bin_dir.substr (0, pos)); + } +} + +void +w32_set_quiet_shutdown (void) +{ + // Let the user close the console window or shutdown without the + // pesky dialog. + // + // FIXME -- should this be user configurable? + SetProcessShutdownParameters (0x280, SHUTDOWN_NORETRY); +} + +void +MINGW_signal_cleanup (void) +{ + w32_set_quiet_shutdown (); + + w32_raise_final (); +} +#endif + +#if defined (__MINGW32__) +static void +MINGW_init (void) +{ + w32_set_octave_home (); + + // Init mutex to protect setjmp/longjmp and get main thread context + w32_sigint_init (); + + w32_set_quiet_shutdown (); +} +#endif + +#if defined (_MSC_VER) +static void +MSVC_init (void) +{ + w32_set_octave_home (); + + // Init mutex to protect setjmp/longjmp and get main thread context + w32_sigint_init (); + + w32_set_quiet_shutdown (); +} +#endif + + +// Return TRUE if FILE1 and FILE2 refer to the same (physical) file. + +bool +same_file_internal (const std::string& file1, const std::string& file2) +{ +#ifdef OCTAVE_USE_WINDOWS_API + + bool retval = false; + + // Windows native code + // Reference: http://msdn2.microsoft.com/en-us/library/aa363788.aspx + + HANDLE hfile1 = CreateFile (file1.c_str (), 0, FILE_SHARE_READ, 0, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + + if (hfile1 != INVALID_HANDLE_VALUE) + { + HANDLE hfile2 = CreateFile (file2.c_str (), 0, FILE_SHARE_READ, 0, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + + if (hfile2 != INVALID_HANDLE_VALUE) + { + BY_HANDLE_FILE_INFORMATION hfi1; + BY_HANDLE_FILE_INFORMATION hfi2; + + if (GetFileInformationByHandle (hfile1, &hfi1) + && GetFileInformationByHandle (hfile2, &hfi2)) + + retval = (hfi1.dwVolumeSerialNumber == hfi2.dwVolumeSerialNumber + && hfi1.nFileIndexHigh == hfi2.nFileIndexHigh + && hfi1.nFileIndexLow == hfi2.nFileIndexLow); + + CloseHandle (hfile2); + } + + CloseHandle (hfile1); + } + + return retval; + +#else + + // POSIX Code + + file_stat fs_file1 (file1); + file_stat fs_file2 (file2); + + return (fs_file1 && fs_file2 + && fs_file1.ino () == fs_file2.ino () + && fs_file1.dev () == fs_file2.dev ()); + +#endif +} + +void +sysdep_init (void) +{ +#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) + BSD_init (); +#elif defined (__MINGW32__) + MINGW_init (); +#elif defined (_MSC_VER) + MSVC_init (); +#endif +} + +void +sysdep_cleanup (void) +{ + MINGW_SIGNAL_CLEANUP (); +} + +// Set terminal in raw mode. From less-177. +// +// Change terminal to "raw mode", or restore to "normal" mode. +// "Raw mode" means +// 1. An outstanding read will complete on receipt of a single keystroke. +// 2. Input is not echoed. +// 3. On output, \n is mapped to \r\n. +// 4. \t is NOT expanded into spaces. +// 5. Signal-causing characters such as ctrl-C (interrupt), +// etc. are NOT disabled. +// It doesn't matter whether an input \n is mapped to \r, or vice versa. + +void +raw_mode (bool on, bool wait) +{ + static bool curr_on = false; + + int tty_fd = STDIN_FILENO; + if (! gnulib::isatty (tty_fd)) + { + if (interactive) + error ("stdin is not a tty!"); + return; + } + + if (on == curr_on) + return; + +#if defined (HAVE_TERMIOS_H) + { + struct termios s; + static struct termios save_term; + + if (on) + { + // Get terminal modes. + + tcgetattr (tty_fd, &s); + + // Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.c_cflag & CBAUD; +// erase_char = s.c_cc[VERASE]; +// kill_char = s.c_cc[VKILL]; + + // Set the modes to the way we want them. + + s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); + s.c_oflag |= (OPOST|ONLCR); +#if defined (OCRNL) + s.c_oflag &= ~(OCRNL); +#endif +#if defined (ONOCR) + s.c_oflag &= ~(ONOCR); +#endif +#if defined (ONLRET) + s.c_oflag &= ~(ONLRET); +#endif + s.c_cc[VMIN] = wait ? 1 : 0; + s.c_cc[VTIME] = 0; + } + else + { + // Restore saved modes. + + s = save_term; + } + + tcsetattr (tty_fd, wait ? TCSAFLUSH : TCSADRAIN, &s); + } +#elif defined (HAVE_TERMIO_H) + { + struct termio s; + static struct termio save_term; + + if (on) + { + // Get terminal modes. + + ioctl (tty_fd, TCGETA, &s); + + // Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.c_cflag & CBAUD; +// erase_char = s.c_cc[VERASE]; +// kill_char = s.c_cc[VKILL]; + + // Set the modes to the way we want them. + + s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); + s.c_oflag |= (OPOST|ONLCR); +#if defined (OCRNL) + s.c_oflag &= ~(OCRNL); +#endif +#if defined (ONOCR) + s.c_oflag &= ~(ONOCR); +#endif +#if defined (ONLRET) + s.c_oflag &= ~(ONLRET); +#endif + s.c_cc[VMIN] = wait ? 1 : 0; + } + else + { + // Restore saved modes. + + s = save_term; + } + + ioctl (tty_fd, TCSETAW, &s); + } +#elif defined (HAVE_SGTTY_H) + { + struct sgttyb s; + static struct sgttyb save_term; + + if (on) + { + // Get terminal modes. + + ioctl (tty_fd, TIOCGETP, &s); + + // Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.sg_ospeed; +// erase_char = s.sg_erase; +// kill_char = s.sg_kill; + + // Set the modes to the way we want them. + + s.sg_flags |= CBREAK; + s.sg_flags &= ~(ECHO); + } + else + { + // Restore saved modes. + + s = save_term; + } + + ioctl (tty_fd, TIOCSETN, &s); + } +#else + warning ("no support for raw mode console I/O on this system"); + + // Make sure the current mode doesn't toggle. + on = curr_on; +#endif + + curr_on = on; +} + +FILE * +octave_popen (const char *command, const char *mode) +{ +#if defined (__MINGW32__) || defined (_MSC_VER) + if (mode && mode[0] && ! mode[1]) + { + char tmode[3]; + tmode[0] = mode[0]; + tmode[1] = 'b'; + tmode[2] = 0; + + return _popen (command, tmode); + } + else + return _popen (command, mode); +#else + return popen (command, mode); +#endif +} + +int +octave_pclose (FILE *f) +{ +#if defined (__MINGW32__) || defined (_MSC_VER) + return _pclose (f); +#else + return pclose (f); +#endif +} + +// Read one character from the terminal. + +int +octave_kbhit (bool wait) +{ +#ifdef HAVE__KBHIT + int c = (! wait && ! _kbhit ()) ? 0 : std::cin.get (); +#else + raw_mode (true, wait); + + // Get current handler. + octave_interrupt_handler saved_interrupt_handler + = octave_ignore_interrupts (); + + // Restore it, disabling system call restarts (if possible) so the + // read can be interrupted. + + octave_set_interrupt_handler (saved_interrupt_handler, false); + + int c = std::cin.get (); + + if (std::cin.fail () || std::cin.eof ()) + std::cin.clear (); + + // Restore it, enabling system call restarts (if possible). + octave_set_interrupt_handler (saved_interrupt_handler, true); + + raw_mode (false, true); +#endif + + return c; +} + +std::string +get_P_tmpdir (void) +{ +#if defined (__WIN32__) && ! defined (_POSIX_VERSION) + + std::string retval; + +#if defined (P_tmpdir) + retval = P_tmpdir; +#endif + + // Apparently some versions of MinGW and MSVC either don't define + // P_tmpdir, or they define it to a single backslash, neither of which + // is particularly helpful. + + if (retval.empty () || retval == "\\") + { + retval = octave_env::getenv ("TEMP"); + + if (retval.empty ()) + retval = octave_env::getenv ("TMP"); + + if (retval.empty ()) + retval = "c:\\temp"; + } + + return retval; + +#elif defined (P_tmpdir) + + return P_tmpdir; + +#else + + return "/tmp"; + +#endif +} + +DEFUN (clc, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} clc ()\n\ +@deftypefnx {Built-in Function} {} home ()\n\ +Clear the terminal screen and move the cursor to the upper left corner.\n\ +@end deftypefn") +{ + command_editor::clear_screen (); + + return octave_value_list (); +} + +DEFALIAS (home, clc); + +DEFUN (getenv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} getenv (@var{var})\n\ +Return the value of the environment variable @var{var}. For example,\n\ +\n\ +@example\n\ +getenv (\"PATH\")\n\ +@end example\n\ +\n\ +@noindent\n\ +returns a string containing the value of your path.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + retval = octave_env::getenv (name); + } + else + print_usage (); + + return retval; +} + +DEFUN (putenv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} putenv (@var{var}, @var{value})\n\ +@deftypefnx {Built-in Function} {} setenv (@var{var}, @var{value})\n\ +Set the value of the environment variable @var{var} to @var{value}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 1) + { + std::string var = args(0).string_value (); + + if (! error_state) + { + std::string val = (nargin == 2 + ? args(1).string_value () : std::string ()); + + if (! error_state) + octave_env::putenv (var, val); + else + error ("putenv: VALUE must be a string"); + } + else + error ("putenv: VAR must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFALIAS (setenv, putenv); + +/* +%!assert (ischar (getenv ("OCTAVE_HOME"))) +%!test +%! setenv ("dummy_variable_that_cannot_matter", "foobar"); +%! assert (getenv ("dummy_variable_that_cannot_matter"), "foobar"); +*/ + +// FIXME -- perhaps kbhit should also be able to print a prompt? + +DEFUN (kbhit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} kbhit ()\n\ +Read a single keystroke from the keyboard. If called with one\n\ +argument, don't wait for a keypress. For example,\n\ +\n\ +@example\n\ +x = kbhit ();\n\ +@end example\n\ +\n\ +@noindent\n\ +will set @var{x} to the next character typed at the keyboard as soon as\n\ +it is typed.\n\ +\n\ +@example\n\ +x = kbhit (1);\n\ +@end example\n\ +\n\ +@noindent\n\ +identical to the above example, but don't wait for a keypress,\n\ +returning the empty string if no key is available.\n\ +@end deftypefn") +{ + octave_value retval; + + // FIXME -- add timeout and default value args? + + if (interactive || forced_interactive) + { + feval ("drawnow"); + + int c = octave_kbhit (args.length () == 0); + + if (c == -1) + c = 0; + + char *s = new char [2]; + s[0] = c; + s[1] = '\0'; + retval = s; + } + + return retval; +} + +DEFUN (pause, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pause (@var{seconds})\n\ +Suspend the execution of the program. If invoked without any arguments,\n\ +Octave waits until you type a character. With a numeric argument, it\n\ +pauses for the given number of seconds. For example, the following\n\ +statement prints a message and then waits 5 seconds before clearing the\n\ +screen.\n\ +\n\ +@example\n\ +@group\n\ +fprintf (stderr, \"wait please...\\n\");\n\ +pause (5);\n\ +clc;\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (! (nargin == 0 || nargin == 1)) + { + print_usage (); + return retval; + } + + if (nargin == 1) + { + double dval = args(0).double_value (); + + if (! error_state) + { + if (! xisnan (dval)) + { + feval ("drawnow"); + + if (xisinf (dval)) + { + flush_octave_stdout (); + octave_kbhit (); + } + else + octave_sleep (dval); + } + else + warning ("pause: NaN is an invalid delay"); + } + } + else + { + feval ("drawnow"); + flush_octave_stdout (); + octave_kbhit (); + } + + return retval; +} + +/* +%!test +%! pause (1); + +%!error (pause (1, 2)) +*/ + +DEFUN (sleep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sleep (@var{seconds})\n\ +Suspend the execution of the program for the given number of seconds.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + double dval = args(0).double_value (); + + if (! error_state) + { + if (xisnan (dval)) + warning ("sleep: NaN is an invalid delay"); + else + { + feval ("drawnow"); + octave_sleep (dval); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! sleep (1); + +%!error (sleep ()) +%!error (sleep (1, 2)) +*/ + +DEFUN (usleep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} usleep (@var{microseconds})\n\ +Suspend the execution of the program for the given number of\n\ +microseconds. On systems where it is not possible to sleep for periods\n\ +of time less than one second, @code{usleep} will pause the execution for\n\ +@code{round (@var{microseconds} / 1e6)} seconds.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + double dval = args(0).double_value (); + + if (! error_state) + { + if (xisnan (dval)) + warning ("usleep: NaN is an invalid delay"); + else + { + feval ("drawnow"); + + int delay = NINT (dval); + + if (delay > 0) + octave_usleep (delay); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! usleep (1000); + +%!error (usleep ()) +%!error (usleep (1, 2)) +*/ + +// FIXME -- maybe this should only return 1 if IEEE floating +// point functions really work. + +DEFUN (isieee, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isieee ()\n\ +Return true if your computer @emph{claims} to conform to the IEEE standard\n\ +for floating point calculations. No actual tests are performed.\n\ +@end deftypefn") +{ + oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); + + return octave_value (flt_fmt == oct_mach_info::flt_fmt_ieee_little_endian + || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); +} + +/* +%!assert (islogical (isieee ())) +*/ + +DEFUN (native_float_format, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} native_float_format ()\n\ +Return the native floating point format as a string\n\ +@end deftypefn") +{ + oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); + + return octave_value (oct_mach_info::float_format_as_string (flt_fmt)); +} + +/* +%!assert (ischar (native_float_format ())) +*/ + +DEFUN (tilde_expand, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} tilde_expand (@var{string})\n\ +Perform tilde expansion on @var{string}. If @var{string} begins with a\n\ +tilde character, (@samp{~}), all of the characters preceding the first\n\ +slash (or all characters, if there is no slash) are treated as a\n\ +possible user name, and the tilde and the following characters up to the\n\ +slash are replaced by the home directory of the named user. If the\n\ +tilde is followed immediately by a slash, the tilde is replaced by the\n\ +home directory of the user running Octave. For example:\n\ +\n\ +@example\n\ +@group\n\ +tilde_expand (\"~joeuser/bin\")\n\ + @result{} \"/home/joeuser/bin\"\n\ +tilde_expand (\"~/bin\")\n\ + @result{} \"/home/jwe/bin\"\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value arg = args(0); + + string_vector sv = arg.all_strings (); + + if (! error_state) + { + sv = file_ops::tilde_expand (sv); + + if (arg.is_cellstr ()) + retval = Cell (arg.dims (), sv); + else + retval = sv; + } + else + error ("tilde_expand: expecting argument to be char or cellstr object"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! if (isempty (getenv ("HOME"))) +%! setenv ("HOME", "foobar"); +%! endif +%! home = getenv ("HOME"); +%! assert (tilde_expand ("~/foobar"), strcat (home, "/foobar")); +%! assert (tilde_expand ("/foo/bar"), "/foo/bar"); +%! assert (tilde_expand ("foo/bar"), "foo/bar"); +*/ diff -r d02b229ce693 -r a132d206a36a src/interpfcn/sysdep.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/sysdep.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,58 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_sysdep_h) +#define octave_sysdep_h 1 + +#include + +#include + +#include "lo-ieee.h" +#include "lo-sysdep.h" + +extern void sysdep_init (void); + +extern void sysdep_cleanup (void); + +extern OCTINTERP_API void raw_mode (bool, bool wait = true); + +extern OCTINTERP_API FILE *octave_popen (const char *command, const char *mode); +extern OCTINTERP_API int octave_pclose (FILE *f); + +extern OCTINTERP_API int octave_kbhit (bool wait = true); + +extern OCTINTERP_API std::string get_P_tmpdir (void); + +extern void w32_set_quiet_shutdown (void); + +#if defined (__WIN32__) && ! defined (_POSIX_VERSION) +extern void MINGW_signal_cleanup (void); +#define USE_W32_SIGINT 1 +#define MINGW_SIGNAL_CLEANUP() MINGW_signal_cleanup () +#else +#define MINGW_SIGNAL_CLEANUP() do { } while (0) +#endif + +extern OCTINTERP_API bool same_file_internal (const std::string&, const std::string&); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/toplev.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/toplev.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1537 @@ +/* + +Copyright (C) 1995-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include + +#include +#include +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "cmd-hist.h" +#include "file-ops.h" +#include "lo-error.h" +#include "lo-mappers.h" +#include "oct-env.h" +#include "oct-locbuf.h" +#include "quit.h" +#include "singleton-cleanup.h" +#include "str-vec.h" + +#include "defaults.h" +#include "defun.h" +#include "error.h" +#include "file-io.h" +#include "graphics.h" +#include "input.h" +#include "lex.h" +#include "oct-conf.h" +#include "oct-hist.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "ov.h" +#include "pager.h" +#include "parse.h" +#include "pathsearch.h" +#include "procstream.h" +#include "pt-eval.h" +#include "pt-jump.h" +#include "pt-stmt.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "syswait.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" + +void (*octave_exit) (int) = ::exit; + +// TRUE means the quit() call is allowed. +bool quit_allowed = true; + +// TRUE means we are exiting via the builtin exit or quit functions. +bool quitting_gracefully = false; +// This stores the exit status. +int exit_status = 0; + +// TRUE means we are ready to interpret commands, but not everything +// is ready for interactive use. +bool octave_interpreter_ready = false; + +// TRUE means we've processed all the init code and we are good to go. +bool octave_initialized = false; + +// Current command to execute. +tree_statement_list *global_command = 0; + +octave_call_stack *octave_call_stack::instance = 0; + +void +octave_call_stack::create_instance (void) +{ + instance = new octave_call_stack (); + + if (instance) + { + instance->do_push (0, symbol_table::top_scope (), 0); + + singleton_cleanup_list::add (cleanup_instance); + } +} + +int +octave_call_stack::do_current_line (void) const +{ + tree_statement *stmt = do_current_statement (); + + return stmt ? stmt->line () : -1; +} + +int +octave_call_stack::do_current_column (void) const +{ + tree_statement *stmt = do_current_statement (); + + return stmt ? stmt->column () : -1; +} + +int +octave_call_stack::do_caller_user_code_line (void) const +{ + int retval = -1; + + const_iterator p = cs.end (); + + while (p != cs.begin ()) + { + const call_stack_elt& elt = *(--p); + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + tree_statement *stmt = elt.stmt; + + if (stmt) + { + retval = stmt->line (); + break; + } + } + } + + return retval; +} + +int +octave_call_stack::do_caller_user_code_column (void) const +{ + int retval = -1; + + const_iterator p = cs.end (); + + while (p != cs.begin ()) + { + const call_stack_elt& elt = *(--p); + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + tree_statement *stmt = elt.stmt; + + if (stmt) + { + retval = stmt->column (); + break; + } + } + } + + return retval; +} + +size_t +octave_call_stack::do_num_user_code_frames (octave_idx_type& curr_user_frame) const +{ + size_t retval = 0; + + curr_user_frame = 0; + + // Look for the caller of dbstack. + size_t frame = cs[curr_frame].prev; + + bool found = false; + + size_t k = cs.size (); + + for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) + { + octave_function *f = (*p).fcn; + + if (--k == frame) + found = true; + + if (f && f->is_user_code ()) + { + if (! found) + curr_user_frame++; + + retval++; + } + } + + // We counted how many user frames were not the one, in reverse. + // Now set curr_user_frame to be the index in the other direction. + curr_user_frame = retval - curr_user_frame - 1; + + return retval; +} + +octave_user_code * +octave_call_stack::do_caller_user_code (size_t nskip) const +{ + octave_user_code *retval = 0; + + const_iterator p = cs.end (); + + while (p != cs.begin ()) + { + const call_stack_elt& elt = *(--p); + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + if (nskip > 0) + nskip--; + else + { + retval = dynamic_cast (f); + break; + } + } + } + + return retval; +} + +// Use static fields for the best efficiency. +// NOTE: C++0x will allow these two to be merged into one. +static const char *bt_fieldnames[] = { "file", "name", "line", + "column", "scope", "context", 0 }; +static const octave_fields bt_fields (bt_fieldnames); + +octave_map +octave_call_stack::empty_backtrace (void) +{ + return octave_map (dim_vector (0, 1), bt_fields); +} + +octave_map +octave_call_stack::do_backtrace (size_t nskip, + octave_idx_type& curr_user_frame) const +{ + size_t user_code_frames = do_num_user_code_frames (curr_user_frame); + + size_t nframes = nskip <= user_code_frames ? user_code_frames - nskip : 0; + + // Our list is reversed. + curr_user_frame = nframes - curr_user_frame - 1; + + octave_map retval (dim_vector (nframes, 1), bt_fields); + + Cell& file = retval.contents (0); + Cell& name = retval.contents (1); + Cell& line = retval.contents (2); + Cell& column = retval.contents (3); + Cell& scope = retval.contents (4); + Cell& context = retval.contents (5); + + if (nframes > 0) + { + int k = 0; + + for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) + { + const call_stack_elt& elt = *p; + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + if (nskip > 0) + nskip--; + else + { + scope(k) = elt.scope; + context(k) = elt.context; + + file(k) = f->fcn_file_name (); + std::string parent_fcn_name = f->parent_fcn_name (); + if (parent_fcn_name == std::string ()) + name(k) = f->name (); + else + name(k) = f->parent_fcn_name () + Vfilemarker + f->name (); + + tree_statement *stmt = elt.stmt; + + if (stmt) + { + line(k) = stmt->line (); + column(k) = stmt->column (); + } + else + { + line(k) = -1; + column(k) = -1; + } + + k++; + } + } + } + } + + return retval; +} + +bool +octave_call_stack::do_goto_frame (size_t n, bool verbose) +{ + bool retval = false; + + if (n < cs.size ()) + { + retval = true; + + curr_frame = n; + + const call_stack_elt& elt = cs[n]; + + symbol_table::set_scope_and_context (elt.scope, elt.context); + + if (verbose) + { + octave_function *f = elt.fcn; + std::string nm = f ? f->name () : std::string (""); + + tree_statement *s = elt.stmt; + int l = -1; + int c = -1; + if (s) + { + l = s->line (); + c = s->column (); + } + + octave_stdout << "stopped in " << nm + << " at line " << l << " column " << c + << " (" << elt.scope << "[" << elt.context << "])" + << std::endl; + } + } + + return retval; +} + +bool +octave_call_stack::do_goto_frame_relative (int nskip, bool verbose) +{ + bool retval = false; + + int incr = 0; + + if (nskip < 0) + incr = -1; + else if (nskip > 0) + incr = 1; + + // Start looking with the caller of dbup/dbdown/keyboard. + size_t frame = cs[curr_frame].prev; + + while (true) + { + if ((incr < 0 && frame == 0) || (incr > 0 && frame == cs.size () - 1)) + break; + + frame += incr; + + const call_stack_elt& elt = cs[frame]; + + octave_function *f = elt.fcn; + + if (frame == 0 || (f && f->is_user_code ())) + { + if (nskip > 0) + nskip--; + else if (nskip < 0) + nskip++; + + if (nskip == 0) + { + curr_frame = frame; + cs[cs.size () - 1].prev = curr_frame; + + symbol_table::set_scope_and_context (elt.scope, elt.context); + + if (verbose) + { + std::ostringstream buf; + + if (f) + { + tree_statement *s = elt.stmt; + + int l = s ? s->line () : -1; + + buf << "stopped in " << f->name () + << " at line " << l << std::endl; + } + else + buf << "at top level" << std::endl; + + octave_stdout << buf.str (); + } + + retval = true; + break; + } + } + + // There is no need to set scope and context here. That will + // happen when the dbup/dbdown/keyboard frame is popped and we + // jump to the new "prev" frame set above. + } + + return retval; +} + +void +octave_call_stack::do_goto_caller_frame (void) +{ + size_t frame = curr_frame; + + bool skipped = false; + + while (frame != 0) + { + frame = cs[frame].prev; + + const call_stack_elt& elt = cs[frame]; + + octave_function *f = elt.fcn; + + if (frame == 0 || (f && f->is_user_code ())) + { + if (! skipped) + // We found the current user code frame, so skip it. + skipped = true; + else + { + // We found the caller user code frame. + call_stack_elt tmp (elt); + tmp.prev = curr_frame; + + curr_frame = cs.size (); + + cs.push_back (tmp); + + symbol_table::set_scope_and_context (tmp.scope, tmp.context); + + break; + } + } + } +} + +void +octave_call_stack::do_goto_base_frame (void) +{ + call_stack_elt tmp (cs[0]); + tmp.prev = curr_frame; + + curr_frame = cs.size (); + + cs.push_back (tmp); + + symbol_table::set_scope_and_context (tmp.scope, tmp.context); +} + +void +octave_call_stack::do_backtrace_error_message (void) const +{ + if (error_state > 0) + { + error_state = -1; + + error ("called from:"); + } + + if (! cs.empty ()) + { + const call_stack_elt& elt = cs.back (); + + octave_function *fcn = elt.fcn; + tree_statement *stmt = elt.stmt; + + std::string fcn_name = "?unknown?"; + + if (fcn) + { + fcn_name = fcn->fcn_file_name (); + + if (fcn_name.empty ()) + fcn_name = fcn->name (); + } + + int line = stmt ? stmt->line () : -1; + int column = stmt ? stmt->column () : -1; + + error (" %s at line %d, column %d", + fcn_name.c_str (), line, column); + } +} + +void +recover_from_exception (void) +{ + can_interrupt = true; + octave_interrupt_immediately = 0; + octave_interrupt_state = 0; + octave_signal_caught = 0; + octave_exception_state = octave_no_exception; + octave_restore_signal_mask (); + octave_catch_interrupts (); +} + +int +main_loop (void) +{ + octave_save_signal_mask (); + + can_interrupt = true; + + octave_signal_hook = octave_signal_handler; + octave_interrupt_hook = 0; + octave_bad_alloc_hook = 0; + + octave_catch_interrupts (); + + octave_initialized = true; + + // The big loop. + + int retval = 0; + do + { + try + { + unwind_protect frame; + + reset_error_handler (); + + reset_parser (); + + if (symbol_table::at_top_level ()) + tree_evaluator::reset_debug_state (); + + // Do this with an unwind-protect cleanup function so that + // the forced variables will be unmarked in the event of an + // interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); + + frame.protect_var (global_command); + + global_command = 0; + + // This is the same as yyparse in parse.y. + retval = octave_parse (); + + if (retval == 0) + { + if (global_command) + { + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of + // an interrupt. + + frame.add_fcn (cleanup_statement_list, &global_command); + + global_command->accept (*current_evaluator); + + octave_quit (); + + if (! (interactive || forced_interactive)) + { + bool quit = (tree_return_command::returning + || tree_break_command::breaking); + + if (tree_return_command::returning) + tree_return_command::returning = 0; + + if (tree_break_command::breaking) + tree_break_command::breaking--; + + if (quit) + break; + } + + if (error_state) + { + if (! (interactive || forced_interactive)) + { + // We should exit with a non-zero status. + retval = 1; + break; + } + } + else + { + if (octave_completion_matches_called) + octave_completion_matches_called = false; + else + command_editor::increment_current_command_number (); + } + } + else if (parser_end_of_input) + break; + } + } + catch (octave_interrupt_exception) + { + recover_from_exception (); + octave_stdout << "\n"; + if (quitting_gracefully) + { + clean_up_and_exit (exit_status); + break; // If user has overriden the exit func. + } + } + catch (octave_execution_exception) + { + recover_from_exception (); + std::cerr + << "error: unhandled execution exception -- trying to return to prompt" + << std::endl; + } + catch (std::bad_alloc) + { + recover_from_exception (); + std::cerr + << "error: memory exhausted or requested size too large for range of Octave's index type -- trying to return to prompt" + << std::endl; + } + } + while (retval == 0); + + return retval; +} + +// Fix up things before exiting. + +void +clean_up_and_exit (int retval) +{ + do_octave_atexit (); + + if (octave_exit) + (*octave_exit) (retval == EOF ? 0 : retval); +} + +DEFUN (quit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} exit (@var{status})\n\ +@deftypefnx {Built-in Function} {} quit (@var{status})\n\ +Exit the current Octave session. If the optional integer value\n\ +@var{status} is supplied, pass that value to the operating system as the\n\ +Octave's exit status. The default value is zero.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (! quit_allowed) + error ("quit: not supported in embedded mode"); + else + { + if (args.length () > 0) + { + int tmp = args(0).nint_value (); + + if (! error_state) + exit_status = tmp; + } + + if (! error_state) + { + // Instead of simply calling exit, we simulate an interrupt + // with a request to exit cleanly so that no matter where the + // call to quit occurs, we will run the unwind_protect stack, + // clear the OCTAVE_LOCAL_BUFFER allocations, etc. before + // exiting. + + quitting_gracefully = true; + + octave_interrupt_state = -1; + + octave_throw_interrupt_exception (); + } + } + + return retval; +} + +DEFALIAS (exit, quit); + +DEFUN (warranty, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} warranty ()\n\ +Describe the conditions for copying and distributing Octave.\n\ +@end deftypefn") +{ + octave_value_list retval; + + octave_stdout << "\n" \ + OCTAVE_NAME_VERSION_AND_COPYRIGHT "\n\ +\n\ +GNU Octave free software; you can redistribute it and/or modify\n\ +it under the terms of the GNU General Public License as published by\n\ +the Free Software Foundation; either version 3 of the License, or\n\ +(at your option) any later version.\n\ +\n\ +GNU Octave is distributed in the hope that it will be useful,\n\ +but WITHOUT ANY WARRANTY; without even the implied warranty of\n\ +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n\ +GNU General Public License for more details.\n\ +\n\ +You should have received a copy of the GNU General Public License\n\ +along with this program. If not, see .\n\ +\n"; + + return retval; +} + +// Execute a shell command. + +static int +wait_for_input (int fid) +{ + int retval = -1; + +#if defined (HAVE_SELECT) + if (fid >= 0) + { + fd_set set; + + FD_ZERO (&set); + FD_SET (fid, &set); + + retval = gnulib::select (FD_SETSIZE, &set, 0, 0, 0); + } +#else + retval = 1; +#endif + + return retval; +} + +static octave_value_list +run_command_and_return_output (const std::string& cmd_str) +{ + octave_value_list retval; + unwind_protect frame; + + iprocstream *cmd = new iprocstream (cmd_str.c_str ()); + + frame.add_delete (cmd); + frame.add_fcn (octave_child_list::remove, cmd->pid ()); + + if (*cmd) + { + int fid = cmd->file_number (); + + std::ostringstream output_buf; + + char ch; + + for (;;) + { + if (cmd->get (ch)) + output_buf.put (ch); + else + { + if (! cmd->eof () && errno == EAGAIN) + { + cmd->clear (); + + if (wait_for_input (fid) != 1) + break; + } + else + break; + } + } + + int cmd_status = cmd->close (); + + if (WIFEXITED (cmd_status)) + cmd_status = WEXITSTATUS (cmd_status); + else + cmd_status = 127; + + retval(1) = output_buf.str (); + retval(0) = cmd_status; + } + else + error ("unable to start subprocess for `%s'", cmd_str.c_str ()); + + return retval; +} + +enum system_exec_type { et_sync, et_async }; + +DEFUN (system, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} system (\"@var{string}\")\n\ +@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output})\n\ +@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output}, @var{type})\n\ +@deftypefnx {Built-in Function} {[@var{status}, @var{output}] =} system (@dots{})\n\ +Execute a shell command specified by @var{string}.\n\ +If the optional argument @var{type} is \"async\", the process\n\ +is started in the background and the process ID of the child process\n\ +is returned immediately. Otherwise, the child process is started and\n\ +Octave waits until it exits. If the @var{type} argument is omitted, it\n\ +defaults to the value \"sync\".\n\ +\n\ +If @var{system} is called with one or more output arguments, or if the\n\ +optional argument @var{return_output} is true and the subprocess is started\n\ +synchronously, then the output from the command is returned as a variable. \n\ +Otherwise, if the subprocess is executed synchronously, its output is sent\n\ +to the standard output. To send the output of a command executed with\n\ +@code{system} through the pager, use a command like\n\ +\n\ +@example\n\ +@group\n\ +[output, text] = system (\"cmd\");\n\ +disp (text);\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +or\n\ +\n\ +@example\n\ +printf (\"%s\\n\", nthargout (2, \"system\", \"cmd\"));\n\ +@end example\n\ +\n\ +The @code{system} function can return two values. The first is the\n\ +exit status of the command and the second is any output from the\n\ +command that was written to the standard output stream. For example,\n\ +\n\ +@example\n\ +[status, output] = system (\"echo foo; exit 2\");\n\ +@end example\n\ +\n\ +@noindent\n\ +will set the variable @code{output} to the string @samp{foo}, and the\n\ +variable @code{status} to the integer @samp{2}.\n\ +\n\ +For commands run asynchronously, @var{status} is the process id of the\n\ +command shell that is started to run the command.\n\ +@seealso{unix, dos}\n\ +@end deftypefn") +{ + octave_value_list retval; + + unwind_protect frame; + + int nargin = args.length (); + + if (nargin > 0 && nargin < 4) + { + bool return_output = (nargin == 1 && nargout > 1); + + system_exec_type type = et_sync; + + if (nargin == 3) + { + std::string type_str = args(2).string_value (); + + if (! error_state) + { + if (type_str == "sync") + type = et_sync; + else if (type_str == "async") + type = et_async; + else + { + error ("system: TYPE must be \"sync\" or \"async\""); + return retval; + } + } + else + { + error ("system: TYPE must be a character string"); + return retval; + } + } + + if (nargin > 1) + { + return_output = args(1).is_true (); + + if (error_state) + { + error ("system: RETURN_OUTPUT must be boolean value true or false"); + return retval; + } + } + + if (return_output && type == et_async) + { + error ("system: can't return output from commands run asynchronously"); + return retval; + } + + std::string cmd_str = args(0).string_value (); + + if (! error_state) + { +#if defined (__WIN32__) && ! defined (__CYGWIN__) + // Work around weird double-quote handling on Windows systems. + if (type == et_sync) + cmd_str = "\"" + cmd_str + "\""; +#endif + + if (type == et_async) + { + // FIXME -- maybe this should go in sysdep.cc? +#ifdef HAVE_FORK + pid_t pid = fork (); + + if (pid < 0) + error ("system: fork failed -- can't create child process"); + else if (pid == 0) + { + // FIXME -- should probably replace this + // call with something portable. + + execl ("/bin/sh", "sh", "-c", cmd_str.c_str (), + static_cast (0)); + + panic_impossible (); + } + else + retval(0) = pid; +#elif defined (__WIN32__) + STARTUPINFO si; + PROCESS_INFORMATION pi; + ZeroMemory (&si, sizeof (si)); + ZeroMemory (&pi, sizeof (pi)); + OCTAVE_LOCAL_BUFFER (char, xcmd_str, cmd_str.length ()+1); + strcpy (xcmd_str, cmd_str.c_str ()); + + if (! CreateProcess (0, xcmd_str, 0, 0, FALSE, 0, 0, 0, &si, &pi)) + error ("system: CreateProcess failed -- can't create child process"); + else + { + retval(0) = pi.dwProcessId; + CloseHandle (pi.hProcess); + CloseHandle (pi.hThread); + } +#else + error ("asynchronous system calls are not supported"); +#endif + } + else if (return_output) + retval = run_command_and_return_output (cmd_str); + else + { + int status = system (cmd_str.c_str ()); + + // The value in status is as returned by waitpid. If + // the process exited normally, extract the actual exit + // status of the command. Otherwise, return 127 as a + // failure code. + + if (WIFEXITED (status)) + status = WEXITSTATUS (status); + + retval(0) = status; + } + } + else + error ("system: expecting string as first argument"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! cmd = ls_command (); +%! [status, output] = system (cmd); +%! assert (status, 0); +%! assert (ischar (output)); +%! assert (! isempty (output)); + +%!error system () +%!error system (1, 2, 3) +*/ + +// FIXME -- this should really be static, but that causes +// problems on some systems. +std::list octave_atexit_functions; + +void +do_octave_atexit (void) +{ + static bool deja_vu = false; + + while (! octave_atexit_functions.empty ()) + { + std::string fcn = octave_atexit_functions.front (); + + octave_atexit_functions.pop_front (); + + OCTAVE_SAFE_CALL (reset_error_handler, ()); + + OCTAVE_SAFE_CALL (feval, (fcn, octave_value_list (), 0)); + + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); + } + + if (! deja_vu) + { + deja_vu = true; + + // Do this explicitly so that destructors for mex file objects + // are called, so that functions registered with mexAtExit are + // called. + OCTAVE_SAFE_CALL (clear_mex_functions, ()); + + OCTAVE_SAFE_CALL (command_editor::restore_terminal_state, ()); + + // FIXME -- is this needed? Can it cause any trouble? + OCTAVE_SAFE_CALL (raw_mode, (0)); + + OCTAVE_SAFE_CALL (octave_history_write_timestamp, ()); + + if (! command_history::ignoring_entries ()) + OCTAVE_SAFE_CALL (command_history::clean_up_and_save, ()); + + OCTAVE_SAFE_CALL (gh_manager::close_all_figures, ()); + + OCTAVE_SAFE_CALL (gtk_manager::unload_all_toolkits, ()); + + OCTAVE_SAFE_CALL (close_files, ()); + + OCTAVE_SAFE_CALL (cleanup_tmp_files, ()); + + OCTAVE_SAFE_CALL (symbol_table::cleanup, ()); + + OCTAVE_SAFE_CALL (cleanup_parser, ()); + + OCTAVE_SAFE_CALL (sysdep_cleanup, ()); + + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); + + if (! quitting_gracefully && (interactive || forced_interactive)) + { + octave_stdout << "\n"; + + // Yes, we want this to be separate from the call to + // flush_octave_stdout above. + + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); + } + + // Don't call singleton_cleanup_list::cleanup until we have the + // problems with registering/unregistering types worked out. For + // example, uncomment the following line, then use the make_int + // function from the examples directory to create an integer + // object and then exit Octave. Octave should crash with a + // segfault when cleaning up the typinfo singleton. We need some + // way to force new octave_value_X types that are created in + // .oct files to be unregistered when the .oct file shared library + // is unloaded. + // + // OCTAVE_SAFE_CALL (singleton_cleanup_list::cleanup, ()); + + OCTAVE_SAFE_CALL (octave_chunk_buffer::clear, ()); + } +} + +void +octave_add_atexit_function (const std::string& fname) +{ + octave_atexit_functions.push_front (fname); +} + +bool +octave_remove_atexit_function (const std::string& fname) +{ + bool found = false; + + for (std::list::iterator p = octave_atexit_functions.begin (); + p != octave_atexit_functions.end (); p++) + { + if (*p == fname) + { + octave_atexit_functions.erase (p); + found = true; + break; + } + } + + return found; +} + + +DEFUN (atexit, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} atexit (@var{fcn})\n\ +@deftypefnx {Built-in Function} {} atexit (@var{fcn}, @var{flag})\n\ +Register a function to be called when Octave exits. For example,\n\ +\n\ +@example\n\ +@group\n\ +function last_words ()\n\ + disp (\"Bye bye\");\n\ +endfunction\n\ +atexit (\"last_words\");\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +will print the message \"Bye bye\" when Octave exits.\n\ +\n\ +The additional argument @var{flag} will register or unregister\n\ +@var{fcn} from the list of functions to be called when Octave\n\ +exits. If @var{flag} is true, the function is registered, and if\n\ +@var{flag} is false, it is unregistered. For example,\n\ +after registering the function @code{last_words} above,\n\ +\n\ +@example\n\ +atexit (\"last_words\", false);\n\ +@end example\n\ +\n\ +@noindent\n\ +will remove the function from the list and Octave will not call\n\ +@code{last_words} when it exits.\n\ +\n\ +Note that @code{atexit} only removes the first occurrence of a function\n\ +from the list, so if a function was placed in the list multiple\n\ +times with @code{atexit}, it must also be removed from the list\n\ +multiple times.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string arg = args(0).string_value (); + + if (! error_state) + { + bool add_mode = true; + + if (nargin == 2) + { + add_mode = args(1).bool_value (); + + if (error_state) + error ("atexit: FLAG argument must be a logical value"); + } + + if (! error_state) + { + if (add_mode) + octave_add_atexit_function (arg); + else + { + bool found = octave_remove_atexit_function (arg); + + if (nargout > 0) + retval(0) = found; + } + } + } + else + error ("atexit: FCN argument must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (octave_config_info, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} octave_config_info ()\n\ +@deftypefnx {Built-in Function} {} octave_config_info (@var{option})\n\ +Return a structure containing configuration and installation\n\ +information for Octave.\n\ +\n\ +If @var{option} is a string, return the configuration information for the\n\ +specified option.\n\ +\n\ +@end deftypefn") +{ + octave_value retval; + +#if defined (ENABLE_DYNAMIC_LINKING) + bool octave_supports_dynamic_linking = true; +#else + bool octave_supports_dynamic_linking = false; +#endif + + static bool initialized = false; + static octave_scalar_map m; + + struct conf_info_struct + { + bool subst_home; + const char *key; + const char *val; + }; + + static const conf_info_struct conf_info[] = + { + { false, "ALL_CFLAGS", OCTAVE_CONF_ALL_CFLAGS }, + { false, "ALL_CXXFLAGS", OCTAVE_CONF_ALL_CXXFLAGS }, + { false, "ALL_FFLAGS", OCTAVE_CONF_ALL_FFLAGS }, + { false, "ALL_LDFLAGS", OCTAVE_CONF_ALL_LDFLAGS }, + { false, "AMD_CPPFLAGS", OCTAVE_CONF_AMD_CPPFLAGS }, + { false, "AMD_LDFLAGS", OCTAVE_CONF_AMD_LDFLAGS }, + { false, "AMD_LIBS", OCTAVE_CONF_AMD_LIBS }, + { false, "AR", OCTAVE_CONF_AR }, + { false, "ARFLAGS", OCTAVE_CONF_ARFLAGS }, + { false, "ARPACK_CPPFLAGS", OCTAVE_CONF_ARPACK_CPPFLAGS }, + { false, "ARPACK_LDFLAGS", OCTAVE_CONF_ARPACK_LDFLAGS }, + { false, "ARPACK_LIBS", OCTAVE_CONF_ARPACK_LIBS }, + { false, "BLAS_LIBS", OCTAVE_CONF_BLAS_LIBS }, + { false, "CARBON_LIBS", OCTAVE_CONF_CARBON_LIBS }, + { false, "CAMD_CPPFLAGS", OCTAVE_CONF_CAMD_CPPFLAGS }, + { false, "CAMD_LDFLAGS", OCTAVE_CONF_CAMD_LDFLAGS }, + { false, "CAMD_LIBS", OCTAVE_CONF_CAMD_LIBS }, + { false, "CC", OCTAVE_CONF_CC }, + { false, "CC_VERSION", OCTAVE_CONF_CC_VERSION }, + { false, "CCOLAMD_CPPFLAGS", OCTAVE_CONF_CCOLAMD_CPPFLAGS }, + { false, "CCOLAMD_LDFLAGS", OCTAVE_CONF_CCOLAMD_LDFLAGS }, + { false, "CCOLAMD_LIBS", OCTAVE_CONF_CCOLAMD_LIBS }, + { false, "CFLAGS", OCTAVE_CONF_CFLAGS }, + { false, "CHOLMOD_CPPFLAGS", OCTAVE_CONF_CHOLMOD_CPPFLAGS }, + { false, "CHOLMOD_LDFLAGS", OCTAVE_CONF_CHOLMOD_LDFLAGS }, + { false, "CHOLMOD_LIBS", OCTAVE_CONF_CHOLMOD_LIBS }, + { false, "COLAMD_CPPFLAGS", OCTAVE_CONF_COLAMD_CPPFLAGS }, + { false, "COLAMD_LDFLAGS", OCTAVE_CONF_COLAMD_LDFLAGS }, + { false, "COLAMD_LIBS", OCTAVE_CONF_COLAMD_LIBS }, + { false, "CPICFLAG", OCTAVE_CONF_CPICFLAG }, + { false, "CPPFLAGS", OCTAVE_CONF_CPPFLAGS }, + { false, "CURL_CPPFLAGS", OCTAVE_CONF_CURL_CPPFLAGS }, + { false, "CURL_LDFLAGS", OCTAVE_CONF_CURL_LDFLAGS }, + { false, "CURL_LIBS", OCTAVE_CONF_CURL_LIBS }, + { false, "CXSPARSE_CPPFLAGS", OCTAVE_CONF_CXSPARSE_CPPFLAGS }, + { false, "CXSPARSE_LDFLAGS", OCTAVE_CONF_CXSPARSE_LDFLAGS }, + { false, "CXSPARSE_LIBS", OCTAVE_CONF_CXSPARSE_LIBS }, + { false, "CXX", OCTAVE_CONF_CXX }, + { false, "CXXCPP", OCTAVE_CONF_CXXCPP }, + { false, "CXXFLAGS", OCTAVE_CONF_CXXFLAGS }, + { false, "CXXPICFLAG", OCTAVE_CONF_CXXPICFLAG }, + { false, "CXX_VERSION", OCTAVE_CONF_CXX_VERSION }, + { false, "DEFAULT_PAGER", OCTAVE_DEFAULT_PAGER }, + { false, "DEFS", OCTAVE_CONF_DEFS }, + { false, "DL_LD", OCTAVE_CONF_DL_LD }, + { false, "DL_LDFLAGS", OCTAVE_CONF_DL_LDFLAGS }, + { false, "DL_LIBS", OCTAVE_CONF_DL_LIBS }, + { false, "ENABLE_DYNAMIC_LINKING", OCTAVE_CONF_ENABLE_DYNAMIC_LINKING }, + { false, "EXEEXT", OCTAVE_CONF_EXEEXT }, + { false, "F77", OCTAVE_CONF_F77 }, + { false, "F77_FLOAT_STORE_FLAG", OCTAVE_CONF_F77_FLOAT_STORE_FLAG }, + { false, "F77_INTEGER_8_FLAG", OCTAVE_CONF_F77_INTEGER_8_FLAG }, + { false, "FC", OCTAVE_CONF_FC }, + { false, "FFLAGS", OCTAVE_CONF_FFLAGS }, + { false, "FFTW3_CPPFLAGS", OCTAVE_CONF_FFTW3_CPPFLAGS }, + { false, "FFTW3_LDFLAGS", OCTAVE_CONF_FFTW3_LDFLAGS }, + { false, "FFTW3_LIBS", OCTAVE_CONF_FFTW3_LIBS }, + { false, "FFTW3F_CPPFLAGS", OCTAVE_CONF_FFTW3F_CPPFLAGS }, + { false, "FFTW3F_LDFLAGS", OCTAVE_CONF_FFTW3F_LDFLAGS }, + { false, "FFTW3F_LIBS", OCTAVE_CONF_FFTW3F_LIBS }, + { false, "FLIBS", OCTAVE_CONF_FLIBS }, + { false, "FPICFLAG", OCTAVE_CONF_FPICFLAG }, + { false, "FT2_LIBS", OCTAVE_CONF_FT2_LIBS }, + { false, "GLPK_CPPFLAGS", OCTAVE_CONF_GLPK_CPPFLAGS }, + { false, "GLPK_LDFLAGS", OCTAVE_CONF_GLPK_LDFLAGS }, + { false, "GLPK_LIBS", OCTAVE_CONF_GLPK_LIBS }, + { false, "GNUPLOT", OCTAVE_CONF_GNUPLOT }, + { false, "GRAPHICS_LIBS", OCTAVE_CONF_GRAPHICS_LIBS }, + { false, "HDF5_CPPFLAGS", OCTAVE_CONF_HDF5_CPPFLAGS }, + { false, "HDF5_LDFLAGS", OCTAVE_CONF_HDF5_LDFLAGS }, + { false, "HDF5_LIBS", OCTAVE_CONF_HDF5_LIBS }, + { false, "INCFLAGS", OCTAVE_CONF_INCFLAGS }, + { false, "LAPACK_LIBS", OCTAVE_CONF_LAPACK_LIBS }, + { false, "LDFLAGS", OCTAVE_CONF_LDFLAGS }, + { false, "LD_CXX", OCTAVE_CONF_LD_CXX }, + { false, "LD_STATIC_FLAG", OCTAVE_CONF_LD_STATIC_FLAG }, + { false, "LEX", OCTAVE_CONF_LEX }, + { false, "LEXLIB", OCTAVE_CONF_LEXLIB }, + { false, "LFLAGS", OCTAVE_CONF_LFLAGS }, + { false, "LIBCRUFT", OCTAVE_CONF_LIBCRUFT }, + { false, "LIBEXT", OCTAVE_CONF_LIBEXT }, + { false, "LIBFLAGS", OCTAVE_CONF_LIBFLAGS }, + { false, "LIBOCTAVE", OCTAVE_CONF_LIBOCTAVE }, + { false, "LIBOCTINTERP", OCTAVE_CONF_LIBOCTINTERP }, + { false, "LIBS", OCTAVE_CONF_LIBS }, + { false, "LN_S", OCTAVE_CONF_LN_S }, + { false, "MAGICK_CPPFLAGS", OCTAVE_CONF_MAGICK_CPPFLAGS }, + { false, "MAGICK_LDFLAGS", OCTAVE_CONF_MAGICK_LDFLAGS }, + { false, "MAGICK_LIBS", OCTAVE_CONF_MAGICK_LIBS }, + { false, "LLVM_CPPFLAGS", OCTAVE_CONF_LLVM_CPPFLAGS }, + { false, "LLVM_LDFLAGS", OCTAVE_CONF_LLVM_LDFLAGS }, + { false, "LLVM_LIBS", OCTAVE_CONF_LLVM_LIBS }, + { false, "MKOCTFILE_DL_LDFLAGS", OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS }, + { false, "OCTAVE_LINK_DEPS", OCTAVE_CONF_OCTAVE_LINK_DEPS }, + { false, "OCTAVE_LINK_OPTS", OCTAVE_CONF_OCTAVE_LINK_OPTS }, + { false, "OCT_LINK_DEPS", OCTAVE_CONF_OCT_LINK_DEPS }, + { false, "OCT_LINK_OPTS", OCTAVE_CONF_OCT_LINK_OPTS }, + { false, "OPENGL_LIBS", OCTAVE_CONF_OPENGL_LIBS }, + { false, "PTHREAD_CFLAGS", OCTAVE_CONF_PTHREAD_CFLAGS }, + { false, "PTHREAD_LIBS", OCTAVE_CONF_PTHREAD_LIBS }, + { false, "QHULL_CPPFLAGS", OCTAVE_CONF_QHULL_CPPFLAGS }, + { false, "QHULL_LDFLAGS", OCTAVE_CONF_QHULL_LDFLAGS }, + { false, "QHULL_LIBS", OCTAVE_CONF_QHULL_LIBS }, + { false, "QRUPDATE_CPPFLAGS", OCTAVE_CONF_QRUPDATE_CPPFLAGS }, + { false, "QRUPDATE_LDFLAGS", OCTAVE_CONF_QRUPDATE_LDFLAGS }, + { false, "QRUPDATE_LIBS", OCTAVE_CONF_QRUPDATE_LIBS }, + { false, "RANLIB", OCTAVE_CONF_RANLIB }, + { false, "RDYNAMIC_FLAG", OCTAVE_CONF_RDYNAMIC_FLAG }, + { false, "READLINE_LIBS", OCTAVE_CONF_READLINE_LIBS }, + { false, "REGEX_LIBS", OCTAVE_CONF_REGEX_LIBS }, + { false, "SED", OCTAVE_CONF_SED }, + { false, "SHARED_LIBS", OCTAVE_CONF_SHARED_LIBS }, + { false, "SHLEXT", OCTAVE_CONF_SHLEXT }, + { false, "SHLEXT_VER", OCTAVE_CONF_SHLEXT_VER }, + { false, "SH_LD", OCTAVE_CONF_SH_LD }, + { false, "SH_LDFLAGS", OCTAVE_CONF_SH_LDFLAGS }, + { false, "SONAME_FLAGS", OCTAVE_CONF_SONAME_FLAGS }, + { false, "STATIC_LIBS", OCTAVE_CONF_STATIC_LIBS }, + { false, "TERM_LIBS", OCTAVE_CONF_TERM_LIBS }, + { false, "UGLY_DEFS", OCTAVE_CONF_UGLY_DEFS }, + { false, "UMFPACK_CPPFLAGS", OCTAVE_CONF_UMFPACK_CPPFLAGS }, + { false, "UMFPACK_LDFLAGS", OCTAVE_CONF_UMFPACK_LDFLAGS }, + { false, "UMFPACK_LIBS", OCTAVE_CONF_UMFPACK_LIBS }, + { false, "USE_64_BIT_IDX_T", OCTAVE_CONF_USE_64_BIT_IDX_T }, + { false, "X11_INCFLAGS", OCTAVE_CONF_X11_INCFLAGS }, + { false, "X11_LIBS", OCTAVE_CONF_X11_LIBS }, + { false, "XTRA_CFLAGS", OCTAVE_CONF_XTRA_CFLAGS }, + { false, "XTRA_CXXFLAGS", OCTAVE_CONF_XTRA_CXXFLAGS }, + { false, "YACC", OCTAVE_CONF_YACC }, + { false, "YFLAGS", OCTAVE_CONF_YFLAGS }, + { false, "Z_CPPFLAGS", OCTAVE_CONF_Z_CPPFLAGS }, + { false, "Z_LDFLAGS", OCTAVE_CONF_Z_LDFLAGS }, + { false, "Z_LIBS", OCTAVE_CONF_Z_LIBS }, + { false, "api_version", OCTAVE_API_VERSION }, + { true, "archlibdir", OCTAVE_ARCHLIBDIR }, + { true, "bindir", OCTAVE_BINDIR }, + { false, "canonical_host_type", OCTAVE_CANONICAL_HOST_TYPE }, + { false, "config_opts", OCTAVE_CONF_config_opts }, + { true, "datadir", OCTAVE_DATADIR }, + { true, "datarootdir", OCTAVE_DATAROOTDIR }, + { true, "exec_prefix", OCTAVE_EXEC_PREFIX }, + { true, "fcnfiledir", OCTAVE_FCNFILEDIR }, + { true, "imagedir", OCTAVE_IMAGEDIR }, + { true, "includedir", OCTAVE_INCLUDEDIR }, + { true, "infodir", OCTAVE_INFODIR }, + { true, "infofile", OCTAVE_INFOFILE }, + { true, "libdir", OCTAVE_LIBDIR }, + { true, "libexecdir", OCTAVE_LIBEXECDIR }, + { true, "localapiarchlibdir", OCTAVE_LOCALAPIARCHLIBDIR }, + { true, "localapifcnfiledir", OCTAVE_LOCALAPIFCNFILEDIR }, + { true, "localapioctfiledir", OCTAVE_LOCALAPIOCTFILEDIR }, + { true, "localarchlibdir", OCTAVE_LOCALARCHLIBDIR }, + { true, "localfcnfiledir", OCTAVE_LOCALFCNFILEDIR }, + { true, "localoctfiledir", OCTAVE_LOCALOCTFILEDIR }, + { true, "localstartupfiledir", OCTAVE_LOCALSTARTUPFILEDIR }, + { true, "localverarchlibdir", OCTAVE_LOCALVERARCHLIBDIR }, + { true, "localverfcnfiledir", OCTAVE_LOCALVERFCNFILEDIR }, + { true, "localveroctfiledir", OCTAVE_LOCALVEROCTFILEDIR }, + { true, "man1dir", OCTAVE_MAN1DIR }, + { false, "man1ext", OCTAVE_MAN1EXT }, + { true, "mandir", OCTAVE_MANDIR }, + { true, "octfiledir", OCTAVE_OCTFILEDIR }, + { true, "octetcdir", OCTAVE_OCTETCDIR }, + { true, "octincludedir", OCTAVE_OCTINCLUDEDIR }, + { true, "octlibdir", OCTAVE_OCTLIBDIR }, + { true, "prefix", OCTAVE_PREFIX }, + { true, "startupfiledir", OCTAVE_STARTUPFILEDIR }, + { false, "version", OCTAVE_VERSION }, + { false, 0, 0 } + }; + + if (! initialized) + { + m.assign ("dld", octave_value (octave_supports_dynamic_linking)); + + oct_mach_info::float_format ff = oct_mach_info::native_float_format (); + m.assign ("float_format", + octave_value (oct_mach_info::float_format_as_string (ff))); + + m.assign ("words_big_endian", + octave_value (oct_mach_info::words_big_endian ())); + + m.assign ("words_little_endian", + octave_value (oct_mach_info::words_little_endian ())); + + int i = 0; + + while (true) + { + const conf_info_struct& elt = conf_info[i++]; + + const char *key = elt.key; + + if (key) + { + if (elt.subst_home) + m.assign (key, subst_octave_home (elt.val)); + else + m.assign (key, elt.val); + } + else + break; + } + + bool unix_system = true; + bool mac_system = false; + bool windows_system = false; + +#if defined (WIN32) + windows_system = true; +#if !defined (__CYGWIN__) + unix_system = false; +#endif +#endif + +#if defined (OCTAVE_USE_OS_X_API) + mac_system = true; +#endif + + m.assign ("unix", octave_value (unix_system)); + m.assign ("mac", octave_value (mac_system)); + m.assign ("windows", octave_value (windows_system)); + + initialized = true; + } + + int nargin = args.length (); + + if (nargin == 1) + { + std::string arg = args(0).string_value (); + + if (! error_state) + { + Cell c = m.contents (arg.c_str ()); + + if (c.is_empty ()) + error ("octave_config_info: no info for `%s'", arg.c_str ()); + else + retval = c(0); + } + } + else if (nargin == 0) + retval = m; + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar (octave_config_info ("version"))) +%!test +%! x = octave_config_info (); +%! assert (isstruct (x)); +%! assert (! isempty (x)); + +%!error octave_config_info (1, 2) +*/ + +#if defined (__GNUG__) && defined (DEBUG_NEW_DELETE) + +int debug_new_delete = 0; + +typedef void (*vfp)(void); +extern vfp __new_handler; + +void * +__builtin_new (size_t sz) +{ + void *p; + + /* malloc (0) is unpredictable; avoid it. */ + if (sz == 0) + sz = 1; + p = malloc (sz); + while (p == 0) + { + (*__new_handler) (); + p = malloc (sz); + } + + if (debug_new_delete) + std::cerr << "__builtin_new: " << p << std::endl; + + return p; +} + +void +__builtin_delete (void *ptr) +{ + if (debug_new_delete) + std::cerr << "__builtin_delete: " << ptr << std::endl; + + if (ptr) + free (ptr); +} + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/toplev.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/toplev.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,455 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_toplev_h) +#define octave_toplev_h 1 + +#include + +#include +#include + +class octave_value; +class octave_value_list; +class octave_function; +class octave_user_script; +class tree_statement; +class tree_statement_list; +class charMatrix; + +#include "quit.h" + +#include "input.h" +#include "oct-map.h" + + +typedef void (*octave_exit_func) (int); +extern OCTINTERP_API octave_exit_func octave_exit; + +extern OCTINTERP_API bool quit_allowed; + +extern OCTINTERP_API bool quitting_gracefully; + +extern OCTINTERP_API int exit_status; + +extern OCTINTERP_API void +clean_up_and_exit (int); + +extern OCTINTERP_API void recover_from_exception (void); + +extern OCTINTERP_API int main_loop (void); + +extern OCTINTERP_API void +do_octave_atexit (void); + +extern OCTINTERP_API void +octave_add_atexit_function (const std::string& fname); + +extern OCTINTERP_API bool +octave_remove_atexit_function (const std::string& fname); + +// Current command to execute. +extern OCTINTERP_API tree_statement_list *global_command; + +// TRUE means we are ready to interpret commands, but not everything +// is ready for interactive use. +extern OCTINTERP_API bool octave_interpreter_ready; + +// TRUE means we've processed all the init code and we are good to go. +extern OCTINTERP_API bool octave_initialized; + +class +OCTINTERP_API +octave_call_stack +{ +private: + + struct call_stack_elt + { + call_stack_elt (octave_function *f, symbol_table::scope_id s, + symbol_table::context_id c, size_t p = 0) + : fcn (f), stmt (0), scope (s), context (c), prev (p) { } + + call_stack_elt (const call_stack_elt& elt) + : fcn (elt.fcn), stmt (elt.stmt), scope (elt.scope), + context (elt.context), prev (elt.prev) { } + + octave_function *fcn; + tree_statement *stmt; + symbol_table::scope_id scope; + symbol_table::context_id context; + size_t prev; + }; + +protected: + + octave_call_stack (void) : cs (), curr_frame (0) { } + +public: + + typedef std::deque::iterator iterator; + typedef std::deque::const_iterator const_iterator; + + typedef std::deque::reverse_iterator reverse_iterator; + typedef std::deque::const_reverse_iterator const_reverse_iterator; + + static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create call stack object!"); + + retval = false; + } + + return retval; + } + + // Current function (top of stack). + static octave_function *current (void) + { + return instance_ok () ? instance->do_current () : 0; + } + + // Current statement (top of stack). + static tree_statement *current_statement (void) + { + return instance_ok () ? instance->do_current_statement () : 0; + } + + // Current line in current function. + static int current_line (void) + { + return instance_ok () ? instance->do_current_line () : -1; + } + + // Current column in current function. + static int current_column (void) + { + return instance_ok () ? instance->do_current_column () : -1; + } + + // Line in user code caller. + static int caller_user_code_line (void) + { + return instance_ok () ? instance->do_caller_user_code_line () : -1; + } + + // Column in user code caller. + static int caller_user_code_column (void) + { + return instance_ok () ? instance->do_caller_user_code_column () : -1; + } + + // Caller function, may be built-in. + static octave_function *caller (void) + { + return instance_ok () ? instance->do_caller () : 0; + } + + static size_t current_frame (void) + { + return instance_ok () ? instance->do_current_frame () : 0; + } + + static size_t size (void) + { + return instance_ok () ? instance->do_size () : 0; + } + + static size_t num_user_code_frames (octave_idx_type& curr_user_frame) + { + return instance_ok () + ? instance->do_num_user_code_frames (curr_user_frame) : 0; + } + + static symbol_table::scope_id current_scope (void) + { + return instance_ok () ? instance->do_current_scope () : 0; + } + + static symbol_table::context_id current_context (void) + { + return instance_ok () ? instance->do_current_context () : 0; + } + + // Function at location N on the call stack (N == 0 is current), may + // be built-in. + static octave_function *element (size_t n) + { + return instance_ok () ? instance->do_element (n) : 0; + } + + // First user-defined function on the stack. + static octave_user_code *caller_user_code (size_t nskip = 0) + { + return instance_ok () ? instance->do_caller_user_code (nskip) : 0; + } + + static void + push (octave_function *f, + symbol_table::scope_id scope = symbol_table::current_scope (), + symbol_table::context_id context = symbol_table::current_context ()) + { + if (instance_ok ()) + instance->do_push (f, scope, context); + } + + static void + push (symbol_table::scope_id scope = symbol_table::current_scope (), + symbol_table::context_id context = symbol_table::current_context ()) + { + if (instance_ok ()) + instance->do_push (0, scope, context); + } + + static void set_statement (tree_statement *s) + { + if (instance_ok ()) + instance->do_set_statement (s); + } + + static bool goto_frame (size_t n = 0, bool verbose = false) + { + return instance_ok () ? instance->do_goto_frame (n, verbose) : false; + } + + static void restore_frame (size_t n) + { + goto_frame (n); + } + + static bool goto_frame_relative (int n, bool verbose = false) + { + return instance_ok () + ? instance->do_goto_frame_relative (n, verbose) : false; + } + + static void goto_caller_frame (void) + { + if (instance_ok ()) + instance->do_goto_caller_frame (); + } + + static void goto_base_frame (void) + { + if (instance_ok ()) + instance->do_goto_base_frame (); + } + + static octave_map backtrace (size_t nskip, octave_idx_type& curr_user_frame) + { + return instance_ok () + ? instance->do_backtrace (nskip, curr_user_frame) : octave_map (); + } + + static octave_map empty_backtrace (void); + + static void pop (void) + { + if (instance_ok ()) + instance->do_pop (); + } + + static void clear (void) + { + if (instance_ok ()) + instance->do_clear (); + } + + static void backtrace_error_message (void) + { + if (instance_ok ()) + instance->do_backtrace_error_message (); + } + +private: + + // The current call stack. + std::deque cs; + + size_t curr_frame; + + static octave_call_stack *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + int do_current_line (void) const; + + int do_current_column (void) const; + + int do_caller_user_code_line (void) const; + + int do_caller_user_code_column (void) const; + + octave_function *do_caller (void) const + { + return curr_frame > 1 ? cs[curr_frame-1].fcn : cs[0].fcn; + } + + size_t do_current_frame (void) { return curr_frame; } + + size_t do_size (void) { return cs.size (); } + + size_t do_num_user_code_frames (octave_idx_type& curr_user_frame) const; + + symbol_table::scope_id do_current_scope (void) const + { + return curr_frame > 0 && curr_frame < cs.size () + ? cs[curr_frame].scope : 0; + } + + symbol_table::context_id do_current_context (void) const + { + return curr_frame > 0 && curr_frame < cs.size () + ? cs[curr_frame].context : 0; + } + + octave_function *do_element (size_t n) + { + octave_function *retval = 0; + + if (cs.size () > n) + { + call_stack_elt& elt = cs[n]; + retval = elt.fcn; + } + + return retval; + } + + octave_user_code *do_caller_user_code (size_t nskip) const; + + void do_push (octave_function *f, symbol_table::scope_id scope, + symbol_table::context_id context) + { + size_t prev_frame = curr_frame; + curr_frame = cs.size (); + cs.push_back (call_stack_elt (f, scope, context, prev_frame)); + symbol_table::set_scope_and_context (scope, context); + } + + octave_function *do_current (void) const + { + octave_function *retval = 0; + + if (! cs.empty ()) + { + const call_stack_elt& elt = cs[curr_frame]; + retval = elt.fcn; + } + + return retval; + } + + tree_statement *do_current_statement (void) const + { + tree_statement *retval = 0; + + if (! cs.empty ()) + { + const call_stack_elt& elt = cs[curr_frame]; + retval = elt.stmt; + } + + return retval; + } + + void do_set_statement (tree_statement *s) + { + if (! cs.empty ()) + { + call_stack_elt& elt = cs.back (); + elt.stmt = s; + } + } + + octave_map do_backtrace (size_t nskip, + octave_idx_type& curr_user_frame) const; + + bool do_goto_frame (size_t n, bool verbose); + + bool do_goto_frame_relative (int n, bool verbose); + + void do_goto_caller_frame (void); + + void do_goto_base_frame (void); + + void do_pop (void) + { + if (cs.size () > 1) + { + const call_stack_elt& elt = cs.back (); + curr_frame = elt.prev; + cs.pop_back (); + const call_stack_elt& new_elt = cs[curr_frame]; + symbol_table::set_scope_and_context (new_elt.scope, new_elt.context); + } + } + + void do_clear (void) { cs.clear (); } + + void do_backtrace_error_message (void) const; +}; + +// Call a function with exceptions handled to avoid problems with +// errors while shutting down. + +#define OCTAVE_IGNORE_EXCEPTION(E) \ + catch (E) \ + { \ + std::cerr << "error: ignoring " #E " while preparing to exit" << std::endl; \ + recover_from_exception (); \ + } + +#define OCTAVE_SAFE_CALL(F, ARGS) \ + do \ + { \ + try \ + { \ + unwind_protect frame; \ + \ + frame.protect_var (Vdebug_on_error); \ + frame.protect_var (Vdebug_on_warning); \ + \ + Vdebug_on_error = false; \ + Vdebug_on_warning = false; \ + \ + F ARGS; \ + } \ + OCTAVE_IGNORE_EXCEPTION (octave_interrupt_exception) \ + OCTAVE_IGNORE_EXCEPTION (octave_execution_exception) \ + OCTAVE_IGNORE_EXCEPTION (std::bad_alloc) \ + \ + if (error_state) \ + error_state = 0; \ + } \ + while (0) + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/utils.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/utils.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1432 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include + +#include +#include + +#include "vasnprintf.h" + +#include "quit.h" + +#include "dir-ops.h" +#include "file-ops.h" +#include "file-stat.h" +#include "lo-mappers.h" +#include "lo-utils.h" +#include "oct-cmplx.h" +#include "oct-env.h" +#include "pathsearch.h" +#include "str-vec.h" + +#include "Cell.h" +#include +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "oct-errno.h" +#include "oct-hist.h" +#include "oct-obj.h" +#include "ov-range.h" +#include "pager.h" +#include "parse.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Return TRUE if S is a valid identifier. + +bool +valid_identifier (const char *s) +{ + if (! s || ! (isalpha (*s) || *s == '_' || *s == '$')) + return false; + + while (*++s != '\0') + if (! (isalnum (*s) || *s == '_' || *s == '$')) + return false; + + return true; +} + +bool +valid_identifier (const std::string& s) +{ + return valid_identifier (s.c_str ()); +} + +DEFUN (isvarname, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isvarname (@var{name})\n\ +Return true if @var{name} is a valid variable name.\n\ +@seealso{iskeyword, exist, who}\n\ +@end deftypefn") +{ + octave_value retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("isvarname"); + + if (error_state) + return retval; + + if (argc == 2) + retval = valid_identifier (argv[1]) && ! is_keyword (argv[1]); + else + print_usage (); + + return retval; +} + +/* +%!assert (isvarname ("foo"), true) +%!assert (isvarname ("_foo"), true) +%!assert (isvarname ("_1"), true) +%!assert (isvarname ("1foo"), false) +%!assert (isvarname (""), false) + +%!error isvarname () +%!error isvarname ("foo", "bar"); +*/ + +// Return TRUE if F and G are both names for the same file. + +bool +same_file (const std::string& f, const std::string& g) +{ + return same_file_internal (f, g); +} + +int +almost_match (const std::string& std, const std::string& s, int min_match_len, + int case_sens) +{ + int stdlen = std.length (); + int slen = s.length (); + + return (slen <= stdlen + && slen >= min_match_len + && (case_sens + ? (strncmp (std.c_str (), s.c_str (), slen) == 0) + : (octave_strncasecmp (std.c_str (), s.c_str (), slen) == 0))); +} + +// Ugh. + +int +keyword_almost_match (const char * const *std, int *min_len, const std::string& s, + int min_toks_to_match, int max_toks) +{ + int status = 0; + int tok_count = 0; + int toks_matched = 0; + + if (s.empty () || max_toks < 1) + return status; + + char *kw = strsave (s.c_str ()); + + char *t = kw; + while (*t != '\0') + { + if (*t == '\t') + *t = ' '; + t++; + } + + char *beg = kw; + while (*beg == ' ') + beg++; + + if (*beg == '\0') + return status; + + + const char **to_match = new const char * [max_toks + 1]; + const char * const *s1 = std; + const char **s2 = to_match; + + if (! s1 || ! s2) + goto done; + + s2[tok_count] = beg; + char *end; + while ((end = strchr (beg, ' ')) != 0) + { + *end = '\0'; + beg = end + 1; + + while (*beg == ' ') + beg++; + + if (*beg == '\0') + break; + + tok_count++; + if (tok_count >= max_toks) + goto done; + + s2[tok_count] = beg; + } + s2[tok_count+1] = 0; + + s2 = to_match; + + for (;;) + { + if (! almost_match (*s1, *s2, min_len[toks_matched], 0)) + goto done; + + toks_matched++; + + s1++; + s2++; + + if (! *s2) + { + status = (toks_matched >= min_toks_to_match); + goto done; + } + + if (! *s1) + goto done; + } + + done: + + delete [] kw; + delete [] to_match; + + return status; +} + +// Return non-zero if either NR or NC is zero. Return -1 if this +// should be considered fatal; return 1 if this is ok. + +int +empty_arg (const char * /* name */, octave_idx_type nr, octave_idx_type nc) +{ + return (nr == 0 || nc == 0); +} + +// See if the given file is in the path. + +std::string +search_path_for_file (const std::string& path, const string_vector& names) +{ + dir_path p (path); + + return octave_env::make_absolute (p.find_first_of (names)); +} + +// Find all locations of the given file in the path. + +string_vector +search_path_for_all_files (const std::string& path, const string_vector& names) +{ + dir_path p (path); + + string_vector sv = p.find_all_first_of (names); + + octave_idx_type len = sv.length (); + + for (octave_idx_type i = 0; i < len; i++) + sv[i] = octave_env::make_absolute (sv[i]); + + return sv; +} + +static string_vector +make_absolute (const string_vector& sv) +{ + octave_idx_type len = sv.length (); + + string_vector retval (len); + + for (octave_idx_type i = 0; i < len; i++) + retval[i] = octave_env::make_absolute (sv[i]); + + return retval; +} + +DEFUN (file_in_loadpath, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} file_in_loadpath (@var{file})\n\ +@deftypefnx {Built-in Function} {} file_in_loadpath (@var{file}, \"all\")\n\ +\n\ +Return the absolute name of @var{file} if it can be found in\n\ +the list of directories specified by @code{path}.\n\ +If no file is found, return an empty character string.\n\ +\n\ +If the first argument is a cell array of strings, search each\n\ +directory of the loadpath for element of the cell array and return\n\ +the first that matches.\n\ +\n\ +If the second optional argument @code{\"all\"} is supplied, return\n\ +a cell array containing the list of all files that have the same\n\ +name in the path. If no files are found, return an empty cell array.\n\ +@seealso{file_in_path, path}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + string_vector names = args(0).all_strings (); + + if (! error_state && names.length () > 0) + { + if (nargin == 1) + retval = octave_env::make_absolute (load_path::find_first_of (names)); + else if (nargin == 2) + { + std::string opt = args(1).string_value (); + + if (! error_state && opt == "all") + retval = Cell (make_absolute + (load_path::find_all_first_of (names))); + else + error ("file_in_loadpath: invalid option"); + } + } + else + error ("file_in_loadpath: FILE argument must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! f = file_in_loadpath ("plot.m"); +%! assert (ischar (f)); +%! assert (! isempty (f)); + +%!test +%! f = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$"); +%! assert (f, ""); + +%!test +%! lst = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$", "all"); +%! assert (lst, {}); + +%!error file_in_loadpath () +%!error file_in_loadpath ("foo", "bar", 1) +*/ + +DEFUN (file_in_path, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} file_in_path (@var{path}, @var{file})\n\ +@deftypefnx {Built-in Function} {} file_in_path (@var{path}, @var{file}, \"all\")\n\ +Return the absolute name of @var{file} if it can be found in\n\ +@var{path}. The value of @var{path} should be a colon-separated list of\n\ +directories in the format described for @code{path}. If no file\n\ +is found, return an empty character string. For example:\n\ +\n\ +@example\n\ +@group\n\ +file_in_path (EXEC_PATH, \"sh\")\n\ + @result{} \"/bin/sh\"\n\ +@end group\n\ +@end example\n\ +\n\ +If the second argument is a cell array of strings, search each\n\ +directory of the path for element of the cell array and return\n\ +the first that matches.\n\ +\n\ +If the third optional argument @code{\"all\"} is supplied, return\n\ +a cell array containing the list of all files that have the same\n\ +name in the path. If no files are found, return an empty cell array.\n\ +@seealso{file_in_loadpath}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + std::string path = args(0).string_value (); + + if (! error_state) + { + string_vector names = args(1).all_strings (); + + if (! error_state && names.length () > 0) + { + if (nargin == 2) + retval = search_path_for_file (path, names); + else if (nargin == 3) + { + std::string opt = args(2).string_value (); + + if (! error_state && opt == "all") + retval = Cell (make_absolute + (search_path_for_all_files (path, names))); + else + error ("file_in_path: invalid option"); + } + } + else + error ("file_in_path: all arguments must be strings"); + } + else + error ("file_in_path: PATH must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! f = file_in_path (path (), "plot.m"); +%! assert (ischar (f)); +%! assert (! isempty (f)); + +%!test +%! f = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$"); +%! assert (f, ""); + +%!test +%! lst = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$", "all"); +%! assert (lst, {}); + +%!error file_in_path () +%!error file_in_path ("foo") +%!error file_in_path ("foo", "bar", "baz", 1) +*/ + +std::string +file_in_path (const std::string& name, const std::string& suffix) +{ + std::string nm = name; + + if (! suffix.empty ()) + nm.append (suffix); + + return octave_env::make_absolute (load_path::find_file (nm)); +} + +// See if there is an function file in the path. If so, return the +// full path to the file. + +std::string +fcn_file_in_path (const std::string& name) +{ + std::string retval; + + int len = name.length (); + + if (len > 0) + { + if (octave_env::absolute_pathname (name)) + { + file_stat fs (name); + + if (fs.exists ()) + retval = name; + } + else if (len > 2 && name[len - 2] == '.' && name[len - 1] == 'm') + retval = load_path::find_fcn_file (name.substr (0, len-2)); + else + { + std::string fname = name; + size_t pos = name.find_first_of (Vfilemarker); + if (pos != std::string::npos) + fname = name.substr (0, pos); + + retval = load_path::find_fcn_file (fname); + } + } + + return retval; +} + +// See if there is a directory called "name" in the path and if it +// contains a Contents.m file return the full path to this file. + +std::string +contents_file_in_path (const std::string& dir) +{ + std::string retval; + + if (dir.length () > 0) + { + std::string tcontents = file_ops::concat (load_path::find_dir (dir), + std::string ("Contents.m")); + + file_stat fs (tcontents); + + if (fs.exists ()) + retval = octave_env::make_absolute (tcontents); + } + + return retval; +} + +// See if there is a .oct file in the path. If so, return the +// full path to the file. + +std::string +oct_file_in_path (const std::string& name) +{ + std::string retval; + + int len = name.length (); + + if (len > 0) + { + if (octave_env::absolute_pathname (name)) + { + file_stat fs (name); + + if (fs.exists ()) + retval = name; + } + else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'o' + && name[len - 2] == 'c' && name[len - 1] == 't') + retval = load_path::find_oct_file (name.substr (0, len-4)); + else + retval = load_path::find_oct_file (name); + } + + return retval; +} + +// See if there is a .mex file in the path. If so, return the +// full path to the file. + +std::string +mex_file_in_path (const std::string& name) +{ + std::string retval; + + int len = name.length (); + + if (len > 0) + { + if (octave_env::absolute_pathname (name)) + { + file_stat fs (name); + + if (fs.exists ()) + retval = name; + } + else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'm' + && name[len - 2] == 'e' && name[len - 1] == 'x') + retval = load_path::find_mex_file (name.substr (0, len-4)); + else + retval = load_path::find_mex_file (name); + } + + return retval; +} + +// Replace backslash escapes in a string with the real values. + +std::string +do_string_escapes (const std::string& s) +{ + std::string retval; + + size_t i = 0; + size_t j = 0; + size_t len = s.length (); + + retval.resize (len); + + while (j < len) + { + if (s[j] == '\\' && j+1 < len) + { + switch (s[++j]) + { + case '0': + retval[i] = '\0'; + break; + + case 'a': + retval[i] = '\a'; + break; + + case 'b': // backspace + retval[i] = '\b'; + break; + + case 'f': // formfeed + retval[i] = '\f'; + break; + + case 'n': // newline + retval[i] = '\n'; + break; + + case 'r': // carriage return + retval[i] = '\r'; + break; + + case 't': // horizontal tab + retval[i] = '\t'; + break; + + case 'v': // vertical tab + retval[i] = '\v'; + break; + + case '\\': // backslash + retval[i] = '\\'; + break; + + case '\'': // quote + retval[i] = '\''; + break; + + case '"': // double quote + retval[i] = '"'; + break; + + default: + warning ("unrecognized escape sequence `\\%c' --\ + converting to `%c'", s[j], s[j]); + retval[i] = s[j]; + break; + } + } + else + { + retval[i] = s[j]; + } + + i++; + j++; + } + + retval.resize (i); + + return retval; +} + +DEFUN (do_string_escapes, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} do_string_escapes (@var{string})\n\ +Convert special characters in @var{string} to their escaped forms.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + retval = do_string_escapes (args(0).string_value ()); + else + error ("do_string_escapes: STRING argument must be of type string"); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (do_string_escapes ('foo\nbar'), "foo\nbar") +%!assert (do_string_escapes ("foo\\nbar"), "foo\nbar") +%!assert (do_string_escapes ("foo\\nbar"), ["foo", char(10), "bar"]) +%!assert ("foo\nbar", ["foo", char(10), "bar"]) + +%!assert (do_string_escapes ('\a\b\f\n\r\t\v'), "\a\b\f\n\r\t\v") +%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), "\a\b\f\n\r\t\v") +%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), +%! char ([7, 8, 12, 10, 13, 9, 11])) +%!assert ("\a\b\f\n\r\t\v", char ([7, 8, 12, 10, 13, 9, 11])) + +%!error do_string_escapes () +%!error do_string_escapes ("foo", "bar") +*/ + +const char * +undo_string_escape (char c) +{ + if (! c) + return ""; + + switch (c) + { + case '\0': + return "\\0"; + + case '\a': + return "\\a"; + + case '\b': // backspace + return "\\b"; + + case '\f': // formfeed + return "\\f"; + + case '\n': // newline + return "\\n"; + + case '\r': // carriage return + return "\\r"; + + case '\t': // horizontal tab + return "\\t"; + + case '\v': // vertical tab + return "\\v"; + + case '\\': // backslash + return "\\\\"; + + case '"': // double quote + return "\\\""; + + default: + { + static char retval[2]; + retval[0] = c; + retval[1] = '\0'; + return retval; + } + } +} + +std::string +undo_string_escapes (const std::string& s) +{ + std::string retval; + + for (size_t i = 0; i < s.length (); i++) + retval.append (undo_string_escape (s[i])); + + return retval; +} + +DEFUN (undo_string_escapes, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} undo_string_escapes (@var{s})\n\ +Convert special characters in strings back to their escaped forms. For\n\ +example, the expression\n\ +\n\ +@example\n\ +bell = \"\\a\";\n\ +@end example\n\ +\n\ +@noindent\n\ +assigns the value of the alert character (control-g, ASCII code 7) to\n\ +the string variable @code{bell}. If this string is printed, the\n\ +system will ring the terminal bell (if it is possible). This is\n\ +normally the desired outcome. However, sometimes it is useful to be\n\ +able to print the original representation of the string, with the\n\ +special characters replaced by their escape sequences. For example,\n\ +\n\ +@example\n\ +@group\n\ +octave:13> undo_string_escapes (bell)\n\ +ans = \\a\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +replaces the unprintable alert character with its printable\n\ +representation.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + retval = undo_string_escapes (args(0).string_value ()); + else + error ("undo_string_escapes: S argument must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (undo_string_escapes ("foo\nbar"), 'foo\nbar') +%!assert (undo_string_escapes ("foo\nbar"), "foo\\nbar") +%!assert (undo_string_escapes (["foo", char(10), "bar"]), "foo\\nbar") + +%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), '\a\b\f\n\r\t\v') +%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), "\\a\\b\\f\\n\\r\\t\\v") +%!assert (undo_string_escapes (char ([7, 8, 12, 10, 13, 9, 11])), +%! "\\a\\b\\f\\n\\r\\t\\v") + +%!error undo_string_escapes () +%!error undo_string_escapes ("foo", "bar") +*/ + +DEFUN (is_absolute_filename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_absolute_filename (@var{file})\n\ +Return true if @var{file} is an absolute filename.\n\ +@seealso{is_rooted_relative_filename, make_absolute_filename, isdir}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + retval = (args(0).is_string () + && octave_env::absolute_pathname (args(0).string_value ())); + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error is_absolute_filename () +%!error is_absolute_filename ("foo", "bar") +*/ + +DEFUN (is_rooted_relative_filename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_rooted_relative_filename (@var{file})\n\ +Return true if @var{file} is a rooted-relative filename.\n\ +@seealso{is_absolute_filename, make_absolute_filename, isdir}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + retval = (args(0).is_string () + && octave_env::rooted_relative_pathname (args(0).string_value ())); + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error is_rooted_relative_filename () +%!error is_rooted_relative_filename ("foo", "bar") +*/ + +DEFUN (make_absolute_filename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} make_absolute_filename (@var{file})\n\ +Return the full name of @var{file} beginning from the root of the file\n\ +system. No check is done for the existence of @var{file}.\n\ +@seealso{canonicalize_file_name, is_absolute_filename, is_rooted_relative_filename, isdir}\n\ +@end deftypefn") +{ + octave_value retval = std::string (); + + if (args.length () == 1) + { + std::string nm = args(0).string_value (); + + if (! error_state) + retval = octave_env::make_absolute (nm); + else + error ("make_absolute_filename: FILE argument must be a file name"); + } + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error make_absolute_filename () +%!error make_absolute_filename ("foo", "bar") +*/ + +DEFUN (find_dir_in_path, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} find_dir_in_path (@var{dir})\n\ +@deftypefnx {Built-in Function} {} find_dir_in_path (@var{dir}, \"all\")\n\ +Return the full name of the path element matching @var{dir}. The\n\ +match is performed at the end of each path element. For example, if\n\ +@var{dir} is @code{\"foo/bar\"}, it matches the path element\n\ +@code{\"/some/dir/foo/bar\"}, but not @code{\"/some/dir/foo/bar/baz\"}\n\ +or @code{\"/some/dir/allfoo/bar\"}.\n\ +\n\ +The second argument is optional. If it is supplied, return a cell array\n\ +containing all name matches rather than just the first.\n\ +@end deftypefn") +{ + octave_value retval = std::string (); + + int nargin = args.length (); + + std::string dir; + + if (nargin == 1 || nargin == 2) + { + dir = args(0).string_value (); + + if (! error_state) + { + if (nargin == 1) + retval = load_path::find_dir (dir); + else if (nargin == 2) + retval = Cell (load_path::find_matching_dirs (dir)); + } + else + error ("find_dir_in_path: DIR must be a directory name"); + } + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error find_dir_in_path () +%!error find_dir_in_path ("foo", "bar", 1) +*/ + +DEFUNX ("errno", Ferrno, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{err} =} errno ()\n\ +@deftypefnx {Built-in Function} {@var{err} =} errno (@var{val})\n\ +@deftypefnx {Built-in Function} {@var{err} =} errno (@var{name})\n\ +Return the current value of the system-dependent variable errno,\n\ +set its value to @var{val} and return the previous value, or return\n\ +the named error code given @var{name} as a character string, or -1\n\ +if @var{name} is not found.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + std::string nm = args(0).string_value (); + + if (! error_state) + retval = octave_errno::lookup (nm); + else + error ("errno: expecting character string argument"); + } + else + { + int val = args(0).int_value (); + + if (! error_state) + retval = octave_errno::set (val); + else + error ("errno: expecting integer argument"); + } + } + else if (nargin == 0) + retval = octave_errno::get (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isnumeric (errno ())) + +%!test +%! lst = errno_list (); +%! fns = fieldnames (lst); +%! oldval = errno (fns{1}); +%! assert (isnumeric (oldval)); +%! errno (oldval); +%! newval = errno (); +%! assert (oldval, newval); + +%!error errno ("foo", 1) +*/ + +DEFUN (errno_list, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} errno_list ()\n\ +Return a structure containing the system-dependent errno values.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = octave_errno::list (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isstruct (errno_list ())) + +%!error errno_list ("foo") +*/ + +static void +check_dimensions (octave_idx_type& nr, octave_idx_type& nc, const char *warnfor) +{ + if (nr < 0 || nc < 0) + { + warning_with_id ("Octave:neg-dim-as-zero", + "%s: converting negative dimension to zero", warnfor); + + nr = (nr < 0) ? 0 : nr; + nc = (nc < 0) ? 0 : nc; + } +} + +void +check_dimensions (dim_vector& dim, const char *warnfor) +{ + bool neg = false; + + for (int i = 0; i < dim.length (); i++) + { + if (dim(i) < 0) + { + dim(i) = 0; + neg = true; + } + } + + if (neg) + warning_with_id ("Octave:neg-dim-as-zero", + "%s: converting negative dimension to zero", warnfor); +} + + +void +get_dimensions (const octave_value& a, const char *warn_for, + dim_vector& dim) +{ + if (a.is_scalar_type ()) + { + dim.resize (2); + dim(0) = a.int_value (); + dim(1) = dim(0); + } + else + { + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.columns (); + + if (nr == 1 || nc == 1) + { + Array v = a.vector_value (); + + if (error_state) + return; + + octave_idx_type n = v.length (); + dim.resize (n); + for (octave_idx_type i = 0; i < n; i++) + dim(i) = static_cast (fix (v(i))); + } + else + error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); + } + + if (! error_state) + check_dimensions (dim, warn_for); // May set error_state. +} + + +void +get_dimensions (const octave_value& a, const char *warn_for, + octave_idx_type& nr, octave_idx_type& nc) +{ + if (a.is_scalar_type ()) + { + nr = nc = a.int_value (); + } + else + { + nr = a.rows (); + nc = a.columns (); + + if ((nr == 1 && nc == 2) || (nr == 2 && nc == 1)) + { + Array v = a.vector_value (); + + if (error_state) + return; + + nr = static_cast (fix (v (0))); + nc = static_cast (fix (v (1))); + } + else + error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); + } + + if (! error_state) + check_dimensions (nr, nc, warn_for); // May set error_state. +} + +void +get_dimensions (const octave_value& a, const octave_value& b, + const char *warn_for, octave_idx_type& nr, octave_idx_type& nc) +{ + nr = a.is_empty () ? 0 : a.int_value (); + nc = b.is_empty () ? 0 : b.int_value (); + + if (error_state) + error ("%s: expecting two scalar arguments", warn_for); + else + check_dimensions (nr, nc, warn_for); // May set error_state. +} + +octave_idx_type +dims_to_numel (const dim_vector& dims, const octave_value_list& idx) +{ + octave_idx_type retval; + + octave_idx_type len = idx.length (); + + if (len == 0) + retval = dims.numel (); + else + { + const dim_vector dv = dims.redim (len); + retval = 1; + for (octave_idx_type i = 0; i < len; i++) + { + octave_value idxi = idx(i); + if (idxi.is_magic_colon ()) + retval *= dv(i); + else if (idxi.is_numeric_type ()) + retval *= idxi.numel (); + else + { + idx_vector jdx = idxi.index_vector (); + if (error_state) + break; + retval *= jdx.length (dv(i)); + } + } + } + + return retval; +} + +Matrix +identity_matrix (octave_idx_type nr, octave_idx_type nc) +{ + Matrix m (nr, nc, 0.0); + + if (nr > 0 && nc > 0) + { + octave_idx_type n = std::min (nr, nc); + + for (octave_idx_type i = 0; i < n; i++) + m (i, i) = 1.0; + } + + return m; +} + +FloatMatrix +float_identity_matrix (octave_idx_type nr, octave_idx_type nc) +{ + FloatMatrix m (nr, nc, 0.0); + + if (nr > 0 && nc > 0) + { + octave_idx_type n = std::min (nr, nc); + + for (octave_idx_type i = 0; i < n; i++) + m (i, i) = 1.0; + } + + return m; +} + +size_t +octave_format (std::ostream& os, const char *fmt, ...) +{ + size_t retval; + + va_list args; + va_start (args, fmt); + + retval = octave_vformat (os, fmt, args); + + va_end (args); + + return retval; +} + +size_t +octave_vformat (std::ostream& os, const char *fmt, va_list args) +{ + std::string s = octave_vasprintf (fmt, args); + + os << s; + + return s.length (); +} + +std::string +octave_vasprintf (const char *fmt, va_list args) +{ + std::string retval; + + char *result; + + int status = gnulib::vasprintf (&result, fmt, args); + + if (status >= 0) + { + retval = result; + ::free (result); + } + + return retval; +} + +std::string +octave_asprintf (const char *fmt, ...) +{ + std::string retval; + + va_list args; + va_start (args, fmt); + + retval = octave_vasprintf (fmt, args); + + va_end (args); + + return retval; +} + +void +octave_sleep (double seconds) +{ + if (seconds > 0) + { + double t; + + unsigned int usec + = static_cast (modf (seconds, &t) * 1000000); + + unsigned int sec + = (t > UINT_MAX) ? UINT_MAX : static_cast (t); + + // Versions of these functions that accept unsigned int args are + // defined in cutils.c. + octave_sleep (sec); + octave_usleep (usec); + + octave_quit (); + } +} + +DEFUN (isindex, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isindex (@var{ind})\n\ +@deftypefnx {Built-in Function} {} isindex (@var{ind}, @var{n})\n\ +Return true if @var{ind} is a valid index. Valid indices are\n\ +either positive integers (although possibly of real data type), or logical\n\ +arrays. If present, @var{n} specifies the maximum extent of the dimension\n\ +to be indexed. When possible the internal result is cached so that\n\ +subsequent indexing using @var{ind} will not perform the check again.\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + octave_idx_type n = 0; + + if (nargin == 2) + n = args(1).idx_type_value (); + else if (nargin != 1) + print_usage (); + + if (! error_state) + { + unwind_protect frame; + + frame.protect_var (Vallow_noninteger_range_as_index); + Vallow_noninteger_range_as_index = false; + + frame.protect_var (error_state); + + frame.protect_var (discard_error_messages); + discard_error_messages = true; + + try + { + idx_vector idx = args(0).index_vector (); + if (! error_state) + { + if (nargin == 2) + retval = idx.extent (n) <= n; + else + retval = true; + } + else + retval = false; + } + catch (octave_execution_exception) + { + retval = false; + } + } + + return retval; +} + +/* +%!assert (isindex ([1, 2, 3])) +%!assert (isindex (1:3)) +%!assert (isindex ([1, 2, -3]), false) + +%!error isindex () +*/ + +octave_value_list +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args, + int nargout) +{ + octave_value_list new_args = args, retval; + int nargin = args.length (); + OCTAVE_LOCAL_BUFFER (bool, iscell, nargin); + OCTAVE_LOCAL_BUFFER (Cell, cells, nargin); + OCTAVE_LOCAL_BUFFER (Cell, rcells, nargout); + + const Cell *ccells = cells; + + octave_idx_type numel = 1; + dim_vector dims (1, 1); + + for (int i = 0; i < nargin; i++) + { + octave_value arg = new_args(i); + iscell[i] = arg.is_cell (); + if (iscell[i]) + { + cells[i] = arg.cell_value (); + octave_idx_type n = ccells[i].numel (); + if (n == 1) + { + iscell[i] = false; + new_args(i) = ccells[i](0); + } + else if (numel == 1) + { + numel = n; + dims = ccells[i].dims (); + } + else if (dims != ccells[i].dims ()) + { + error ("%s: cell arguments must have matching sizes", fun_name); + break; + } + } + } + + if (! error_state) + { + for (int i = 0; i < nargout; i++) + rcells[i].clear (dims); + + for (octave_idx_type j = 0; j < numel; j++) + { + for (int i = 0; i < nargin; i++) + if (iscell[i]) + new_args(i) = ccells[i](j); + + octave_quit (); + + const octave_value_list tmp = fun (new_args, nargout); + + if (tmp.length () < nargout) + { + error ("%s: do_simple_cellfun: internal error", fun_name); + break; + } + else + { + for (int i = 0; i < nargout; i++) + rcells[i](j) = tmp(i); + } + } + } + + if (! error_state) + { + retval.resize (nargout); + for (int i = 0; i < nargout; i++) + retval(i) = rcells[i]; + } + + return retval; +} + +octave_value +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args) +{ + octave_value retval; + const octave_value_list tmp = do_simple_cellfun (fun, fun_name, args, 1); + if (tmp.length () > 0) + retval = tmp(0); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/utils.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/utils.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,130 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_utils_h) +#define octave_utils_h 1 + +#include + +#include +#include +#include + +#include "dMatrix.h" +#include "lo-utils.h" + +#include "cutils.h" + +class octave_value; +class octave_value_list; +class string_vector; + +extern OCTINTERP_API bool valid_identifier (const char *s); +extern OCTINTERP_API bool valid_identifier (const std::string& s); + +extern OCTINTERP_API bool +same_file (const std::string& f, const std::string& g); + +extern OCTINTERP_API int almost_match (const std::string& std, + const std::string& s, + int min_match_len = 1, + int case_sens = 1); + +extern OCTINTERP_API int +keyword_almost_match (const char * const *std, int *min_len, + const std::string& s, int min_toks_to_match, + int max_toks); + +extern OCTINTERP_API int empty_arg (const char *name, octave_idx_type nr, + octave_idx_type nc); + +extern OCTINTERP_API std::string +search_path_for_file (const std::string&, const string_vector&); + +extern OCTINTERP_API string_vector +search_path_for_all_files (const std::string&, const string_vector&); + +extern OCTINTERP_API std::string +file_in_path (const std::string&, const std::string&); + +extern OCTINTERP_API std::string contents_file_in_path (const std::string&); + +extern OCTINTERP_API std::string fcn_file_in_path (const std::string&); +extern OCTINTERP_API std::string oct_file_in_path (const std::string&); +extern OCTINTERP_API std::string mex_file_in_path (const std::string&); + +extern OCTINTERP_API std::string do_string_escapes (const std::string& s); + +extern OCTINTERP_API const char *undo_string_escape (char c); + +extern OCTINTERP_API std::string undo_string_escapes (const std::string& s); + +extern OCTINTERP_API void +check_dimensions (dim_vector& dim, const char *warnfor); + +extern OCTINTERP_API void +get_dimensions (const octave_value& a, const char *warn_for, + dim_vector& dim); + +extern OCTINTERP_API void +get_dimensions (const octave_value& a, const octave_value& b, + const char *warn_for, octave_idx_type& nr, + octave_idx_type& nc); + +extern OCTINTERP_API void +get_dimensions (const octave_value& a,const char *warn_for, + octave_idx_type& nr, octave_idx_type& nc); + +extern OCTINTERP_API octave_idx_type +dims_to_numel (const dim_vector& dims, const octave_value_list& idx); + +extern OCTINTERP_API Matrix +identity_matrix (octave_idx_type nr, octave_idx_type nc); + +extern OCTINTERP_API FloatMatrix +float_identity_matrix (octave_idx_type nr, octave_idx_type nc); + +extern OCTINTERP_API size_t +octave_format (std::ostream& os, const char *fmt, ...); + +extern OCTINTERP_API size_t +octave_vformat (std::ostream& os, const char *fmt, va_list args); + +extern OCTINTERP_API std::string +octave_vasprintf (const char *fmt, va_list args); + +extern OCTINTERP_API std::string octave_asprintf (const char *fmt, ...); + +extern OCTINTERP_API void octave_sleep (double seconds); + +extern OCTINTERP_API +octave_value_list +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args, + int nargout); + +extern OCTINTERP_API +octave_value +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args); + +#endif diff -r d02b229ce693 -r a132d206a36a src/interpfcn/variables.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/variables.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,2596 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include + +#include "file-stat.h" +#include "oct-env.h" +#include "file-ops.h" +#include "glob-match.h" +#include "regexp.h" +#include "str-vec.h" + +#include +#include "Cell.h" +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "help.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-class.h" +#include "ov-usr-fcn.h" +#include "pager.h" +#include "parse.h" +#include "symtab.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Defines layout for the whos/who -long command +static std::string Vwhos_line_format + = " %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\n"; + +void +clear_mex_functions (void) +{ + symbol_table::clear_mex_functions (); +} + +void +clear_function (const std::string& nm) +{ + symbol_table::clear_function (nm); +} + +void +clear_variable (const std::string& nm) +{ + symbol_table::clear_variable (nm); +} + +void +clear_symbol (const std::string& nm) +{ + symbol_table::clear_symbol (nm); +} + +// Attributes of variables and functions. + +// Is this octave_value a valid function? + +octave_function * +is_valid_function (const std::string& fcn_name, + const std::string& warn_for, bool warn) +{ + octave_function *ans = 0; + + if (! fcn_name.empty ()) + { + octave_value val = symbol_table::find_function (fcn_name); + + if (val.is_defined ()) + ans = val.function_value (true); + } + + if (! ans && warn) + error ("%s: the symbol `%s' is not valid as a function", + warn_for.c_str (), fcn_name.c_str ()); + + return ans; +} + +octave_function * +is_valid_function (const octave_value& arg, + const std::string& warn_for, bool warn) +{ + octave_function *ans = 0; + + std::string fcn_name; + + if (arg.is_string ()) + { + fcn_name = arg.string_value (); + + if (! error_state) + ans = is_valid_function (fcn_name, warn_for, warn); + else if (warn) + error ("%s: expecting function name as argument", warn_for.c_str ()); + } + else if (warn) + error ("%s: expecting function name as argument", warn_for.c_str ()); + + return ans; +} + +octave_function * +extract_function (const octave_value& arg, const std::string& warn_for, + const std::string& fname, const std::string& header, + const std::string& trailer) +{ + octave_function *retval = 0; + + retval = is_valid_function (arg, warn_for, 0); + + if (! retval) + { + std::string s = arg.string_value (); + + std::string cmd = header; + cmd.append (s); + cmd.append (trailer); + + if (! error_state) + { + int parse_status; + + eval_string (cmd, true, parse_status, 0); + + if (parse_status == 0) + { + retval = is_valid_function (fname, warn_for, 0); + + if (! retval) + { + error ("%s: `%s' is not valid as a function", + warn_for.c_str (), fname.c_str ()); + return retval; + } + + warning ("%s: passing function body as a string is obsolete; please use anonymous functions", + warn_for.c_str ()); + } + else + error ("%s: `%s' is not valid as a function", + warn_for.c_str (), fname.c_str ()); + } + else + error ("%s: expecting first argument to be a string", + warn_for.c_str ()); + } + + return retval; +} + +string_vector +get_struct_elts (const std::string& text) +{ + int n = 1; + + size_t pos = 0; + + size_t len = text.length (); + + while ((pos = text.find ('.', pos)) != std::string::npos) + { + if (++pos == len) + break; + + n++; + } + + string_vector retval (n); + + pos = 0; + + for (int i = 0; i < n; i++) + { + len = text.find ('.', pos); + + if (len != std::string::npos) + len -= pos; + + retval[i] = text.substr (pos, len); + + if (len != std::string::npos) + pos += len + 1; + } + + return retval; +} + +static inline bool +is_variable (const std::string& name) +{ + bool retval = false; + + if (! name.empty ()) + { + octave_value val = symbol_table::varval (name); + + retval = val.is_defined (); + } + + return retval; +} + +string_vector +generate_struct_completions (const std::string& text, + std::string& prefix, std::string& hint) +{ + string_vector names; + + size_t pos = text.rfind ('.'); + + if (pos != std::string::npos) + { + if (pos == text.length ()) + hint = ""; + else + hint = text.substr (pos+1); + + prefix = text.substr (0, pos); + + std::string base_name = prefix; + + pos = base_name.find_first_of ("{(."); + + if (pos != std::string::npos) + base_name = base_name.substr (0, pos); + + if (is_variable (base_name)) + { + int parse_status; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + octave_value tmp = eval_string (prefix, true, parse_status); + + frame.run (); + + if (tmp.is_defined () && tmp.is_map ()) + names = tmp.map_keys (); + } + } + + return names; +} + +// FIXME -- this will have to be much smarter to work +// "correctly". + +bool +looks_like_struct (const std::string& text) +{ + bool retval = (! text.empty () + && text != "." + && text.find_first_of (file_ops::dir_sep_chars ()) == std::string::npos + && text.find ("..") == std::string::npos + && text.rfind ('.') != std::string::npos); + +#if 0 + symbol_record *sr = curr_sym_tab->lookup (text); + + if (sr && ! sr->is_function ()) + { + int parse_status; + + unwind_protect frame; + + frame.protect_var (discard_error_messages); + frame.protect_var (error_state); + + discard_error_messages = true; + + octave_value tmp = eval_string (text, true, parse_status); + + frame.run (); + + retval = (tmp.is_defined () && tmp.is_map ()); + } +#endif + + return retval; +} + +static octave_value +do_isglobal (const octave_value_list& args) +{ + octave_value retval = false; + + int nargin = args.length (); + + if (nargin != 1) + { + print_usage (); + return retval; + } + + std::string name = args(0).string_value (); + + if (error_state) + { + error ("isglobal: NAME must be a string"); + return retval; + } + + return symbol_table::is_global (name); +} + +DEFUN (isglobal, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isglobal (@var{name})\n\ +Return true if @var{name} is a globally visible variable.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +global x\n\ +isglobal (\"x\")\n\ + @result{} 1\n\ +@end group\n\ +@end example\n\ +@seealso{isvarname, exist}\n\ +@end deftypefn") +{ + return do_isglobal (args); +} + +static octave_value +safe_symbol_lookup (const std::string& symbol_name) +{ + octave_value retval; + + unwind_protect frame; + interpreter_try (frame); + + retval = symbol_table::find (symbol_name); + + error_state = 0; + + return retval; +} + +int +symbol_exist (const std::string& name, const std::string& type) +{ + int retval = 0; + + std::string struct_elts; + std::string symbol_name = name; + + size_t pos = name.find ('.'); + + if (pos != std::string::npos && pos > 0) + { + struct_elts = name.substr (pos+1); + symbol_name = name.substr (0, pos); + } + + // We shouldn't need to look in the global symbol table, since any + // name that is visible in the current scope will be in the local + // symbol table. + + octave_value val = safe_symbol_lookup (symbol_name); + + if (val.is_defined ()) + { + bool not_a_struct = struct_elts.empty (); + bool var_ok = not_a_struct /* || val.is_map_element (struct_elts) */; + + if (! retval + && var_ok + && (type == "any" || type == "var") + && (val.is_constant () || val.is_object () + || val.is_function_handle () + || val.is_anonymous_function () + || val.is_inline_function ())) + { + retval = 1; + } + + if (! retval + && (type == "any" || type == "builtin")) + { + if (not_a_struct && val.is_builtin_function ()) + { + retval = 5; + } + } + + if (! retval + && not_a_struct + && (type == "any" || type == "file") + && (val.is_user_function () || val.is_dld_function ())) + { + octave_function *f = val.function_value (true); + std::string s = f ? f->fcn_file_name () : std::string (); + + retval = s.empty () ? 103 : (val.is_user_function () ? 2 : 3); + } + } + + if (! (type == "var" || type == "builtin")) + { + if (! retval) + { + std::string file_name = lookup_autoload (name); + + if (file_name.empty ()) + file_name = load_path::find_fcn (name); + + size_t len = file_name.length (); + + if (len > 0) + { + if (type == "any" || type == "file") + { + if (len > 4 && (file_name.substr (len-4) == ".oct" + || file_name.substr (len-4) == ".mex")) + retval = 3; + else + retval = 2; + } + } + } + + if (! retval) + { + std::string file_name = file_in_path (name, ""); + + if (file_name.empty ()) + file_name = name; + + file_stat fs (file_name); + + if (fs) + { + if (type == "any" || type == "file") + retval = fs.is_dir () ? 7 : 2; + else if (type == "dir" && fs.is_dir ()) + retval = 7; + } + } + } + + return retval; +} + +#define GET_IDX(LEN) \ + static_cast ((LEN-1) * static_cast (rand ()) / RAND_MAX) + +std::string +unique_symbol_name (const std::string& basename) +{ + static const std::string alpha + = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; + + static size_t len = alpha.length (); + + std::string nm = basename + alpha[GET_IDX (len)]; + + size_t pos = nm.length (); + + if (nm.substr (0, 2) == "__") + nm.append ("__"); + + while (symbol_exist (nm, "any")) + nm.insert (pos++, 1, alpha[GET_IDX (len)]); + + return nm; +} + +DEFUN (exist, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} exist (@var{name}, @var{type})\n\ +Return 1 if the name exists as a variable, 2 if the name is an\n\ +absolute file name, an ordinary file in Octave's @code{path}, or (after\n\ +appending @samp{.m}) a function file in Octave's @code{path}, 3 if the\n\ +name is a @samp{.oct} or @samp{.mex} file in Octave's @code{path},\n\ +5 if the name is a built-in function, 7 if the name is a directory, or 103\n\ +if the name is a function not associated with a file (entered on\n\ +the command line).\n\ +\n\ +Otherwise, return 0.\n\ +\n\ +This function also returns 2 if a regular file called @var{name}\n\ +exists in Octave's search path. If you want information about\n\ +other types of files, you should use some combination of the functions\n\ +@code{file_in_path} and @code{stat} instead.\n\ +\n\ +If the optional argument @var{type} is supplied, check only for\n\ +symbols of the specified type. Valid types are\n\ +\n\ +@table @asis\n\ +@item \"var\"\n\ +Check only for variables.\n\ +\n\ +@item \"builtin\"\n\ +Check only for built-in functions.\n\ +\n\ +@item \"file\"\n\ +Check only for files.\n\ +\n\ +@item \"dir\"\n\ +Check only for directories.\n\ +@end table\n\ +\n\ +@seealso{file_in_loadpath}\n\ +@end deftypefn") +{ + octave_value retval = false; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + std::string type + = (nargin == 2) ? args(1).string_value () : std::string ("any"); + + if (! error_state) + retval = symbol_exist (name, type); + else + error ("exist: TYPE must be a string"); + } + else + error ("exist: NAME must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! if (isunix ()) +%! assert (exist ("/tmp") == 7); +%! assert (exist ("/tmp", "file") == 7); +%! assert (exist ("/tmp", "dir") == 7); +%! assert (exist ("/bin/sh") == 2); +%! assert (exist ("/bin/sh", "file") == 2); +%! assert (exist ("/bin/sh", "dir") == 0); +%! assert (exist ("/dev/null") == 2); +%! assert (exist ("/dev/null", "file") == 2); +%! assert (exist ("/dev/null", "dir") == 0); +%! endif +*/ + +octave_value +lookup_function_handle (const std::string& nm) +{ + octave_value val = symbol_table::varval (nm); + + return val.is_function_handle () ? val : octave_value (); +} + +octave_value +get_global_value (const std::string& nm, bool silent) +{ + octave_value val = symbol_table::global_varval (nm); + + if (val.is_undefined () && ! silent) + error ("get_global_value: undefined symbol `%s'", nm.c_str ()); + + return val; +} + +void +set_global_value (const std::string& nm, const octave_value& val) +{ + symbol_table::global_varref (nm) = val; +} + +octave_value +get_top_level_value (const std::string& nm, bool silent) +{ + octave_value val = symbol_table::top_level_varval (nm); + + if (val.is_undefined () && ! silent) + error ("get_top_level_value: undefined symbol `%s'", nm.c_str ()); + + return val; +} + +void +set_top_level_value (const std::string& nm, const octave_value& val) +{ + symbol_table::top_level_varref (nm) = val; +} + +// Variable values. + +static bool +wants_local_change (const octave_value_list& args, int& nargin) +{ + bool retval = false; + + if (nargin == 2) + { + if (args(1).is_string () && args(1).string_value () == "local") + { + nargin = 1; + retval = true; + } + else + { + error_with_cfn ("expecting second argument to be \"local\""); + nargin = 0; + } + } + + return retval; +} + +template +bool try_local_protect (T& var) +{ + octave_user_code *curr_usr_code = octave_call_stack::caller_user_code (); + octave_user_function *curr_usr_fcn = 0; + if (curr_usr_code && curr_usr_code->is_user_function ()) + curr_usr_fcn = dynamic_cast (curr_usr_code); + + if (curr_usr_fcn && curr_usr_fcn->local_protect (var)) + return true; + else + return false; +} + +octave_value +set_internal_variable (bool& var, const octave_value_list& args, + int nargout, const char *nm) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + bool bval = args(0).bool_value (); + + if (! error_state) + var = bval; + else + error ("%s: expecting arg to be a logical value", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (char& var, const octave_value_list& args, + int nargout, const char *nm) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + switch (sval.length ()) + { + case 1: + var = sval[0]; + break; + + case 0: + var = '\0'; + break; + + default: + error ("%s: argument must be a single character", nm); + break; + } + } + else + error ("%s: argument must be a single character", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, + int minval, int maxval) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + int ival = args(0).int_value (); + + if (! error_state) + { + if (ival < minval) + error ("%s: expecting arg to be greater than %d", nm, minval); + else if (ival > maxval) + error ("%s: expecting arg to be less than or equal to %d", + nm, maxval); + else + var = ival; + } + else + error ("%s: expecting arg to be an integer value", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (double& var, const octave_value_list& args, + int nargout, const char *nm, + double minval, double maxval) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + double dval = args(0).scalar_value (); + + if (! error_state) + { + if (dval < minval) + error ("%s: expecting arg to be greater than %g", minval); + else if (dval > maxval) + error ("%s: expecting arg to be less than or equal to %g", maxval); + else + var = dval; + } + else + error ("%s: expecting arg to be a scalar value", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (std::string& var, const octave_value_list& args, + int nargout, const char *nm, bool empty_ok) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + if (empty_ok || ! sval.empty ()) + var = sval; + else + error ("%s: value must not be empty", nm); + } + else + error ("%s: expecting arg to be a character string", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, const char **choices) +{ + octave_value retval; + int nchoices = 0; + while (choices[nchoices] != 0) + nchoices++; + + int nargin = args.length (); + assert (var < nchoices); + + if (nargout > 0 || nargin == 0) + retval = choices[var]; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + int i = 0; + for (; i < nchoices; i++) + { + if (sval == choices[i]) + { + var = i; + break; + } + } + if (i == nchoices) + error ("%s: value not allowed (\"%s\")", nm, sval.c_str ()); + } + else + error ("%s: expecting arg to be a character string", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +struct +whos_parameter +{ + char command; + char modifier; + int parameter_length; + int first_parameter_length; + int balance; + std::string text; + std::string line; +}; + +static void +print_descriptor (std::ostream& os, std::list params) +{ + // This method prints a line of information on a given symbol + std::list::iterator i = params.begin (); + std::ostringstream param_buf; + + while (i != params.end ()) + { + whos_parameter param = *i; + + if (param.command != '\0') + { + // Do the actual printing + switch (param.modifier) + { + case 'l': + os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + break; + + case 'r': + os << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); + break; + + case 'c': + if (param.command != 's') + { + os << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + } + break; + + default: + os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + } + + if (param.command == 's' && param.modifier == 'c') + { + int a, b; + + if (param.modifier == 'c') + { + a = param.first_parameter_length - param.balance; + a = (a < 0 ? 0 : a); + b = param.parameter_length - a - param.text . length (); + b = (b < 0 ? 0 : b); + os << std::setiosflags (std::ios::left) << std::setw (a) + << "" << std::resetiosflags (std::ios::left) << param.text + << std::setiosflags (std::ios::left) + << std::setw (b) << "" + << std::resetiosflags (std::ios::left); + param_buf << std::setiosflags (std::ios::left) << std::setw (a) + << "" << std::resetiosflags (std::ios::left) << param.line + << std::setiosflags (std::ios::left) + << std::setw (b) << "" + << std::resetiosflags (std::ios::left); + } + } + else + { + os << param.text; + param_buf << param.line; + } + os << std::resetiosflags (std::ios::left) + << std::resetiosflags (std::ios::right); + param_buf << std::resetiosflags (std::ios::left) + << std::resetiosflags (std::ios::right); + i++; + } + else + { + os << param.text; + param_buf << param.line; + i++; + } + } + + os << param_buf.str (); +} + +// FIXME -- This is a bit of a kluge. We'd like to just use val.dims() +// and if val is an object, expect that dims will call size if it is +// overloaded by a user-defined method. But there are currently some +// unresolved const issues that prevent that solution from working. + +std::string +get_dims_str (const octave_value& val) +{ + octave_value tmp = val; + + Matrix sz = tmp.size (); + + dim_vector dv = dim_vector::alloc (sz.numel ()); + + for (octave_idx_type i = 0; i < dv.length (); i++) + dv(i) = sz(i); + + return dv.str (); +} + +class +symbol_info_list +{ +private: + struct symbol_info + { + symbol_info (const symbol_table::symbol_record& sr, + const std::string& expr_str = std::string (), + const octave_value& expr_val = octave_value ()) + : name (expr_str.empty () ? sr.name () : expr_str), + varval (expr_val.is_undefined () ? sr.varval () : expr_val), + is_automatic (sr.is_automatic ()), + is_complex (varval.is_complex_type ()), + is_formal (sr.is_formal ()), + is_global (sr.is_global ()), + is_persistent (sr.is_persistent ()) + { } + + void display_line (std::ostream& os, + const std::list& params) const + { + std::string dims_str = get_dims_str (varval); + + std::list::const_iterator i = params.begin (); + + while (i != params.end ()) + { + whos_parameter param = *i; + + if (param.command != '\0') + { + // Do the actual printing. + + switch (param.modifier) + { + case 'l': + os << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + break; + + case 'r': + os << std::setiosflags (std::ios::right) + << std::setw (param.parameter_length); + break; + + case 'c': + if (param.command == 's') + { + int front = param.first_parameter_length + - dims_str.find ('x'); + int back = param.parameter_length + - dims_str.length () + - front; + front = (front > 0) ? front : 0; + back = (back > 0) ? back : 0; + + os << std::setiosflags (std::ios::left) + << std::setw (front) + << "" + << std::resetiosflags (std::ios::left) + << dims_str + << std::setiosflags (std::ios::left) + << std::setw (back) + << "" + << std::resetiosflags (std::ios::left); + } + else + { + os << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + } + break; + + default: + error ("whos_line_format: modifier `%c' unknown", + param.modifier); + + os << std::setiosflags (std::ios::right) + << std::setw (param.parameter_length); + } + + switch (param.command) + { + case 'a': + { + char tmp[6]; + + tmp[0] = (is_automatic ? 'a' : ' '); + tmp[1] = (is_complex ? 'c' : ' '); + tmp[2] = (is_formal ? 'f' : ' '); + tmp[3] = (is_global ? 'g' : ' '); + tmp[4] = (is_persistent ? 'p' : ' '); + tmp[5] = 0; + + os << tmp; + } + break; + + case 'b': + os << varval.byte_size (); + break; + + case 'c': + os << varval.class_name (); + break; + + case 'e': + os << varval.capacity (); + break; + + case 'n': + os << name; + break; + + case 's': + if (param.modifier != 'c') + os << dims_str; + break; + + case 't': + os << varval.type_name (); + break; + + default: + error ("whos_line_format: command `%c' unknown", + param.command); + } + + os << std::resetiosflags (std::ios::left) + << std::resetiosflags (std::ios::right); + i++; + } + else + { + os << param.text; + i++; + } + } + } + + std::string name; + octave_value varval; + bool is_automatic; + bool is_complex; + bool is_formal; + bool is_global; + bool is_persistent; + }; + +public: + symbol_info_list (void) : lst () { } + + symbol_info_list (const symbol_info_list& sil) : lst (sil.lst) { } + + symbol_info_list& operator = (const symbol_info_list& sil) + { + if (this != &sil) + lst = sil.lst; + + return *this; + } + + ~symbol_info_list (void) { } + + void append (const symbol_table::symbol_record& sr) + { + lst.push_back (symbol_info (sr)); + } + + void append (const symbol_table::symbol_record& sr, + const std::string& expr_str, + const octave_value& expr_val) + { + lst.push_back (symbol_info (sr, expr_str, expr_val)); + } + + size_t size (void) const { return lst.size (); } + + bool empty (void) const { return lst.empty (); } + + octave_map + map_value (const std::string& caller_function_name, int nesting_level) const + { + size_t len = lst.size (); + + Cell name_info (len, 1); + Cell size_info (len, 1); + Cell bytes_info (len, 1); + Cell class_info (len, 1); + Cell global_info (len, 1); + Cell sparse_info (len, 1); + Cell complex_info (len, 1); + Cell nesting_info (len, 1); + Cell persistent_info (len, 1); + + std::list::const_iterator p = lst.begin (); + + for (size_t j = 0; j < len; j++) + { + const symbol_info& si = *p++; + + octave_scalar_map ni; + + ni.assign ("function", caller_function_name); + ni.assign ("level", nesting_level); + + name_info(j) = si.name; + global_info(j) = si.is_global; + persistent_info(j) = si.is_persistent; + + octave_value val = si.varval; + + size_info(j) = val.size (); + bytes_info(j) = val.byte_size (); + class_info(j) = val.class_name (); + sparse_info(j) = val.is_sparse_type (); + complex_info(j) = val.is_complex_type (); + nesting_info(j) = ni; + } + + octave_map info; + + info.assign ("name", name_info); + info.assign ("size", size_info); + info.assign ("bytes", bytes_info); + info.assign ("class", class_info); + info.assign ("global", global_info); + info.assign ("sparse", sparse_info); + info.assign ("complex", complex_info); + info.assign ("nesting", nesting_info); + info.assign ("persistent", persistent_info); + + return info; + } + + void display (std::ostream& os) + { + if (! lst.empty ()) + { + size_t bytes = 0; + size_t elements = 0; + + std::list params = parse_whos_line_format (); + + print_descriptor (os, params); + + octave_stdout << "\n"; + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + { + p->display_line (os, params); + + octave_value val = p->varval; + + elements += val.capacity (); + bytes += val.byte_size (); + } + + os << "\nTotal is " << elements + << (elements == 1 ? " element" : " elements") + << " using " << bytes << (bytes == 1 ? " byte" : " bytes") + << "\n"; + } + } + + // Parse the string whos_line_format, and return a parameter list, + // containing all information needed to print the given + // attributtes of the symbols. + std::list parse_whos_line_format (void) + { + int idx; + size_t format_len = Vwhos_line_format.length (); + char garbage; + std::list params; + + size_t bytes1; + int elements1; + + std::string param_string = "abcenst"; + Array param_length (dim_vector (param_string.length (), 1)); + Array param_names (dim_vector (param_string.length (), 1)); + size_t pos_a, pos_b, pos_c, pos_e, pos_n, pos_s, pos_t; + + pos_a = param_string.find ('a'); // Attributes + pos_b = param_string.find ('b'); // Bytes + pos_c = param_string.find ('c'); // Class + pos_e = param_string.find ('e'); // Elements + pos_n = param_string.find ('n'); // Name + pos_s = param_string.find ('s'); // Size + pos_t = param_string.find ('t'); // Type + + param_names(pos_a) = "Attr"; + param_names(pos_b) = "Bytes"; + param_names(pos_c) = "Class"; + param_names(pos_e) = "Elements"; + param_names(pos_n) = "Name"; + param_names(pos_s) = "Size"; + param_names(pos_t) = "Type"; + + for (size_t i = 0; i < param_string.length (); i++) + param_length(i) = param_names(i).length (); + + // The attribute column needs size 5. + param_length(pos_a) = 5; + + // Calculating necessary spacing for name column, + // bytes column, elements column and class column + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + { + std::stringstream ss1, ss2; + std::string str; + + str = p->name; + param_length(pos_n) = ((str.length () + > static_cast (param_length(pos_n))) + ? str.length () : param_length(pos_n)); + + octave_value val = p->varval; + + str = val.type_name (); + param_length(pos_t) = ((str.length () + > static_cast (param_length(pos_t))) + ? str.length () : param_length(pos_t)); + + elements1 = val.capacity (); + ss1 << elements1; + str = ss1.str (); + param_length(pos_e) = ((str.length () + > static_cast (param_length(pos_e))) + ? str.length () : param_length(pos_e)); + + bytes1 = val.byte_size (); + ss2 << bytes1; + str = ss2.str (); + param_length(pos_b) = ((str.length () + > static_cast (param_length(pos_b))) + ? str.length () : param_length (pos_b)); + } + + idx = 0; + while (static_cast (idx) < format_len) + { + whos_parameter param; + param.command = '\0'; + + if (Vwhos_line_format[idx] == '%') + { + bool error_encountered = false; + param.modifier = 'r'; + param.parameter_length = 0; + + int a = 0, b = -1, balance = 1; + unsigned int items; + size_t pos; + std::string cmd; + + // Parse one command from whos_line_format + cmd = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); + pos = cmd.find (';'); + if (pos != std::string::npos) + cmd = cmd.substr (0, pos+1); + else + error ("parameter without ; in whos_line_format"); + + idx += cmd.length (); + + // FIXME -- use iostream functions instead of sscanf! + + if (cmd.find_first_of ("crl") != 1) + items = sscanf (cmd.c_str (), "%c%c:%d:%d:%d;", + &garbage, ¶m.command, &a, &b, &balance); + else + items = sscanf (cmd.c_str (), "%c%c%c:%d:%d:%d;", + &garbage, ¶m.modifier, ¶m.command, + &a, &b, &balance) - 1; + + if (items < 2) + { + error ("whos_line_format: parameter structure without command in whos_line_format"); + error_encountered = true; + } + + // Insert data into parameter + param.first_parameter_length = 0; + pos = param_string.find (param.command); + if (pos != std::string::npos) + { + param.parameter_length = param_length(pos); + param.text = param_names(pos); + param.line.assign (param_names(pos).length (), '='); + + param.parameter_length = (a > param.parameter_length + ? a : param.parameter_length); + if (param.command == 's' && param.modifier == 'c' && b > 0) + param.first_parameter_length = b; + } + else + { + error ("whos_line_format: '%c' is not a command", + param.command); + error_encountered = true; + } + + if (param.command == 's') + { + // Have to calculate space needed for printing + // matrix dimensions Space needed for Size column is + // hard to determine in prior, because it depends on + // dimensions to be shown. That is why it is + // recalculated for each Size-command int first, + // rest = 0, total; + int rest = 0; + int first = param.first_parameter_length; + int total = param.parameter_length; + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + { + octave_value val = p->varval; + std::string dims_str = get_dims_str (val); + int first1 = dims_str.find ('x'); + int total1 = dims_str.length (); + int rest1 = total1 - first1; + rest = (rest1 > rest ? rest1 : rest); + first = (first1 > first ? first1 : first); + total = (total1 > total ? total1 : total); + } + + if (param.modifier == 'c') + { + if (first < balance) + first += balance - first; + if (rest + balance < param.parameter_length) + rest += param.parameter_length - rest - balance; + + param.parameter_length = first + rest; + param.first_parameter_length = first; + param.balance = balance; + } + else + { + param.parameter_length = total; + param.first_parameter_length = 0; + } + } + else if (param.modifier == 'c') + { + error ("whos_line_format: modifier 'c' not available for command '%c'", + param.command); + error_encountered = true; + } + + // What happens if whos_line_format contains negative numbers + // at param_length positions? + param.balance = (b < 0 ? 0 : param.balance); + param.first_parameter_length = (b < 0 ? 0 : + param.first_parameter_length); + param.parameter_length = (a < 0 + ? 0 + : (param.parameter_length + < param_length(pos_s) + ? param_length(pos_s) + : param.parameter_length)); + + // Parameter will not be pushed into parameter list if ... + if (! error_encountered) + params.push_back (param); + } + else + { + // Text string, to be printed as it is ... + std::string text; + size_t pos; + text = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); + pos = text.find ('%'); + if (pos != std::string::npos) + text = text.substr (0, pos); + + // Push parameter into list ... + idx += text.length (); + param.text=text; + param.line.assign (text.length (), ' '); + params.push_back (param); + } + } + + return params; + } + +private: + std::list lst; + +}; + +static octave_value +do_who (int argc, const string_vector& argv, bool return_list, + bool verbose = false, std::string msg = std::string ()) +{ + octave_value retval; + + std::string my_name = argv[0]; + + bool global_only = false; + bool have_regexp = false; + + int i; + for (i = 1; i < argc; i++) + { + if (argv[i] == "-file") + { + // FIXME. This is an inefficient manner to implement this as the + // variables are loaded in to a temporary context and then treated. + // It would be better to refecat symbol_info_list to not store the + // symbol records and then use it in load-save.cc (do_load) to + // implement this option there so that the variables are never + // stored at all. + if (i == argc - 1) + error ("whos: -file argument must be followed by a file name"); + else + { + std::string nm = argv[i + 1]; + + unwind_protect frame; + + // Set up temporary scope. + + symbol_table::scope_id tmp_scope = symbol_table::alloc_scope (); + frame.add_fcn (symbol_table::erase_scope, tmp_scope); + + symbol_table::set_scope (tmp_scope); + + octave_call_stack::push (tmp_scope, 0); + frame.add_fcn (octave_call_stack::pop); + + frame.add_fcn (symbol_table::clear_variables); + + feval ("load", octave_value (nm), 0); + + if (! error_state) + { + std::string newmsg = std::string ("Variables in the file ") + + nm + ":\n\n"; + + retval = do_who (i, argv, return_list, verbose, newmsg); + } + } + + return retval; + } + else if (argv[i] == "-regexp") + have_regexp = true; + else if (argv[i] == "global") + global_only = true; + else if (argv[i][0] == '-') + warning ("%s: unrecognized option `%s'", my_name.c_str (), + argv[i].c_str ()); + else + break; + } + + int npats = argc - i; + string_vector pats; + if (npats > 0) + { + pats.resize (npats); + for (int j = 0; j < npats; j++) + pats[j] = argv[i+j]; + } + else + { + pats.resize (++npats); + pats[0] = "*"; + } + + symbol_info_list symbol_stats; + std::list symbol_names; + + for (int j = 0; j < npats; j++) + { + std::string pat = pats[j]; + + if (have_regexp) + { + std::list tmp = global_only + ? symbol_table::regexp_global_variables (pat) + : symbol_table::regexp_variables (pat); + + for (std::list::const_iterator p = tmp.begin (); + p != tmp.end (); p++) + { + if (p->is_variable ()) + { + if (verbose) + symbol_stats.append (*p); + else + symbol_names.push_back (p->name ()); + } + } + } + else + { + size_t pos = pat.find_first_of (".({"); + + if (pos != std::string::npos && pos > 0) + { + if (verbose) + { + // NOTE: we can only display information for + // expressions based on global values if the variable is + // global in the current scope because we currently have + // no way of looking up the base value in the global + // scope and then evaluating the arguments in the + // current scope. + + std::string base_name = pat.substr (0, pos); + + if (symbol_table::is_variable (base_name)) + { + symbol_table::symbol_record sr + = symbol_table::find_symbol (base_name); + + if (! global_only || sr.is_global ()) + { + int parse_status; + + octave_value expr_val + = eval_string (pat, true, parse_status); + + if (! error_state) + symbol_stats.append (sr, pat, expr_val); + else + return retval; + } + } + } + } + else + { + std::list tmp = global_only + ? symbol_table::glob_global_variables (pat) + : symbol_table::glob_variables (pat); + + for (std::list::const_iterator p = tmp.begin (); + p != tmp.end (); p++) + { + if (p->is_variable ()) + { + if (verbose) + symbol_stats.append (*p); + else + symbol_names.push_back (p->name ()); + } + } + } + } + } + + if (return_list) + { + if (verbose) + { + std::string caller_function_name; + octave_function *caller = octave_call_stack::caller (); + if (caller) + caller_function_name = caller->name (); + + retval = symbol_stats.map_value (caller_function_name, 1); + } + else + retval = Cell (string_vector (symbol_names)); + } + else if (! (symbol_stats.empty () && symbol_names.empty ())) + { + if (msg.length () == 0) + if (global_only) + octave_stdout << "Global variables:\n\n"; + else + octave_stdout << "Variables in the current scope:\n\n"; + else + octave_stdout << msg; + + if (verbose) + symbol_stats.display (octave_stdout); + else + { + string_vector names (symbol_names); + + names.list_in_columns (octave_stdout); + } + + octave_stdout << "\n"; + } + + return retval; +} + +DEFUN (who, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} who\n\ +@deftypefnx {Command} {} who pattern @dots{}\n\ +@deftypefnx {Command} {} who option pattern @dots{}\n\ +@deftypefnx {Command} {C =} who (\"pattern\", @dots{})\n\ +List currently defined variables matching the given patterns. Valid\n\ +pattern syntax is the same as described for the @code{clear} command.\n\ +If no patterns are supplied, all variables are listed.\n\ +By default, only variables visible in the local scope are displayed.\n\ +\n\ +The following are valid options but may not be combined.\n\ +\n\ +@table @code\n\ +@item global\n\ +List variables in the global scope rather than the current scope.\n\ +\n\ +@item -regexp\n\ +The patterns are considered to be regular expressions when matching the\n\ +variables to display. The same pattern syntax accepted by\n\ +the @code{regexp} function is used.\n\ +\n\ +@item -file\n\ +The next argument is treated as a filename. All variables found within the\n\ +specified file are listed. No patterns are accepted when reading variables\n\ +from a file.\n\ +@end table\n\ +\n\ +If called as a function, return a cell array of defined variable names\n\ +matching the given patterns.\n\ +@seealso{whos, isglobal, isvarname, exist, regexp}\n\ +@end deftypefn") +{ + octave_value retval; + + if (nargout < 2) + { + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("who"); + + if (! error_state) + retval = do_who (argc, argv, nargout == 1); + } + else + print_usage (); + + return retval; +} + +DEFUN (whos, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} whos\n\ +@deftypefnx {Command} {} whos pattern @dots{}\n\ +@deftypefnx {Command} {} whos option pattern @dots{}\n\ +@deftypefnx {Command} {S =} whos (\"pattern\", @dots{})\n\ +Provide detailed information on currently defined variables matching the\n\ +given patterns. Options and pattern syntax are the same as for the\n\ +@code{who} command. Extended information about each variable is\n\ +summarized in a table with the following default entries.\n\ +\n\ +@table @asis\n\ +@item Attr\n\ +Attributes of the listed variable. Possible attributes are:\n\ +\n\ +@table @asis\n\ +@item blank\n\ +Variable in local scope\n\ +\n\ +@item @code{a}\n\ +Automatic variable. An automatic variable is one created by the\n\ +interpreter, for example @code{argn}.\n\ +\n\ +@item @code{c}\n\ +Variable of complex type.\n\ +\n\ +@item @code{f}\n\ +Formal parameter (function argument).\n\ +\n\ +@item @code{g}\n\ +Variable with global scope.\n\ +\n\ +@item @code{p}\n\ +Persistent variable.\n\ +@end table\n\ +\n\ +@item Name\n\ +The name of the variable.\n\ +\n\ +@item Size\n\ +The logical size of the variable. A scalar is 1x1, a vector is\n\ +@nospell{1xN} or @nospell{Nx1}, a 2-D matrix is @nospell{MxN}.\n\ +\n\ +@item Bytes\n\ +The amount of memory currently used to store the variable.\n\ +\n\ +@item Class\n\ +The class of the variable. Examples include double, single, char, uint16,\n\ +cell, and struct.\n\ +@end table\n\ +\n\ +The table can be customized to display more or less information through\n\ +the function @code{whos_line_format}.\n\ +\n\ +If @code{whos} is called as a function, return a struct array of defined\n\ +variable names matching the given patterns. Fields in the structure\n\ +describing each variable are: name, size, bytes, class, global, sparse,\n\ +complex, nesting, persistent.\n\ +@seealso{who, whos_line_format}\n\ +@end deftypefn") +{ + octave_value retval; + + if (nargout < 2) + { + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("whos"); + + if (! error_state) + retval = do_who (argc, argv, nargout == 1, true); + } + else + print_usage (); + + return retval; +} + +// Defining variables. + +void +bind_ans (const octave_value& val, bool print) +{ + static std::string ans = "ans"; + + if (val.is_defined ()) + { + if (val.is_cs_list ()) + { + octave_value_list lst = val.list_value (); + + for (octave_idx_type i = 0; i < lst.length (); i++) + bind_ans (lst(i), print); + } + else + { + symbol_table::varref (ans) = val; + + if (print) + val.print_with_name (octave_stdout, ans); + } + } +} + +void +bind_internal_variable (const std::string& fname, const octave_value& val) +{ + octave_value_list args; + + args(0) = val; + + feval (fname, args, 0); +} + +void +mlock (void) +{ + octave_function *fcn = octave_call_stack::current (); + + if (fcn) + fcn->lock (); + else + error ("mlock: invalid use outside a function"); +} + +void +munlock (const std::string& nm) +{ + octave_value val = symbol_table::find_function (nm); + + if (val.is_defined ()) + { + octave_function *fcn = val.function_value (); + + if (fcn) + fcn->unlock (); + } +} + +bool +mislocked (const std::string& nm) +{ + bool retval = false; + + octave_value val = symbol_table::find_function (nm); + + if (val.is_defined ()) + { + octave_function *fcn = val.function_value (); + + if (fcn) + retval = fcn->islocked (); + } + + return retval; +} + +DEFUN (mlock, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mlock ()\n\ +Lock the current function into memory so that it can't be cleared.\n\ +@seealso{munlock, mislocked, persistent}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 0) + { + octave_function *fcn = octave_call_stack::caller (); + + if (fcn) + fcn->lock (); + else + error ("mlock: invalid use outside a function"); + } + else + print_usage (); + + return retval; +} + +DEFUN (munlock, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} munlock ()\n\ +@deftypefnx {Built-in Function} {} munlock (@var{fcn})\n\ +Unlock the named function @var{fcn}. If no function is named\n\ +then unlock the current function.\n\ +@seealso{mlock, mislocked, persistent}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + munlock (name); + else + error ("munlock: FCN must be a string"); + } + else if (args.length () == 0) + { + octave_function *fcn = octave_call_stack::caller (); + + if (fcn) + fcn->unlock (); + else + error ("munlock: invalid use outside a function"); + } + else + print_usage (); + + return retval; +} + + +DEFUN (mislocked, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mislocked ()\n\ +@deftypefnx {Built-in Function} {} mislocked (@var{fcn})\n\ +Return true if the named function @var{fcn} is locked. If no function is\n\ +named then return true if the current function is locked.\n\ +@seealso{mlock, munlock, persistent}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + retval = mislocked (name); + else + error ("mislocked: FCN must be a string"); + } + else if (args.length () == 0) + { + octave_function *fcn = octave_call_stack::caller (); + + if (fcn) + retval = fcn->islocked (); + else + error ("mislocked: invalid use outside a function"); + } + else + print_usage (); + + return retval; +} + +// Deleting names from the symbol tables. + +static inline bool +name_matches_any_pattern (const std::string& nm, const string_vector& argv, + int argc, int idx, bool have_regexp = false) +{ + bool retval = false; + + for (int k = idx; k < argc; k++) + { + std::string patstr = argv[k]; + if (! patstr.empty ()) + { + if (have_regexp) + { + if (is_regexp_match (patstr, nm)) + { + retval = true; + break; + } + } + else + { + glob_match pattern (patstr); + + if (pattern.match (nm)) + { + retval = true; + break; + } + } + } + } + + return retval; +} + +static inline void +maybe_warn_exclusive (bool exclusive) +{ + if (exclusive) + warning ("clear: ignoring --exclusive option"); +} + +static void +do_clear_functions (const string_vector& argv, int argc, int idx, + bool exclusive = false) +{ + if (idx == argc) + symbol_table::clear_functions (); + else + { + if (exclusive) + { + string_vector fcns = symbol_table::user_function_names (); + + int fcount = fcns.length (); + + for (int i = 0; i < fcount; i++) + { + std::string nm = fcns[i]; + + if (! name_matches_any_pattern (nm, argv, argc, idx)) + symbol_table::clear_function (nm); + } + } + else + { + while (idx < argc) + symbol_table::clear_function_pattern (argv[idx++]); + } + } +} + +static void +do_clear_globals (const string_vector& argv, int argc, int idx, + bool exclusive = false) +{ + if (idx == argc) + { + string_vector gvars = symbol_table::global_variable_names (); + + int gcount = gvars.length (); + + for (int i = 0; i < gcount; i++) + symbol_table::clear_global (gvars[i]); + } + else + { + if (exclusive) + { + string_vector gvars = symbol_table::global_variable_names (); + + int gcount = gvars.length (); + + for (int i = 0; i < gcount; i++) + { + std::string nm = gvars[i]; + + if (! name_matches_any_pattern (nm, argv, argc, idx)) + symbol_table::clear_global (nm); + } + } + else + { + while (idx < argc) + symbol_table::clear_global_pattern (argv[idx++]); + } + } +} + +static void +do_clear_variables (const string_vector& argv, int argc, int idx, + bool exclusive = false, bool have_regexp = false) +{ + if (idx == argc) + symbol_table::clear_variables (); + else + { + if (exclusive) + { + string_vector lvars = symbol_table::variable_names (); + + int lcount = lvars.length (); + + for (int i = 0; i < lcount; i++) + { + std::string nm = lvars[i]; + + if (! name_matches_any_pattern (nm, argv, argc, idx, have_regexp)) + symbol_table::clear_variable (nm); + } + } + else + { + if (have_regexp) + while (idx < argc) + symbol_table::clear_variable_regexp (argv[idx++]); + else + while (idx < argc) + symbol_table::clear_variable_pattern (argv[idx++]); + } + } +} + +static void +do_clear_symbols (const string_vector& argv, int argc, int idx, + bool exclusive = false) +{ + if (idx == argc) + symbol_table::clear_variables (); + else + { + if (exclusive) + { + // FIXME -- is this really what we want, or do we + // somehow want to only clear the functions that are not + // shadowed by local variables? It seems that would be a + // bit harder to do. + + do_clear_variables (argv, argc, idx, exclusive); + do_clear_functions (argv, argc, idx, exclusive); + } + else + { + while (idx < argc) + symbol_table::clear_symbol_pattern (argv[idx++]); + } + } +} + +static void +do_matlab_compatible_clear (const string_vector& argv, int argc, int idx) +{ + // This is supposed to be mostly Matlab compatible. + + for (; idx < argc; idx++) + { + if (argv[idx] == "all" + && ! symbol_table::is_local_variable ("all")) + { + symbol_table::clear_all (); + } + else if (argv[idx] == "functions" + && ! symbol_table::is_local_variable ("functions")) + { + do_clear_functions (argv, argc, ++idx); + } + else if (argv[idx] == "global" + && ! symbol_table::is_local_variable ("global")) + { + do_clear_globals (argv, argc, ++idx); + } + else if (argv[idx] == "variables" + && ! symbol_table::is_local_variable ("variables")) + { + symbol_table::clear_variables (); + } + else if (argv[idx] == "classes" + && ! symbol_table::is_local_variable ("classes")) + { + symbol_table::clear_objects (); + octave_class::clear_exemplar_map (); + } + else + { + symbol_table::clear_symbol_pattern (argv[idx]); + } + } +} + +#define CLEAR_OPTION_ERROR(cond) \ + do \ + { \ + if (cond) \ + { \ + print_usage (); \ + return retval; \ + } \ + } \ + while (0) + +DEFUN (clear, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} clear [options] pattern @dots{}\n\ +Delete the names matching the given patterns from the symbol table. The\n\ +pattern may contain the following special characters:\n\ +\n\ +@table @code\n\ +@item ?\n\ +Match any single character.\n\ +\n\ +@item *\n\ +Match zero or more characters.\n\ +\n\ +@item [ @var{list} ]\n\ +Match the list of characters specified by @var{list}. If the first\n\ +character is @code{!} or @code{^}, match all characters except those\n\ +specified by @var{list}. For example, the pattern @samp{[a-zA-Z]} will\n\ +match all lowercase and uppercase alphabetic characters.\n\ +@end table\n\ +\n\ +For example, the command\n\ +\n\ +@example\n\ +clear foo b*r\n\ +@end example\n\ +\n\ +@noindent\n\ +clears the name @code{foo} and all names that begin with the letter\n\ +@code{b} and end with the letter @code{r}.\n\ +\n\ +If @code{clear} is called without any arguments, all user-defined\n\ +variables (local and global) are cleared from the symbol table. If\n\ +@code{clear} is called with at least one argument, only the visible\n\ +names matching the arguments are cleared. For example, suppose you have\n\ +defined a function @code{foo}, and then hidden it by performing the\n\ +assignment @code{foo = 2}. Executing the command @kbd{clear foo} once\n\ +will clear the variable definition and restore the definition of\n\ +@code{foo} as a function. Executing @kbd{clear foo} a second time will\n\ +clear the function definition.\n\ +\n\ +The following options are available in both long and short form\n\ +\n\ +@table @code\n\ +@item -all, -a\n\ +Clears all local and global user-defined variables and all functions\n\ +from the symbol table.\n\ +\n\ +@item -exclusive, -x\n\ +Clears the variables that don't match the following pattern.\n\ +\n\ +@item -functions, -f\n\ +Clears the function names and the built-in symbols names.\n\ +\n\ +@item -global, -g\n\ +Clears the global symbol names.\n\ +\n\ +@item -variables, -v\n\ +Clears the local variable names.\n\ +\n\ +@item -classes, -c\n\ +Clears the class structure table and clears all objects.\n\ +\n\ +@item -regexp, -r\n\ +The arguments are treated as regular expressions as any variables that\n\ +match will be cleared.\n\ +@end table\n\ +\n\ +With the exception of @code{exclusive}, all long options can be used\n\ +without the dash as well.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("clear"); + + if (! error_state) + { + if (argc == 1) + { + do_clear_globals (argv, argc, 1); + do_clear_variables (argv, argc, 1); + } + else + { + int idx = 0; + + bool clear_all = false; + bool clear_functions = false; + bool clear_globals = false; + bool clear_variables = false; + bool clear_objects = false; + bool exclusive = false; + bool have_regexp = false; + bool have_dash_option = false; + + while (++idx < argc) + { + if (argv[idx] == "-all" || argv[idx] == "-a") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_all = true; + } + else if (argv[idx] == "-exclusive" || argv[idx] == "-x") + { + have_dash_option = true; + exclusive = true; + } + else if (argv[idx] == "-functions" || argv[idx] == "-f") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_functions = true; + } + else if (argv[idx] == "-global" || argv[idx] == "-g") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_globals = true; + } + else if (argv[idx] == "-variables" || argv[idx] == "-v") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_variables = true; + } + else if (argv[idx] == "-classes" || argv[idx] == "-c") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_objects = true; + } + else if (argv[idx] == "-regexp" || argv[idx] == "-r") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + have_regexp = true; + } + else + break; + } + + if (idx <= argc) + { + if (! have_dash_option) + { + do_matlab_compatible_clear (argv, argc, idx); + } + else + { + if (clear_all) + { + maybe_warn_exclusive (exclusive); + + if (++idx < argc) + warning + ("clear: ignoring extra arguments after -all"); + + symbol_table::clear_all (); + } + else if (have_regexp) + { + do_clear_variables (argv, argc, idx, exclusive, true); + } + else if (clear_functions) + { + do_clear_functions (argv, argc, idx, exclusive); + } + else if (clear_globals) + { + do_clear_globals (argv, argc, idx, exclusive); + } + else if (clear_variables) + { + do_clear_variables (argv, argc, idx, exclusive); + } + else if (clear_objects) + { + symbol_table::clear_objects (); + octave_class::clear_exemplar_map (); + } + else + { + do_clear_symbols (argv, argc, idx, exclusive); + } + } + } + } + } + + return retval; +} + +DEFUN (whos_line_format, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} whos_line_format ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} whos_line_format (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} whos_line_format (@var{new_val}, \"local\")\n\ +Query or set the format string used by the command @code{whos}.\n\ +\n\ +A full format string is:\n\ +@c Set example in small font to prevent overfull line\n\ +\n\ +@smallexample\n\ +%[modifier][:width[:left-min[:balance]]];\n\ +@end smallexample\n\ +\n\ +The following command sequences are available:\n\ +\n\ +@table @code\n\ +@item %a\n\ +Prints attributes of variables (g=global, p=persistent,\n\ +f=formal parameter, a=automatic variable).\n\ +\n\ +@item %b\n\ +Prints number of bytes occupied by variables.\n\ +\n\ +@item %c\n\ +Prints class names of variables.\n\ +\n\ +@item %e\n\ +Prints elements held by variables.\n\ +\n\ +@item %n\n\ +Prints variable names.\n\ +\n\ +@item %s\n\ +Prints dimensions of variables.\n\ +\n\ +@item %t\n\ +Prints type names of variables.\n\ +@end table\n\ +\n\ +Every command may also have an alignment modifier:\n\ +\n\ +@table @code\n\ +@item l\n\ +Left alignment.\n\ +\n\ +@item r\n\ +Right alignment (default).\n\ +\n\ +@item c\n\ +Column-aligned (only applicable to command %s).\n\ +@end table\n\ +\n\ +The @code{width} parameter is a positive integer specifying the minimum\n\ +number of columns used for printing. No maximum is needed as the field will\n\ +auto-expand as required.\n\ +\n\ +The parameters @code{left-min} and @code{balance} are only available when the\n\ +column-aligned modifier is used with the command @samp{%s}.\n\ +@code{balance} specifies the column number within the field width which will\n\ +be aligned between entries. Numbering starts from 0 which indicates the\n\ +leftmost column. @code{left-min} specifies the minimum field width to the\n\ +left of the specified balance column.\n\ +\n\ +The default format is\n\ +@code{\" %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\\n\"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{whos}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (whos_line_format); +} + +static std::string Vmissing_function_hook = "unimplemented"; + +DEFUN (missing_function_hook, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} missing_function_hook ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} missing_function_hook (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} missing_function_hook (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the function to call when\n\ +an unknown identifier is requested.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (missing_function_hook); +} + +void maybe_missing_function_hook (const std::string& name) +{ + // Don't do this if we're handling errors. + if (buffer_error_messages == 0 && ! Vmissing_function_hook.empty ()) + { + // Ensure auto-restoration. + unwind_protect frame; + frame.protect_var (Vmissing_function_hook); + + // Clear the variable prior to calling the function. + const std::string func_name = Vmissing_function_hook; + Vmissing_function_hook.clear (); + + // Call. + feval (func_name, octave_value (name)); + } +} + +DEFUN (__varval__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __varval__ (@var{name})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + retval = symbol_table::varval (args(0).string_value ()); + else + error ("__varval__: expecting argument to be variable name"); + } + else + print_usage (); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/interpfcn/variables.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/variables.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,147 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_variables_h) +#define octave_variables_h 1 + +class octave_function; +class octave_user_function; + +class tree_identifier; +class octave_value; +class octave_value_list; +class octave_builtin; +class string_vector; + +#include +#include + +#include + +#include "ov.h" +#include "ov-builtin.h" +#include "symtab.h" + +extern OCTINTERP_API void clear_mex_functions (void); + +extern OCTINTERP_API octave_function * +is_valid_function (const octave_value&, const std::string& = std::string (), + bool warn = false); + +extern OCTINTERP_API octave_function * +is_valid_function (const std::string&, const std::string& = std::string (), + bool warn = false); + +extern OCTINTERP_API octave_function * +extract_function (const octave_value& arg, const std::string& warn_for, + const std::string& fname, const std::string& header, + const std::string& trailer); + +extern OCTINTERP_API string_vector +get_struct_elts (const std::string& text); + +extern OCTINTERP_API string_vector +generate_struct_completions (const std::string& text, std::string& prefix, + std::string& hint); + +extern OCTINTERP_API bool +looks_like_struct (const std::string& text); + +extern OCTINTERP_API int +symbol_exist (const std::string& name, const std::string& type = "any"); + +extern OCTINTERP_API std::string +unique_symbol_name (const std::string& basename); + +extern OCTINTERP_API octave_value lookup_function_handle (const std::string& nm); + +extern OCTINTERP_API octave_value +get_global_value (const std::string& nm, bool silent = false); + +extern OCTINTERP_API void +set_global_value (const std::string& nm, const octave_value& val); + +extern OCTINTERP_API octave_value +get_top_level_value (const std::string& nm, bool silent = false); + +extern OCTINTERP_API void +set_top_level_value (const std::string& nm, const octave_value& val); + +extern OCTINTERP_API octave_value +set_internal_variable (bool& var, const octave_value_list& args, + int nargout, const char *nm); + +extern OCTINTERP_API octave_value +set_internal_variable (char& var, const octave_value_list& args, + int nargout, const char *nm); + +extern OCTINTERP_API octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, + int minval = INT_MIN, int maxval = INT_MAX); + +extern OCTINTERP_API octave_value +set_internal_variable (double& var, const octave_value_list& args, + int nargout, const char *nm, + double minval = DBL_MIN, double maxval = DBL_MAX); + +extern OCTINTERP_API octave_value +set_internal_variable (std::string& var, const octave_value_list& args, + int nargout, const char *nm, bool empty_ok = true); + +extern OCTINTERP_API octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, const char **choices); + +#define SET_INTERNAL_VARIABLE(NM) \ + set_internal_variable (V ## NM, args, nargout, #NM) + +#define SET_NONEMPTY_INTERNAL_STRING_VARIABLE(NM) \ + set_internal_variable (V ## NM, args, nargout, #NM, false) + +#define SET_INTERNAL_VARIABLE_WITH_LIMITS(NM, MINVAL, MAXVAL) \ + set_internal_variable (V ## NM, args, nargout, #NM, MINVAL, MAXVAL) + +// in the following, CHOICES must be a C string array terminated by null. +#define SET_INTERNAL_VARIABLE_CHOICES(NM, CHOICES) \ + set_internal_variable (V ## NM, args, nargout, #NM, CHOICES) + +extern OCTINTERP_API std::string builtin_string_variable (const std::string&); +extern OCTINTERP_API int builtin_real_scalar_variable (const std::string&, double&); +extern OCTINTERP_API octave_value builtin_any_variable (const std::string&); + +extern OCTINTERP_API void bind_ans (const octave_value& val, bool print); + +extern OCTINTERP_API void +bind_internal_variable (const std::string& fname, const octave_value& val); + +extern OCTINTERP_API void mlock (void); +extern OCTINTERP_API void munlock (const std::string&); +extern OCTINTERP_API bool mislocked (const std::string&); + +extern OCTINTERP_API void clear_function (const std::string& nm); +extern OCTINTERP_API void clear_variable (const std::string& nm); +extern OCTINTERP_API void clear_symbol (const std::string& nm); + +extern OCTINTERP_API void maybe_missing_function_hook (const std::string& name); + +#endif diff -r d02b229ce693 -r a132d206a36a src/jit-ir.cc --- a/src/jit-ir.cc Thu Aug 02 12:12:00 2012 +0200 +++ b/src/jit-ir.cc Fri Aug 03 14:59:40 2012 -0400 @@ -598,4 +598,52 @@ return false; } +// -------------------- jit_magic_end -------------------- +jit_magic_end::jit_magic_end (const std::vector& full_context) +{ + // for now we only support end in 1 dimensional indexing + resize_arguments (full_context.size ()); + + size_t i; + std::vector::const_iterator iter; + for (iter = full_context.begin (), i = 0; iter != full_context.end (); ++iter, + ++i) + { + if (iter->count != 1) + throw jit_fail_exception ("end is only supported in linear contexts"); + stash_argument (i, iter->value); + } +} + +const jit_function& +jit_magic_end::overload () const +{ + jit_value *ctx = resolve_context (); + if (ctx) + return jit_typeinfo::end (ctx->type ()); + + static jit_function null_ret; + return null_ret; +} + +jit_value * +jit_magic_end::resolve_context (void) const +{ + // FIXME: We need to have a way of marking functions so we can skip them here + return argument_count () ? argument (0) : 0; +} + +bool +jit_magic_end::infer (void) +{ + jit_type *new_type = overload ().result (); + if (new_type != type ()) + { + stash_type (new_type); + return true; + } + + return false; +} + #endif diff -r d02b229ce693 -r a132d206a36a src/jit-ir.h --- a/src/jit-ir.h Thu Aug 02 12:12:00 2012 +0200 +++ b/src/jit-ir.h Fri Aug 03 14:59:40 2012 -0400 @@ -46,7 +46,8 @@ JIT_METH(variable); \ JIT_METH(error_check); \ JIT_METH(assign) \ - JIT_METH(argument) + JIT_METH(argument) \ + JIT_METH(magic_end) #define JIT_VISIT_IR_CONST \ JIT_METH(const_bool); \ @@ -256,6 +257,14 @@ #undef STASH_ARG #undef JIT_INSTRUCTION_CTOR + jit_instruction (const std::vector& aarguments) + : already_infered (aarguments.size ()), marguments (aarguments.size ()), + mid (next_id ()), mparent (0) + { + for (size_t i = 0; i < aarguments.size (); ++i) + stash_argument (i, aarguments[i]); + } + static void reset_ids (void) { next_id (true); @@ -1065,6 +1074,10 @@ #undef JIT_CALL_CONST + jit_call (const jit_operation& aoperation, + const std::vector& args) + : jit_instruction (args), moperation (aoperation) + {} const jit_operation& operation (void) const { return moperation; } @@ -1137,6 +1150,48 @@ } }; +// for now only handles the 1D case +class +jit_magic_end : public jit_instruction +{ +public: + class + context + { + public: + context (void) : value (0), index (0), count (0) + {} + + context (jit_value *avalue, size_t aindex, size_t acount) + : value (avalue), index (aindex), count (acount) + {} + + jit_value *value; + size_t index; + size_t count; + }; + + jit_magic_end (const std::vector& full_context); + + const jit_function& overload () const; + + jit_value *resolve_context (void) const; + + virtual bool infer (void); + + virtual std::ostream& short_print (std::ostream& os) const + { + return os << "magic_end"; + } + + virtual std::ostream& print (std::ostream& os, size_t indent = 0) const + { + return short_print (print_indent (os, indent)); + } + + JIT_VALUE_ACCEPT; +}; + class jit_extract_argument : public jit_assign_base { diff -r d02b229ce693 -r a132d206a36a src/jit-typeinfo.cc --- a/src/jit-typeinfo.cc Thu Aug 02 12:12:00 2012 +0200 +++ b/src/jit-typeinfo.cc Fri Aug 03 14:59:40 2012 -0400 @@ -243,6 +243,57 @@ *ret = *mat; } +static void +make_indices (double *indices, octave_idx_type idx_count, + Array& result) +{ + result.resize (dim_vector (1, idx_count)); + for (octave_idx_type i = 0; i < idx_count; ++i) + result(i) = idx_vector (indices[i]); +} + +extern "C" double +octave_jit_paren_scalar (jit_matrix *mat, double *indicies, + octave_idx_type idx_count) +{ + // FIXME: Replace this with a more optimal version + try + { + Array idx; + make_indices (indicies, idx_count, idx); + + Array ret = mat->array->index (idx); + return ret.xelem (0); + } + catch (const octave_execution_exception&) + { + gripe_library_execution_error (); + return 0; + } +} + +extern "C" void +octave_jit_paren_scalar_subsasgn (jit_matrix *ret, jit_matrix *mat, + double *indices, octave_idx_type idx_count, + double value) +{ + // FIXME: Replace this with a more optimal version + try + { + Array idx; + make_indices (indices, idx_count, idx); + + Matrix temp (1, 1); + temp.xelem(0) = value; + mat->array->assign (idx, temp); + ret->update (mat->array); + } + catch (const octave_execution_exception&) + { + gripe_library_execution_error (); + } +} + extern "C" void octave_jit_paren_subsasgn_matrix_range (jit_matrix *result, jit_matrix *mat, jit_range *index, double value) @@ -522,8 +573,10 @@ jit_function::call (llvm::IRBuilderD& builder, const std::vector& in_args) const { + if (! valid ()) + throw jit_fail_exception ("Call not implemented"); + assert (in_args.size () == args.size ()); - std::vector llvm_args (args.size ()); for (size_t i = 0; i < in_args.size (); ++i) llvm_args[i] = in_args[i]->to_llvm (); @@ -535,7 +588,9 @@ jit_function::call (llvm::IRBuilderD& builder, const std::vector& in_args) const { - assert (valid ()); + if (! valid ()) + throw jit_fail_exception ("Call not implemented"); + assert (in_args.size () == args.size ()); llvm::Function *stacksave = llvm::Intrinsic::getDeclaration (module, llvm::Intrinsic::stacksave); @@ -653,6 +708,16 @@ } // -------------------- jit_operation -------------------- +jit_operation::~jit_operation (void) +{ + for (generated_map::iterator iter = generated.begin (); + iter != generated.end (); ++iter) + { + delete iter->first; + delete iter->second; + } +} + void jit_operation::add_overload (const jit_function& func, const std::vector& args) @@ -687,23 +752,26 @@ const jit_function& jit_operation::overload (const std::vector& types) const { - // FIXME: We should search for the next best overload on failure static jit_function null_overload; - if (types.size () >= overloads.size ()) - return null_overload; - for (size_t i =0; i < types.size (); ++i) if (! types[i]) return null_overload; + if (types.size () >= overloads.size ()) + return do_generate (types); + const Array& over = overloads[types.size ()]; dim_vector dv (over.dims ()); Array idx = to_idx (types); for (octave_idx_type i = 0; i < dv.length (); ++i) if (idx(i) >= dv(i)) - return null_overload; + return do_generate (types); - return over(idx); + const jit_function& ret = over(idx); + if (! ret.valid ()) + return do_generate (types); + + return ret; } Array @@ -727,6 +795,175 @@ return idx; } +const jit_function& +jit_operation::do_generate (const signature_vec& types) const +{ + static jit_function null_overload; + generated_map::const_iterator find = generated.find (&types); + if (find != generated.end ()) + { + if (find->second) + return *find->second; + else + return null_overload; + } + + jit_function *ret = generate (types); + generated[new signature_vec (types)] = ret; + return ret ? *ret : null_overload; +} + +jit_function * +jit_operation::generate (const signature_vec& types) const +{ + return 0; +} + +bool +jit_operation::signature_cmp +::operator() (const signature_vec *lhs, const signature_vec *rhs) +{ + const signature_vec& l = *lhs; + const signature_vec& r = *rhs; + + if (l.size () < r.size ()) + return true; + else if (l.size () > r.size ()) + return false; + + for (size_t i = 0; i < l.size (); ++i) + { + if (l[i]->type_id () < r[i]->type_id ()) + return true; + else if (l[i]->type_id () > r[i]->type_id ()) + return false; + } + + return false; +} + +// -------------------- jit_index_operation -------------------- +jit_function * +jit_index_operation::generate (const signature_vec& types) const +{ + if (types.size () > 2 && types[0] == jit_typeinfo::get_matrix ()) + { + // indexing a matrix with scalars + jit_type *scalar = jit_typeinfo::get_scalar (); + for (size_t i = 1; i < types.size (); ++i) + if (types[i] != scalar) + return 0; + + return generate_matrix (types); + } + + return 0; +} + +llvm::Value * +jit_index_operation::create_arg_array (llvm::IRBuilderD& builder, + const jit_function &fn, size_t start_idx, + size_t end_idx) const +{ + size_t n = end_idx - start_idx; + llvm::Type *scalar_t = jit_typeinfo::get_scalar_llvm (); + llvm::ArrayType *array_t = llvm::ArrayType::get (scalar_t, n); + llvm::Value *array = llvm::UndefValue::get (array_t); + for (size_t i = start_idx; i < end_idx; ++i) + { + llvm::Value *idx = fn.argument (builder, i); + array = builder.CreateInsertValue (array, idx, i - start_idx); + } + + llvm::Value *array_mem = builder.CreateAlloca (array_t); + builder.CreateStore (array, array_mem); + return builder.CreateBitCast (array_mem, scalar_t->getPointerTo ()); +} + +// -------------------- jit_paren_subsref -------------------- +jit_function * +jit_paren_subsref::generate_matrix (const signature_vec& types) const +{ + std::stringstream ss; + ss << "jit_paren_subsref_matrix_scalar" << (types.size () - 1); + + jit_type *scalar = jit_typeinfo::get_scalar (); + jit_function *fn = new jit_function (module, jit_convention::internal, + ss.str (), scalar, types); + fn->mark_can_error (); + llvm::BasicBlock *body = fn->new_block (); + llvm::IRBuilder<> builder (body); + + llvm::Value *array = create_arg_array (builder, *fn, 1, types.size ()); + jit_type *index = jit_typeinfo::get_index (); + llvm::Value *nelem = llvm::ConstantInt::get (index->to_llvm (), + types.size () - 1); + llvm::Value *mat = fn->argument (builder, 0); + llvm::Value *ret = paren_scalar.call (builder, mat, array, nelem); + fn->do_return (builder, ret); + return fn; +} + +void +jit_paren_subsref::do_initialize (void) +{ + std::vector types (3); + types[0] = jit_typeinfo::get_matrix (); + types[1] = jit_typeinfo::get_scalar_ptr (); + types[2] = jit_typeinfo::get_index (); + + jit_type *scalar = jit_typeinfo::get_scalar (); + paren_scalar = jit_function (module, jit_convention::external, + "octave_jit_paren_scalar", scalar, types); + paren_scalar.add_mapping (engine, &octave_jit_paren_scalar); + paren_scalar.mark_can_error (); +} + +// -------------------- jit_paren_subsasgn -------------------- +jit_function * +jit_paren_subsasgn::generate_matrix (const signature_vec& types) const +{ + std::stringstream ss; + ss << "jit_paren_subsasgn_matrix_scalar" << (types.size () - 2); + + jit_type *matrix = jit_typeinfo::get_matrix (); + jit_function *fn = new jit_function (module, jit_convention::internal, + ss.str (), matrix, types); + fn->mark_can_error (); + llvm::BasicBlock *body = fn->new_block (); + llvm::IRBuilder<> builder (body); + + llvm::Value *array = create_arg_array (builder, *fn, 1, types.size () - 1); + jit_type *index = jit_typeinfo::get_index (); + llvm::Value *nelem = llvm::ConstantInt::get (index->to_llvm (), + types.size () - 2); + + llvm::Value *mat = fn->argument (builder, 0); + llvm::Value *value = fn->argument (builder, types.size () - 1); + llvm::Value *ret = paren_scalar.call (builder, mat, array, nelem, value); + fn->do_return (builder, ret); + return fn; +} + +void +jit_paren_subsasgn::do_initialize (void) +{ + if (paren_scalar.valid ()) + return; + + jit_type *matrix = jit_typeinfo::get_matrix (); + std::vector types (4); + types[0] = matrix; + types[1] = jit_typeinfo::get_scalar_ptr (); + types[2] = jit_typeinfo::get_index (); + types[3] = jit_typeinfo::get_scalar (); + + paren_scalar = jit_function (module, jit_convention::external, + "octave_jit_paren_scalar", matrix, types); + paren_scalar.add_mapping (engine, &octave_jit_paren_scalar_subsasgn); + paren_scalar.mark_can_error (); +} + // -------------------- jit_typeinfo -------------------- void jit_typeinfo::initialize (llvm::Module *m, llvm::ExecutionEngine *e) @@ -780,6 +1017,7 @@ matrix = new_type ("matrix", any, matrix_t); complex = new_type ("complex", any, complex_t); scalar = new_type ("scalar", complex, scalar_t); + scalar_ptr = new_type ("scalar_ptr", 0, scalar_t->getPointerTo ()); range = new_type ("range", any, range_t); string = new_type ("string", any, string_t); boolean = new_type ("bool", any, bool_t); @@ -809,6 +1047,9 @@ if (sizeof (void *) == 4) complex->mark_sret (); + paren_subsref_fn.initialize (module, engine); + paren_subsasgn_fn.initialize (module, engine); + // bind global variables lerror_state = new llvm::GlobalVariable (*module, bool_t, false, llvm::GlobalValue::ExternalLinkage, @@ -1342,8 +1583,7 @@ builder.CreateBr (done); builder.SetInsertPoint (normal); - llvm::Value *len = builder.CreateExtractValue (mat, - llvm::ArrayRef (2)); + llvm::Value *len = builder.CreateExtractValue (mat, 2); cond0 = builder.CreateICmpSGT (int_idx, len); llvm::Value *rcount = builder.CreateExtractValue (mat, 0); @@ -1386,6 +1626,18 @@ fn.mark_can_error (); paren_subsasgn_fn.add_overload (fn); + end_fn.stash_name ("end"); + fn = create_function (jit_convention::internal, "octave_jit_end_matrix", + scalar, matrix); + body = fn.new_block (); + builder.SetInsertPoint (body); + { + llvm::Value *mat = fn.argument (builder, 0); + llvm::Value *ret = builder.CreateExtractValue (mat, 2); + fn.do_return (builder, builder.CreateSIToFP (ret, scalar_t)); + } + end_fn.add_overload (fn); + casts[any->type_id ()].stash_name ("(any)"); casts[scalar->type_id ()].stash_name ("(scalar)"); casts[complex->type_id ()].stash_name ("(complex)"); diff -r d02b229ce693 -r a132d206a36a src/jit-typeinfo.h --- a/src/jit-typeinfo.h Thu Aug 02 12:12:00 2012 +0200 +++ b/src/jit-typeinfo.h Fri Aug 03 14:59:40 2012 -0400 @@ -314,17 +314,22 @@ jit_operation { public: + // type signature vector + typedef std::vector signature_vec; + + virtual ~jit_operation (void); + void add_overload (const jit_function& func) { add_overload (func, func.arguments ()); } void add_overload (const jit_function& func, - const std::vector& args); + const signature_vec& args); - const jit_function& overload (const std::vector& types) const; + const jit_function& overload (const signature_vec& types) const; - jit_type *result (const std::vector& types) const + jit_type *result (const signature_vec& types) const { const jit_function& temp = overload (types); return temp.result (); @@ -346,14 +351,79 @@ const std::string& name (void) const { return mname; } void stash_name (const std::string& aname) { mname = aname; } +protected: + virtual jit_function *generate (const signature_vec& types) const; private: - Array to_idx (const std::vector& types) const; + Array to_idx (const signature_vec& types) const; + + const jit_function& do_generate (const signature_vec& types) const; + + struct signature_cmp + { + bool operator() (const signature_vec *lhs, const signature_vec *rhs); + }; + + typedef std::map + generated_map; + + mutable generated_map generated; std::vector > overloads; std::string mname; }; +class +jit_index_operation : public jit_operation +{ +public: + jit_index_operation (void) : module (0), engine (0) {} + + void initialize (llvm::Module *amodule, llvm::ExecutionEngine *aengine) + { + module = amodule; + engine = aengine; + do_initialize (); + } +protected: + virtual jit_function *generate (const signature_vec& types) const; + + virtual jit_function *generate_matrix (const signature_vec& types) const = 0; + + virtual void do_initialize (void) = 0; + + // helper functions + // [start_idx, end_idx). + llvm::Value *create_arg_array (llvm::IRBuilderD& builder, + const jit_function &fn, size_t start_idx, + size_t end_idx) const; + + llvm::Module *module; + llvm::ExecutionEngine *engine; +}; + +class +jit_paren_subsref : public jit_index_operation +{ +protected: + virtual jit_function *generate_matrix (const signature_vec& types) const; + + virtual void do_initialize (void); +private: + jit_function paren_scalar; +}; + +class +jit_paren_subsasgn : public jit_index_operation +{ +protected: + jit_function *generate_matrix (const signature_vec& types) const; + + virtual void do_initialize (void); +private: + jit_function paren_scalar; +}; + // A singleton class which handles the construction of jit_types and // jit_operations. class @@ -376,6 +446,8 @@ static llvm::Type *get_scalar_llvm (void) { return instance->scalar->to_llvm (); } + static jit_type *get_scalar_ptr (void) { return instance->scalar_ptr; } + static jit_type *get_range (void) { return instance->range; } static jit_type *get_string (void) { return instance->string; } @@ -471,6 +543,16 @@ { return instance->do_insert_error_check (bld); } + + static const jit_operation& end (void) + { + return instance->end_fn; + } + + static const jit_function& end (jit_type *ty) + { + return instance->end_fn.overload (ty); + } private: jit_typeinfo (llvm::Module *m, llvm::ExecutionEngine *e); @@ -633,6 +715,7 @@ jit_type *any; jit_type *matrix; jit_type *scalar; + jit_type *scalar_ptr; // a fake type for interfacing with C++ jit_type *range; jit_type *string; jit_type *boolean; @@ -653,8 +736,9 @@ jit_operation for_index_fn; jit_operation logically_true_fn; jit_operation make_range_fn; - jit_operation paren_subsref_fn; - jit_operation paren_subsasgn_fn; + jit_paren_subsref paren_subsref_fn; + jit_paren_subsasgn paren_subsasgn_fn; + jit_operation end_fn; // type id -> cast function TO that type std::vector casts; diff -r d02b229ce693 -r a132d206a36a src/lex.h --- a/src/lex.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,200 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_lex_h) -#define octave_lex_h 1 - -#include -#include - -// FIXME -- these input buffer things should be members of a -// parser input stream class. - -typedef struct yy_buffer_state *YY_BUFFER_STATE; - -// Associate a buffer with a new file to read. -extern OCTINTERP_API YY_BUFFER_STATE create_buffer (FILE *f); - -// Report the current buffer. -extern OCTINTERP_API YY_BUFFER_STATE current_buffer (void); - -// Connect to new buffer buffer. -extern OCTINTERP_API void switch_to_buffer (YY_BUFFER_STATE buf); - -// Delete a buffer. -extern OCTINTERP_API void delete_buffer (YY_BUFFER_STATE buf); - -extern OCTINTERP_API void clear_all_buffers (void); - -extern OCTINTERP_API void cleanup_parser (void); - -// Is the given string a keyword? -extern bool is_keyword (const std::string& s); - -extern void prep_lexer_for_script_file (void); -extern void prep_lexer_for_function_file (void); - -// For communication between the lexer and parser. - -class -lexical_feedback -{ -public: - - lexical_feedback (void) - - : bracketflag (0), braceflag (0), looping (0), - convert_spaces_to_comma (true), at_beginning_of_statement (true), - defining_func (0), looking_at_function_handle (0), - looking_at_anon_fcn_args (true), - looking_at_return_list (false), looking_at_parameter_list (false), - looking_at_decl_list (false), looking_at_initializer_expression (false), - looking_at_matrix_or_assign_lhs (false), looking_at_object_index (), - looking_for_object_index (false), do_comma_insert (false), - looking_at_indirect_ref (false), parsed_function_name (), - parsing_class_method (false), maybe_classdef_get_set_method (false), - parsing_classdef (false), quote_is_transpose (false), - pending_local_variables () - - { - init (); - } - - ~lexical_feedback (void) { } - - void init (void); - - // Square bracket level count. - int bracketflag; - - // Curly brace level count. - int braceflag; - - // TRUE means we're in the middle of defining a loop. - int looping; - - // TRUE means that we should convert spaces to a comma inside a - // matrix definition. - bool convert_spaces_to_comma; - - // TRUE means we are at the beginning of a statement, where a - // command name is possible. - bool at_beginning_of_statement; - - // Nonzero means we're in the middle of defining a function. - int defining_func; - - // Nonzero means we are parsing a function handle. - int looking_at_function_handle; - - // TRUE means we are parsing an anonymous function argument list. - bool looking_at_anon_fcn_args; - - // TRUE means we're parsing the return list for a function. - bool looking_at_return_list; - - // TRUE means we're parsing the parameter list for a function. - bool looking_at_parameter_list; - - // TRUE means we're parsing a declaration list (global or - // persistent). - bool looking_at_decl_list; - - // TRUE means we are looking at the initializer expression for a - // parameter list element. - bool looking_at_initializer_expression; - - // TRUE means we're parsing a matrix or the left hand side of - // multi-value assignment statement. - bool looking_at_matrix_or_assign_lhs; - - // If the front of the list is TRUE, the closest paren, brace, or - // bracket nesting is an index for an object. - std::list looking_at_object_index; - - // Object index not possible until we've seen something. - bool looking_for_object_index; - - // GAG. Stupid kludge so that [[1,2][3,4]] will work. - bool do_comma_insert; - - // TRUE means we're looking at an indirect reference to a - // structure element. - bool looking_at_indirect_ref; - - // If the top of the stack is TRUE, then we've already seen the name - // of the current function. Should only matter if - // current_function_level > 0 - std::stack parsed_function_name; - - // TRUE means we are parsing a class method in function or classdef file. - bool parsing_class_method; - - // TRUE means we are parsing a class method declaration line in a - // classdef file and can accept a property get or set method name. - // For example, "get.PropertyName" is recognized as a function name. - bool maybe_classdef_get_set_method; - - // TRUE means we are parsing a classdef file - bool parsing_classdef; - - // Return transpose or start a string? - bool quote_is_transpose; - - // Set of identifiers that might be local variable names. - std::set pending_local_variables; - -private: - - lexical_feedback (const lexical_feedback&); - - lexical_feedback& operator = (const lexical_feedback&); -}; - -class -stream_reader -{ -public: - virtual int getc (void) = 0; - virtual int ungetc (int c) = 0; - -protected: - stream_reader (void) { } - ~stream_reader (void) { } - -private: - - // No copying! - stream_reader (const stream_reader&); - stream_reader& operator = (const stream_reader&); -}; - -extern std::string -grab_comment_block (stream_reader& reader, bool at_bol, bool& eof); - -// TRUE means that we have encountered EOF on the input stream. -extern bool parser_end_of_input; - -// Flags that need to be shared between the lexer and parser. -extern lexical_feedback lexer_flags; - -#endif diff -r d02b229ce693 -r a132d206a36a src/lex.ll --- a/src/lex.ll Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3822 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -%option prefix = "octave_" - -%top { -#ifdef HAVE_CONFIG_H -#include -#endif - -} - -%s COMMAND_START -%s MATRIX_START - -%x SCRIPT_FILE_BEGIN -%x FUNCTION_FILE_BEGIN - -%{ - -#include -#include - -#include -#include -#include -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "quit.h" -#include "lo-mappers.h" - -// These would be alphabetical, but y.tab.h must be included before -// oct-gperf.h and y.tab.h must be included after token.h and the tree -// class declarations. We can't include y.tab.h in oct-gperf.h -// because it may not be protected to allow it to be included multiple -// times. - -#include "Cell.h" -#include "comment-list.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "lex.h" -#include "ov.h" -#include "parse.h" -#include "parse-private.h" -#include "pt-all.h" -#include "symtab.h" -#include "token.h" -#include "toplev.h" -#include "utils.h" -#include "variables.h" -#include -#include - -#if defined (GNULIB_NAMESPACE) -// Calls to the following functions appear in the generated output from -// flex without the namespace tag. Redefine them so we will use them -// via the gnulib namespace. -#define fprintf GNULIB_NAMESPACE::fprintf -#define fwrite GNULIB_NAMESPACE::fwrite -#define isatty GNULIB_NAMESPACE::isatty -#define malloc GNULIB_NAMESPACE::malloc -#define realloc GNULIB_NAMESPACE::realloc -#endif - -#if ! (defined (FLEX_SCANNER) \ - && defined (YY_FLEX_MAJOR_VERSION) && YY_FLEX_MAJOR_VERSION >= 2 \ - && defined (YY_FLEX_MINOR_VERSION) && YY_FLEX_MINOR_VERSION >= 5) -#error lex.l requires flex version 2.5.4 or later -#endif - -#define yylval octave_lval - -// Arrange to get input via readline. - -#ifdef YY_INPUT -#undef YY_INPUT -#endif -#define YY_INPUT(buf, result, max_size) \ - if ((result = octave_read (buf, max_size)) < 0) \ - YY_FATAL_ERROR ("octave_read () in flex scanner failed"); - -// Try to avoid crashing out completely on fatal scanner errors. -// The call to yy_fatal_error should never happen, but it avoids a -// `static function defined but not used' warning from gcc. - -#ifdef YY_FATAL_ERROR -#undef YY_FATAL_ERROR -#endif -#define YY_FATAL_ERROR(msg) \ - do \ - { \ - error (msg); \ - OCTAVE_QUIT; \ - yy_fatal_error (msg); \ - } \ - while (0) - -#define DISPLAY_TOK_AND_RETURN(tok) \ - do \ - { \ - int tok_val = tok; \ - if (Vdisplay_tokens) \ - display_token (tok_val); \ - if (lexer_debug_flag) \ - { \ - std::cerr << "R: "; \ - display_token (tok_val); \ - std::cerr << std::endl; \ - } \ - return tok_val; \ - } \ - while (0) - -#define COUNT_TOK_AND_RETURN(tok) \ - do \ - { \ - Vtoken_count++; \ - DISPLAY_TOK_AND_RETURN (tok); \ - } \ - while (0) - -#define TOK_RETURN(tok) \ - do \ - { \ - current_input_column += yyleng; \ - lexer_flags.quote_is_transpose = false; \ - lexer_flags.convert_spaces_to_comma = true; \ - COUNT_TOK_AND_RETURN (tok); \ - } \ - while (0) - -#define TOK_PUSH_AND_RETURN(name, tok) \ - do \ - { \ - yylval.tok_val = new token (name, input_line_number, \ - current_input_column); \ - token_stack.push (yylval.tok_val); \ - TOK_RETURN (tok); \ - } \ - while (0) - -#define BIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ - do \ - { \ - yylval.tok_val = new token (input_line_number, current_input_column); \ - token_stack.push (yylval.tok_val); \ - current_input_column += yyleng; \ - lexer_flags.quote_is_transpose = qit; \ - lexer_flags.convert_spaces_to_comma = convert; \ - lexer_flags.looking_for_object_index = false; \ - lexer_flags.at_beginning_of_statement = bos; \ - COUNT_TOK_AND_RETURN (tok); \ - } \ - while (0) - -#define XBIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ - do \ - { \ - gripe_matlab_incompatible_operator (yytext); \ - BIN_OP_RETURN_INTERNAL (tok, convert, bos, qit); \ - } \ - while (0) - -#define BIN_OP_RETURN(tok, convert, bos) \ - do \ - { \ - BIN_OP_RETURN_INTERNAL (tok, convert, bos, false); \ - } \ - while (0) - -#define XBIN_OP_RETURN(tok, convert, bos) \ - do \ - { \ - gripe_matlab_incompatible_operator (yytext); \ - BIN_OP_RETURN (tok, convert, bos); \ - } \ - while (0) - -#define LEXER_DEBUG(pattern) \ - do \ - { \ - if (lexer_debug_flag) \ - lexer_debug (pattern, yytext); \ - } \ - while (0) - -// TRUE means that we have encountered EOF on the input stream. -bool parser_end_of_input = false; - -// Flags that need to be shared between the lexer and parser. -lexical_feedback lexer_flags; - -// Stack to hold tokens so that we can delete them when the parser is -// reset and avoid growing forever just because we are stashing some -// information. This has to appear before lex.h is included, because -// one of the macros defined there uses token_stack. -// -// FIXME -- this should really be static, but that causes -// problems on some systems. -std::stack token_stack; - -// Did eat_whitespace() eat a space or tab, or a newline, or both? - -typedef int yum_yum; - -const yum_yum ATE_NOTHING = 0; -const yum_yum ATE_SPACE_OR_TAB = 1; -const yum_yum ATE_NEWLINE = 2; - -// Is the closest nesting level a square bracket, squiggly brace or a paren? - -class bracket_brace_paren_nesting_level -{ -public: - - bracket_brace_paren_nesting_level (void) : context () { } - - ~bracket_brace_paren_nesting_level (void) { } - - void bracket (void) { context.push (BRACKET); } - bool is_bracket (void) - { return ! context.empty () && context.top () == BRACKET; } - - void brace (void) { context.push (BRACE); } - bool is_brace (void) - { return ! context.empty () && context.top () == BRACE; } - - void paren (void) { context.push (PAREN); } - bool is_paren (void) - { return ! context.empty () && context.top () == PAREN; } - - bool is_bracket_or_brace (void) - { return (! context.empty () - && (context.top () == BRACKET || context.top () == BRACE)); } - - bool none (void) { return context.empty (); } - - void remove (void) { if (! context.empty ()) context.pop (); } - - void clear (void) { while (! context.empty ()) context.pop (); } - -private: - - std::stack context; - - static const int BRACKET; - static const int BRACE; - static const int PAREN; - - bracket_brace_paren_nesting_level (const bracket_brace_paren_nesting_level&); - - bracket_brace_paren_nesting_level& - operator = (const bracket_brace_paren_nesting_level&); -}; - -const int bracket_brace_paren_nesting_level::BRACKET = 1; -const int bracket_brace_paren_nesting_level::BRACE = 2; -const int bracket_brace_paren_nesting_level::PAREN = 3; - -static bracket_brace_paren_nesting_level nesting_level; - -static bool Vdisplay_tokens = false; - -static unsigned int Vtoken_count = 0; - -// The start state that was in effect when the beginning of a block -// comment was noticed. -static int block_comment_nesting_level = 0; - -// Internal variable for lexer debugging state. -static bool lexer_debug_flag = false; - -// Forward declarations for functions defined at the bottom of this -// file. - -static int text_yyinput (void); -static void xunput (char c, char *buf); -static void fixup_column_count (char *s); -static void do_comma_insert_check (void); -static int is_keyword_token (const std::string& s); -static int process_comment (bool start_in_block, bool& eof); -static bool match_any (char c, const char *s); -static bool next_token_is_sep_op (void); -static bool next_token_is_bin_op (bool spc_prev); -static bool next_token_is_postfix_unary_op (bool spc_prev); -static std::string strip_trailing_whitespace (char *s); -static void handle_number (void); -static int handle_string (char delim); -static int handle_close_bracket (bool spc_gobbled, int bracket_type); -static int handle_superclass_identifier (void); -static int handle_meta_identifier (void); -static int handle_identifier (void); -static bool have_continuation (bool trailing_comments_ok = true); -static bool have_ellipsis_continuation (bool trailing_comments_ok = true); -static void scan_for_comments (const char *); -static yum_yum eat_whitespace (void); -static yum_yum eat_continuation (void); -static void maybe_warn_separator_insert (char sep); -static void gripe_single_quote_string (void); -static void gripe_matlab_incompatible (const std::string& msg); -static void maybe_gripe_matlab_incompatible_comment (char c); -static void gripe_matlab_incompatible_continuation (void); -static void gripe_matlab_incompatible_operator (const std::string& op); -static void display_token (int tok); -static void lexer_debug (const char *pattern, const char *text); - -%} - -D [0-9] -S [ \t] -NL ((\n)|(\r)|(\r\n)) -SNL ({S}|{NL}) -EL (\.\.\.) -BS (\\) -CONT ({EL}|{BS}) -Im [iIjJ] -CCHAR [#%] -COMMENT ({CCHAR}.*{NL}) -SNLCMT ({SNL}|{COMMENT}) -NOT ((\~)|(\!)) -POW ((\*\*)|(\^)) -EPOW (\.{POW}) -IDENT ([_$a-zA-Z][_$a-zA-Z0-9]*) -EXPON ([DdEe][+-]?{D}+) -NUMBER (({D}+\.?{D}*{EXPON}?)|(\.{D}+{EXPON}?)|(0[xX][0-9a-fA-F]+)) -%% - -%{ -// Make script and function files start with a bogus token. This makes -// the parser go down a special path. -%} - -. { - LEXER_DEBUG ("."); - - BEGIN (INITIAL); - xunput (yytext[0], yytext); - COUNT_TOK_AND_RETURN (SCRIPT_FILE); - } - -. { - LEXER_DEBUG ("."); - - BEGIN (INITIAL); - xunput (yytext[0], yytext); - COUNT_TOK_AND_RETURN (FUNCTION_FILE); - } - -%{ -// Help and other command-style functions. -%} - -{NL} { - LEXER_DEBUG ("{NL}"); - - BEGIN (INITIAL); - input_line_number++; - current_input_column = 1; - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = true; - - COUNT_TOK_AND_RETURN ('\n'); - } - -[\;\,] { - LEXER_DEBUG ("[\\;\\,]"); - - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = true; - - BEGIN (INITIAL); - - if (strcmp (yytext, ",") == 0) - TOK_RETURN (','); - else - TOK_RETURN (';'); - } - -[\"\'] { - LEXER_DEBUG ("[\\\"\\']"); - - lexer_flags.at_beginning_of_statement = false; - - current_input_column++; - int tok = handle_string (yytext[0]); - - COUNT_TOK_AND_RETURN (tok); - } - -[^#% \t\r\n\;\,\"\'][^ \t\r\n\;\,]*{S}* { - LEXER_DEBUG ("[^#% \\t\\r\\n\\;\\,\\\"\\'][^ \\t\\r\\n\\;\\,]*{S}*"); - - std::string tok = strip_trailing_whitespace (yytext); - - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - TOK_PUSH_AND_RETURN (tok, SQ_STRING); - } - -%{ -// For this and the next two rules, we're looking at ']', and we -// need to know if the next token is `=' or `=='. -// -// It would have been so much easier if the delimiters were simply -// different for the expression on the left hand side of the equals -// operator. -// -// It's also a pain in the ass to decide whether to insert a comma -// after seeing a ']' character... - -// FIXME -- we need to handle block comments here. -%} - -{SNLCMT}*\]{S}* { - LEXER_DEBUG ("{SNLCMT}*\\]{S}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - int c = yytext[yyleng-1]; - int cont_is_spc = eat_continuation (); - bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); - int tok_to_return = handle_close_bracket (spc_gobbled, ']'); - - if (spc_gobbled) - xunput (' ', yytext); - - COUNT_TOK_AND_RETURN (tok_to_return); - } - -%{ -// FIXME -- we need to handle block comments here. -%} - -{SNLCMT}*\}{S}* { - LEXER_DEBUG ("{SNLCMT}*\\}{S}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - int c = yytext[yyleng-1]; - int cont_is_spc = eat_continuation (); - bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); - int tok_to_return = handle_close_bracket (spc_gobbled, '}'); - - if (spc_gobbled) - xunput (' ', yytext); - - COUNT_TOK_AND_RETURN (tok_to_return); - } - -%{ -// Commas are element separators in matrix constants. If we don't -// check for continuations here we can end up inserting too many -// commas. -%} - -{S}*\,{S}* { - LEXER_DEBUG ("{S}*\\,{S}*"); - - current_input_column += yyleng; - - int tmp = eat_continuation (); - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - if (! lexer_flags.looking_at_object_index.front ()) - { - if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) - { - maybe_warn_separator_insert (';'); - - xunput (';', yytext); - } - } - - COUNT_TOK_AND_RETURN (','); - } - -%{ -// In some cases, spaces in matrix constants can turn into commas. -// If commas are required, spaces are not important in matrix -// constants so we just eat them. If we don't check for continuations -// here we can end up inserting too many commas. -%} - -{S}+ { - LEXER_DEBUG ("{S}+"); - - current_input_column += yyleng; - - lexer_flags.at_beginning_of_statement = false; - - int tmp = eat_continuation (); - - if (! lexer_flags.looking_at_object_index.front ()) - { - bool bin_op = next_token_is_bin_op (true); - bool postfix_un_op = next_token_is_postfix_unary_op (true); - bool sep_op = next_token_is_sep_op (); - - if (! (postfix_un_op || bin_op || sep_op) - && nesting_level.is_bracket_or_brace () - && lexer_flags.convert_spaces_to_comma) - { - if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) - { - maybe_warn_separator_insert (';'); - - xunput (';', yytext); - } - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - - maybe_warn_separator_insert (','); - - COUNT_TOK_AND_RETURN (','); - } - } - } - -%{ -// Semicolons are handled as row seprators in matrix constants. If we -// don't eat whitespace here we can end up inserting too many -// semicolons. - -// FIXME -- we need to handle block comments here. -%} - -{SNLCMT}*;{SNLCMT}* { - LEXER_DEBUG ("{SNLCMT}*;{SNLCMT}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - eat_whitespace (); - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - COUNT_TOK_AND_RETURN (';'); - } - -%{ -// In some cases, new lines can also become row separators. If we -// don't eat whitespace here we can end up inserting too many -// semicolons. - -// FIXME -- we need to handle block comments here. -%} - -{S}*{COMMENT}{SNLCMT}* | -{S}*{NL}{SNLCMT}* { - LEXER_DEBUG ("{S}*{COMMENT}{SNLCMT}*|{S}*{NL}{SNLCMT}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - eat_whitespace (); - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.at_beginning_of_statement = false; - - if (nesting_level.none ()) - return LEXICAL_ERROR; - - if (! lexer_flags.looking_at_object_index.front () - && nesting_level.is_bracket_or_brace ()) - { - maybe_warn_separator_insert (';'); - - COUNT_TOK_AND_RETURN (';'); - } - } - -\[{S}* { - LEXER_DEBUG ("\\[{S}*"); - - nesting_level.bracket (); - - lexer_flags.looking_at_object_index.push_front (false); - - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - if (lexer_flags.defining_func - && ! lexer_flags.parsed_function_name.top ()) - lexer_flags.looking_at_return_list = true; - else - lexer_flags.looking_at_matrix_or_assign_lhs = true; - - promptflag--; - eat_whitespace (); - - lexer_flags.bracketflag++; - BEGIN (MATRIX_START); - COUNT_TOK_AND_RETURN ('['); - } - -\] { - LEXER_DEBUG ("\\]"); - - nesting_level.remove (); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - TOK_RETURN (']'); - } - -%{ -// Imaginary numbers. -%} - -{NUMBER}{Im} { - LEXER_DEBUG ("{NUMBER}{Im}"); - - handle_number (); - COUNT_TOK_AND_RETURN (IMAG_NUM); - } - -%{ -// Real numbers. Don't grab the `.' part of a dot operator as part of -// the constant. -%} - -{D}+/\.[\*/\\^\'] | -{NUMBER} { - LEXER_DEBUG ("{D}+/\\.[\\*/\\^\\']|{NUMBER}"); - handle_number (); - COUNT_TOK_AND_RETURN (NUM); - } - -%{ -// Eat whitespace. Whitespace inside matrix constants is handled by -// the start state code above. -%} - -{S}* { - current_input_column += yyleng; - } - -%{ -// Continuation lines. Allow comments after continuations. -%} - -{CONT}{S}*{NL} | -{CONT}{S}*{COMMENT} { - LEXER_DEBUG ("{CONT}{S}*{NL}|{CONT}{S}*{COMMENT}"); - - if (yytext[0] == '\\') - gripe_matlab_incompatible_continuation (); - scan_for_comments (yytext); - promptflag--; - input_line_number++; - current_input_column = 1; - } - -%{ -// End of file. -%} - -<> { - LEXER_DEBUG ("<>"); - - if (block_comment_nesting_level != 0) - { - warning ("block comment open at end of input"); - - if ((reading_fcn_file || reading_script_file || reading_classdef_file) - && ! curr_fcn_file_name.empty ()) - warning ("near line %d of file `%s.m'", - input_line_number, curr_fcn_file_name.c_str ()); - } - - TOK_RETURN (END_OF_INPUT); - } - -%{ -// Identifiers. Truncate the token at the first space or tab but -// don't write directly on yytext. -%} - -{IDENT}{S}* { - LEXER_DEBUG ("{IDENT}{S}*"); - - int id_tok = handle_identifier (); - - if (id_tok >= 0) - COUNT_TOK_AND_RETURN (id_tok); - } - -%{ -// Superclass method identifiers. -%} - -{IDENT}@{IDENT}{S}* | -{IDENT}@{IDENT}.{IDENT}{S}* { - LEXER_DEBUG ("{IDENT}@{IDENT}{S}*|{IDENT}@{IDENT}.{IDENT}{S}*"); - - int id_tok = handle_superclass_identifier (); - - if (id_tok >= 0) - { - lexer_flags.looking_for_object_index = true; - - COUNT_TOK_AND_RETURN (SUPERCLASSREF); - } - } - -%{ -// Metaclass query -%} - -\?{IDENT}{S}* | -\?{IDENT}\.{IDENT}{S}* { - LEXER_DEBUG ("\\?{IDENT}{S}*|\\?{IDENT}\\.{IDENT}{S}*"); - - int id_tok = handle_meta_identifier (); - - if (id_tok >= 0) - { - lexer_flags.looking_for_object_index = true; - - COUNT_TOK_AND_RETURN (METAQUERY); - } - } - -%{ -// Function handles and superclass references -%} - -"@" { - LEXER_DEBUG ("@"); - - current_input_column++; - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = false; - lexer_flags.looking_at_function_handle++; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - COUNT_TOK_AND_RETURN ('@'); - - } - -%{ -// A new line character. New line characters inside matrix constants -// are handled by the start state code above. If closest -// nesting is inside parentheses, don't return a row separator. -%} - -{NL} { - LEXER_DEBUG ("{NL}"); - - input_line_number++; - current_input_column = 1; - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - - if (nesting_level.none ()) - { - lexer_flags.at_beginning_of_statement = true; - COUNT_TOK_AND_RETURN ('\n'); - } - else if (nesting_level.is_paren ()) - { - lexer_flags.at_beginning_of_statement = false; - gripe_matlab_incompatible ("bare newline inside parentheses"); - } - else if (nesting_level.is_bracket_or_brace ()) - return LEXICAL_ERROR; - } - -%{ -// Single quote can either be the beginning of a string or a transpose -// operator. -%} - -"'" { - LEXER_DEBUG ("'"); - - current_input_column++; - lexer_flags.convert_spaces_to_comma = true; - - if (lexer_flags.quote_is_transpose) - { - do_comma_insert_check (); - COUNT_TOK_AND_RETURN (QUOTE); - } - else - { - int tok = handle_string ('\''); - COUNT_TOK_AND_RETURN (tok); - } - } - -%{ -// Double quotes always begin strings. -%} - -\" { - LEXER_DEBUG ("\""); - - current_input_column++; - int tok = handle_string ('"'); - - COUNT_TOK_AND_RETURN (tok); -} - -%{ -// Gobble comments. -%} - -{CCHAR} { - LEXER_DEBUG ("{CCHAR}"); - - lexer_flags.looking_for_object_index = false; - - xunput (yytext[0], yytext); - - bool eof = false; - int tok = process_comment (false, eof); - - if (eof) - TOK_RETURN (END_OF_INPUT); - else if (tok > 0) - COUNT_TOK_AND_RETURN (tok); - } - -%{ -// Block comments. -%} - -^{S}*{CCHAR}\{{S}*{NL} { - LEXER_DEBUG ("^{S}*{CCHAR}\\{{S}*{NL}"); - - lexer_flags.looking_for_object_index = false; - - input_line_number++; - current_input_column = 1; - block_comment_nesting_level++; - promptflag--; - - bool eof = false; - process_comment (true, eof); - } - -%{ -// Other operators. -%} - -":" { LEXER_DEBUG (":"); BIN_OP_RETURN (':', false, false); } - -".+" { LEXER_DEBUG (".+"); XBIN_OP_RETURN (EPLUS, false, false); } -".-" { LEXER_DEBUG (".-"); XBIN_OP_RETURN (EMINUS, false, false); } -".*" { LEXER_DEBUG (".*"); BIN_OP_RETURN (EMUL, false, false); } -"./" { LEXER_DEBUG ("./"); BIN_OP_RETURN (EDIV, false, false); } -".\\" { LEXER_DEBUG (".\\"); BIN_OP_RETURN (ELEFTDIV, false, false); } -".^" { LEXER_DEBUG (".^"); BIN_OP_RETURN (EPOW, false, false); } -".**" { LEXER_DEBUG (".**"); XBIN_OP_RETURN (EPOW, false, false); } -".'" { LEXER_DEBUG (".'"); do_comma_insert_check (); BIN_OP_RETURN (TRANSPOSE, true, false); } -"++" { LEXER_DEBUG ("++"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (PLUS_PLUS, true, false, true); } -"--" { LEXER_DEBUG ("--"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (MINUS_MINUS, true, false, true); } -"<=" { LEXER_DEBUG ("<="); BIN_OP_RETURN (EXPR_LE, false, false); } -"==" { LEXER_DEBUG ("=="); BIN_OP_RETURN (EXPR_EQ, false, false); } -"~=" { LEXER_DEBUG ("~="); BIN_OP_RETURN (EXPR_NE, false, false); } -"!=" { LEXER_DEBUG ("!="); XBIN_OP_RETURN (EXPR_NE, false, false); } -">=" { LEXER_DEBUG (">="); BIN_OP_RETURN (EXPR_GE, false, false); } -"&" { LEXER_DEBUG ("&"); BIN_OP_RETURN (EXPR_AND, false, false); } -"|" { LEXER_DEBUG ("|"); BIN_OP_RETURN (EXPR_OR, false, false); } -"<" { LEXER_DEBUG ("<"); BIN_OP_RETURN (EXPR_LT, false, false); } -">" { LEXER_DEBUG (">"); BIN_OP_RETURN (EXPR_GT, false, false); } -"+" { LEXER_DEBUG ("+"); BIN_OP_RETURN ('+', false, false); } -"-" { LEXER_DEBUG ("-"); BIN_OP_RETURN ('-', false, false); } -"*" { LEXER_DEBUG ("*"); BIN_OP_RETURN ('*', false, false); } -"/" { LEXER_DEBUG ("/"); BIN_OP_RETURN ('/', false, false); } -"\\" { LEXER_DEBUG ("\\"); BIN_OP_RETURN (LEFTDIV, false, false); } -";" { LEXER_DEBUG (";"); BIN_OP_RETURN (';', true, true); } -"," { LEXER_DEBUG (","); BIN_OP_RETURN (',', true, ! lexer_flags.looking_at_object_index.front ()); } -"^" { LEXER_DEBUG ("^"); BIN_OP_RETURN (POW, false, false); } -"**" { LEXER_DEBUG ("**"); XBIN_OP_RETURN (POW, false, false); } -"=" { LEXER_DEBUG ("="); BIN_OP_RETURN ('=', true, false); } -"&&" { LEXER_DEBUG ("&&"); BIN_OP_RETURN (EXPR_AND_AND, false, false); } -"||" { LEXER_DEBUG ("||"); BIN_OP_RETURN (EXPR_OR_OR, false, false); } -"<<" { LEXER_DEBUG ("<<"); XBIN_OP_RETURN (LSHIFT, false, false); } -">>" { LEXER_DEBUG (">>"); XBIN_OP_RETURN (RSHIFT, false, false); } - -{NOT} { - LEXER_DEBUG ("{NOT}"); - - if (yytext[0] == '~') - BIN_OP_RETURN (EXPR_NOT, false, false); - else - XBIN_OP_RETURN (EXPR_NOT, false, false); - } - -"(" { - LEXER_DEBUG ("("); - - // If we are looking for an object index, then push TRUE for - // looking_at_object_index. Otherwise, just push whatever state - // is current (so that we can pop it off the stack when we find - // the matching close paren). - - lexer_flags.looking_at_object_index.push_front - (lexer_flags.looking_for_object_index); - - lexer_flags.looking_at_indirect_ref = false; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - nesting_level.paren (); - promptflag--; - - TOK_RETURN ('('); - } - -")" { - LEXER_DEBUG (")"); - - nesting_level.remove (); - current_input_column++; - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma - = (nesting_level.is_bracket_or_brace () - && ! lexer_flags.looking_at_anon_fcn_args); - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - if (lexer_flags.looking_at_anon_fcn_args) - lexer_flags.looking_at_anon_fcn_args = false; - - do_comma_insert_check (); - - COUNT_TOK_AND_RETURN (')'); - } - -"." { - LEXER_DEBUG ("."); - - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - TOK_RETURN ('.'); - } - -"+=" { LEXER_DEBUG ("+="); XBIN_OP_RETURN (ADD_EQ, false, false); } -"-=" { LEXER_DEBUG ("-="); XBIN_OP_RETURN (SUB_EQ, false, false); } -"*=" { LEXER_DEBUG ("*="); XBIN_OP_RETURN (MUL_EQ, false, false); } -"/=" { LEXER_DEBUG ("/="); XBIN_OP_RETURN (DIV_EQ, false, false); } -"\\=" { LEXER_DEBUG ("\\="); XBIN_OP_RETURN (LEFTDIV_EQ, false, false); } -".+=" { LEXER_DEBUG (".+="); XBIN_OP_RETURN (ADD_EQ, false, false); } -".-=" { LEXER_DEBUG (".-="); XBIN_OP_RETURN (SUB_EQ, false, false); } -".*=" { LEXER_DEBUG (".*="); XBIN_OP_RETURN (EMUL_EQ, false, false); } -"./=" { LEXER_DEBUG ("./="); XBIN_OP_RETURN (EDIV_EQ, false, false); } -".\\=" { LEXER_DEBUG (".\\="); XBIN_OP_RETURN (ELEFTDIV_EQ, false, false); } -{POW}= { LEXER_DEBUG ("{POW}="); XBIN_OP_RETURN (POW_EQ, false, false); } -{EPOW}= { LEXER_DEBUG ("{EPOW}="); XBIN_OP_RETURN (EPOW_EQ, false, false); } -"&=" { LEXER_DEBUG ("&="); XBIN_OP_RETURN (AND_EQ, false, false); } -"|=" { LEXER_DEBUG ("|="); XBIN_OP_RETURN (OR_EQ, false, false); } -"<<=" { LEXER_DEBUG ("<<="); XBIN_OP_RETURN (LSHIFT_EQ, false, false); } -">>=" { LEXER_DEBUG (">>="); XBIN_OP_RETURN (RSHIFT_EQ, false, false); } - -\{{S}* { - LEXER_DEBUG ("\\{{S}*"); - - nesting_level.brace (); - - lexer_flags.looking_at_object_index.push_front - (lexer_flags.looking_for_object_index); - - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - promptflag--; - eat_whitespace (); - - lexer_flags.braceflag++; - BEGIN (MATRIX_START); - COUNT_TOK_AND_RETURN ('{'); - } - -"}" { - LEXER_DEBUG ("}"); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - nesting_level.remove (); - - TOK_RETURN ('}'); - } - -%{ -// Unrecognized input is a lexical error. -%} - -. { - LEXER_DEBUG ("."); - - xunput (yytext[0], yytext); - - int c = text_yyinput (); - - if (c != EOF) - { - current_input_column++; - - error ("invalid character `%s' (ASCII %d) near line %d, column %d", - undo_string_escape (static_cast (c)), c, - input_line_number, current_input_column); - - return LEXICAL_ERROR; - } - else - TOK_RETURN (END_OF_INPUT); - } - -%% - -// GAG. -// -// If we're reading a matrix and the next character is '[', make sure -// that we insert a comma ahead of it. - -void -do_comma_insert_check (void) -{ - int spc_gobbled = eat_continuation (); - - int c = text_yyinput (); - - xunput (c, yytext); - - if (spc_gobbled) - xunput (' ', yytext); - - lexer_flags.do_comma_insert = (! lexer_flags.looking_at_object_index.front () - && lexer_flags.bracketflag && c == '['); -} - -// Fix things up for errors or interrupts. The parser is never called -// recursively, so it is always safe to reinitialize its state before -// doing any parsing. - -void -reset_parser (void) -{ - // Start off on the right foot. - BEGIN (INITIAL); - - parser_end_of_input = false; - - parser_symtab_context.clear (); - - // We do want a prompt by default. - promptflag = 1; - - // We are not in a block comment. - block_comment_nesting_level = 0; - - // Error may have occurred inside some brackets, braces, or parentheses. - nesting_level.clear (); - - // Clear out the stack of token info used to track line and column - // numbers. - while (! token_stack.empty ()) - { - delete token_stack.top (); - token_stack.pop (); - } - - // Can be reset by defining a function. - if (! (reading_script_file || reading_fcn_file || reading_classdef_file)) - { - current_input_column = 1; - input_line_number = command_editor::current_command_number (); - } - - // Only ask for input from stdin if we are expecting interactive - // input. - - if (! quitting_gracefully - && (interactive || forced_interactive) - && ! (reading_fcn_file - || reading_classdef_file - || reading_script_file - || get_input_from_eval_string - || input_from_startup_file)) - yyrestart (stdin); - - // Clear the buffer for help text. - while (! help_buf.empty ()) - help_buf.pop (); - - // Reset other flags. - lexer_flags.init (); -} - -static void -display_character (char c) -{ - if (isgraph (c)) - std::cerr << c; - else - switch (c) - { - case 0: - std::cerr << "NUL"; - break; - - case 1: - std::cerr << "SOH"; - break; - - case 2: - std::cerr << "STX"; - break; - - case 3: - std::cerr << "ETX"; - break; - - case 4: - std::cerr << "EOT"; - break; - - case 5: - std::cerr << "ENQ"; - break; - - case 6: - std::cerr << "ACK"; - break; - - case 7: - std::cerr << "\\a"; - break; - - case 8: - std::cerr << "\\b"; - break; - - case 9: - std::cerr << "\\t"; - break; - - case 10: - std::cerr << "\\n"; - break; - - case 11: - std::cerr << "\\v"; - break; - - case 12: - std::cerr << "\\f"; - break; - - case 13: - std::cerr << "\\r"; - break; - - case 14: - std::cerr << "SO"; - break; - - case 15: - std::cerr << "SI"; - break; - - case 16: - std::cerr << "DLE"; - break; - - case 17: - std::cerr << "DC1"; - break; - - case 18: - std::cerr << "DC2"; - break; - - case 19: - std::cerr << "DC3"; - break; - - case 20: - std::cerr << "DC4"; - break; - - case 21: - std::cerr << "NAK"; - break; - - case 22: - std::cerr << "SYN"; - break; - - case 23: - std::cerr << "ETB"; - break; - - case 24: - std::cerr << "CAN"; - break; - - case 25: - std::cerr << "EM"; - break; - - case 26: - std::cerr << "SUB"; - break; - - case 27: - std::cerr << "ESC"; - break; - - case 28: - std::cerr << "FS"; - break; - - case 29: - std::cerr << "GS"; - break; - - case 30: - std::cerr << "RS"; - break; - - case 31: - std::cerr << "US"; - break; - - case 32: - std::cerr << "SPACE"; - break; - - case 127: - std::cerr << "DEL"; - break; - } -} - -static int -text_yyinput (void) -{ - int c = yyinput (); - - if (lexer_debug_flag) - { - std::cerr << "I: "; - display_character (c); - std::cerr << std::endl; - } - - // Convert CRLF into just LF and single CR into LF. - - if (c == '\r') - { - c = yyinput (); - - if (lexer_debug_flag) - { - std::cerr << "I: "; - display_character (c); - std::cerr << std::endl; - } - - if (c != '\n') - { - xunput (c, yytext); - c = '\n'; - } - } - - if (c == '\n') - input_line_number++; - - return c; -} - -static void -xunput (char c, char *buf) -{ - if (lexer_debug_flag) - { - std::cerr << "U: "; - display_character (c); - std::cerr << std::endl; - } - - if (c == '\n') - input_line_number--; - - yyunput (c, buf); -} - -// If we read some newlines, we need figure out what column we're -// really looking at. - -static void -fixup_column_count (char *s) -{ - char c; - while ((c = *s++) != '\0') - { - if (c == '\n') - { - input_line_number++; - current_input_column = 1; - } - else - current_input_column++; - } -} - -// Include these so that we don't have to link to libfl.a. - -int -yywrap (void) -{ - return 1; -} - -// Tell us all what the current buffer is. - -YY_BUFFER_STATE -current_buffer (void) -{ - return YY_CURRENT_BUFFER; -} - -// Create a new buffer. - -YY_BUFFER_STATE -create_buffer (FILE *f) -{ - return yy_create_buffer (f, YY_BUF_SIZE); -} - -// Start reading a new buffer. - -void -switch_to_buffer (YY_BUFFER_STATE buf) -{ - yy_switch_to_buffer (buf); -} - -// Delete a buffer. - -void -delete_buffer (YY_BUFFER_STATE buf) -{ - yy_delete_buffer (buf); - - // Prevent invalid yyin from being used by yyrestart. - if (! current_buffer ()) - yyin = 0; -} - -// Delete all buffers from the stack. -void -clear_all_buffers (void) -{ - while (current_buffer ()) - octave_pop_buffer_state (); -} - -void -cleanup_parser (void) -{ - reset_parser (); - - clear_all_buffers (); -} - -// Restore a buffer (for unwind-prot). - -void -restore_input_buffer (void *buf) -{ - switch_to_buffer (static_cast (buf)); -} - -// Delete a buffer (for unwind-prot). - -void -delete_input_buffer (void *buf) -{ - delete_buffer (static_cast (buf)); -} - -static bool -inside_any_object_index (void) -{ - bool retval = false; - - for (std::list::const_iterator i = lexer_flags.looking_at_object_index.begin (); - i != lexer_flags.looking_at_object_index.end (); i++) - { - if (*i) - { - retval = true; - break; - } - } - - return retval; -} - -// Handle keywords. Return -1 if the keyword should be ignored. - -static int -is_keyword_token (const std::string& s) -{ - int l = input_line_number; - int c = current_input_column; - - int len = s.length (); - - const octave_kw *kw = octave_kw_hash::in_word_set (s.c_str (), len); - - if (kw) - { - yylval.tok_val = 0; - - switch (kw->kw_id) - { - case break_kw: - case catch_kw: - case continue_kw: - case else_kw: - case otherwise_kw: - case return_kw: - case unwind_protect_cleanup_kw: - lexer_flags.at_beginning_of_statement = true; - break; - - case static_kw: - if ((reading_fcn_file || reading_script_file - || reading_classdef_file) - && ! curr_fcn_file_full_name.empty ()) - warning_with_id ("Octave:deprecated-keyword", - "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d of file `%s'", - input_line_number, - curr_fcn_file_full_name.c_str ()); - else - warning_with_id ("Octave:deprecated-keyword", - "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d", - input_line_number); - // fall through ... - - case persistent_kw: - break; - - case case_kw: - case elseif_kw: - case global_kw: - case until_kw: - break; - - case end_kw: - if (inside_any_object_index () - || (! reading_classdef_file - && (lexer_flags.defining_func - && ! (lexer_flags.looking_at_return_list - || lexer_flags.parsed_function_name.top ())))) - return 0; - - yylval.tok_val = new token (token::simple_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case end_try_catch_kw: - yylval.tok_val = new token (token::try_catch_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case end_unwind_protect_kw: - yylval.tok_val = new token (token::unwind_protect_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endfor_kw: - yylval.tok_val = new token (token::for_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endfunction_kw: - yylval.tok_val = new token (token::function_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endif_kw: - yylval.tok_val = new token (token::if_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endparfor_kw: - yylval.tok_val = new token (token::parfor_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endswitch_kw: - yylval.tok_val = new token (token::switch_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endwhile_kw: - yylval.tok_val = new token (token::while_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endclassdef_kw: - yylval.tok_val = new token (token::classdef_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endenumeration_kw: - yylval.tok_val = new token (token::enumeration_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endevents_kw: - yylval.tok_val = new token (token::events_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endmethods_kw: - yylval.tok_val = new token (token::methods_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endproperties_kw: - yylval.tok_val = new token (token::properties_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - - case for_kw: - case parfor_kw: - case while_kw: - promptflag--; - lexer_flags.looping++; - break; - - case do_kw: - lexer_flags.at_beginning_of_statement = true; - promptflag--; - lexer_flags.looping++; - break; - - case try_kw: - case unwind_protect_kw: - lexer_flags.at_beginning_of_statement = true; - promptflag--; - break; - - case if_kw: - case switch_kw: - promptflag--; - break; - - case get_kw: - case set_kw: - // 'get' and 'set' are keywords in classdef method - // declarations. - if (! lexer_flags.maybe_classdef_get_set_method) - return 0; - break; - - case enumeration_kw: - case events_kw: - case methods_kw: - case properties_kw: - // 'properties', 'methods' and 'events' are keywords for - // classdef blocks. - if (! lexer_flags.parsing_classdef) - return 0; - // fall through ... - - case classdef_kw: - // 'classdef' is always a keyword. - promptflag--; - break; - - case function_kw: - promptflag--; - - lexer_flags.defining_func++; - lexer_flags.parsed_function_name.push (false); - - if (! (reading_fcn_file || reading_script_file - || reading_classdef_file)) - input_line_number = 1; - break; - - case magic_file_kw: - { - if ((reading_fcn_file || reading_script_file - || reading_classdef_file) - && ! curr_fcn_file_full_name.empty ()) - yylval.tok_val = new token (curr_fcn_file_full_name, l, c); - else - yylval.tok_val = new token ("stdin", l, c); - } - break; - - case magic_line_kw: - yylval.tok_val = new token (static_cast (l), "", l, c); - break; - - default: - panic_impossible (); - } - - if (! yylval.tok_val) - yylval.tok_val = new token (l, c); - - token_stack.push (yylval.tok_val); - - return kw->tok; - } - - return 0; -} - -static bool -is_variable (const std::string& name) -{ - return (symbol_table::is_variable (name) - || (lexer_flags.pending_local_variables.find (name) - != lexer_flags.pending_local_variables.end ())); -} - -static std::string -grab_block_comment (stream_reader& reader, bool& eof) -{ - std::string buf; - - bool at_bol = true; - bool look_for_marker = false; - - bool warned_incompatible = false; - - int c = 0; - - while ((c = reader.getc ()) != EOF) - { - current_input_column++; - - if (look_for_marker) - { - at_bol = false; - look_for_marker = false; - - if (c == '{' || c == '}') - { - std::string tmp_buf (1, static_cast (c)); - - int type = c; - - bool done = false; - - while ((c = reader.getc ()) != EOF && ! done) - { - current_input_column++; - - switch (c) - { - case ' ': - case '\t': - tmp_buf += static_cast (c); - break; - - case '\n': - { - current_input_column = 0; - at_bol = true; - done = true; - - if (type == '{') - { - block_comment_nesting_level++; - promptflag--; - } - else - { - block_comment_nesting_level--; - promptflag++; - - if (block_comment_nesting_level == 0) - { - buf += grab_comment_block (reader, true, eof); - - return buf; - } - } - } - break; - - default: - at_bol = false; - tmp_buf += static_cast (c); - buf += tmp_buf; - done = true; - break; - } - } - } - } - - if (at_bol && (c == '%' || c == '#')) - { - if (c == '#' && ! warned_incompatible) - { - warned_incompatible = true; - maybe_gripe_matlab_incompatible_comment (c); - } - - at_bol = false; - look_for_marker = true; - } - else - { - buf += static_cast (c); - - if (c == '\n') - { - current_input_column = 0; - at_bol = true; - } - } - } - - if (c == EOF) - eof = true; - - return buf; -} - -std::string -grab_comment_block (stream_reader& reader, bool at_bol, - bool& eof) -{ - std::string buf; - - // TRUE means we are at the beginning of a comment block. - bool begin_comment = false; - - // TRUE means we are currently reading a comment block. - bool in_comment = false; - - bool warned_incompatible = false; - - int c = 0; - - while ((c = reader.getc ()) != EOF) - { - current_input_column++; - - if (begin_comment) - { - if (c == '%' || c == '#') - { - at_bol = false; - continue; - } - else if (at_bol && c == '{') - { - std::string tmp_buf (1, static_cast (c)); - - bool done = false; - - while ((c = reader.getc ()) != EOF && ! done) - { - current_input_column++; - - switch (c) - { - case ' ': - case '\t': - tmp_buf += static_cast (c); - break; - - case '\n': - { - current_input_column = 0; - at_bol = true; - done = true; - - block_comment_nesting_level++; - promptflag--; - - buf += grab_block_comment (reader, eof); - - in_comment = false; - - if (eof) - goto done; - } - break; - - default: - at_bol = false; - tmp_buf += static_cast (c); - buf += tmp_buf; - done = true; - break; - } - } - } - else - { - at_bol = false; - begin_comment = false; - } - } - - if (in_comment) - { - buf += static_cast (c); - - if (c == '\n') - { - at_bol = true; - current_input_column = 0; - in_comment = false; - - // FIXME -- bailing out here prevents things like - // - // octave> # comment - // octave> x = 1 - // - // from failing at the command line, while still - // allowing blocks of comments to be grabbed properly - // for function doc strings. But only the first line of - // a mult-line doc string will be picked up for - // functions defined on the command line. We need a - // better way of collecting these comments... - if (! (reading_fcn_file || reading_script_file)) - goto done; - } - } - else - { - switch (c) - { - case ' ': - case '\t': - break; - - case '#': - if (! warned_incompatible) - { - warned_incompatible = true; - maybe_gripe_matlab_incompatible_comment (c); - } - // fall through... - - case '%': - in_comment = true; - begin_comment = true; - break; - - default: - current_input_column--; - reader.ungetc (c); - goto done; - } - } - } - - done: - - if (c == EOF) - eof = true; - - return buf; -} - -class -flex_stream_reader : public stream_reader -{ -public: - flex_stream_reader (char *buf_arg) : stream_reader (), buf (buf_arg) { } - - int getc (void) { return ::text_yyinput (); } - int ungetc (int c) { ::xunput (c, buf); return 0; } - -private: - - // No copying! - - flex_stream_reader (const flex_stream_reader&); - - flex_stream_reader& operator = (const flex_stream_reader&); - - char *buf; -}; - -static int -process_comment (bool start_in_block, bool& eof) -{ - eof = false; - - std::string help_txt; - - if (! help_buf.empty ()) - help_txt = help_buf.top (); - - flex_stream_reader flex_reader (yytext); - - // process_comment is only supposed to be called when we are not - // initially looking at a block comment. - - std::string txt = start_in_block - ? grab_block_comment (flex_reader, eof) - : grab_comment_block (flex_reader, false, eof); - - if (lexer_debug_flag) - std::cerr << "C: " << txt << std::endl; - - if (help_txt.empty () && nesting_level.none ()) - { - if (! help_buf.empty ()) - help_buf.pop (); - - help_buf.push (txt); - } - - octave_comment_buffer::append (txt); - - current_input_column = 1; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.at_beginning_of_statement = true; - - if (YY_START == COMMAND_START) - BEGIN (INITIAL); - - if (nesting_level.none ()) - return '\n'; - else if (nesting_level.is_bracket_or_brace ()) - return ';'; - else - return 0; -} - -// Return 1 if the given character matches any character in the given -// string. - -static bool -match_any (char c, const char *s) -{ - char tmp; - while ((tmp = *s++) != '\0') - { - if (c == tmp) - return true; - } - return false; -} - -// Given information about the spacing surrounding an operator, -// return 1 if it looks like it should be treated as a binary -// operator. For example, -// -// [ 1 + 2 ] or [ 1+ 2] or [ 1+2 ] ==> binary -// -// [ 1 +2 ] ==> unary - -static bool -looks_like_bin_op (bool spc_prev, int next_char) -{ - bool spc_next = (next_char == ' ' || next_char == '\t'); - - return ((spc_prev && spc_next) || ! spc_prev); -} - -// Recognize separators. If the separator is a CRLF pair, it is -// replaced by a single LF. - -static bool -next_token_is_sep_op (void) -{ - bool retval = false; - - int c = text_yyinput (); - - retval = match_any (c, ",;\n]"); - - xunput (c, yytext); - - return retval; -} - -// Try to determine if the next token should be treated as a postfix -// unary operator. This is ugly, but it seems to do the right thing. - -static bool -next_token_is_postfix_unary_op (bool spc_prev) -{ - bool un_op = false; - - int c0 = text_yyinput (); - - if (c0 == '\'' && ! spc_prev) - { - un_op = true; - } - else if (c0 == '.') - { - int c1 = text_yyinput (); - un_op = (c1 == '\''); - xunput (c1, yytext); - } - else if (c0 == '+') - { - int c1 = text_yyinput (); - un_op = (c1 == '+'); - xunput (c1, yytext); - } - else if (c0 == '-') - { - int c1 = text_yyinput (); - un_op = (c1 == '-'); - xunput (c1, yytext); - } - - xunput (c0, yytext); - - return un_op; -} - -// Try to determine if the next token should be treated as a binary -// operator. -// -// This kluge exists because whitespace is not always ignored inside -// the square brackets that are used to create matrix objects (though -// spacing only really matters in the cases that can be interpreted -// either as binary ops or prefix unary ops: currently just +, -). -// -// Note that a line continuation directly following a + or - operator -// (e.g., the characters '[' 'a' ' ' '+' '\' LFD 'b' ']') will be -// parsed as a binary operator. - -static bool -next_token_is_bin_op (bool spc_prev) -{ - bool bin_op = false; - - int c0 = text_yyinput (); - - switch (c0) - { - case '+': - case '-': - { - int c1 = text_yyinput (); - - switch (c1) - { - case '+': - case '-': - // Unary ops, spacing doesn't matter. - break; - - case '=': - // Binary ops, spacing doesn't matter. - bin_op = true; - break; - - default: - // Could be either, spacing matters. - bin_op = looks_like_bin_op (spc_prev, c1); - break; - } - - xunput (c1, yytext); - } - break; - - case ':': - case '/': - case '\\': - case '^': - // Always a binary op (may also include /=, \=, and ^=). - bin_op = true; - break; - - // .+ .- ./ .\ .^ .* .** - case '.': - { - int c1 = text_yyinput (); - - if (match_any (c1, "+-/\\^*")) - // Always a binary op (may also include .+=, .-=, ./=, ...). - bin_op = true; - else if (! isdigit (c1) && c1 != ' ' && c1 != '\t' && c1 != '.') - // A structure element reference is a binary op. - bin_op = true; - - xunput (c1, yytext); - } - break; - - // = == & && | || * ** - case '=': - case '&': - case '|': - case '*': - // Always a binary op (may also include ==, &&, ||, **). - bin_op = true; - break; - - // < <= <> > >= - case '<': - case '>': - // Always a binary op (may also include <=, <>, >=). - bin_op = true; - break; - - // ~= != - case '~': - case '!': - { - int c1 = text_yyinput (); - - // ~ and ! can be unary ops, so require following =. - if (c1 == '=') - bin_op = true; - - xunput (c1, yytext); - } - break; - - default: - break; - } - - xunput (c0, yytext); - - return bin_op; -} - -// Used to delete trailing white space from tokens. - -static std::string -strip_trailing_whitespace (char *s) -{ - std::string retval = s; - - size_t pos = retval.find_first_of (" \t"); - - if (pos != std::string::npos) - retval.resize (pos); - - return retval; -} - -// FIXME -- we need to handle block comments here. - -static void -scan_for_comments (const char *text) -{ - std::string comment_buf; - - bool in_comment = false; - bool beginning_of_comment = false; - - int len = strlen (text); - int i = 0; - - while (i < len) - { - char c = text[i++]; - - switch (c) - { - case '%': - case '#': - if (in_comment) - { - if (! beginning_of_comment) - comment_buf += static_cast (c); - } - else - { - maybe_gripe_matlab_incompatible_comment (c); - in_comment = true; - beginning_of_comment = true; - } - break; - - case '\n': - if (in_comment) - { - comment_buf += static_cast (c); - octave_comment_buffer::append (comment_buf); - comment_buf.resize (0); - in_comment = false; - beginning_of_comment = false; - } - break; - - default: - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - } - break; - } - } - - if (! comment_buf.empty ()) - octave_comment_buffer::append (comment_buf); -} - -// Discard whitespace, including comments and continuations. -// -// Return value is logical OR of the following values: -// -// ATE_NOTHING : no spaces to eat -// ATE_SPACE_OR_TAB : space or tab in input -// ATE_NEWLINE : bare new line in input - -// FIXME -- we need to handle block comments here. - -static yum_yum -eat_whitespace (void) -{ - yum_yum retval = ATE_NOTHING; - - std::string comment_buf; - - bool in_comment = false; - bool beginning_of_comment = false; - - int c = 0; - - while ((c = text_yyinput ()) != EOF) - { - current_input_column++; - - switch (c) - { - case ' ': - case '\t': - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - } - retval |= ATE_SPACE_OR_TAB; - break; - - case '\n': - retval |= ATE_NEWLINE; - if (in_comment) - { - comment_buf += static_cast (c); - octave_comment_buffer::append (comment_buf); - comment_buf.resize (0); - in_comment = false; - beginning_of_comment = false; - } - current_input_column = 0; - break; - - case '#': - case '%': - if (in_comment) - { - if (! beginning_of_comment) - comment_buf += static_cast (c); - } - else - { - maybe_gripe_matlab_incompatible_comment (c); - in_comment = true; - beginning_of_comment = true; - } - break; - - case '.': - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - break; - } - else - { - if (have_ellipsis_continuation ()) - break; - else - goto done; - } - - case '\\': - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - break; - } - else - { - if (have_continuation ()) - break; - else - goto done; - } - - default: - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - break; - } - else - goto done; - } - } - - if (! comment_buf.empty ()) - octave_comment_buffer::append (comment_buf); - - done: - xunput (c, yytext); - current_input_column--; - return retval; -} - -static inline bool -looks_like_hex (const char *s, int len) -{ - return (len > 2 && s[0] == '0' && (s[1] == 'x' || s[1] == 'X')); -} - -static void -handle_number (void) -{ - double value = 0.0; - int nread = 0; - - if (looks_like_hex (yytext, strlen (yytext))) - { - unsigned long ival; - - nread = sscanf (yytext, "%lx", &ival); - - value = static_cast (ival); - } - else - { - char *tmp = strsave (yytext); - - char *idx = strpbrk (tmp, "Dd"); - - if (idx) - *idx = 'e'; - - nread = sscanf (tmp, "%lf", &value); - - delete [] tmp; - } - - // If yytext doesn't contain a valid number, we are in deep doo doo. - - assert (nread == 1); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - yylval.tok_val = new token (value, yytext, input_line_number, - current_input_column); - - token_stack.push (yylval.tok_val); - - current_input_column += yyleng; - - do_comma_insert_check (); -} - -// We have seen a backslash and need to find out if it should be -// treated as a continuation character. If so, this eats it, up to -// and including the new line character. -// -// Match whitespace only, followed by a comment character or newline. -// Once a comment character is found, discard all input until newline. -// If non-whitespace characters are found before comment -// characters, return 0. Otherwise, return 1. - -// FIXME -- we need to handle block comments here. - -static bool -have_continuation (bool trailing_comments_ok) -{ - std::ostringstream buf; - - std::string comment_buf; - - bool in_comment = false; - bool beginning_of_comment = false; - - int c = 0; - - while ((c = text_yyinput ()) != EOF) - { - buf << static_cast (c); - - switch (c) - { - case ' ': - case '\t': - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - } - break; - - case '%': - case '#': - if (trailing_comments_ok) - { - if (in_comment) - { - if (! beginning_of_comment) - comment_buf += static_cast (c); - } - else - { - maybe_gripe_matlab_incompatible_comment (c); - in_comment = true; - beginning_of_comment = true; - } - } - else - goto cleanup; - break; - - case '\n': - if (in_comment) - { - comment_buf += static_cast (c); - octave_comment_buffer::append (comment_buf); - } - current_input_column = 0; - promptflag--; - gripe_matlab_incompatible_continuation (); - return true; - - default: - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - } - else - goto cleanup; - break; - } - } - - xunput (c, yytext); - return false; - -cleanup: - - std::string s = buf.str (); - - int len = s.length (); - while (len--) - xunput (s[len], yytext); - - return false; -} - -// We have seen a `.' and need to see if it is the start of a -// continuation. If so, this eats it, up to and including the new -// line character. - -static bool -have_ellipsis_continuation (bool trailing_comments_ok) -{ - char c1 = text_yyinput (); - if (c1 == '.') - { - char c2 = text_yyinput (); - if (c2 == '.' && have_continuation (trailing_comments_ok)) - return true; - else - { - xunput (c2, yytext); - xunput (c1, yytext); - } - } - else - xunput (c1, yytext); - - return false; -} - -// See if we have a continuation line. If so, eat it and the leading -// whitespace on the next line. -// -// Return value is the same as described for eat_whitespace(). - -static yum_yum -eat_continuation (void) -{ - int retval = ATE_NOTHING; - - int c = text_yyinput (); - - if ((c == '.' && have_ellipsis_continuation ()) - || (c == '\\' && have_continuation ())) - retval = eat_whitespace (); - else - xunput (c, yytext); - - return retval; -} - -static int -handle_string (char delim) -{ - std::ostringstream buf; - - int bos_line = input_line_number; - int bos_col = current_input_column; - - int c; - int escape_pending = 0; - - while ((c = text_yyinput ()) != EOF) - { - current_input_column++; - - if (c == '\\') - { - if (delim == '\'' || escape_pending) - { - buf << static_cast (c); - escape_pending = 0; - } - else - { - if (have_continuation (false)) - escape_pending = 0; - else - { - buf << static_cast (c); - escape_pending = 1; - } - } - continue; - } - else if (c == '.') - { - if (delim == '\'' || ! have_ellipsis_continuation (false)) - buf << static_cast (c); - } - else if (c == '\n') - { - error ("unterminated string constant"); - break; - } - else if (c == delim) - { - if (escape_pending) - buf << static_cast (c); - else - { - c = text_yyinput (); - if (c == delim) - { - buf << static_cast (c); - } - else - { - std::string s; - xunput (c, yytext); - - if (delim == '\'') - s = buf.str (); - else - s = do_string_escapes (buf.str ()); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - - yylval.tok_val = new token (s, bos_line, bos_col); - token_stack.push (yylval.tok_val); - - if (delim == '"') - gripe_matlab_incompatible ("\" used as string delimiter"); - else if (delim == '\'') - gripe_single_quote_string (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - return delim == '"' ? DQ_STRING : SQ_STRING; - } - } - } - else - { - buf << static_cast (c); - } - - escape_pending = 0; - } - - return LEXICAL_ERROR; -} - -static bool -next_token_is_assign_op (void) -{ - bool retval = false; - - int c0 = text_yyinput (); - - switch (c0) - { - case '=': - { - int c1 = text_yyinput (); - xunput (c1, yytext); - if (c1 != '=') - retval = true; - } - break; - - case '+': - case '-': - case '*': - case '/': - case '\\': - case '&': - case '|': - { - int c1 = text_yyinput (); - xunput (c1, yytext); - if (c1 == '=') - retval = true; - } - break; - - case '.': - { - int c1 = text_yyinput (); - if (match_any (c1, "+-*/\\")) - { - int c2 = text_yyinput (); - xunput (c2, yytext); - if (c2 == '=') - retval = true; - } - xunput (c1, yytext); - } - break; - - case '>': - { - int c1 = text_yyinput (); - if (c1 == '>') - { - int c2 = text_yyinput (); - xunput (c2, yytext); - if (c2 == '=') - retval = true; - } - xunput (c1, yytext); - } - break; - - case '<': - { - int c1 = text_yyinput (); - if (c1 == '<') - { - int c2 = text_yyinput (); - xunput (c2, yytext); - if (c2 == '=') - retval = true; - } - xunput (c1, yytext); - } - break; - - default: - break; - } - - xunput (c0, yytext); - - return retval; -} - -static bool -next_token_is_index_op (void) -{ - int c = text_yyinput (); - xunput (c, yytext); - return c == '(' || c == '{'; -} - -static int -handle_close_bracket (bool spc_gobbled, int bracket_type) -{ - int retval = bracket_type; - - if (! nesting_level.none ()) - { - nesting_level.remove (); - - if (bracket_type == ']') - lexer_flags.bracketflag--; - else if (bracket_type == '}') - lexer_flags.braceflag--; - else - panic_impossible (); - } - - if (lexer_flags.bracketflag == 0 && lexer_flags.braceflag == 0) - BEGIN (INITIAL); - - if (bracket_type == ']' - && next_token_is_assign_op () - && ! lexer_flags.looking_at_return_list) - { - retval = CLOSE_BRACE; - } - else if ((lexer_flags.bracketflag || lexer_flags.braceflag) - && lexer_flags.convert_spaces_to_comma - && (nesting_level.is_bracket () - || (nesting_level.is_brace () - && ! lexer_flags.looking_at_object_index.front ()))) - { - bool index_op = next_token_is_index_op (); - - // Don't insert comma if we are looking at something like - // - // [x{i}{j}] or [x{i}(j)] - // - // but do if we are looking at - // - // [x{i} {j}] or [x{i} (j)] - - if (spc_gobbled || ! (bracket_type == '}' && index_op)) - { - bool bin_op = next_token_is_bin_op (spc_gobbled); - - bool postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); - - bool sep_op = next_token_is_sep_op (); - - if (! (postfix_un_op || bin_op || sep_op)) - { - maybe_warn_separator_insert (','); - - xunput (',', yytext); - return retval; - } - } - } - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - - return retval; -} - -static void -maybe_unput_comma (int spc_gobbled) -{ - if (nesting_level.is_bracket () - || (nesting_level.is_brace () - && ! lexer_flags.looking_at_object_index.front ())) - { - int bin_op = next_token_is_bin_op (spc_gobbled); - - int postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); - - int c1 = text_yyinput (); - int c2 = text_yyinput (); - - xunput (c2, yytext); - xunput (c1, yytext); - - int sep_op = next_token_is_sep_op (); - - int dot_op = (c1 == '.' - && (isalpha (c2) || isspace (c2) || c2 == '_')); - - if (postfix_un_op || bin_op || sep_op || dot_op) - return; - - int index_op = (c1 == '(' || c1 == '{'); - - // If there is no space before the indexing op, we don't insert - // a comma. - - if (index_op && ! spc_gobbled) - return; - - maybe_warn_separator_insert (','); - - xunput (',', yytext); - } -} - -static bool -next_token_can_follow_bin_op (void) -{ - std::stack buf; - - int c = EOF; - - // Skip whitespace in current statement on current line - while (true) - { - c = text_yyinput (); - - buf.push (c); - - if (match_any (c, ",;\n") || (c != ' ' && c != '\t')) - break; - } - - // Restore input. - while (! buf.empty ()) - { - xunput (buf.top (), yytext); - - buf.pop (); - } - - return (isalnum (c) || match_any (c, "!\"'(-[_{~")); -} - -static bool -can_be_command (const std::string& tok) -{ - // Don't allow these names to be treated as commands to avoid - // surprises when parsing things like "NaN ^2". - - return ! (tok == "e" - || tok == "I" || tok == "i" - || tok == "J" || tok == "j" - || tok == "Inf" || tok == "inf" - || tok == "NaN" || tok == "nan"); -} - -static bool -looks_like_command_arg (void) -{ - bool retval = true; - - int c0 = text_yyinput (); - - switch (c0) - { - // = == - case '=': - { - int c1 = text_yyinput (); - - if (c1 == '=') - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else - retval = false; - - xunput (c1, yytext); - } - break; - - case '(': - case '{': - // Indexing. - retval = false; - break; - - case '\n': - // EOL. - break; - - case '\'': - case '"': - // Beginning of a character string. - break; - - // + - ++ -- += -= - case '+': - case '-': - { - int c1 = text_yyinput (); - - switch (c1) - { - case '\n': - // EOL. - case '+': - case '-': - // Unary ops, spacing doesn't matter. - break; - - case '\t': - case ' ': - { - if (next_token_can_follow_bin_op ()) - retval = false; - } - break; - - case '=': - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - break; - } - - xunput (c1, yytext); - } - break; - - case ':': - case '/': - case '\\': - case '^': - { - int c1 = text_yyinput (); - - if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - // .+ .- ./ .\ .^ .* .** - case '.': - { - int c1 = text_yyinput (); - - if (match_any (c1, "+-/\\^*")) - { - int c2 = text_yyinput (); - - if (c2 == '=') - { - int c3 = text_yyinput (); - - if (! match_any (c3, ",;\n") && (c3 == ' ' || c3 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c3, yytext); - } - else if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") - && (! isdigit (c1) && c1 != ' ' && c1 != '\t' - && c1 != '.')) - { - // Structure reference. FIXME -- is this a complete check? - - retval = false; - } - - xunput (c1, yytext); - } - break; - - // & && | || * ** - case '&': - case '|': - case '*': - { - int c1 = text_yyinput (); - - if (c1 == c0) - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - // < <= > >= - case '<': - case '>': - { - int c1 = text_yyinput (); - - if (c1 == '=') - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - // ~= != - case '~': - case '!': - { - int c1 = text_yyinput (); - - // ~ and ! can be unary ops, so require following =. - if (c1 == '=') - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - default: - break; - } - - xunput (c0, yytext); - - return retval; -} - -static int -handle_superclass_identifier (void) -{ - eat_continuation (); - - std::string pkg; - std::string meth = strip_trailing_whitespace (yytext); - size_t pos = meth.find ("@"); - std::string cls = meth.substr (pos).substr (1); - meth = meth.substr (0, pos - 1); - - pos = cls.find ("."); - if (pos != std::string::npos) - { - pkg = cls.substr (pos).substr (1); - cls = cls.substr (0, pos - 1); - } - - int kw_token = (is_keyword_token (meth) || is_keyword_token (cls) - || is_keyword_token (pkg)); - if (kw_token) - { - error ("method, class and package names may not be keywords"); - return LEXICAL_ERROR; - } - - yylval.tok_val - = new token (meth.empty () ? 0 : &(symbol_table::insert (meth)), - cls.empty () ? 0 : &(symbol_table::insert (cls)), - pkg.empty () ? 0 : &(symbol_table::insert (pkg)), - input_line_number, current_input_column); - token_stack.push (yylval.tok_val); - - lexer_flags.convert_spaces_to_comma = true; - current_input_column += yyleng; - - return SUPERCLASSREF; -} - -static int -handle_meta_identifier (void) -{ - eat_continuation (); - - std::string pkg; - std::string cls = strip_trailing_whitespace (yytext).substr (1); - size_t pos = cls.find ("."); - - if (pos != std::string::npos) - { - pkg = cls.substr (pos).substr (1); - cls = cls.substr (0, pos - 1); - } - - int kw_token = is_keyword_token (cls) || is_keyword_token (pkg); - if (kw_token) - { - error ("class and package names may not be keywords"); - return LEXICAL_ERROR; - } - - yylval.tok_val - = new token (cls.empty () ? 0 : &(symbol_table::insert (cls)), - pkg.empty () ? 0 : &(symbol_table::insert (pkg)), - input_line_number, current_input_column); - - token_stack.push (yylval.tok_val); - - lexer_flags.convert_spaces_to_comma = true; - current_input_column += yyleng; - - return METAQUERY; -} - -// Figure out exactly what kind of token to return when we have seen -// an identifier. Handles keywords. Return -1 if the identifier -// should be ignored. - -static int -handle_identifier (void) -{ - bool at_bos = lexer_flags.at_beginning_of_statement; - - std::string tok = strip_trailing_whitespace (yytext); - - int c = yytext[yyleng-1]; - - int cont_is_spc = eat_continuation (); - - int spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); - - // If we are expecting a structure element, avoid recognizing - // keywords and other special names and return STRUCT_ELT, which is - // a string that is also a valid identifier. But first, we have to - // decide whether to insert a comma. - - if (lexer_flags.looking_at_indirect_ref) - { - do_comma_insert_check (); - - maybe_unput_comma (spc_gobbled); - - yylval.tok_val = new token (tok, input_line_number, - current_input_column); - - token_stack.push (yylval.tok_val); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = true; - - current_input_column += yyleng; - - return STRUCT_ELT; - } - - lexer_flags.at_beginning_of_statement = false; - - // The is_keyword_token may reset - // lexer_flags.at_beginning_of_statement. For example, if it sees - // an else token, then the next token is at the beginning of a - // statement. - - int kw_token = is_keyword_token (tok); - - // If we found a keyword token, then the beginning_of_statement flag - // is already set. Otherwise, we won't be at the beginning of a - // statement. - - if (lexer_flags.looking_at_function_handle) - { - if (kw_token) - { - error ("function handles may not refer to keywords"); - - return LEXICAL_ERROR; - } - else - { - yylval.tok_val = new token (tok, input_line_number, - current_input_column); - - token_stack.push (yylval.tok_val); - - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = true; - - return FCN_HANDLE; - } - } - - // If we have a regular keyword, return it. - // Keywords can be followed by identifiers. - - if (kw_token) - { - if (kw_token >= 0) - { - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - } - - return kw_token; - } - - // See if we have a plot keyword (title, using, with, or clear). - - int c1 = text_yyinput (); - - bool next_tok_is_eq = false; - if (c1 == '=') - { - int c2 = text_yyinput (); - xunput (c2, yytext); - - if (c2 != '=') - next_tok_is_eq = true; - } - - xunput (c1, yytext); - - // Kluge alert. - // - // If we are looking at a text style function, set up to gobble its - // arguments. - // - // If the following token is `=', or if we are parsing a function - // return list or function parameter list, or if we are looking at - // something like [ab,cd] = foo (), force the symbol to be inserted - // as a variable in the current symbol table. - - if (! is_variable (tok)) - { - if (at_bos && spc_gobbled && can_be_command (tok) - && looks_like_command_arg ()) - { - BEGIN (COMMAND_START); - } - else if (next_tok_is_eq - || lexer_flags.looking_at_decl_list - || lexer_flags.looking_at_return_list - || (lexer_flags.looking_at_parameter_list - && ! lexer_flags.looking_at_initializer_expression)) - { - symbol_table::force_variable (tok); - } - else if (lexer_flags.looking_at_matrix_or_assign_lhs) - { - lexer_flags.pending_local_variables.insert (tok); - } - } - - // Find the token in the symbol table. Beware the magic - // transformation of the end keyword... - - if (tok == "end") - tok = "__end__"; - - yylval.tok_val = new token (&(symbol_table::insert (tok)), - input_line_number, current_input_column); - - token_stack.push (yylval.tok_val); - - // After seeing an identifer, it is ok to convert spaces to a comma - // (if needed). - - lexer_flags.convert_spaces_to_comma = true; - - if (! (next_tok_is_eq || YY_START == COMMAND_START)) - { - lexer_flags.quote_is_transpose = true; - - do_comma_insert_check (); - - maybe_unput_comma (spc_gobbled); - } - - current_input_column += yyleng; - - if (tok != "__end__") - lexer_flags.looking_for_object_index = true; - - return NAME; -} - -void -lexical_feedback::init (void) -{ - // Not initially defining a matrix list. - bracketflag = 0; - - // Not initially defining a cell array list. - braceflag = 0; - - // Not initially inside a loop or if statement. - looping = 0; - - // Not initially defining a function. - defining_func = 0; - - // Not parsing an object index. - while (! parsed_function_name.empty ()) - parsed_function_name.pop (); - - parsing_class_method = false; - - // Not initially defining a class with classdef. - maybe_classdef_get_set_method = false; - parsing_classdef = false; - - // Not initiallly looking at a function handle. - looking_at_function_handle = 0; - - // Not initiallly looking at an anonymous function argument list. - looking_at_anon_fcn_args = 0; - - // Not parsing a function return, parameter, or declaration list. - looking_at_return_list = false; - looking_at_parameter_list = false; - looking_at_decl_list = false; - - // Not looking at an argument list initializer expression. - looking_at_initializer_expression = false; - - // Not parsing a matrix or the left hand side of multi-value - // assignment statement. - looking_at_matrix_or_assign_lhs = false; - - // Not parsing an object index. - while (! looking_at_object_index.empty ()) - looking_at_object_index.pop_front (); - - looking_at_object_index.push_front (false); - - // Object index not possible until we've seen something. - looking_for_object_index = false; - - // Yes, we are at the beginning of a statement. - at_beginning_of_statement = true; - - // No need to do comma insert or convert spaces to comma at - // beginning of input. - convert_spaces_to_comma = true; - do_comma_insert = false; - - // Not initially looking at indirect references. - looking_at_indirect_ref = false; - - // Quote marks strings intially. - quote_is_transpose = false; - - // Set of identifiers that might be local variable names is empty. - pending_local_variables.clear (); -} - -bool -is_keyword (const std::string& s) -{ - // Parsing function names like "set.property_name" inside - // classdef-style class definitions is simplified by handling the - // "set" and "get" portions of the names using the same mechanism as - // is used for keywords. However, they are not really keywords in - // the language, so omit them from the list of possible keywords. - - return (octave_kw_hash::in_word_set (s.c_str (), s.length ()) != 0 - && ! (s == "set" || s == "get")); -} - -DEFUN (iskeyword, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} iskeyword ()\n\ -@deftypefnx {Built-in Function} {} iskeyword (@var{name})\n\ -Return true if @var{name} is an Octave keyword. If @var{name}\n\ -is omitted, return a list of keywords.\n\ -@seealso{isvarname, exist}\n\ -@end deftypefn") -{ - octave_value retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("iskeyword"); - - if (error_state) - return retval; - - if (argc == 1) - { - // Neither set and get are keywords. See the note in the - // is_keyword function for additional details. - - string_vector lst (TOTAL_KEYWORDS); - - int j = 0; - - for (int i = 0; i < TOTAL_KEYWORDS; i++) - { - std::string tmp = wordlist[i].name; - - if (! (tmp == "set" || tmp == "get")) - lst[j++] = tmp; - } - - lst.resize (j); - - retval = Cell (lst.sort ()); - } - else if (argc == 2) - { - retval = is_keyword (argv[1]); - } - else - print_usage (); - - return retval; -} - -/* - -%!assert (iskeyword ("for")) -%!assert (iskeyword ("fort"), false) -%!assert (iskeyword ("fft"), false) - -*/ - -void -prep_lexer_for_script_file (void) -{ - BEGIN (SCRIPT_FILE_BEGIN); -} - -void -prep_lexer_for_function_file (void) -{ - BEGIN (FUNCTION_FILE_BEGIN); -} - -static void -maybe_warn_separator_insert (char sep) -{ - std::string nm = curr_fcn_file_full_name; - - if (nm.empty ()) - warning_with_id ("Octave:separator-insert", - "potential auto-insertion of `%c' near line %d", - sep, input_line_number); - else - warning_with_id ("Octave:separator-insert", - "potential auto-insertion of `%c' near line %d of file %s", - sep, input_line_number, nm.c_str ()); -} - -static void -gripe_single_quote_string (void) -{ - std::string nm = curr_fcn_file_full_name; - - if (nm.empty ()) - warning_with_id ("Octave:single-quote-string", - "single quote delimited string near line %d", - input_line_number); - else - warning_with_id ("Octave:single-quote-string", - "single quote delimited string near line %d of file %s", - input_line_number, nm.c_str ()); -} - -static void -gripe_matlab_incompatible (const std::string& msg) -{ - std::string nm = curr_fcn_file_full_name; - - if (nm.empty ()) - warning_with_id ("Octave:matlab-incompatible", - "potential Matlab compatibility problem: %s", - msg.c_str ()); - else - warning_with_id ("Octave:matlab-incompatible", - "potential Matlab compatibility problem: %s near line %d offile %s", - msg.c_str (), input_line_number, nm.c_str ()); -} - -static void -maybe_gripe_matlab_incompatible_comment (char c) -{ - if (c == '#') - gripe_matlab_incompatible ("# used as comment character"); -} - -static void -gripe_matlab_incompatible_continuation (void) -{ - gripe_matlab_incompatible ("\\ used as line continuation marker"); -} - -static void -gripe_matlab_incompatible_operator (const std::string& op) -{ - std::string t = op; - int n = t.length (); - if (t[n-1] == '\n') - t.resize (n-1); - gripe_matlab_incompatible (t + " used as operator"); -} - -static void -display_token (int tok) -{ - switch (tok) - { - case '=': std::cerr << "'='\n"; break; - case ':': std::cerr << "':'\n"; break; - case '-': std::cerr << "'-'\n"; break; - case '+': std::cerr << "'+'\n"; break; - case '*': std::cerr << "'*'\n"; break; - case '/': std::cerr << "'/'\n"; break; - case ADD_EQ: std::cerr << "ADD_EQ\n"; break; - case SUB_EQ: std::cerr << "SUB_EQ\n"; break; - case MUL_EQ: std::cerr << "MUL_EQ\n"; break; - case DIV_EQ: std::cerr << "DIV_EQ\n"; break; - case LEFTDIV_EQ: std::cerr << "LEFTDIV_EQ\n"; break; - case POW_EQ: std::cerr << "POW_EQ\n"; break; - case EMUL_EQ: std::cerr << "EMUL_EQ\n"; break; - case EDIV_EQ: std::cerr << "EDIV_EQ\n"; break; - case ELEFTDIV_EQ: std::cerr << "ELEFTDIV_EQ\n"; break; - case EPOW_EQ: std::cerr << "EPOW_EQ\n"; break; - case AND_EQ: std::cerr << "AND_EQ\n"; break; - case OR_EQ: std::cerr << "OR_EQ\n"; break; - case LSHIFT_EQ: std::cerr << "LSHIFT_EQ\n"; break; - case RSHIFT_EQ: std::cerr << "RSHIFT_EQ\n"; break; - case LSHIFT: std::cerr << "LSHIFT\n"; break; - case RSHIFT: std::cerr << "RSHIFT\n"; break; - case EXPR_AND_AND: std::cerr << "EXPR_AND_AND\n"; break; - case EXPR_OR_OR: std::cerr << "EXPR_OR_OR\n"; break; - case EXPR_AND: std::cerr << "EXPR_AND\n"; break; - case EXPR_OR: std::cerr << "EXPR_OR\n"; break; - case EXPR_NOT: std::cerr << "EXPR_NOT\n"; break; - case EXPR_LT: std::cerr << "EXPR_LT\n"; break; - case EXPR_LE: std::cerr << "EXPR_LE\n"; break; - case EXPR_EQ: std::cerr << "EXPR_EQ\n"; break; - case EXPR_NE: std::cerr << "EXPR_NE\n"; break; - case EXPR_GE: std::cerr << "EXPR_GE\n"; break; - case EXPR_GT: std::cerr << "EXPR_GT\n"; break; - case LEFTDIV: std::cerr << "LEFTDIV\n"; break; - case EMUL: std::cerr << "EMUL\n"; break; - case EDIV: std::cerr << "EDIV\n"; break; - case ELEFTDIV: std::cerr << "ELEFTDIV\n"; break; - case EPLUS: std::cerr << "EPLUS\n"; break; - case EMINUS: std::cerr << "EMINUS\n"; break; - case QUOTE: std::cerr << "QUOTE\n"; break; - case TRANSPOSE: std::cerr << "TRANSPOSE\n"; break; - case PLUS_PLUS: std::cerr << "PLUS_PLUS\n"; break; - case MINUS_MINUS: std::cerr << "MINUS_MINUS\n"; break; - case POW: std::cerr << "POW\n"; break; - case EPOW: std::cerr << "EPOW\n"; break; - - case NUM: - case IMAG_NUM: - std::cerr << (tok == NUM ? "NUM" : "IMAG_NUM") - << " [" << yylval.tok_val->number () << "]\n"; - break; - - case STRUCT_ELT: - std::cerr << "STRUCT_ELT [" << yylval.tok_val->text () << "]\n"; break; - - case NAME: - { - symbol_table::symbol_record *sr = yylval.tok_val->sym_rec (); - std::cerr << "NAME"; - if (sr) - std::cerr << " [" << sr->name () << "]"; - std::cerr << "\n"; - } - break; - - case END: std::cerr << "END\n"; break; - - case DQ_STRING: - case SQ_STRING: - std::cerr << (tok == DQ_STRING ? "DQ_STRING" : "SQ_STRING") - << " [" << yylval.tok_val->text () << "]\n"; - break; - - case FOR: std::cerr << "FOR\n"; break; - case WHILE: std::cerr << "WHILE\n"; break; - case DO: std::cerr << "DO\n"; break; - case UNTIL: std::cerr << "UNTIL\n"; break; - case IF: std::cerr << "IF\n"; break; - case ELSEIF: std::cerr << "ELSEIF\n"; break; - case ELSE: std::cerr << "ELSE\n"; break; - case SWITCH: std::cerr << "SWITCH\n"; break; - case CASE: std::cerr << "CASE\n"; break; - case OTHERWISE: std::cerr << "OTHERWISE\n"; break; - case BREAK: std::cerr << "BREAK\n"; break; - case CONTINUE: std::cerr << "CONTINUE\n"; break; - case FUNC_RET: std::cerr << "FUNC_RET\n"; break; - case UNWIND: std::cerr << "UNWIND\n"; break; - case CLEANUP: std::cerr << "CLEANUP\n"; break; - case TRY: std::cerr << "TRY\n"; break; - case CATCH: std::cerr << "CATCH\n"; break; - case GLOBAL: std::cerr << "GLOBAL\n"; break; - case PERSISTENT: std::cerr << "PERSISTENT\n"; break; - case FCN_HANDLE: std::cerr << "FCN_HANDLE\n"; break; - case END_OF_INPUT: std::cerr << "END_OF_INPUT\n\n"; break; - case LEXICAL_ERROR: std::cerr << "LEXICAL_ERROR\n\n"; break; - case FCN: std::cerr << "FCN\n"; break; - case CLOSE_BRACE: std::cerr << "CLOSE_BRACE\n"; break; - case SCRIPT_FILE: std::cerr << "SCRIPT_FILE\n"; break; - case FUNCTION_FILE: std::cerr << "FUNCTION_FILE\n"; break; - case SUPERCLASSREF: std::cerr << "SUPERCLASSREF\n"; break; - case METAQUERY: std::cerr << "METAQUERY\n"; break; - case GET: std::cerr << "GET\n"; break; - case SET: std::cerr << "SET\n"; break; - case PROPERTIES: std::cerr << "PROPERTIES\n"; break; - case METHODS: std::cerr << "METHODS\n"; break; - case EVENTS: std::cerr << "EVENTS\n"; break; - case CLASSDEF: std::cerr << "CLASSDEF\n"; break; - case '\n': std::cerr << "\\n\n"; break; - case '\r': std::cerr << "\\r\n"; break; - case '\t': std::cerr << "TAB\n"; break; - default: - { - if (tok < 256) - std::cerr << static_cast (tok) << "\n"; - else - std::cerr << "UNKNOWN(" << tok << ")\n"; - } - break; - } -} - -static void -display_state (void) -{ - std::cerr << "S: "; - - switch (YY_START) - { - case INITIAL: - std::cerr << "INITIAL" << std::endl; - break; - - case COMMAND_START: - std::cerr << "COMMAND_START" << std::endl; - break; - - case MATRIX_START: - std::cerr << "MATRIX_START" << std::endl; - break; - - case SCRIPT_FILE_BEGIN: - std::cerr << "SCRIPT_FILE_BEGIN" << std::endl; - break; - - case FUNCTION_FILE_BEGIN: - std::cerr << "FUNCTION_FILE_BEGIN" << std::endl; - break; - - default: - std::cerr << "UNKNOWN START STATE!" << std::endl; - break; - } -} - -static void -lexer_debug (const char *pattern, const char *text) -{ - std::cerr << std::endl; - - display_state (); - - std::cerr << "P: " << pattern << std::endl; - std::cerr << "T: " << text << std::endl; -} - -DEFUN (__display_tokens__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __display_tokens__ ()\n\ -Query or set the internal variable that determines whether Octave's\n\ -lexer displays tokens as they are read.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (display_tokens); -} - -DEFUN (__token_count__, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __token_count__ ()\n\ -Number of language tokens processed since Octave startup.\n\ -@end deftypefn") -{ - return octave_value (Vtoken_count); -} - -DEFUN (__lexer_debug_flag__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{old_val} =} __lexer_debug_flag__ (@var{new_val}))\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - retval = set_internal_variable (lexer_debug_flag, args, nargout, - "__lexer_debug_flag__"); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/link-deps.mk --- a/src/link-deps.mk Thu Aug 02 12:12:00 2012 +0200 +++ b/src/link-deps.mk Fri Aug 03 14:59:40 2012 -0400 @@ -3,7 +3,7 @@ if AMCOND_ENABLE_DYNAMIC_LINKING LIBOCTINTERP_LINK_DEPS = else - LIBOCTINTERP_LINK_DEPS = $(DLD_FUNCTIONS_LIBS) + LIBOCTINTERP_LINK_DEPS = $(DLDFCN_LIBS) endif LIBOCTINTERP_LINK_DEPS += \ @@ -16,7 +16,8 @@ $(OPENGL_LIBS) \ $(X11_LIBS) \ $(CARBON_LIBS) \ - $(LLVM_LIBS) + $(LLVM_LIBS) \ + $(LAPACK_LIBS) LIBOCTINTERP_LINK_OPTS = \ $(GRAPHICS_LDFLAGS) \ diff -r d02b229ce693 -r a132d206a36a src/load-path.cc --- a/src/load-path.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2327 +0,0 @@ -/* - -Copyright (C) 2006-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "dir-ops.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "pathsearch.h" -#include "singleton-cleanup.h" - -#include "defaults.h" -#include "defun.h" -#include "input.h" -#include "load-path.h" -#include "pager.h" -#include "parse.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" - -load_path *load_path::instance = 0; -load_path::hook_fcn_ptr load_path::add_hook = execute_pkg_add; -load_path::hook_fcn_ptr load_path::remove_hook = execute_pkg_del; -std::string load_path::command_line_path; -std::string load_path::sys_path; -load_path::abs_dir_cache_type load_path::abs_dir_cache; - -void -load_path::dir_info::update (void) -{ - file_stat fs (dir_name); - - if (fs) - { - if (is_relative) - { - try - { - std::string abs_name = octave_env::make_absolute (dir_name); - - abs_dir_cache_iterator p = abs_dir_cache.find (abs_name); - - if (p != abs_dir_cache.end ()) - { - // The directory is in the cache of all directories - // we have visited (indexed by its absolute name). - // If it is out of date, initialize it. Otherwise, - // copy the info from the cache. By doing that, we - // avoid unnecessary calls to stat that can slow - // things down tremendously for large directories. - - const dir_info& di = p->second; - - if (fs.mtime () + fs.time_resolution () > di.dir_time_last_checked) - initialize (); - else - *this = di; - } - else - { - // We haven't seen this directory before. - - initialize (); - } - } - catch (octave_execution_exception) - { - // Skip updating if we don't know where we are, but - // don't treat it as an error. - - error_state = 0; - } - } - else if (fs.mtime () + fs.time_resolution () > dir_time_last_checked) - initialize (); - } - else - { - std::string msg = fs.error (); - warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); - } -} - -void -load_path::dir_info::initialize (void) -{ - is_relative = ! octave_env::absolute_pathname (dir_name); - - dir_time_last_checked = octave_time (static_cast (0)); - - file_stat fs (dir_name); - - if (fs) - { - method_file_map.clear (); - - dir_mtime = fs.mtime (); - dir_time_last_checked = octave_time (); - - get_file_list (dir_name); - - try - { - std::string abs_name = octave_env::make_absolute (dir_name); - - // FIXME -- nothing is ever removed from this cache of - // directory information, so there could be some resource - // problems. Perhaps it should be pruned from time to time. - - abs_dir_cache[abs_name] = *this; - } - catch (octave_execution_exception) - { - // Skip updating if we don't know where we are. - } - } - else - { - std::string msg = fs.error (); - warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); - } -} - -void -load_path::dir_info::get_file_list (const std::string& d) -{ - dir_entry dir (d); - - if (dir) - { - string_vector flist = dir.read (); - - octave_idx_type len = flist.length (); - - all_files.resize (len); - fcn_files.resize (len); - - octave_idx_type all_files_count = 0; - octave_idx_type fcn_files_count = 0; - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = flist[i]; - - std::string full_name = file_ops::concat (d, fname); - - file_stat fs (full_name); - - if (fs) - { - if (fs.is_dir ()) - { - if (fname == "private") - get_private_file_map (full_name); - else if (fname[0] == '@') - get_method_file_map (full_name, fname.substr (1)); - } - else - { - all_files[all_files_count++] = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - std::string ext = fname.substr (pos); - - if (ext == ".m" || ext == ".oct" || ext == ".mex") - { - std::string base = fname.substr (0, pos); - - if (valid_identifier (base)) - fcn_files[fcn_files_count++] = fname; - } - } - } - } - } - - all_files.resize (all_files_count); - fcn_files.resize (fcn_files_count); - } - else - { - std::string msg = dir.error (); - warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); - } -} - -load_path::dir_info::fcn_file_map_type -get_fcn_files (const std::string& d) -{ - load_path::dir_info::fcn_file_map_type retval; - - dir_entry dir (d); - - if (dir) - { - string_vector flist = dir.read (); - - octave_idx_type len = flist.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = flist[i]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - - if (valid_identifier (base)) - { - int t = 0; - - if (ext == ".m") - t = load_path::M_FILE; - else if (ext == ".oct") - t = load_path::OCT_FILE; - else if (ext == ".mex") - t = load_path::MEX_FILE; - - retval[base] |= t; - } - } - } - } - else - { - std::string msg = dir.error (); - warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); - } - - return retval; -} - -void -load_path::dir_info::get_private_file_map (const std::string& d) -{ - private_file_map = get_fcn_files (d); -} - -void -load_path::dir_info::get_method_file_map (const std::string& d, - const std::string& class_name) -{ - method_file_map[class_name].method_file_map = get_fcn_files (d); - - std::string pd = file_ops::concat (d, "private"); - - file_stat fs (pd); - - if (fs && fs.is_dir ()) - method_file_map[class_name].private_file_map = get_fcn_files (pd); -} - -bool -load_path::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new load_path (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create load path object!"); - - retval = false; - } - - return retval; -} - -// FIXME -- maybe we should also maintain a map to speed up this -// method of access. - -load_path::const_dir_info_list_iterator -load_path::find_dir_info (const std::string& dir_arg) const -{ - std::string dir = file_ops::tilde_expand (dir_arg); - - const_dir_info_list_iterator retval = dir_info_list.begin (); - - while (retval != dir_info_list.end ()) - { - if (retval->dir_name == dir) - break; - - retval++; - } - - return retval; -} - -load_path::dir_info_list_iterator -load_path::find_dir_info (const std::string& dir_arg) -{ - std::string dir = file_ops::tilde_expand (dir_arg); - - dir_info_list_iterator retval = dir_info_list.begin (); - - while (retval != dir_info_list.end ()) - { - if (retval->dir_name == dir) - break; - - retval++; - } - - return retval; -} - -bool -load_path::contains (const std::string& dir) const -{ - return find_dir_info (dir) != dir_info_list.end (); -} - -void -load_path::move_fcn_map (const std::string& dir_name, - const string_vector& fcn_files, bool at_end) -{ - octave_idx_type len = fcn_files.length (); - - for (octave_idx_type k = 0; k < len; k++) - { - std::string fname = fcn_files[k]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - } - - file_info_list_type& file_info_list = fcn_map[base]; - - if (file_info_list.size () == 1) - continue; - else - { - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == dir_name) - { - file_info fi = *p; - - file_info_list.erase (p); - - if (at_end) - file_info_list.push_back (fi); - else - file_info_list.push_front (fi); - - break; - } - } - } - } -} - -void -load_path::move_method_map (const std::string& dir_name, bool at_end) -{ - for (method_map_iterator i = method_map.begin (); - i != method_map.end (); - i++) - { - std::string class_name = i->first; - - fcn_map_type& fm = i->second; - - std::string full_dir_name - = file_ops::concat (dir_name, "@" + class_name); - - for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) - { - file_info_list_type& file_info_list = q->second; - - if (file_info_list.size () == 1) - continue; - else - { - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == full_dir_name) - { - file_info fi = *p; - - file_info_list.erase (p); - - if (at_end) - file_info_list.push_back (fi); - else - file_info_list.push_front (fi); - - break; - } - } - } - } - } -} - -void -load_path::move (dir_info_list_iterator i, bool at_end) -{ - if (dir_info_list.size () > 1) - { - dir_info di = *i; - - dir_info_list.erase (i); - - if (at_end) - dir_info_list.push_back (di); - else - dir_info_list.push_front (di); - - std::string dir_name = di.dir_name; - - move_fcn_map (dir_name, di.fcn_files, at_end); - - // No need to move elements of private function map. - - move_method_map (dir_name, at_end); - } -} - -static void -maybe_add_path_elts (std::string& path, const std::string& dir) -{ - std::string tpath = genpath (dir); - - if (! tpath.empty ()) - { - if (path.empty ()) - path = tpath; - else - path += dir_path::path_sep_str () + tpath; - } -} - -void -load_path::do_initialize (bool set_initial_path) -{ - sys_path = ""; - - if (set_initial_path) - { - maybe_add_path_elts (sys_path, Vlocal_ver_oct_file_dir); - maybe_add_path_elts (sys_path, Vlocal_api_oct_file_dir); - maybe_add_path_elts (sys_path, Vlocal_oct_file_dir); - maybe_add_path_elts (sys_path, Vlocal_ver_fcn_file_dir); - maybe_add_path_elts (sys_path, Vlocal_api_fcn_file_dir); - maybe_add_path_elts (sys_path, Vlocal_fcn_file_dir); - maybe_add_path_elts (sys_path, Voct_file_dir); - maybe_add_path_elts (sys_path, Vfcn_file_dir); - } - - std::string tpath = load_path::command_line_path; - - if (tpath.empty ()) - tpath = octave_env::getenv ("OCTAVE_PATH"); - - std::string xpath; - - if (! tpath.empty ()) - { - xpath = tpath; - - if (! sys_path.empty ()) - xpath += dir_path::path_sep_str () + sys_path; - } - else - xpath = sys_path; - - do_set (xpath, false, true); -} - -void -load_path::do_clear (void) -{ - dir_info_list.clear (); - fcn_map.clear (); - private_fcn_map.clear (); - method_map.clear (); -} - -static std::list -split_path (const std::string& p) -{ - std::list retval; - - size_t beg = 0; - size_t end = p.find (dir_path::path_sep_char ()); - - size_t len = p.length (); - - while (end != std::string::npos) - { - std::string elt = p.substr (beg, end-beg); - - if (! elt.empty ()) - retval.push_back (elt); - - beg = end + 1; - - if (beg == len) - break; - - end = p.find (dir_path::path_sep_char (), beg); - } - - std::string elt = p.substr (beg); - - if (! elt.empty ()) - retval.push_back (elt); - - return retval; -} - -void -load_path::do_set (const std::string& p, bool warn, bool is_init) -{ - // Use a list when we need to preserve order. - std::list elts = split_path (p); - - // Use a set when we need to search and order is not important. - std::set elts_set (elts.begin (), elts.end ()); - - if (is_init) - init_dirs = elts_set; - else - { - for (std::set::const_iterator it = init_dirs.begin (); - it != init_dirs.end (); it++) - { - if (elts_set.find (*it) == elts_set.end ()) - { - warning_with_id ("Octave:remove-init-dir", - "default load path altered. Some built-in functions may not be found. Try restoredefaultpath() to recover it."); - break; - } - } - } - - // Temporarily disable add hook. - - unwind_protect frame; - frame.protect_var (add_hook); - - add_hook = 0; - - do_clear (); - - for (std::list::const_iterator i = elts.begin (); - i != elts.end (); i++) - do_append (*i, warn); - - // Restore add hook and execute for all newly added directories. - frame.run_top (); - - for (dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - { - if (add_hook) - add_hook (i->dir_name); - } - - // Always prepend current directory. - do_prepend (".", warn); -} - -void -load_path::do_append (const std::string& dir, bool warn) -{ - if (! dir.empty ()) - do_add (dir, true, warn); -} - -void -load_path::do_prepend (const std::string& dir, bool warn) -{ - if (! dir.empty ()) - do_add (dir, false, warn); -} - -// Strip trailing directory separators. - -static std::string -strip_trailing_separators (const std::string& dir_arg) -{ - std::string dir = dir_arg; - - size_t k = dir.length (); - - while (k > 1 && file_ops::is_dir_sep (dir[k-1])) - k--; - - if (k < dir.length ()) - dir.resize (k); - - return dir; -} - -void -load_path::do_add (const std::string& dir_arg, bool at_end, bool warn) -{ - size_t len = dir_arg.length (); - - if (len > 1 && dir_arg.substr (len-2) == "//") - warning_with_id ("Octave:recursive-path-search", - "trailing `//' is no longer special in search path elements"); - - std::string dir = file_ops::tilde_expand (dir_arg); - - dir = strip_trailing_separators (dir); - - dir_info_list_iterator i = find_dir_info (dir); - - if (i != dir_info_list.end ()) - move (i, at_end); - else - { - file_stat fs (dir); - - if (fs) - { - if (fs.is_dir ()) - { - dir_info di (dir); - - if (! error_state) - { - if (at_end) - dir_info_list.push_back (di); - else - dir_info_list.push_front (di); - - add_to_fcn_map (di, at_end); - - add_to_private_fcn_map (di); - - add_to_method_map (di, at_end); - - if (add_hook) - add_hook (dir); - } - } - else if (warn) - warning ("addpath: %s: not a directory", dir_arg.c_str ()); - } - else if (warn) - { - std::string msg = fs.error (); - warning ("addpath: %s: %s", dir_arg.c_str (), msg.c_str ()); - } - } - - // FIXME -- is there a better way to do this? - - i = find_dir_info ("."); - - if (i != dir_info_list.end ()) - move (i, false); -} - -void -load_path::remove_fcn_map (const std::string& dir, - const string_vector& fcn_files) -{ - octave_idx_type len = fcn_files.length (); - - for (octave_idx_type k = 0; k < len; k++) - { - std::string fname = fcn_files[k]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - } - - file_info_list_type& file_info_list = fcn_map[base]; - - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == dir) - { - file_info_list.erase (p); - - if (file_info_list.empty ()) - fcn_map.erase (fname); - - break; - } - } - } -} - -void -load_path::remove_private_fcn_map (const std::string& dir) -{ - private_fcn_map_iterator p = private_fcn_map.find (dir); - - if (p != private_fcn_map.end ()) - private_fcn_map.erase (p); -} - -void -load_path::remove_method_map (const std::string& dir) -{ - for (method_map_iterator i = method_map.begin (); - i != method_map.end (); - i++) - { - std::string class_name = i->first; - - fcn_map_type& fm = i->second; - - std::string full_dir_name = file_ops::concat (dir, "@" + class_name); - - for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) - { - file_info_list_type& file_info_list = q->second; - - if (file_info_list.size () == 1) - continue; - else - { - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == full_dir_name) - { - file_info_list.erase (p); - - // FIXME -- if there are no other elements, we - // should remove this element of fm but calling - // erase here would invalidate the iterator q. - - break; - } - } - } - } - } -} - -bool -load_path::do_remove (const std::string& dir_arg) -{ - bool retval = false; - - if (! dir_arg.empty ()) - { - if (dir_arg == ".") - { - warning ("rmpath: can't remove \".\" from path"); - - // Avoid additional warnings. - retval = true; - } - else - { - std::string dir = file_ops::tilde_expand (dir_arg); - - dir = strip_trailing_separators (dir); - - dir_info_list_iterator i = find_dir_info (dir); - - if (i != dir_info_list.end ()) - { - retval = true; - - if (remove_hook) - remove_hook (dir); - - string_vector fcn_files = i->fcn_files; - - dir_info_list.erase (i); - - remove_fcn_map (dir, fcn_files); - - remove_private_fcn_map (dir); - - remove_method_map (dir); - } - } - } - - return retval; -} - -void -load_path::do_update (void) const -{ - // I don't see a better way to do this because we need to - // preserve the correct directory ordering for new files that - // have appeared. - - fcn_map.clear (); - - private_fcn_map.clear (); - - method_map.clear (); - - for (dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - dir_info& di = *p; - - di.update (); - - add_to_fcn_map (di, true); - - add_to_private_fcn_map (di); - - add_to_method_map (di, true); - } -} - -bool -load_path::check_file_type (std::string& fname, int type, int possible_types, - const std::string& fcn, const char *who) -{ - bool retval = false; - - if (type == load_path::OCT_FILE) - { - if ((type & possible_types) == load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - } - else if (type == load_path::M_FILE) - { - if ((type & possible_types) == load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else if (type == load_path::MEX_FILE) - { - if ((type & possible_types) == load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - } - else if (type == (load_path::M_FILE | load_path::OCT_FILE)) - { - if (possible_types & load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - else if (possible_types & load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else if (type == (load_path::M_FILE | load_path::MEX_FILE)) - { - if (possible_types & load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - else if (possible_types & load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else if (type == (load_path::OCT_FILE | load_path::MEX_FILE)) - { - if (possible_types & load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - else if (possible_types & load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - } - else if (type == (load_path::M_FILE | load_path::OCT_FILE - | load_path::MEX_FILE)) - { - if (possible_types & load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - else if (possible_types & load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - else if (possible_types & load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else - error ("%s: %s: invalid type code = %d", who, fcn.c_str (), type); - - return retval; -} - -std::string -load_path::do_find_fcn (const std::string& fcn, std::string& dir_name, - int type) const -{ - std::string retval; - - // update (); - - if (fcn.length () > 0 && fcn[0] == '@') - { - size_t pos = fcn.find ('/'); - - if (pos != std::string::npos) - { - std::string class_name = fcn.substr (1, pos-1); - std::string meth = fcn.substr (pos+1); - - retval = do_find_method (class_name, meth, dir_name); - } - else - retval = std::string (); - } - else - { - dir_name = std::string (); - - const_fcn_map_iterator p = fcn_map.find (fcn); - - if (p != fcn_map.end ()) - { - const file_info_list_type& file_info_list = p->second; - - for (const_file_info_list_iterator i = file_info_list.begin (); - i != file_info_list.end (); - i++) - { - const file_info& fi = *i; - - retval = file_ops::concat (fi.dir_name, fcn); - - if (check_file_type (retval, type, fi.types, - fcn, "load_path::do_find_fcn")) - { - dir_name = fi.dir_name; - break; - } - else - retval = std::string (); - } - } - } - - return retval; -} - -std::string -load_path::do_find_private_fcn (const std::string& dir, - const std::string& fcn, int type) const -{ - std::string retval; - - // update (); - - const_private_fcn_map_iterator q = private_fcn_map.find (dir); - - if (q != private_fcn_map.end ()) - { - const dir_info::fcn_file_map_type& m = q->second; - - dir_info::const_fcn_file_map_iterator p = m.find (fcn); - - if (p != m.end ()) - { - std::string fname - = file_ops::concat (file_ops::concat (dir, "private"), fcn); - - if (check_file_type (fname, type, p->second, fcn, - "load_path::find_private_fcn")) - retval = fname; - } - } - - return retval; -} - -std::string -load_path::do_find_method (const std::string& class_name, - const std::string& meth, - std::string& dir_name, int type) const -{ - std::string retval; - - // update (); - - dir_name = std::string (); - - const_method_map_iterator q = method_map.find (class_name); - - if (q != method_map.end ()) - { - const fcn_map_type& m = q->second; - - const_fcn_map_iterator p = m.find (meth); - - if (p != m.end ()) - { - const file_info_list_type& file_info_list = p->second; - - for (const_file_info_list_iterator i = file_info_list.begin (); - i != file_info_list.end (); - i++) - { - const file_info& fi = *i; - - retval = file_ops::concat (fi.dir_name, meth); - - bool found = check_file_type (retval, type, fi.types, - meth, "load_path::do_find_method"); - - if (found) - { - dir_name = fi.dir_name; - break; - } - else - retval = std::string (); - } - } - } - - return retval; -} - -std::list -load_path::do_methods (const std::string& class_name) const -{ - std::list retval; - - // update (); - - const_method_map_iterator q = method_map.find (class_name); - - if (q != method_map.end ()) - { - const fcn_map_type& m = q->second; - - for (const_fcn_map_iterator p = m.begin (); p != m.end (); p++) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; -} - -std::list -load_path::do_overloads (const std::string& meth) const -{ - std::list retval; - - // update (); - - for (const_method_map_iterator q = method_map.begin (); - q != method_map.end (); q++) - { - const fcn_map_type& m = q->second; - - if (m.find (meth) != m.end ()) - retval.push_back (q->first); - } - - return retval; -} - -std::string -load_path::do_find_file (const std::string& file) const -{ - std::string retval; - - if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) - { - if (octave_env::absolute_pathname (file) - || octave_env::rooted_relative_pathname (file)) - { - file_stat fs (file); - - if (fs.exists ()) - return file; - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string tfile = file_ops::concat (p->dir_name, file); - - file_stat fs (tfile); - - if (fs.exists ()) - return tfile; - } - } - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - string_vector all_files = p->all_files; - - octave_idx_type len = all_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - if (all_files[i] == file) - return file_ops::concat (p->dir_name, file); - } - } - } - - return retval; -} - -std::string -load_path::do_find_dir (const std::string& dir) const -{ - std::string retval; - - if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos - && (octave_env::absolute_pathname (dir) - || octave_env::rooted_relative_pathname (dir))) - { - file_stat fs (dir); - - if (fs.exists () && fs.is_dir ()) - return dir; - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string dname = octave_env::make_absolute (p->dir_name); - - size_t dname_len = dname.length (); - - if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) - { - dname = dname.substr (0, dname_len - 1); - dname_len--; - } - - size_t dir_len = dir.length (); - - if (dname_len >= dir_len - && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) - && dir.compare (dname.substr (dname_len - dir_len)) == 0) - { - file_stat fs (p->dir_name); - - if (fs.exists () && fs.is_dir ()) - return p->dir_name; - } - } - } - - return retval; -} - -string_vector -load_path::do_find_matching_dirs (const std::string& dir) const -{ - std::list retlist; - - if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos - && (octave_env::absolute_pathname (dir) - || octave_env::rooted_relative_pathname (dir))) - { - file_stat fs (dir); - - if (fs.exists () && fs.is_dir ()) - retlist.push_back (dir); - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string dname = octave_env::make_absolute (p->dir_name); - - size_t dname_len = dname.length (); - - if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) - { - dname = dname.substr (0, dname_len - 1); - dname_len--; - } - - size_t dir_len = dir.length (); - - if (dname_len >= dir_len - && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) - && dir.compare (dname.substr (dname_len - dir_len)) == 0) - { - file_stat fs (p->dir_name); - - if (fs.exists () && fs.is_dir ()) - retlist.push_back (p->dir_name); - } - } - } - - return retlist; -} - -std::string -load_path::do_find_first_of (const string_vector& flist) const -{ - std::string retval; - - std::string dir_name; - std::string file_name; - - octave_idx_type flen = flist.length (); - octave_idx_type rel_flen = 0; - - string_vector rel_flist (flen); - - for (octave_idx_type i = 0; i < flen; i++) - { - std::string file = flist[i]; - - if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) - { - if (octave_env::absolute_pathname (file) - || octave_env::rooted_relative_pathname (file)) - { - file_stat fs (file); - - if (fs.exists ()) - return file; - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string tfile = file_ops::concat (p->dir_name, file); - - file_stat fs (tfile); - - if (fs.exists ()) - return tfile; - } - } - } - else - rel_flist[rel_flen++] = file; - } - - rel_flist.resize (rel_flen); - - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - string_vector all_files = p->all_files; - - octave_idx_type len = all_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - for (octave_idx_type j = 0; j < rel_flen; j++) - { - if (all_files[i] == rel_flist[j]) - { - dir_name = p->dir_name; - file_name = rel_flist[j]; - - goto done; - } - } - } - } - - done: - - if (! dir_name.empty ()) - retval = file_ops::concat (dir_name, file_name); - - return retval; -} - -string_vector -load_path::do_find_all_first_of (const string_vector& flist) const -{ - std::list retlist; - - std::string dir_name; - std::string file_name; - - octave_idx_type flen = flist.length (); - octave_idx_type rel_flen = 0; - - string_vector rel_flist (flen); - - for (octave_idx_type i = 0; i < flen; i++) - { - std::string file = flist[i]; - - if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) - { - if (octave_env::absolute_pathname (file) - || octave_env::rooted_relative_pathname (file)) - { - file_stat fs (file); - - if (fs.exists ()) - retlist.push_back (file); - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string tfile = file_ops::concat (p->dir_name, file); - - file_stat fs (tfile); - - if (fs.exists ()) - retlist.push_back (tfile); - } - } - } - else - rel_flist[rel_flen++] = file; - } - - rel_flist.resize (rel_flen); - - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - string_vector all_files = p->all_files; - - octave_idx_type len = all_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - for (octave_idx_type j = 0; j < rel_flen; j++) - { - if (all_files[i] == rel_flist[j]) - retlist.push_back - (file_ops::concat (p->dir_name, rel_flist[j])); - } - } - } - - return retlist; -} - -string_vector -load_path::do_dirs (void) const -{ - size_t len = dir_info_list.size (); - - string_vector retval (len); - - octave_idx_type k = 0; - - for (const_dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - retval[k++] = i->dir_name; - - return retval; -} - -std::list -load_path::do_dir_list (void) const -{ - std::list retval; - - for (const_dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - retval.push_back (i->dir_name); - - return retval; -} - -string_vector -load_path::do_files (const std::string& dir, bool omit_exts) const -{ - string_vector retval; - - const_dir_info_list_iterator p = find_dir_info (dir); - - if (p != dir_info_list.end ()) - retval = p->fcn_files; - - if (omit_exts) - { - octave_idx_type len = retval.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = retval[i]; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - retval[i] = fname.substr (0, pos); - } - } - - return retval; -} - -string_vector -load_path::do_fcn_names (void) const -{ - size_t len = fcn_map.size (); - - string_vector retval (len); - - octave_idx_type count = 0; - - for (const_fcn_map_iterator p = fcn_map.begin (); - p != fcn_map.end (); - p++) - retval[count++] = p->first; - - return retval; -} - -std::string -load_path::do_path (void) const -{ - std::string xpath; - - string_vector xdirs = load_path::dirs (); - - octave_idx_type len = xdirs.length (); - - if (len > 0) - xpath = xdirs[0]; - - for (octave_idx_type i = 1; i < len; i++) - xpath += dir_path::path_sep_str () + xdirs[i]; - - return xpath; -} - -void -print_types (std::ostream& os, int types) -{ - bool printed_type = false; - - if (types & load_path::OCT_FILE) - { - os << "oct"; - printed_type = true; - } - - if (types & load_path::MEX_FILE) - { - if (printed_type) - os << "|"; - os << "mex"; - printed_type = true; - } - - if (types & load_path::M_FILE) - { - if (printed_type) - os << "|"; - os << "m"; - printed_type = true; - } -} - -void -print_fcn_list (std::ostream& os, - const load_path::dir_info::fcn_file_map_type& lst) -{ - for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); - p != lst.end (); - p++) - { - os << " " << p->first << " ("; - - print_types (os, p->second); - - os << ")\n"; - } -} - -string_vector -get_file_list (const load_path::dir_info::fcn_file_map_type& lst) -{ - octave_idx_type n = lst.size (); - - string_vector retval (n); - - octave_idx_type count = 0; - - for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); - p != lst.end (); - p++) - { - std::string nm = p->first; - - int types = p->second; - - if (types & load_path::OCT_FILE) - nm += ".oct"; - else if (types & load_path::MEX_FILE) - nm += ".mex"; - else - nm += ".m"; - - retval[count++] = nm; - } - - return retval; -} - -void -load_path::do_display (std::ostream& os) const -{ - for (const_dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - { - string_vector fcn_files = i->fcn_files; - - if (! fcn_files.empty ()) - { - os << "\n*** function files in " << i->dir_name << ":\n\n"; - - fcn_files.list_in_columns (os); - } - - const dir_info::method_file_map_type& method_file_map - = i->method_file_map; - - if (! method_file_map.empty ()) - { - for (dir_info::const_method_file_map_iterator p = method_file_map.begin (); - p != method_file_map.end (); - p++) - { - os << "\n*** methods in " << i->dir_name - << "/@" << p->first << ":\n\n"; - - const dir_info::class_info& ci = p->second; - - string_vector method_files = get_file_list (ci.method_file_map); - - method_files.list_in_columns (os); - } - } - } - - for (const_private_fcn_map_iterator i = private_fcn_map.begin (); - i != private_fcn_map.end (); i++) - { - os << "\n*** private functions in " - << file_ops::concat (i->first, "private") << ":\n\n"; - - print_fcn_list (os, i->second); - } - -#if defined (DEBUG_LOAD_PATH) - - for (const_fcn_map_iterator i = fcn_map.begin (); - i != fcn_map.end (); - i++) - { - os << i->first << ":\n"; - - const file_info_list_type& file_info_list = i->second; - - for (const_file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - os << " " << p->dir_name << " ("; - - print_types (os, p->types); - - os << ")\n"; - } - } - - for (const_method_map_iterator i = method_map.begin (); - i != method_map.end (); - i++) - { - os << "CLASS " << i->first << ":\n"; - - const fcn_map_type& fm = i->second; - - for (const_fcn_map_iterator q = fm.begin (); - q != fm.end (); - q++) - { - os << " " << q->first << ":\n"; - - const file_info_list_type& file_info_list = q->second; - - for (const_file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - os << " " << p->dir_name << " ("; - - print_types (os, p->types); - - os << ")\n"; - } - } - } - - os << "\n"; - -#endif -} - -// True if a path is contained in a path list separated by path_sep_char -static bool -in_path_list (const std::string& path_list, const std::string& path) -{ - size_t ps = path.size (), pls = path_list.size (), pos = path_list.find (path); - char psc = dir_path::path_sep_char (); - while (pos != std::string::npos) - { - if ((pos == 0 || path_list[pos-1] == psc) - && (pos + ps == pls || path_list[pos + ps] == psc)) - return true; - else - pos = path_list.find (path, pos + 1); - } - - return false; -} - -void -load_path::add_to_fcn_map (const dir_info& di, bool at_end) const -{ - std::string dir_name = di.dir_name; - - string_vector fcn_files = di.fcn_files; - - octave_idx_type len = fcn_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = fcn_files[i]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - } - - file_info_list_type& file_info_list = fcn_map[base]; - - file_info_list_iterator p = file_info_list.begin (); - - while (p != file_info_list.end ()) - { - if (p->dir_name == dir_name) - break; - - p++; - } - - int t = 0; - if (ext == ".m") - t = load_path::M_FILE; - else if (ext == ".oct") - t = load_path::OCT_FILE; - else if (ext == ".mex") - t = load_path::MEX_FILE; - - if (p == file_info_list.end ()) - { - file_info fi (dir_name, t); - - if (at_end) - file_info_list.push_back (fi); - else - { - // Warn if a built-in or library function is being shadowed. - - if (! file_info_list.empty ()) - { - file_info& old = file_info_list.front (); - - // FIXME -- do we need to be more careful about the - // way we look for old.dir_name in sys_path to avoid - // partial matches? - - // Don't warn about Contents.m files since we expect - // more than one to exist in the load path. - - if (fname != "Contents.m" - && sys_path.find (old.dir_name) != std::string::npos - && in_path_list (sys_path, old.dir_name)) - { - std::string fcn_path = file_ops::concat (dir_name, fname); - - warning_with_id ("Octave:shadowed-function", - "function %s shadows a core library function", - fcn_path.c_str ()); - } - } - else if (symbol_table::is_built_in_function_name (base)) - { - std::string fcn_path = file_ops::concat (dir_name, fname); - warning_with_id ("Octave:shadowed-function", - "function %s shadows a built-in function", - fcn_path.c_str ()); - } - - file_info_list.push_front (fi); - } - } - else - { - file_info& fi = *p; - - fi.types |= t; - } - } -} - -void -load_path::add_to_private_fcn_map (const dir_info& di) const -{ - dir_info::fcn_file_map_type private_file_map = di.private_file_map; - - if (! private_file_map.empty ()) - private_fcn_map[di.dir_name] = private_file_map; -} - -void -load_path::add_to_method_map (const dir_info& di, bool at_end) const -{ - std::string dir_name = di.dir_name; - - // - dir_info::method_file_map_type method_file_map = di.method_file_map; - - for (dir_info::const_method_file_map_iterator q = method_file_map.begin (); - q != method_file_map.end (); - q++) - { - std::string class_name = q->first; - - fcn_map_type& fm = method_map[class_name]; - - std::string full_dir_name - = file_ops::concat (dir_name, "@" + class_name); - - const dir_info::class_info& ci = q->second; - - // - const dir_info::fcn_file_map_type& m = ci.method_file_map; - - for (dir_info::const_fcn_file_map_iterator p = m.begin (); - p != m.end (); - p++) - { - std::string base = p->first; - - int types = p->second; - - file_info_list_type& file_info_list = fm[base]; - - file_info_list_iterator p2 = file_info_list.begin (); - - while (p2 != file_info_list.end ()) - { - if (p2->dir_name == full_dir_name) - break; - - p2++; - } - - if (p2 == file_info_list.end ()) - { - file_info fi (full_dir_name, types); - - if (at_end) - file_info_list.push_back (fi); - else - file_info_list.push_front (fi); - } - else - { - // FIXME -- is this possible? - - file_info& fi = *p2; - - fi.types = types; - } - } - - // - dir_info::fcn_file_map_type private_file_map = ci.private_file_map; - - if (! private_file_map.empty ()) - private_fcn_map[full_dir_name] = private_file_map; - } -} - -std::string -genpath (const std::string& dirname, const string_vector& skip) -{ - std::string retval; - - dir_entry dir (dirname); - - if (dir) - { - retval = dirname; - - string_vector dirlist = dir.read (); - - octave_idx_type len = dirlist.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string elt = dirlist[i]; - - bool skip_p = (elt == "." || elt == ".." || elt[0] == '@'); - - if (! skip_p) - { - for (octave_idx_type j = 0; j < skip.length (); j++) - { - skip_p = (elt == skip[j]); - if (skip_p) - break; - } - - if (! skip_p) - { - std::string nm = file_ops::concat (dirname, elt); - - file_stat fs (nm); - - if (fs && fs.is_dir ()) - retval += dir_path::path_sep_str () + genpath (nm, skip); - } - } - } - } - - return retval; -} - -static void -execute_pkg_add_or_del (const std::string& dir, - const std::string& script_file) -{ - if (! octave_interpreter_ready) - return; - - unwind_protect frame; - - frame.protect_var (input_from_startup_file); - - input_from_startup_file = true; - - std::string file = file_ops::concat (dir, script_file); - - file_stat fs (file); - - if (fs.exists ()) - source_file (file, "base"); -} - -void -execute_pkg_add (const std::string& dir) -{ - execute_pkg_add_or_del (dir, "PKG_ADD"); -} - -void -execute_pkg_del (const std::string& dir) -{ - execute_pkg_add_or_del (dir, "PKG_DEL"); -} - -DEFUN (genpath, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} genpath (@var{dir})\n\ -@deftypefnx {Built-in Function} {} genpath (@var{dir}, @var{skip}, @dots{})\n\ -Return a path constructed from @var{dir} and all its subdirectories.\n\ -If additional string parameters are given, the resulting path will\n\ -exclude directories with those names.\n\ -@end deftypefn") -{ - octave_value retval; - - octave_idx_type nargin = args.length (); - - if (nargin == 1) - { - std::string dirname = args(0).string_value (); - - if (! error_state) - retval = genpath (dirname); - else - error ("genpath: DIR must be a character string"); - } - else if (nargin > 1) - { - std::string dirname = args(0).string_value (); - - string_vector skip (nargin - 1); - - for (octave_idx_type i = 1; i < nargin; i++) - { - skip[i-1] = args(i).string_value (); - - if (error_state) - break; - } - - if (! error_state) - retval = genpath (dirname, skip); - else - error ("genpath: all arguments must be character strings"); - } - else - print_usage (); - - return retval; -} - -static void -rehash_internal (void) -{ - load_path::update (); - - // FIXME -- maybe we should rename this variable since it is being - // used for more than keeping track of the prompt time. - - // This will force updated functions to be found. - Vlast_prompt_time.stamp (); -} - -DEFUN (rehash, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rehash ()\n\ -Reinitialize Octave's load path directory cache.\n\ -@end deftypefn") -{ - octave_value_list retval; - - rehash_internal (); - - return retval; -} - -DEFUN (command_line_path, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} command_line_path (@dots{})\n\ -Return the command line path variable.\n\ -\n\ -@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - return octave_value (load_path::get_command_line_path ()); -} - -DEFUN (restoredefaultpath, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} restoredefaultpath (@dots{})\n\ -Restore Octave's path to its initial state at startup.\n\ -\n\ -@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - load_path::initialize (true); - - return octave_value (load_path::system_path ()); -} - -// Return Octave's original default list of directories in which to -// search for function files. This corresponds to the path that -// exists prior to running the system's octaverc file or the user's -// ~/.octaverc file - -DEFUN (__pathorig__, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} __pathorig__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return octave_value (load_path::system_path ()); -} - -DEFUN (path, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} path (@dots{})\n\ -Modify or display Octave's load path.\n\ -\n\ -If @var{nargin} and @var{nargout} are zero, display the elements of\n\ -Octave's load path in an easy to read format.\n\ -\n\ -If @var{nargin} is zero and nargout is greater than zero, return the\n\ -current load path.\n\ -\n\ -If @var{nargin} is greater than zero, concatenate the arguments,\n\ -separating them with @code{pathsep}. Set the internal search path\n\ -to the result and return it.\n\ -\n\ -No checks are made for duplicate elements.\n\ -@seealso{addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - octave_value retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("path"); - - if (! error_state) - { - if (argc > 1) - { - std::string path = argv[1]; - - for (int i = 2; i < argc; i++) - path += dir_path::path_sep_str () + argv[i]; - - load_path::set (path, true); - - rehash_internal (); - } - - if (nargout > 0) - retval = load_path::path (); - else if (argc == 1 && nargout == 0) - { - octave_stdout << "\nOctave's search path contains the following directories:\n\n"; - - string_vector dirs = load_path::dirs (); - - dirs.list_in_columns (octave_stdout); - - octave_stdout << "\n"; - } - } - - return retval; -} - -DEFUN (addpath, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} addpath (@var{dir1}, @dots{})\n\ -@deftypefnx {Built-in Function} {} addpath (@var{dir1}, @dots{}, @var{option})\n\ -Add @var{dir1}, @dots{} to the current function search path. If\n\ -@var{option} is \"-begin\" or 0 (the default), prepend the\n\ -directory name to the current path. If @var{option} is \"-end\"\n\ -or 1, append the directory name to the current path.\n\ -Directories added to the path must exist.\n\ -\n\ -In addition to accepting individual directory arguments, lists of\n\ -directory names separated by @code{pathsep} are also accepted. For example:\n\ -\n\ -@example\n\ -addpath (\"dir1:/dir2:~/dir3\")\n\ -@end example\n\ -@seealso{path, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - octave_value retval; - - // Originally written by Bill Denney and Etienne Grossman. Heavily - // modified and translated to C++ by jwe. - - if (nargout > 0) - retval = load_path::path (); - - int nargin = args.length (); - - if (nargin > 0) - { - bool append = false; - - octave_value option_arg = args(nargin-1); - - if (option_arg.is_string ()) - { - std::string option = option_arg.string_value (); - - if (option == "-end") - { - append = true; - nargin--; - } - else if (option == "-begin") - nargin--; - } - else if (option_arg.is_numeric_type ()) - { - int val = option_arg.int_value (); - - if (! error_state) - { - if (val == 0) - nargin--; - else if (val == 1) - { - append = true; - nargin--; - } - else - { - error ("addpath: expecting final argument to be 1 or 0"); - return retval; - } - } - else - { - error ("addpath: expecting final argument to be 1 or 0"); - return retval; - } - } - - bool need_to_update = false; - - for (int i = 0; i < nargin; i++) - { - std::string arg = args(i).string_value (); - - if (! error_state) - { - std::list dir_elts = split_path (arg); - - if (! append) - std::reverse (dir_elts.begin (), dir_elts.end ()); - - for (std::list::const_iterator p = dir_elts.begin (); - p != dir_elts.end (); - p++) - { - std::string dir = *p; - - //dir = regexprep (dir_elts{j}, '//+', "/"); - //dir = regexprep (dir, '/$', ""); - - if (append) - load_path::append (dir, true); - else - load_path::prepend (dir, true); - - need_to_update = true; - } - } - else - error ("addpath: all arguments must be character strings"); - } - - if (need_to_update) - rehash_internal (); - } - else - print_usage (); - - return retval; -} - -DEFUN (rmpath, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rmpath (@var{dir1}, @dots{})\n\ -Remove @var{dir1}, @dots{} from the current function search path.\n\ -\n\ -In addition to accepting individual directory arguments, lists of\n\ -directory names separated by @code{pathsep} are also accepted. For example:\n\ -\n\ -@example\n\ -rmpath (\"dir1:/dir2:~/dir3\")\n\ -@end example\n\ -@seealso{path, addpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - // Originally by Etienne Grossmann. Heavily modified and translated - // to C++ by jwe. - - octave_value retval; - - if (nargout > 0) - retval = load_path::path (); - - int nargin = args.length (); - - if (nargin > 0) - { - bool need_to_update = false; - - for (int i = 0; i < nargin; i++) - { - std::string arg = args(i).string_value (); - - if (! error_state) - { - std::list dir_elts = split_path (arg); - - for (std::list::const_iterator p = dir_elts.begin (); - p != dir_elts.end (); - p++) - { - std::string dir = *p; - - //dir = regexprep (dir_elts{j}, '//+', "/"); - //dir = regexprep (dir, '/$', ""); - - if (! load_path::remove (dir)) - warning ("rmpath: %s: not found", dir.c_str ()); - else - need_to_update = true; - } - } - else - error ("addpath: all arguments must be character strings"); - } - - if (need_to_update) - rehash_internal (); - } - else - print_usage (); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/load-path.h --- a/src/load-path.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,566 +0,0 @@ -/* - -Copyright (C) 2006-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_load_path_h) -#define octave_load_path_h 1 - -#include -#include -#include -#include - -#include "pathsearch.h" -#include "str-vec.h" - -class -OCTINTERP_API -load_path -{ -protected: - - load_path (void) - : dir_info_list (), fcn_map (), private_fcn_map (), method_map (), - init_dirs () { } - -public: - - typedef void (*hook_fcn_ptr) (const std::string& dir); - - ~load_path (void) { } - - static void initialize (bool set_initial_path = false) - { - if (instance_ok ()) - instance->do_initialize (set_initial_path); - } - - static void clear (void) - { - if (instance_ok ()) - instance->do_clear (); - } - - static void set (const std::string& p, bool warn = false) - { - if (instance_ok ()) - instance->do_set (p, warn); - } - - static void append (const std::string& dir, bool warn = false) - { - if (instance_ok ()) - instance->do_append (dir, warn); - } - - static void prepend (const std::string& dir, bool warn = false) - { - if (instance_ok ()) - instance->do_prepend (dir, warn); - } - - static bool remove (const std::string& dir) - { - return instance_ok () ? instance->do_remove (dir) : false; - } - - static void update (void) - { - if (instance_ok ()) - instance->do_update (); - } - - static std::string find_method (const std::string& class_name, - const std::string& meth, - std::string& dir_name) - { - return instance_ok () - ? instance->do_find_method (class_name, meth, dir_name) : std::string (); - } - - static std::string find_method (const std::string& class_name, - const std::string& meth) - { - std::string dir_name; - return find_method (class_name, meth, dir_name); - } - - static std::list methods (const std::string& class_name) - { - return instance_ok () - ? instance->do_methods (class_name) : std::list (); - } - - static std::list overloads (const std::string& meth) - { - return instance_ok () - ? instance->do_overloads (meth) : std::list (); - } - - static std::string find_fcn (const std::string& fcn, std::string& dir_name) - { - return instance_ok () - ? instance->do_find_fcn (fcn, dir_name) : std::string (); - } - - static std::string find_fcn (const std::string& fcn) - { - std::string dir_name; - return find_fcn (fcn, dir_name); - } - - static std::string find_private_fcn (const std::string& dir, - const std::string& fcn) - { - return instance_ok () - ? instance->do_find_private_fcn (dir, fcn) : std::string (); - } - - static std::string find_fcn_file (const std::string& fcn) - { - std::string dir_name; - - return instance_ok () ? - instance->do_find_fcn (fcn, dir_name, M_FILE) : std::string (); - } - - static std::string find_oct_file (const std::string& fcn) - { - std::string dir_name; - - return instance_ok () ? - instance->do_find_fcn (fcn, dir_name, OCT_FILE) : std::string (); - } - - static std::string find_mex_file (const std::string& fcn) - { - std::string dir_name; - - return instance_ok () ? - instance->do_find_fcn (fcn, dir_name, MEX_FILE) : std::string (); - } - - static std::string find_file (const std::string& file) - { - return instance_ok () - ? instance->do_find_file (file) : std::string (); - } - - static std::string find_dir (const std::string& dir) - { - return instance_ok () - ? instance->do_find_dir (dir) : std::string (); - } - - static string_vector find_matching_dirs (const std::string& dir) - { - return instance_ok () - ? instance->do_find_matching_dirs (dir) : string_vector (); - } - - static std::string find_first_of (const string_vector& files) - { - return instance_ok () ? - instance->do_find_first_of (files) : std::string (); - } - - static string_vector find_all_first_of (const string_vector& files) - { - return instance_ok () ? - instance->do_find_all_first_of (files) : string_vector (); - } - - static string_vector dirs (void) - { - return instance_ok () ? instance->do_dirs () : string_vector (); - } - - static std::list dir_list (void) - { - return instance_ok () - ? instance->do_dir_list () : std::list (); - } - - static string_vector files (const std::string& dir, bool omit_exts = false) - { - return instance_ok () - ? instance->do_files (dir, omit_exts) : string_vector (); - } - - static string_vector fcn_names (void) - { - return instance_ok () ? instance->do_fcn_names () : string_vector (); - } - - static std::string path (void) - { - return instance_ok () ? instance->do_path () : std::string (); - } - - static void display (std::ostream& os) - { - if (instance_ok ()) - instance->do_display (os); - } - - static void set_add_hook (hook_fcn_ptr f) { add_hook = f; } - - static void set_remove_hook (hook_fcn_ptr f) { remove_hook = f; } - - static void set_command_line_path (const std::string& p) - { - if (command_line_path.empty ()) - command_line_path = p; - else - command_line_path += dir_path::path_sep_str () + p; - } - - static std::string get_command_line_path (void) - { - return instance_ok () ? instance->do_get_command_line_path () : std::string (); - } - - static std::string system_path (void) - { - return instance_ok () ? instance->do_system_path () : std::string (); - } - -private: - - static const int M_FILE = 1; - static const int OCT_FILE = 2; - static const int MEX_FILE = 4; - - class dir_info - { - public: - - // - typedef std::map fcn_file_map_type; - - typedef fcn_file_map_type::const_iterator const_fcn_file_map_iterator; - typedef fcn_file_map_type::iterator fcn_file_map_iterator; - - struct class_info - { - class_info (void) : method_file_map (), private_file_map () { } - - class_info (const class_info& ci) - : method_file_map (ci.method_file_map), - private_file_map (ci.private_file_map) { } - - class_info& operator = (const class_info& ci) - { - if (this != &ci) - { - method_file_map = ci.method_file_map; - private_file_map = ci.private_file_map; - } - return *this; - } - - ~class_info (void) { } - - fcn_file_map_type method_file_map; - fcn_file_map_type private_file_map; - }; - - // - typedef std::map method_file_map_type; - - typedef method_file_map_type::const_iterator const_method_file_map_iterator; - typedef method_file_map_type::iterator method_file_map_iterator; - - // This default constructor is only provided so we can create a - // std::map of dir_info objects. You should not use this - // constructor for any other purpose. - dir_info (void) - : dir_name (), abs_dir_name (), is_relative (false), - dir_mtime (), dir_time_last_checked (), - all_files (), fcn_files (), private_file_map (), method_file_map () - { } - - dir_info (const std::string& d) - : dir_name (d), abs_dir_name (), is_relative (false), - dir_mtime (), dir_time_last_checked (), - all_files (), fcn_files (), private_file_map (), method_file_map () - { - initialize (); - } - - dir_info (const dir_info& di) - : dir_name (di.dir_name), abs_dir_name (di.abs_dir_name), - is_relative (di.is_relative), - dir_mtime (di.dir_mtime), - dir_time_last_checked (di.dir_time_last_checked), - all_files (di.all_files), fcn_files (di.fcn_files), - private_file_map (di.private_file_map), - method_file_map (di.method_file_map) { } - - ~dir_info (void) { } - - dir_info& operator = (const dir_info& di) - { - if (&di != this) - { - dir_name = di.dir_name; - abs_dir_name = di.abs_dir_name; - is_relative = di.is_relative; - dir_mtime = di.dir_mtime; - dir_time_last_checked = di.dir_time_last_checked; - all_files = di.all_files; - fcn_files = di.fcn_files; - private_file_map = di.private_file_map; - method_file_map = di.method_file_map; - } - - return *this; - } - - void update (void); - - std::string dir_name; - std::string abs_dir_name; - bool is_relative; - octave_time dir_mtime; - octave_time dir_time_last_checked; - string_vector all_files; - string_vector fcn_files; - fcn_file_map_type private_file_map; - method_file_map_type method_file_map; - - private: - - void initialize (void); - - void get_file_list (const std::string& d); - - void get_private_file_map (const std::string& d); - - void get_method_file_map (const std::string& d, - const std::string& class_name); - - friend fcn_file_map_type get_fcn_files (const std::string& d); - }; - - class file_info - { - public: - - file_info (const std::string& d, int t) : dir_name (d), types (t) { } - - file_info (const file_info& fi) - : dir_name (fi.dir_name), types (fi.types) { } - - ~file_info (void) { } - - file_info& operator = (const file_info& fi) - { - if (&fi != this) - { - dir_name = fi.dir_name; - types = fi.types; - } - - return *this; - } - - std::string dir_name; - int types; - }; - - // We maintain two ways of looking at the same information. - // - // First, a list of directories and the set of "public" files and - // private files (those found in the special "private" subdirectory) - // in each directory. - // - // Second, a map from file names (the union of all "public" files for all - // directories, but without filename extensions) to a list of - // corresponding information (directory name and file types). This - // way, we can quickly find shadowed file names and look up all - // overloaded functions (in the "@" directories used to implement - // classes). - - typedef std::list dir_info_list_type; - - typedef dir_info_list_type::const_iterator const_dir_info_list_iterator; - typedef dir_info_list_type::iterator dir_info_list_iterator; - - typedef std::map abs_dir_cache_type; - - typedef abs_dir_cache_type::const_iterator const_abs_dir_cache_iterator; - typedef abs_dir_cache_type::iterator abs_dir_cache_iterator; - - typedef std::list file_info_list_type; - - typedef file_info_list_type::const_iterator const_file_info_list_iterator; - typedef file_info_list_type::iterator file_info_list_iterator; - - // - typedef std::map fcn_map_type; - - typedef fcn_map_type::const_iterator const_fcn_map_iterator; - typedef fcn_map_type::iterator fcn_map_iterator; - - // > - typedef std::map private_fcn_map_type; - - typedef private_fcn_map_type::const_iterator const_private_fcn_map_iterator; - typedef private_fcn_map_type::iterator private_fcn_map_iterator; - - // > - typedef std::map method_map_type; - - typedef method_map_type::const_iterator const_method_map_iterator; - typedef method_map_type::iterator method_map_iterator; - - mutable dir_info_list_type dir_info_list; - - mutable fcn_map_type fcn_map; - - mutable private_fcn_map_type private_fcn_map; - - mutable method_map_type method_map; - - mutable std::set init_dirs; - - static load_path *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - static hook_fcn_ptr add_hook; - - static hook_fcn_ptr remove_hook; - - static std::string command_line_path; - - static std::string sys_path; - - static abs_dir_cache_type abs_dir_cache; - - static bool instance_ok (void); - - const_dir_info_list_iterator find_dir_info (const std::string& dir) const; - dir_info_list_iterator find_dir_info (const std::string& dir); - - bool contains (const std::string& dir) const; - - void move_fcn_map (const std::string& dir, - const string_vector& fcn_files, bool at_end); - - void move_method_map (const std::string& dir, bool at_end); - - void move (std::list::iterator i, bool at_end); - - void do_initialize (bool set_initial_path); - - void do_clear (void); - - void do_set (const std::string& p, bool warn, bool is_init = false); - - void do_append (const std::string& dir, bool warn); - - void do_prepend (const std::string& dir, bool warn); - - void do_add (const std::string& dir, bool at_end, bool warn); - - void remove_fcn_map (const std::string& dir, const string_vector& fcn_files); - - void remove_private_fcn_map (const std::string& dir); - - void remove_method_map (const std::string& dir); - - bool do_remove (const std::string& dir); - - void do_update (void) const; - - static bool - check_file_type (std::string& fname, int type, int possible_types, - const std::string& fcn, const char *who); - - std::string do_find_fcn (const std::string& fcn, - std::string& dir_name, - int type = M_FILE | OCT_FILE | MEX_FILE) const; - - std::string do_find_private_fcn (const std::string& dir, - const std::string& fcn, - int type = M_FILE | OCT_FILE | MEX_FILE) const; - - std::string do_find_method (const std::string& class_name, - const std::string& meth, - std::string& dir_name, - int type = M_FILE | OCT_FILE | MEX_FILE) const; - - std::list do_methods (const std::string& class_name) const; - - std::list do_overloads (const std::string& meth) const; - - std::string do_find_file (const std::string& file) const; - - std::string do_find_dir (const std::string& dir) const; - - string_vector do_find_matching_dirs (const std::string& dir) const; - - std::string do_find_first_of (const string_vector& files) const; - - string_vector do_find_all_first_of (const string_vector& files) const; - - string_vector do_dirs (void) const; - - std::list do_dir_list (void) const; - - string_vector do_files (const std::string& dir, bool omit_exts) const; - - string_vector do_fcn_names (void) const; - - std::string do_path (void) const; - - friend void print_types (std::ostream& os, int types); - - friend string_vector get_file_list (const dir_info::fcn_file_map_type& lst); - - friend void - print_fcn_list (std::ostream& os, const dir_info::fcn_file_map_type& lst); - - void do_display (std::ostream& os) const; - - std::string do_system_path (void) const { return sys_path; } - - std::string do_get_command_line_path (void) const { return command_line_path; } - - void add_to_fcn_map (const dir_info& di, bool at_end) const; - - void add_to_private_fcn_map (const dir_info& di) const; - - void add_to_method_map (const dir_info& di, bool at_end) const; - - friend dir_info::fcn_file_map_type get_fcn_files (const std::string& d); -}; - -extern std::string -genpath (const std::string& dir, const string_vector& skip = "private"); - -extern void execute_pkg_add (const std::string& dir); -extern void execute_pkg_del (const std::string& dir); - -#endif diff -r d02b229ce693 -r a132d206a36a src/load-save.cc --- a/src/load-save.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1872 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: John W. Eaton. -// HDF5 support by Steven G. Johnson -// Matlab v5 support by James R. Van Zandt - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include -#include - -#include "strftime.h" - -#include "byte-swap.h" -#include "data-conv.h" -#include "file-ops.h" -#include "file-stat.h" -#include "glob-match.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" -#include "str-vec.h" -#include "oct-locbuf.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "load-path.h" -#include "load-save.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-cell.h" -#include "pager.h" -#include "pt-exp.h" -#include "symtab.h" -#include "sysdep.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "dMatrix.h" - -#include "ls-hdf5.h" -#include "ls-mat-ascii.h" -#include "ls-mat4.h" -#include "ls-mat5.h" -#include "ls-oct-ascii.h" -#include "ls-oct-binary.h" - -// Remove gnulib definitions, if any. -#ifdef close -#undef close -#endif -#ifdef open -#undef open -#endif - -#ifdef HAVE_ZLIB -#include "zfstream.h" -#endif - -// Write octave-workspace file if Octave crashes or is killed by a signal. -static bool Vcrash_dumps_octave_core = true; - -// The maximum amount of memory (in kilobytes) that we will attempt to -// write to the Octave core file. -static double Voctave_core_file_limit = -1.0; - -// The name of the Octave core file. -static std::string Voctave_core_file_name = "octave-workspace"; - -// The default output format. May be one of "binary", "text", -// "mat-binary", or "hdf5". -static std::string Vdefault_save_options = "-text"; - -// The output format for Octave core files. -static std::string Voctave_core_file_options = "-binary"; - -static std::string -default_save_header_format (void) -{ - return - std::string ("# Created by Octave " OCTAVE_VERSION - ", %a %b %d %H:%M:%S %Y %Z <") - + octave_env::get_user_name () - + std::string ("@") - + octave_env::get_host_name () - + std::string (">"); -} - -// The format string for the comment line at the top of text-format -// save files. Passed to strftime. Should begin with `#' and contain -// no newline characters. -static std::string Vsave_header_format_string = default_save_header_format (); - -static void -gripe_file_open (const std::string& fcn, const std::string& file) -{ - if (fcn == "load") - error ("%s: unable to open input file `%s'", fcn.c_str (), file.c_str ()); - else if (fcn == "save") - error ("%s: unable to open output file `%s'", fcn.c_str (), file.c_str ()); - else - error ("%s: unable to open file `%s'", fcn.c_str (), file.c_str ()); -} - -// Install a variable with name NAME and the value VAL in the -// symbol table. If GLOBAL is TRUE, make the variable global. - -static void -install_loaded_variable (const std::string& name, - const octave_value& val, - bool global, const std::string& /*doc*/) -{ - if (global) - { - symbol_table::symbol_record& sr = symbol_table::insert (name); - sr.clear (); - sr.mark_global (); - sr.varref () = val; - } - else - symbol_table::varref (name) = val; -} - -// Return TRUE if NAME matches one of the given globbing PATTERNS. - -static bool -matches_patterns (const string_vector& patterns, int pat_idx, - int num_pat, const std::string& name) -{ - for (int i = pat_idx; i < num_pat; i++) - { - glob_match pattern (patterns[i]); - - if (pattern.match (name)) - return true; - } - - return false; -} - -int -read_binary_file_header (std::istream& is, bool& swap, - oct_mach_info::float_format& flt_fmt, bool quiet) -{ - const int magic_len = 10; - char magic[magic_len+1]; - is.read (magic, magic_len); - magic[magic_len] = '\0'; - - if (strncmp (magic, "Octave-1-L", magic_len) == 0) - swap = oct_mach_info::words_big_endian (); - else if (strncmp (magic, "Octave-1-B", magic_len) == 0) - swap = ! oct_mach_info::words_big_endian (); - else - { - if (! quiet) - error ("load: unable to read read binary file"); - return -1; - } - - char tmp = 0; - is.read (&tmp, 1); - - flt_fmt = mopt_digit_to_float_format (tmp); - - if (flt_fmt == oct_mach_info::flt_fmt_unknown) - { - if (! quiet) - error ("load: unrecognized binary format!"); - - return -1; - } - - return 0; -} - -#ifdef HAVE_ZLIB -static bool -check_gzip_magic (const std::string& fname) -{ - bool retval = false; - std::ifstream file (fname.c_str ()); - OCTAVE_LOCAL_BUFFER (unsigned char, magic, 2); - - if (file.read (reinterpret_cast (magic), 2) && magic[0] == 0x1f && - magic[1] == 0x8b) - retval = true; - - file.close (); - return retval; -} -#endif - -static load_save_format -get_file_format (std::istream& file, const std::string& filename) -{ - load_save_format retval = LS_UNKNOWN; - - oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; - - bool swap = false; - - if (read_binary_file_header (file, swap, flt_fmt, true) == 0) - retval = LS_BINARY; - else - { - file.clear (); - file.seekg (0, std::ios::beg); - - int32_t mopt, nr, nc, imag, len; - - int err = read_mat_file_header (file, swap, mopt, nr, nc, imag, len, 1); - - if (! err) - retval = LS_MAT_BINARY; - else - { - file.clear (); - file.seekg (0, std::ios::beg); - - err = read_mat5_binary_file_header (file, swap, true, filename); - - if (! err) - { - file.clear (); - file.seekg (0, std::ios::beg); - retval = LS_MAT5_BINARY; - } - else - { - file.clear (); - file.seekg (0, std::ios::beg); - - std::string tmp = extract_keyword (file, "name"); - - if (! tmp.empty ()) - retval = LS_ASCII; - } - } - } - - return retval; -} - -static load_save_format -get_file_format (const std::string& fname, const std::string& orig_fname, - bool &use_zlib) -{ - load_save_format retval = LS_UNKNOWN; - -#ifdef HAVE_HDF5 - // check this before we open the file - if (H5Fis_hdf5 (fname.c_str ()) > 0) - return LS_HDF5; -#endif /* HAVE_HDF5 */ - - std::ifstream file (fname.c_str ()); - use_zlib = false; - - if (file) - { - retval = get_file_format (file, orig_fname); - file.close (); - -#ifdef HAVE_ZLIB - if (retval == LS_UNKNOWN && check_gzip_magic (fname)) - { - gzifstream gzfile (fname.c_str ()); - use_zlib = true; - - if (gzfile) - { - retval = get_file_format (gzfile, orig_fname); - gzfile.close (); - } - } -#endif - - if (retval == LS_UNKNOWN) - { - // Try reading the file as numbers only, determining the - // number of rows and columns from the data. We don't - // even bother to check to see if the first item in the - // file is a number, so that get_complete_line() can - // skip any comments that might appear at the top of the - // file. - - retval = LS_MAT_ASCII; - } - } - else - gripe_file_open ("load", orig_fname); - - return retval; -} - -octave_value -do_load (std::istream& stream, const std::string& orig_fname, - load_save_format format, oct_mach_info::float_format flt_fmt, - bool list_only, bool swap, bool verbose, - const string_vector& argv, int argv_idx, int argc, int nargout) -{ - octave_value retval; - - octave_scalar_map retstruct; - - std::ostringstream output_buf; - std::list symbol_names; - - octave_idx_type count = 0; - - for (;;) - { - bool global = false; - octave_value tc; - - std::string name; - std::string doc; - - switch (format.type) - { - case LS_ASCII: - name = read_ascii_data (stream, orig_fname, global, tc, count); - break; - - case LS_BINARY: - name = read_binary_data (stream, swap, flt_fmt, orig_fname, - global, tc, doc); - break; - - case LS_MAT_ASCII: - name = read_mat_ascii_data (stream, orig_fname, tc); - break; - - case LS_MAT_BINARY: - name = read_mat_binary_data (stream, orig_fname, tc); - break; - -#ifdef HAVE_HDF5 - case LS_HDF5: - name = read_hdf5_data (stream, orig_fname, global, tc, doc); - break; -#endif /* HAVE_HDF5 */ - - case LS_MAT5_BINARY: - case LS_MAT7_BINARY: - name = read_mat5_binary_element (stream, orig_fname, swap, - global, tc); - break; - - default: - gripe_unrecognized_data_fmt ("load"); - break; - } - - if (error_state || stream.eof () || name.empty ()) - break; - else if (! error_state && ! name.empty ()) - { - if (tc.is_defined ()) - { - if (format == LS_MAT_ASCII && argv_idx < argc) - warning ("load: loaded ASCII file `%s' -- ignoring extra args", - orig_fname.c_str ()); - - if (format == LS_MAT_ASCII - || argv_idx == argc - || matches_patterns (argv, argv_idx, argc, name)) - { - count++; - if (list_only) - { - if (verbose) - { - if (count == 1) - output_buf - << "type rows cols name\n" - << "==== ==== ==== ====\n"; - - output_buf - << std::setiosflags (std::ios::left) - << std::setw (16) << tc.type_name () . c_str () - << std::setiosflags (std::ios::right) - << std::setw (7) << tc.rows () - << std::setw (7) << tc.columns () - << " " << name << "\n"; - } - else - symbol_names.push_back (name); - } - else - { - if (nargout == 1) - { - if (format == LS_MAT_ASCII) - retval = tc; - else - retstruct.assign (name, tc); - } - else - install_loaded_variable (name, tc, global, doc); - } - } - - // Only attempt to read one item from a headless text file. - - if (format == LS_MAT_ASCII) - break; - } - else - error ("load: unable to load variable `%s'", name.c_str ()); - } - else - { - if (count == 0) - error ("load: are you sure `%s' is an Octave data file?", - orig_fname.c_str ()); - - break; - } - } - - if (list_only && count) - { - if (verbose) - { - std::string msg = output_buf.str (); - - if (nargout > 0) - retval = msg; - else - octave_stdout << msg; - } - else - { - if (nargout > 0) - retval = Cell (string_vector (symbol_names)); - else - { - string_vector names (symbol_names); - - names.list_in_columns (octave_stdout); - - octave_stdout << "\n"; - } - } - } - else if (retstruct.nfields () != 0) - retval = retstruct; - - return retval; -} - -std::string -find_file_to_load (const std::string& name, const std::string& orig_name) -{ - std::string fname = name; - - if (! (octave_env::absolute_pathname (fname) - || octave_env::rooted_relative_pathname (fname))) - { - file_stat fs (fname); - - if (! (fs.exists () && fs.is_reg ())) - { - std::string tmp - = octave_env::make_absolute (load_path::find_file (fname)); - - if (! tmp.empty ()) - { - warning_with_id ("Octave:load-file-in-path", - "load: file found in load path"); - fname = tmp; - } - } - } - - size_t dot_pos = fname.rfind ("."); - size_t sep_pos = fname.find_last_of (file_ops::dir_sep_chars ()); - - if (dot_pos == std::string::npos - || (sep_pos != std::string::npos && dot_pos < sep_pos)) - { - // Either no '.' in name or no '.' appears after last directory - // separator. - - file_stat fs (fname); - - if (! (fs.exists () && fs.is_reg ())) - fname = find_file_to_load (fname + ".mat", orig_name); - } - else - { - file_stat fs (fname); - - if (! (fs.exists () && fs.is_reg ())) - { - fname = ""; - - error ("load: unable to find file %s", orig_name.c_str ()); - } - } - - return fname; -} - - -DEFUN (load, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} load file\n\ -@deftypefnx {Command} {} load options file\n\ -@deftypefnx {Command} {} load options file v1 v2 @dots{}\n\ -@deftypefnx {Command} {S =} load (\"options\", \"file\", \"v1\", \"v2\", @dots{})\n\ -@deftypefnx {Command} {} load file options\n\ -@deftypefnx {Command} {} load file options v1 v2 @dots{}\n\ -@deftypefnx {Command} {S =} load (\"file\", \"options\", \"v1\", \"v2\", @dots{})\n\ -Load the named variables @var{v1}, @var{v2}, @dots{}, from the file\n\ -@var{file}. If no variables are specified then all variables found in the\n\ -file will be loaded. As with @code{save}, the list of variables to extract\n\ -can be full names or use a pattern syntax. The format of the file is\n\ -automatically detected but may be overridden by supplying the appropriate\n\ -option.\n\ -\n\ -If load is invoked using the functional form\n\ -\n\ -@example\n\ -load (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ -@end example\n\ -\n\ -@noindent\n\ -then the @var{options}, @var{file}, and variable name arguments\n\ -(@var{v1}, @dots{}) must be specified as character strings.\n\ -\n\ -If a variable that is not marked as global is loaded from a file when a\n\ -global symbol with the same name already exists, it is loaded in the\n\ -global symbol table. Also, if a variable is marked as global in a file\n\ -and a local symbol exists, the local symbol is moved to the global\n\ -symbol table and given the value from the file.\n\ -\n\ -If invoked with a single output argument, Octave returns data instead\n\ -of inserting variables in the symbol table. If the data file contains\n\ -only numbers (TAB- or space-delimited columns), a matrix of values is\n\ -returned. Otherwise, @code{load} returns a structure with members\n\ - corresponding to the names of the variables in the file.\n\ -\n\ -The @code{load} command can read data stored in Octave's text and\n\ -binary formats, and @sc{matlab}'s binary format. If compiled with zlib\n\ -support, it can also load gzip-compressed files. It will automatically\n\ -detect the type of file and do conversion from different floating point\n\ -formats (currently only IEEE big and little endian, though other formats\n\ -may be added in the future).\n\ -\n\ -Valid options for @code{load} are listed in the following table.\n\ -\n\ -@table @code\n\ -@item -force\n\ -This option is accepted for backward compatibility but is ignored.\n\ -Octave now overwrites variables currently in memory with\n\ -those of the same name found in the file.\n\ -\n\ -@item -ascii\n\ -Force Octave to assume the file contains columns of numbers in text format\n\ -without any header or other information. Data in the file will be loaded\n\ -as a single numeric matrix with the name of the variable derived from the\n\ -name of the file.\n\ -\n\ -@item -binary\n\ -Force Octave to assume the file is in Octave's binary format.\n\ -\n\ -@item -hdf5\n\ -Force Octave to assume the file is in @sc{hdf5} format.\n\ -(@sc{hdf5} is a free, portable binary format developed by the National\n\ -Center for Supercomputing Applications at the University of Illinois.)\n\ -Note that Octave can read @sc{hdf5} files not created by itself, but may\n\ -skip some datasets in formats that it cannot support. This format is\n\ -only available if Octave was built with a link to the @sc{hdf5} libraries.\n\ -\n\ -@item -import\n\ -This option is accepted for backward compatibility but is ignored.\n\ -Octave can now support multi-dimensional HDF data and automatically\n\ -modifies variable names if they are invalid Octave identifiers.\n\ -\n\ -@item -mat\n\ -@itemx -mat-binary\n\ -@itemx -6\n\ -@itemx -v6\n\ -@itemx -7\n\ -@itemx -v7\n\ -Force Octave to assume the file is in @sc{matlab}'s version 6 or 7 binary\n\ -format.\n\ -\n\ -@item -mat4-binary\n\ -@itemx -4\n\ -@itemx -v4\n\ -@itemx -V4\n\ -Force Octave to assume the file is in the binary format written by\n\ -@sc{matlab} version 4.\n\ -\n\ -@item -text\n\ -Force Octave to assume the file is in Octave's text format.\n\ -@end table\n\ -@seealso{save, dlmwrite, csvwrite, fwrite}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("load"); - - if (error_state) - return retval; - - int i = 1; - std::string orig_fname = ""; - - // Function called with Matlab-style ["filename", options] syntax - if (argc > 1 && ! argv[1].empty () && argv[1].at (0) != '-') - { - orig_fname = argv[1]; - i++; - } - - // It isn't necessary to have the default load format stored in a - // user preference variable since we can determine the type of file - // as we are reading. - - load_save_format format = LS_UNKNOWN; - - bool list_only = false; - bool verbose = false; - - //for (i; i < argc; i++) - for (; i < argc; i++) - { - if (argv[i] == "-force" || argv[i] == "-f") - { - // Silently ignore this - // warning ("load: -force ignored"); - } - else if (argv[i] == "-list" || argv[i] == "-l") - { - list_only = true; - } - else if (argv[i] == "-verbose" || argv[i] == "-v") - { - verbose = true; - } - else if (argv[i] == "-ascii" || argv[i] == "-a") - { - format = LS_MAT_ASCII; - } - else if (argv[i] == "-binary" || argv[i] == "-b") - { - format = LS_BINARY; - } - else if (argv[i] == "-mat-binary" || argv[i] == "-mat" || argv[i] == "-m" - || argv[i] == "-6" || argv[i] == "-v6") - { - format = LS_MAT5_BINARY; - } - else if (argv[i] == "-7" || argv[i] == "-v7") - { - format = LS_MAT7_BINARY; - } - else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" - || argv[i] == "-v4" || argv[i] == "-4") - { - format = LS_MAT_BINARY; - } - else if (argv[i] == "-hdf5" || argv[i] == "-h") - { -#ifdef HAVE_HDF5 - format = LS_HDF5; -#else /* ! HAVE_HDF5 */ - error ("load: octave executable was not linked with HDF5 library"); - return retval; -#endif /* ! HAVE_HDF5 */ - } - else if (argv[i] == "-import" || argv[i] == "-i") - { - warning ("load: -import ignored"); - } - else if (argv[i] == "-text" || argv[i] == "-t") - { - format = LS_ASCII; - } - else - break; - } - - if (orig_fname == "") - { - if (i == argc) - { - print_usage (); - return retval; - } - else - orig_fname = argv[i]; - } - else - i--; - - oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; - - bool swap = false; - - if (orig_fname == "-") - { - i++; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - error ("load: cannot read HDF5 format from stdin"); - else -#endif /* HAVE_HDF5 */ - if (format != LS_UNKNOWN) - { - // FIXME -- if we have already seen EOF on a - // previous call, how do we fix up the state of std::cin so - // that we can get additional input? I'm afraid that we - // can't fix this using std::cin only. - - retval = do_load (std::cin, orig_fname, format, flt_fmt, - list_only, swap, verbose, argv, i, argc, - nargout); - } - else - error ("load: must specify file format if reading from stdin"); - } - else - { - std::string fname = file_ops::tilde_expand (orig_fname); - - fname = find_file_to_load (fname, orig_fname); - - if (error_state) - return retval; - - bool use_zlib = false; - - if (format == LS_UNKNOWN) - format = get_file_format (fname, orig_fname, use_zlib); - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - i++; - - hdf5_ifstream hdf5_file (fname.c_str ()); - - if (hdf5_file.file_id >= 0) - { - retval = do_load (hdf5_file, orig_fname, format, - flt_fmt, list_only, swap, verbose, - argv, i, argc, nargout); - - hdf5_file.close (); - } - else - gripe_file_open ("load", orig_fname); - } - else -#endif /* HAVE_HDF5 */ - // don't insert any statements here; the "else" above has to - // go with the "if" below!!!!! - if (format != LS_UNKNOWN) - { - i++; - - // Always open in binary mode and handle various - // line-endings explicitly. - std::ios::openmode mode = std::ios::in | std::ios::binary; - -#ifdef HAVE_ZLIB - if (use_zlib) - { - gzifstream file (fname.c_str (), mode); - - if (file) - { - if (format == LS_BINARY) - { - if (read_binary_file_header (file, swap, flt_fmt) < 0) - { - if (file) file.close (); - return retval; - } - } - else if (format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - { - if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) - { - if (file) file.close (); - return retval; - } - } - - retval = do_load (file, orig_fname, format, - flt_fmt, list_only, swap, verbose, - argv, i, argc, nargout); - - file.close (); - } - else - gripe_file_open ("load", orig_fname); - } - else -#endif - { - std::ifstream file (fname.c_str (), mode); - - if (file) - { - if (format == LS_BINARY) - { - if (read_binary_file_header (file, swap, flt_fmt) < 0) - { - if (file) file.close (); - return retval; - } - } - else if (format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - { - if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) - { - if (file) file.close (); - return retval; - } - } - - retval = do_load (file, orig_fname, format, - flt_fmt, list_only, swap, verbose, - argv, i, argc, nargout); - - file.close (); - } - else - error ("load: unable to open input file `%s'", - orig_fname.c_str ()); - } - } - } - - return retval; -} - -// Return TRUE if PATTERN has any special globbing chars in it. - -static bool -glob_pattern_p (const std::string& pattern) -{ - int open = 0; - - int len = pattern.length (); - - for (int i = 0; i < len; i++) - { - char c = pattern[i]; - - switch (c) - { - case '?': - case '*': - return true; - - case '[': // Only accept an open brace if there is a close - open++; // brace to match it. Bracket expressions must be - continue; // complete, according to Posix.2 - - case ']': - if (open) - return true; - continue; - - case '\\': - if (i == len - 1) - return false; - - default: - continue; - } - } - - return false; -} - -static void -do_save (std::ostream& os, const octave_value& tc, - const std::string& name, const std::string& help, - bool global, load_save_format fmt, bool save_as_floats) -{ - switch (fmt.type) - { - case LS_ASCII: - save_ascii_data (os, tc, name, global, 0); - break; - - case LS_BINARY: - save_binary_data (os, tc, name, help, global, save_as_floats); - break; - - case LS_MAT_ASCII: - if (! save_mat_ascii_data (os, tc, fmt.opts & LS_MAT_ASCII_LONG ? 16 : 8, - fmt.opts & LS_MAT_ASCII_TABS)) - warning ("save: unable to save %s in ASCII format", name.c_str ()); - break; - - case LS_MAT_BINARY: - save_mat_binary_data (os, tc, name); - break; - -#ifdef HAVE_HDF5 - case LS_HDF5: - save_hdf5_data (os, tc, name, help, global, save_as_floats); - break; -#endif /* HAVE_HDF5 */ - - case LS_MAT5_BINARY: - save_mat5_binary_element (os, tc, name, global, false, save_as_floats); - break; - - case LS_MAT7_BINARY: - save_mat5_binary_element (os, tc, name, global, true, save_as_floats); - break; - - default: - gripe_unrecognized_data_fmt ("save"); - break; - } -} - -// Save the info from SR on stream OS in the format specified by FMT. - -void -do_save (std::ostream& os, const symbol_table::symbol_record& sr, - load_save_format fmt, bool save_as_floats) -{ - octave_value val = sr.varval (); - - if (val.is_defined ()) - { - std::string name = sr.name (); - std::string help; - bool global = sr.is_global (); - - do_save (os, val, name, help, global, fmt, save_as_floats); - } -} - -// save fields of a scalar structure STR matching PATTERN on stream OS -// in the format specified by FMT. - -static size_t -save_fields (std::ostream& os, const octave_scalar_map& m, - const std::string& pattern, - load_save_format fmt, bool save_as_floats) -{ - glob_match pat (pattern); - - size_t saved = 0; - - for (octave_scalar_map::const_iterator p = m.begin (); p != m.end (); p++) - { - std::string empty_str; - - if (pat.match (m.key (p))) - { - do_save (os, m.contents (p), m.key (p), empty_str, - 0, fmt, save_as_floats); - - saved++; - } - } - - return saved; -} - -// Save variables with names matching PATTERN on stream OS in the -// format specified by FMT. - -static size_t -save_vars (std::ostream& os, const std::string& pattern, - load_save_format fmt, bool save_as_floats) -{ - std::list vars = symbol_table::glob (pattern); - - size_t saved = 0; - - typedef std::list::const_iterator const_vars_iterator; - - for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) - { - do_save (os, *p, fmt, save_as_floats); - - if (error_state) - break; - - saved++; - } - - return saved; -} - -static string_vector -parse_save_options (const string_vector &argv, - load_save_format &format, bool &append, - bool &save_as_floats, bool &use_zlib) -{ - string_vector retval; - int argc = argv.length (); - - bool do_double = false, do_tabs = false; - - for (int i = 0; i < argc; i++) - { - if (argv[i] == "-append") - { - append = true; - } - else if (argv[i] == "-ascii" || argv[i] == "-a") - { - format = LS_MAT_ASCII; - } - else if (argv[i] == "-double") - { - do_double = true; - } - else if (argv[i] == "-tabs") - { - do_tabs = true; - } - else if (argv[i] == "-text" || argv[i] == "-t") - { - format = LS_ASCII; - } - else if (argv[i] == "-binary" || argv[i] == "-b") - { - format = LS_BINARY; - } - else if (argv[i] == "-hdf5" || argv[i] == "-h") - { -#ifdef HAVE_HDF5 - format = LS_HDF5; -#else /* ! HAVE_HDF5 */ - error ("save: octave executable was not linked with HDF5 library"); -#endif /* ! HAVE_HDF5 */ - } - else if (argv[i] == "-mat-binary" || argv[i] == "-mat" - || argv[i] == "-m" || argv[i] == "-6" || argv[i] == "-v6" - || argv[i] == "-V6") - { - format = LS_MAT5_BINARY; - } -#ifdef HAVE_ZLIB - else if (argv[i] == "-mat7-binary" || argv[i] == "-7" - || argv[i] == "-v7" || argv[i] == "-V7") - { - format = LS_MAT7_BINARY; - } -#endif - else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" - || argv[i] == "-v4" || argv[i] == "-4") - { - format = LS_MAT_BINARY; - } - else if (argv[i] == "-float-binary" || argv[i] == "-f") - { - format = LS_BINARY; - save_as_floats = true; - } - else if (argv[i] == "-float-hdf5") - { -#ifdef HAVE_HDF5 - format = LS_HDF5; - save_as_floats = true; -#else /* ! HAVE_HDF5 */ - error ("save: octave executable was not linked with HDF5 library"); -#endif /* ! HAVE_HDF5 */ - } -#ifdef HAVE_ZLIB - else if (argv[i] == "-zip" || argv[i] == "-z") - { - use_zlib = true; - } -#endif - else - retval.append (argv[i]); - } - - if (do_double) - { - if (format == LS_MAT_ASCII) - format.opts |= LS_MAT_ASCII_LONG; - else - warning ("save: \"-double\" option only has an effect with \"-ascii\""); - } - - if (do_tabs) - { - if (format == LS_MAT_ASCII) - format.opts |= LS_MAT_ASCII_TABS; - else - warning ("save: \"-tabs\" option only has an effect with \"-ascii\""); - } - - return retval; -} - -static string_vector -parse_save_options (const std::string &arg, load_save_format &format, - bool &append, bool &save_as_floats, - bool &use_zlib) -{ - std::istringstream is (arg); - std::string str; - string_vector argv; - - while (! is.eof ()) - { - is >> str; - argv.append (str); - } - - return parse_save_options (argv, format, append, save_as_floats, - use_zlib); -} - -void -write_header (std::ostream& os, load_save_format format) -{ - switch (format.type) - { - case LS_BINARY: - { - os << (oct_mach_info::words_big_endian () - ? "Octave-1-B" : "Octave-1-L"); - - oct_mach_info::float_format flt_fmt = - oct_mach_info::native_float_format (); - - char tmp = static_cast (float_format_to_mopt_digit (flt_fmt)); - - os.write (&tmp, 1); - } - break; - - case LS_MAT5_BINARY: - case LS_MAT7_BINARY: - { - char const * versionmagic; - int16_t number = *(reinterpret_cast("\x00\x01")); - struct tm bdt; - time_t now; - char headertext[128]; - - time (&now); - bdt = *gmtime (&now); - memset (headertext, ' ', 124); - // ISO 8601 format date - nstrftime (headertext, 124, "MATLAB 5.0 MAT-file, written by Octave " - OCTAVE_VERSION ", %Y-%m-%d %T UTC", &bdt, 1, 0); - - // The first pair of bytes give the version of the MAT file - // format. The second pair of bytes form a magic number which - // signals a MAT file. MAT file data are always written in - // native byte order. The order of the bytes in the second - // pair indicates whether the file was written by a big- or - // little-endian machine. However, the version number is - // written in the *opposite* byte order from everything else! - if (number == 1) - versionmagic = "\x01\x00\x4d\x49"; // this machine is big endian - else - versionmagic = "\x00\x01\x49\x4d"; // this machine is little endian - - memcpy (headertext+124, versionmagic, 4); - os.write (headertext, 128); - } - - break; - -#ifdef HAVE_HDF5 - case LS_HDF5: -#endif /* HAVE_HDF5 */ - case LS_ASCII: - { - octave_localtime now; - - std::string comment_string = now.strftime (Vsave_header_format_string); - - if (! comment_string.empty ()) - { -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - hdf5_ofstream& hs = dynamic_cast (os); - H5Gset_comment (hs.file_id, "/", comment_string.c_str ()); - } - else -#endif /* HAVE_HDF5 */ - os << comment_string << "\n"; - } - } - break; - - default: - break; - } -} - -static void -save_vars (const string_vector& argv, int argv_idx, int argc, - std::ostream& os, load_save_format fmt, - bool save_as_floats, bool write_header_info) -{ - if (write_header_info) - write_header (os, fmt); - - if (argv_idx == argc) - { - save_vars (os, "*", fmt, save_as_floats); - } - else if (argv[argv_idx] == "-struct") - { - if (++argv_idx >= argc) - { - error ("save: missing struct name"); - return; - } - - std::string struct_name = argv[argv_idx]; - - if (! symbol_table::is_variable (struct_name)) - { - error ("save: no such variable: `%s'", struct_name.c_str ()); - return; - } - - octave_value struct_var = symbol_table::varref (struct_name); - - if (! struct_var.is_map () || struct_var.numel () != 1) - { - error ("save: `%s' is not a scalar structure", - struct_name.c_str ()); - return; - } - octave_scalar_map struct_var_map = struct_var.scalar_map_value (); - - ++argv_idx; - - if (argv_idx < argc) - { - for (int i = argv_idx; i < argc; i++) - { - if (! save_fields (os, struct_var_map, argv[i], fmt, - save_as_floats)) - { - warning ("save: no such field `%s.%s'", - struct_name.c_str (), argv[i].c_str ()); - } - } - } - else - save_fields (os, struct_var_map, "*", fmt, save_as_floats); - } - else - { - for (int i = argv_idx; i < argc; i++) - { - if (! save_vars (os, argv[i], fmt, save_as_floats)) - warning ("save: no such variable `%s'", argv[i].c_str ()); - } - } -} - -static void -dump_octave_core (std::ostream& os, const char *fname, load_save_format fmt, - bool save_as_floats) -{ - write_header (os, fmt); - - std::list vars - = symbol_table::all_variables (symbol_table::top_scope (), 0); - - double save_mem_size = 0; - - typedef std::list::const_iterator const_vars_iterator; - - for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) - { - octave_value val = p->varval (); - - if (val.is_defined ()) - { - std::string name = p->name (); - std::string help; - bool global = p->is_global (); - - double val_size = val.byte_size () / 1024; - - // FIXME -- maybe we should try to throw out the largest first... - - if (Voctave_core_file_limit < 0 - || save_mem_size + val_size < Voctave_core_file_limit) - { - save_mem_size += val_size; - - do_save (os, val, name, help, global, fmt, save_as_floats); - - if (error_state) - break; - } - } - } - - message (0, "save to `%s' complete", fname); -} - -void -dump_octave_core (void) -{ - if (Vcrash_dumps_octave_core) - { - // FIXME -- should choose better file name? - - const char *fname = Voctave_core_file_name.c_str (); - - message (0, "attempting to save variables to `%s'...", fname); - - load_save_format format = LS_BINARY; - - bool save_as_floats = false; - - bool append = false; - - bool use_zlib = false; - - parse_save_options (Voctave_core_file_options, format, append, - save_as_floats, use_zlib); - - std::ios::openmode mode = std::ios::out; - - // Matlab v7 files are always compressed - if (format == LS_MAT7_BINARY) - use_zlib = false; - - if (format == LS_BINARY -#ifdef HAVE_HDF5 - || format == LS_HDF5 -#endif - || format == LS_MAT_BINARY - || format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - mode |= std::ios::binary; - - mode |= append ? std::ios::ate : std::ios::trunc; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - hdf5_ofstream file (fname, mode); - - if (file.file_id >= 0) - { - dump_octave_core (file, fname, format, save_as_floats); - - file.close (); - } - else - warning ("unable to open `%s' for writing...", fname); - } - else -#endif /* HAVE_HDF5 */ - // don't insert any commands here! The open brace below must - // go with the else above! - { -#ifdef HAVE_ZLIB - if (use_zlib) - { - gzofstream file (fname, mode); - - if (file) - { - dump_octave_core (file, fname, format, save_as_floats); - - file.close (); - } - else - warning ("unable to open `%s' for writing...", fname); - } - else -#endif - { - std::ofstream file (fname, mode); - - if (file) - { - dump_octave_core (file, fname, format, save_as_floats); - - file.close (); - } - else - warning ("unable to open `%s' for writing...", fname); - } - } - } -} - - -DEFUN (save, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} save file\n\ -@deftypefnx {Command} {} save options file\n\ -@deftypefnx {Command} {} save options file @var{v1} @var{v2} @dots{}\n\ -@deftypefnx {Command} {} save options file -struct @var{STRUCT} @var{f1} @var{f2} @dots{}\n\ -Save the named variables @var{v1}, @var{v2}, @dots{}, in the file\n\ -@var{file}. The special filename @samp{-} may be used to write\n\ -output to the terminal. If no variable names are listed, Octave saves\n\ -all the variables in the current scope. Otherwise, full variable names or\n\ -pattern syntax can be used to specify the variables to save.\n\ -If the @option{-struct} modifier is used, fields @var{f1} @var{f2} @dots{}\n\ -of the scalar structure @var{STRUCT} are saved as if they were variables\n\ -with corresponding names.\n\ -Valid options for the @code{save} command are listed in the following table.\n\ -Options that modify the output format override the format specified by\n\ -@code{default_save_options}.\n\ -\n\ -If save is invoked using the functional form\n\ -\n\ -@example\n\ -save (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ -@end example\n\ -\n\ -@noindent\n\ -then the @var{options}, @var{file}, and variable name arguments\n\ -(@var{v1}, @dots{}) must be specified as character strings.\n\ -\n\ -@table @code\n\ -@item -append\n\ -Append to the destination instead of overwriting.\n\ -\n\ -@item -ascii\n\ -Save a single matrix in a text file without header or any other information.\n\ -\n\ -@item -binary\n\ -Save the data in Octave's binary data format.\n\ -\n\ -@item -float-binary\n\ -Save the data in Octave's binary data format but only using single\n\ -precision. Only use this format if you know that all the\n\ -values to be saved can be represented in single precision.\n\ -\n\ -@item -hdf5\n\ -Save the data in @sc{hdf5} format.\n\ -(HDF5 is a free, portable binary format developed by the National\n\ -Center for Supercomputing Applications at the University of Illinois.)\n\ -This format is only available if Octave was built with a link to the\n\ -@sc{hdf5} libraries.\n\ -\n\ -@item -float-hdf5\n\ -Save the data in @sc{hdf5} format but only using single precision.\n\ -Only use this format if you know that all the\n\ -values to be saved can be represented in single precision.\n\ -\n\ -@item -V7\n\ -@itemx -v7\n\ -@itemx -7\n\ -@itemx -mat7-binary\n\ -Save the data in @sc{matlab}'s v7 binary data format.\n\ -\n\ -@item -V6\n\ -@itemx -v6\n\ -@itemx -6\n\ -@itemx -mat\n\ -@itemx -mat-binary\n\ -Save the data in @sc{matlab}'s v6 binary data format.\n\ -\n\ -@item -V4\n\ -@itemx -v4\n\ -@itemx -4\n\ -@itemx -mat4-binary\n\ -Save the data in the binary format written by @sc{matlab} version 4.\n\ -\n\ -@item -text\n\ -Save the data in Octave's text data format. (default).\n\ -\n\ -@item -zip\n\ -@itemx -z\n\ -Use the gzip algorithm to compress the file. This works equally on files\n\ -that are compressed with gzip outside of octave, and gzip can equally be\n\ -used to convert the files for backward compatibility.\n\ -This option is only available if Octave was built with a link to the zlib\n\ -libraries.\n\ -@end table\n\ -\n\ -The list of variables to save may use wildcard patterns containing\n\ -the following special characters:\n\ -\n\ -@table @code\n\ -@item ?\n\ -Match any single character.\n\ -\n\ -@item *\n\ -Match zero or more characters.\n\ -\n\ -@item [ @var{list} ]\n\ -Match the list of characters specified by @var{list}. If the first\n\ -character is @code{!} or @code{^}, match all characters except those\n\ -specified by @var{list}. For example, the pattern @code{[a-zA-Z]} will\n\ -match all lower and uppercase alphabetic characters.\n\ -\n\ -Wildcards may also be used in the field name specifications when using\n\ -the @option{-struct} modifier (but not in the struct name itself).\n\ -\n\ -@end table\n\ -\n\ -Except when using the @sc{matlab} binary data file format or the\n\ -@samp{-ascii} format, saving global\n\ -variables also saves the global status of the variable. If the variable\n\ -is restored at a later time using @samp{load}, it will be restored as a\n\ -global variable.\n\ -\n\ -The command\n\ -\n\ -@example\n\ -save -binary data a b*\n\ -@end example\n\ -\n\ -@noindent\n\ -saves the variable @samp{a} and all variables beginning with @samp{b} to\n\ -the file @file{data} in Octave's binary format.\n\ -@seealso{load, default_save_options, save_header_format_string, dlmread, csvread, fread}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length (); - - string_vector argv = args.make_argv (); - - if (error_state) - return retval; - - // Here is where we would get the default save format if it were - // stored in a user preference variable. - - bool save_as_floats = false; - - load_save_format format = LS_ASCII; - - bool append = false; - - bool use_zlib = false; - - // get default options - parse_save_options (Vdefault_save_options, format, append, save_as_floats, - use_zlib); - - // override from command line - argv = parse_save_options (argv, format, append, save_as_floats, - use_zlib); - argc = argv.length (); - int i = 0; - - if (error_state) - return retval; - - if (i == argc) - { - print_usage (); - return retval; - } - - if (save_as_floats && format == LS_ASCII) - { - error ("save: cannot specify both -ascii and -float-binary"); - return retval; - } - - if (argv[i] == "-") - { - i++; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - error ("save: cannot write HDF5 format to stdout"); - else -#endif /* HAVE_HDF5 */ - // don't insert any commands here! the brace below must go - // with the "else" above! - { - if (append) - warning ("save: ignoring -append option for output to stdout"); - - // FIXME -- should things intended for the screen end up - // in a octave_value (string)? - - save_vars (argv, i, argc, octave_stdout, format, - save_as_floats, true); - } - } - - // Guard against things like `save a*', which are probably mistakes... - - else if (i == argc - 1 && glob_pattern_p (argv[i])) - { - print_usage (); - return retval; - } - else - { - std::string fname = file_ops::tilde_expand (argv[i]); - - i++; - - // Matlab v7 files are always compressed - if (format == LS_MAT7_BINARY) - use_zlib = false; - - std::ios::openmode mode - = append ? (std::ios::app | std::ios::ate) : std::ios::out; - - if (format == LS_BINARY -#ifdef HAVE_HDF5 - || format == LS_HDF5 -#endif - || format == LS_MAT_BINARY - || format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - mode |= std::ios::binary; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - // FIXME. It should be possible to append to HDF5 files. - if (append) - { - error ("save: appending to HDF5 files is not implemented"); - return retval; - } - - bool write_header_info = ! (append && - H5Fis_hdf5 (fname.c_str ()) > 0); - - hdf5_ofstream hdf5_file (fname.c_str (), mode); - - if (hdf5_file.file_id != -1) - { - save_vars (argv, i, argc, hdf5_file, format, - save_as_floats, write_header_info); - - hdf5_file.close (); - } - else - { - gripe_file_open ("save", fname); - return retval; - } - } - else -#endif /* HAVE_HDF5 */ - // don't insert any statements here! The brace below must go - // with the "else" above! - { -#ifdef HAVE_ZLIB - if (use_zlib) - { - gzofstream file (fname.c_str (), mode); - - if (file) - { - bool write_header_info = ! file.tellp (); - - save_vars (argv, i, argc, file, format, - save_as_floats, write_header_info); - - file.close (); - } - else - { - gripe_file_open ("save", fname); - return retval; - } - } - else -#endif - { - std::ofstream file (fname.c_str (), mode); - - if (file) - { - bool write_header_info = ! file.tellp (); - - save_vars (argv, i, argc, file, format, - save_as_floats, write_header_info); - - file.close (); - } - else - { - gripe_file_open ("save", fname); - return retval; - } - } - } - } - - return retval; -} - -DEFUN (crash_dumps_octave_core, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} crash_dumps_octave_core ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} crash_dumps_octave_core (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} crash_dumps_octave_core (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave tries\n\ -to save all current variables to the file \"octave-workspace\" if it\n\ -crashes or receives a hangup, terminate or similar signal.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{octave_core_file_limit, octave_core_file_name, octave_core_file_options}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (crash_dumps_octave_core); -} - -DEFUN (default_save_options, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} default_save_options ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} default_save_options (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} default_save_options (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the default options\n\ -for the @code{save} command, and defines the default format.\n\ -Typical values include @code{\"-ascii\"}, @code{\"-text -zip\"}.\n\ -The default value is @option{-text}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{save}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (default_save_options); -} - -DEFUN (octave_core_file_limit, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} octave_core_file_limit ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_limit (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} octave_core_file_limit (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the maximum amount\n\ -of memory (in kilobytes) of the top-level workspace that Octave will\n\ -attempt to save when writing data to the crash dump file (the name of\n\ -the file is specified by @var{octave_core_file_name}). If\n\ -@var{octave_core_file_options} flags specify a binary format,\n\ -then @var{octave_core_file_limit} will be approximately the maximum\n\ -size of the file. If a text file format is used, then the file could\n\ -be much larger than the limit. The default value is -1 (unlimited)\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (octave_core_file_limit); -} - -DEFUN (octave_core_file_name, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} octave_core_file_name ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_name (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} octave_core_file_name (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the file\n\ -used for saving data from the top-level workspace if Octave aborts.\n\ -The default value is @code{\"octave-workspace\"}\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_name); -} - -DEFUN (octave_core_file_options, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} octave_core_file_options ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_options (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} octave_core_file_options (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the options used for\n\ -saving the workspace data if Octave aborts. The value of\n\ -@code{octave_core_file_options} should follow the same format as the\n\ -options for the @code{save} function. The default value is Octave's binary\n\ -format.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_limit}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_options); -} - -DEFUN (save_header_format_string, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} save_header_format_string ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} save_header_format_string (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} save_header_format_string (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the format\n\ -string used for the comment line written at the beginning of\n\ -text-format data files saved by Octave. The format string is\n\ -passed to @code{strftime} and should begin with the character\n\ -@samp{#} and contain no newline characters. If the value of\n\ -@code{save_header_format_string} is the empty string,\n\ -the header comment is omitted from text-format data files. The\n\ -default value is\n\ -@c Set example in small font to prevent overfull line\n\ -\n\ -@smallexample\n\ -\"# Created by Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ -@end smallexample\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{strftime, save}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (save_header_format_string); -} diff -r d02b229ce693 -r a132d206a36a src/load-save.h --- a/src/load-save.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,90 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_load_save_h) -#define octave_load_save_h 1 - -#include -#include - -class octave_value; - -// FIXME: maybe MAT5 and MAT7 should be options to MAT_BINARY. -// Similarly, save_as_floats may be an option for LS_BINARY, LS_HDF5 etc. -enum load_save_format_type - { - LS_ASCII, - LS_BINARY, - LS_MAT_ASCII, - LS_MAT_BINARY, - LS_MAT5_BINARY, - LS_MAT7_BINARY, -#ifdef HAVE_HDF5 - LS_HDF5, -#endif /* HAVE_HDF5 */ - LS_UNKNOWN - }; - -enum load_save_format_options -{ - // LS_MAT_ASCII options (not exclusive) - LS_MAT_ASCII_LONG = 1, - LS_MAT_ASCII_TABS = 2, - // LS_MAT_BINARY options - LS_MAT_BINARY_V5 = 1, - LS_MAT_BINARY_V7, - // zero means no option. - LS_NO_OPTION = 0 -}; - -class load_save_format -{ -public: - load_save_format (load_save_format_type t, - load_save_format_options o = LS_NO_OPTION) - : type (t), opts (o) { } - operator int (void) const - { return type; } - int type, opts; -}; - -extern void dump_octave_core (void); - -extern int -read_binary_file_header (std::istream& is, bool& swap, - oct_mach_info::float_format& flt_fmt, - bool quiet = false); - -extern octave_value -do_load (std::istream& stream, const std::string& orig_fname, - load_save_format format, oct_mach_info::float_format flt_fmt, - bool list_only, bool swap, bool verbose, - const string_vector& argv, int argv_idx, int argc, int nargout); - -extern void -do_save (std::ostream& os, const symbol_table::symbol_record& sr, - load_save_format fmt, bool save_as_floats); - -extern void -write_header (std::ostream& os, load_save_format format); - -#endif diff -r d02b229ce693 -r a132d206a36a src/ls-oct-ascii.cc --- a/src/ls-oct-ascii.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,432 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Author: John W. Eaton. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include -#include -#include - -#include "byte-swap.h" -#include "data-conv.h" -#include "file-ops.h" -#include "glob-match.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" -#include "str-vec.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "load-save.h" -#include "ls-ascii-helper.h" -#include "ls-oct-ascii.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-cell.h" -#include "pager.h" -#include "pt-exp.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "dMatrix.h" - -// The number of decimal digits to use when writing ascii data. -static int Vsave_precision = 16; - -// Functions for reading ascii data. - -// Extract a KEYWORD and its value from stream IS, returning the -// associated value in a new string. -// -// Input should look something like: -// -// [%#][ \t]*keyword[ \t]*:[ \t]*string-value[ \t]*\n - -std::string -extract_keyword (std::istream& is, const char *keyword, const bool next_only) -{ - std::string retval; - - int ch = is.peek (); - if (next_only && ch != '%' && ch != '#') - return retval; - - char c; - while (is.get (c)) - { - if (c == '%' || c == '#') - { - std::ostringstream buf; - - while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) - ; // Skip whitespace and comment characters. - - if (isalpha (c)) - buf << c; - - while (is.get (c) && isalpha (c)) - buf << c; - - std::string tmp = buf.str (); - bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); - - if (match) - { - std::ostringstream value; - while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) - ; // Skip whitespace and the colon. - - is.putback (c); - retval = read_until_newline (is, false); - break; - } - else if (next_only) - break; - else - skip_until_newline (is, false); - } - } - - int len = retval.length (); - - if (len > 0) - { - while (len) - { - c = retval[len-1]; - - if (c == ' ' || c == '\t') - len--; - else - { - retval.resize (len); - break; - } - } - } - - return retval; -} - -// Extract one value (scalar, matrix, string, etc.) from stream IS and -// place it in TC, returning the name of the variable. If the value -// is tagged as global in the file, return TRUE in GLOBAL. -// -// Each type supplies its own function to load the data, and so this -// function is extensible. -// -// FILENAME is used for error messages. -// -// The data is expected to be in the following format: -// -// The input file must have a header followed by some data. -// -// All lines in the header must begin with a `#' character. -// -// The header must contain a list of keyword and value pairs with the -// keyword and value separated by a colon. -// -// Keywords must appear in the following order: -// -// # name: -// # type: -// # -// -// Where, for the built in types are: -// -// : a valid identifier -// -// : -// | global -// -// : scalar -// | complex scalar -// | matrix -// | complex matrix -// | bool -// | bool matrix -// | string -// | range -// -// : -// | -// -// : # rows: -// : # columns: -// -// : # elements: -// : # length: (once before each string) -// -// For backward compatibility the type "string array" is treated as a -// "string" type. Also "string" can have a single element with no elements -// line such that -// -// : # length: -// -// Formatted ASCII data follows the header. -// -// Example: -// -// # name: foo -// # type: matrix -// # rows: 2 -// # columns: 2 -// 2 4 -// 1 3 -// -// Example: -// -// # name: foo -// # type: string -// # elements: 5 -// # length: 4 -// this -// # length: 2 -// is -// # length: 1 -// a -// # length: 6 -// string -// # length: 5 -// array -// -// FIXME -- this format is fairly rigid, and doesn't allow for -// arbitrary comments. Someone should fix that. It does allow arbitrary -// types however. - -// Ugh. The signature of the compare method is not standard in older -// versions of the GNU libstdc++. Do this instead: - -#define SUBSTRING_COMPARE_EQ(s, pos, n, t) (s.substr (pos, n) == t) - -std::string -read_ascii_data (std::istream& is, const std::string& filename, bool& global, - octave_value& tc, octave_idx_type count) -{ - // Read name for this entry or break on EOF. - - std::string name = extract_keyword (is, "name"); - - if (name.empty ()) - { - if (count == 0) - error ("load: empty name keyword or no data found in file `%s'", - filename.c_str ()); - - return std::string (); - } - - if (! (name == ".nargin." || name == ".nargout." - || name == CELL_ELT_TAG || valid_identifier (name))) - { - error ("load: bogus identifier `%s' found in file `%s'", - name.c_str (), filename.c_str ()); - return std::string (); - } - - // Look for type keyword. - - std::string tag = extract_keyword (is, "type"); - - if (! tag.empty ()) - { - std::string typ; - size_t pos = tag.rfind (' '); - - if (pos != std::string::npos) - { - global = SUBSTRING_COMPARE_EQ (tag, 0, 6, "global"); - - typ = global ? tag.substr (7) : tag; - } - else - typ = tag; - - // Special case for backward compatiablity. A small bit of cruft - if (SUBSTRING_COMPARE_EQ (typ, 0, 12, "string array")) - tc = charMatrix (); - else - tc = octave_value_typeinfo::lookup_type (typ); - - if (! tc.load_ascii (is)) - error ("load: trouble reading ascii file `%s'", filename.c_str ()); - } - else - error ("load: failed to extract keyword specifying value type"); - - if (error_state) - { - error ("load: reading file %s", filename.c_str ()); - return std::string (); - } - - return name; -} - -// 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 empty, the name: line is not -// generated. PRECISION specifies the number of decimal digits to print. -// -// Assumes ranges and strings cannot contain Inf or NaN values. -// -// Returns 1 for success and 0 for failure. - -// FIXME -- should probably write the help string here too. - -bool -save_ascii_data (std::ostream& os, const octave_value& val_arg, - const std::string& name, bool mark_as_global, - int precision) -{ - bool success = true; - - if (! name.empty ()) - os << "# name: " << name << "\n"; - - octave_value val = val_arg; - - if (mark_as_global) - os << "# type: global " << val.type_name () << "\n"; - else - os << "# type: " << val.type_name () << "\n"; - - if (! precision) - precision = Vsave_precision; - - long old_precision = os.precision (); - os.precision (precision); - - success = val.save_ascii (os); - - // Insert an extra pair of newline characters after the data so that - // multiple data elements may be handled separately by gnuplot (see - // the description of the index qualifier for the plot command in the - // gnuplot documentation). - os << "\n\n"; - - os.precision (old_precision); - - return (os && success); -} - -bool -save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, - const std::string& name) -{ - return save_ascii_data (os, t, name, false, 6); -} - -// Maybe this should be a static function in tree-plot.cc? - -// If TC is matrix, save it on stream OS in a format useful for -// making a 3-dimensional plot with gnuplot. If PARAMETRIC is -// TRUE, assume a parametric 3-dimensional plot will be generated. - -bool -save_three_d (std::ostream& os, const octave_value& tc, bool parametric) -{ - bool fail = false; - - octave_idx_type nr = tc.rows (); - octave_idx_type nc = tc.columns (); - - if (tc.is_real_matrix ()) - { - os << "# 3D data...\n" - << "# type: matrix\n" - << "# total rows: " << nr << "\n" - << "# total columns: " << nc << "\n"; - - long old_precision = os.precision (); - os.precision (6); - - if (parametric) - { - octave_idx_type extras = nc % 3; - if (extras) - warning ("ignoring last %d columns", extras); - - Matrix tmp = tc.matrix_value (); - nr = tmp.rows (); - - for (octave_idx_type i = 0; i < nc-extras; i += 3) - { - os << tmp.extract (0, i, nr-1, i+2); - if (i+3 < nc-extras) - os << "\n"; - } - } - else - { - Matrix tmp = tc.matrix_value (); - nr = tmp.rows (); - - for (octave_idx_type i = 0; i < nc; i++) - { - os << tmp.extract (0, i, nr-1, i); - if (i+1 < nc) - os << "\n"; - } - } - - os.precision (old_precision); - } - else - { - ::error ("for now, I can only save real matrices in 3D format"); - fail = true; - } - - return (os && ! fail); -} - -DEFUN (save_precision, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} save_precision ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} save_precision (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} save_precision (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the number of\n\ -digits to keep when saving data in text format.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE_WITH_LIMITS (save_precision, -1, INT_MAX); -} diff -r d02b229ce693 -r a132d206a36a src/ls-oct-ascii.h --- a/src/ls-oct-ascii.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,189 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_ls_oct_ascii_h) -#define octave_ls_oct_ascii_h 1 - -#include - -#include -#include - -#include "str-vec.h" - -#include "ls-ascii-helper.h" - -// Flag for cell elements -#define CELL_ELT_TAG "" - -// Used when converting Inf to something that gnuplot can read. - -#ifndef OCT_RBV -#define OCT_RBV DBL_MAX / 100.0 -#endif - -extern OCTINTERP_API std::string -extract_keyword (std::istream& is, const char *keyword, - const bool next_only = false); - -extern OCTINTERP_API std::string -read_ascii_data (std::istream& is, const std::string& filename, bool& global, - octave_value& tc, octave_idx_type count); - -extern OCTINTERP_API bool -save_ascii_data (std::ostream& os, const octave_value& val_arg, - const std::string& name, bool mark_as_global, int precision); - -extern OCTINTERP_API bool -save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, - const std::string& name); - -extern OCTINTERP_API bool -save_three_d (std::ostream& os, const octave_value& t, - bool parametric = false); - -// Match KEYWORD on stream IS, placing the associated value in VALUE, -// returning TRUE if successful and FALSE otherwise. -// -// Input should look something like: -// -// [%#][ \t]*keyword[ \t]*int-value.*\n - -template -bool -extract_keyword (std::istream& is, const char *keyword, T& value, - const bool next_only = false) -{ - bool status = false; - value = T (); - - char c; - while (is.get (c)) - { - if (c == '%' || c == '#') - { - std::ostringstream buf; - - while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) - ; // Skip whitespace and comment characters. - - if (isalpha (c)) - buf << c; - - while (is.get (c) && isalpha (c)) - buf << c; - - std::string tmp = buf.str (); - bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); - - if (match) - { - while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) - ; // Skip whitespace and the colon. - - is.putback (c); - if (c != '\n' && c != '\r') - is >> value; - if (is) - status = true; - skip_until_newline (is, false); - break; - } - else if (next_only) - break; - } - } - return status; -} - -template -bool -extract_keyword (std::istream& is, const std::string& kw, T& value, - const bool next_only = false) -{ - return extract_keyword (is, kw.c_str (), value, next_only); -} - -// Match one of the elements in KEYWORDS on stream IS, placing the -// matched keyword in KW and the associated value in VALUE, -// returning TRUE if successful and FALSE otherwise. -// -// Input should look something like: -// -// [%#][ \t]*keyword[ \t]*int-value.*\n - -template -bool -extract_keyword (std::istream& is, const string_vector& keywords, - std::string& kw, T& value, const bool next_only = false) -{ - bool status = false; - kw = ""; - value = 0; - - char c; - while (is.get (c)) - { - if (c == '%' || c == '#') - { - std::ostringstream buf; - - while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) - ; // Skip whitespace and comment characters. - - if (isalpha (c)) - buf << c; - - while (is.get (c) && isalpha (c)) - buf << c; - - std::string tmp = buf.str (); - - for (int i = 0; i < keywords.length (); i++) - { - int match = (tmp == keywords[i]); - - if (match) - { - kw = keywords[i]; - - while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) - ; // Skip whitespace and the colon. - - is.putback (c); - if (c != '\n' && c != '\r') - is >> value; - if (is) - status = true; - skip_until_newline (is, false); - return status; - } - } - - if (next_only) - break; - } - } - return status; -} - -#endif diff -r d02b229ce693 -r a132d206a36a src/mappers.cc --- a/src/mappers.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2087 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "lo-ieee.h" -#include "lo-specfun.h" -#include "lo-mappers.h" - -#include "defun.h" -#include "error.h" -#include "variables.h" - -DEFUN (abs, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} abs (@var{z})\n\ -Compute the magnitude of @var{z}, defined as\n\ -@tex\n\ -$|z| = \\sqrt{x^2 + y^2}$.\n\ -@end tex\n\ -@ifnottex\n\ -|@var{z}| = @code{sqrt (x^2 + y^2)}.\n\ -@end ifnottex\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -abs (3 + 4i)\n\ - @result{} 5\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).abs (); - else - print_usage (); - - return retval; -} - -/* -%!assert (abs (1), 1) -%!assert (abs (-3.5), 3.5) -%!assert (abs (3+4i), 5) -%!assert (abs (3-4i), 5) -%!assert (abs ([1.1, 3i; 3+4i, -3-4i]), [1.1, 3; 5, 5]) - -%!assert (abs (single (1)), single (1)) -%!assert (abs (single (-3.5)), single (3.5)) -%!assert (abs (single (3+4i)), single (5)) -%!assert (abs (single (3-4i)), single (5)) -%!assert (abs (single ([1.1, 3i; 3+4i, -3-4i])), single ([1.1, 3; 5, 5])) - -%!error abs () -%!error abs (1, 2) -*/ - -DEFUN (acos, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} acos (@var{x})\n\ -Compute the inverse cosine in radians for each element of @var{x}.\n\ -@seealso{cos, acosd}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).acos (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; -%! v = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! assert (acos (x), v, sqrt (eps)); - -%!test -%! x = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); -%! v = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! assert (acos (x), v, sqrt (eps ("single"))); - -%!error acos () -%!error acos (1, 2) -*/ - -DEFUN (acosh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} acosh (@var{x})\n\ -Compute the inverse hyperbolic cosine for each element of @var{x}.\n\ -@seealso{cosh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).acosh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [1, 0, -1, 0]; -%! v = [0, pi/2*i, pi*i, pi/2*i]; -%! assert (acosh (x), v, sqrt (eps)); - -%!test -%! x = single ([1, 0, -1, 0]); -%! v = single ([0, pi/2*i, pi*i, pi/2*i]); -%! assert (acosh (x), v, sqrt (eps ("single"))); - -%!error acosh () -%!error acosh (1, 2) -*/ - -DEFUN (angle, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} angle (@var{z})\n\ -See arg.\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).arg (); - else - print_usage (); - - return retval; -} - -DEFUN (arg, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} arg (@var{z})\n\ -@deftypefnx {Mapping Function} {} angle (@var{z})\n\ -Compute the argument of @var{z}, defined as,\n\ -@tex\n\ -$\\theta = atan2 (y, x),$\n\ -@end tex\n\ -@ifnottex\n\ -@var{theta} = @code{atan2 (@var{y}, @var{x})},\n\ -@end ifnottex\n\ -in radians.\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -arg (3 + 4i)\n\ - @result{} 0.92730\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).arg (); - else - print_usage (); - - return retval; -} - -/* -%!assert (arg (1), 0) -%!assert (arg (i), pi/2) -%!assert (arg (-1), pi) -%!assert (arg (-i), -pi/2) -%!assert (arg ([1, i; -1, -i]), [0, pi/2; pi, -pi/2]) - -%!assert (arg (single (1)), single (0)) -%!assert (arg (single (i)), single (pi/2)) -%!test -%! if (ismac ()) -%! ## Avoid failing for a MacOS feature -%! assert (arg (single (-1)), single (pi), 2*eps (single (1))); -%! else -%! assert (arg (single (-1)), single (pi)); -%! endif -%!assert (arg (single (-i)), single (-pi/2)) -%!assert (arg (single ([1, i; -1, -i])), single ([0, pi/2; pi, -pi/2]), 2e1*eps ("single")) - -%!error arg () -%!error arg (1, 2) -*/ - -DEFUN (asin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} asin (@var{x})\n\ -Compute the inverse sine in radians for each element of @var{x}.\n\ -@seealso{sin, asind}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).asin (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! x = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; -%! v = [0, pi/6, pi/4, pi/3, pi/2, pi/3, pi/4, pi/6, 0]; -%! assert (all (abs (asin (x) - v) < sqrt (eps))); - -%!error asin () -%!error asin (1, 2) -*/ - -DEFUN (asinh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} asinh (@var{x})\n\ -Compute the inverse hyperbolic sine for each element of @var{x}.\n\ -@seealso{sinh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).asinh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! v = [0, pi/2*i, 0, -pi/2*i]; -%! x = [0, i, 0, -i]; -%! assert (asinh (x), v, sqrt (eps)); - -%!test -%! v = single ([0, pi/2*i, 0, -pi/2*i]); -%! x = single ([0, i, 0, -i]); -%! assert (asinh (x), v, sqrt (eps ("single"))); - -%!error asinh () -%!error asinh (1, 2) -*/ - -DEFUN (atan, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} atan (@var{x})\n\ -Compute the inverse tangent in radians for each element of @var{x}.\n\ -@seealso{tan, atand}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).atan (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; -%! x = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; -%! assert (atan (x), v, sqrt (eps)); - -%!test -%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); -%! x = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); -%! assert (atan (x), v, sqrt (eps ("single"))); - -%!error atan () -%!error atan (1, 2) -*/ - -DEFUN (atanh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} atanh (@var{x})\n\ -Compute the inverse hyperbolic tangent for each element of @var{x}.\n\ -@seealso{tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).atanh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! v = [0, 0]; -%! x = [0, 0]; -%! assert (atanh (x), v, sqrt (eps)); - -%!test -%! v = single ([0, 0]); -%! x = single ([0, 0]); -%! assert (atanh (x), v, sqrt (eps ("single"))); - -%!error atanh () -%!error atanh (1, 2) -*/ - -DEFUN (cbrt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} cbrt (@var{x})\n\ -Compute the real cube root of each element of @var{x}.\n\ -Unlike @code{@var{x}^(1/3)}, the result will be negative if @var{x} is\n\ -negative.\n\ -@seealso{nthroot}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).cbrt (); - else - print_usage (); - - return retval; -} - -/* -%!assert (cbrt (64), 4) -%!assert (cbrt (-125), -5) -%!assert (cbrt (0), 0) -%!assert (cbrt (Inf), Inf) -%!assert (cbrt (-Inf), -Inf) -%!assert (cbrt (NaN), NaN) -%!assert (cbrt (2^300), 2^100) -%!assert (cbrt (125*2^300), 5*2^100) - -%!error cbrt () -%!error cbrt (1, 2) -*/ - -DEFUN (ceil, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} ceil (@var{x})\n\ -Return the smallest integer not less than @var{x}. This is equivalent to\n\ -rounding towards positive infinity. If @var{x} is\n\ -complex, return @code{ceil (real (@var{x})) + ceil (imag (@var{x})) * I}.\n\ -\n\ -@example\n\ -@group\n\ -ceil ([-2.7, 2.7])\n\ - @result{} -2 3\n\ -@end group\n\ -@end example\n\ -@seealso{floor, round, fix}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).ceil (); - else - print_usage (); - - return retval; -} - -/* -## double precision -%!assert (ceil ([2, 1.1, -1.1, -1]), [2, 2, -1, -1]) - -## complex double precison -%!assert (ceil ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 2+2i, -1-i, -1-i]) - -## single precision -%!assert (ceil (single ([2, 1.1, -1.1, -1])), single ([2, 2, -1, -1])) - -## complex single precision -%!assert (ceil (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 2+2i, -1-i, -1-i])) - -%!error ceil () -%!error ceil (1, 2) -*/ - -DEFUN (conj, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} conj (@var{z})\n\ -Return the complex conjugate of @var{z}, defined as\n\ -@tex\n\ -$\\bar{z} = x - iy$.\n\ -@end tex\n\ -@ifnottex\n\ -@code{conj (@var{z})} = @var{x} - @var{i}@var{y}.\n\ -@end ifnottex\n\ -@seealso{real, imag}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).conj (); - else - print_usage (); - - return retval; -} - -/* -%!assert (conj (1), 1) -%!assert (conj (i), -i) -%!assert (conj (1+i), 1-i) -%!assert (conj (1-i), 1+i) -%!assert (conj ([-1, -i; -1+i, -1-i]), [-1, i; -1-i, -1+i]) - -%!assert (conj (single (1)), single (1)) -%!assert (conj (single (i)), single (-i)) -%!assert (conj (single (1+i)), single (1-i)) -%!assert (conj (single (1-i)), single (1+i)) -%!assert (conj (single ([-1, -i; -1+i, -1-i])), single ([-1, i; -1-i, -1+i])) - -%!error conj () -%!error conj (1, 2) -*/ - -DEFUN (cos, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} cos (@var{x})\n\ -Compute the cosine for each element of @var{x} in radians.\n\ -@seealso{acos, cosd, cosh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).cos (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; -%! assert (cos (x), v, sqrt (eps)); - -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); -%! assert (cos (x), v, sqrt (eps ("single"))); - -%!error cos () -%!error cos (1, 2) -*/ - -DEFUN (cosh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} cosh (@var{x})\n\ -Compute the hyperbolic cosine for each element of @var{x}.\n\ -@seealso{acosh, sinh, tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).cosh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; -%! v = [1, 0, -1, 0]; -%! assert (cosh (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); -%! v = single ([1, 0, -1, 0]); -%! assert (cosh (x), v, sqrt (eps ("single"))); - -%!error cosh () -%!error cosh (1, 2) -*/ - -DEFUN (erf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erf (@var{z})\n\ -Compute the error function,\n\ -@tex\n\ -$$\n\ - {\\rm erf} (z) = {2 \\over \\sqrt{\\pi}}\\int_0^z e^{-t^2} dt\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@group\n\ - z\n\ - 2 /\n\ -erf (z) = --------- * | e^(-t^2) dt\n\ - sqrt (pi) /\n\ - t=0\n\ -@end group\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -@seealso{erfc, erfcx, erfinv, erfcinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erf (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (erf (a), erf (real (a))); - -%!test -%! x = [0,.5,1]; -%! v = [0, .520499877813047, .842700792949715]; -%! assert (erf (x), v, 1.e-10); -%! assert (erf (-x), -v, 1.e-10); -%! assert (erfc (x), 1-v, 1.e-10); -%! assert (erfinv (v), x, 1.e-10); - -%!test -%! a = -1i*sqrt (single (-1/(6.4187*6.4187))); -%! assert (erf (a), erf (real (a))); - -%!test -%! x = single ([0,.5,1]); -%! v = single ([0, .520499877813047, .842700792949715]); -%! assert (erf (x), v, 1.e-6); -%! assert (erf (-x), -v, 1.e-6); -%! assert (erfc (x), 1-v, 1.e-6); -%! assert (erfinv (v), x, 1.e-6); - -%!error erf () -%!error erf (1, 2) -*/ - -DEFUN (erfinv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfinv (@var{x})\n\ -Compute the inverse error function, i.e., @var{y} such that\n\ -\n\ -@example\n\ -erf (@var{y}) == @var{x}\n\ -@end example\n\ -@seealso{erf, erfc, erfcx, erfcinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfinv (); - else - print_usage (); - - return retval; -} - -/* -## middle region -%!assert (erf (erfinv ([-0.9 -0.3 0 0.4 0.8])), [-0.9 -0.3 0 0.4 0.8], eps) -%!assert (erf (erfinv (single ([-0.9 -0.3 0 0.4 0.8]))), single ([-0.9 -0.3 0 0.4 0.8]), eps ("single")) -## tail region -%!assert (erf (erfinv ([-0.999 -0.99 0.9999 0.99999])), [-0.999 -0.99 0.9999 0.99999], eps) -%!assert (erf (erfinv (single ([-0.999 -0.99 0.9999 0.99999]))), single ([-0.999 -0.99 0.9999 0.99999]), eps ("single")) -## backward - loss of accuracy -%!assert (erfinv (erf ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) -%!assert (erfinv (erf (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) -## exceptional -%!assert (erfinv ([-1, 1, 1.1, -2.1]), [-Inf, Inf, NaN, NaN]) -%!error erfinv (1+2i) - -%!error erfinv () -%!error erfinv (1, 2) -*/ - -DEFUN (erfcinv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfcinv (@var{x})\n\ -Compute the inverse complementary error function, i.e., @var{y} such that\n\ -\n\ -@example\n\ -erfc (@var{y}) == @var{x}\n\ -@end example\n\ -@seealso{erfc, erf, erfcx, erfinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfcinv (); - else - print_usage (); - - return retval; -} - -/* -## middle region -%!assert (erfc (erfcinv ([1.9 1.3 1 0.6 0.2])), [1.9 1.3 1 0.6 0.2], eps) -%!assert (erfc (erfcinv (single ([1.9 1.3 1 0.6 0.2]))), single ([1.9 1.3 1 0.6 0.2]), eps ("single")) -## tail region -%!assert (erfc (erfcinv ([0.001 0.01 1.9999 1.99999])), [0.001 0.01 1.9999 1.99999], eps) -%!assert (erfc (erfcinv (single ([0.001 0.01 1.9999 1.99999]))), single ([0.001 0.01 1.9999 1.99999]), eps ("single")) -## backward - loss of accuracy -%!assert (erfcinv (erfc ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) -%!assert (erfcinv (erfc (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) -## exceptional -%!assert (erfcinv ([2, 0, -0.1, 2.1]), [-Inf, Inf, NaN, NaN]) -%!error erfcinv (1+2i) - -%!error erfcinv () -%!error erfcinv (1, 2) -*/ - -DEFUN (erfc, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfc (@var{z})\n\ -Compute the complementary error function,\n\ -@tex\n\ -$1 - {\\rm erf} (z)$.\n\ -@end tex\n\ -@ifnottex\n\ -@w{@code{1 - erf (@var{z})}}.\n\ -@end ifnottex\n\ -@seealso{erfcinv, erfcx, erf, erfinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfc (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (erfc (a), erfc (real (a))); - -%!error erfc () -%!error erfc (1, 2) -*/ - -DEFUN (erfcx, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfcx (@var{z})\n\ -Compute the scaled complementary error function,\n\ -@tex\n\ -$$\n\ - e^{z^2} {\\rm erfc} (z) \\equiv e^{z^2} (1 - {\\rm erf} (z))\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -exp (z^2) * erfc (x)\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -@seealso{erfc, erf, erfinv, erfcinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfcx (); - else - print_usage (); - - return retval; -} - -/* -## FIXME: Need a test for erfcx - -%!error erfcx () -%!error erfcx (1, 2) -*/ - -DEFUN (exp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} exp (@var{x})\n\ -Compute\n\ -@tex\n\ -$e^{x}$\n\ -@end tex\n\ -@ifnottex\n\ -@code{e^x}\n\ -@end ifnottex\n\ -for each element of @var{x}. To compute the matrix\n\ -exponential, see @ref{Linear Algebra}.\n\ -@seealso{log}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).exp (); - else - print_usage (); - - return retval; -} - -/* -%!assert (exp ([0, 1, -1, -1000]), [1, e, 1/e, 0], sqrt (eps)) -%!assert (exp (1+i), e * (cos (1) + sin (1) * i), sqrt (eps)) -%!assert (exp (single ([0, 1, -1, -1000])), single ([1, e, 1/e, 0]), sqrt (eps ("single"))) -%!assert (exp (single (1+i)), single (e * (cos (1) + sin (1) * i)), sqrt (eps ("single"))) - -%!assert (exp ([Inf, -Inf, NaN]), [Inf 0 NaN]) -%!assert (exp (single ([Inf, -Inf, NaN])), single ([Inf 0 NaN])) - -%!error exp () -%!error exp (1, 2) -*/ - -DEFUN (expm1, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} expm1 (@var{x})\n\ -Compute\n\ -@tex\n\ -$ e^{x} - 1 $\n\ -@end tex\n\ -@ifnottex\n\ -@code{exp (@var{x}) - 1}\n\ -@end ifnottex\n\ -accurately in the neighborhood of zero.\n\ -@seealso{exp}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).expm1 (); - else - print_usage (); - - return retval; -} - -/* -%!assert (expm1 (2*eps), 2*eps, 1e-29) - -%!assert (expm1 ([Inf, -Inf, NaN]), [Inf -1 NaN]) -%!assert (expm1 (single ([Inf, -Inf, NaN])), single ([Inf -1 NaN])) - -%!error expm1 () -%!error expm1 (1, 2) -*/ - -DEFUN (isfinite, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isfinite (@var{x})\n\ -@deftypefnx {Mapping Function} {} finite (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -finite values and false where they are not.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -finite ([13, Inf, NA, NaN])\n\ - @result{} [ 1, 0, 0, 0 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isinf, isnan, isna}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).finite (); - else - print_usage (); - - return retval; -} - -/* -%!assert (!finite (Inf)) -%!assert (!finite (NaN)) -%!assert (finite (rand (1,10))) - -%!assert (!finite (single (Inf))) -%!assert (!finite (single (NaN))) -%!assert (finite (single (rand (1,10)))) - -%!error finite () -%!error finite (1, 2) -*/ - -DEFUN (fix, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} fix (@var{x})\n\ -Truncate fractional portion of @var{x} and return the integer portion. This\n\ -is equivalent to rounding towards zero. If @var{x} is complex, return\n\ -@code{fix (real (@var{x})) + fix (imag (@var{x})) * I}.\n\ -\n\ -@example\n\ -@group\n\ -fix ([-2.7, 2.7])\n\ - @result{} -2 2\n\ -@end group\n\ -@end example\n\ -@seealso{ceil, floor, round}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).fix (); - else - print_usage (); - - return retval; -} - -/* -%!assert (fix ([1.1, 1, -1.1, -1]), [1, 1, -1, -1]) -%!assert (fix ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i]), [1+i, 1+i, -1-i, -1-i]) -%!assert (fix (single ([1.1, 1, -1.1, -1])), single ([1, 1, -1, -1])) -%!assert (fix (single ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i])), single ([1+i, 1+i, -1-i, -1-i])) - -%!error fix () -%!error fix (1, 2) -*/ - -DEFUN (floor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} floor (@var{x})\n\ -Return the largest integer not greater than @var{x}. This is equivalent to\n\ -rounding towards negative infinity. If @var{x} is\n\ -complex, return @code{floor (real (@var{x})) + floor (imag (@var{x})) * I}.\n\ -\n\ -@example\n\ -@group\n\ -floor ([-2.7, 2.7])\n\ - @result{} -3 2\n\ -@end group\n\ -@end example\n\ -@seealso{ceil, round, fix}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).floor (); - else - print_usage (); - - return retval; -} - -/* -%!assert (floor ([2, 1.1, -1.1, -1]), [2, 1, -2, -1]) -%!assert (floor ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 1+i, -2-2i, -1-i]) -%!assert (floor (single ([2, 1.1, -1.1, -1])), single ([2, 1, -2, -1])) -%!assert (floor (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 1+i, -2-2i, -1-i])) - -%!error floor () -%!error floor (1, 2) -*/ - -DEFUN (gamma, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} gamma (@var{z})\n\ -Compute the Gamma function,\n\ -@tex\n\ -$$\n\ - \\Gamma (z) = \\int_0^\\infty t^{z-1} e^{-t} dt.\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@group\n\ - infinity\n\ - /\n\ -gamma (z) = | t^(z-1) exp (-t) dt.\n\ - /\n\ - t=0\n\ -@end group\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -@seealso{gammainc, lgamma}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).gamma (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (gamma (a), gamma (real (a))); - -%!test -%! x = [.5, 1, 1.5, 2, 3, 4, 5]; -%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; -%! assert (gamma (x), v, sqrt (eps)); - -%!test -%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); -%! assert (gamma (a), gamma (real (a))); - -%!test -%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); -%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); -%! assert (gamma (x), v, sqrt (eps ("single"))); - -%!test -%! x = [-1, 0, 1, Inf]; -%! v = [Inf, Inf, 1, Inf]; -%! assert (gamma (x), v); -%! assert (gamma (single (x)), single (v)); - -%!error gamma () -%!error gamma (1, 2) -*/ - -DEFUN (imag, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} imag (@var{z})\n\ -Return the imaginary part of @var{z} as a real number.\n\ -@seealso{real, conj}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).imag (); - else - print_usage (); - - return retval; -} - -/* -%!assert (imag (1), 0) -%!assert (imag (i), 1) -%!assert (imag (1+i), 1) -%!assert (imag ([i, 1; 1, i]), full (eye (2))) - -%!assert (imag (single (1)), single (0)) -%!assert (imag (single (i)), single (1)) -%!assert (imag (single (1+i)), single (1)) -%!assert (imag (single ([i, 1; 1, i])), full (eye (2,"single"))) - -%!error imag () -%!error imag (1, 2) -*/ - -DEFUNX ("isalnum", Fisalnum, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isalnum (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -letters or digits and false where they are not. This is equivalent to\n\ -(@code{isalpha (@var{s}) | isdigit (@var{s})}).\n\ -@seealso{isalpha, isdigit, ispunct, isspace, iscntrl}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisalnum (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"Z") + 1) = true; -%! result(toascii ("0":"9") + 1) = true; -%! result(toascii ("a":"z") + 1) = true; -%! assert (isalnum (charset), result); - -%!error isalnum () -%!error isalnum (1, 2) -*/ - -DEFUNX ("isalpha", Fisalpha, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isalpha (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -letters and false where they are not. This is equivalent to\n\ -(@code{islower (@var{s}) | isupper (@var{s})}).\n\ -@seealso{isdigit, ispunct, isspace, iscntrl, isalnum, islower, isupper}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisalpha (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"Z") + 1) = true; -%! result(toascii ("a":"z") + 1) = true; -%! assert (isalpha (charset), result); - -%!error isalpha () -%!error isalpha (1, 2) -*/ - -DEFUNX ("isascii", Fisascii, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isascii (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -ASCII characters (in the range 0 to 127 decimal) and false where they are\n\ -not.\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisascii (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = true (1, 128); -%! assert (isascii (charset), result); - -%!error isascii () -%!error isascii (1, 2) -*/ - -DEFUNX ("iscntrl", Fiscntrl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} iscntrl (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -control characters and false where they are not.\n\ -@seealso{ispunct, isspace, isalpha, isdigit}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xiscntrl (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(1:32) = true; -%! result(128) = true; -%! assert (iscntrl (charset), result); - -%!error iscntrl () -%!error iscntrl (1, 2) -*/ - -DEFUNX ("isdigit", Fisdigit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isdigit (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -decimal digits (0-9) and false where they are not.\n\ -@seealso{isxdigit, isalpha, isletter, ispunct, isspace, iscntrl}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisdigit (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("0":"9") + 1) = true; -%! assert (isdigit (charset), result); - -%!error isdigit () -%!error isdigit (1, 2) -*/ - -DEFUN (isinf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isinf (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -are infinite and false where they are not.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -isinf ([13, Inf, NA, NaN])\n\ - @result{} [ 0, 1, 0, 0 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isfinite, isnan, isna}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).isinf (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isinf (Inf)) -%!assert (!isinf (NaN)) -%!assert (!isinf (NA)) -%!assert (isinf (rand (1,10)), false (1,10)) -%!assert (isinf ([NaN -Inf -1 0 1 Inf NA]), [false, true, false, false, false, true, false]) - -%!assert (isinf (single (Inf))) -%!assert (!isinf (single (NaN))) -%!assert (!isinf (single (NA))) -%!assert (isinf (single (rand (1,10))), false (1,10)) -%!assert (isinf (single ([NaN -Inf -1 0 1 Inf NA])), [false, true, false, false, false, true, false]) - -%!error isinf () -%!error isinf (1, 2) -*/ - -DEFUNX ("isgraph", Fisgraph, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isgraph (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -printable characters (but not the space character) and false where they are\n\ -not.\n\ -@seealso{isprint}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisgraph (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(34:127) = true; -%! assert (isgraph (charset), result); - -%!error isgraph () -%!error isgraph (1, 2) -*/ - -DEFUNX ("islower", Fislower, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} islower (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -lowercase letters and false where they are not.\n\ -@seealso{isupper, isalpha, isletter, isalnum}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xislower (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("a":"z") + 1) = true; -%! assert (islower (charset), result); - -%!error islower () -%!error islower (1, 2) -*/ - -DEFUN (isna, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isna (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -NA (missing) values and false where they are not.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -isna ([13, Inf, NA, NaN])\n\ - @result{} [ 0, 0, 1, 0 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isnan, isinf, isfinite}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).isna (); - else - print_usage (); - - return retval; -} - -/* -%!assert (!isna (Inf)) -%!assert (!isna (NaN)) -%!assert (isna (NA)) -%!assert (isna (rand (1,10)), false (1,10)) -%!assert (isna ([NaN -Inf -1 0 1 Inf NA]), [false, false, false, false, false, false, true]) - -%!assert (!isna (single (Inf))) -%!assert (!isna (single (NaN))) -%!assert (isna (single (NA))) -%!assert (isna (single (rand (1,10))), false (1,10)) -%!assert (isna (single ([NaN -Inf -1 0 1 Inf NA])), [false, false, false, false, false, false, true]) - -%!error isna () -%!error isna (1, 2) -*/ - -DEFUN (isnan, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isnan (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -NaN values and false where they are not.\n\ -NA values are also considered NaN values. For example:\n\ -\n\ -@example\n\ -@group\n\ -isnan ([13, Inf, NA, NaN])\n\ - @result{} [ 0, 0, 1, 1 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isna, isinf, isfinite}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).isnan (); - else - print_usage (); - - return retval; -} - -/* -%!assert (!isnan (Inf)) -%!assert (isnan (NaN)) -%!assert (isnan (NA)) -%!assert (isnan (rand (1,10)), false (1,10)) -%!assert (isnan ([NaN -Inf -1 0 1 Inf NA]), [true, false, false, false, false, false, true]) - -%!assert (!isnan (single (Inf))) -%!assert (isnan (single (NaN))) -%!assert (isnan (single (NA))) -%!assert (isnan (single (rand (1,10))), false (1,10)) -%!assert (isnan (single ([NaN -Inf -1 0 1 Inf NA])), [true, false, false, false, false, false, true]) - -%!error isnan () -%!error isnan (1, 2) -*/ - -DEFUNX ("isprint", Fisprint, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isprint (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -printable characters (including the space character) and false where they\n\ -are not.\n\ -@seealso{isgraph}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisprint (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(33:127) = true; -%! assert (isprint (charset), result); - -%!error isprint () -%!error isprint (1, 2) -*/ - -DEFUNX ("ispunct", Fispunct, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} ispunct (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -punctuation characters and false where they are not.\n\ -@seealso{isalpha, isdigit, isspace, iscntrl}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xispunct (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(34:48) = true; -%! result(59:65) = true; -%! result(92:97) = true; -%! result(124:127) = true; -%! assert (ispunct (charset), result); - -%!error ispunct () -%!error ispunct (1, 2) -*/ - -DEFUNX ("isspace", Fisspace, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isspace (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -whitespace characters (space, formfeed, newline, carriage return, tab, and\n\ -vertical tab) and false where they are not.\n\ -@seealso{iscntrl, ispunct, isalpha, isdigit}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisspace (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii (" \f\n\r\t\v") + 1) = true; -%! assert (isspace (charset), result); - -%!error isspace () -%!error isspace (1, 2) -*/ - -DEFUNX ("isupper", Fisupper, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isupper (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -uppercase letters and false where they are not.\n\ -@seealso{islower, isalpha, isletter, isalnum}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisupper (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"Z") + 1) = true; -%! assert (isupper (charset), result); - -%!error isupper () -%!error isupper (1, 2) -*/ - -DEFUNX ("isxdigit", Fisxdigit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isxdigit (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -hexadecimal digits (0-9 and @nospell{a-fA-F}).\n\ -@seealso{isdigit}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisxdigit (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"F") + 1) = true; -%! result(toascii ("0":"9") + 1) = true; -%! result(toascii ("a":"f") + 1) = true; -%! assert (isxdigit (charset), result); - -%!error isxdigit () -%!error isxdigit (1, 2) -*/ - -DEFUN (lgamma, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} lgamma (@var{x})\n\ -@deftypefnx {Mapping Function} {} gammaln (@var{x})\n\ -Return the natural logarithm of the gamma function of @var{x}.\n\ -@seealso{gamma, gammainc}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).lgamma (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (lgamma (a), lgamma (real (a))); - -%!test -%! x = [.5, 1, 1.5, 2, 3, 4, 5]; -%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; -%! assert (lgamma (x), log (v), sqrt (eps)) - -%!test -%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); -%! assert (lgamma (a), lgamma (real (a))); - -%!test -%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); -%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); -%! assert (lgamma (x), log (v), sqrt (eps ("single"))) - -%!test -%! x = [-1, 0, 1, Inf]; -%! v = [Inf, Inf, 0, Inf]; -%! assert (lgamma (x), v); -%! assert (lgamma (single (x)), single (v)); - -%!error lgamma () -%!error lgamma (1,2) -*/ - -DEFUN (log, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log (@var{x})\n\ -Compute the natural logarithm,\n\ -@tex\n\ -$\\ln{(x)},$\n\ -@end tex\n\ -@ifnottex\n\ -@code{ln (@var{x})},\n\ -@end ifnottex\n\ -for each element of @var{x}. To compute the\n\ -matrix logarithm, see @ref{Linear Algebra}.\n\ -@seealso{exp, log1p, log2, log10, logspace}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).log (); - else - print_usage (); - - return retval; -} - -/* -%!assert (log ([1, e, e^2]), [0, 1, 2], sqrt (eps)) -%!assert (log ([-0.5, -1.5, -2.5]), log ([0.5, 1.5, 2.5]) + pi*1i, sqrt (eps)) - -%!assert (log (single ([1, e, e^2])), single ([0, 1, 2]), sqrt (eps ("single"))) -%!assert (log (single ([-0.5, -1.5, -2.5])), single (log ([0.5, 1.5, 2.5]) + pi*1i), 4*eps ("single")) - -%!error log () -%!error log (1, 2) -*/ - -DEFUN (log10, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log10 (@var{x})\n\ -Compute the base-10 logarithm of each element of @var{x}.\n\ -@seealso{log, log2, logspace, exp}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).log10 (); - else - print_usage (); - - return retval; -} - -/* -%!assert (log10 ([0.01, 0.1, 1, 10, 100]), [-2, -1, 0, 1, 2], sqrt (eps)) -%!assert (log10 (single ([0.01, 0.1, 1, 10, 100])), single ([-2, -1, 0, 1, 2]), sqrt (eps ("single"))) - -%!error log10 () -%!error log10 (1, 2) -*/ - -DEFUN (log1p, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log1p (@var{x})\n\ -Compute\n\ -@tex\n\ -$\\ln{(1 + x)}$\n\ -@end tex\n\ -@ifnottex\n\ -@code{log (1 + @var{x})}\n\ -@end ifnottex\n\ -accurately in the neighborhood of zero.\n\ -@seealso{log, exp, expm1}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).log1p (); - else - print_usage (); - - return retval; -} - -/* -%!assert (log1p ([0, 2*eps, -2*eps]), [0, 2*eps, -2*eps], 1e-29) -%!assert (log1p (single ([0, 2*eps, -2*eps])), single ([0, 2*eps, -2*eps]), 1e-29) - -%!error log1p () -%!error log1p (1, 2) -*/ - -DEFUN (real, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} real (@var{z})\n\ -Return the real part of @var{z}.\n\ -@seealso{imag, conj}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).real (); - else - print_usage (); - - return retval; -} - -/* -%!assert (real (1), 1) -%!assert (real (i), 0) -%!assert (real (1+i), 1) -%!assert (real ([1, i; i, 1]), full (eye (2))) - -%!assert (real (single (1)), single (1)) -%!assert (real (single (i)), single (0)) -%!assert (real (single (1+i)), single (1)) -%!assert (real (single ([1, i; i, 1])), full (eye (2,"single"))) - -%!error real () -%!error real (1, 2) -*/ - -DEFUN (round, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} round (@var{x})\n\ -Return the integer nearest to @var{x}. If @var{x} is complex, return\n\ -@code{round (real (@var{x})) + round (imag (@var{x})) * I}. If there\n\ -are two nearest integers, return the one further away from zero.\n\ -\n\ -@example\n\ -@group\n\ -round ([-2.7, 2.7])\n\ - @result{} -3 3\n\ -@end group\n\ -@end example\n\ -@seealso{ceil, floor, fix, roundb}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).round (); - else - print_usage (); - - return retval; -} - -/* -%!assert (round (1), 1) -%!assert (round (1.1), 1) -%!assert (round (5.5), 6) -%!assert (round (i), i) -%!assert (round (2.5+3.5i), 3+4i) -%!assert (round (-2.6), -3) -%!assert (round ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) - -%!assert (round (single (1)), single (1)) -%!assert (round (single (1.1)), single (1)) -%!assert (round (single (5.5)), single (6)) -%!assert (round (single (i)), single (i)) -%!assert (round (single (2.5+3.5i)), single (3+4i)) -%!assert (round (single (-2.6)), single (-3)) -%!assert (round (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) - -%!error round () -%!error round (1, 2) -*/ - -DEFUN (roundb, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} roundb (@var{x})\n\ -Return the integer nearest to @var{x}. If there are two nearest\n\ -integers, return the even one (banker's rounding). If @var{x} is complex,\n\ -return @code{roundb (real (@var{x})) + roundb (imag (@var{x})) * I}.\n\ -@seealso{round}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).roundb (); - else - print_usage (); - - return retval; -} - -/* -%!assert (roundb (1), 1) -%!assert (roundb (1.1), 1) -%!assert (roundb (1.5), 2) -%!assert (roundb (4.5), 4) -%!assert (roundb (i), i) -%!assert (roundb (2.5+3.5i), 2+4i) -%!assert (roundb (-2.6), -3) -%!assert (roundb ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) - -%!assert (roundb (single (1)), single (1)) -%!assert (roundb (single (1.1)), single (1)) -%!assert (roundb (single (1.5)), single (2)) -%!assert (roundb (single (4.5)), single (4)) -%!assert (roundb (single (i)), single (i)) -%!assert (roundb (single (2.5+3.5i)), single (2+4i)) -%!assert (roundb (single (-2.6)), single (-3)) -%!assert (roundb (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) - -%!error roundb () -%!error roundb (1, 2) -*/ - -DEFUN (sign, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sign (@var{x})\n\ -Compute the @dfn{signum} function, which is defined as\n\ -@tex\n\ -$$\n\ -{\\rm sign} (@var{x}) = \\cases{1,&$x>0$;\\cr 0,&$x=0$;\\cr -1,&$x<0$.\\cr}\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@group\n\ - -1, x < 0;\n\ -sign (x) = 0, x = 0;\n\ - 1, x > 0.\n\ -@end group\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -\n\ -For complex arguments, @code{sign} returns @code{x ./ abs (@var{x})}.\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).signum (); - else - print_usage (); - - return retval; -} - -/* -%!assert (sign (-2) , -1) -%!assert (sign (0), 0) -%!assert (sign (3), 1) -%!assert (sign ([1, -pi; e, 0]), [1, -1; 1, 0]) - -%!assert (sign (single (-2)) , single (-1)) -%!assert (sign (single (0)), single (0)) -%!assert (sign (single (3)), single (1)) -%!assert (sign (single ([1, -pi; e, 0])), single ([1, -1; 1, 0])) - -%!error sign () -%!error sign (1, 2) -*/ - -DEFUN (sin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sin (@var{x})\n\ -Compute the sine for each element of @var{x} in radians.\n\ -@seealso{asin, sind, sinh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).sin (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; -%! assert (sin (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single ([0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]); -%! assert (sin (x), v, sqrt (eps ("single"))); - -%!error sin () -%!error sin (1, 2) -*/ - -DEFUN (sinh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sinh (@var{x})\n\ -Compute the hyperbolic sine for each element of @var{x}.\n\ -@seealso{asinh, cosh, tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).sinh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; -%! v = [0, i, 0, -i]; -%! assert (sinh (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); -%! v = single ([0, i, 0, -i]); -%! assert (sinh (x), v, sqrt (eps ("single"))); - -%!error sinh () -%!error sinh (1, 2) -*/ - -DEFUN (sqrt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sqrt (@var{x})\n\ -Compute the square root of each element of @var{x}. If @var{x} is negative,\n\ -a complex result is returned. To compute the matrix square root, see\n\ -@ref{Linear Algebra}.\n\ -@seealso{realsqrt, nthroot}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).sqrt (); - else - print_usage (); - - return retval; -} - -/* -%!assert (sqrt (4), 2) -%!assert (sqrt (-1), i) -%!assert (sqrt (1+i), exp (0.5 * log (1+i)), sqrt (eps)) -%!assert (sqrt ([4, -4; i, 1-i]), [2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))], sqrt (eps)) - -%!assert (sqrt (single (4)), single (2)) -%!assert (sqrt (single (-1)), single (i)) -%!assert (sqrt (single (1+i)), single (exp (0.5 * log (1+i))), sqrt (eps ("single"))) -%!assert (sqrt (single ([4, -4; i, 1-i])), single ([2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))]), sqrt (eps ("single"))) - -%!error sqrt () -%!error sqrt (1, 2) -*/ - -DEFUN (tan, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} tan (@var{z})\n\ -Compute the tangent for each element of @var{x} in radians.\n\ -@seealso{atan, tand, tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).tan (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; -%! assert (tan (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); -%! assert (tan (x), v, sqrt (eps ("single"))); - -%!error tan () -%!error tan (1, 2) -*/ - -DEFUN (tanh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} tanh (@var{x})\n\ -Compute hyperbolic tangent for each element of @var{x}.\n\ -@seealso{atanh, sinh, cosh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).tanh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [0, pi*i]; -%! v = [0, 0]; -%! assert (tanh (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi*i]); -%! v = single ([0, 0]); -%! assert (tanh (x), v, sqrt (eps ("single"))); - -%!error tanh () -%!error tanh (1, 2) -*/ - -DEFUNX ("toascii", Ftoascii, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} toascii (@var{s})\n\ -Return ASCII representation of @var{s} in a matrix. For example:\n\ -\n\ -@example\n\ -@group\n\ -toascii (\"ASCII\")\n\ - @result{} [ 65, 83, 67, 73, 73 ]\n\ -@end group\n\ -\n\ -@end example\n\ -@seealso{char}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xtoascii (); - else - print_usage (); - - return retval; -} - -/* -%!assert (toascii (char (0:127)), 0:127) -%!assert (toascii (" ":"@"), 32:64) -%!assert (toascii ("A":"Z"), 65:90) -%!assert (toascii ("[":"`"), 91:96) -%!assert (toascii ("a":"z"), 97:122) -%!assert (toascii ("{":"~"), 123:126) - -%!error toascii () -%!error toascii (1, 2) -*/ - -DEFUNX ("tolower", Ftolower, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} tolower (@var{s})\n\ -@deftypefnx {Mapping Function} {} lower (@var{s})\n\ -Return a copy of the string or cell string @var{s}, with each uppercase\n\ -character replaced by the corresponding lowercase one; non-alphabetic\n\ -characters are left unchanged. For example:\n\ -\n\ -@example\n\ -@group\n\ -tolower (\"MiXeD cAsE 123\")\n\ - @result{} \"mixed case 123\"\n\ -@end group\n\ -@end example\n\ -@seealso{toupper}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xtolower (); - else - print_usage (); - - return retval; -} - -DEFALIAS (lower, tolower); - -/* -%!assert (tolower ("OCTAVE"), "octave") -%!assert (tolower ("123OCTave!_&"), "123octave!_&") -%!assert (tolower ({"ABC", "DEF", {"GHI", {"JKL"}}}), {"abc", "def", {"ghi", {"jkl"}}}) -%!assert (tolower (["ABC"; "DEF"]), ["abc"; "def"]) -%!assert (tolower ({["ABC"; "DEF"]}), {["abc";"def"]}) -%!assert (tolower (68), "d") -%!assert (tolower ({[68, 68; 68, 68]}), {["dd";"dd"]}) -%!test -%! a(3,3,3,3) = "D"; -%! assert (tolower (a)(3,3,3,3), "d"); - -%!test -%! charset = char (0:127); -%! result = charset; -%! result (toascii ("A":"Z") + 1) = result (toascii ("a":"z") + 1); -%! assert (tolower (charset), result); - -%!error lower () -%!error tolower () -%!error tolower (1, 2) -*/ - -DEFUNX ("toupper", Ftoupper, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} toupper (@var{s})\n\ -@deftypefnx {Mapping Function} {} upper (@var{s})\n\ -Return a copy of the string or cell string @var{s}, with each lowercase\n\ -character replaced by the corresponding uppercase one; non-alphabetic\n\ -characters are left unchanged. For example:\n\ -\n\ -@example\n\ -@group\n\ -toupper (\"MiXeD cAsE 123\")\n\ - @result{} \"MIXED CASE 123\"\n\ -@end group\n\ -@end example\n\ -@seealso{tolower}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xtoupper (); - else - print_usage (); - - return retval; -} - -DEFALIAS (upper, toupper); - -/* -%!assert (toupper ("octave"), "OCTAVE") -%!assert (toupper ("123OCTave!_&"), "123OCTAVE!_&") -%!assert (toupper ({"abc", "def", {"ghi", {"jkl"}}}), {"ABC", "DEF", {"GHI", {"JKL"}}}) -%!assert (toupper (["abc"; "def"]), ["ABC"; "DEF"]) -%!assert (toupper ({["abc"; "def"]}), {["ABC";"DEF"]}) -%!assert (toupper (100), "D") -%!assert (toupper ({[100, 100; 100, 100]}), {["DD";"DD"]}) -%!test -%! a(3,3,3,3) = "d"; -%! assert (toupper (a)(3,3,3,3), "D"); -%!test -%! charset = char (0:127); -%! result = charset; -%! result (toascii ("a":"z") + 1) = result (toascii ("A":"Z") + 1); -%! assert (toupper (charset), result); - -%!error toupper () -%!error upper () -%!error toupper (1, 2) -*/ - -DEFALIAS (gammaln, lgamma); - -DEFALIAS (finite, isfinite); diff -r d02b229ce693 -r a132d206a36a src/mkops --- a/src/mkops Thu Aug 02 12:12:00 2012 +0200 +++ b/src/mkops Fri Aug 03 14:59:40 2012 -0400 @@ -21,7 +21,7 @@ SED=${SED:-'sed'} cat << \EOF -// DO NOT EDIT! Generated automatically by mkbuiltins. +// DO NOT EDIT! Generated automatically by mkops. #ifdef HAVE_CONFIG_H #include "config.h" @@ -32,7 +32,7 @@ EOF for file in "$@"; do - f=`echo $file | $SED 's,^\./,,; s%^OPERATORS/op-%%; s%\.cc%%; s%-%_%g'` + f=`echo $file | $SED 's,^\./,,; s%^operators/op-%%; s%\.cc%%; s%-%_%g'` echo "extern void install_${f}_ops (void);" done @@ -46,7 +46,7 @@ EOF for file in "$@"; do - f=`echo $file | $SED 's,^\./,,; s%^OPERATORS/op-%%; s%\.cc%%; s%-%_%g'` + f=`echo $file | $SED 's,^\./,,; s%^operators/op-%%; s%\.cc%%; s%-%_%g'` echo " install_${f}_ops ();" done diff -r d02b229ce693 -r a132d206a36a src/mxarray.in.h --- a/src/mxarray.in.h Thu Aug 02 12:12:00 2012 +0200 +++ b/src/mxarray.in.h Fri Aug 03 14:59:40 2012 -0400 @@ -1,3 +1,4 @@ +// DO NOT EDIT! Generated automatically from mxarray.in.h by configure /* Copyright (C) 2001-2012 Paul Kienzle diff -r d02b229ce693 -r a132d206a36a src/oct-conf.in.h --- a/src/oct-conf.in.h Thu Aug 02 12:12:00 2012 +0200 +++ b/src/oct-conf.in.h Fri Aug 03 14:59:40 2012 -0400 @@ -1,4 +1,4 @@ -// oct-conf.h.in +// DO NOT EDIT! Generated automatically from oct-conf.in.h by configure /* Copyright (C) 1996-2012 John W. Eaton diff -r d02b229ce693 -r a132d206a36a src/oct-hist.cc --- a/src/oct-hist.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,781 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - -The functions listed below were adapted from similar functions from -GNU Bash, the Bourne Again SHell, copyright (C) 1987, 1989, 1991 Free -Software Foundation, Inc. - - do_history edit_history_readline - do_edit_history edit_history_add_hist - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include - -#include - -#include -#include - -#include "cmd-hist.h" -#include "file-ops.h" -#include "lo-mappers.h" -#include "oct-env.h" -#include "oct-time.h" -#include "str-vec.h" - -#include -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "oct-hist.h" -#include "oct-obj.h" -#include "pager.h" -#include "parse.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// TRUE means input is coming from temporary history file. -bool input_from_tmp_history_file = false; - -static std::string -default_history_file (void) -{ - std::string file; - - std::string env_file = octave_env::getenv ("OCTAVE_HISTFILE"); - - if (! env_file.empty ()) - file = env_file; - - if (file.empty ()) - file = file_ops::concat (octave_env::get_home_directory (), - ".octave_hist"); - - return file; -} - -static int -default_history_size (void) -{ - int size = 1024; - - std::string env_size = octave_env::getenv ("OCTAVE_HISTSIZE"); - - if (! env_size.empty ()) - { - int val; - - if (sscanf (env_size.c_str (), "%d", &val) == 1) - size = val > 0 ? val : 0; - } - - return size; -} - -static std::string -default_history_timestamp_format (void) -{ - return - std::string ("# Octave " OCTAVE_VERSION ", %a %b %d %H:%M:%S %Y %Z <") - + octave_env::get_user_name () - + std::string ("@") - + octave_env::get_host_name () - + std::string (">"); -} - -// The format of the timestamp marker written to the history file when -// Octave exits. -static std::string Vhistory_timestamp_format_string - = default_history_timestamp_format (); - -// Display, save, or load history. Stolen and modified from bash. -// -// Arg of -w FILENAME means write file, arg of -r FILENAME -// means read file, arg of -q means don't number lines. Arg of N -// means only display that many items. - -static void -do_history (int argc, const string_vector& argv) -{ - int numbered_output = 1; - - unwind_protect frame; - - frame.add_fcn (command_history::set_file, command_history::file ()); - - int i; - for (i = 1; i < argc; i++) - { - std::string option = argv[i]; - - if (option == "-r" || option == "-w" || option == "-a" - || option == "-n") - { - if (i < argc - 1) - command_history::set_file (argv[i+1]); - - if (option == "-a") - // Append `new' lines to file. - command_history::append (); - - else if (option == "-w") - // Write entire history. - command_history::write (); - - else if (option == "-r") - // Read entire file. - command_history::read (); - - else if (option == "-n") - // Read `new' history from file. - command_history::read_range (); - - else - panic_impossible (); - - return; - } - else if (argv[i] == "-q") - numbered_output = 0; - else if (argv[i] == "--") - { - i++; - break; - } - else - break; - } - - int limit = -1; - - if (i < argc) - { - if (sscanf (argv[i].c_str (), "%d", &limit) != 1) - { - if (argv[i][0] == '-') - error ("history: unrecognized option `%s'", argv[i].c_str ()); - else - error ("history: bad non-numeric arg `%s'", argv[i].c_str ()); - - return; - } - - if (limit < 0) - limit = -limit; - } - - string_vector hlist = command_history::list (limit, numbered_output); - - int len = hlist.length (); - - for (i = 0; i < len; i++) - octave_stdout << hlist[i] << "\n"; -} - -// Read the edited history lines from STREAM and return them -// one at a time. This can read unlimited length lines. The -// caller should free the storage. - -static char * -edit_history_readline (std::fstream& stream) -{ - char c; - int line_len = 128; - int lindex = 0; - char *line = new char [line_len]; - line[0] = '\0'; - - while (stream.get (c)) - { - if (lindex + 2 >= line_len) - { - char *tmp_line = new char [line_len += 128]; - strcpy (tmp_line, line); - delete [] line; - line = tmp_line; - } - - if (c == '\n') - { - line[lindex++] = '\n'; - line[lindex++] = '\0'; - return line; - } - else - line[lindex++] = c; - } - - if (! lindex) - { - delete [] line; - return 0; - } - - if (lindex + 2 >= line_len) - { - char *tmp_line = new char [lindex+3]; - strcpy (tmp_line, line); - delete [] line; - line = tmp_line; - } - - // Finish with newline if none in file. - - line[lindex++] = '\n'; - line[lindex++] = '\0'; - return line; -} - -// Use `command' to replace the last entry in the history list, which, -// by this time, is `run_history blah...'. The intent is that the -// new command becomes the history entry, and that `fc' should never -// appear in the history list. This way you can do `run_history' to -// your heart's content. - -static void -edit_history_repl_hist (const std::string& command) -{ - if (! command.empty ()) - { - string_vector hlist = command_history::list (); - - int len = hlist.length (); - - if (len > 0) - { - int i = len - 1; - - std::string histent = command_history::get_entry (i); - - if (! histent.empty ()) - { - std::string cmd = command; - - int cmd_len = cmd.length (); - - if (cmd[cmd_len - 1] == '\n') - cmd.resize (cmd_len - 1); - - if (! cmd.empty ()) - command_history::replace_entry (i, cmd); - } - } - } -} - -static void -edit_history_add_hist (const std::string& line) -{ - if (! line.empty ()) - { - std::string tmp = line; - - int len = tmp.length (); - - if (len > 0 && tmp[len-1] == '\n') - tmp.resize (len - 1); - - if (! tmp.empty ()) - command_history::add (tmp); - } -} - -static std::string -mk_tmp_hist_file (int argc, const string_vector& argv, - int insert_curr, const char *warn_for) -{ - std::string retval; - - string_vector hlist = command_history::list (); - - int hist_count = hlist.length (); - - // The current command line is already part of the history list by - // the time we get to this point. Delete it from the list. - - hist_count -= 2; - - if (! insert_curr) - command_history::remove (hist_count); - - hist_count--; - - // If no numbers have been specified, the default is to edit the - // last command in the history list. - - int hist_end = hist_count; - int hist_beg = hist_count; - int reverse = 0; - - // Process options. - - int usage_error = 0; - if (argc == 3) - { - if (sscanf (argv[1].c_str (), "%d", &hist_beg) != 1 - || sscanf (argv[2].c_str (), "%d", &hist_end) != 1) - usage_error = 1; - else - { - hist_beg--; - hist_end--; - } - } - else if (argc == 2) - { - if (sscanf (argv[1].c_str (), "%d", &hist_beg) != 1) - usage_error = 1; - else - { - hist_beg--; - hist_end = hist_beg; - } - } - - if (hist_beg < 0 || hist_end < 0 || hist_beg > hist_count - || hist_end > hist_count) - { - error ("%s: history specification out of range", warn_for); - return retval; - } - - if (usage_error) - { - usage ("%s [first] [last]", warn_for); - return retval; - } - - if (hist_end < hist_beg) - { - int t = hist_end; - hist_end = hist_beg; - hist_beg = t; - reverse = 1; - } - - std::string name = octave_tempnam ("", "oct-"); - - std::fstream file (name.c_str (), std::ios::out); - - if (! file) - { - error ("%s: couldn't open temporary file `%s'", warn_for, - name.c_str ()); - return retval; - } - - if (reverse) - { - for (int i = hist_end; i >= hist_beg; i--) - file << hlist[i] << "\n"; - } - else - { - for (int i = hist_beg; i <= hist_end; i++) - file << hlist[i] << "\n"; - } - - file.close (); - - return name; -} - -static void -unlink_cleanup (const char *file) -{ - gnulib::unlink (file); -} - -static void -do_edit_history (int argc, const string_vector& argv) -{ - std::string name = mk_tmp_hist_file (argc, argv, 0, "edit_history"); - - if (name.empty ()) - return; - - // Call up our favorite editor on the file of commands. - - std::string cmd = VEDITOR; - cmd.append (" \""); - cmd.append (name); - cmd.append ("\""); - - // Ignore interrupts while we are off editing commands. Should we - // maybe avoid using system()? - - volatile octave_interrupt_handler old_interrupt_handler - = octave_ignore_interrupts (); - - system (cmd.c_str ()); - - octave_set_interrupt_handler (old_interrupt_handler); - - // Write the commands to the history file since source_file - // disables command line history while it executes. - - std::fstream file (name.c_str (), std::ios::in); - - char *line; - int first = 1; - while ((line = edit_history_readline (file)) != 0) - { - // Skip blank lines. - - if (line[0] == '\n') - { - delete [] line; - continue; - } - - if (first) - { - first = 0; - edit_history_repl_hist (line); - } - else - edit_history_add_hist (line); - } - - file.close (); - - // Turn on command echo, so the output from this will make better - // sense. - - unwind_protect frame; - - frame.add_fcn (unlink_cleanup, name.c_str ()); - frame.protect_var (Vecho_executing_commands); - frame.protect_var (input_from_tmp_history_file); - - Vecho_executing_commands = ECHO_CMD_LINE; - input_from_tmp_history_file = true; - - source_file (name); -} - -static void -do_run_history (int argc, const string_vector& argv) -{ - std::string name = mk_tmp_hist_file (argc, argv, 1, "run_history"); - - if (name.empty ()) - return; - - // Turn on command echo so the output from this will make better - // sense. - - unwind_protect frame; - - frame.add_fcn (unlink_cleanup, name.c_str ()); - frame.protect_var (Vecho_executing_commands); - frame.protect_var (input_from_tmp_history_file); - - Vecho_executing_commands = ECHO_CMD_LINE; - input_from_tmp_history_file = true; - - source_file (name); -} - -void -initialize_history (bool read_history_file) -{ - command_history::initialize (read_history_file, - default_history_file (), - default_history_size (), - octave_env::getenv ("OCTAVE_HISTCONTROL")); -} - -void -octave_history_write_timestamp (void) -{ - octave_localtime now; - - std::string timestamp = now.strftime (Vhistory_timestamp_format_string); - - if (! timestamp.empty ()) - command_history::add (timestamp); -} - -DEFUN (edit_history, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} edit_history [@var{first}] [@var{last}]\n\ -If invoked with no arguments, @code{edit_history} allows you to edit the\n\ -history list using the editor named by the variable @w{@env{EDITOR}}. The\n\ -commands to be edited are first copied to a temporary file. When you\n\ -exit the editor, Octave executes the commands that remain in the file.\n\ -It is often more convenient to use @code{edit_history} to define functions\n\ -rather than attempting to enter them directly on the command line.\n\ -By default, the block of commands is executed as soon as you exit the\n\ -editor. To avoid executing any commands, simply delete all the lines\n\ -from the buffer before exiting the editor.\n\ -\n\ -The @code{edit_history} command takes two optional arguments specifying\n\ -the history numbers of first and last commands to edit. For example,\n\ -the command\n\ -\n\ -@example\n\ -edit_history 13\n\ -@end example\n\ -\n\ -@noindent\n\ -extracts all the commands from the 13th through the last in the history\n\ -list. The command\n\ -\n\ -@example\n\ -edit_history 13 169\n\ -@end example\n\ -\n\ -@noindent\n\ -only extracts commands 13 through 169. Specifying a larger number for\n\ -the first command than the last command reverses the list of commands\n\ -before placing them in the buffer to be edited. If both arguments are\n\ -omitted, the previous command in the history list is used.\n\ -@seealso{run_history}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("edit_history"); - - if (error_state) - return retval; - - do_edit_history (argc, argv); - - return retval; -} - -DEFUN (history, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} history options\n\ -If invoked with no arguments, @code{history} displays a list of commands\n\ -that you have executed. Valid options are:\n\ -\n\ -@table @code\n\ -@item -w @var{file}\n\ -Write the current history to the file @var{file}. If the name is\n\ -omitted, use the default history file (normally @file{~/.octave_hist}).\n\ -\n\ -@item -r @var{file}\n\ -Read the file @var{file}, appending its contents to the current\n\ -history list. If the name is omitted, use the default history file\n\ -(normally @file{~/.octave_hist}).\n\ -\n\ -@item @var{n}\n\ -Display only the most recent @var{n} lines of history.\n\ -\n\ -@item -q\n\ -Don't number the displayed lines of history. This is useful for cutting\n\ -and pasting commands using the X Window System.\n\ -@end table\n\ -\n\ -For example, to display the five most recent commands that you have\n\ -typed without displaying line numbers, use the command\n\ -@kbd{history -q 5}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("history"); - - if (error_state) - return retval; - - do_history (argc, argv); - - return retval; -} - -DEFUN (run_history, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} run_history [@var{first}] [@var{last}]\n\ -Similar to @code{edit_history}, except that the editor is not invoked,\n\ -and the commands are simply executed as they appear in the history list.\n\ -@seealso{edit_history}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("run_history"); - - if (error_state) - return retval; - - do_run_history (argc, argv); - - return retval; -} - -DEFUN (history_control, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_control ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_control (@var{new_val})\n\ -Query or set the internal variable that specifies how commands are saved\n\ -to the history list. The default value is an empty character string,\n\ -but may be overridden by the environment variable\n\ -@w{@env{OCTAVE_HISTCONTROL}}.\n\ -\n\ -The value of @code{history_control} is a colon-separated list of values\n\ -controlling how commands are saved on the history list. If the list\n\ -of values includes @code{ignorespace}, lines which begin with a space\n\ -character are not saved in the history list. A value of @code{ignoredups}\n\ -causes lines matching the previous history entry to not be saved.\n\ -A value of @code{ignoreboth} is shorthand for @code{ignorespace} and\n\ -@code{ignoredups}. A value of @code{erasedups} causes all previous lines\n\ -matching the current line to be removed from the history list before that\n\ -line is saved. Any value not in the above list is ignored. If\n\ -@code{history_control} is the empty string, all commands are saved on\n\ -the history list, subject to the value of @code{saving_history}.\n\ -@seealso{history_file, history_size, history_timestamp_format_string, saving_history}\n\ -@end deftypefn") -{ - std::string old_history_control = command_history::histcontrol (); - - std::string tmp = old_history_control; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "history_control"); - - if (tmp != old_history_control) - command_history::process_histcontrol (tmp); - - return retval; -} - -DEFUN (history_size, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_size ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_size (@var{new_val})\n\ -Query or set the internal variable that specifies how many entries\n\ -to store in the history file. The default value is @code{1024},\n\ -but may be overridden by the environment variable @w{@env{OCTAVE_HISTSIZE}}.\n\ -@seealso{history_file, history_timestamp_format_string, saving_history}\n\ -@end deftypefn") -{ - int old_history_size = command_history::size (); - - int tmp = old_history_size; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "history_size", -1, INT_MAX); - - if (tmp != old_history_size) - command_history::set_size (tmp); - - return retval; -} - -DEFUN (history_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_file (@var{new_val})\n\ -Query or set the internal variable that specifies the name of the\n\ -file used to store command history. The default value is\n\ -@file{~/.octave_hist}, but may be overridden by the environment\n\ -variable @w{@env{OCTAVE_HISTFILE}}.\n\ -@seealso{history_size, saving_history, history_timestamp_format_string}\n\ -@end deftypefn") -{ - std::string old_history_file = command_history::file (); - - std::string tmp = old_history_file; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "history_file"); - - if (tmp != old_history_file) - command_history::set_file (tmp); - - return retval; -} - -DEFUN (history_timestamp_format_string, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_timestamp_format_string ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_timestamp_format_string (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} history_timestamp_format_string (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the format string\n\ -for the comment line that is written to the history file when Octave\n\ -exits. The format string is passed to @code{strftime}. The default\n\ -value is\n\ -\n\ -@example\n\ -\"# Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ -@end example\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{strftime, history_file, history_size, saving_history}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (history_timestamp_format_string); -} - -DEFUN (saving_history, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} saving_history ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} saving_history (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} saving_history (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether commands entered\n\ -on the command line are saved in the history file.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{history_control, history_file, history_size, history_timestamp_format_string}\n\ -@end deftypefn") -{ - bool old_saving_history = ! command_history::ignoring_entries (); - - bool tmp = old_saving_history; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "saving_history"); - - if (tmp != old_saving_history) - command_history::ignore_entries (! tmp); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/oct-hist.h --- a/src/oct-hist.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_octave_hist_h) -#define octave_octave_hist_h 1 - -#include - -#include "cmd-hist.h" - -extern void initialize_history (bool read_history_file = false); - -// Write timestamp to history file. -extern void octave_history_write_timestamp (void); - -// TRUE means input is coming from temporary history file. -extern bool input_from_tmp_history_file; - -#endif diff -r d02b229ce693 -r a132d206a36a src/oct-parse.yy --- a/src/oct-parse.yy Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4734 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009 David Grundberg -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Parser for Octave. - -// C decarations. - -%{ -#define YYDEBUG 1 - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include - -#include "Cell.h" -#include "Matrix.h" -#include "cmd-edit.h" -#include "cmd-hist.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" - -#include "comment-list.h" -#include "defaults.h" -#include "defun.h" -#include "dirfns.h" -#include "dynamic-ld.h" -#include "error.h" -#include "input.h" -#include "lex.h" -#include "load-path.h" -#include "oct-hist.h" -#include "oct-map.h" -#include "ov-fcn-handle.h" -#include "ov-usr-fcn.h" -#include "ov-null-mat.h" -#include "toplev.h" -#include "pager.h" -#include "parse.h" -#include "parse-private.h" -#include "pt-all.h" -#include "pt-eval.h" -#include "symtab.h" -#include "token.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -#if defined (GNULIB_NAMESPACE) -// Calls to the following functions appear in the generated output from -// Bison without the namespace tag. Redefine them so we will use them -// via the gnulib namespace. -#define fclose GNULIB_NAMESPACE::fclose -#define fprintf GNULIB_NAMESPACE::fprintf -#define malloc GNULIB_NAMESPACE::malloc -#endif - -// The current input line number. -int input_line_number = 1; - -// The column of the current token. -int current_input_column = 1; - -// Buffer for help text snagged from function files. -std::stack help_buf; - -// Buffer for comments appearing before a function statement. -static std::string fcn_comment_header; - -// TRUE means we are using readline. -// (--no-line-editing) -bool line_editing = true; - -// TRUE means we printed messages about reading startup files. -bool reading_startup_message_printed = false; - -// TRUE means input is coming from startup file. -bool input_from_startup_file = false; - -// = 0 currently outside any function. -// = 1 inside the primary function or a subfunction. -// > 1 means we are looking at a function definition that seems to be -// inside a function. Note that the function still might not be a -// nested function. -static int current_function_depth = 0; - -// A stack holding the nested function scopes being parsed. -// We don't use std::stack, because we want the clear method. Also, we -// must access one from the top -static std::vector function_scopes; - -// Maximum function depth detected. Just here to determine whether -// we have nested functions or just implicitly ended subfunctions. -static int max_function_depth = 0; - -// FALSE if we are still at the primary function. Subfunctions can -// only be declared inside function files. -static int parsing_subfunctions = false; - -// Have we found an explicit end to a function? -static bool endfunction_found = false; - -// Keep track of symbol table information when parsing functions. -symtab_context parser_symtab_context; - -// Name of the current class when we are parsing class methods or -// constructors. -std::string current_class_name; - -// TRUE means we are in the process of autoloading a function. -static bool autoloading = false; - -// TRUE means the current function file was found in a relative path -// element. -static bool fcn_file_from_relative_lookup = false; - -// Pointer to the primary user function or user script function. -static octave_function *primary_fcn_ptr = 0; - -// Scope where we install all subfunctions and nested functions. Only -// used while reading function files. -static symbol_table::scope_id primary_fcn_scope; - -// List of autoloads (function -> file mapping). -static std::map autoload_map; - -// Forward declarations for some functions defined at the bottom of -// the file. - -// Generic error messages. -static void -yyerror (const char *s); - -// Error mesages for mismatched end tokens. -static void -end_error (const char *type, token::end_tok_type ettype, int l, int c); - -// Check to see that end tokens are properly matched. -static bool -end_token_ok (token *tok, token::end_tok_type expected); - -// Maybe print a warning if an assignment expression is used as the -// test in a logical expression. -static void -maybe_warn_assign_as_truth_value (tree_expression *expr); - -// Maybe print a warning about switch labels that aren't constants. -static void -maybe_warn_variable_switch_label (tree_expression *expr); - -// Finish building a range. -static tree_expression * -finish_colon_expression (tree_colon_expression *e); - -// Build a constant. -static tree_constant * -make_constant (int op, token *tok_val); - -// Build a function handle. -static tree_fcn_handle * -make_fcn_handle (token *tok_val); - -// Build an anonymous function handle. -static tree_anon_fcn_handle * -make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt); - -// Build a binary expression. -static tree_expression * -make_binary_op (int op, tree_expression *op1, token *tok_val, - tree_expression *op2); - -// Build a boolean expression. -static tree_expression * -make_boolean_op (int op, tree_expression *op1, token *tok_val, - tree_expression *op2); - -// Build a prefix expression. -static tree_expression * -make_prefix_op (int op, tree_expression *op1, token *tok_val); - -// Build a postfix expression. -static tree_expression * -make_postfix_op (int op, tree_expression *op1, token *tok_val); - -// Build an unwind-protect command. -static tree_command * -make_unwind_command (token *unwind_tok, tree_statement_list *body, - tree_statement_list *cleanup, token *end_tok, - octave_comment_list *lc, octave_comment_list *mc); - -// Build a try-catch command. -static tree_command * -make_try_command (token *try_tok, tree_statement_list *body, - tree_statement_list *cleanup, token *end_tok, - octave_comment_list *lc, octave_comment_list *mc); - -// Build a while command. -static tree_command * -make_while_command (token *while_tok, tree_expression *expr, - tree_statement_list *body, token *end_tok, - octave_comment_list *lc); - -// Build a do-until command. -static tree_command * -make_do_until_command (token *until_tok, tree_statement_list *body, - tree_expression *expr, octave_comment_list *lc); - -// Build a for command. -static tree_command * -make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, - tree_expression *expr, tree_expression *maxproc, - tree_statement_list *body, token *end_tok, - octave_comment_list *lc); - -// Build a break command. -static tree_command * -make_break_command (token *break_tok); - -// Build a continue command. -static tree_command * -make_continue_command (token *continue_tok); - -// Build a return command. -static tree_command * -make_return_command (token *return_tok); - -// Start an if command. -static tree_if_command_list * -start_if_command (tree_expression *expr, tree_statement_list *list); - -// Finish an if command. -static tree_if_command * -finish_if_command (token *if_tok, tree_if_command_list *list, - token *end_tok, octave_comment_list *lc); - -// Build an elseif clause. -static tree_if_clause * -make_elseif_clause (token *elseif_tok, tree_expression *expr, - tree_statement_list *list, octave_comment_list *lc); - -// Finish a switch command. -static tree_switch_command * -finish_switch_command (token *switch_tok, tree_expression *expr, - tree_switch_case_list *list, token *end_tok, - octave_comment_list *lc); - -// Build a switch case. -static tree_switch_case * -make_switch_case (token *case_tok, tree_expression *expr, - tree_statement_list *list, octave_comment_list *lc); - -// Build an assignment to a variable. -static tree_expression * -make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, - tree_expression *rhs); - -// Define a script. -static void -make_script (tree_statement_list *cmds, tree_statement *end_script); - -// Begin defining a function. -static octave_user_function * -start_function (tree_parameter_list *param_list, tree_statement_list *body, - tree_statement *end_function); - -// Create a no-op statement for end_function. -static tree_statement * -make_end (const std::string& type, int l, int c); - -// Do most of the work for defining a function. -static octave_user_function * -frob_function (const std::string& fname, octave_user_function *fcn); - -// Finish defining a function. -static tree_function_def * -finish_function (tree_parameter_list *ret_list, - octave_user_function *fcn, octave_comment_list *lc); - -// Reset state after parsing function. -static void -recover_from_parsing_function (void); - -// Make an index expression. -static tree_index_expression * -make_index_expression (tree_expression *expr, - tree_argument_list *args, char type); - -// Make an indirect reference expression. -static tree_index_expression * -make_indirect_ref (tree_expression *expr, const std::string&); - -// Make an indirect reference expression with dynamic field name. -static tree_index_expression * -make_indirect_ref (tree_expression *expr, tree_expression *field); - -// Make a declaration command. -static tree_decl_command * -make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst); - -// Validate argument list forming a matrix or cell row. -static tree_argument_list * -validate_matrix_row (tree_argument_list *row); - -// Finish building a matrix list. -static tree_expression * -finish_matrix (tree_matrix *m); - -// Finish building a cell list. -static tree_expression * -finish_cell (tree_cell *c); - -// Maybe print a warning. Duh. -static void -maybe_warn_missing_semi (tree_statement_list *); - -// Set the print flag for a statement based on the separator type. -static tree_statement_list * -set_stmt_print_flag (tree_statement_list *, char, bool); - -// Create a statement list. -static tree_statement_list *make_statement_list (tree_statement *stmt); - -// Append a statement to an existing statement list. -static tree_statement_list * -append_statement_list (tree_statement_list *list, char sep, - tree_statement *stmt, bool warn_missing_semi); - -// Finish building a statement. -template -static tree_statement * -make_statement (T *arg) -{ - octave_comment_list *comment = octave_comment_buffer::get_comment (); - - return new tree_statement (arg, comment); -} - -#define ABORT_PARSE \ - do \ - { \ - global_command = 0; \ - yyerrok; \ - if (! parser_symtab_context.empty ()) \ - parser_symtab_context.pop (); \ - if ((interactive || forced_interactive) \ - && ! get_input_from_eval_string) \ - YYACCEPT; \ - else \ - YYABORT; \ - } \ - while (0) - -%} - -// Bison declarations. - -// Don't add spaces around the = here; it causes some versions of -// bison to fail to properly recognize the directive. - -%name-prefix="octave_" - -%union -{ - // The type of the basic tokens returned by the lexer. - token *tok_val; - - // Comment strings that we need to deal with mid-rule. - octave_comment_list *comment_type; - - // Types for the nonterminals we generate. - char sep_type; - tree *tree_type; - tree_matrix *tree_matrix_type; - tree_cell *tree_cell_type; - tree_expression *tree_expression_type; - tree_constant *tree_constant_type; - tree_fcn_handle *tree_fcn_handle_type; - tree_anon_fcn_handle *tree_anon_fcn_handle_type; - tree_identifier *tree_identifier_type; - tree_index_expression *tree_index_expression_type; - tree_colon_expression *tree_colon_expression_type; - tree_argument_list *tree_argument_list_type; - tree_parameter_list *tree_parameter_list_type; - tree_command *tree_command_type; - tree_if_command *tree_if_command_type; - tree_if_clause *tree_if_clause_type; - tree_if_command_list *tree_if_command_list_type; - tree_switch_command *tree_switch_command_type; - tree_switch_case *tree_switch_case_type; - tree_switch_case_list *tree_switch_case_list_type; - tree_decl_elt *tree_decl_elt_type; - tree_decl_init_list *tree_decl_init_list_type; - tree_decl_command *tree_decl_command_type; - tree_statement *tree_statement_type; - tree_statement_list *tree_statement_list_type; - octave_user_function *octave_user_function_type; - void *dummy_type; -} - -// Tokens with line and column information. -%token '=' ':' '-' '+' '*' '/' -%token ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ -%token EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ AND_EQ OR_EQ -%token LSHIFT_EQ RSHIFT_EQ LSHIFT RSHIFT -%token EXPR_AND_AND EXPR_OR_OR -%token EXPR_AND EXPR_OR EXPR_NOT -%token EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT -%token LEFTDIV EMUL EDIV ELEFTDIV EPLUS EMINUS -%token QUOTE TRANSPOSE -%token PLUS_PLUS MINUS_MINUS POW EPOW -%token NUM IMAG_NUM -%token STRUCT_ELT -%token NAME -%token END -%token DQ_STRING SQ_STRING -%token FOR PARFOR WHILE DO UNTIL -%token IF ELSEIF ELSE -%token SWITCH CASE OTHERWISE -%token BREAK CONTINUE FUNC_RET -%token UNWIND CLEANUP -%token TRY CATCH -%token GLOBAL PERSISTENT -%token FCN_HANDLE -%token PROPERTIES METHODS EVENTS ENUMERATION -%token METAQUERY -%token SUPERCLASSREF -%token GET SET - -// Other tokens. -%token END_OF_INPUT LEXICAL_ERROR -%token FCN SCRIPT_FILE FUNCTION_FILE CLASSDEF -// %token VARARGIN VARARGOUT -%token CLOSE_BRACE - -// Nonterminals we construct. -%type stash_comment function_beg classdef_beg -%type properties_beg methods_beg events_beg enum_beg -%type sep_no_nl opt_sep_no_nl sep opt_sep opt_comma -%type input -%type string constant magic_colon -%type anon_fcn_handle -%type fcn_handle -%type matrix_rows matrix_rows1 -%type cell_rows cell_rows1 -%type matrix cell -%type primary_expr oper_expr -%type simple_expr colon_expr assign_expr expression -%type identifier fcn_name magic_tilde -%type superclass_identifier meta_identifier -%type function1 function2 classdef1 -%type word_list_cmd -%type colon_expr1 -%type arg_list word_list assign_lhs -%type cell_or_matrix_row -%type param_list param_list1 param_list2 -%type return_list return_list1 -%type superclasses opt_superclasses -%type command select_command loop_command -%type jump_command except_command function -%type script_file classdef -%type function_file function_list -%type if_command -%type elseif_clause else_clause -%type if_cmd_list1 if_cmd_list -%type switch_command -%type switch_case default_case -%type case_list1 case_list -%type decl2 -%type decl1 -%type declaration -%type statement function_end classdef_end -%type simple_list simple_list1 list list1 -%type opt_list input1 -// These types need to be specified. -%type attr -%type class_event -%type class_enum -%type class_property -%type properties_list -%type properties_block -%type methods_list -%type methods_block -%type opt_attr_list -%type attr_list -%type events_list -%type events_block -%type enum_list -%type enum_block -%type class_body - -// Precedence and associativity. -%right '=' ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ OR_EQ AND_EQ LSHIFT_EQ RSHIFT_EQ -%left EXPR_OR_OR -%left EXPR_AND_AND -%left EXPR_OR -%left EXPR_AND -%left EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT -%left LSHIFT RSHIFT -%left ':' -%left '-' '+' EPLUS EMINUS -%left '*' '/' LEFTDIV EMUL EDIV ELEFTDIV -%right UNARY EXPR_NOT -%left POW EPOW QUOTE TRANSPOSE -%right PLUS_PLUS MINUS_MINUS -%left '(' '.' '{' - -// Where to start. -%start input - -%% - -// ============================== -// Statements and statement lists -// ============================== - -input : input1 - { - global_command = $1; - promptflag = 1; - YYACCEPT; - } - | function_file - { YYACCEPT; } - | simple_list parse_error - { ABORT_PARSE; } - | parse_error - { ABORT_PARSE; } - ; - -input1 : '\n' - { $$ = 0; } - | END_OF_INPUT - { - parser_end_of_input = 1; - $$ = 0; - } - | simple_list - { $$ = $1; } - | simple_list '\n' - { $$ = $1; } - | simple_list END_OF_INPUT - { $$ = $1; } - ; - -simple_list : simple_list1 opt_sep_no_nl - { $$ = set_stmt_print_flag ($1, $2, false); } - ; - -simple_list1 : statement - { $$ = make_statement_list ($1); } - | simple_list1 sep_no_nl statement - { $$ = append_statement_list ($1, $2, $3, false); } - ; - -opt_list : // empty - { $$ = new tree_statement_list (); } - | list - { $$ = $1; } - ; - -list : list1 opt_sep - { $$ = set_stmt_print_flag ($1, $2, true); } - ; - -list1 : statement - { $$ = make_statement_list ($1); } - | list1 sep statement - { $$ = append_statement_list ($1, $2, $3, true); } - ; - -statement : expression - { $$ = make_statement ($1); } - | command - { $$ = make_statement ($1); } - | word_list_cmd - { $$ = make_statement ($1); } - ; - -// ================= -// Word-list command -// ================= - -// These are not really like expressions since they can't appear on -// the RHS of an assignment. But they are also not like commands (IF, -// WHILE, etc. - -word_list_cmd : identifier word_list - { $$ = make_index_expression ($1, $2, '('); } - ; - -word_list : string - { $$ = new tree_argument_list ($1); } - | word_list string - { - $1->append ($2); - $$ = $1; - } - ; - -// =========== -// Expressions -// =========== - -identifier : NAME - { - symbol_table::symbol_record *sr = $1->sym_rec (); - $$ = new tree_identifier (*sr, $1->line (), $1->column ()); - } - ; - -superclass_identifier - : SUPERCLASSREF - { $$ = new tree_identifier ($1->line (), $1->column ()); } - ; - -meta_identifier : METAQUERY - { $$ = new tree_identifier ($1->line (), $1->column ()); } - ; - -string : DQ_STRING - { $$ = make_constant (DQ_STRING, $1); } - | SQ_STRING - { $$ = make_constant (SQ_STRING, $1); } - ; - -constant : NUM - { $$ = make_constant (NUM, $1); } - | IMAG_NUM - { $$ = make_constant (IMAG_NUM, $1); } - | string - { $$ = $1; } - ; - -matrix : '[' ']' - { - $$ = new tree_constant (octave_null_matrix::instance); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.pending_local_variables.clear (); - } - | '[' ';' ']' - { - $$ = new tree_constant (octave_null_matrix::instance); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.pending_local_variables.clear (); - } - | '[' ',' ']' - { - $$ = new tree_constant (octave_null_matrix::instance); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.pending_local_variables.clear (); - } - | '[' matrix_rows ']' - { - $$ = finish_matrix ($2); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.pending_local_variables.clear (); - } - ; - -matrix_rows : matrix_rows1 - { $$ = $1; } - | matrix_rows1 ';' // Ignore trailing semicolon. - { $$ = $1; } - ; - -matrix_rows1 : cell_or_matrix_row - { $$ = new tree_matrix ($1); } - | matrix_rows1 ';' cell_or_matrix_row - { - $1->append ($3); - $$ = $1; - } - ; - -cell : '{' '}' - { $$ = new tree_constant (octave_value (Cell ())); } - | '{' ';' '}' - { $$ = new tree_constant (octave_value (Cell ())); } - | '{' cell_rows '}' - { $$ = finish_cell ($2); } - ; - -cell_rows : cell_rows1 - { $$ = $1; } - | cell_rows1 ';' // Ignore trailing semicolon. - { $$ = $1; } - ; - -cell_rows1 : cell_or_matrix_row - { $$ = new tree_cell ($1); } - | cell_rows1 ';' cell_or_matrix_row - { - $1->append ($3); - $$ = $1; - } - ; - -cell_or_matrix_row - : arg_list - { $$ = validate_matrix_row ($1); } - | arg_list ',' // Ignore trailing comma. - { $$ = validate_matrix_row ($1); } - ; - -fcn_handle : '@' FCN_HANDLE - { - $$ = make_fcn_handle ($2); - lexer_flags.looking_at_function_handle--; - } - ; - -anon_fcn_handle : '@' param_list statement - { - lexer_flags.quote_is_transpose = false; - $$ = make_anon_fcn_handle ($2, $3); - } - ; - -primary_expr : identifier - { $$ = $1; } - | constant - { $$ = $1; } - | fcn_handle - { $$ = $1; } - | matrix - { $$ = $1; } - | cell - { $$ = $1; } - | meta_identifier - { $$ = $1; } - | superclass_identifier - { $$ = $1; } - | '(' expression ')' - { $$ = $2->mark_in_parens (); } - ; - -magic_colon : ':' - { - octave_value tmp (octave_value::magic_colon_t); - $$ = new tree_constant (tmp); - } - ; - -magic_tilde : EXPR_NOT - { - $$ = new tree_black_hole (); - } - ; - -arg_list : expression - { $$ = new tree_argument_list ($1); } - | magic_colon - { $$ = new tree_argument_list ($1); } - | magic_tilde - { $$ = new tree_argument_list ($1); } - | arg_list ',' magic_colon - { - $1->append ($3); - $$ = $1; - } - | arg_list ',' magic_tilde - { - $1->append ($3); - $$ = $1; - } - | arg_list ',' expression - { - $1->append ($3); - $$ = $1; - } - ; - -indirect_ref_op : '.' - { lexer_flags.looking_at_indirect_ref = true; } - ; - -oper_expr : primary_expr - { $$ = $1; } - | oper_expr PLUS_PLUS - { $$ = make_postfix_op (PLUS_PLUS, $1, $2); } - | oper_expr MINUS_MINUS - { $$ = make_postfix_op (MINUS_MINUS, $1, $2); } - | oper_expr '(' ')' - { $$ = make_index_expression ($1, 0, '('); } - | oper_expr '(' arg_list ')' - { $$ = make_index_expression ($1, $3, '('); } - | oper_expr '{' '}' - { $$ = make_index_expression ($1, 0, '{'); } - | oper_expr '{' arg_list '}' - { $$ = make_index_expression ($1, $3, '{'); } - | oper_expr QUOTE - { $$ = make_postfix_op (QUOTE, $1, $2); } - | oper_expr TRANSPOSE - { $$ = make_postfix_op (TRANSPOSE, $1, $2); } - | oper_expr indirect_ref_op STRUCT_ELT - { $$ = make_indirect_ref ($1, $3->text ()); } - | oper_expr indirect_ref_op '(' expression ')' - { $$ = make_indirect_ref ($1, $4); } - | PLUS_PLUS oper_expr %prec UNARY - { $$ = make_prefix_op (PLUS_PLUS, $2, $1); } - | MINUS_MINUS oper_expr %prec UNARY - { $$ = make_prefix_op (MINUS_MINUS, $2, $1); } - | EXPR_NOT oper_expr %prec UNARY - { $$ = make_prefix_op (EXPR_NOT, $2, $1); } - | '+' oper_expr %prec UNARY - { $$ = make_prefix_op ('+', $2, $1); } - | '-' oper_expr %prec UNARY - { $$ = make_prefix_op ('-', $2, $1); } - | oper_expr POW oper_expr - { $$ = make_binary_op (POW, $1, $2, $3); } - | oper_expr EPOW oper_expr - { $$ = make_binary_op (EPOW, $1, $2, $3); } - | oper_expr '+' oper_expr - { $$ = make_binary_op ('+', $1, $2, $3); } - | oper_expr '-' oper_expr - { $$ = make_binary_op ('-', $1, $2, $3); } - | oper_expr '*' oper_expr - { $$ = make_binary_op ('*', $1, $2, $3); } - | oper_expr '/' oper_expr - { $$ = make_binary_op ('/', $1, $2, $3); } - | oper_expr EPLUS oper_expr - { $$ = make_binary_op ('+', $1, $2, $3); } - | oper_expr EMINUS oper_expr - { $$ = make_binary_op ('-', $1, $2, $3); } - | oper_expr EMUL oper_expr - { $$ = make_binary_op (EMUL, $1, $2, $3); } - | oper_expr EDIV oper_expr - { $$ = make_binary_op (EDIV, $1, $2, $3); } - | oper_expr LEFTDIV oper_expr - { $$ = make_binary_op (LEFTDIV, $1, $2, $3); } - | oper_expr ELEFTDIV oper_expr - { $$ = make_binary_op (ELEFTDIV, $1, $2, $3); } - ; - -colon_expr : colon_expr1 - { $$ = finish_colon_expression ($1); } - ; - -colon_expr1 : oper_expr - { $$ = new tree_colon_expression ($1); } - | colon_expr1 ':' oper_expr - { - if (! ($$ = $1->append ($3))) - ABORT_PARSE; - } - ; - -simple_expr : colon_expr - { $$ = $1; } - | simple_expr LSHIFT simple_expr - { $$ = make_binary_op (LSHIFT, $1, $2, $3); } - | simple_expr RSHIFT simple_expr - { $$ = make_binary_op (RSHIFT, $1, $2, $3); } - | simple_expr EXPR_LT simple_expr - { $$ = make_binary_op (EXPR_LT, $1, $2, $3); } - | simple_expr EXPR_LE simple_expr - { $$ = make_binary_op (EXPR_LE, $1, $2, $3); } - | simple_expr EXPR_EQ simple_expr - { $$ = make_binary_op (EXPR_EQ, $1, $2, $3); } - | simple_expr EXPR_GE simple_expr - { $$ = make_binary_op (EXPR_GE, $1, $2, $3); } - | simple_expr EXPR_GT simple_expr - { $$ = make_binary_op (EXPR_GT, $1, $2, $3); } - | simple_expr EXPR_NE simple_expr - { $$ = make_binary_op (EXPR_NE, $1, $2, $3); } - | simple_expr EXPR_AND simple_expr - { $$ = make_binary_op (EXPR_AND, $1, $2, $3); } - | simple_expr EXPR_OR simple_expr - { $$ = make_binary_op (EXPR_OR, $1, $2, $3); } - | simple_expr EXPR_AND_AND simple_expr - { $$ = make_boolean_op (EXPR_AND_AND, $1, $2, $3); } - | simple_expr EXPR_OR_OR simple_expr - { $$ = make_boolean_op (EXPR_OR_OR, $1, $2, $3); } - ; - -// Arrange for the lexer to return CLOSE_BRACE for `]' by looking ahead -// one token for an assignment op. - -assign_lhs : simple_expr - { - $$ = new tree_argument_list ($1); - $$->mark_as_simple_assign_lhs (); - } - | '[' arg_list opt_comma CLOSE_BRACE - { - $$ = $2; - lexer_flags.looking_at_matrix_or_assign_lhs = false; - for (std::set::const_iterator p = lexer_flags.pending_local_variables.begin (); - p != lexer_flags.pending_local_variables.end (); - p++) - { - symbol_table::force_variable (*p); - } - lexer_flags.pending_local_variables.clear (); - } - ; - -assign_expr : assign_lhs '=' expression - { $$ = make_assign_op ('=', $1, $2, $3); } - | assign_lhs ADD_EQ expression - { $$ = make_assign_op (ADD_EQ, $1, $2, $3); } - | assign_lhs SUB_EQ expression - { $$ = make_assign_op (SUB_EQ, $1, $2, $3); } - | assign_lhs MUL_EQ expression - { $$ = make_assign_op (MUL_EQ, $1, $2, $3); } - | assign_lhs DIV_EQ expression - { $$ = make_assign_op (DIV_EQ, $1, $2, $3); } - | assign_lhs LEFTDIV_EQ expression - { $$ = make_assign_op (LEFTDIV_EQ, $1, $2, $3); } - | assign_lhs POW_EQ expression - { $$ = make_assign_op (POW_EQ, $1, $2, $3); } - | assign_lhs LSHIFT_EQ expression - { $$ = make_assign_op (LSHIFT_EQ, $1, $2, $3); } - | assign_lhs RSHIFT_EQ expression - { $$ = make_assign_op (RSHIFT_EQ, $1, $2, $3); } - | assign_lhs EMUL_EQ expression - { $$ = make_assign_op (EMUL_EQ, $1, $2, $3); } - | assign_lhs EDIV_EQ expression - { $$ = make_assign_op (EDIV_EQ, $1, $2, $3); } - | assign_lhs ELEFTDIV_EQ expression - { $$ = make_assign_op (ELEFTDIV_EQ, $1, $2, $3); } - | assign_lhs EPOW_EQ expression - { $$ = make_assign_op (EPOW_EQ, $1, $2, $3); } - | assign_lhs AND_EQ expression - { $$ = make_assign_op (AND_EQ, $1, $2, $3); } - | assign_lhs OR_EQ expression - { $$ = make_assign_op (OR_EQ, $1, $2, $3); } - ; - -expression : simple_expr - { $$ = $1; } - | assign_expr - { $$ = $1; } - | anon_fcn_handle - { $$ = $1; } - ; - -// ================================================ -// Commands, declarations, and function definitions -// ================================================ - -command : declaration - { $$ = $1; } - | select_command - { $$ = $1; } - | loop_command - { $$ = $1; } - | jump_command - { $$ = $1; } - | except_command - { $$ = $1; } - | function - { $$ = $1; } - | script_file - { $$ = $1; } - | classdef - { $$ = $1; } - ; - -// ===================== -// Declaration statemnts -// ===================== - -parsing_decl_list - : // empty - { lexer_flags.looking_at_decl_list = true; } - -declaration : GLOBAL parsing_decl_list decl1 - { - $$ = make_decl_command (GLOBAL, $1, $3); - lexer_flags.looking_at_decl_list = false; - } - | PERSISTENT parsing_decl_list decl1 - { - $$ = make_decl_command (PERSISTENT, $1, $3); - lexer_flags.looking_at_decl_list = false; - } - ; - -decl1 : decl2 - { $$ = new tree_decl_init_list ($1); } - | decl1 decl2 - { - $1->append ($2); - $$ = $1; - } - ; - -decl_param_init : // empty - { lexer_flags.looking_at_initializer_expression = true; } - -decl2 : identifier - { $$ = new tree_decl_elt ($1); } - | identifier '=' decl_param_init expression - { - lexer_flags.looking_at_initializer_expression = false; - $$ = new tree_decl_elt ($1, $4); - } - | magic_tilde - { - $$ = new tree_decl_elt ($1); - } - ; - -// ==================== -// Selection statements -// ==================== - -select_command : if_command - { $$ = $1; } - | switch_command - { $$ = $1; } - ; - -// ============ -// If statement -// ============ - -if_command : IF stash_comment if_cmd_list END - { - if (! ($$ = finish_if_command ($1, $3, $4, $2))) - ABORT_PARSE; - } - ; - -if_cmd_list : if_cmd_list1 - { $$ = $1; } - | if_cmd_list1 else_clause - { - $1->append ($2); - $$ = $1; - } - ; - -if_cmd_list1 : expression opt_sep opt_list - { - $1->mark_braindead_shortcircuit (curr_fcn_file_full_name); - - $$ = start_if_command ($1, $3); - } - | if_cmd_list1 elseif_clause - { - $1->append ($2); - $$ = $1; - } - ; - -elseif_clause : ELSEIF stash_comment opt_sep expression opt_sep opt_list - { - $4->mark_braindead_shortcircuit (curr_fcn_file_full_name); - - $$ = make_elseif_clause ($1, $4, $6, $2); - } - ; - -else_clause : ELSE stash_comment opt_sep opt_list - { $$ = new tree_if_clause ($4, $2); } - ; - -// ================ -// Switch statement -// ================ - -switch_command : SWITCH stash_comment expression opt_sep case_list END - { - if (! ($$ = finish_switch_command ($1, $3, $5, $6, $2))) - ABORT_PARSE; - } - ; - -case_list : // empty - { $$ = new tree_switch_case_list (); } - | default_case - { $$ = new tree_switch_case_list ($1); } - | case_list1 - { $$ = $1; } - | case_list1 default_case - { - $1->append ($2); - $$ = $1; - } - ; - -case_list1 : switch_case - { $$ = new tree_switch_case_list ($1); } - | case_list1 switch_case - { - $1->append ($2); - $$ = $1; - } - ; - -switch_case : CASE stash_comment opt_sep expression opt_sep opt_list - { $$ = make_switch_case ($1, $4, $6, $2); } - ; - -default_case : OTHERWISE stash_comment opt_sep opt_list - { - $$ = new tree_switch_case ($4, $2); - } - ; - -// ======= -// Looping -// ======= - -loop_command : WHILE stash_comment expression opt_sep opt_list END - { - $3->mark_braindead_shortcircuit (curr_fcn_file_full_name); - - if (! ($$ = make_while_command ($1, $3, $5, $6, $2))) - ABORT_PARSE; - } - | DO stash_comment opt_sep opt_list UNTIL expression - { - if (! ($$ = make_do_until_command ($5, $4, $6, $2))) - ABORT_PARSE; - } - | FOR stash_comment assign_lhs '=' expression opt_sep opt_list END - { - if (! ($$ = make_for_command (FOR, $1, $3, $5, 0, - $7, $8, $2))) - ABORT_PARSE; - } - | FOR stash_comment '(' assign_lhs '=' expression ')' opt_sep opt_list END - { - if (! ($$ = make_for_command (FOR, $1, $4, $6, 0, - $9, $10, $2))) - ABORT_PARSE; - } - | PARFOR stash_comment assign_lhs '=' expression opt_sep opt_list END - { - if (! ($$ = make_for_command (PARFOR, $1, $3, $5, - 0, $7, $8, $2))) - ABORT_PARSE; - } - | PARFOR stash_comment '(' assign_lhs '=' expression ',' expression ')' opt_sep opt_list END - { - if (! ($$ = make_for_command (PARFOR, $1, $4, $6, - $8, $11, $12, $2))) - ABORT_PARSE; - } - ; - -// ======= -// Jumping -// ======= - -jump_command : BREAK - { - if (! ($$ = make_break_command ($1))) - ABORT_PARSE; - } - | CONTINUE - { - if (! ($$ = make_continue_command ($1))) - ABORT_PARSE; - } - | FUNC_RET - { - if (! ($$ = make_return_command ($1))) - ABORT_PARSE; - } - ; - -// ========== -// Exceptions -// ========== - -except_command : UNWIND stash_comment opt_sep opt_list CLEANUP - stash_comment opt_sep opt_list END - { - if (! ($$ = make_unwind_command ($1, $4, $8, $9, $2, $6))) - ABORT_PARSE; - } - | TRY stash_comment opt_sep opt_list CATCH - stash_comment opt_sep opt_list END - { - if (! ($$ = make_try_command ($1, $4, $8, $9, $2, $6))) - ABORT_PARSE; - } - | TRY stash_comment opt_sep opt_list END - { - if (! ($$ = make_try_command ($1, $4, 0, $5, $2, 0))) - ABORT_PARSE; - } - ; - -// =========================================== -// Some `subroutines' for function definitions -// =========================================== - -push_fcn_symtab : // empty - { - current_function_depth++; - - if (max_function_depth < current_function_depth) - max_function_depth = current_function_depth; - - parser_symtab_context.push (); - - symbol_table::set_scope (symbol_table::alloc_scope ()); - - function_scopes.push_back (symbol_table::current_scope ()); - - if (! reading_script_file && current_function_depth == 1 - && ! parsing_subfunctions) - primary_fcn_scope = symbol_table::current_scope (); - - if (reading_script_file && current_function_depth > 1) - yyerror ("nested functions not implemented in this context"); - } - ; - -// =========================== -// List of function parameters -// =========================== - -param_list_beg : '(' - { - lexer_flags.looking_at_parameter_list = true; - - if (lexer_flags.looking_at_function_handle) - { - parser_symtab_context.push (); - symbol_table::set_scope (symbol_table::alloc_scope ()); - lexer_flags.looking_at_function_handle--; - lexer_flags.looking_at_anon_fcn_args = true; - } - } - ; - -param_list_end : ')' - { - lexer_flags.looking_at_parameter_list = false; - lexer_flags.looking_for_object_index = false; - } - ; - -param_list : param_list_beg param_list1 param_list_end - { - lexer_flags.quote_is_transpose = false; - $$ = $2; - } - | param_list_beg error - { - yyerror ("invalid parameter list"); - $$ = 0; - ABORT_PARSE; - } - ; - -param_list1 : // empty - { $$ = 0; } - | param_list2 - { - $1->mark_as_formal_parameters (); - if ($1->validate (tree_parameter_list::in)) - $$ = $1; - else - ABORT_PARSE; - } - ; - -param_list2 : decl2 - { $$ = new tree_parameter_list ($1); } - | param_list2 ',' decl2 - { - $1->append ($3); - $$ = $1; - } - ; - -// =================================== -// List of function return value names -// =================================== - -return_list : '[' ']' - { - lexer_flags.looking_at_return_list = false; - $$ = new tree_parameter_list (); - } - | return_list1 - { - lexer_flags.looking_at_return_list = false; - if ($1->validate (tree_parameter_list::out)) - $$ = $1; - else - ABORT_PARSE; - } - | '[' return_list1 ']' - { - lexer_flags.looking_at_return_list = false; - if ($2->validate (tree_parameter_list::out)) - $$ = $2; - else - ABORT_PARSE; - } - ; - -return_list1 : identifier - { $$ = new tree_parameter_list (new tree_decl_elt ($1)); } - | return_list1 ',' identifier - { - $1->append (new tree_decl_elt ($3)); - $$ = $1; - } - ; - -// =========== -// Script file -// =========== - -script_file : SCRIPT_FILE opt_list END_OF_INPUT - { - tree_statement *end_of_script - = make_end ("endscript", input_line_number, - current_input_column); - - make_script ($2, end_of_script); - - $$ = 0; - } - ; - -// ============= -// Function file -// ============= - -function_file : FUNCTION_FILE function_list opt_sep END_OF_INPUT - { $$ = 0; } - ; - -function_list : function - | function_list sep function - ; - -// =================== -// Function definition -// =================== - -function_beg : push_fcn_symtab FCN stash_comment - { - $$ = $3; - - if (reading_classdef_file || lexer_flags.parsing_classdef) - lexer_flags.maybe_classdef_get_set_method = true; - } - ; - -function : function_beg function1 - { - $$ = finish_function (0, $2, $1); - recover_from_parsing_function (); - } - | function_beg return_list '=' function1 - { - $$ = finish_function ($2, $4, $1); - recover_from_parsing_function (); - } - ; - -fcn_name : identifier - { - std::string id_name = $1->name (); - - lexer_flags.parsed_function_name.top () = true; - lexer_flags.maybe_classdef_get_set_method = false; - - $$ = $1; - } - | GET '.' identifier - { - lexer_flags.parsed_function_name.top () = true; - lexer_flags.maybe_classdef_get_set_method = false; - $$ = $3; - } - | SET '.' identifier - { - lexer_flags.parsed_function_name.top () = true; - lexer_flags.maybe_classdef_get_set_method = false; - $$ = $3; - } - ; - -function1 : fcn_name function2 - { - std::string fname = $1->name (); - - delete $1; - - if (! ($$ = frob_function (fname, $2))) - ABORT_PARSE; - } - ; - -function2 : param_list opt_sep opt_list function_end - { $$ = start_function ($1, $3, $4); } - | opt_sep opt_list function_end - { $$ = start_function (0, $2, $3); } - ; - -function_end : END - { - endfunction_found = true; - if (end_token_ok ($1, token::function_end)) - $$ = make_end ("endfunction", $1->line (), $1->column ()); - else - ABORT_PARSE; - } - | END_OF_INPUT - { -// A lot of tests are based on the assumption that this is OK -// if (reading_script_file) -// { -// yyerror ("function body open at end of script"); -// YYABORT; -// } - - if (endfunction_found) - { - yyerror ("inconsistent function endings -- " - "if one function is explicitly ended, " - "so must all the others"); - YYABORT; - } - - if (! (reading_fcn_file || reading_script_file - || get_input_from_eval_string)) - { - yyerror ("function body open at end of input"); - YYABORT; - } - - if (reading_classdef_file) - { - yyerror ("classdef body open at end of input"); - YYABORT; - } - - $$ = make_end ("endfunction", input_line_number, - current_input_column); - } - ; - -// ======== -// Classdef -// ======== - -classdef_beg : CLASSDEF stash_comment - { - $$ = 0; - lexer_flags.parsing_classdef = true; - } - ; - -classdef_end : END - { - lexer_flags.parsing_classdef = false; - - if (end_token_ok ($1, token::classdef_end)) - $$ = make_end ("endclassdef", $1->line (), $1->column ()); - else - ABORT_PARSE; - } - ; - -classdef1 : classdef_beg opt_attr_list identifier opt_superclasses - { $$ = 0; } - ; - -classdef : classdef1 opt_sep class_body opt_sep stash_comment classdef_end - { $$ = 0; } - ; - -opt_attr_list : // empty - { $$ = 0; } - | '(' attr_list ')' - { $$ = 0; } - ; - -attr_list : attr - { $$ = 0; } - | attr_list ',' attr - { $$ = 0; } - ; - -attr : identifier - { $$ = 0; } - | identifier '=' decl_param_init expression - { $$ = 0; } - | EXPR_NOT identifier - { $$ = 0; } - ; - -opt_superclasses - : // empty - { $$ = 0; } - | superclasses - { $$ = 0; } - ; - -superclasses : EXPR_LT identifier '.' identifier - { $$ = 0; } - | EXPR_LT identifier - { $$ = 0; } - | superclasses EXPR_AND identifier '.' identifier - { $$ = 0; } - | superclasses EXPR_AND identifier - { $$ = 0; } - ; - -class_body : properties_block - { $$ = 0; } - | methods_block - { $$ = 0; } - | events_block - { $$ = 0; } - | enum_block - { $$ = 0; } - | class_body opt_sep properties_block - { $$ = 0; } - | class_body opt_sep methods_block - { $$ = 0; } - | class_body opt_sep events_block - { $$ = 0; } - | class_body opt_sep enum_block - { $$ = 0; } - ; - -properties_beg : PROPERTIES stash_comment - { $$ = 0; } - ; - -properties_block - : properties_beg opt_attr_list opt_sep properties_list opt_sep END - { $$ = 0; } - ; - -properties_list - : class_property - { $$ = 0; } - | properties_list opt_sep class_property - { $$ = 0; } - ; - -class_property : identifier - { $$ = 0; } - | identifier '=' decl_param_init expression ';' - { $$ = 0; } - ; - -methods_beg : METHODS stash_comment - { $$ = 0; } - ; - -methods_block : methods_beg opt_attr_list opt_sep methods_list opt_sep END - { $$ = 0; } - ; - -methods_list : function - { $$ = 0; } - | methods_list opt_sep function - { $$ = 0; } - ; - -events_beg : EVENTS stash_comment - { $$ = 0; } - ; - -events_block : events_beg opt_attr_list opt_sep events_list opt_sep END - { $$ = 0; } - ; - -events_list : class_event - { $$ = 0; } - | events_list opt_sep class_event - { $$ = 0; } - ; - -class_event : identifier - { $$ = 0; } - ; - -enum_beg : ENUMERATION stash_comment - { $$ = 0; } - ; - -enum_block : enum_beg opt_attr_list opt_sep enum_list opt_sep END - { $$ = 0; } - ; - -enum_list : class_enum - { $$ = 0; } - | enum_list opt_sep class_enum - { $$ = 0; } - ; - -class_enum : identifier '(' expression ')' - { $$ = 0; } - ; - -// ============= -// Miscellaneous -// ============= - -stash_comment : // empty - { $$ = octave_comment_buffer::get_comment (); } - ; - -parse_error : LEXICAL_ERROR - { yyerror ("parse error"); } - | error - ; - -sep_no_nl : ',' - { $$ = ','; } - | ';' - { $$ = ';'; } - | sep_no_nl ',' - { $$ = $1; } - | sep_no_nl ';' - { $$ = $1; } - ; - -opt_sep_no_nl : // empty - { $$ = 0; } - | sep_no_nl - { $$ = $1; } - ; - -sep : ',' - { $$ = ','; } - | ';' - { $$ = ';'; } - | '\n' - { $$ = '\n'; } - | sep ',' - { $$ = $1; } - | sep ';' - { $$ = $1; } - | sep '\n' - { $$ = $1; } - ; - -opt_sep : // empty - { $$ = 0; } - | sep - { $$ = $1; } - ; - -opt_comma : // empty - { $$ = 0; } - | ',' - { $$ = ','; } - ; - -%% - -// Generic error messages. - -static void -yyerror (const char *s) -{ - int err_col = current_input_column - 1; - - std::ostringstream output_buf; - - if (reading_fcn_file || reading_script_file || reading_classdef_file) - output_buf << "parse error near line " << input_line_number - << " of file " << curr_fcn_file_full_name; - else - output_buf << "parse error:"; - - if (s && strcmp (s, "parse error") != 0) - output_buf << "\n\n " << s; - - output_buf << "\n\n"; - - if (! current_input_line.empty ()) - { - size_t len = current_input_line.length (); - - if (current_input_line[len-1] == '\n') - current_input_line.resize (len-1); - - // Print the line, maybe with a pointer near the error token. - - output_buf << ">>> " << current_input_line << "\n"; - - if (err_col == 0) - err_col = len; - - for (int i = 0; i < err_col + 3; i++) - output_buf << " "; - - output_buf << "^"; - } - - output_buf << "\n"; - - std::string msg = output_buf.str (); - - parse_error ("%s", msg.c_str ()); -} - -// Error mesages for mismatched end tokens. - -static void -end_error (const char *type, token::end_tok_type ettype, int l, int c) -{ - static const char *fmt - = "`%s' command matched by `%s' near line %d column %d"; - - switch (ettype) - { - case token::simple_end: - error (fmt, type, "end", l, c); - break; - - case token::for_end: - error (fmt, type, "endfor", l, c); - break; - - case token::function_end: - error (fmt, type, "endfunction", l, c); - break; - - case token::classdef_end: - error (fmt, type, "endclassdef", l, c); - break; - - case token::if_end: - error (fmt, type, "endif", l, c); - break; - - case token::switch_end: - error (fmt, type, "endswitch", l, c); - break; - - case token::while_end: - error (fmt, type, "endwhile", l, c); - break; - - case token::try_catch_end: - error (fmt, type, "end_try_catch", l, c); - break; - - case token::unwind_protect_end: - error (fmt, type, "end_unwind_protect", l, c); - break; - - default: - panic_impossible (); - break; - } -} - -// Check to see that end tokens are properly matched. - -static bool -end_token_ok (token *tok, token::end_tok_type expected) -{ - bool retval = true; - - token::end_tok_type ettype = tok->ettype (); - - if (ettype != expected && ettype != token::simple_end) - { - retval = false; - - yyerror ("parse error"); - - int l = tok->line (); - int c = tok->column (); - - switch (expected) - { - case token::classdef_end: - end_error ("classdef", ettype, l, c); - break; - - case token::for_end: - end_error ("for", ettype, l, c); - break; - - case token::enumeration_end: - end_error ("enumeration", ettype, l, c); - break; - - case token::function_end: - end_error ("function", ettype, l, c); - break; - - case token::if_end: - end_error ("if", ettype, l, c); - break; - - case token::parfor_end: - end_error ("parfor", ettype, l, c); - break; - - case token::try_catch_end: - end_error ("try", ettype, l, c); - break; - - case token::switch_end: - end_error ("switch", ettype, l, c); - break; - - case token::unwind_protect_end: - end_error ("unwind_protect", ettype, l, c); - break; - - case token::while_end: - end_error ("while", ettype, l, c); - break; - - default: - panic_impossible (); - break; - } - } - - return retval; -} - -// Maybe print a warning if an assignment expression is used as the -// test in a logical expression. - -static void -maybe_warn_assign_as_truth_value (tree_expression *expr) -{ - if (expr->is_assignment_expression () - && expr->paren_count () < 2) - { - if (curr_fcn_file_full_name.empty ()) - warning_with_id - ("Octave:assign-as-truth-value", - "suggest parenthesis around assignment used as truth value"); - else - warning_with_id - ("Octave:assign-as-truth-value", - "suggest parenthesis around assignment used as truth value near line %d, column %d in file `%s'", - expr->line (), expr->column (), curr_fcn_file_full_name.c_str ()); - } -} - -// Maybe print a warning about switch labels that aren't constants. - -static void -maybe_warn_variable_switch_label (tree_expression *expr) -{ - if (! expr->is_constant ()) - { - if (curr_fcn_file_full_name.empty ()) - warning_with_id ("Octave:variable-switch-label", - "variable switch label"); - else - warning_with_id - ("Octave:variable-switch-label", - "variable switch label near line %d, column %d in file `%s'", - expr->line (), expr->column (), curr_fcn_file_full_name.c_str ()); - } -} - -static tree_expression * -fold (tree_binary_expression *e) -{ - tree_expression *retval = e; - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (warning_state); - - frame.protect_var (discard_error_messages); - frame.protect_var (discard_warning_messages); - - discard_error_messages = true; - discard_warning_messages = true; - - tree_expression *op1 = e->lhs (); - tree_expression *op2 = e->rhs (); - - if (op1->is_constant () && op2->is_constant ()) - { - octave_value tmp = e->rvalue1 (); - - if (! (error_state || warning_state)) - { - tree_constant *tc_retval - = new tree_constant (tmp, op1->line (), op1->column ()); - - std::ostringstream buf; - - tree_print_code tpc (buf); - - e->accept (tpc); - - tc_retval->stash_original_text (buf.str ()); - - delete e; - - retval = tc_retval; - } - } - - return retval; -} - -static tree_expression * -fold (tree_unary_expression *e) -{ - tree_expression *retval = e; - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (warning_state); - - frame.protect_var (discard_error_messages); - frame.protect_var (discard_warning_messages); - - discard_error_messages = true; - discard_warning_messages = true; - - tree_expression *op = e->operand (); - - if (op->is_constant ()) - { - octave_value tmp = e->rvalue1 (); - - if (! (error_state || warning_state)) - { - tree_constant *tc_retval - = new tree_constant (tmp, op->line (), op->column ()); - - std::ostringstream buf; - - tree_print_code tpc (buf); - - e->accept (tpc); - - tc_retval->stash_original_text (buf.str ()); - - delete e; - - retval = tc_retval; - } - } - - return retval; -} - -// Finish building a range. - -static tree_expression * -finish_colon_expression (tree_colon_expression *e) -{ - tree_expression *retval = e; - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (warning_state); - - frame.protect_var (discard_error_messages); - frame.protect_var (discard_warning_messages); - - discard_error_messages = true; - discard_warning_messages = true; - - tree_expression *base = e->base (); - tree_expression *limit = e->limit (); - tree_expression *incr = e->increment (); - - if (base) - { - if (limit) - { - if (base->is_constant () && limit->is_constant () - && (! incr || (incr && incr->is_constant ()))) - { - octave_value tmp = e->rvalue1 (); - - if (! (error_state || warning_state)) - { - tree_constant *tc_retval - = new tree_constant (tmp, base->line (), base->column ()); - - std::ostringstream buf; - - tree_print_code tpc (buf); - - e->accept (tpc); - - tc_retval->stash_original_text (buf.str ()); - - delete e; - - retval = tc_retval; - } - } - } - else - { - e->preserve_base (); - delete e; - - // FIXME -- need to attempt constant folding here - // too (we need a generic way to do that). - retval = base; - } - } - - return retval; -} - -// Make a constant. - -static tree_constant * -make_constant (int op, token *tok_val) -{ - int l = tok_val->line (); - int c = tok_val->column (); - - tree_constant *retval = 0; - - switch (op) - { - case NUM: - { - octave_value tmp (tok_val->number ()); - retval = new tree_constant (tmp, l, c); - retval->stash_original_text (tok_val->text_rep ()); - } - break; - - case IMAG_NUM: - { - octave_value tmp (Complex (0.0, tok_val->number ())); - retval = new tree_constant (tmp, l, c); - retval->stash_original_text (tok_val->text_rep ()); - } - break; - - case DQ_STRING: - case SQ_STRING: - { - std::string txt = tok_val->text (); - - char delim = op == DQ_STRING ? '"' : '\''; - octave_value tmp (txt, delim); - - if (txt.empty ()) - { - if (op == DQ_STRING) - tmp = octave_null_str::instance; - else - tmp = octave_null_sq_str::instance; - } - - retval = new tree_constant (tmp, l, c); - - if (op == DQ_STRING) - txt = undo_string_escapes (txt); - - // FIXME -- maybe this should also be handled by - // tok_val->text_rep () for character strings? - retval->stash_original_text (delim + txt + delim); - } - break; - - default: - panic_impossible (); - break; - } - - return retval; -} - -// Make a function handle. - -static tree_fcn_handle * -make_fcn_handle (token *tok_val) -{ - int l = tok_val->line (); - int c = tok_val->column (); - - tree_fcn_handle *retval = new tree_fcn_handle (tok_val->text (), l, c); - - return retval; -} - -// Make an anonymous function handle. - -static tree_anon_fcn_handle * -make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt) -{ - // FIXME -- need to get these from the location of the @ symbol. - int l = input_line_number; - int c = current_input_column; - - tree_parameter_list *ret_list = 0; - - symbol_table::scope_id fcn_scope = symbol_table::current_scope (); - - if (parser_symtab_context.empty ()) - panic_impossible (); - - parser_symtab_context.pop (); - - stmt->set_print_flag (false); - - tree_statement_list *body = new tree_statement_list (stmt); - - body->mark_as_anon_function_body (); - - tree_anon_fcn_handle *retval - = new tree_anon_fcn_handle (param_list, ret_list, body, fcn_scope, l, c); - // FIXME: Stash the filename. This does not work and produces - // errors when executed. - //retval->stash_file_name (curr_fcn_file_name); - - return retval; -} - -// Build a binary expression. - -static tree_expression * -make_binary_op (int op, tree_expression *op1, token *tok_val, - tree_expression *op2) -{ - octave_value::binary_op t = octave_value::unknown_binary_op; - - switch (op) - { - case POW: - t = octave_value::op_pow; - break; - - case EPOW: - t = octave_value::op_el_pow; - break; - - case '+': - t = octave_value::op_add; - break; - - case '-': - t = octave_value::op_sub; - break; - - case '*': - t = octave_value::op_mul; - break; - - case '/': - t = octave_value::op_div; - break; - - case EMUL: - t = octave_value::op_el_mul; - break; - - case EDIV: - t = octave_value::op_el_div; - break; - - case LEFTDIV: - t = octave_value::op_ldiv; - break; - - case ELEFTDIV: - t = octave_value::op_el_ldiv; - break; - - case LSHIFT: - t = octave_value::op_lshift; - break; - - case RSHIFT: - t = octave_value::op_rshift; - break; - - case EXPR_LT: - t = octave_value::op_lt; - break; - - case EXPR_LE: - t = octave_value::op_le; - break; - - case EXPR_EQ: - t = octave_value::op_eq; - break; - - case EXPR_GE: - t = octave_value::op_ge; - break; - - case EXPR_GT: - t = octave_value::op_gt; - break; - - case EXPR_NE: - t = octave_value::op_ne; - break; - - case EXPR_AND: - t = octave_value::op_el_and; - break; - - case EXPR_OR: - t = octave_value::op_el_or; - break; - - default: - panic_impossible (); - break; - } - - int l = tok_val->line (); - int c = tok_val->column (); - - tree_binary_expression *e - = maybe_compound_binary_expression (op1, op2, l, c, t); - - return fold (e); -} - -// Build a boolean expression. - -static tree_expression * -make_boolean_op (int op, tree_expression *op1, token *tok_val, - tree_expression *op2) -{ - tree_boolean_expression::type t; - - switch (op) - { - case EXPR_AND_AND: - t = tree_boolean_expression::bool_and; - break; - - case EXPR_OR_OR: - t = tree_boolean_expression::bool_or; - break; - - default: - panic_impossible (); - break; - } - - int l = tok_val->line (); - int c = tok_val->column (); - - tree_boolean_expression *e - = new tree_boolean_expression (op1, op2, l, c, t); - - return fold (e); -} - -// Build a prefix expression. - -static tree_expression * -make_prefix_op (int op, tree_expression *op1, token *tok_val) -{ - octave_value::unary_op t = octave_value::unknown_unary_op; - - switch (op) - { - case EXPR_NOT: - t = octave_value::op_not; - break; - - case '+': - t = octave_value::op_uplus; - break; - - case '-': - t = octave_value::op_uminus; - break; - - case PLUS_PLUS: - t = octave_value::op_incr; - break; - - case MINUS_MINUS: - t = octave_value::op_decr; - break; - - default: - panic_impossible (); - break; - } - - int l = tok_val->line (); - int c = tok_val->column (); - - tree_prefix_expression *e - = new tree_prefix_expression (op1, l, c, t); - - return fold (e); -} - -// Build a postfix expression. - -static tree_expression * -make_postfix_op (int op, tree_expression *op1, token *tok_val) -{ - octave_value::unary_op t = octave_value::unknown_unary_op; - - switch (op) - { - case QUOTE: - t = octave_value::op_hermitian; - break; - - case TRANSPOSE: - t = octave_value::op_transpose; - break; - - case PLUS_PLUS: - t = octave_value::op_incr; - break; - - case MINUS_MINUS: - t = octave_value::op_decr; - break; - - default: - panic_impossible (); - break; - } - - int l = tok_val->line (); - int c = tok_val->column (); - - tree_postfix_expression *e - = new tree_postfix_expression (op1, l, c, t); - - return fold (e); -} - -// Build an unwind-protect command. - -static tree_command * -make_unwind_command (token *unwind_tok, tree_statement_list *body, - tree_statement_list *cleanup, token *end_tok, - octave_comment_list *lc, octave_comment_list *mc) -{ - tree_command *retval = 0; - - if (end_token_ok (end_tok, token::unwind_protect_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = unwind_tok->line (); - int c = unwind_tok->column (); - - retval = new tree_unwind_protect_command (body, cleanup, - lc, mc, tc, l, c); - } - - return retval; -} - -// Build a try-catch command. - -static tree_command * -make_try_command (token *try_tok, tree_statement_list *body, - tree_statement_list *cleanup, token *end_tok, - octave_comment_list *lc, octave_comment_list *mc) -{ - tree_command *retval = 0; - - if (end_token_ok (end_tok, token::try_catch_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = try_tok->line (); - int c = try_tok->column (); - - retval = new tree_try_catch_command (body, cleanup, - lc, mc, tc, l, c); - } - - return retval; -} - -// Build a while command. - -static tree_command * -make_while_command (token *while_tok, tree_expression *expr, - tree_statement_list *body, token *end_tok, - octave_comment_list *lc) -{ - tree_command *retval = 0; - - maybe_warn_assign_as_truth_value (expr); - - if (end_token_ok (end_tok, token::while_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - lexer_flags.looping--; - - int l = while_tok->line (); - int c = while_tok->column (); - - retval = new tree_while_command (expr, body, lc, tc, l, c); - } - - return retval; -} - -// Build a do-until command. - -static tree_command * -make_do_until_command (token *until_tok, tree_statement_list *body, - tree_expression *expr, octave_comment_list *lc) -{ - tree_command *retval = 0; - - maybe_warn_assign_as_truth_value (expr); - - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - lexer_flags.looping--; - - int l = until_tok->line (); - int c = until_tok->column (); - - retval = new tree_do_until_command (expr, body, lc, tc, l, c); - - return retval; -} - -// Build a for command. - -static tree_command * -make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, - tree_expression *expr, tree_expression *maxproc, - tree_statement_list *body, token *end_tok, - octave_comment_list *lc) -{ - tree_command *retval = 0; - - bool parfor = tok_id == PARFOR; - - if (end_token_ok (end_tok, parfor ? token::parfor_end : token::for_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - lexer_flags.looping--; - - int l = for_tok->line (); - int c = for_tok->column (); - - if (lhs->length () == 1) - { - tree_expression *tmp = lhs->remove_front (); - - retval = new tree_simple_for_command (parfor, tmp, expr, maxproc, - body, lc, tc, l, c); - - delete lhs; - } - else - { - if (parfor) - yyerror ("invalid syntax for parfor statement"); - else - retval = new tree_complex_for_command (lhs, expr, body, - lc, tc, l, c); - } - } - - return retval; -} - -// Build a break command. - -static tree_command * -make_break_command (token *break_tok) -{ - tree_command *retval = 0; - - int l = break_tok->line (); - int c = break_tok->column (); - - retval = new tree_break_command (l, c); - - return retval; -} - -// Build a continue command. - -static tree_command * -make_continue_command (token *continue_tok) -{ - tree_command *retval = 0; - - int l = continue_tok->line (); - int c = continue_tok->column (); - - retval = new tree_continue_command (l, c); - - return retval; -} - -// Build a return command. - -static tree_command * -make_return_command (token *return_tok) -{ - tree_command *retval = 0; - - int l = return_tok->line (); - int c = return_tok->column (); - - retval = new tree_return_command (l, c); - - return retval; -} - -// Start an if command. - -static tree_if_command_list * -start_if_command (tree_expression *expr, tree_statement_list *list) -{ - maybe_warn_assign_as_truth_value (expr); - - tree_if_clause *t = new tree_if_clause (expr, list); - - return new tree_if_command_list (t); -} - -// Finish an if command. - -static tree_if_command * -finish_if_command (token *if_tok, tree_if_command_list *list, - token *end_tok, octave_comment_list *lc) -{ - tree_if_command *retval = 0; - - if (end_token_ok (end_tok, token::if_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = if_tok->line (); - int c = if_tok->column (); - - if (list && ! list->empty ()) - { - tree_if_clause *elt = list->front (); - - if (elt) - { - elt->line (l); - elt->column (c); - } - } - - retval = new tree_if_command (list, lc, tc, l, c); - } - - return retval; -} - -// Build an elseif clause. - -static tree_if_clause * -make_elseif_clause (token *elseif_tok, tree_expression *expr, - tree_statement_list *list, octave_comment_list *lc) -{ - maybe_warn_assign_as_truth_value (expr); - - int l = elseif_tok->line (); - int c = elseif_tok->column (); - - return new tree_if_clause (expr, list, lc, l, c); -} - -// Finish a switch command. - -static tree_switch_command * -finish_switch_command (token *switch_tok, tree_expression *expr, - tree_switch_case_list *list, token *end_tok, - octave_comment_list *lc) -{ - tree_switch_command *retval = 0; - - if (end_token_ok (end_tok, token::switch_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = switch_tok->line (); - int c = switch_tok->column (); - - if (list && ! list->empty ()) - { - tree_switch_case *elt = list->front (); - - if (elt) - { - elt->line (l); - elt->column (c); - } - } - - retval = new tree_switch_command (expr, list, lc, tc, l, c); - } - - return retval; -} - -// Build a switch case. - -static tree_switch_case * -make_switch_case (token *case_tok, tree_expression *expr, - tree_statement_list *list, octave_comment_list *lc) -{ - maybe_warn_variable_switch_label (expr); - - int l = case_tok->line (); - int c = case_tok->column (); - - return new tree_switch_case (expr, list, lc, l, c); -} - -// Build an assignment to a variable. - -static tree_expression * -make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, - tree_expression *rhs) -{ - tree_expression *retval = 0; - - octave_value::assign_op t = octave_value::unknown_assign_op; - - switch (op) - { - case '=': - t = octave_value::op_asn_eq; - break; - - case ADD_EQ: - t = octave_value::op_add_eq; - break; - - case SUB_EQ: - t = octave_value::op_sub_eq; - break; - - case MUL_EQ: - t = octave_value::op_mul_eq; - break; - - case DIV_EQ: - t = octave_value::op_div_eq; - break; - - case LEFTDIV_EQ: - t = octave_value::op_ldiv_eq; - break; - - case POW_EQ: - t = octave_value::op_pow_eq; - break; - - case LSHIFT_EQ: - t = octave_value::op_lshift_eq; - break; - - case RSHIFT_EQ: - t = octave_value::op_rshift_eq; - break; - - case EMUL_EQ: - t = octave_value::op_el_mul_eq; - break; - - case EDIV_EQ: - t = octave_value::op_el_div_eq; - break; - - case ELEFTDIV_EQ: - t = octave_value::op_el_ldiv_eq; - break; - - case EPOW_EQ: - t = octave_value::op_el_pow_eq; - break; - - case AND_EQ: - t = octave_value::op_el_and_eq; - break; - - case OR_EQ: - t = octave_value::op_el_or_eq; - break; - - default: - panic_impossible (); - break; - } - - int l = eq_tok->line (); - int c = eq_tok->column (); - - if (lhs->is_simple_assign_lhs ()) - { - tree_expression *tmp = lhs->remove_front (); - - retval = new tree_simple_assignment (tmp, rhs, false, l, c, t); - - delete lhs; - } - else if (t == octave_value::op_asn_eq) - return new tree_multi_assignment (lhs, rhs, false, l, c); - else - yyerror ("computed multiple assignment not allowed"); - - return retval; -} - -// Define a script. - -static void -make_script (tree_statement_list *cmds, tree_statement *end_script) -{ - std::string doc_string; - - if (! help_buf.empty ()) - { - doc_string = help_buf.top (); - help_buf.pop (); - } - - if (! cmds) - cmds = new tree_statement_list (); - - cmds->append (end_script); - - octave_user_script *script - = new octave_user_script (curr_fcn_file_full_name, curr_fcn_file_name, - cmds, doc_string); - - octave_time now; - - script->stash_fcn_file_time (now); - - primary_fcn_ptr = script; - - // Unmark any symbols that may have been tagged as local variables - // while parsing (for example, by force_local_variable in lex.l). - - symbol_table::unmark_forced_variables (); -} - -// Begin defining a function. - -static octave_user_function * -start_function (tree_parameter_list *param_list, tree_statement_list *body, - tree_statement *end_fcn_stmt) -{ - // We'll fill in the return list later. - - if (! body) - body = new tree_statement_list (); - - body->append (end_fcn_stmt); - - octave_user_function *fcn - = new octave_user_function (symbol_table::current_scope (), - param_list, 0, body); - - if (fcn) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - fcn->stash_trailing_comment (tc); - } - - return fcn; -} - -static tree_statement * -make_end (const std::string& type, int l, int c) -{ - return make_statement (new tree_no_op_command (type, l, c)); -} - -// Do most of the work for defining a function. - -static octave_user_function * -frob_function (const std::string& fname, octave_user_function *fcn) -{ - std::string id_name = fname; - - // If input is coming from a file, issue a warning if the name of - // the file does not match the name of the function stated in the - // file. Matlab doesn't provide a diagnostic (it ignores the stated - // name). - if (! autoloading && reading_fcn_file - && current_function_depth == 1 && ! parsing_subfunctions) - { - // FIXME -- should curr_fcn_file_name already be - // preprocessed when we get here? It seems to only be a - // problem with relative file names. - - std::string nm = curr_fcn_file_name; - - size_t pos = nm.find_last_of (file_ops::dir_sep_chars ()); - - if (pos != std::string::npos) - nm = curr_fcn_file_name.substr (pos+1); - - if (nm != id_name) - { - warning_with_id - ("Octave:function-name-clash", - "function name `%s' does not agree with function file name `%s'", - id_name.c_str (), curr_fcn_file_full_name.c_str ()); - - id_name = nm; - } - } - - if (reading_fcn_file || reading_classdef_file || autoloading) - { - octave_time now; - - fcn->stash_fcn_file_name (curr_fcn_file_full_name); - fcn->stash_fcn_file_time (now); - fcn->mark_as_system_fcn_file (); - - if (fcn_file_from_relative_lookup) - fcn->mark_relative (); - - if (current_function_depth > 1 || parsing_subfunctions) - { - fcn->stash_parent_fcn_name (curr_fcn_file_name); - - if (current_function_depth > 1) - fcn->stash_parent_fcn_scope (function_scopes[function_scopes.size ()-2]); - else - fcn->stash_parent_fcn_scope (primary_fcn_scope); - } - - if (lexer_flags.parsing_class_method) - { - if (current_class_name == id_name) - fcn->mark_as_class_constructor (); - else - fcn->mark_as_class_method (); - - fcn->stash_dispatch_class (current_class_name); - } - - std::string nm = fcn->fcn_file_name (); - - file_stat fs (nm); - - if (fs && fs.is_newer (now)) - warning_with_id ("Octave:future-time-stamp", - "time stamp for `%s' is in the future", nm.c_str ()); - } - else if (! (input_from_tmp_history_file || input_from_startup_file) - && reading_script_file - && curr_fcn_file_name == id_name) - { - warning ("function `%s' defined within script file `%s'", - id_name.c_str (), curr_fcn_file_full_name.c_str ()); - } - - fcn->stash_function_name (id_name); - fcn->stash_fcn_location (input_line_number, current_input_column); - - if (! help_buf.empty () && current_function_depth == 1 - && ! parsing_subfunctions) - { - fcn->document (help_buf.top ()); - - help_buf.pop (); - } - - if (reading_fcn_file && current_function_depth == 1 - && ! parsing_subfunctions) - primary_fcn_ptr = fcn; - - return fcn; -} - -static tree_function_def * -finish_function (tree_parameter_list *ret_list, - octave_user_function *fcn, octave_comment_list *lc) -{ - tree_function_def *retval = 0; - - if (ret_list) - ret_list->mark_as_formal_parameters (); - - if (fcn) - { - std::string nm = fcn->name (); - std::string file = fcn->fcn_file_name (); - - std::string tmp = nm; - if (! file.empty ()) - tmp += ": " + file; - - symbol_table::cache_name (fcn->scope (), tmp); - - if (lc) - fcn->stash_leading_comment (lc); - - fcn->define_ret_list (ret_list); - - if (current_function_depth > 1 || parsing_subfunctions) - { - fcn->mark_as_subfunction (); - - if (endfunction_found && function_scopes.size () > 1) - { - symbol_table::scope_id pscope - = function_scopes[function_scopes.size ()-2]; - - symbol_table::install_nestfunction (nm, octave_value (fcn), - pscope); - } - else - symbol_table::install_subfunction (nm, octave_value (fcn), - primary_fcn_scope); - } - - if (current_function_depth == 1 && fcn) - symbol_table::update_nest (fcn->scope ()); - - if (! reading_fcn_file && current_function_depth == 1) - { - // We are either reading a script file or defining a function - // at the command line, so this definition creates a - // tree_function object that is placed in the parse tree. - // Otherwise, it is just inserted in the symbol table, - // either as a subfunction or nested function (see above), - // or as the primary function for the file, via - // primary_fcn_ptr (see also load_fcn_from_file,, - // parse_fcn_file, and - // symbol_table::fcn_info::fcn_info_rep::find_user_function). - - retval = new tree_function_def (fcn); - } - - // Unmark any symbols that may have been tagged as local - // variables while parsing (for example, by force_local_variable - // in lex.l). - - symbol_table::unmark_forced_variables (fcn->scope ()); - } - - return retval; -} - -static void -recover_from_parsing_function (void) -{ - if (parser_symtab_context.empty ()) - panic_impossible (); - - parser_symtab_context.pop (); - - if (reading_fcn_file && current_function_depth == 1 - && ! parsing_subfunctions) - parsing_subfunctions = true; - - current_function_depth--; - function_scopes.pop_back (); - - lexer_flags.defining_func--; - lexer_flags.parsed_function_name.pop (); - lexer_flags.looking_at_return_list = false; - lexer_flags.looking_at_parameter_list = false; -} - -// Make an index expression. - -static tree_index_expression * -make_index_expression (tree_expression *expr, tree_argument_list *args, - char type) -{ - tree_index_expression *retval = 0; - - if (args && args->has_magic_tilde ()) - { - yyerror ("invalid use of empty argument (~) in index expression"); - return retval; - } - - int l = expr->line (); - int c = expr->column (); - - expr->mark_postfix_indexed (); - - if (expr->is_index_expression ()) - { - tree_index_expression *tmp = static_cast (expr); - - tmp->append (args, type); - - retval = tmp; - } - else - retval = new tree_index_expression (expr, args, l, c, type); - - return retval; -} - -// Make an indirect reference expression. - -static tree_index_expression * -make_indirect_ref (tree_expression *expr, const std::string& elt) -{ - tree_index_expression *retval = 0; - - int l = expr->line (); - int c = expr->column (); - - if (expr->is_index_expression ()) - { - tree_index_expression *tmp = static_cast (expr); - - tmp->append (elt); - - retval = tmp; - } - else - retval = new tree_index_expression (expr, elt, l, c); - - lexer_flags.looking_at_indirect_ref = false; - - return retval; -} - -// Make an indirect reference expression with dynamic field name. - -static tree_index_expression * -make_indirect_ref (tree_expression *expr, tree_expression *elt) -{ - tree_index_expression *retval = 0; - - int l = expr->line (); - int c = expr->column (); - - if (expr->is_index_expression ()) - { - tree_index_expression *tmp = static_cast (expr); - - tmp->append (elt); - - retval = tmp; - } - else - retval = new tree_index_expression (expr, elt, l, c); - - lexer_flags.looking_at_indirect_ref = false; - - return retval; -} - -// Make a declaration command. - -static tree_decl_command * -make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst) -{ - tree_decl_command *retval = 0; - - int l = tok_val->line (); - int c = tok_val->column (); - - switch (tok) - { - case GLOBAL: - retval = new tree_global_command (lst, l, c); - break; - - case PERSISTENT: - if (current_function_depth > 0) - retval = new tree_persistent_command (lst, l, c); - else - { - if (reading_script_file) - warning ("ignoring persistent declaration near line %d of file `%s'", - l, curr_fcn_file_full_name.c_str ()); - else - warning ("ignoring persistent declaration near line %d", l); - } - break; - - default: - panic_impossible (); - break; - } - - return retval; -} - -static tree_argument_list * -validate_matrix_row (tree_argument_list *row) -{ - if (row && row->has_magic_tilde ()) - yyerror ("invalid use of tilde (~) in matrix expression"); - return row; -} - -// Finish building a matrix list. - -static tree_expression * -finish_matrix (tree_matrix *m) -{ - tree_expression *retval = m; - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (warning_state); - - frame.protect_var (discard_error_messages); - frame.protect_var (discard_warning_messages); - - discard_error_messages = true; - discard_warning_messages = true; - - if (m->all_elements_are_constant ()) - { - octave_value tmp = m->rvalue1 (); - - if (! (error_state || warning_state)) - { - tree_constant *tc_retval - = new tree_constant (tmp, m->line (), m->column ()); - - std::ostringstream buf; - - tree_print_code tpc (buf); - - m->accept (tpc); - - tc_retval->stash_original_text (buf.str ()); - - delete m; - - retval = tc_retval; - } - } - - return retval; -} - -// Finish building a cell list. - -static tree_expression * -finish_cell (tree_cell *c) -{ - return finish_matrix (c); -} - -static void -maybe_warn_missing_semi (tree_statement_list *t) -{ - if (current_function_depth > 0) - { - tree_statement *tmp = t->back (); - - if (tmp->is_expression ()) - warning_with_id - ("Octave:missing-semicolon", - "missing semicolon near line %d, column %d in file `%s'", - tmp->line (), tmp->column (), curr_fcn_file_full_name.c_str ()); - } -} - -static tree_statement_list * -set_stmt_print_flag (tree_statement_list *list, char sep, - bool warn_missing_semi) -{ - tree_statement *tmp = list->back (); - - switch (sep) - { - case ';': - tmp->set_print_flag (false); - break; - - case 0: - case ',': - case '\n': - tmp->set_print_flag (true); - if (warn_missing_semi) - maybe_warn_missing_semi (list); - break; - - default: - warning ("unrecognized separator type!"); - break; - } - - // Even if a statement is null, we add it to the list then remove it - // here so that the print flag is applied to the correct statement. - - if (tmp->is_null_statement ()) - { - list->pop_back (); - delete tmp; - } - - return list; -} - -static tree_statement_list * -make_statement_list (tree_statement *stmt) -{ - return new tree_statement_list (stmt); -} - -static tree_statement_list * -append_statement_list (tree_statement_list *list, char sep, - tree_statement *stmt, bool warn_missing_semi) -{ - set_stmt_print_flag (list, sep, warn_missing_semi); - - list->append (stmt); - - return list; -} - -static void -safe_fclose (FILE *f) -{ - // FIXME -- comments at the end of an input file are - // discarded (otherwise, they would be appended to the next - // statement, possibly from the command line or another file, which - // can be quite confusing). - - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - delete tc; - - if (f) - fclose (static_cast (f)); -} - -static bool -looks_like_copyright (const std::string& s) -{ - bool retval = false; - - if (! s.empty ()) - { - size_t offset = s.find_first_not_of (" \t"); - - retval = (s.substr (offset, 9) == "Copyright" || s.substr (offset, 6) == "Author"); - } - - return retval; -} - -static int -text_getc (FILE *f) -{ - int c = gnulib::getc (f); - - // Convert CRLF into just LF and single CR into LF. - - if (c == '\r') - { - c = gnulib::getc (f); - - if (c != '\n') - { - ungetc (c, f); - c = '\n'; - } - } - - if (c == '\n') - input_line_number++; - - return c; -} - -class -stdio_stream_reader : public stream_reader -{ -public: - stdio_stream_reader (FILE *f_arg) : stream_reader (), f (f_arg) { } - - int getc (void) { return ::text_getc (f); } - int ungetc (int c) - { - if (c == '\n') - input_line_number--; - - return ::ungetc (c, f); - } - -private: - FILE *f; - - // No copying! - - stdio_stream_reader (const stdio_stream_reader&); - - stdio_stream_reader & operator = (const stdio_stream_reader&); -}; - -static bool -skip_white_space (stream_reader& reader) -{ - int c = 0; - - while ((c = reader.getc ()) != EOF) - { - switch (c) - { - case ' ': - case '\t': - current_input_column++; - break; - - case '\n': - current_input_column = 1; - break; - - default: - reader.ungetc (c); - goto done; - } - } - - done: - - return (c == EOF); -} - -static bool -looking_at_classdef_keyword (FILE *ffile) -{ - bool status = false; - - long pos = gnulib::ftell (ffile); - - char buf [10]; - gnulib::fgets (buf, 10, ffile); - size_t len = strlen (buf); - if (len > 8 && strncmp (buf, "classdef", 8) == 0 - && ! (isalnum (buf[8]) || buf[8] == '_')) - status = true; - - gnulib::fseek (ffile, pos, SEEK_SET); - - return status; - } - -static std::string -gobble_leading_white_space (FILE *ffile, bool& eof) -{ - std::string help_txt; - - eof = false; - - // TRUE means we have already cached the help text. - bool have_help_text = false; - - std::string txt; - - stdio_stream_reader stdio_reader (ffile); - - while (true) - { - eof = skip_white_space (stdio_reader); - - if (eof) - break; - - txt = grab_comment_block (stdio_reader, true, eof); - - if (txt.empty ()) - break; - - if (! (have_help_text || looks_like_copyright (txt))) - { - help_txt = txt; - have_help_text = true; - } - - octave_comment_buffer::append (txt); - - if (eof) - break; - } - - return help_txt; -} - -static bool -looking_at_function_keyword (FILE *ffile) -{ - bool status = false; - - long pos = gnulib::ftell (ffile); - - char buf [10]; - gnulib::fgets (buf, 10, ffile); - size_t len = strlen (buf); - if (len > 8 && strncmp (buf, "function", 8) == 0 - && ! (isalnum (buf[8]) || buf[8] == '_')) - status = true; - - gnulib::fseek (ffile, pos, SEEK_SET); - - return status; -} - -static octave_function * -parse_fcn_file (const std::string& ff, const std::string& dispatch_type, - bool force_script = false, bool require_file = true, - const std::string& warn_for = std::string ()) -{ - unwind_protect frame; - - octave_function *fcn_ptr = 0; - - // Open function file and parse. - - FILE *in_stream = command_editor::get_input_stream (); - - frame.add_fcn (command_editor::set_input_stream, in_stream); - - frame.protect_var (ff_instream); - - frame.protect_var (input_line_number); - frame.protect_var (current_input_column); - frame.protect_var (reading_fcn_file); - frame.protect_var (line_editing); - frame.protect_var (current_class_name); - frame.protect_var (current_function_depth); - frame.protect_var (function_scopes); - frame.protect_var (max_function_depth); - frame.protect_var (parsing_subfunctions); - frame.protect_var (endfunction_found); - - input_line_number = 1; - current_input_column = 1; - reading_fcn_file = true; - line_editing = false; - current_class_name = dispatch_type; - current_function_depth = 0; - function_scopes.clear (); - max_function_depth = 0; - parsing_subfunctions = false; - endfunction_found = false; - - frame.add_fcn (command_history::ignore_entries, - command_history::ignoring_entries ()); - - command_history::ignore_entries (); - - FILE *ffile = get_input_from_file (ff, 0); - - frame.add_fcn (safe_fclose, ffile); - - if (ffile) - { - bool eof; - - std::string help_txt = gobble_leading_white_space (ffile, eof); - - if (! help_txt.empty ()) - help_buf.push (help_txt); - - if (! eof) - { - std::string file_type; - - frame.protect_var (get_input_from_eval_string); - frame.protect_var (parser_end_of_input); - frame.protect_var (reading_fcn_file); - frame.protect_var (reading_script_file); - frame.protect_var (reading_classdef_file); - frame.protect_var (Vecho_executing_commands); - - - get_input_from_eval_string = false; - parser_end_of_input = false; - - if (! force_script && looking_at_function_keyword (ffile)) - { - file_type = "function"; - - Vecho_executing_commands = ECHO_OFF; - - reading_classdef_file = false; - reading_fcn_file = true; - reading_script_file = false; - } - else if (! force_script && looking_at_classdef_keyword (ffile)) - { - file_type = "classdef"; - - Vecho_executing_commands = ECHO_OFF; - - reading_classdef_file = true; - reading_fcn_file = false; - // FIXME -- Should classdef files be handled as - // scripts or separately? Currently, without setting up - // for reading script files, parsing classdef files - // fails. - reading_script_file = true; - } - else - { - file_type = "script"; - - Vecho_executing_commands = ECHO_OFF; - - reading_classdef_file = false; - reading_fcn_file = false; - reading_script_file = true; - } - - YY_BUFFER_STATE old_buf = current_buffer (); - YY_BUFFER_STATE new_buf = create_buffer (ffile); - - frame.add_fcn (switch_to_buffer, old_buf); - frame.add_fcn (delete_buffer, new_buf); - - switch_to_buffer (new_buf); - - frame.protect_var (primary_fcn_ptr); - primary_fcn_ptr = 0; - - reset_parser (); - - // Do this with an unwind-protect cleanup function so that - // the forced variables will be unmarked in the event of an - // interrupt. - symbol_table::scope_id scope = symbol_table::top_scope (); - frame.add_fcn (symbol_table::unmark_forced_variables, scope); - - if (! help_txt.empty ()) - help_buf.push (help_txt); - - if (reading_script_file) - prep_lexer_for_script_file (); - else - prep_lexer_for_function_file (); - - lexer_flags.parsing_class_method = ! dispatch_type.empty (); - - frame.protect_var (global_command); - - global_command = 0; - - int status = yyparse (); - - // Use an unwind-protect cleanup function so that the - // global_command list will be deleted in the event of an - // interrupt. - - frame.add_fcn (cleanup_statement_list, &global_command); - - fcn_ptr = primary_fcn_ptr; - - if (status != 0) - error ("parse error while reading %s file %s", - file_type.c_str (), ff.c_str ()); - } - else - { - tree_statement *end_of_script - = make_end ("endscript", input_line_number, current_input_column); - - make_script (0, end_of_script); - - fcn_ptr = primary_fcn_ptr; - } - } - else if (require_file) - error ("no such file, `%s'", ff.c_str ()); - else if (! warn_for.empty ()) - error ("%s: unable to open file `%s'", warn_for.c_str (), ff.c_str ()); - - return fcn_ptr; -} - -std::string -get_help_from_file (const std::string& nm, bool& symbol_found, - std::string& file) -{ - std::string retval; - - file = fcn_file_in_path (nm); - - if (! file.empty ()) - { - symbol_found = true; - - FILE *fptr = gnulib::fopen (file.c_str (), "r"); - - if (fptr) - { - unwind_protect frame; - frame.add_fcn (safe_fclose, fptr); - - bool eof; - retval = gobble_leading_white_space (fptr, eof); - - if (retval.empty ()) - { - octave_function *fcn = parse_fcn_file (file, ""); - - if (fcn) - { - retval = fcn->doc_string (); - - delete fcn; - } - } - } - } - - return retval; -} - -std::string -get_help_from_file (const std::string& nm, bool& symbol_found) -{ - std::string file; - return get_help_from_file (nm, symbol_found, file); -} - -std::string -lookup_autoload (const std::string& nm) -{ - std::string retval; - - typedef std::map::const_iterator am_iter; - - am_iter p = autoload_map.find (nm); - - if (p != autoload_map.end ()) - retval = load_path::find_file (p->second); - - return retval; -} - -string_vector -autoloaded_functions (void) -{ - string_vector names (autoload_map.size ()); - - octave_idx_type i = 0; - typedef std::map::const_iterator am_iter; - for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) - names[i++] = p->first; - - return names; -} - -string_vector -reverse_lookup_autoload (const std::string& nm) -{ - string_vector names; - - typedef std::map::const_iterator am_iter; - for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) - if (nm == p->second) - names.append (p->first); - - return names; -} - -octave_function * -load_fcn_from_file (const std::string& file_name, const std::string& dir_name, - const std::string& dispatch_type, - const std::string& fcn_name, bool autoload) -{ - octave_function *retval = 0; - - unwind_protect frame; - - std::string nm = file_name; - - size_t nm_len = nm.length (); - - std::string file; - - frame.protect_var (fcn_file_from_relative_lookup); - - fcn_file_from_relative_lookup = false; - - file = nm; - - if ((nm_len > 4 && nm.substr (nm_len-4) == ".oct") - || (nm_len > 4 && nm.substr (nm_len-4) == ".mex") - || (nm_len > 2 && nm.substr (nm_len-2) == ".m")) - { - nm = octave_env::base_pathname (file); - nm = nm.substr (0, nm.find_last_of ('.')); - - size_t pos = nm.find_last_of (file_ops::dir_sep_str ()); - if (pos != std::string::npos) - nm = nm.substr (pos+1); - } - - if (autoload) - { - frame.protect_var (autoloading); - autoloading = true; - } - - fcn_file_from_relative_lookup = ! octave_env::absolute_pathname (file); - - file = octave_env::make_absolute (file); - - int len = file.length (); - - if (len > 4 && file.substr (len-4, len-1) == ".oct") - { - if (autoload && ! fcn_name.empty ()) - nm = fcn_name; - - retval = octave_dynamic_loader::load_oct (nm, file, fcn_file_from_relative_lookup); - } - else if (len > 4 && file.substr (len-4, len-1) == ".mex") - { - // Temporarily load m-file version of mex-file, if it exists, - // to get the help-string to use. - frame.protect_var (curr_fcn_file_name); - frame.protect_var (curr_fcn_file_full_name); - - curr_fcn_file_name = nm; - curr_fcn_file_full_name = file.substr (0, len - 2); - - octave_function *tmpfcn = parse_fcn_file (file.substr (0, len - 2), - dispatch_type, autoloading, - false); - - retval = octave_dynamic_loader::load_mex (nm, file, fcn_file_from_relative_lookup); - - if (tmpfcn) - retval->document (tmpfcn->doc_string ()); - delete tmpfcn; - } - else if (len > 2) - { - // These are needed by yyparse. - - frame.protect_var (curr_fcn_file_name); - frame.protect_var (curr_fcn_file_full_name); - - curr_fcn_file_name = nm; - curr_fcn_file_full_name = file; - - retval = parse_fcn_file (file, dispatch_type, autoloading); - } - - if (retval) - { - retval->stash_dir_name (dir_name); - - if (retval->is_user_function ()) - { - symbol_table::scope_id id = retval->scope (); - - symbol_table::stash_dir_name_for_subfunctions (id, dir_name); - } - } - - return retval; -} - -DEFUN (autoload, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} autoload (@var{function}, @var{file})\n\ -Define @var{function} to autoload from @var{file}.\n\ -\n\ -The second argument, @var{file}, should be an absolute file name or\n\ -a file name in the same directory as the function or script from which\n\ -the autoload command was run. @var{file} should not depend on the\n\ -Octave load path.\n\ -\n\ -Normally, calls to @code{autoload} appear in PKG_ADD script files that\n\ -are evaluated when a directory is added to the Octave's load path. To\n\ -avoid having to hardcode directory names in @var{file}, if @var{file}\n\ -is in the same directory as the PKG_ADD script then\n\ -\n\ -@example\n\ -autoload (\"foo\", \"bar.oct\");\n\ -@end example\n\ -\n\ -@noindent\n\ -will load the function @code{foo} from the file @code{bar.oct}. The above\n\ -when @code{bar.oct} is not in the same directory or uses like\n\ -\n\ -@example\n\ -autoload (\"foo\", file_in_loadpath (\"bar.oct\"))\n\ -@end example\n\ -\n\ -@noindent\n\ -are strongly discouraged, as their behavior might be unpredictable.\n\ -\n\ -With no arguments, return a structure containing the current autoload map.\n\ -@seealso{PKG_ADD}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - { - Cell func_names (dim_vector (autoload_map.size (), 1)); - Cell file_names (dim_vector (autoload_map.size (), 1)); - - octave_idx_type i = 0; - typedef std::map::const_iterator am_iter; - for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) - { - func_names(i) = p->first; - file_names(i) = p->second; - - i++; - } - - octave_map m; - - m.assign ("function", func_names); - m.assign ("file", file_names); - - retval = m; - } - else if (nargin == 2) - { - string_vector argv = args.make_argv ("autoload"); - - if (! error_state) - { - std::string nm = argv[2]; - - if (! octave_env::absolute_pathname (nm)) - { - octave_user_code *fcn = octave_call_stack::caller_user_code (); - - bool found = false; - - if (fcn) - { - std::string fname = fcn->fcn_file_name (); - - if (! fname.empty ()) - { - fname = octave_env::make_absolute (fname); - fname = fname.substr (0, fname.find_last_of (file_ops::dir_sep_str ()) + 1); - - file_stat fs (fname + nm); - - if (fs.exists ()) - { - nm = fname + nm; - found = true; - } - } - } - if (! found) - warning_with_id ("Octave:autoload-relative-file-name", - "autoload: `%s' is not an absolute file name", - nm.c_str ()); - } - autoload_map[argv[1]] = nm; - } - } - else - print_usage (); - - return retval; -} - -void -source_file (const std::string& file_name, const std::string& context, - bool verbose, bool require_file, const std::string& warn_for) -{ - // Map from absolute name of script file to recursion level. We - // use a map instead of simply placing a limit on recursion in the - // source_file function so that two mutually recursive scripts - // written as - // - // foo1.m: - // ------ - // foo2 - // - // foo2.m: - // ------ - // foo1 - // - // and called with - // - // foo1 - // - // (for example) will behave the same if they are written as - // - // foo1.m: - // ------ - // source ("foo2.m") - // - // foo2.m: - // ------ - // source ("foo1.m") - // - // and called with - // - // source ("foo1.m") - // - // (for example). - - static std::map source_call_depth; - - std::string file_full_name = file_ops::tilde_expand (file_name); - - file_full_name = octave_env::make_absolute (file_full_name); - - unwind_protect frame; - - frame.protect_var (curr_fcn_file_name); - frame.protect_var (curr_fcn_file_full_name); - - curr_fcn_file_name = file_name; - curr_fcn_file_full_name = file_full_name; - - if (source_call_depth.find (file_full_name) == source_call_depth.end ()) - source_call_depth[file_full_name] = -1; - - frame.protect_var (source_call_depth[file_full_name]); - - source_call_depth[file_full_name]++; - - if (source_call_depth[file_full_name] >= Vmax_recursion_depth) - { - error ("max_recursion_depth exceeded"); - return; - } - - if (! context.empty ()) - { - if (context == "caller") - octave_call_stack::goto_caller_frame (); - else if (context == "base") - octave_call_stack::goto_base_frame (); - else - error ("source: context must be \"caller\" or \"base\""); - - if (! error_state) - frame.add_fcn (octave_call_stack::pop); - } - - if (! error_state) - { - octave_function *fcn = parse_fcn_file (file_full_name, "", true, - require_file, warn_for); - - if (! error_state) - { - if (fcn && fcn->is_user_script ()) - { - octave_value_list args; - - if (verbose) - { - std::cout << "executing commands from " << file_full_name << " ... "; - reading_startup_message_printed = true; - std::cout.flush (); - } - - fcn->do_multi_index_op (0, args); - - if (verbose) - std::cout << "done." << std::endl; - - delete fcn; - } - } - else - error ("source: error sourcing file `%s'", - file_full_name.c_str ()); - } -} - -DEFUN (mfilename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mfilename ()\n\ -@deftypefnx {Built-in Function} {} mfilename (\"fullpath\")\n\ -@deftypefnx {Built-in Function} {} mfilename (\"fullpathext\")\n\ -Return the name of the currently executing file. At the top-level,\n\ -return the empty string. Given the argument @code{\"fullpath\"},\n\ -include the directory part of the file name, but not the extension.\n\ -Given the argument @code{\"fullpathext\"}, include the directory part\n\ -of the file name and the extension.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin > 1) - { - print_usage (); - return retval; - } - - std::string arg; - - if (nargin == 1) - { - arg = args(0).string_value (); - - if (error_state) - { - error ("mfilename: expecting argument to be a character string"); - return retval; - } - } - - std::string fname; - - octave_user_code *fcn = octave_call_stack::caller_user_code (); - - if (fcn) - { - fname = fcn->fcn_file_name (); - - if (fname.empty ()) - fname = fcn->name (); - } - - if (arg == "fullpathext") - retval = fname; - else - { - size_t dpos = fname.rfind (file_ops::dir_sep_char ()); - size_t epos = fname.rfind ('.'); - - if (epos <= dpos) - epos = std::string::npos; - - fname = (epos != std::string::npos) ? fname.substr (0, epos) : fname; - - if (arg == "fullpath") - retval = fname; - else - retval = (dpos != std::string::npos) ? fname.substr (dpos+1) : fname; - } - - return retval; -} - - -DEFUN (source, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} source (@var{file})\n\ -Parse and execute the contents of @var{file}. This is equivalent to\n\ -executing commands from a script file, but without requiring the file to\n\ -be named @file{@var{file}.m}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string file_name = args(0).string_value (); - - if (! error_state) - { - std::string context; - - if (nargin == 2) - context = args(1).string_value (); - - if (! error_state) - source_file (file_name, context); - else - error ("source: expecting context to be character string"); - } - else - error ("source: expecting file name as argument"); - } - else - print_usage (); - - return retval; -} - -// Evaluate an Octave function (built-in or interpreted) and return -// the list of result values. NAME is the name of the function to -// call. ARGS are the arguments to the function. NARGOUT is the -// number of output arguments expected. - -octave_value_list -feval (const std::string& name, const octave_value_list& args, int nargout) -{ - octave_value_list retval; - - octave_value fcn = symbol_table::find_function (name, args); - - if (fcn.is_defined ()) - retval = fcn.do_multi_index_op (nargout, args); - else - { - maybe_missing_function_hook (name); - if (! error_state) - error ("feval: function `%s' not found", name.c_str ()); - } - - return retval; -} - -octave_value_list -feval (octave_function *fcn, const octave_value_list& args, int nargout) -{ - octave_value_list retval; - - if (fcn) - retval = fcn->do_multi_index_op (nargout, args); - - return retval; -} - -static octave_value_list -get_feval_args (const octave_value_list& args) -{ - return args.slice (1, args.length () - 1, true); -} - - -// Evaluate an Octave function (built-in or interpreted) and return -// the list of result values. The first element of ARGS should be a -// string containing the name of the function to call, then the rest -// are the actual arguments to the function. NARGOUT is the number of -// output arguments expected. - -octave_value_list -feval (const octave_value_list& args, int nargout) -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - { - octave_value f_arg = args(0); - - if (f_arg.is_string ()) - { - std::string name = f_arg.string_value (); - - if (! error_state) - { - octave_value_list tmp_args = get_feval_args (args); - - retval = feval (name, tmp_args, nargout); - } - } - else if (f_arg.is_function_handle () - || f_arg.is_anonymous_function () - || f_arg.is_inline_function ()) - { - const octave_value_list tmp_args = get_feval_args (args); - - retval = f_arg.do_multi_index_op (nargout, tmp_args); - } - else - error ("feval: first argument must be a string, inline function or a function handle"); - } - - return retval; -} - -DEFUN (feval, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} feval (@var{name}, @dots{})\n\ -Evaluate the function named @var{name}. Any arguments after the first\n\ -are passed on to the named function. For example,\n\ -\n\ -@example\n\ -@group\n\ -feval (\"acos\", -1)\n\ - @result{} 3.1416\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -calls the function @code{acos} with the argument @samp{-1}.\n\ -\n\ -The function @code{feval} can also be used with function handles of\n\ -any sort (@pxref{Function Handles}). Historically, @code{feval} was\n\ -the only way to call user-supplied functions in strings, but\n\ -function handles are now preferred due to the cleaner syntax they\n\ -offer. For example,\n\ -\n\ -@example\n\ -@group\n\ -@var{f} = @@exp;\n\ -feval (@var{f}, 1)\n\ - @result{} 2.7183\n\ -@var{f} (1)\n\ - @result{} 2.7183\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -are equivalent ways to call the function referred to by @var{f}. If it\n\ -cannot be predicted beforehand that @var{f} is a function handle or the\n\ -function name in a string, @code{feval} can be used instead.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - retval = feval (args, nargout); - else - print_usage (); - - return retval; -} - -DEFUN (builtin, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@dots{}]} builtin (@var{f}, @dots{})\n\ -Call the base function @var{f} even if @var{f} is overloaded to\n\ -another function for the given type signature.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - { - const std::string name (args(0).string_value ()); - - if (! error_state) - { - octave_value fcn = symbol_table::builtin_find (name); - - if (fcn.is_defined ()) - retval = feval (fcn.function_value (), args.splice (0, 1), - nargout); - else - error ("builtin: lookup for symbol `%s' failed", name.c_str ()); - } - else - error ("builtin: function name (F) must be a string"); - } - else - print_usage (); - - return retval; -} - -octave_value_list -eval_string (const std::string& s, bool silent, int& parse_status, int nargout) -{ - octave_value_list retval; - - unwind_protect frame; - - frame.protect_var (input_line_number); - frame.protect_var (current_input_column); - frame.protect_var (get_input_from_eval_string); - frame.protect_var (input_from_eval_string_pending); - frame.protect_var (parser_end_of_input); - frame.protect_var (line_editing); - frame.protect_var (current_eval_string); - frame.protect_var (current_function_depth); - frame.protect_var (function_scopes); - frame.protect_var (max_function_depth); - frame.protect_var (parsing_subfunctions); - frame.protect_var (endfunction_found); - frame.protect_var (reading_fcn_file); - frame.protect_var (reading_script_file); - frame.protect_var (reading_classdef_file); - - input_line_number = 1; - current_input_column = 1; - get_input_from_eval_string = true; - input_from_eval_string_pending = true; - parser_end_of_input = false; - line_editing = false; - current_function_depth = 0; - function_scopes.clear (); - max_function_depth = 0; - parsing_subfunctions = false; - endfunction_found = false; - reading_fcn_file = false; - reading_script_file = false; - reading_classdef_file = false; - - current_eval_string = s; - - YY_BUFFER_STATE old_buf = current_buffer (); - YY_BUFFER_STATE new_buf = create_buffer (0); - - frame.add_fcn (switch_to_buffer, old_buf); - frame.add_fcn (delete_buffer, new_buf); - - switch_to_buffer (new_buf); - - do - { - reset_parser (); - - frame.protect_var (global_command); - - global_command = 0; - - // Do this with an unwind-protect cleanup function so that the - // forced variables will be unmarked in the event of an - // interrupt. - symbol_table::scope_id scope = symbol_table::top_scope (); - frame.add_fcn (symbol_table::unmark_forced_variables, scope); - - parse_status = yyparse (); - - tree_statement_list *command_list = global_command; - - // Unmark forced variables. - // Restore previous value of global_command. - frame.run_top (2); - - if (parse_status == 0) - { - if (command_list) - { - unwind_protect inner_frame; - - // Use an unwind-protect cleanup function so that the - // global_command list will be deleted in the event of an - // interrupt. - - inner_frame.add_fcn (cleanup_statement_list, &command_list); - - tree_statement *stmt = 0; - - if (command_list->length () == 1 - && (stmt = command_list->front ()) - && stmt->is_expression ()) - { - tree_expression *expr = stmt->expression (); - - if (silent) - expr->set_print_flag (false); - - bool do_bind_ans = false; - - if (expr->is_identifier ()) - { - tree_identifier *id - = dynamic_cast (expr); - - do_bind_ans = (! id->is_variable ()); - } - else - do_bind_ans = (! expr->is_assignment_expression ()); - - retval = expr->rvalue (nargout); - - if (do_bind_ans && ! (error_state || retval.empty ())) - bind_ans (retval(0), expr->print_result ()); - - if (nargout == 0) - retval = octave_value_list (); - } - else if (nargout == 0) - command_list->accept (*current_evaluator); - else - error ("eval: invalid use of statement list"); - - if (error_state - || tree_return_command::returning - || tree_break_command::breaking - || tree_continue_command::continuing) - break; - } - else if (parser_end_of_input) - break; - } - } - while (parse_status == 0); - - return retval; -} - -octave_value -eval_string (const std::string& s, bool silent, int& parse_status) -{ - octave_value retval; - - octave_value_list tmp = eval_string (s, silent, parse_status, 1); - - if (! tmp.empty ()) - retval = tmp(0); - - return retval; -} - -static octave_value_list -eval_string (const octave_value& arg, bool silent, int& parse_status, - int nargout) -{ - std::string s = arg.string_value (); - - if (error_state) - { - error ("eval: expecting std::string argument"); - return octave_value (-1); - } - - return eval_string (s, silent, parse_status, nargout); -} - -void -cleanup_statement_list (tree_statement_list **lst) -{ - if (*lst) - { - delete *lst; - *lst = 0; - } -} - -DEFUN (eval, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eval (@var{try})\n\ -@deftypefnx {Built-in Function} {} eval (@var{try}, @var{catch})\n\ -Parse the string @var{try} and evaluate it as if it were an Octave\n\ -program. If that fails, evaluate the optional string @var{catch}.\n\ -The string @var{try} is evaluated in the current context,\n\ -so any results remain available after @code{eval} returns.\n\ -\n\ -The following example makes the variable @var{a} with the approximate\n\ -value 3.1416 available.\n\ -\n\ -@example\n\ -eval (\"a = acos(-1);\");\n\ -@end example\n\ -\n\ -If an error occurs during the evaluation of @var{try} the @var{catch}\n\ -string is evaluated, as the following example shows:\n\ -\n\ -@example\n\ -@group\n\ -eval ('error (\"This is a bad example\");',\n\ - 'printf (\"This error occurred:\\n%s\\n\", lasterr ());');\n\ - @print{} This error occurred:\n\ - This is a bad example\n\ -@end group\n\ -@end example\n\ -\n\ -Consider using try/catch blocks instead if you are only using @code{eval}\n\ -as an error-capturing mechanism rather than for the execution of arbitrary\n\ -code strings.\n\ -@seealso{evalin}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - { - unwind_protect frame; - - if (nargin > 1) - { - frame.protect_var (buffer_error_messages); - buffer_error_messages++; - } - - int parse_status = 0; - - octave_value_list tmp = eval_string (args(0), nargout > 0, - parse_status, nargout); - - if (nargin > 1 && (parse_status != 0 || error_state)) - { - error_state = 0; - - // Set up for letting the user print any messages from - // errors that occurred in the first part of this eval(). - - buffer_error_messages--; - - tmp = eval_string (args(1), nargout > 0, parse_status, nargout); - - if (nargout > 0) - retval = tmp; - } - else if (nargout > 0) - retval = tmp; - } - else - print_usage (); - - return retval; -} - -/* - -%!shared x -%! x = 1; - -%!assert (eval ("x"), 1) -%!assert (eval ("x;")) -%!assert (eval ("x;"), 1); - -%!test -%! y = eval ("x"); -%! assert (y, 1); - -%!test -%! y = eval ("x;"); -%! assert (y, 1); - -%!test -%! eval ("x = 1;") -%! assert (x,1); - -%!test -%! eval ("flipud = 2;"); -%! assert (flipud, 2); - -%!function y = __f () -%! eval ("flipud = 2;"); -%! y = flipud; -%!endfunction -%!assert (__f(), 2) - -% bug #35645 -%!test -%! [a,] = gcd (1,2); -%! [a,b,] = gcd (1, 2); - -*/ - -DEFUN (assignin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} assignin (@var{context}, @var{varname}, @var{value})\n\ -Assign @var{value} to @var{varname} in context @var{context}, which\n\ -may be either @code{\"base\"} or @code{\"caller\"}.\n\ -@seealso{evalin}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 3) - { - std::string context = args(0).string_value (); - - if (! error_state) - { - unwind_protect frame; - - if (context == "caller") - octave_call_stack::goto_caller_frame (); - else if (context == "base") - octave_call_stack::goto_base_frame (); - else - error ("assignin: CONTEXT must be \"caller\" or \"base\""); - - if (! error_state) - { - frame.add_fcn (octave_call_stack::pop); - - std::string nm = args(1).string_value (); - - if (! error_state) - { - if (valid_identifier (nm)) - symbol_table::varref (nm) = args(2); - else - error ("assignin: invalid variable name in argument VARNAME"); - } - else - error ("assignin: VARNAME must be a string"); - } - } - else - error ("assignin: CONTEXT must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (evalin, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} evalin (@var{context}, @var{try})\n\ -@deftypefnx {Built-in Function} {} evalin (@var{context}, @var{try}, @var{catch})\n\ -Like @code{eval}, except that the expressions are evaluated in the\n\ -context @var{context}, which may be either @code{\"caller\"} or\n\ -@code{\"base\"}.\n\ -@seealso{eval, assignin}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 1) - { - std::string context = args(0).string_value (); - - if (! error_state) - { - unwind_protect frame; - - if (context == "caller") - octave_call_stack::goto_caller_frame (); - else if (context == "base") - octave_call_stack::goto_base_frame (); - else - error ("evalin: CONTEXT must be \"caller\" or \"base\""); - - if (! error_state) - { - frame.add_fcn (octave_call_stack::pop); - - if (nargin > 2) - { - frame.protect_var (buffer_error_messages); - buffer_error_messages++; - } - - int parse_status = 0; - - octave_value_list tmp = eval_string (args(1), nargout > 0, - parse_status, nargout); - - if (nargout > 0) - retval = tmp; - - if (nargin > 2 && (parse_status != 0 || error_state)) - { - error_state = 0; - - // Set up for letting the user print any messages from - // errors that occurred in the first part of this eval(). - - buffer_error_messages--; - - tmp = eval_string (args(2), nargout > 0, - parse_status, nargout); - - retval = (nargout > 0) ? tmp : octave_value_list (); - } - } - } - else - error ("evalin: CONTEXT must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__parser_debug_flag__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{old_val} =} __parser_debug_flag__ (@var{new_val}))\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - bool debug_flag = octave_debug; - - retval = set_internal_variable (debug_flag, args, nargout, - "__parser_debug_flag__"); - - octave_debug = debug_flag; - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/octave-value/module.mk --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/module.mk Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,126 @@ +EXTRA_DIST += \ + octave-value/module.mk + +OV_INTTYPE_INCLUDES = \ + octave-value/ov-base-int.h \ + octave-value/ov-base-int.cc \ + octave-value/ov-int-traits.h \ + octave-value/ov-int16.h \ + octave-value/ov-int32.h \ + octave-value/ov-int64.h \ + octave-value/ov-int8.h \ + octave-value/ov-intx.h \ + octave-value/ov-uint16.h \ + octave-value/ov-uint32.h \ + octave-value/ov-uint64.h \ + octave-value/ov-uint8.h + +OV_SPARSE_INCLUDES = \ + octave-value/ov-base-sparse.h \ + octave-value/ov-bool-sparse.h \ + octave-value/ov-cx-sparse.h \ + octave-value/ov-re-sparse.h + +OV_INCLUDES = \ + octave-value/ov-base-diag.h \ + octave-value/ov-base-diag.cc \ + octave-value/ov-base-mat.h \ + octave-value/ov-base-mat.cc \ + octave-value/ov-base-scalar.h \ + octave-value/ov-base-scalar.cc \ + octave-value/ov-base.h \ + octave-value/ov-bool-mat.h \ + octave-value/ov-bool-mat.cc \ + octave-value/ov-bool.h \ + octave-value/ov-builtin.h \ + octave-value/ov-cell.h \ + octave-value/ov-ch-mat.h \ + octave-value/ov-class.h \ + octave-value/ov-colon.h \ + octave-value/ov-complex.h \ + octave-value/ov-cs-list.h \ + octave-value/ov-cx-diag.h \ + octave-value/ov-cx-mat.h \ + octave-value/ov-dld-fcn.h \ + octave-value/ov-fcn-handle.h \ + octave-value/ov-fcn-inline.h \ + octave-value/ov-fcn.h \ + octave-value/ov-float.h \ + octave-value/ov-flt-complex.h \ + octave-value/ov-flt-cx-diag.h \ + octave-value/ov-flt-cx-mat.h \ + octave-value/ov-flt-re-diag.h \ + octave-value/ov-flt-re-mat.h \ + octave-value/ov-lazy-idx.h \ + octave-value/ov-mex-fcn.h \ + octave-value/ov-null-mat.h \ + octave-value/ov-oncleanup.h \ + octave-value/ov-perm.h \ + octave-value/ov-range.h \ + octave-value/ov-re-diag.h \ + octave-value/ov-re-mat.h \ + octave-value/ov-scalar.h \ + octave-value/ov-str-mat.h \ + octave-value/ov-struct.h \ + octave-value/ov-type-conv.h \ + octave-value/ov-typeinfo.h \ + octave-value/ov-usr-fcn.h \ + octave-value/ov.h \ + $(OV_INTTYPE_INCLUDES) + +OV_INTTYPE_SRC = \ + octave-value/ov-int16.cc \ + octave-value/ov-int32.cc \ + octave-value/ov-int64.cc \ + octave-value/ov-int8.cc \ + octave-value/ov-uint16.cc \ + octave-value/ov-uint32.cc \ + octave-value/ov-uint64.cc \ + octave-value/ov-uint8.cc + +OV_SPARSE_SRC = \ + octave-value/ov-base-sparse.cc \ + octave-value/ov-bool-sparse.cc \ + octave-value/ov-cx-sparse.cc \ + octave-value/ov-re-sparse.cc + +OCTAVE_VALUE_SRC = \ + octave-value/ov-base.cc \ + octave-value/ov-bool-mat.cc \ + octave-value/ov-bool.cc \ + octave-value/ov-builtin.cc \ + octave-value/ov-cell.cc \ + octave-value/ov-ch-mat.cc \ + octave-value/ov-class.cc \ + octave-value/ov-colon.cc \ + octave-value/ov-complex.cc \ + octave-value/ov-cs-list.cc \ + octave-value/ov-cx-diag.cc \ + octave-value/ov-cx-mat.cc \ + octave-value/ov-dld-fcn.cc \ + octave-value/ov-fcn-handle.cc \ + octave-value/ov-fcn-inline.cc \ + octave-value/ov-fcn.cc \ + octave-value/ov-float.cc \ + octave-value/ov-flt-complex.cc \ + octave-value/ov-flt-cx-diag.cc \ + octave-value/ov-flt-cx-mat.cc \ + octave-value/ov-flt-re-diag.cc \ + octave-value/ov-flt-re-mat.cc \ + octave-value/ov-lazy-idx.cc \ + octave-value/ov-mex-fcn.cc \ + octave-value/ov-null-mat.cc \ + octave-value/ov-oncleanup.cc \ + octave-value/ov-perm.cc \ + octave-value/ov-range.cc \ + octave-value/ov-re-diag.cc \ + octave-value/ov-re-mat.cc \ + octave-value/ov-scalar.cc \ + octave-value/ov-str-mat.cc \ + octave-value/ov-struct.cc \ + octave-value/ov-typeinfo.cc \ + octave-value/ov-usr-fcn.cc \ + octave-value/ov.cc \ + $(OV_INTTYPE_SRC) \ + $(OV_SPARSE_SRC) + diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base-diag.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base-diag.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,506 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "mach-info.h" +#include "lo-ieee.h" + +#include "ov-base.h" +#include "ov-base-mat.h" +#include "pr-output.h" +#include "error.h" +#include "gripes.h" +#include "oct-stream.h" +#include "ops.h" + +#include "ls-oct-ascii.h" + +template +octave_value +octave_base_diag::subsref (const std::string& type, + const std::list& idx) +{ + octave_value retval; + + switch (type[0]) + { + case '(': + retval = do_index_op (idx.front ()); + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + return retval.next_subsref (type, idx); +} + +template +octave_value +octave_base_diag::do_index_op (const octave_value_list& idx, + bool resize_ok) +{ + octave_value retval; + typedef typename DMT::element_type el_type; + + if (idx.length () == 2 && ! resize_ok) + { + idx_vector idx0 = idx(0).index_vector (); + idx_vector idx1 = idx(1).index_vector (); + + if (idx0.is_scalar () && idx1.is_scalar ()) + { + retval = matrix.elem (idx0(0), idx1(0)); + } + else + { + octave_idx_type m = idx0.length (matrix.rows ()); + octave_idx_type n = idx1.length (matrix.columns ()); + if (idx0.is_colon_equiv (m) && idx1.is_colon_equiv (n) + && m <= matrix.rows () && n <= matrix.rows ()) + { + DMT rm (matrix); + rm.resize (m, n); + retval = rm; + } + else + retval = to_dense ().do_index_op (idx, resize_ok); + } + } + else + retval = to_dense ().do_index_op (idx, resize_ok); + + return retval; +} + +template +octave_value +octave_base_diag::subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + octave_value retval; + + switch (type[0]) + { + case '(': + { + if (type.length () == 1) + { + octave_value_list jdx = idx.front (); + // Check for a simple element assignment. That means, if D is a diagonal matrix, + // `D(i,i) = x' will not destroy its diagonality (provided i is a valid index). + if (jdx.length () == 2 && jdx(0).is_scalar_type () && jdx(1).is_scalar_type ()) + { + typename DMT::element_type val; + idx_vector i0 = jdx(0).index_vector (), i1 = jdx(1).index_vector (); + if (! error_state && i0(0) == i1(0) + && i0(0) < matrix.rows () && i1(0) < matrix.cols () + && chk_valid_scalar (rhs, val)) + { + matrix.dgelem (i0(0)) = val; + retval = this; + this->count++; + // invalidate cache + dense_cache = octave_value (); + } + } + + if (! error_state && ! retval.is_defined ()) + retval = numeric_assign (type, idx, rhs); + } + else + { + std::string nm = type_name (); + error ("in indexed assignment of %s, last lhs index must be ()", + nm.c_str ()); + } + } + break; + + case '{': + case '.': + { + if (is_empty ()) + { + octave_value tmp = octave_value::empty_conv (type, rhs); + + retval = tmp.subsasgn (type, idx, rhs); + } + else + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + } + break; + + default: + panic_impossible (); + } + + return retval; +} + +template +octave_value +octave_base_diag::resize (const dim_vector& dv, bool fill) const +{ + octave_value retval; + if (dv.length () == 2) + { + DMT rm (matrix); + rm.resize (dv(0), dv(1)); + retval = rm; + } + else + retval = to_dense ().resize (dv, fill); + return retval; +} + +template +bool +octave_base_diag::is_true (void) const +{ + return to_dense ().is_true (); +} + +// FIXME: this should be achieveable using ::real +template inline T helper_getreal (T x) { return x; } +template inline T helper_getreal (std::complex x) { return x.real (); } +// FIXME: we really need some traits so that ad hoc hooks like this are not necessary +template inline T helper_iscomplex (T) { return false; } +template inline T helper_iscomplex (std::complex) { return true; } + +template +double +octave_base_diag::double_value (bool force_conversion) const +{ + double retval = lo_ieee_nan_value (); + typedef typename DMT::element_type el_type; + + if (helper_iscomplex (el_type ()) && ! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real scalar"); + + if (numel () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + type_name (), "real scalar"); + + retval = helper_getreal (el_type (matrix (0, 0))); + } + else + gripe_invalid_conversion (type_name (), "real scalar"); + + return retval; +} + +template +float +octave_base_diag::float_value (bool force_conversion) const +{ + float retval = lo_ieee_float_nan_value (); + typedef typename DMT::element_type el_type; + + if (helper_iscomplex (el_type ()) && ! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real scalar"); + + if (numel () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + type_name (), "real scalar"); + + retval = helper_getreal (el_type (matrix (0, 0))); + } + else + gripe_invalid_conversion (type_name (), "real scalar"); + + return retval; +} + +template +Complex +octave_base_diag::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + type_name (), "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion (type_name (), "complex scalar"); + + return retval; +} + +template +FloatComplex +octave_base_diag::float_complex_value (bool) const +{ + float tmp = lo_ieee_float_nan_value (); + + FloatComplex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + type_name (), "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion (type_name (), "complex scalar"); + + return retval; +} + +template +Matrix +octave_base_diag::matrix_value (bool) const +{ + return Matrix (diag_matrix_value ()); +} + +template +FloatMatrix +octave_base_diag::float_matrix_value (bool) const +{ + return FloatMatrix (float_diag_matrix_value ()); +} + +template +ComplexMatrix +octave_base_diag::complex_matrix_value (bool) const +{ + return ComplexMatrix (complex_diag_matrix_value ()); +} + +template +FloatComplexMatrix +octave_base_diag::float_complex_matrix_value (bool) const +{ + return FloatComplexMatrix (float_complex_diag_matrix_value ()); +} + +template +NDArray +octave_base_diag::array_value (bool) const +{ + return NDArray (matrix_value ()); +} + +template +FloatNDArray +octave_base_diag::float_array_value (bool) const +{ + return FloatNDArray (float_matrix_value ()); +} + +template +ComplexNDArray +octave_base_diag::complex_array_value (bool) const +{ + return ComplexNDArray (complex_matrix_value ()); +} + +template +FloatComplexNDArray +octave_base_diag::float_complex_array_value (bool) const +{ + return FloatComplexNDArray (float_complex_matrix_value ()); +} + +template +boolNDArray +octave_base_diag::bool_array_value (bool warn) const +{ + return to_dense ().bool_array_value (warn); +} + +template +charNDArray +octave_base_diag::char_array_value (bool warn) const +{ + return to_dense ().char_array_value (warn); +} + +template +SparseMatrix +octave_base_diag::sparse_matrix_value (bool) const +{ + return SparseMatrix (diag_matrix_value ()); +} + +template +SparseComplexMatrix +octave_base_diag::sparse_complex_matrix_value (bool) const +{ + return SparseComplexMatrix (complex_diag_matrix_value ()); +} + +template +idx_vector +octave_base_diag::index_vector (void) const +{ + return to_dense ().index_vector (); +} + +template +octave_value +octave_base_diag::convert_to_str_internal (bool pad, bool force, char type) const +{ + return to_dense ().convert_to_str_internal (pad, force, type); +} + +template +bool +octave_base_diag::save_ascii (std::ostream& os) +{ + os << "# rows: " << matrix.rows () << "\n" + << "# columns: " << matrix.columns () << "\n"; + + os << matrix.diag (); + + return true; +} + +template +bool +octave_base_diag::load_ascii (std::istream& is) +{ + octave_idx_type r = 0, c = 0; + bool success = true; + + if (extract_keyword (is, "rows", r, true) + && extract_keyword (is, "columns", c, true)) + { + octave_idx_type l = r < c ? r : c; + MT tmp (l, 1); + is >> tmp; + + if (!is) + { + error ("load: failed to load diagonal matrix constant"); + success = false; + } + else + { + // This is a little tricky, as we have the Matrix type, but + // not ColumnVector type. We need to help the compiler get + // through the inheritance tree. + typedef typename DMT::element_type el_type; + matrix = DMT (MDiagArray2 (MArray (tmp))); + matrix.resize (r, c); + + // Invalidate cache. Probably not necessary, but safe. + dense_cache = octave_value (); + } + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + + return success; +} + +template +void +octave_base_diag::print_raw (std::ostream& os, + bool pr_as_read_syntax) const +{ + return octave_print_internal (os, matrix, pr_as_read_syntax, + current_print_indent_level ()); +} + +template +mxArray * +octave_base_diag::as_mxArray (void) const +{ + return to_dense ().as_mxArray (); +} + +template +bool +octave_base_diag::print_as_scalar (void) const +{ + dim_vector dv = dims (); + + return (dv.all_ones () || dv.any_zero ()); +} + +template +void +octave_base_diag::print (std::ostream& os, bool pr_as_read_syntax) const +{ + print_raw (os, pr_as_read_syntax); + newline (os); +} +template +int +octave_base_diag::write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const +{ + return to_dense ().write (os, block_size, output_type, skip, flt_fmt); +} + +template +void +octave_base_diag::print_info (std::ostream& os, + const std::string& prefix) const +{ + matrix.print_info (os, prefix); +} + +template +octave_value +octave_base_diag::to_dense (void) const +{ + if (! dense_cache.is_defined ()) + dense_cache = MT (matrix); + + return dense_cache; +} + diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base-diag.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base-diag.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,226 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_base_diag_h) +#define octave_base_diag_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "str-vec.h" + +#include "oct-obj.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class tree_walker; + +// Real matrix values. + +template +class +octave_base_diag : public octave_base_value +{ + +public: + + octave_base_diag (void) + : octave_base_value (), matrix (), dense_cache () { } + + octave_base_diag (const DMT& m) + : octave_base_value (), matrix (m), dense_cache () + { } + + octave_base_diag (const octave_base_diag& m) + : octave_base_value (), matrix (m.matrix), dense_cache () { } + + ~octave_base_diag (void) { } + + size_t byte_size (void) const { return matrix.byte_size (); } + + octave_value squeeze (void) const { return matrix; } + + octave_value full_value (void) const { return to_dense (); } + + octave_value subsref (const std::string& type, + const std::list& idx); + + octave_value_list subsref (const std::string& type, + const std::list& idx, int) + { return subsref (type, idx); } + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + octave_value subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + dim_vector dims (void) const { return matrix.dims (); } + + octave_idx_type nnz (void) const { return to_dense ().nnz (); } + + octave_value reshape (const dim_vector& new_dims) const + { return to_dense ().reshape (new_dims); } + + octave_value permute (const Array& vec, bool inv = false) const + { return to_dense ().permute (vec, inv); } + + octave_value resize (const dim_vector& dv, bool fill = false) const; + + octave_value all (int dim = 0) const { return MT (matrix).all (dim); } + octave_value any (int dim = 0) const { return MT (matrix).any (dim); } + + MatrixType matrix_type (void) const { return MatrixType::Diagonal; } + MatrixType matrix_type (const MatrixType&) const + { return matrix_type (); } + + octave_value diag (octave_idx_type k = 0) const + { return octave_value (matrix.diag (k)); } + + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const + { return to_dense ().sort (dim, mode); } + octave_value sort (Array &sidx, octave_idx_type dim = 0, + sortmode mode = ASCENDING) const + { return to_dense ().sort (sidx, dim, mode); } + + sortmode is_sorted (sortmode mode = UNSORTED) const + { return to_dense ().is_sorted (mode); } + + Array sort_rows_idx (sortmode mode = ASCENDING) const + { return to_dense ().sort_rows_idx (mode); } + + sortmode is_sorted_rows (sortmode mode = UNSORTED) const + { return to_dense ().is_sorted_rows (mode); } + + bool is_matrix_type (void) const { return true; } + + bool is_numeric_type (void) const { return true; } + + bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + + bool is_true (void) const; + + bool is_diag_matrix (void) const { return true; } + + double double_value (bool = false) const; + + float float_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + idx_vector index_vector (void) const; + + Matrix matrix_value (bool = false) const; + + FloatMatrix float_matrix_value (bool = false) const; + + Complex complex_value (bool = false) const; + + FloatComplex float_complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + FloatComplexMatrix float_complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const; + + FloatComplexNDArray float_complex_array_value (bool = false) const; + + boolNDArray bool_array_value (bool warn = false) const; + + charNDArray char_array_value (bool = false) const; + + NDArray array_value (bool = false) const; + + FloatNDArray float_array_value (bool = false) const; + + SparseMatrix sparse_matrix_value (bool = false) const; + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; + + int8NDArray + int8_array_value (void) const { return to_dense ().int8_array_value (); } + + int16NDArray + int16_array_value (void) const { return to_dense ().int16_array_value (); } + + int32NDArray + int32_array_value (void) const { return to_dense ().int32_array_value (); } + + int64NDArray + int64_array_value (void) const { return to_dense ().int64_array_value (); } + + uint8NDArray + uint8_array_value (void) const { return to_dense ().uint8_array_value (); } + + uint16NDArray + uint16_array_value (void) const { return to_dense ().uint16_array_value (); } + + uint32NDArray + uint32_array_value (void) const { return to_dense ().uint32_array_value (); } + + uint64NDArray + uint64_array_value (void) const { return to_dense ().uint64_array_value (); } + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const; + + mxArray *as_mxArray (void) const; + + bool print_as_scalar (void) const; + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_info (std::ostream& os, const std::string& prefix) const; + +protected: + + DMT matrix; + + octave_value to_dense (void) const; + + virtual bool chk_valid_scalar (const octave_value&, + typename DMT::element_type&) const = 0; + +private: + + mutable octave_value dense_cache; + +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base-int.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base-int.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,608 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "lo-ieee.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "quit.h" +#include "oct-locbuf.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "oct-stream.h" +#include "ops.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-base-mat.cc" +#include "ov-base-scalar.h" +#include "ov-base-scalar.cc" +#include "ov-base-int.h" +#include "ov-int-traits.h" +#include "pr-output.h" +#include "variables.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +// We have all the machinery below (octave_base_int_helper and +// octave_base_int_helper_traits) to avoid a few warnings from GCC +// about comparisons always false due to limited range of data types. +// Ugh. The cure may be worse than the disease. + +template +struct octave_base_int_helper +{ + static bool + char_value_out_of_range (T val) { return val < 0 || val > UCHAR_MAX; } +}; + +template +struct octave_base_int_helper +{ + static bool char_value_out_of_range (T) { return false; } +}; + +template +struct octave_base_int_helper +{ + static bool char_value_out_of_range (T val) { return val > UCHAR_MAX; } +}; + +template +struct octave_base_int_helper +{ + static bool char_value_out_of_range (T val) { return val < 0; } +}; + +// For all types other than char, signed char, and unsigned char, we +// assume that the upper limit for the range of allowable values is +// larger than the range for unsigned char. If that's not true, we +// are still OK, but will see the warnings again for any other types +// that do not meet this assumption. + +template +struct octave_base_int_helper_traits +{ + static const bool can_be_larger_than_uchar_max = true; +}; + +template <> +struct octave_base_int_helper_traits +{ + static const bool can_be_larger_than_uchar_max = false; +}; + +template <> +struct octave_base_int_helper_traits +{ + static const bool can_be_larger_than_uchar_max = false; +}; + +template <> +struct octave_base_int_helper_traits +{ + static const bool can_be_larger_than_uchar_max = false; +}; + + +template +octave_base_value * +octave_base_int_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (this->matrix.nelem () == 1) + retval = new typename octave_value_int_traits::scalar_type (this->matrix (0)); + + return retval; +} + +template +octave_value +octave_base_int_matrix::convert_to_str_internal (bool, bool, char type) const +{ + octave_value retval; + dim_vector dv = this->dims (); + octave_idx_type nel = dv.numel (); + + charNDArray chm (dv); + + bool warned = false; + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_quit (); + + typename T::element_type tmp = this->matrix(i); + + typedef typename T::element_type::val_type val_type; + + val_type ival = tmp.value (); + + static const bool is_signed = std::numeric_limits::is_signed; + static const bool can_be_larger_than_uchar_max + = octave_base_int_helper_traits::can_be_larger_than_uchar_max; + + if (octave_base_int_helper::char_value_out_of_range (ival)) + { + // FIXME -- is there something better we could do? + + ival = 0; + + if (! warned) + { + ::warning ("range error for conversion to character value"); + warned = true; + } + } + else + chm (i) = static_cast (ival); + } + + retval = octave_value (chm, type); + + return retval; +} + +template +bool +octave_base_int_matrix::save_ascii (std::ostream& os) +{ + dim_vector d = this->dims (); + + os << "# ndims: " << d.length () << "\n"; + + for (int i = 0; i < d.length (); i++) + os << " " << d (i); + + os << "\n" << this->matrix; + + return true; +} + +template +bool +octave_base_int_matrix::load_ascii (std::istream& is) +{ + int mdims = 0; + bool success = true; + + if (extract_keyword (is, "ndims", mdims, true)) + { + if (mdims >= 0) + { + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + is >> dv(i); + + T tmp(dv); + + is >> tmp; + + if (!is) + { + error ("load: failed to load matrix constant"); + success = false; + } + + this->matrix = tmp; + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + } + else + error ("load: failed to extract number of dimensions"); + + return success; +} + +template +bool +octave_base_int_matrix::save_binary (std::ostream& os, bool&) +{ + dim_vector d = this->dims (); + if (d.length () < 1) + return false; + + // Use negative value for ndims to differentiate with old format!! + int32_t tmp = - d.length (); + os.write (reinterpret_cast (&tmp), 4); + for (int i=0; i < d.length (); i++) + { + tmp = d(i); + os.write (reinterpret_cast (&tmp), 4); + } + + os.write (reinterpret_cast (this->matrix.data ()), this->byte_size ()); + + return true; +} + +template +bool +octave_base_int_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format ) +{ + int32_t mdims; + if (! is.read (reinterpret_cast (&mdims), 4)) + return false; + if (swap) + swap_bytes<4> (&mdims); + if (mdims >= 0) + return false; + + mdims = - mdims; + int32_t di; + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + { + if (! is.read (reinterpret_cast (&di), 4)) + return false; + if (swap) + swap_bytes<4> (&di); + dv(i) = di; + } + + // Convert an array with a single dimension to be a row vector. + // Octave should never write files like this, other software + // might. + + if (mdims == 1) + { + mdims = 2; + dv.resize (mdims); + dv(1) = dv(0); + dv(0) = 1; + } + + T m (dv); + + if (! is.read (reinterpret_cast (m.fortran_vec ()), m.byte_size ())) + return false; + + if (swap) + { + int nel = dv.numel (); + int bytes = nel / m.byte_size (); + for (int i = 0; i < nel; i++) + switch (bytes) + { + case 8: + swap_bytes<8> (&m(i)); + break; + case 4: + swap_bytes<4> (&m(i)); + break; + case 2: + swap_bytes<2> (&m(i)); + break; + case 1: + default: + break; + } + } + + this->matrix = m; + return true; +} + +#if defined (HAVE_HDF5) + +template +bool +octave_base_int_matrix::save_hdf5 (hid_t loc_id, const char *name, bool) +{ + hid_t save_type_hid = HDF5_SAVE_TYPE; + bool retval = true; + dim_vector dv = this->dims (); + int empty = save_hdf5_empty (loc_id, name, dv); + if (empty) + return (empty > 0); + + int rank = dv.length (); + hid_t space_hid = -1, data_hid = -1; + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + + // Octave uses column-major, while HDF5 uses row-major ordering + for (int i = 0; i < rank; i++) + hdims[i] = dv (rank-i-1); + + space_hid = H5Screate_simple (rank, hdims, 0); + + if (space_hid < 0) return false; +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + return false; + } + + retval = H5Dwrite (data_hid, save_type_hid, H5S_ALL, H5S_ALL, + H5P_DEFAULT, this->matrix.data ()) >= 0; + + H5Dclose (data_hid); + H5Sclose (space_hid); + + return retval; +} + +template +bool +octave_base_int_matrix::load_hdf5 (hid_t loc_id, const char *name) +{ + hid_t save_type_hid = HDF5_SAVE_TYPE; + bool retval = false; + dim_vector dv; + int empty = load_hdf5_empty (loc_id, name, dv); + if (empty > 0) + this->matrix.resize (dv); + if (empty) + return (empty > 0); + +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t space_id = H5Dget_space (data_hid); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank < 1) + { + H5Sclose (space_id); + H5Dclose (data_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_id, hdims, maxdims); + + // Octave uses column-major, while HDF5 uses row-major ordering + if (rank == 1) + { + dv.resize (2); + dv(0) = 1; + dv(1) = hdims[0]; + } + else + { + dv.resize (rank); + for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) + dv(j) = hdims[i]; + } + + T m (dv); + if (H5Dread (data_hid, save_type_hid, H5S_ALL, H5S_ALL, + H5P_DEFAULT, m.fortran_vec ()) >= 0) + { + retval = true; + this->matrix = m; + } + + H5Sclose (space_id); + H5Dclose (data_hid); + + return retval; +} + +#endif + +template +void +octave_base_int_matrix::print_raw (std::ostream& os, + bool pr_as_read_syntax) const +{ + octave_print_internal (os, this->matrix, pr_as_read_syntax, + this->current_print_indent_level ()); +} + +template +octave_value +octave_base_int_scalar::convert_to_str_internal (bool, bool, char type) const +{ + octave_value retval; + + T tmp = this->scalar; + + typedef typename T::val_type val_type; + + val_type ival = tmp.value (); + + static const bool is_signed = std::numeric_limits::is_signed; + static const bool can_be_larger_than_uchar_max + = octave_base_int_helper_traits::can_be_larger_than_uchar_max; + + if (octave_base_int_helper::char_value_out_of_range (ival)) + { + // FIXME -- is there something better we could do? + + ival = 0; + + ::warning ("range error for conversion to character value"); + } + else + retval = octave_value (std::string (1, static_cast (ival)), type); + + return retval; +} + +template +bool +octave_base_int_scalar::save_ascii (std::ostream& os) +{ + os << this->scalar << "\n"; + return true; +} + +template +bool +octave_base_int_scalar::load_ascii (std::istream& is) +{ + is >> this->scalar; + if (!is) + { + error ("load: failed to load scalar constant"); + return false; + } + return true; +} + +template +bool +octave_base_int_scalar::save_binary (std::ostream& os, bool&) +{ + os.write (reinterpret_cast (&(this->scalar)), this->byte_size ()); + return true; +} + +template +bool +octave_base_int_scalar::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format) +{ + T tmp; + if (! is.read (reinterpret_cast (&tmp), this->byte_size ())) + return false; + + if (swap) + switch (this->byte_size ()) + { + case 8: + swap_bytes<8> (&tmp); + break; + case 4: + swap_bytes<4> (&tmp); + break; + case 2: + swap_bytes<2> (&tmp); + break; + case 1: + default: + break; + } + this->scalar = tmp; + return true; +} + +#if defined (HAVE_HDF5) + +template +bool +octave_base_int_scalar::save_hdf5 (hid_t loc_id, const char *name, bool) +{ + hid_t save_type_hid = HDF5_SAVE_TYPE; + bool retval = true; + hsize_t dimens[3]; + hid_t space_hid = -1, data_hid = -1; + + space_hid = H5Screate_simple (0, dimens, 0); + if (space_hid < 0) return false; + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + return false; + } + + retval = H5Dwrite (data_hid, save_type_hid, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &(this->scalar)) >= 0; + + H5Dclose (data_hid); + H5Sclose (space_hid); + + return retval; +} + +template +bool +octave_base_int_scalar::load_hdf5 (hid_t loc_id, const char *name) +{ + hid_t save_type_hid = HDF5_SAVE_TYPE; +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t space_id = H5Dget_space (data_hid); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank != 0) + { + H5Dclose (data_hid); + return false; + } + + T tmp; + if (H5Dread (data_hid, save_type_hid, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &tmp) < 0) + { + H5Dclose (data_hid); + return false; + } + + this->scalar = tmp; + + H5Dclose (data_hid); + + return true; +} + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base-int.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base-int.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,129 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_base_int_matrix_h) +#define octave_base_int_matrix_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "error.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-base-scalar.h" +#include "ov-typeinfo.h" + +// base int matrix values. + +template +class +octave_base_int_matrix : public octave_base_matrix +{ +public: + + octave_base_int_matrix (void) : octave_base_matrix () { } + + octave_base_int_matrix (const T& nda) : octave_base_matrix (nda) { } + + ~octave_base_int_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_base_int_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_base_int_matrix (); } + + octave_base_value *try_narrowing_conversion (void); + + bool is_real_type (void) const { return true; } + + // void increment (void) { matrix += 1; } + + // void decrement (void) { matrix -= 1; } + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + octave_value convert_to_str_internal (bool, bool, char type) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& ); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format ); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif +}; + +// base int scalar values. + +template +class +octave_base_int_scalar : public octave_base_scalar +{ +public: + + octave_base_int_scalar (void) : octave_base_scalar () { } + + octave_base_int_scalar (const T& s) : octave_base_scalar (s) { } + + ~octave_base_int_scalar (void) { } + + octave_base_value *clone (void) const { return new octave_base_int_scalar (*this); } + octave_base_value *empty_clone (void) const { return new octave_base_int_scalar (); } + + octave_base_value *try_narrowing_conversion (void) { return 0; } + + bool is_real_type (void) const { return true; } + + // void increment (void) { scalar += 1; } + + // void decrement (void) { scalar -= 1; } + + octave_value convert_to_str_internal (bool, bool, char type) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& ); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format ); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool ); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base-mat.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base-mat.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,482 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "Cell.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-base-scalar.h" +#include "pr-output.h" + +template +octave_value +octave_base_matrix::subsref (const std::string& type, + const std::list& idx) +{ + octave_value retval; + + switch (type[0]) + { + case '(': + retval = do_index_op (idx.front ()); + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + return retval.next_subsref (type, idx); +} + +template +octave_value +octave_base_matrix::subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + octave_value retval; + + switch (type[0]) + { + case '(': + { + if (type.length () == 1) + retval = numeric_assign (type, idx, rhs); + else if (is_empty ()) + { + // Allow conversion of empty matrix to some other type in + // cases like + // + // x = []; x(i).f = rhs + + if (type[1] == '.') + { + octave_value tmp = octave_value::empty_conv (type, rhs); + + retval = tmp.subsasgn (type, idx, rhs); + } + else + error ("invalid assignment expression"); + } + else + { + std::string nm = type_name (); + error ("in indexed assignment of %s, last lhs index must be ()", + nm.c_str ()); + } + } + break; + + case '{': + case '.': + { + if (is_empty ()) + { + octave_value tmp = octave_value::empty_conv (type, rhs); + + retval = tmp.subsasgn (type, idx, rhs); + } + else + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + } + break; + + default: + panic_impossible (); + } + + return retval; +} + +template +octave_value +octave_base_matrix::do_index_op (const octave_value_list& idx, + bool resize_ok) +{ + octave_value retval; + + octave_idx_type n_idx = idx.length (); + + int nd = matrix.ndims (); + const MT& cmatrix = matrix; + + switch (n_idx) + { + case 0: + retval = matrix; + break; + + case 1: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + { + // optimize single scalar index. + if (! resize_ok && i.is_scalar ()) + retval = cmatrix.checkelem (i(0)); + else + retval = MT (matrix.index (i, resize_ok)); + } + } + break; + + case 2: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + { + idx_vector j = idx (1).index_vector (); + + if (! error_state) + { + // optimize two scalar indices. + if (! resize_ok && i.is_scalar () && j.is_scalar ()) + retval = cmatrix.checkelem (i(0), j(0)); + else + retval = MT (matrix.index (i, j, resize_ok)); + } + } + } + break; + + default: + { + Array idx_vec (dim_vector (n_idx, 1)); + bool scalar_opt = n_idx == nd && ! resize_ok; + const dim_vector dv = matrix.dims (); + + for (octave_idx_type i = 0; i < n_idx; i++) + { + idx_vec(i) = idx(i).index_vector (); + + if (error_state) + break; + + scalar_opt = (scalar_opt && idx_vec(i).is_scalar ()); + } + + if (! error_state) + { + if (scalar_opt) + retval = cmatrix.checkelem (conv_to_int_array (idx_vec)); + else + retval = MT (matrix.index (idx_vec, resize_ok)); + } + } + break; + } + + return retval; +} + +template +void +octave_base_matrix::assign (const octave_value_list& idx, const MT& rhs) +{ + octave_idx_type n_idx = idx.length (); + + switch (n_idx) + { + case 0: + panic_impossible (); + break; + + case 1: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + matrix.assign (i, rhs); + } + break; + + case 2: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + { + idx_vector j = idx (1).index_vector (); + + if (! error_state) + matrix.assign (i, j, rhs); + } + } + break; + + default: + { + Array idx_vec (dim_vector (n_idx, 1)); + + for (octave_idx_type i = 0; i < n_idx; i++) + { + idx_vec(i) = idx(i).index_vector (); + + if (error_state) + break; + } + + if (! error_state) + matrix.assign (idx_vec, rhs); + } + break; + } + + // Clear cache. + clear_cached_info (); +} + +template +MatrixType +octave_base_matrix::matrix_type (const MatrixType& _typ) const +{ + delete typ; + typ = new MatrixType (_typ); + return *typ; +} + +template +void +octave_base_matrix::assign (const octave_value_list& idx, + typename MT::element_type rhs) +{ + octave_idx_type n_idx = idx.length (); + + int nd = matrix.ndims (); + + MT mrhs (dim_vector (1, 1), rhs); + + switch (n_idx) + { + case 0: + panic_impossible (); + break; + + case 1: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + { + // optimize single scalar index. + if (i.is_scalar () && i(0) < matrix.numel ()) + matrix(i(0)) = rhs; + else + matrix.assign (i, mrhs); + } + } + break; + + case 2: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + { + idx_vector j = idx (1).index_vector (); + + if (! error_state) + { + // optimize two scalar indices. + if (i.is_scalar () && j.is_scalar () && nd == 2 + && i(0) < matrix.rows () && j(0) < matrix.columns ()) + matrix(i(0), j(0)) = rhs; + else + matrix.assign (i, j, mrhs); + } + } + } + break; + + default: + { + Array idx_vec (dim_vector (n_idx, 1)); + bool scalar_opt = n_idx == nd; + const dim_vector dv = matrix.dims ().redim (n_idx); + + for (octave_idx_type i = 0; i < n_idx; i++) + { + idx_vec(i) = idx(i).index_vector (); + + if (error_state) + break; + + scalar_opt = (scalar_opt && idx_vec(i).is_scalar () + && idx_vec(i)(0) < dv(i)); + } + + if (! error_state) + { + if (scalar_opt) + { + // optimize all scalar indices. Don't construct an index array, + // but rather calc a scalar index directly. + octave_idx_type k = 1, j = 0; + for (octave_idx_type i = 0; i < n_idx; i++) + { + j += idx_vec(i)(0) * k; + k *= dv (i); + } + matrix(j) = rhs; + } + else + matrix.assign (idx_vec, mrhs); + } + } + break; + } + + // Clear cache. + clear_cached_info (); +} + +template +void +octave_base_matrix::delete_elements (const octave_value_list& idx) +{ + octave_idx_type len = idx.length (); + + Array ra_idx (dim_vector (len, 1)); + + for (octave_idx_type i = 0; i < len; i++) + ra_idx(i) = idx(i).index_vector (); + + matrix.delete_elements (ra_idx); + + // Clear cache. + clear_cached_info (); +} + +template +octave_value +octave_base_matrix::resize (const dim_vector& dv, bool fill) const +{ + MT retval (matrix); + if (fill) + retval.resize (dv, 0); + else + retval.resize (dv); + return retval; +} + +template +bool +octave_base_matrix::is_true (void) const +{ + bool retval = false; + dim_vector dv = matrix.dims (); + int nel = dv.numel (); + + if (nel > 0) + { + MT t1 (matrix.reshape (dim_vector (nel, 1))); + + if (t1.any_element_is_nan ()) + gripe_nan_to_logical_conversion (); + else + { + boolNDArray t2 = t1.all (); + + retval = t2(0); + } + } + + return retval; +} + +template +bool +octave_base_matrix::print_as_scalar (void) const +{ + dim_vector dv = dims (); + + return (dv.all_ones () || dv.any_zero ()); +} + +template +void +octave_base_matrix::print (std::ostream& os, bool pr_as_read_syntax) const +{ + print_raw (os, pr_as_read_syntax); + newline (os); +} + +template +void +octave_base_matrix::print_info (std::ostream& os, + const std::string& prefix) const +{ + matrix.print_info (os, prefix); +} + +template +octave_value +octave_base_matrix::fast_elem_extract (octave_idx_type n) const +{ + if (n < matrix.numel ()) + return matrix(n); + else + return octave_value (); +} + +template +bool +octave_base_matrix::fast_elem_insert (octave_idx_type n, + const octave_value& x) +{ + if (n < matrix.numel ()) + { + // Don't use builtin_type () here to avoid an extra VM call. + typedef typename MT::element_type ET; + const builtin_type_t btyp = class_to_btyp::btyp; + if (btyp == btyp_unknown) // Dead branch? + return false; + + // Set up the pointer to the proper place. + void *here = reinterpret_cast (&matrix(n)); + // Ask x to store there if it can. + return x.get_rep ().fast_elem_insert_self (here, btyp); + } + else + return false; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base-mat.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base-mat.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,204 @@ +/* + +Copyright (C) 1998-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_base_matrix_h) +#define octave_base_matrix_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "str-vec.h" +#include "MatrixType.h" + +#include "error.h" +#include "oct-obj.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class tree_walker; + +// Real matrix values. + +template +class +octave_base_matrix : public octave_base_value +{ +public: + + octave_base_matrix (void) + : octave_base_value (), matrix (), typ (), idx_cache () { } + + octave_base_matrix (const MT& m, const MatrixType& t = MatrixType ()) + : octave_base_value (), matrix (m), + typ (t.is_known () ? new MatrixType (t) : 0), idx_cache () + { + if (matrix.ndims () == 0) + matrix.resize (dim_vector (0, 0)); + } + + octave_base_matrix (const octave_base_matrix& m) + : octave_base_value (), matrix (m.matrix), + typ (m.typ ? new MatrixType (*m.typ) : 0), + idx_cache (m.idx_cache ? new idx_vector (*m.idx_cache) : 0) + { } + + ~octave_base_matrix (void) { clear_cached_info (); } + + size_t byte_size (void) const { return matrix.byte_size (); } + + octave_value squeeze (void) const { return MT (matrix.squeeze ()); } + + octave_value full_value (void) const { return matrix; } + + void maybe_economize (void) { matrix.maybe_economize (); } + + octave_value subsref (const std::string& type, + const std::list& idx); + + octave_value_list subsref (const std::string& type, + const std::list& idx, int) + { return subsref (type, idx); } + + octave_value subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + octave_value_list do_multi_index_op (int, const octave_value_list& idx) + { return do_index_op (idx); } + + void assign (const octave_value_list& idx, const MT& rhs); + + void assign (const octave_value_list& idx, typename MT::element_type rhs); + + void delete_elements (const octave_value_list& idx); + + dim_vector dims (void) const { return matrix.dims (); } + + octave_idx_type numel (void) const { return matrix.numel (); } + + int ndims (void) const { return matrix.ndims (); } + + octave_idx_type nnz (void) const { return matrix.nnz (); } + + octave_value reshape (const dim_vector& new_dims) const + { return MT (matrix.reshape (new_dims)); } + + octave_value permute (const Array& vec, bool inv = false) const + { return MT (matrix.permute (vec, inv)); } + + octave_value resize (const dim_vector& dv, bool fill = false) const; + + octave_value all (int dim = 0) const { return matrix.all (dim); } + octave_value any (int dim = 0) const { return matrix.any (dim); } + + MatrixType matrix_type (void) const { return typ ? *typ : MatrixType (); } + MatrixType matrix_type (const MatrixType& _typ) const; + + octave_value diag (octave_idx_type k = 0) const + { return octave_value (matrix.diag (k)); } + + octave_value diag (octave_idx_type m, octave_idx_type n) const + { return octave_value (matrix.diag (m, n)); } + + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const + { return octave_value (matrix.sort (dim, mode)); } + octave_value sort (Array &sidx, octave_idx_type dim = 0, + sortmode mode = ASCENDING) const + { return octave_value (matrix.sort (sidx, dim, mode)); } + + sortmode is_sorted (sortmode mode = UNSORTED) const + { return matrix.is_sorted (mode); } + + Array sort_rows_idx (sortmode mode = ASCENDING) const + { return matrix.sort_rows_idx (mode); } + + sortmode is_sorted_rows (sortmode mode = UNSORTED) const + { return matrix.is_sorted_rows (mode); } + + bool is_matrix_type (void) const { return true; } + + bool is_numeric_type (void) const { return true; } + + bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + + bool is_true (void) const; + + bool print_as_scalar (void) const; + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_info (std::ostream& os, const std::string& prefix) const; + + MT& matrix_ref (void) + { + clear_cached_info (); + return matrix; + } + + const MT& matrix_ref (void) const + { + return matrix; + } + + octave_value + fast_elem_extract (octave_idx_type n) const; + + bool + fast_elem_insert (octave_idx_type n, const octave_value& x); + +protected: + + MT matrix; + + idx_vector set_idx_cache (const idx_vector& idx) const + { + delete idx_cache; + idx_cache = idx ? new idx_vector (idx) : 0; + return idx; + } + + void clear_cached_info (void) const + { + delete typ; typ = 0; + delete idx_cache; idx_cache = 0; + } + + mutable MatrixType *typ; + mutable idx_vector *idx_cache; + +private: + + // No assignment. + + octave_base_matrix& operator = (const octave_base_matrix&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base-scalar.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base-scalar.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,184 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "oct-obj.h" +#include "ov-base.h" +#include "ov-cx-mat.h" +#include "ov-re-mat.h" +#include "ov-base-scalar.h" +#include "pr-output.h" + +template +octave_value +octave_base_scalar::subsref (const std::string& type, + const std::list& idx) +{ + octave_value retval; + + switch (type[0]) + { + case '(': + retval = do_index_op (idx.front ()); + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + return retval.next_subsref (type, idx); +} + +template +octave_value +octave_base_scalar::subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + octave_value retval; + + switch (type[0]) + { + case '(': + { + if (type.length () == 1) + retval = numeric_assign (type, idx, rhs); + else + { + std::string nm = type_name (); + error ("in indexed assignment of %s, last rhs index must be ()", + nm.c_str ()); + } + } + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + return retval; +} + +template +octave_value +octave_base_scalar::permute (const Array& vec, bool inv) const +{ + return Array (dim_vector (1, 1), scalar).permute (vec, inv); +} + +template +octave_value +octave_base_scalar::reshape (const dim_vector& new_dims) const +{ + return Array (dim_vector (1, 1), scalar).reshape (new_dims); +} + +template +octave_value +octave_base_scalar::diag (octave_idx_type k) const +{ + return Array (dim_vector (1, 1), scalar).diag (k); +} + +template +octave_value +octave_base_scalar::diag (octave_idx_type m, octave_idx_type n) const +{ + return Array (dim_vector (1, 1), scalar).diag (m, n); +} + +template +bool +octave_base_scalar::is_true (void) const +{ + bool retval = false; + + if (xisnan (scalar)) + gripe_nan_to_logical_conversion (); + else + retval = (scalar != ST ()); + + return retval; +} + +template +void +octave_base_scalar::print (std::ostream& os, bool pr_as_read_syntax) const +{ + print_raw (os, pr_as_read_syntax); + newline (os); +} + +template +void +octave_base_scalar::print_raw (std::ostream& os, + bool pr_as_read_syntax) const +{ + indent (os); + octave_print_internal (os, scalar, pr_as_read_syntax); +} + +template +bool +octave_base_scalar::print_name_tag (std::ostream& os, + const std::string& name) const +{ + indent (os); + os << name << " = "; + return false; +} + +template +bool +octave_base_scalar::fast_elem_insert_self (void *where, builtin_type_t btyp) const +{ + + // Don't use builtin_type () here to avoid an extra VM call. + if (btyp == class_to_btyp::btyp) + { + *(reinterpret_cast(where)) = scalar; + return true; + } + else + return false; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base-scalar.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base-scalar.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,157 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_base_scalar_h) +#define octave_base_scalar_h 1 + +#include + +#include +#include + +#include "lo-mappers.h" +#include "lo-utils.h" +#include "oct-alloc.h" +#include "str-vec.h" +#include "MatrixType.h" + +#include "ov-base.h" +#include "ov-typeinfo.h" + +// Real scalar values. + +template +class +octave_base_scalar : public octave_base_value +{ +public: + + octave_base_scalar (void) + : octave_base_value (), scalar () { } + + octave_base_scalar (const ST& s) + : octave_base_value (), scalar (s) { } + + octave_base_scalar (const octave_base_scalar& s) + : octave_base_value (), scalar (s.scalar) { } + + ~octave_base_scalar (void) { } + + octave_value squeeze (void) const { return scalar; } + + octave_value full_value (void) const { return scalar; } + + octave_value subsref (const std::string& type, + const std::list& idx); + + octave_value_list subsref (const std::string& type, + const std::list& idx, int) + { return subsref (type, idx); } + + octave_value subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + octave_value_list do_multi_index_op (int, const octave_value_list& idx) + { return do_index_op (idx); } + + bool is_constant (void) const { return true; } + + bool is_defined (void) const { return true; } + + dim_vector dims (void) const { static dim_vector dv (1, 1); return dv; } + + octave_idx_type numel (void) const { return 1; } + + int ndims (void) const { return 2; } + + octave_idx_type nnz (void) const { return (scalar != ST ()) ? 1 : 0; } + + octave_value permute (const Array&, bool = false) const; + + octave_value reshape (const dim_vector& new_dims) const; + + size_t byte_size (void) const { return sizeof (ST); } + + octave_value all (int = 0) const { return (scalar != ST ()); } + + octave_value any (int = 0) const { return (scalar != ST ()); } + + octave_value diag (octave_idx_type k = 0) const; + + octave_value diag (octave_idx_type m, octave_idx_type n) const; + + octave_value sort (octave_idx_type, sortmode) const + { return octave_value (scalar); } + octave_value sort (Array &sidx, octave_idx_type, + sortmode) const + { + sidx.resize (dim_vector (1, 1)); + sidx(0) = 0; + return octave_value (scalar); + } + + sortmode is_sorted (sortmode mode = UNSORTED) const + { return mode ? mode : ASCENDING; } + + Array sort_rows_idx (sortmode) const + { + return Array (dim_vector (1, 1), + static_cast (0)); + } + + sortmode is_sorted_rows (sortmode mode = UNSORTED) const + { return mode ? mode : ASCENDING; } + + MatrixType matrix_type (void) const { return MatrixType::Diagonal; } + MatrixType matrix_type (const MatrixType&) const + { return matrix_type (); } + + bool is_scalar_type (void) const { return true; } + + bool is_numeric_type (void) const { return true; } + + bool is_true (void) const; + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool print_name_tag (std::ostream& os, const std::string& name) const; + + // Unsafe. This function exists to support the MEX interface. + // You should not use it anywhere else. + void *mex_get_data (void) const { return const_cast (&scalar); } + + const ST& scalar_ref (void) const { return scalar; } + + ST& scalar_ref (void) { return scalar; } + + bool fast_elem_insert_self (void *where, builtin_type_t btyp) const; + +protected: + + // The value of this scalar. + ST scalar; +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base-sparse.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base-sparse.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,465 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "oct-obj.h" +#include "ov-base.h" +#include "quit.h" +#include "pr-output.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +#include "boolSparse.h" +#include "ov-base-sparse.h" +#include "pager.h" + +template +octave_value +octave_base_sparse::do_index_op (const octave_value_list& idx, + bool resize_ok) +{ + octave_value retval; + + octave_idx_type n_idx = idx.length (); + + switch (n_idx) + { + case 0: + retval = matrix; + break; + + case 1: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + retval = octave_value (matrix.index (i, resize_ok)); + } + break; + + case 2: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + { + idx_vector j = idx (1).index_vector (); + + if (! error_state) + retval = octave_value (matrix.index (i, j, resize_ok)); + } + } + break; + default: + error ("sparse indexing needs 1 or 2 indices"); + } + + return retval; +} + +template +octave_value +octave_base_sparse::subsref (const std::string& type, + const std::list& idx) +{ + octave_value retval; + + switch (type[0]) + { + case '(': + retval = do_index_op (idx.front ()); + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + return retval.next_subsref (type, idx); +} + +template +octave_value +octave_base_sparse::subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + octave_value retval; + + switch (type[0]) + { + case '(': + { + if (type.length () == 1) + retval = numeric_assign (type, idx, rhs); + else + { + std::string nm = type_name (); + error ("in indexed assignment of %s, last lhs index must be ()", + nm.c_str ()); + } + } + break; + + case '{': + case '.': + { + if (is_empty ()) + { + octave_value tmp = octave_value::empty_conv (type, rhs); + + retval = tmp.subsasgn (type, idx, rhs); + } + else + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + } + break; + + default: + panic_impossible (); + } + + return retval; +} + +template +void +octave_base_sparse::assign (const octave_value_list& idx, const T& rhs) +{ + + octave_idx_type len = idx.length (); + + switch (len) + { + case 1: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + matrix.assign (i, rhs); + + break; + } + + case 2: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + { + idx_vector j = idx (1).index_vector (); + + if (! error_state) + matrix.assign (i, j, rhs); + } + + break; + } + + default: + error ("sparse indexing needs 1 or 2 indices"); + } + + + // Invalidate matrix type. + typ.invalidate_type (); +} + +template +void +octave_base_sparse::delete_elements (const octave_value_list& idx) +{ + octave_idx_type len = idx.length (); + + switch (len) + { + case 1: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + matrix.delete_elements (i); + + break; + } + + case 2: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + { + idx_vector j = idx (1).index_vector (); + + if (! error_state) + matrix.delete_elements (i, j); + } + + break; + } + + default: + error ("sparse indexing needs 1 or 2 indices"); + } + + // Invalidate the matrix type + typ.invalidate_type (); +} + +template +octave_value +octave_base_sparse::resize (const dim_vector& dv, bool) const +{ + T retval (matrix); + retval.resize (dv); + return retval; +} + +template +bool +octave_base_sparse::is_true (void) const +{ + bool retval = false; + dim_vector dv = matrix.dims (); + octave_idx_type nel = dv.numel (); + octave_idx_type nz = nnz (); + + if (nz == nel && nel > 0) + { + T t1 (matrix.reshape (dim_vector (nel, 1))); + + SparseBoolMatrix t2 = t1.all (); + + retval = t2(0); + } + + return retval; +} + +template +bool +octave_base_sparse::print_as_scalar (void) const +{ + dim_vector dv = dims (); + + return (dv.all_ones () || dv.any_zero ()); +} + +template +void +octave_base_sparse::print (std::ostream& os, bool pr_as_read_syntax) const +{ + print_raw (os, pr_as_read_syntax); + newline (os); +} + +template +void +octave_base_sparse::print_info (std::ostream& os, + const std::string& prefix) const +{ + matrix.print_info (os, prefix); +} + +template +void +octave_base_sparse::print_raw (std::ostream& os, + bool pr_as_read_syntax) const +{ + octave_idx_type nr = matrix.rows (); + octave_idx_type nc = matrix.cols (); + octave_idx_type nz = nnz (); + + // FIXME -- this should probably all be handled by a + // separate octave_print_internal function that can handle format + // compact, loose, etc. + + os << "Compressed Column Sparse (rows = " << nr + << ", cols = " << nc + << ", nnz = " << nz; + + // Avoid calling numel here since it can easily overflow + // octave_idx_type even when there is no real problem storing the + // sparse array. + + double dnr = nr; + double dnc = nc; + double dnel = dnr * dnc; + + if (dnel > 0) + { + double pct = (nz / dnel * 100); + + int prec = 2; + + // Display at least 2 significant figures and up to 4 as we + // approach 100%. Avoid having limited precision of the display + // result in reporting 100% for matrices that are not actually + // 100% full. + + if (pct == 100) + prec = 3; + else + { + if (pct > 99.9) + prec = 4; + else if (pct > 99) + prec = 3; + + if (pct > 99.99) + pct = 99.99; + } + + os << " [" << std::setprecision (prec) << pct << "%]"; + } + + os << ")\n"; + + // add one to the printed indices to go from + // zero-based to one-based arrays + + if (nz != 0) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + // FIXME -- is there an easy way to get the max row + // and column indices so we can set the width appropriately + // and line up the columns here? Similarly, we should look + // at all the nonzero values and display them with the same + // formatting rules that apply to columns of a matrix. + + for (octave_idx_type i = matrix.cidx (j); i < matrix.cidx (j+1); i++) + { + os << "\n"; + os << " (" << matrix.ridx (i)+1 << + ", " << j+1 << ") -> "; + + octave_print_internal (os, matrix.data (i), pr_as_read_syntax); + } + } + } +} + +template +bool +octave_base_sparse::save_ascii (std::ostream& os) +{ + dim_vector dv = this->dims (); + + // Ensure that additional memory is deallocated + matrix.maybe_compress (); + + os << "# nnz: " << nnz () << "\n"; + os << "# rows: " << dv (0) << "\n"; + os << "# columns: " << dv (1) << "\n"; + + os << this->matrix; + + return true; +} + +template +bool +octave_base_sparse::load_ascii (std::istream& is) +{ + octave_idx_type nz = 0; + octave_idx_type nr = 0; + octave_idx_type nc = 0; + bool success = true; + + if (extract_keyword (is, "nnz", nz, true) && + extract_keyword (is, "rows", nr, true) && + extract_keyword (is, "columns", nc, true)) + { + T tmp (nr, nc, nz); + + is >> tmp; + + if (!is) + { + error ("load: failed to load matrix constant"); + success = false; + } + + matrix = tmp; + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + + return success; +} + +template +octave_value +octave_base_sparse::map (octave_base_value::unary_mapper_t umap) const +{ + // Try the map on the dense value. + octave_value retval = this->full_value ().map (umap); + + // Sparsify the result if possible. + // FIXME: intentionally skip this step for string mappers. Is this wanted? + if (umap >= umap_xisalnum && umap <= umap_xtoupper) + return retval; + + switch (retval.builtin_type ()) + { + case btyp_double: + retval = retval.sparse_matrix_value (); + break; + case btyp_complex: + retval = retval.sparse_complex_matrix_value (); + break; + case btyp_bool: + retval = retval.sparse_bool_matrix_value (); + break; + default: + break; + } + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base-sparse.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base-sparse.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,175 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_base_sparse_h) +#define octave_base_sparse_h 1 + +#include + +#include +#include + +#include "str-vec.h" + +#include "error.h" +#include "oct-obj.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +#include "boolSparse.h" +#include "MatrixType.h" + +class tree_walker; + +class octave_sparse_bool_matrix; + +template +class +octave_base_sparse : public octave_base_value +{ + public: + + octave_base_sparse (void) + : octave_base_value (), matrix (), typ (MatrixType ()) + { } + + octave_base_sparse (const T& a) : octave_base_value (), matrix (a), + typ (MatrixType ()) + { + if (matrix.ndims () == 0) + matrix.resize (dim_vector (0, 0)); + } + + octave_base_sparse (const T& a, const MatrixType& t) : octave_base_value (), + matrix (a), typ (t) + { + if (matrix.ndims () == 0) + matrix.resize (dim_vector (0, 0)); + } + + octave_base_sparse (const octave_base_sparse& a) : + octave_base_value (), matrix (a.matrix), typ (a.typ) { } + + ~octave_base_sparse (void) { } + + octave_idx_type nnz (void) const { return matrix.nnz (); } + + octave_idx_type nzmax (void) const { return matrix.nzmax (); } + + size_t byte_size (void) const { return matrix.byte_size (); } + + octave_value squeeze (void) const { return matrix.squeeze (); } + + octave_value full_value (void) const { return matrix.matrix_value (); } + + octave_value subsref (const std::string& type, + const std::list& idx); + + octave_value_list subsref (const std::string& type, + const std::list& idx, int) + { return subsref (type, idx); } + + octave_value subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + void assign (const octave_value_list& idx, const T& rhs); + + void delete_elements (const octave_value_list& idx); + + dim_vector dims (void) const { return matrix.dims (); } + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + octave_value reshape (const dim_vector& new_dims) const + { return T (matrix.reshape (new_dims)); } + + octave_value permute (const Array& vec, bool inv = false) const + { return T (matrix.permute (vec, inv)); } + + octave_value resize (const dim_vector& dv, bool = false) const; + + octave_value all (int dim = 0) const { return matrix.all (dim); } + octave_value any (int dim = 0) const { return matrix.any (dim); } + + octave_value diag (octave_idx_type k = 0) const + { return octave_value (matrix.diag (k)); } + + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const + { return octave_value (matrix.sort (dim, mode)); } + octave_value sort (Array &sidx, octave_idx_type dim = 0, + sortmode mode = ASCENDING) const + { return octave_value (matrix.sort (sidx, dim, mode)); } + + sortmode is_sorted (sortmode mode = UNSORTED) const + { return full_value ().is_sorted (mode); } + + MatrixType matrix_type (void) const { return typ; } + MatrixType matrix_type (const MatrixType& _typ) const + { MatrixType ret = typ; typ = _typ; return ret; } + + bool is_matrix_type (void) const { return true; } + + bool is_numeric_type (void) const { return true; } + + bool is_sparse_type (void) const { return true; } + + bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + + bool is_true (void) const; + + octave_idx_type capacity (void) const { return matrix.capacity (); } + + bool print_as_scalar (void) const; + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_info (std::ostream& os, const std::string& prefix) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + // Unsafe. These functions exists to support the MEX interface. + // You should not use them anywhere else. + void *mex_get_data (void) const { return matrix.mex_get_data (); } + + octave_idx_type *mex_get_ir (void) const { return matrix.mex_get_ir (); } + + octave_idx_type *mex_get_jc (void) const { return matrix.mex_get_jc (); } + +protected: + + octave_value map (octave_base_value::unary_mapper_t umap) const; + + T matrix; + + mutable MatrixType typ; +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1579 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "lo-ieee.h" +#include "lo-mappers.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "oct-stream.h" +#include "ops.h" +#include "ov-base.h" +#include "ov-cell.h" +#include "ov-ch-mat.h" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ov-range.h" +#include "ov-re-mat.h" +#include "ov-scalar.h" +#include "ov-str-mat.h" +#include "ov-fcn-handle.h" +#include "parse.h" +#include "pr-output.h" +#include "utils.h" +#include "variables.h" + +builtin_type_t btyp_mixed_numeric (builtin_type_t x, builtin_type_t y) +{ + builtin_type_t retval = btyp_unknown; + + if (x == btyp_bool) + x = btyp_double; + if (y == btyp_bool) + y = btyp_double; + + if (x <= btyp_float_complex && y <= btyp_float_complex) + retval = static_cast (x | y); + else if (x <= btyp_uint64 && y <= btyp_float) + retval = x; + else if (x <= btyp_float && y <= btyp_uint64) + retval = y; + else if ((x >= btyp_int8 && x <= btyp_int64 + && y >= btyp_int8 && y <= btyp_int64) + || (x >= btyp_uint8 && x <= btyp_uint64 + && y >= btyp_uint8 && y <= btyp_uint64)) + retval = (x > y) ? x : y; + + return retval; +} + +std::string btyp_class_name[btyp_num_types] = +{ + "double", "single", "double", "single", + "int8", "int16", "int32", "int64", + "uint8", "uint16", "uint32", "uint64", + "logical", "char", + "struct", "cell", "function_handle" +}; + +string_vector +get_builtin_classes (void) +{ + static string_vector retval; + + if (retval.is_empty ()) + { + int n = btyp_num_types - 2; + retval = string_vector (n); + int j = 0; + for (int i = 0; i < btyp_num_types; i++) + { + builtin_type_t ityp = static_cast (i); + if (ityp != btyp_complex && ityp != btyp_float_complex) + retval(j++) = btyp_class_name[i]; + } + } + + return retval; +} + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_base_value, + "", "unknown"); + +// TRUE means to perform automatic sparse to real mutation if there +// is memory to be saved +bool Vsparse_auto_mutate = false; + +octave_base_value * +octave_base_value::empty_clone (void) const +{ + return resize (dim_vector ()).clone (); +} + +octave_value +octave_base_value::squeeze (void) const +{ + std::string nm = type_name (); + error ("squeeze: invalid operation for %s type", nm.c_str ()); + return octave_value (); +} + +octave_value +octave_base_value::full_value (void) const +{ + gripe_wrong_type_arg ("full: invalid operation for %s type", type_name ()); + return octave_value (); +} + +Matrix +octave_base_value::size (void) +{ + const dim_vector dv = dims (); + Matrix mdv (1, dv.length ()); + for (octave_idx_type i = 0; i < dv.length (); i++) + mdv(i) = dv(i); + return mdv; +} + +octave_idx_type +octave_base_value::numel (const octave_value_list& idx) +{ + return dims_to_numel (dims (), idx); +} + +octave_value +octave_base_value::subsref (const std::string&, + const std::list&) +{ + std::string nm = type_name (); + error ("can't perform indexing operations for %s type", nm.c_str ()); + return octave_value (); +} + +octave_value_list +octave_base_value::subsref (const std::string&, + const std::list&, int) +{ + std::string nm = type_name (); + error ("can't perform indexing operations for %s type", nm.c_str ()); + return octave_value (); +} + +octave_value +octave_base_value::subsref (const std::string& type, + const std::list& idx, + bool /* auto_add */) +{ + // This way we may get a more meaningful error message. + return subsref (type, idx); +} + +octave_value_list +octave_base_value::subsref (const std::string& type, + const std::list& idx, + int nargout, + const std::list *) +{ + // Fall back to call without passing lvalue list. + return subsref (type, idx, nargout); +} + +octave_value +octave_base_value::do_index_op (const octave_value_list&, bool) +{ + std::string nm = type_name (); + error ("can't perform indexing operations for %s type", nm.c_str ()); + return octave_value (); +} + +octave_value_list +octave_base_value::do_multi_index_op (int, const octave_value_list&) +{ + std::string nm = type_name (); + error ("can't perform indexing operations for %s type", nm.c_str ()); + return octave_value (); +} + +octave_value_list +octave_base_value::do_multi_index_op (int nargout, const octave_value_list& idx, + const std::list *) +{ + // Fall back. + return do_multi_index_op (nargout, idx); +} + +idx_vector +octave_base_value::index_vector (void) const +{ + std::string nm = type_name (); + error ("%s type invalid as index value", nm.c_str ()); + return idx_vector (); +} + +octave_value +octave_base_value::subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + octave_value retval; + + if (is_defined ()) + { + if (is_numeric_type ()) + { + switch (type[0]) + { + case '(': + { + if (type.length () == 1) + retval = numeric_assign (type, idx, rhs); + else if (is_empty ()) + { + // Allow conversion of empty matrix to some other + // type in cases like + // + // x = []; x(i).f = rhs + + octave_value tmp = octave_value::empty_conv (type, rhs); + + retval = tmp.subsasgn (type, idx, rhs); + } + else + { + std::string nm = type_name (); + error ("in indexed assignment of %s, last rhs index must be ()", + nm.c_str ()); + } + } + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + } + else + { + std::string nm = type_name (); + error ("can't perform indexed assignment for %s type", nm.c_str ()); + } + } + else + { + // Create new object of appropriate type for given index and rhs + // types and then call undef_subsasgn for that object. + + octave_value tmp = octave_value::empty_conv (type, rhs); + + retval = tmp.undef_subsasgn (type, idx, rhs); + } + + return retval; +} + +octave_value +octave_base_value::undef_subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + // In most cases, undef_subsasgn is handled the sams as subsasgn. One + // exception is octave_class objects. + + return subsasgn (type, idx, rhs); +} + +octave_idx_type +octave_base_value::nnz (void) const +{ + gripe_wrong_type_arg ("octave_base_value::nnz ()", type_name ()); + return -1; +} + +octave_idx_type +octave_base_value::nzmax (void) const +{ + return numel (); +} + +octave_idx_type +octave_base_value::nfields (void) const +{ + gripe_wrong_type_arg ("octave_base_value::nfields ()", type_name ()); + return -1; +} + +octave_value +octave_base_value::reshape (const dim_vector&) const +{ + gripe_wrong_type_arg ("octave_base_value::reshape ()", type_name ()); + return octave_value (); +} + +octave_value +octave_base_value::permute (const Array&, bool) const +{ + gripe_wrong_type_arg ("octave_base_value::permute ()", type_name ()); + return octave_value (); +} + +octave_value +octave_base_value::resize (const dim_vector&, bool) const +{ + gripe_wrong_type_arg ("octave_base_value::resize ()", type_name ()); + return octave_value (); +} + +MatrixType +octave_base_value::matrix_type (void) const +{ + gripe_wrong_type_arg ("octave_base_value::matrix_type ()", type_name ()); + return MatrixType (); +} + +MatrixType +octave_base_value::matrix_type (const MatrixType&) const +{ + gripe_wrong_type_arg ("octave_base_value::matrix_type ()", type_name ()); + return MatrixType (); +} + +octave_value +octave_base_value::all (int) const +{ + return 0.0; +} + +octave_value +octave_base_value::any (int) const +{ + return 0.0; +} + +octave_value +octave_base_value::convert_to_str (bool pad, bool force, char type) const +{ + octave_value retval = convert_to_str_internal (pad, force, type); + + if (! force && is_numeric_type ()) + gripe_implicit_conversion ("Octave:num-to-str", + type_name (), retval.type_name ()); + + return retval; +} + +octave_value +octave_base_value::convert_to_str_internal (bool, bool, char) const +{ + gripe_wrong_type_arg ("octave_base_value::convert_to_str_internal ()", + type_name ()); + return octave_value (); +} + +void +octave_base_value::convert_to_row_or_column_vector (void) +{ + gripe_wrong_type_arg + ("octave_base_value::convert_to_row_or_column_vector ()", + type_name ()); +} + +void +octave_base_value::print (std::ostream&, bool) const +{ + gripe_wrong_type_arg ("octave_base_value::print ()", type_name ()); +} + +void +octave_base_value::print_raw (std::ostream&, bool) const +{ + gripe_wrong_type_arg ("octave_base_value::print_raw ()", type_name ()); +} + +bool +octave_base_value::print_name_tag (std::ostream& os, const std::string& name) const +{ + bool retval = false; + + indent (os); + + if (print_as_scalar ()) + os << name << " = "; + else + { + os << name << " ="; + newline (os); + if (! Vcompact_format) + newline (os); + + retval = true; + } + + return retval; +} + +void +octave_base_value::print_with_name (std::ostream& output_buf, + const std::string& name, + bool print_padding) +{ + bool pad_after = print_name_tag (output_buf, name); + + print (output_buf); + + if (print_padding && pad_after && ! Vcompact_format) + newline (output_buf); +} + +void +octave_base_value::print_info (std::ostream& os, + const std::string& /* prefix */) const +{ + os << "no info for type: " << type_name () << "\n"; +} + +#define INT_CONV_METHOD(T, F, MIN_LIMIT, MAX_LIMIT) \ + T \ + octave_base_value::F ## _value (bool require_int, bool frc_str_conv) const \ + { \ + T retval = 0; \ + \ + double d = double_value (frc_str_conv); \ + \ + if (! error_state) \ + { \ + if (require_int && D_NINT (d) != d) \ + error_with_cfn ("conversion of %g to " #T " value failed", d); \ + else if (d < MIN_LIMIT) \ + retval = MIN_LIMIT; \ + else if (d > MAX_LIMIT) \ + retval = MAX_LIMIT; \ + else \ + retval = static_cast (::fix (d)); \ + } \ + else \ + gripe_wrong_type_arg ("octave_base_value::" #F "_value ()", \ + type_name ()); \ + \ + return retval; \ + } + +INT_CONV_METHOD (short int, short, SHRT_MIN, SHRT_MAX) +INT_CONV_METHOD (unsigned short int, ushort, 0, USHRT_MAX) + +INT_CONV_METHOD (int, int, INT_MIN, INT_MAX) +INT_CONV_METHOD (unsigned int, uint, 0, UINT_MAX) + +INT_CONV_METHOD (long int, long, LONG_MIN, LONG_MAX) +INT_CONV_METHOD (unsigned long int, ulong, 0, ULONG_MAX) + +int +octave_base_value::nint_value (bool frc_str_conv) const +{ + int retval = 0; + + double d = double_value (frc_str_conv); + + if (! error_state) + { + if (xisnan (d)) + { + error ("conversion of NaN to integer value failed"); + return retval; + } + + retval = static_cast (::fix (d)); + } + else + gripe_wrong_type_arg ("octave_base_value::nint_value ()", type_name ()); + + return retval; +} + +double +octave_base_value::double_value (bool) const +{ + double retval = lo_ieee_nan_value (); + gripe_wrong_type_arg ("octave_base_value::double_value ()", type_name ()); + return retval; +} + +float +octave_base_value::float_value (bool) const +{ + float retval = lo_ieee_float_nan_value (); + gripe_wrong_type_arg ("octave_base_value::float_value ()", type_name ()); + return retval; +} + +Cell +octave_base_value::cell_value () const +{ + Cell retval; + gripe_wrong_type_arg ("octave_base_value::cell_value()", type_name ()); + return retval; +} + +Matrix +octave_base_value::matrix_value (bool) const +{ + Matrix retval; + gripe_wrong_type_arg ("octave_base_value::matrix_value()", type_name ()); + return retval; +} + +FloatMatrix +octave_base_value::float_matrix_value (bool) const +{ + FloatMatrix retval; + gripe_wrong_type_arg ("octave_base_value::float_matrix_value()", type_name ()); + return retval; +} + +NDArray +octave_base_value::array_value (bool) const +{ + FloatNDArray retval; + gripe_wrong_type_arg ("octave_base_value::array_value()", type_name ()); + return retval; +} + +FloatNDArray +octave_base_value::float_array_value (bool) const +{ + FloatNDArray retval; + gripe_wrong_type_arg ("octave_base_value::float_array_value()", type_name ()); + return retval; +} + +Complex +octave_base_value::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + Complex retval (tmp, tmp); + gripe_wrong_type_arg ("octave_base_value::complex_value()", type_name ()); + return retval; +} + +FloatComplex +octave_base_value::float_complex_value (bool) const +{ + float tmp = lo_ieee_float_nan_value (); + FloatComplex retval (tmp, tmp); + gripe_wrong_type_arg ("octave_base_value::float_complex_value()", type_name ()); + return retval; +} + +ComplexMatrix +octave_base_value::complex_matrix_value (bool) const +{ + ComplexMatrix retval; + gripe_wrong_type_arg ("octave_base_value::complex_matrix_value()", + type_name ()); + return retval; +} + +FloatComplexMatrix +octave_base_value::float_complex_matrix_value (bool) const +{ + FloatComplexMatrix retval; + gripe_wrong_type_arg ("octave_base_value::float_complex_matrix_value()", + type_name ()); + return retval; +} + +ComplexNDArray +octave_base_value::complex_array_value (bool) const +{ + ComplexNDArray retval; + gripe_wrong_type_arg ("octave_base_value::complex_array_value()", + type_name ()); + return retval; +} + +FloatComplexNDArray +octave_base_value::float_complex_array_value (bool) const +{ + FloatComplexNDArray retval; + gripe_wrong_type_arg ("octave_base_value::float_complex_array_value()", + type_name ()); + return retval; +} + +bool +octave_base_value::bool_value (bool) const +{ + bool retval = false; + gripe_wrong_type_arg ("octave_base_value::bool_value()", type_name ()); + return retval; +} + +boolMatrix +octave_base_value::bool_matrix_value (bool) const +{ + boolMatrix retval; + gripe_wrong_type_arg ("octave_base_value::bool_matrix_value()", + type_name ()); + return retval; +} + +boolNDArray +octave_base_value::bool_array_value (bool) const +{ + boolNDArray retval; + gripe_wrong_type_arg ("octave_base_value::bool_array_value()", + type_name ()); + return retval; +} + +charMatrix +octave_base_value::char_matrix_value (bool force) const +{ + charMatrix retval; + + octave_value tmp = convert_to_str (false, force); + + if (! error_state) + retval = tmp.char_matrix_value (); + + return retval; +} + +charNDArray +octave_base_value::char_array_value (bool) const +{ + charNDArray retval; + gripe_wrong_type_arg ("octave_base_value::char_array_value()", + type_name ()); + return retval; +} + +SparseMatrix +octave_base_value::sparse_matrix_value (bool) const +{ + SparseMatrix retval; + gripe_wrong_type_arg ("octave_base_value::sparse_matrix_value()", type_name ()); + return retval; +} + +SparseComplexMatrix +octave_base_value::sparse_complex_matrix_value (bool) const +{ + SparseComplexMatrix retval; + gripe_wrong_type_arg ("octave_base_value::sparse_complex_matrix_value()", type_name ()); + return retval; +} + +SparseBoolMatrix +octave_base_value::sparse_bool_matrix_value (bool) const +{ + SparseBoolMatrix retval; + gripe_wrong_type_arg ("octave_base_value::sparse_bool_matrix_value()", type_name ()); + return retval; +} + +DiagMatrix +octave_base_value::diag_matrix_value (bool) const +{ + DiagMatrix retval; + gripe_wrong_type_arg ("octave_base_value::diag_matrix_value()", type_name ()); + return retval; +} + +FloatDiagMatrix +octave_base_value::float_diag_matrix_value (bool) const +{ + FloatDiagMatrix retval; + gripe_wrong_type_arg ("octave_base_value::float_diag_matrix_value()", type_name ()); + return retval; +} + +ComplexDiagMatrix +octave_base_value::complex_diag_matrix_value (bool) const +{ + ComplexDiagMatrix retval; + gripe_wrong_type_arg ("octave_base_value::complex_diag_matrix_value()", type_name ()); + return retval; +} + +FloatComplexDiagMatrix +octave_base_value::float_complex_diag_matrix_value (bool) const +{ + FloatComplexDiagMatrix retval; + gripe_wrong_type_arg ("octave_base_value::float_complex_diag_matrix_value()", type_name ()); + return retval; +} + +PermMatrix +octave_base_value::perm_matrix_value (void) const +{ + PermMatrix retval; + gripe_wrong_type_arg ("octave_base_value::perm_matrix_value()", type_name ()); + return retval; +} + +octave_int8 +octave_base_value::int8_scalar_value (void) const +{ + octave_int8 retval; + gripe_wrong_type_arg ("octave_base_value::int8_scalar_value()", + type_name ()); + return retval; +} + +octave_int16 +octave_base_value::int16_scalar_value (void) const +{ + octave_int16 retval; + gripe_wrong_type_arg ("octave_base_value::int16_scalar_value()", + type_name ()); + return retval; +} + +octave_int32 +octave_base_value::int32_scalar_value (void) const +{ + octave_int32 retval; + gripe_wrong_type_arg ("octave_base_value::int32_scalar_value()", + type_name ()); + return retval; +} + +octave_int64 +octave_base_value::int64_scalar_value (void) const +{ + octave_int64 retval; + gripe_wrong_type_arg ("octave_base_value::int64_scalar_value()", + type_name ()); + return retval; +} + +octave_uint8 +octave_base_value::uint8_scalar_value (void) const +{ + octave_uint8 retval; + gripe_wrong_type_arg ("octave_base_value::uint8_scalar_value()", + type_name ()); + return retval; +} + +octave_uint16 +octave_base_value::uint16_scalar_value (void) const +{ + octave_uint16 retval; + gripe_wrong_type_arg ("octave_base_value::uint16_scalar_value()", + type_name ()); + return retval; +} + +octave_uint32 +octave_base_value::uint32_scalar_value (void) const +{ + octave_uint32 retval; + gripe_wrong_type_arg ("octave_base_value::uint32_scalar_value()", + type_name ()); + return retval; +} + +octave_uint64 +octave_base_value::uint64_scalar_value (void) const +{ + octave_uint64 retval; + gripe_wrong_type_arg ("octave_base_value::uint64_scalar_value()", + type_name ()); + return retval; +} + +int8NDArray +octave_base_value::int8_array_value (void) const +{ + int8NDArray retval; + gripe_wrong_type_arg ("octave_base_value::int8_array_value()", + type_name ()); + return retval; +} + +int16NDArray +octave_base_value::int16_array_value (void) const +{ + int16NDArray retval; + gripe_wrong_type_arg ("octave_base_value::int16_array_value()", + type_name ()); + return retval; +} + +int32NDArray +octave_base_value::int32_array_value (void) const +{ + int32NDArray retval; + gripe_wrong_type_arg ("octave_base_value::int32_array_value()", + type_name ()); + return retval; +} + +int64NDArray +octave_base_value::int64_array_value (void) const +{ + int64NDArray retval; + gripe_wrong_type_arg ("octave_base_value::int64_array_value()", + type_name ()); + return retval; +} + +uint8NDArray +octave_base_value::uint8_array_value (void) const +{ + uint8NDArray retval; + gripe_wrong_type_arg ("octave_base_value::uint8_array_value()", + type_name ()); + return retval; +} + +uint16NDArray +octave_base_value::uint16_array_value (void) const +{ + uint16NDArray retval; + gripe_wrong_type_arg ("octave_base_value::uint16_array_value()", + type_name ()); + return retval; +} + +uint32NDArray +octave_base_value::uint32_array_value (void) const +{ + uint32NDArray retval; + gripe_wrong_type_arg ("octave_base_value::uint32_array_value()", + type_name ()); + return retval; +} + +uint64NDArray +octave_base_value::uint64_array_value (void) const +{ + uint64NDArray retval; + gripe_wrong_type_arg ("octave_base_value::uint64_array_value()", + type_name ()); + return retval; +} + +string_vector +octave_base_value::all_strings (bool pad) const +{ + string_vector retval; + + octave_value tmp = convert_to_str (pad, true); + + if (! error_state) + retval = tmp.all_strings (); + + return retval; +} + +std::string +octave_base_value::string_value (bool force) const +{ + std::string retval; + + octave_value tmp = convert_to_str (force); + + if (! error_state) + retval = tmp.string_value (); + + return retval; +} + +Array +octave_base_value::cellstr_value (void) const +{ + Array retval; + gripe_wrong_type_arg ("octave_base_value::cellstry_value()", + type_name ()); + return retval; +} + +Range +octave_base_value::range_value (void) const +{ + Range retval; + gripe_wrong_type_arg ("octave_base_value::range_value()", type_name ()); + return retval; +} + +octave_map +octave_base_value::map_value (void) const +{ + octave_map retval; + gripe_wrong_type_arg ("octave_base_value::map_value()", type_name ()); + return retval; +} + +octave_scalar_map +octave_base_value::scalar_map_value (void) const +{ + octave_map tmp = map_value (); + + if (tmp.numel () == 1) + return tmp.checkelem (0); + else + { + if (! error_state) + error ("invalid conversion of multi-dimensional struct to scalar struct"); + + return octave_scalar_map (); + } +} + +string_vector +octave_base_value::map_keys (void) const +{ + string_vector retval; + gripe_wrong_type_arg ("octave_base_value::map_keys()", type_name ()); + return retval; +} + +size_t +octave_base_value::nparents (void) const +{ + size_t retval = 0; + gripe_wrong_type_arg ("octave_base_value::nparents()", type_name ()); + return retval; +} + +std::list +octave_base_value::parent_class_name_list (void) const +{ + std::list retval; + gripe_wrong_type_arg ("octave_base_value::parent_class_name_list()", + type_name ()); + return retval; +} + +string_vector +octave_base_value::parent_class_names (void) const +{ + string_vector retval; + gripe_wrong_type_arg ("octave_base_value::parent_class_names()", + type_name ()); + return retval; +} + +octave_function * +octave_base_value::function_value (bool silent) +{ + octave_function *retval = 0; + + if (! silent) + gripe_wrong_type_arg ("octave_base_value::function_value()", + type_name ()); + return retval; +} + +octave_user_function * +octave_base_value::user_function_value (bool silent) +{ + octave_user_function *retval = 0; + + if (! silent) + gripe_wrong_type_arg ("octave_base_value::user_function_value()", + type_name ()); + return retval; +} + +octave_user_script * +octave_base_value::user_script_value (bool silent) +{ + octave_user_script *retval = 0; + + if (! silent) + gripe_wrong_type_arg ("octave_base_value::user_script_value()", + type_name ()); + return retval; +} + +octave_user_code * +octave_base_value::user_code_value (bool silent) +{ + octave_user_code *retval = 0; + + if (! silent) + gripe_wrong_type_arg ("octave_base_value::user_code_value()", + type_name ()); + return retval; +} + +octave_fcn_handle * +octave_base_value::fcn_handle_value (bool silent) +{ + octave_fcn_handle *retval = 0; + + if (! silent) + gripe_wrong_type_arg ("octave_base_value::fcn_handle_value()", + type_name ()); + return retval; +} + +octave_fcn_inline * +octave_base_value::fcn_inline_value (bool silent) +{ + octave_fcn_inline *retval = 0; + + if (! silent) + gripe_wrong_type_arg ("octave_base_value::fcn_inline_value()", + type_name ()); + return retval; +} + +octave_value_list +octave_base_value::list_value (void) const +{ + octave_value_list retval; + gripe_wrong_type_arg ("octave_base_value::list_value()", type_name ()); + return retval; +} + +bool +octave_base_value::save_ascii (std::ostream&) +{ + gripe_wrong_type_arg ("octave_base_value::save_ascii()", type_name ()); + return false; +} + +bool +octave_base_value::load_ascii (std::istream&) +{ + gripe_wrong_type_arg ("octave_base_value::load_ascii()", type_name ()); + return false; +} + +bool +octave_base_value::save_binary (std::ostream&, bool&) +{ + gripe_wrong_type_arg ("octave_base_value::save_binary()", type_name ()); + return false; +} + +bool +octave_base_value::load_binary (std::istream&, bool, + oct_mach_info::float_format) +{ + gripe_wrong_type_arg ("octave_base_value::load_binary()", type_name ()); + return false; +} + +#if defined (HAVE_HDF5) + +bool +octave_base_value::save_hdf5 (hid_t, const char *, bool) +{ + gripe_wrong_type_arg ("octave_base_value::save_binary()", type_name ()); + + return false; +} + +bool +octave_base_value::load_hdf5 (hid_t, const char *) +{ + gripe_wrong_type_arg ("octave_base_value::load_binary()", type_name ()); + + return false; +} + +#endif + +int +octave_base_value::write (octave_stream&, int, oct_data_conv::data_type, + int, oct_mach_info::float_format) const +{ + gripe_wrong_type_arg ("octave_base_value::write()", type_name ()); + + return false; +} + +mxArray * +octave_base_value::as_mxArray (void) const +{ + return 0; +} + +octave_value +octave_base_value::diag (octave_idx_type) const +{ + gripe_wrong_type_arg ("octave_base_value::diag ()", type_name ()); + + return octave_value (); +} + +octave_value +octave_base_value::diag (octave_idx_type, octave_idx_type) const +{ + gripe_wrong_type_arg ("octave_base_value::diag ()", type_name ()); + + return octave_value (); +} + +octave_value +octave_base_value::sort (octave_idx_type, sortmode) const +{ + gripe_wrong_type_arg ("octave_base_value::sort ()", type_name ()); + + return octave_value (); +} + +octave_value +octave_base_value::sort (Array &, + octave_idx_type, sortmode) const +{ + gripe_wrong_type_arg ("octave_base_value::sort ()", type_name ()); + + return octave_value (); +} + +sortmode +octave_base_value::is_sorted (sortmode) const +{ + gripe_wrong_type_arg ("octave_base_value::is_sorted ()", type_name ()); + + return UNSORTED; +} + +Array +octave_base_value::sort_rows_idx (sortmode) const +{ + gripe_wrong_type_arg ("octave_base_value::sort_rows_idx ()", type_name ()); + + return Array (); +} + +sortmode +octave_base_value::is_sorted_rows (sortmode) const +{ + gripe_wrong_type_arg ("octave_base_value::is_sorted_rows ()", type_name ()); + + return UNSORTED; +} + + +const char * +octave_base_value::get_umap_name (unary_mapper_t umap) +{ + static const char *names[num_unary_mappers] = + { + "abs", + "acos", + "acosh", + "angle", + "arg", + "asin", + "asinh", + "atan", + "atanh", + "cbrt", + "ceil", + "conj", + "cos", + "cosh", + "erf", + "erfinv", + "erfcinv", + "erfc", + "exp", + "expm1", + "finite", + "fix", + "floor", + "gamma", + "imag", + "isinf", + "isna", + "isnan", + "lgamma", + "log", + "log2", + "log10", + "log1p", + "real", + "round", + "roundb", + "signum", + "sin", + "sinh", + "sqrt", + "tan", + "tanh", + "isalnum", + "isalpha", + "isascii", + "iscntrl", + "isdigit", + "isgraph", + "islower", + "isprint", + "ispunct", + "isspace", + "isupper", + "isxdigit", + "toascii", + "tolower", + "toupper" + }; + + if (umap < 0 || umap >= num_unary_mappers) + return "unknown"; + else + return names[umap]; +} + +octave_value +octave_base_value::map (unary_mapper_t umap) const +{ + error ("%s: not defined for %s", get_umap_name (umap), type_name ().c_str ()); + return octave_value (); +} + +void +octave_base_value::lock (void) +{ + gripe_wrong_type_arg ("octave_base_value::lock ()", type_name ()); +} + +void +octave_base_value::unlock (void) +{ + gripe_wrong_type_arg ("octave_base_value::unlock ()", type_name ()); +} + +void +octave_base_value::dump (std::ostream& os) const +{ + dim_vector dv = this->dims (); + + os << "class: " << this->class_name () + << " type: " << this->type_name () + << " dims: " << dv.str (); +} + +static void +gripe_indexed_assignment (const std::string& tn1, const std::string& tn2) +{ + error ("assignment of `%s' to indexed `%s' not implemented", + tn2.c_str (), tn1.c_str ()); +} + +static void +gripe_assign_conversion_failed (const std::string& tn1, + const std::string& tn2) +{ + error ("type conversion for assignment of `%s' to indexed `%s' failed", + tn2.c_str (), tn1.c_str ()); +} + +static void +gripe_no_conversion (const std::string& on, const std::string& tn1, + const std::string& tn2) +{ + error ("operator %s: no conversion for assignment of `%s' to indexed `%s'", + on.c_str (), tn2.c_str (), tn1.c_str ()); +} + +octave_value +octave_base_value::numeric_assign (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + octave_value retval; + + if (idx.front ().empty ()) + { + error ("missing index in indexed assignment"); + return retval; + } + + int t_lhs = type_id (); + int t_rhs = rhs.type_id (); + + octave_value_typeinfo::assign_op_fcn f + = octave_value_typeinfo::lookup_assign_op (octave_value::op_asn_eq, + t_lhs, t_rhs); + + bool done = false; + + if (f) + { + f (*this, idx.front (), rhs.get_rep ()); + + done = (! error_state); + } + + if (done) + { + count++; + retval = octave_value (this); + } + else + { + int t_result + = octave_value_typeinfo::lookup_pref_assign_conv (t_lhs, t_rhs); + + if (t_result >= 0) + { + octave_base_value::type_conv_fcn cf + = octave_value_typeinfo::lookup_widening_op (t_lhs, t_result); + + if (cf) + { + octave_base_value *tmp = cf (*this); + + if (tmp) + { + octave_value val (tmp); + + retval = val.subsasgn (type, idx, rhs); + + done = (! error_state); + } + else + gripe_assign_conversion_failed (type_name (), + rhs.type_name ()); + } + else + gripe_indexed_assignment (type_name (), rhs.type_name ()); + } + + if (! (done || error_state)) + { + octave_value tmp_rhs; + + octave_base_value::type_conv_info cf_rhs + = rhs.numeric_conversion_function (); + + octave_base_value::type_conv_info cf_this + = numeric_conversion_function (); + + // Try biased (one-sided) conversions first. + if (cf_rhs.type_id () >= 0 + && (octave_value_typeinfo::lookup_assign_op (octave_value::op_asn_eq, + t_lhs, cf_rhs.type_id ()) + || octave_value_typeinfo::lookup_pref_assign_conv (t_lhs, + cf_rhs.type_id ()) >= 0)) + cf_this = 0; + else if (cf_this.type_id () >= 0 + && (octave_value_typeinfo::lookup_assign_op (octave_value::op_asn_eq, + cf_this.type_id (), t_rhs) + || octave_value_typeinfo::lookup_pref_assign_conv (cf_this.type_id (), + t_rhs) >= 0)) + cf_rhs = 0; + + if (cf_rhs) + { + octave_base_value *tmp = cf_rhs (rhs.get_rep ()); + + if (tmp) + tmp_rhs = octave_value (tmp); + else + { + gripe_assign_conversion_failed (type_name (), + rhs.type_name ()); + return octave_value (); + } + } + else + tmp_rhs = rhs; + + count++; + octave_value tmp_lhs = octave_value (this); + + if (cf_this) + { + octave_base_value *tmp = cf_this (*this); + + if (tmp) + tmp_lhs = octave_value (tmp); + else + { + gripe_assign_conversion_failed (type_name (), + rhs.type_name ()); + return octave_value (); + } + } + + if (cf_this || cf_rhs) + { + retval = tmp_lhs.subsasgn (type, idx, tmp_rhs); + + done = (! error_state); + } + else + gripe_no_conversion (octave_value::assign_op_as_string (octave_value::op_asn_eq), + type_name (), rhs.type_name ()); + } + } + + // The assignment may have converted to a type that is wider than + // necessary. + + retval.maybe_mutate (); + + return retval; +} + +// Current indentation. +int octave_base_value::curr_print_indent_level = 0; + +// TRUE means we are at the beginning of a line. +bool octave_base_value::beginning_of_line = true; + +// Each print() function should call this before printing anything. +// +// This doesn't need to be fast, but isn't there a better way? + +void +octave_base_value::indent (std::ostream& os) const +{ + assert (curr_print_indent_level >= 0); + + if (beginning_of_line) + { + // FIXME -- do we need this? + // os << prefix; + + for (int i = 0; i < curr_print_indent_level; i++) + os << " "; + + beginning_of_line = false; + } +} + +// All print() functions should use this to print new lines. + +void +octave_base_value::newline (std::ostream& os) const +{ + os << "\n"; + + beginning_of_line = true; +} + +// For ressetting print state. + +void +octave_base_value::reset (void) const +{ + beginning_of_line = true; + curr_print_indent_level = 0; +} + + +octave_value +octave_base_value::fast_elem_extract (octave_idx_type) const +{ + return octave_value (); +} + +bool +octave_base_value::fast_elem_insert (octave_idx_type, const octave_value&) +{ + return false; +} + +bool +octave_base_value::fast_elem_insert_self (void *, builtin_type_t) const +{ + return false; +} + +CONVDECLX (matrix_conv) +{ + return new octave_matrix (); +} + +CONVDECLX (complex_matrix_conv) +{ + return new octave_complex_matrix (); +} + +CONVDECLX (string_conv) +{ + return new octave_char_matrix_str (); +} + +CONVDECLX (cell_conv) +{ + return new octave_cell (); +} + +void +install_base_type_conversions (void) +{ + INSTALL_ASSIGNCONV (octave_base_value, octave_scalar, octave_matrix); + INSTALL_ASSIGNCONV (octave_base_value, octave_matrix, octave_matrix); + INSTALL_ASSIGNCONV (octave_base_value, octave_complex, octave_complex_matrix); + INSTALL_ASSIGNCONV (octave_base_value, octave_complex_matrix, octave_complex_matrix); + INSTALL_ASSIGNCONV (octave_base_value, octave_range, octave_matrix); + INSTALL_ASSIGNCONV (octave_base_value, octave_char_matrix_str, octave_char_matrix_str); + INSTALL_ASSIGNCONV (octave_base_value, octave_cell, octave_cell); + + INSTALL_WIDENOP (octave_base_value, octave_matrix, matrix_conv); + INSTALL_WIDENOP (octave_base_value, octave_complex_matrix, complex_matrix_conv); + INSTALL_WIDENOP (octave_base_value, octave_char_matrix_str, string_conv); + INSTALL_WIDENOP (octave_base_value, octave_cell, cell_conv); +} + +DEFUN (sparse_auto_mutate, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} sparse_auto_mutate ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} sparse_auto_mutate (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} sparse_auto_mutate (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will\n\ +automatically mutate sparse matrices to full matrices to save memory.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +s = speye (3);\n\ +sparse_auto_mutate (false);\n\ +s(:, 1) = 1;\n\ +typeinfo (s)\n\ +@result{} sparse matrix\n\ +sparse_auto_mutate (true);\n\ +s(1, :) = 1;\n\ +typeinfo (s)\n\ +@result{} matrix\n\ +@end group\n\ +@end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (sparse_auto_mutate); +} + +/* +%!test +%! s = speye (3); +%! sparse_auto_mutate (false); +%! s(:, 1) = 1; +%! assert (typeinfo (s), "sparse matrix"); +%! sparse_auto_mutate (true); +%! s(1, :) = 1; +%! assert (typeinfo (s), "matrix"); +%! sparse_auto_mutate (false); +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-base.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-base.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,820 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_base_value_h) +#define octave_base_value_h 1 + +#include + +#include +#include +#include + +#include "Range.h" +#include "data-conv.h" +#include "mxarray.h" +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-hdf5.h" + +class Cell; +class octave_map; +class octave_scalar_map; +class octave_value; +class octave_value_list; +class octave_stream; +class octave_function; +class octave_user_function; +class octave_user_script; +class octave_user_code; +class octave_fcn_handle; +class octave_fcn_inline; +class octave_value_list; +class octave_lvalue; + +class tree_walker; + +enum builtin_type_t +{ + btyp_double, + btyp_float, + btyp_complex, + btyp_float_complex, + btyp_int8, + btyp_int16, + btyp_int32, + btyp_int64, + btyp_uint8, + btyp_uint16, + btyp_uint32, + btyp_uint64, + btyp_bool, + btyp_char, + btyp_struct, + btyp_cell, + btyp_func_handle, + btyp_unknown, + btyp_num_types = btyp_unknown +}; + +extern OCTINTERP_API std::string +btyp_class_name [btyp_num_types]; + +extern OCTINTERP_API string_vector +get_builtin_classes (void); + +inline bool btyp_isnumeric (builtin_type_t btyp) +{ return btyp <= btyp_uint64; } + +inline bool btyp_isinteger (builtin_type_t btyp) +{ return btyp >= btyp_int8 && btyp <= btyp_uint64; } + +inline bool btyp_isfloat (builtin_type_t btyp) +{ return btyp <= btyp_float_complex; } + +inline bool btyp_isarray (builtin_type_t btyp) +{ return btyp <= btyp_char; } + +// Compute a numeric type for a possibly mixed-type operation, using these rules: +// bool -> double +// single + double -> single +// real + complex -> complex +// integer + real -> integer +// uint + uint -> uint (the bigger one) +// sint + sint -> sint (the bigger one) +// +// failing otherwise. + +extern OCTINTERP_API +builtin_type_t btyp_mixed_numeric (builtin_type_t x, builtin_type_t y); + +template +struct class_to_btyp +{ + static const builtin_type_t btyp = btyp_unknown; +}; + +#define DEF_CLASS_TO_BTYP(CLASS,BTYP) \ +template <> \ +struct class_to_btyp \ +{ static const builtin_type_t btyp = BTYP; } + +DEF_CLASS_TO_BTYP (double, btyp_double); +DEF_CLASS_TO_BTYP (float, btyp_float); +DEF_CLASS_TO_BTYP (Complex, btyp_complex); +DEF_CLASS_TO_BTYP (FloatComplex, btyp_float_complex); +DEF_CLASS_TO_BTYP (octave_int8, btyp_int8); +DEF_CLASS_TO_BTYP (octave_int16, btyp_int16); +DEF_CLASS_TO_BTYP (octave_int32, btyp_int32); +DEF_CLASS_TO_BTYP (octave_int64, btyp_int64); +DEF_CLASS_TO_BTYP (octave_uint8, btyp_uint8); +DEF_CLASS_TO_BTYP (octave_uint16, btyp_uint16); +DEF_CLASS_TO_BTYP (octave_uint32, btyp_uint32); +DEF_CLASS_TO_BTYP (octave_uint64, btyp_uint64); +DEF_CLASS_TO_BTYP (bool, btyp_bool); +DEF_CLASS_TO_BTYP (char, btyp_char); + +// T_ID is the type id of struct objects, set by register_type(). +// T_NAME is the type name of struct objects. + +#define DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA \ + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA2 (OCTAVE_EMPTY_CPP_ARG) + +#define DECLARE_OV_BASE_TYPEID_FUNCTIONS_AND_DATA \ + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA2(virtual) + +#define DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA2(VIRTUAL) \ + public: \ + VIRTUAL int type_id (void) const { return t_id; } \ + VIRTUAL std::string type_name (void) const { return t_name; } \ + VIRTUAL std::string class_name (void) const { return c_name; } \ + static int static_type_id (void) { return t_id; } \ + static std::string static_type_name (void) { return t_name; } \ + static std::string static_class_name (void) { return c_name; } \ + static void register_type (void); \ + \ + private: \ + static int t_id; \ + static const std::string t_name; \ + static const std::string c_name; + + +#define DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA(t, n, c) \ + int t::t_id (-1); \ + const std::string t::t_name (n); \ + const std::string t::c_name (c); \ + void t::register_type (void) \ + { \ + static t exemplar; \ + octave_value v (&exemplar, true); \ + t_id = octave_value_typeinfo::register_type (t::t_name, t::c_name, v); \ + } + +// A base value type, so that derived types only have to redefine what +// they need (if they are derived from octave_base_value instead of +// octave_value). + +class +OCTINTERP_API +octave_base_value +{ +public: + + typedef octave_base_value * (*type_conv_fcn) (const octave_base_value&); + + // type conversion, including result type information + class type_conv_info + { + public: + type_conv_info (type_conv_fcn f = 0, int t = -1) : _fcn (f), _type_id (t) { } + + operator type_conv_fcn (void) const { return _fcn; } + + octave_base_value * operator () (const octave_base_value &v) const + { return (*_fcn) (v); } + + int type_id (void) const { return _type_id; } + + private: + type_conv_fcn _fcn; + int _type_id; + }; + + friend class octave_value; + + octave_base_value (void) : count (1) { } + + octave_base_value (const octave_base_value&) : count (1) { } + + virtual ~octave_base_value (void) { } + + // Unconditional clone. Always clones. + virtual octave_base_value * + clone (void) const { return new octave_base_value (*this); } + + // Empty clone. + virtual octave_base_value * + empty_clone (void) const; + + // Unique clone. Usually clones, but may be overriden to fake the + // cloning when sharing copies is to be controlled from within an + // instance (see octave_class). + virtual octave_base_value * + unique_clone (void) { return clone (); } + + virtual type_conv_info + numeric_conversion_function (void) const + { return type_conv_info (); } + + virtual type_conv_info + numeric_demotion_function (void) const + { return type_conv_info (); } + + virtual octave_value squeeze (void) const; + + virtual octave_value full_value (void) const; + + virtual octave_base_value *try_narrowing_conversion (void) { return 0; } + + virtual void maybe_economize (void) { } + + virtual Matrix size (void); + + virtual octave_idx_type numel (const octave_value_list&); + + virtual octave_value + subsref (const std::string& type, + const std::list& idx); + + virtual octave_value_list + subsref (const std::string& type, + const std::list& idx, + int nargout); + + virtual octave_value + subsref (const std::string& type, + const std::list& idx, + bool auto_add); + + virtual octave_value_list + subsref (const std::string& type, + const std::list& idx, + int nargout, + const std::list *lvalue_list); + + virtual octave_value + do_index_op (const octave_value_list& idx, bool resize_ok = false); + + virtual octave_value_list + do_multi_index_op (int nargout, const octave_value_list& idx); + + virtual octave_value_list + do_multi_index_op (int nargout, const octave_value_list& idx, + const std::list *lvalue_list); + + virtual void assign (const std::string&, const octave_value&) { } + + virtual octave_value + subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + virtual octave_value + undef_subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + virtual idx_vector index_vector (void) const; + + virtual dim_vector dims (void) const { return dim_vector (); } + + octave_idx_type rows (void) const + { + const dim_vector dv = dims (); + + return dv(0); + } + + octave_idx_type columns (void) const + { + const dim_vector dv = dims (); + + return dv(1); + } + + virtual int ndims (void) const + { return dims ().length (); } + + virtual octave_idx_type numel (void) const { return dims ().numel (); } + + virtual octave_idx_type capacity (void) const { return numel (); } + + virtual size_t byte_size (void) const { return 0; } + + virtual octave_idx_type nnz (void) const; + + virtual octave_idx_type nzmax (void) const; + + virtual octave_idx_type nfields (void) const; + + virtual octave_value reshape (const dim_vector&) const; + + virtual octave_value permute (const Array& vec, bool = false) const; + + virtual octave_value resize (const dim_vector&, bool fill = false) const; + + virtual MatrixType matrix_type (void) const; + + virtual MatrixType matrix_type (const MatrixType& typ) const; + + virtual bool is_defined (void) const { return false; } + + bool is_empty (void) const { return numel () == 0; } + + virtual bool is_cell (void) const { return false; } + + virtual bool is_cellstr (void) const { return false; } + + virtual bool is_real_scalar (void) const { return false; } + + virtual bool is_real_matrix (void) const { return false; } + + virtual bool is_real_nd_array (void) const { return false; } + + virtual bool is_complex_scalar (void) const { return false; } + + virtual bool is_complex_matrix (void) const { return false; } + + virtual bool is_bool_scalar (void) const { return false; } + + virtual bool is_bool_matrix (void) const { return false; } + + virtual bool is_char_matrix (void) const { return false; } + + virtual bool is_diag_matrix (void) const { return false; } + + virtual bool is_perm_matrix (void) const { return false; } + + virtual bool is_string (void) const { return false; } + + virtual bool is_sq_string (void) const { return false; } + + virtual bool is_range (void) const { return false; } + + virtual bool is_map (void) const { return false; } + + virtual bool is_object (void) const { return false; } + + virtual bool is_cs_list (void) const { return false; } + + virtual bool is_magic_colon (void) const { return false; } + + virtual bool is_all_va_args (void) const { return false; } + + virtual octave_value all (int = 0) const; + + virtual octave_value any (int = 0) const; + + virtual builtin_type_t builtin_type (void) const { return btyp_unknown; } + + virtual bool is_double_type (void) const { return false; } + + virtual bool is_single_type (void) const { return false; } + + virtual bool is_float_type (void) const { return false; } + + virtual bool is_int8_type (void) const { return false; } + + virtual bool is_int16_type (void) const { return false; } + + virtual bool is_int32_type (void) const { return false; } + + virtual bool is_int64_type (void) const { return false; } + + virtual bool is_uint8_type (void) const { return false; } + + virtual bool is_uint16_type (void) const { return false; } + + virtual bool is_uint32_type (void) const { return false; } + + virtual bool is_uint64_type (void) const { return false; } + + virtual bool is_bool_type (void) const { return false; } + + virtual bool is_integer_type (void) const { return false; } + + virtual bool is_real_type (void) const { return false; } + + virtual bool is_complex_type (void) const { return false; } + + // Would be nice to get rid of the next four functions: + + virtual bool is_scalar_type (void) const { return false; } + + virtual bool is_matrix_type (void) const { return false; } + + virtual bool is_numeric_type (void) const { return false; } + + virtual bool is_sparse_type (void) const { return false; } + + virtual bool is_true (void) const { return false; } + + virtual bool is_null_value (void) const { return false; } + + virtual bool is_constant (void) const { return false; } + + virtual bool is_function_handle (void) const { return false; } + + virtual bool is_anonymous_function (void) const { return false; } + + virtual bool is_inline_function (void) const { return false; } + + virtual bool is_function (void) const { return false; } + + virtual bool is_user_script (void) const { return false; } + + virtual bool is_user_function (void) const { return false; } + + virtual bool is_user_code (void) const { return false; } + + virtual bool is_builtin_function (void) const { return false; } + + virtual bool is_dld_function (void) const { return false; } + + virtual bool is_mex_function (void) const { return false; } + + virtual void erase_subfunctions (void) { } + + virtual short int short_value (bool = false, bool = false) const; + + virtual unsigned short int ushort_value (bool = false, bool = false) const; + + virtual int int_value (bool = false, bool = false) const; + + virtual unsigned int uint_value (bool = false, bool = false) const; + + virtual int nint_value (bool = false) const; + + virtual long int long_value (bool = false, bool = false) const; + + virtual unsigned long int ulong_value (bool = false, bool = false) const; + + virtual double double_value (bool = false) const; + + virtual float float_value (bool = false) const; + + virtual double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + virtual float float_scalar_value (bool frc_str_conv = false) const + { return float_value (frc_str_conv); } + + virtual Cell cell_value (void) const; + + virtual Matrix matrix_value (bool = false) const; + + virtual FloatMatrix float_matrix_value (bool = false) const; + + virtual NDArray array_value (bool = false) const; + + virtual FloatNDArray float_array_value (bool = false) const; + + virtual Complex complex_value (bool = false) const; + + virtual FloatComplex float_complex_value (bool = false) const; + + virtual ComplexMatrix complex_matrix_value (bool = false) const; + + virtual FloatComplexMatrix float_complex_matrix_value (bool = false) const; + + virtual ComplexNDArray complex_array_value (bool = false) const; + + virtual FloatComplexNDArray float_complex_array_value (bool = false) const; + + virtual bool bool_value (bool = false) const; + + virtual boolMatrix bool_matrix_value (bool = false) const; + + virtual boolNDArray bool_array_value (bool = false) const; + + virtual charMatrix char_matrix_value (bool force = false) const; + + virtual charNDArray char_array_value (bool = false) const; + + virtual SparseMatrix sparse_matrix_value (bool = false) const; + + virtual SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; + + virtual SparseBoolMatrix sparse_bool_matrix_value (bool = false) const; + + virtual DiagMatrix diag_matrix_value (bool = false) const; + + virtual FloatDiagMatrix float_diag_matrix_value (bool = false) const; + + virtual ComplexDiagMatrix complex_diag_matrix_value (bool = false) const; + + virtual FloatComplexDiagMatrix float_complex_diag_matrix_value (bool = false) const; + + virtual PermMatrix perm_matrix_value (void) const; + + virtual octave_int8 int8_scalar_value (void) const; + + virtual octave_int16 int16_scalar_value (void) const; + + virtual octave_int32 int32_scalar_value (void) const; + + virtual octave_int64 int64_scalar_value (void) const; + + virtual octave_uint8 uint8_scalar_value (void) const; + + virtual octave_uint16 uint16_scalar_value (void) const; + + virtual octave_uint32 uint32_scalar_value (void) const; + + virtual octave_uint64 uint64_scalar_value (void) const; + + virtual int8NDArray int8_array_value (void) const; + + virtual int16NDArray int16_array_value (void) const; + + virtual int32NDArray int32_array_value (void) const; + + virtual int64NDArray int64_array_value (void) const; + + virtual uint8NDArray uint8_array_value (void) const; + + virtual uint16NDArray uint16_array_value (void) const; + + virtual uint32NDArray uint32_array_value (void) const; + + virtual uint64NDArray uint64_array_value (void) const; + + virtual string_vector all_strings (bool pad = false) const; + + virtual std::string string_value (bool force = false) const; + + virtual Array cellstr_value (void) const; + + virtual Range range_value (void) const; + + virtual octave_map map_value (void) const; + + virtual octave_scalar_map scalar_map_value (void) const; + + virtual string_vector map_keys (void) const; + + virtual size_t nparents (void) const; + + virtual std::list parent_class_name_list (void) const; + + virtual string_vector parent_class_names (void) const; + + virtual octave_base_value *find_parent_class (const std::string&) + { return 0; } + + virtual octave_base_value *unique_parent_class (const std::string&) + { return 0; } + + virtual octave_function *function_value (bool silent = false); + + virtual octave_user_function *user_function_value (bool silent = false); + + virtual octave_user_script *user_script_value (bool silent = false); + + virtual octave_user_code *user_code_value (bool silent = false); + + virtual octave_fcn_handle *fcn_handle_value (bool silent = false); + + virtual octave_fcn_inline *fcn_inline_value (bool silent = false); + + virtual octave_value_list list_value (void) const; + + virtual octave_value convert_to_str (bool pad = false, bool force = false, + char type = '\'') const; + virtual octave_value + convert_to_str_internal (bool pad, bool force, char type) const; + + virtual void convert_to_row_or_column_vector (void); + + virtual bool print_as_scalar (void) const { return false; } + + virtual void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + virtual void + print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + virtual bool + print_name_tag (std::ostream& os, const std::string& name) const; + + virtual void + print_with_name (std::ostream& output_buf, const std::string& name, + bool print_padding = true); + + virtual void print_info (std::ostream& os, const std::string& prefix) const; + + virtual bool save_ascii (std::ostream& os); + + virtual bool load_ascii (std::istream& is); + + virtual bool save_binary (std::ostream& os, bool& save_as_floats); + + virtual bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + virtual bool + save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + virtual bool + load_hdf5 (hid_t loc_id, const char *name); +#endif + + virtual int + write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const; + + virtual void *mex_get_data (void) const { return 0; } + + virtual octave_idx_type *mex_get_ir (void) const { return 0; } + + virtual octave_idx_type *mex_get_jc (void) const { return 0; } + + virtual mxArray *as_mxArray (void) const; + + virtual octave_value diag (octave_idx_type k = 0) const; + + virtual octave_value diag (octave_idx_type m, octave_idx_type n) const; + + virtual octave_value sort (octave_idx_type dim = 0, + sortmode mode = ASCENDING) const; + virtual octave_value sort (Array &sidx, + octave_idx_type dim = 0, + sortmode mode = ASCENDING) const; + + virtual sortmode is_sorted (sortmode mode = UNSORTED) const; + + virtual Array + sort_rows_idx (sortmode mode = ASCENDING) const; + + virtual sortmode is_sorted_rows (sortmode mode = UNSORTED) const; + + virtual void lock (void); + + virtual void unlock (void); + + virtual bool islocked (void) const { return false; } + + virtual void dump (std::ostream& os) const; + + // Standard mappers. Register new ones here. + enum unary_mapper_t + { + umap_abs, + umap_acos, + umap_acosh, + umap_angle, + umap_arg, + umap_asin, + umap_asinh, + umap_atan, + umap_atanh, + umap_cbrt, + umap_ceil, + umap_conj, + umap_cos, + umap_cosh, + umap_erf, + umap_erfinv, + umap_erfcinv, + umap_erfc, + umap_erfcx, + umap_exp, + umap_expm1, + umap_finite, + umap_fix, + umap_floor, + umap_gamma, + umap_imag, + umap_isinf, + umap_isna, + umap_isnan, + umap_lgamma, + umap_log, + umap_log2, + umap_log10, + umap_log1p, + umap_real, + umap_round, + umap_roundb, + umap_signum, + umap_sin, + umap_sinh, + umap_sqrt, + umap_tan, + umap_tanh, + umap_xisalnum, + umap_xisalpha, + umap_xisascii, + umap_xiscntrl, + umap_xisdigit, + umap_xisgraph, + umap_xislower, + umap_xisprint, + umap_xispunct, + umap_xisspace, + umap_xisupper, + umap_xisxdigit, + umap_xtoascii, + umap_xtolower, + umap_xtoupper, + umap_unknown, + num_unary_mappers = umap_unknown + }; + + virtual octave_value map (unary_mapper_t) const; + + // These are fast indexing & assignment shortcuts for extracting + // or inserting a single scalar from/to an array. + + // Extract the n-th element, aka val(n). Result is undefined if val is not an + // array type or n is out of range. Never error. + virtual octave_value + fast_elem_extract (octave_idx_type n) const; + + // Assign the n-th element, aka val(n) = x. Returns false if val is not an + // array type, x is not a matching scalar type, or n is out of range. + // Never error. + virtual bool + fast_elem_insert (octave_idx_type n, const octave_value& x); + + // This is a helper for the above, to be overriden in scalar types. The + // whole point is to handle the insertion efficiently with just *two* VM + // calls, which is basically the theoretical minimum. + virtual bool + fast_elem_insert_self (void *where, builtin_type_t btyp) const; + + // Grab the reference count. For use by jit. + void + grab (void) + { + ++count; + } + + // Release the reference count. For use by jit. + void + release (void) + { + if (--count == 0) + delete this; + } + +protected: + + // This should only be called for derived types. + + octave_value numeric_assign (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + void reset_indent_level (void) const + { curr_print_indent_level = 0; } + + void increment_indent_level (void) const + { curr_print_indent_level += 2; } + + void decrement_indent_level (void) const + { curr_print_indent_level -= 2; } + + int current_print_indent_level (void) const + { return curr_print_indent_level; } + + void indent (std::ostream& os) const; + + void newline (std::ostream& os) const; + + void reset (void) const; + + // A reference count. + // NOTE: the declaration is octave_idx_type because with 64-bit indexing, + // it is well possible to have more than MAX_INT copies of a single value + // (think of an empty cell array with >2G elements). + octave_refcount count; + +private: + + static const char *get_umap_name (unary_mapper_t); + + static int curr_print_indent_level; + static bool beginning_of_line; + + DECLARE_OV_BASE_TYPEID_FUNCTIONS_AND_DATA +}; + +// TRUE means to perform automatic sparse to real mutation if there +// is memory to be saved +extern OCTINTERP_API bool Vsparse_auto_mutate; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-bool-mat.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-bool-mat.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,588 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "lo-ieee.h" +#include "mx-base.h" +#include "oct-locbuf.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "ops.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-base-mat.cc" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-re-mat.h" +#include "pr-output.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-hdf5.h" +#include "ls-utils.h" + +template class octave_base_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_bool_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_bool_matrix, + "bool matrix", "logical"); + +static octave_base_value * +default_numeric_conversion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_bool_matrix&); + + return new octave_matrix (NDArray (v.bool_array_value ())); +} + +octave_base_value::type_conv_info +octave_bool_matrix::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_conversion_function, + octave_matrix::static_type_id ()); +} + +octave_base_value * +octave_bool_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (matrix.ndims () == 2) + { + boolMatrix bm = matrix.matrix_value (); + + octave_idx_type nr = bm.rows (); + octave_idx_type nc = bm.cols (); + + if (nr == 1 && nc == 1) + retval = new octave_bool (bm (0, 0)); + } + + return retval; +} + +double +octave_bool_matrix::double_value (bool) const +{ + double retval = lo_ieee_nan_value (); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "bool matrix", "real scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("bool matrix", "real scalar"); + + return retval; +} + +float +octave_bool_matrix::float_value (bool) const +{ + float retval = lo_ieee_float_nan_value (); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "bool matrix", "real scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("bool matrix", "real scalar"); + + return retval; +} + +Complex +octave_bool_matrix::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "bool matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("bool matrix", "complex scalar"); + + return retval; +} + +FloatComplex +octave_bool_matrix::float_complex_value (bool) const +{ + float tmp = lo_ieee_float_nan_value (); + + FloatComplex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "bool matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("bool matrix", "complex scalar"); + + return retval; +} + +octave_value +octave_bool_matrix::convert_to_str_internal (bool pad, bool force, + char type) const +{ + octave_value tmp = octave_value (array_value ()); + return tmp.convert_to_str (pad, force, type); +} + +void +octave_bool_matrix::print_raw (std::ostream& os, + bool pr_as_read_syntax) const +{ + octave_print_internal (os, matrix, pr_as_read_syntax, + current_print_indent_level ()); +} + +bool +octave_bool_matrix::save_ascii (std::ostream& os) +{ + dim_vector d = dims (); + if (d.length () > 2) + { + NDArray tmp = array_value (); + os << "# ndims: " << d.length () << "\n"; + + for (int i = 0; i < d.length (); i++) + os << " " << d (i); + + os << "\n" << tmp; + } + else + { + // Keep this case, rather than use generic code above for backward + // compatiability. Makes load_ascii much more complex!! + os << "# rows: " << rows () << "\n" + << "# columns: " << columns () << "\n"; + + Matrix tmp = matrix_value (); + + os << tmp; + } + + return true; +} + +bool +octave_bool_matrix::load_ascii (std::istream& is) +{ + bool success = true; + + string_vector keywords (2); + + keywords[0] = "ndims"; + keywords[1] = "rows"; + + std::string kw; + octave_idx_type val = 0; + + if (extract_keyword (is, keywords, kw, val, true)) + { + if (kw == "ndims") + { + int mdims = static_cast (val); + + if (mdims >= 0) + { + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + is >> dv(i); + + if (is) + { + boolNDArray btmp (dv); + + if (btmp.is_empty ()) + matrix = btmp; + else + { + NDArray tmp(dv); + is >> tmp; + + if (is) + { + for (octave_idx_type i = 0; i < btmp.nelem (); i++) + btmp.elem (i) = (tmp.elem (i) != 0.); + + matrix = btmp; + } + else + { + error ("load: failed to load matrix constant"); + success = false; + } + } + } + else + { + error ("load: failed to extract dimensions"); + success = false; + } + } + else + { + error ("load: failed to extract number of dimensions"); + success = false; + } + } + else if (kw == "rows") + { + octave_idx_type nr = val; + octave_idx_type nc = 0; + + if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) + { + if (nr > 0 && nc > 0) + { + Matrix tmp (nr, nc); + is >> tmp; + if (is) + { + boolMatrix btmp (nr, nc); + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + btmp.elem (i,j) = (tmp.elem (i, j) != 0.); + + matrix = btmp; + } + else + { + error ("load: failed to load matrix constant"); + success = false; + } + } + else if (nr == 0 || nc == 0) + matrix = boolMatrix (nr, nc); + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + } + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + + return success; +} + +bool +octave_bool_matrix::save_binary (std::ostream& os, bool& /* save_as_floats */) +{ + + dim_vector d = dims (); + if (d.length () < 1) + return false; + + // Use negative value for ndims to differentiate with old format!! + int32_t tmp = - d.length (); + os.write (reinterpret_cast (&tmp), 4); + for (int i = 0; i < d.length (); i++) + { + tmp = d(i); + os.write (reinterpret_cast (&tmp), 4); + } + + boolNDArray m = bool_array_value (); + bool *mtmp = m.fortran_vec (); + octave_idx_type nel = m.nelem (); + OCTAVE_LOCAL_BUFFER (char, htmp, nel); + + for (octave_idx_type i = 0; i < nel; i++) + htmp[i] = (mtmp[i] ? 1 : 0); + + os.write (htmp, nel); + + return true; +} + +bool +octave_bool_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format /* fmt */) +{ + int32_t mdims; + if (! is.read (reinterpret_cast (&mdims), 4)) + return false; + if (swap) + swap_bytes<4> (&mdims); + if (mdims >= 0) + return false; + + // mdims is negative for consistency with other matrices, where it is + // negative to allow the positive value to be used for rows/cols for + // backward compatibility + mdims = - mdims; + int32_t di; + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + { + if (! is.read (reinterpret_cast (&di), 4)) + return false; + if (swap) + swap_bytes<4> (&di); + dv(i) = di; + } + + // Convert an array with a single dimension to be a row vector. + // Octave should never write files like this, other software + // might. + + if (mdims == 1) + { + mdims = 2; + dv.resize (mdims); + dv(1) = dv(0); + dv(0) = 1; + } + + octave_idx_type nel = dv.numel (); + OCTAVE_LOCAL_BUFFER (char, htmp, nel); + if (! is.read (htmp, nel)) + return false; + boolNDArray m(dv); + bool *mtmp = m.fortran_vec (); + for (octave_idx_type i = 0; i < nel; i++) + mtmp[i] = (htmp[i] ? 1 : 0); + matrix = m; + + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_bool_matrix::save_hdf5 (hid_t loc_id, const char *name, + bool /* save_as_floats */) +{ + dim_vector dv = dims (); + int empty = save_hdf5_empty (loc_id, name, dv); + if (empty) + return (empty > 0); + + int rank = dv.length (); + hid_t space_hid = -1, data_hid = -1; + bool retval = true; + boolNDArray m = bool_array_value (); + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + + // Octave uses column-major, while HDF5 uses row-major ordering + for (int i = 0; i < rank; i++) + hdims[i] = dv (rank-i-1); + + space_hid = H5Screate_simple (rank, hdims, 0); + if (space_hid < 0) return false; +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_HBOOL, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_HBOOL, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + return false; + } + + octave_idx_type nel = m.nelem (); + bool *mtmp = m.fortran_vec (); + OCTAVE_LOCAL_BUFFER (hbool_t, htmp, nel); + + for (octave_idx_type i = 0; i < nel; i++) + htmp[i] = mtmp[i]; + + retval = H5Dwrite (data_hid, H5T_NATIVE_HBOOL, H5S_ALL, H5S_ALL, + H5P_DEFAULT, htmp) >= 0; + + H5Dclose (data_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_bool_matrix::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; + + dim_vector dv; + int empty = load_hdf5_empty (loc_id, name, dv); + if (empty > 0) + matrix.resize (dv); + if (empty) + return (empty > 0); + +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t space_id = H5Dget_space (data_hid); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank < 1) + { + H5Dclose (data_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_id, hdims, maxdims); + + // Octave uses column-major, while HDF5 uses row-major ordering + if (rank == 1) + { + dv.resize (2); + dv(0) = 1; + dv(1) = hdims[0]; + } + else + { + dv.resize (rank); + for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) + dv(j) = hdims[i]; + } + + octave_idx_type nel = dv.numel (); + OCTAVE_LOCAL_BUFFER (hbool_t, htmp, nel); + if (H5Dread (data_hid, H5T_NATIVE_HBOOL, H5S_ALL, H5S_ALL, H5P_DEFAULT, htmp) >= 0) + { + retval = true; + + boolNDArray btmp (dv); + for (octave_idx_type i = 0; i < nel; i++) + btmp.elem (i) = htmp[i]; + + matrix = btmp; + } + + H5Dclose (data_hid); + + return retval; +} + +#endif + +mxArray * +octave_bool_matrix::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxLOGICAL_CLASS, dims (), mxREAL); + + bool *pr = static_cast (retval->get_data ()); + + mwSize nel = numel (); + + const bool *p = matrix.data (); + + for (mwIndex i = 0; i < nel; i++) + pr[i] = p[i]; + + return retval; +} + +DEFUN (logical, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} logical (@var{x})\n\ +Convert @var{x} to logical type.\n\ +@seealso{double, single, char}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + octave_value arg = args(0); + if (arg.is_bool_type ()) + retval = arg; + else if (arg.is_numeric_type ()) + { + if (arg.is_sparse_type ()) + retval = arg.sparse_bool_matrix_value (); + else if (arg.is_scalar_type ()) + retval = arg.bool_value (); + else + retval = arg.bool_array_value (); + } + else + gripe_wrong_type_arg ("logical", arg); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! m = eye (2) != 0; +%! s = !0; +%! c = {"double", "single", "int8", "int16", "int32", "int64", "uint8", "uint16", "uint32", "uint64", "logical"}; +%! for i = 1:numel (c) +%! assert (logical (eye (2, c{i})), m) +%! assert (logical (eye (1, c{i})), s) +%! endfor +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-bool-mat.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-bool-mat.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,235 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_bool_matrix_h) +#define octave_bool_matrix_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" + +#include "error.h" +#include "oct-stream.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" + +#include "MatrixType.h" + +class octave_value_list; + +class tree_walker; + +// Character matrix values. + +class +octave_bool_matrix : public octave_base_matrix +{ +public: + + octave_bool_matrix (void) + : octave_base_matrix () { } + + octave_bool_matrix (const boolNDArray& bnda) + : octave_base_matrix (bnda) { } + + octave_bool_matrix (const Array& bnda) + : octave_base_matrix (bnda) { } + + octave_bool_matrix (const boolMatrix& bm) + : octave_base_matrix (bm) { } + + octave_bool_matrix (const boolMatrix& bm, const MatrixType& t) + : octave_base_matrix (bm, t) { } + + octave_bool_matrix (const boolNDArray& bm, const idx_vector& cache) + : octave_base_matrix (bm) + { + set_idx_cache (cache); + } + + octave_bool_matrix (const octave_bool_matrix& bm) + : octave_base_matrix (bm) { } + + ~octave_bool_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_bool_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_bool_matrix (); } + + type_conv_info numeric_conversion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + idx_vector index_vector (void) const + { return idx_cache ? *idx_cache : set_idx_cache (idx_vector (matrix)); } + + builtin_type_t builtin_type (void) const { return btyp_bool; } + + bool is_bool_matrix (void) const { return true; } + + bool is_bool_type (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_numeric_type (void) const { return false; } + + int8NDArray + int8_array_value (void) const { return int8NDArray (matrix); } + + int16NDArray + int16_array_value (void) const { return int16NDArray (matrix); } + + int32NDArray + int32_array_value (void) const { return int32NDArray (matrix); } + + int64NDArray + int64_array_value (void) const { return int64NDArray (matrix); } + + uint8NDArray + uint8_array_value (void) const { return uint8NDArray (matrix); } + + uint16NDArray + uint16_array_value (void) const { return uint16NDArray (matrix); } + + uint32NDArray + uint32_array_value (void) const { return uint32NDArray (matrix); } + + uint64NDArray + uint64_array_value (void) const { return uint64NDArray (matrix); } + + double double_value (bool = false) const; + + float float_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const + { return Matrix (matrix.matrix_value ()); } + + FloatMatrix float_matrix_value (bool = false) const + { return FloatMatrix (matrix.matrix_value ()); } + + NDArray array_value (bool = false) const + { return NDArray (matrix); } + + FloatNDArray float_array_value (bool = false) const + { return FloatNDArray (matrix); } + + Complex complex_value (bool = false) const; + + FloatComplex float_complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const + { return ComplexMatrix (matrix.matrix_value ( )); } + + FloatComplexMatrix float_complex_matrix_value (bool = false) const + { return FloatComplexMatrix (matrix.matrix_value ( )); } + + ComplexNDArray complex_array_value (bool = false) const + { return ComplexNDArray (matrix); } + + FloatComplexNDArray float_complex_array_value (bool = false) const + { return FloatComplexNDArray (matrix); } + + charNDArray + char_array_value (bool = false) const + { + charNDArray retval (dims ()); + + octave_idx_type nel = numel (); + + for (octave_idx_type i = 0; i < nel; i++) + retval(i) = static_cast(matrix(i)); + + return retval; + } + + boolMatrix bool_matrix_value (bool = false) const + { return matrix.matrix_value (); } + + boolNDArray bool_array_value (bool = false) const + { return matrix; } + + SparseMatrix sparse_matrix_value (bool = false) const + { return SparseMatrix (Matrix (matrix.matrix_value ())); } + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const + { return SparseComplexMatrix (ComplexMatrix (matrix.matrix_value ())); } + + SparseBoolMatrix sparse_bool_matrix_value (bool = false) const + { return SparseBoolMatrix (matrix.matrix_value ()); } + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + + // Use matrix_ref here to clear index cache. + void invert (void) { matrix_ref ().invert (); } + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { return os.write (matrix, block_size, output_type, skip, flt_fmt); } + + // Unsafe. This function exists to support the MEX interface. + // You should not use it anywhere else. + void *mex_get_data (void) const { return matrix.mex_get_data (); } + + mxArray *as_mxArray (void) const; + + // Mapper functions are converted to double for treatment + octave_value map (unary_mapper_t umap) const + { + octave_matrix m (array_value ()); + return m.map (umap); + } + +protected: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-bool-sparse.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-bool-sparse.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,793 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "ov-base.h" +#include "ov-scalar.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "gripes.h" +#include "ops.h" +#include "oct-locbuf.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "ov-bool-sparse.h" + +#include "ov-base-sparse.h" +#include "ov-base-sparse.cc" + +template class OCTINTERP_API octave_base_sparse; + +DEFINE_OCTAVE_ALLOCATOR (octave_sparse_bool_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_sparse_bool_matrix, "sparse bool matrix", "logical"); + +static octave_base_value * +default_numeric_conversion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_sparse_bool_matrix&); + + return new octave_sparse_matrix (SparseMatrix (v.sparse_bool_matrix_value ())); +} + +octave_base_value::type_conv_info +octave_sparse_bool_matrix::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_conversion_function, + octave_sparse_matrix::static_type_id ()); +} + +octave_base_value * +octave_sparse_bool_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (Vsparse_auto_mutate) + { + // Don't use numel, since it can overflow for very large matrices + // Note that for the second test, this means it becomes approximative + // since it involves a cast to double to avoid issues of overflow + if (matrix.rows () == 1 && matrix.cols () == 1) + { + // Const copy of the matrix, so the right version of () operator used + const SparseBoolMatrix tmp (matrix); + + retval = new octave_bool (tmp (0)); + } + else if (matrix.cols () > 0 && matrix.rows () > 0 + && (double (matrix.byte_size ()) > double (matrix.rows ()) + * double (matrix.cols ()) * sizeof (bool))) + retval = new octave_bool_matrix (matrix.matrix_value ()); + } + + return retval; +} + +double +octave_sparse_bool_matrix::double_value (bool) const +{ + double retval = lo_ieee_nan_value (); + + if (numel () > 0) + { + if (numel () > 1) + gripe_implicit_conversion ("Octave:array-to-scalar", + "bool sparse matrix", "real scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("bool sparse matrix", "real scalar"); + + return retval; +} + +Complex +octave_sparse_bool_matrix::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + if (numel () > 1) + gripe_implicit_conversion ("Octave:array-to-scalar", + "bool sparse matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("bool sparse matrix", "complex scalar"); + + return retval; +} + +octave_value +octave_sparse_bool_matrix::convert_to_str_internal (bool pad, bool force, + char type) const +{ + octave_value tmp = octave_value (array_value ()); + return tmp.convert_to_str (pad, force, type); +} + +// FIXME These are inefficient ways of creating full matrices + +Matrix +octave_sparse_bool_matrix::matrix_value (bool) const +{ + return Matrix (matrix.matrix_value ()); +} + +ComplexMatrix +octave_sparse_bool_matrix::complex_matrix_value (bool) const +{ + return ComplexMatrix (matrix.matrix_value ()); +} + +ComplexNDArray +octave_sparse_bool_matrix::complex_array_value (bool) const +{ + return ComplexNDArray (ComplexMatrix (matrix.matrix_value ())); +} + +NDArray +octave_sparse_bool_matrix::array_value (bool) const +{ + return NDArray (Matrix (matrix.matrix_value ())); +} + +charNDArray +octave_sparse_bool_matrix::char_array_value (bool) const +{ + charNDArray retval (dims (), 0); + octave_idx_type nc = matrix.cols (); + octave_idx_type nr = matrix.rows (); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = matrix.cidx (j); i < matrix.cidx (j+1); i++) + retval(matrix.ridx (i) + nr * j) = static_cast(matrix.data (i)); + + return retval; +} + +boolMatrix +octave_sparse_bool_matrix::bool_matrix_value (bool) const +{ + return matrix.matrix_value (); +} + +boolNDArray +octave_sparse_bool_matrix::bool_array_value (bool) const +{ + return boolNDArray (matrix.matrix_value ()); +} + + +SparseMatrix +octave_sparse_bool_matrix::sparse_matrix_value (bool) const +{ + return SparseMatrix (this->matrix); +} + +SparseComplexMatrix +octave_sparse_bool_matrix::sparse_complex_matrix_value (bool) const +{ + return SparseComplexMatrix (this->matrix); +} + +bool +octave_sparse_bool_matrix::save_binary (std::ostream& os, bool&) +{ + dim_vector d = this->dims (); + if (d.length () < 1) + return false; + + // Ensure that additional memory is deallocated + matrix.maybe_compress (); + + int nr = d(0); + int nc = d(1); + int nz = nnz (); + + int32_t itmp; + // Use negative value for ndims to be consistent with other formats + itmp= -2; + os.write (reinterpret_cast (&itmp), 4); + + itmp= nr; + os.write (reinterpret_cast (&itmp), 4); + + itmp= nc; + os.write (reinterpret_cast (&itmp), 4); + + itmp= nz; + os.write (reinterpret_cast (&itmp), 4); + + // add one to the printed indices to go from + // zero-based to one-based arrays + for (int i = 0; i < nc+1; i++) + { + octave_quit (); + itmp = matrix.cidx (i); + os.write (reinterpret_cast (&itmp), 4); + } + + for (int i = 0; i < nz; i++) + { + octave_quit (); + itmp = matrix.ridx (i); + os.write (reinterpret_cast (&itmp), 4); + } + + OCTAVE_LOCAL_BUFFER (char, htmp, nz); + + for (int i = 0; i < nz; i++) + htmp[i] = (matrix.data (i) ? 1 : 0); + + os.write (htmp, nz); + + return true; +} + +bool +octave_sparse_bool_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format /* fmt */) +{ + int32_t nz, nc, nr, tmp; + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + + if (swap) + swap_bytes<4> (&tmp); + + if (tmp != -2) { + error ("load: only 2D sparse matrices are supported"); + return false; + } + + if (! is.read (reinterpret_cast (&nr), 4)) + return false; + if (! is.read (reinterpret_cast (&nc), 4)) + return false; + if (! is.read (reinterpret_cast (&nz), 4)) + return false; + + if (swap) + { + swap_bytes<4> (&nr); + swap_bytes<4> (&nc); + swap_bytes<4> (&nz); + } + + SparseBoolMatrix m (static_cast (nr), + static_cast (nc), + static_cast (nz)); + + for (int i = 0; i < nc+1; i++) + { + octave_quit (); + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + if (swap) + swap_bytes<4> (&tmp); + m.cidx (i) = tmp; + } + + for (int i = 0; i < nz; i++) + { + octave_quit (); + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + if (swap) + swap_bytes<4> (&tmp); + m.ridx (i) = tmp; + } + + if (error_state || ! is) + return false; + + OCTAVE_LOCAL_BUFFER (char, htmp, nz); + + if (! is.read (htmp, nz)) + return false; + + for (int i = 0; i < nz; i++) + m.data(i) = (htmp[i] ? 1 : 0); + + if (! m.indices_ok ()) + return false; + + matrix = m; + + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_sparse_bool_matrix::save_hdf5 (hid_t loc_id, const char *name, bool) +{ + dim_vector dv = dims (); + int empty = save_hdf5_empty (loc_id, name, dv); + if (empty) + return (empty > 0); + + // Ensure that additional memory is deallocated + matrix.maybe_compress (); +#if HAVE_HDF5_18 + hid_t group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + hid_t group_hid = H5Gcreate (loc_id, name, 0); +#endif + if (group_hid < 0) + return false; + + hid_t space_hid = -1, data_hid = -1; + bool retval = true; + SparseBoolMatrix m = sparse_bool_matrix_value (); + octave_idx_type tmp; + hsize_t hdims[2]; + + space_hid = H5Screate_simple (0, hdims, 0); + if (space_hid < 0) + { + H5Gclose (group_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + tmp = m.rows (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &tmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + tmp = m.cols (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &tmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + tmp = m.nnz (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &tmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + + hdims[0] = m.cols () + 1; + hdims[1] = 1; + + space_hid = H5Screate_simple (2, hdims, 0); + + if (space_hid < 0) + { + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + octave_idx_type * itmp = m.xcidx (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, itmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + + hdims[0] = m.nnz (); + hdims[1] = 1; + + space_hid = H5Screate_simple (2, hdims, 0); + + if (space_hid < 0) + { + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + itmp = m.xridx (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, itmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "data", H5T_NATIVE_HBOOL, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "data", H5T_NATIVE_HBOOL, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hbool_t, htmp, m.nnz ()); + for (int i = 0; i < m.nnz (); i++) + htmp[i] = m.xdata(i); + + retval = H5Dwrite (data_hid, H5T_NATIVE_HBOOL, H5S_ALL, H5S_ALL, + H5P_DEFAULT, htmp) >= 0; + H5Dclose (data_hid); + H5Sclose (space_hid); + H5Gclose (group_hid); + + return retval; +} + +bool +octave_sparse_bool_matrix::load_hdf5 (hid_t loc_id, const char *name) +{ + octave_idx_type nr, nc, nz; + hid_t group_hid, data_hid, space_hid; + hsize_t rank; + + dim_vector dv; + int empty = load_hdf5_empty (loc_id, name, dv); + if (empty > 0) + matrix.resize (dv); + if (empty) + return (empty > 0); + +#if HAVE_HDF5_18 + group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); +#else + group_hid = H5Gopen (loc_id, name); +#endif + if (group_hid < 0 ) return false; + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "nr", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "nr"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nr) < 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "nc", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "nc"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nc) < 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "nz", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "nz"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nz) < 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + + SparseBoolMatrix m (static_cast (nr), + static_cast (nc), + static_cast (nz)); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "cidx", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "cidx"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 2) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + if (static_cast (hdims[0]) != nc + 1 + || static_cast (hdims[1]) != 1) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + octave_idx_type *itmp = m.xcidx (); + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, itmp) < 0) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "ridx", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "ridx"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 2) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + if (static_cast (hdims[0]) != nz + || static_cast (hdims[1]) != 1) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + itmp = m.xridx (); + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, itmp) < 0) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "data", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "data"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 2) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + if (static_cast (hdims[0]) != nz + || static_cast (hdims[1]) != 1) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hbool_t, htmp, nz); + bool retval = false; + if (H5Dread (data_hid, H5T_NATIVE_HBOOL, H5S_ALL, H5S_ALL, + H5P_DEFAULT, htmp) >= 0 + && m.indices_ok ()) + { + retval = true; + + for (int i = 0; i < nz; i++) + m.xdata(i) = htmp[i]; + + matrix = m; + } + + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + + return retval; +} + +#endif + +mxArray * +octave_sparse_bool_matrix::as_mxArray (void) const +{ + mwSize nz = nzmax (); + mxArray *retval = new mxArray (mxLOGICAL_CLASS, rows (), columns (), + nz, mxREAL); + bool *pr = static_cast (retval->get_data ()); + mwIndex *ir = retval->get_ir (); + mwIndex *jc = retval->get_jc (); + + for (mwIndex i = 0; i < nz; i++) + { + pr[i] = matrix.data (i); + ir[i] = matrix.ridx (i); + } + + for (mwIndex i = 0; i < columns () + 1; i++) + jc[i] = matrix.cidx (i); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-bool-sparse.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-bool-sparse.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,157 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_sparse_bool_matrix_h) +#define octave_sparse_bool_matrix_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-stream.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +#include "boolSparse.h" +#include "ov-base-sparse.h" +#include "ov-re-sparse.h" + +class octave_value_list; + +class tree_walker; + +class +OCTINTERP_API +octave_sparse_bool_matrix : public octave_base_sparse +{ +public: + + octave_sparse_bool_matrix (void) + : octave_base_sparse () { } + + octave_sparse_bool_matrix (const SparseBoolMatrix& bnda) + : octave_base_sparse (bnda) { } + + octave_sparse_bool_matrix (const SparseBoolMatrix& bnda, + const MatrixType& t) + : octave_base_sparse (bnda, t) { } + + octave_sparse_bool_matrix (const boolNDArray& m) + : octave_base_sparse (SparseBoolMatrix (m)) { } + + octave_sparse_bool_matrix (const boolMatrix& m) + : octave_base_sparse (SparseBoolMatrix (m)) { } + + octave_sparse_bool_matrix (const Sparse& a) + : octave_base_sparse (a) { } + + octave_sparse_bool_matrix (const octave_sparse_bool_matrix& bm) + : octave_base_sparse (bm) { } + + ~octave_sparse_bool_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_sparse_bool_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_sparse_bool_matrix (); } + + type_conv_info numeric_conversion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + // FIXME Adapt idx_vector to allow sparse logical indexing!! + idx_vector index_vector (void) const + { return idx_vector (bool_array_value ()); } + + builtin_type_t builtin_type (void) const { return btyp_bool; } + + bool is_bool_matrix (void) const { return true; } + + bool is_bool_type (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_numeric_type (void) const { return false; } + + double double_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const; + + NDArray array_value (bool = false) const; + + Complex complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const; + + charNDArray char_array_value (bool = false) const; + + boolMatrix bool_matrix_value (bool = false) const; + + boolNDArray bool_array_value (bool = false) const; + + SparseMatrix sparse_matrix_value (bool = false) const; + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; + + SparseBoolMatrix sparse_bool_matrix_value (bool = false) const + { return matrix; } + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + mxArray *as_mxArray (void) const; + + // Mapper functions are converted to double for treatment + octave_value map (unary_mapper_t umap) const + { + octave_sparse_matrix m (sparse_matrix_value ()); + return m.map (umap); + } + +protected: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-bool.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-bool.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,240 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "mx-base.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ops.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-base.h" +#include "ov-base-scalar.h" +#include "ov-base-scalar.cc" +#include "ov-re-mat.h" +#include "ov-scalar.h" +#include "pr-output.h" + +#include "ls-oct-ascii.h" +#include "ls-hdf5.h" + +template class octave_base_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_bool); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_bool, "bool", "logical"); + +static octave_base_value * +default_numeric_conversion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_bool&); + + return new octave_scalar (v.bool_value ()); +} + +octave_base_value::type_conv_info +octave_bool::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_conversion_function, + octave_scalar::static_type_id ()); + +} + +octave_value +octave_bool::do_index_op (const octave_value_list& idx, bool resize_ok) +{ + // FIXME -- this doesn't solve the problem of + // + // a = 1; a([1,1], [1,1], [1,1]) + // + // and similar constructions. Hmm... + + // FIXME -- using this constructor avoids narrowing the + // 1x1 matrix back to a scalar value. Need a better solution + // to this problem. + + octave_value tmp (new octave_bool_matrix (bool_matrix_value ())); + + return tmp.do_index_op (idx, resize_ok); +} + +octave_value +octave_bool::resize (const dim_vector& dv, bool fill) const +{ + if (fill) + { + boolNDArray retval (dv, false); + if (dv.numel ()) + retval(0) = scalar; + return retval; + } + else + { + boolNDArray retval (dv); + if (dv.numel ()) + retval(0) = scalar; + return retval; + } +} + +octave_value +octave_bool::convert_to_str_internal (bool, bool, char type) const +{ + char s[2]; + s[0] = static_cast (scalar); + s[1] = '\0'; + + return octave_value (s, type); +} + +bool +octave_bool::save_ascii (std::ostream& os) +{ + double d = double_value (); + + octave_write_double (os, d); + os << "\n"; + + return true; +} + +bool +octave_bool::load_ascii (std::istream& is) +{ + scalar = (octave_read_value (is) != 0.); + + if (!is) + { + error ("load: failed to load scalar constant"); + return false; + } + + return true; +} + +bool +octave_bool::save_binary (std::ostream& os, bool& /* save_as_floats */) +{ + char tmp = (scalar ? 1 : 0); + os.write (reinterpret_cast (&tmp), 1); + + return true; +} + +bool +octave_bool::load_binary (std::istream& is, bool /* swap */, + oct_mach_info::float_format /* fmt */) +{ + char tmp; + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + scalar = (tmp ? 1 : 0); + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_bool::save_hdf5 (hid_t loc_id, const char *name, + bool /* save_as_floats */) +{ + hsize_t dimens[3]; + hid_t space_hid = -1, data_hid = -1; + bool retval = true; + + space_hid = H5Screate_simple (0, dimens, 0); + if (space_hid < 0) return false; +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_DOUBLE, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_DOUBLE, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + return false; + } + + double tmp = double_value (); + retval = H5Dwrite (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &tmp) >= 0; + + H5Dclose (data_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_bool::load_hdf5 (hid_t loc_id, const char *name) +{ +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t space_id = H5Dget_space (data_hid); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank != 0) + { + H5Dclose (data_hid); + return false; + } + + double dtmp; + if (H5Dread (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &dtmp) < 0) + { + H5Dclose (data_hid); + return false; + } + + scalar = (dtmp != 0.); + + H5Dclose (data_hid); + + return true; +} + +#endif + +mxArray * +octave_bool::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxLOGICAL_CLASS, 1, 1, mxREAL); + + bool *pr = static_cast (retval->get_data ()); + + pr[0] = scalar; + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-bool.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-bool.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,251 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_bool_h) +#define octave_bool_h 1 + +#include + +#include +#include + +#include "lo-utils.h" +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "oct-stream.h" +#include "ov-base.h" +#include "ov-base-scalar.h" +#include "ov-bool-mat.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +OCTINTERP_API +octave_bool : public octave_base_scalar +{ +public: + + octave_bool (void) + : octave_base_scalar (false) { } + + octave_bool (bool b) + : octave_base_scalar (b) { } + + octave_bool (const octave_bool& s) + : octave_base_scalar (s) { } + + ~octave_bool (void) { } + + octave_base_value *clone (void) const { return new octave_bool (*this); } + octave_base_value *empty_clone (void) const { return new octave_bool_matrix (); } + + type_conv_info numeric_conversion_function (void) const; + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + idx_vector index_vector (void) const { return idx_vector (scalar); } + + builtin_type_t builtin_type (void) const { return btyp_bool; } + + bool is_real_scalar (void) const { return true; } + + bool is_bool_scalar (void) const { return true; } + + bool is_bool_type (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_numeric_type (void) const { return false; } + + bool is_true (void) const { return scalar; } + + int8NDArray + int8_array_value (void) const + { return int8NDArray (dim_vector (1, 1), scalar); } + + int16NDArray + int16_array_value (void) const + { return int16NDArray (dim_vector (1, 1), scalar); } + + int32NDArray + int32_array_value (void) const + { return int32NDArray (dim_vector (1, 1), scalar); } + + int64NDArray + int64_array_value (void) const + { return int64NDArray (dim_vector (1, 1), scalar); } + + uint8NDArray + uint8_array_value (void) const + { return uint8NDArray (dim_vector (1, 1), scalar); } + + uint16NDArray + uint16_array_value (void) const + { return uint16NDArray (dim_vector (1, 1), scalar); } + + uint32NDArray + uint32_array_value (void) const + { return uint32NDArray (dim_vector (1, 1), scalar); } + + uint64NDArray + uint64_array_value (void) const + { return uint64NDArray (dim_vector (1, 1), scalar); } + + octave_int8 + int8_scalar_value (void) const { return octave_int8 (scalar); } + + octave_int16 + int16_scalar_value (void) const { return octave_int16 (scalar); } + + octave_int32 + int32_scalar_value (void) const { return octave_int32 (scalar); } + + octave_int64 + int64_scalar_value (void) const { return octave_int64 (scalar); } + + octave_uint8 + uint8_scalar_value (void) const { return octave_uint8 (scalar); } + + octave_uint16 + uint16_scalar_value (void) const { return octave_uint16 (scalar); } + + octave_uint32 + uint32_scalar_value (void) const { return octave_uint32 (scalar); } + + octave_uint64 + uint64_scalar_value (void) const { return octave_uint64 (scalar); } + + double double_value (bool = false) const { return scalar; } + + float float_value (bool = false) const { return scalar; } + + double scalar_value (bool = false) const { return scalar; } + + float float_scalar_value (bool = false) const { return scalar; } + + Matrix matrix_value (bool = false) const + { return Matrix (1, 1, scalar); } + + FloatMatrix float_matrix_value (bool = false) const + { return FloatMatrix (1, 1, scalar); } + + NDArray array_value (bool = false) const + { return NDArray (dim_vector (1, 1), static_cast (scalar)); } + + FloatNDArray float_array_value (bool = false) const + { return FloatNDArray (dim_vector (1, 1), static_cast (scalar)); } + + Complex complex_value (bool = false) const { return scalar; } + + FloatComplex float_complex_value (bool = false) const { return scalar; } + + ComplexMatrix complex_matrix_value (bool = false) const + { return ComplexMatrix (1, 1, Complex (scalar)); } + + FloatComplexMatrix float_complex_matrix_value (bool = false) const + { return FloatComplexMatrix (1, 1, FloatComplex (scalar)); } + + ComplexNDArray complex_array_value (bool = false) const + { return ComplexNDArray (dim_vector (1, 1), Complex (scalar)); } + + FloatComplexNDArray float_complex_array_value (bool = false) const + { return FloatComplexNDArray (dim_vector (1, 1), FloatComplex (scalar)); } + + SparseMatrix sparse_matrix_value (bool = false) const + { return SparseMatrix (Matrix (1, 1, scalar)); } + + // FIXME Need SparseComplexMatrix (Matrix) constructor!!! + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const + { return SparseComplexMatrix (sparse_matrix_value ()); } + + SparseBoolMatrix sparse_bool_matrix_value (bool = false) const + { return SparseBoolMatrix (boolMatrix (1, 1, scalar)); } + + charNDArray + char_array_value (bool = false) const + { + charNDArray retval (dim_vector (1, 1)); + retval(0) = static_cast (scalar); + return retval; + } + + bool bool_value (bool = false) const { return scalar; } + + boolMatrix bool_matrix_value (bool = false) const + { return boolMatrix (1, 1, scalar); } + + boolNDArray bool_array_value (bool = false) const + { return boolNDArray (dim_vector (1, 1), scalar); } + + octave_value resize (const dim_vector& dv, bool fill = false) const; + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { + return os.write (bool_array_value (), block_size, output_type, + skip, flt_fmt); + } + + mxArray *as_mxArray (void) const; + + // Mapper functions are converted to double for treatment + octave_value map (unary_mapper_t umap) const + { + octave_scalar m (scalar_value ()); + return m.map (umap); + } + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-builtin.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-builtin.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,173 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "ov-builtin.h" +#include "ov.h" +#include "profiler.h" +#include "toplev.h" +#include "unwind-prot.h" + +DEFINE_OCTAVE_ALLOCATOR (octave_builtin); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_builtin, + "built-in function", + "built-in function"); + +octave_value_list +octave_builtin::subsref (const std::string& type, + const std::list& idx, + int nargout) +{ + return octave_builtin::subsref (type, idx, nargout, 0); +} + +octave_value_list +octave_builtin::subsref (const std::string& type, + const std::list& idx, + int nargout, const std::list* lvalue_list) +{ + octave_value_list retval; + + switch (type[0]) + { + case '(': + { + int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout; + + retval = do_multi_index_op (tmp_nargout, idx.front (), + idx.size () == 1 ? lvalue_list : 0); + } + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + // FIXME -- perhaps there should be an + // octave_value_list::next_subsref member function? See also + // octave_user_function::subsref. + // + // FIXME -- Note that if a function call returns multiple + // values, and there is further indexing to perform, then we are + // ignoring all but the first value. Is this really what we want to + // do? If it is not, then what should happen for stat("file").size, + // for exmaple? + + if (idx.size () > 1) + retval = retval(0).next_subsref (nargout, type, idx); + + return retval; +} + +octave_value_list +octave_builtin::do_multi_index_op (int nargout, const octave_value_list& args) +{ + return octave_builtin::do_multi_index_op (nargout, args, 0); +} + +octave_value_list +octave_builtin::do_multi_index_op (int nargout, const octave_value_list& args, + const std::list *lvalue_list) +{ + octave_value_list retval; + + if (error_state) + return retval; + + if (args.has_magic_colon ()) + ::error ("invalid use of colon in function argument list"); + else + { + unwind_protect frame; + + octave_call_stack::push (this); + + frame.add_fcn (octave_call_stack::pop); + + if (lvalue_list || curr_lvalue_list) + { + frame.protect_var (curr_lvalue_list); + curr_lvalue_list = lvalue_list; + } + + try + { + BEGIN_PROFILER_BLOCK (profiler_name ()) + + retval = (*f) (args, nargout); + // Do not allow null values to be returned from functions. + // FIXME -- perhaps true builtins should be allowed? + retval.make_storable_values (); + // Fix the case of a single undefined value. + // This happens when a compiled function uses + // octave_value retval; + // instead of + // octave_value_list retval; + // the idiom is very common, so we solve that here. + if (retval.length () == 1 && retval.xelem (0).is_undefined ()) + retval.clear (); + + END_PROFILER_BLOCK + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + + return retval; +} + +jit_type * +octave_builtin::to_jit (void) const +{ + return jtype; +} + +void +octave_builtin::stash_jit (jit_type &type) +{ + jtype = &type; +} + +octave_builtin::fcn +octave_builtin::function (void) const +{ + return f; +} + +const std::list *octave_builtin::curr_lvalue_list = 0; diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-builtin.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-builtin.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,117 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_builtin_h) +#define octave_builtin_h 1 + +#include + +#include "ov-fcn.h" +#include "ov-typeinfo.h" + +class octave_value; +class octave_value_list; +class jit_type; + +// Builtin functions. + +class +OCTINTERP_API +octave_builtin : public octave_function +{ +public: + + octave_builtin (void) : octave_function (), f (0), file (), jtype (0) { } + + typedef octave_value_list (*fcn) (const octave_value_list&, int); + + octave_builtin (fcn ff, const std::string& nm = std::string (), + const std::string& ds = std::string ()) + : octave_function (nm, ds), f (ff), file (), jtype (0) { } + + octave_builtin (fcn ff, const std::string& nm, const std::string& fnm, + const std::string& ds) + : octave_function (nm, ds), f (ff), file (fnm), jtype (0) { } + + ~octave_builtin (void) { } + + std::string src_file_name (void) const { return file; } + + octave_value subsref (const std::string& type, + const std::list& idx) + { + octave_value_list tmp = subsref (type, idx, 1); + return tmp.length () > 0 ? tmp(0) : octave_value (); + } + + octave_value_list subsref (const std::string& type, + const std::list& idx, + int nargout); + + octave_value_list subsref (const std::string& type, + const std::list& idx, + int nargout, const std::list* lvalue_list); + + octave_function *function_value (bool = false) { return this; } + + bool is_builtin_function (void) const { return true; } + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& args); + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& args, + const std::list* lvalue_list); + + jit_type *to_jit (void) const; + + void stash_jit (jit_type& type); + + fcn function (void) const; + + static const std::list *curr_lvalue_list; + +protected: + + // A pointer to the actual function. + fcn f; + + // The name of the file where this function was defined. + std::string file; + + // A pointer to the jit type that represents the function. + jit_type *jtype; + +private: + + // No copying! + + octave_builtin (const octave_builtin& ob); + + octave_builtin& operator = (const octave_builtin& ob); + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-cell.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-cell.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1528 @@ +/* + +Copyright (C) 1999-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include + +#include "Array-util.h" +#include "byte-swap.h" +#include "lo-utils.h" +#include "quit.h" +#include "oct-locbuf.h" + +#include "defun.h" +#include "error.h" +#include "ov-cell.h" +#include "oct-obj.h" +#include "unwind-prot.h" +#include "utils.h" +#include "ov-base-mat.h" +#include "ov-base-mat.cc" +#include "ov-re-mat.h" +#include "ov-scalar.h" +#include "pr-output.h" +#include "ov-scalar.h" +#include "gripes.h" + +#include "ls-oct-ascii.h" +#include "ls-oct-binary.h" +#include "ls-hdf5.h" +#include "ls-utils.h" + +// Cell is able to handle octave_value indexing by itself, so just forward +// everything. + +template <> +octave_value +octave_base_matrix::do_index_op (const octave_value_list& idx, + bool resize_ok) +{ + return matrix.index (idx, resize_ok); +} + +template <> +void +octave_base_matrix::assign (const octave_value_list& idx, const Cell& rhs) +{ + matrix.assign (idx, rhs); +} + +template <> +void +octave_base_matrix::assign (const octave_value_list& idx, octave_value rhs) +{ + // FIXME: Really? + if (rhs.is_cell ()) + matrix.assign (idx, rhs.cell_value ()); + else + matrix.assign (idx, Cell (rhs)); +} + +template <> +void +octave_base_matrix::delete_elements (const octave_value_list& idx) +{ + matrix.delete_elements (idx); +} + +// FIXME: this list of specializations is becoming so long that we should really ask +// whether octave_cell should inherit from octave_base_matrix at all. + +template <> +octave_value +octave_base_matrix::fast_elem_extract (octave_idx_type n) const +{ + if (n < matrix.numel ()) + return Cell (matrix(n)); + else + return octave_value (); +} + +template <> +bool +octave_base_matrix::fast_elem_insert (octave_idx_type n, + const octave_value& x) +{ + const octave_cell *xrep = + dynamic_cast (&x.get_rep ()); + + bool retval = xrep && xrep->matrix.numel () == 1 && n < matrix.numel (); + if (retval) + matrix(n) = xrep->matrix(0); + + return retval; +} + +template class octave_base_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_cell); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_cell, "cell", "cell"); + +static void +gripe_failed_assignment (void) +{ + error ("assignment to cell array failed"); +} + +octave_value_list +octave_cell::subsref (const std::string& type, + const std::list& idx, + int nargout) +{ + octave_value_list retval; + + switch (type[0]) + { + case '(': + retval(0) = do_index_op (idx.front ()); + break; + + case '{': + { + octave_value tmp = do_index_op (idx.front ()); + + if (! error_state) + { + Cell tcell = tmp.cell_value (); + + if (tcell.length () == 1) + retval(0) = tcell(0,0); + else + retval = octave_value (octave_value_list (tcell), true); + } + } + break; + + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + // FIXME -- perhaps there should be an + // octave_value_list::next_subsref member function? See also + // octave_user_function::subsref. + + if (idx.size () > 1) + retval = retval(0).next_subsref (nargout, type, idx); + + return retval; +} + +octave_value +octave_cell::subsref (const std::string& type, + const std::list& idx, + bool auto_add) +{ + octave_value retval; + + switch (type[0]) + { + case '(': + retval = do_index_op (idx.front (), auto_add); + break; + + case '{': + { + octave_value tmp = do_index_op (idx.front (), auto_add); + + if (! error_state) + { + const Cell tcell = tmp.cell_value (); + + if (tcell.length () == 1) + retval = tcell(0,0); + else + retval = octave_value (octave_value_list (tcell), true); + } + } + break; + + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + // FIXME -- perhaps there should be an + // octave_value_list::next_subsref member function? See also + // octave_user_function::subsref. + + if (idx.size () > 1) + retval = retval.next_subsref (auto_add, type, idx); + + return retval; +} + +octave_value +octave_cell::subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + octave_value retval; + + int n = type.length (); + + octave_value t_rhs = rhs; + + clear_cellstr_cache (); + + if (idx.front ().empty ()) + { + error ("missing index in indexed assignment"); + return retval; + } + + if (n > 1) + { + switch (type[0]) + { + case '(': + { + if (is_empty () && type[1] == '.') + { + // Allow conversion of empty cell array to some other + // type in cases like + // + // x = {}; x(i).f = rhs + + octave_value tmp = octave_value::empty_conv (type, rhs); + + return tmp.subsasgn (type, idx, rhs); + } + else + { + octave_value tmp = do_index_op (idx.front (), true); + + if (! tmp.is_defined ()) + tmp = octave_value::empty_conv (type.substr (1), rhs); + + if (! error_state) + { + std::list next_idx (idx); + + next_idx.erase (next_idx.begin ()); + + tmp.make_unique (); + + t_rhs = tmp.subsasgn (type.substr (1), next_idx, rhs); + } + } + } + break; + + case '{': + { + matrix.make_unique (); + Cell tmpc = matrix.index (idx.front (), true); + + if (! error_state) + { + std::list next_idx (idx); + + next_idx.erase (next_idx.begin ()); + + std::string next_type = type.substr (1); + + if (tmpc.numel () == 1) + { + octave_value tmp = tmpc(0); + tmpc = Cell (); + + if (! tmp.is_defined () || tmp.is_zero_by_zero ()) + { + tmp = octave_value::empty_conv (type.substr (1), rhs); + tmp.make_unique (); // probably a no-op. + } + else + // optimization: ignore the copy still stored inside our array. + tmp.make_unique (1); + + if (! error_state) + t_rhs = tmp.subsasgn (next_type, next_idx, rhs); + } + else + gripe_indexed_cs_list (); + } + } + break; + + case '.': + { + if (is_empty ()) + { + // Do nothing; the next branch will handle it. + } + else + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + } + break; + + default: + panic_impossible (); + } + } + + if (! error_state) + { + switch (type[0]) + { + case '(': + { + octave_value_list i = idx.front (); + + if (t_rhs.is_cell ()) + octave_base_matrix::assign (i, t_rhs.cell_value ()); + else + if (t_rhs.is_null_value ()) + octave_base_matrix::delete_elements (i); + else + octave_base_matrix::assign (i, Cell (t_rhs)); + + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + break; + + case '{': + { + octave_value_list idxf = idx.front (); + + if (t_rhs.is_cs_list ()) + { + Cell tmp_cell = Cell (t_rhs.list_value ()); + + // Inquire the proper shape of the RHS. + + dim_vector didx = dims ().redim (idxf.length ()); + for (octave_idx_type k = 0; k < idxf.length (); k++) + if (! idxf(k).is_magic_colon ()) didx(k) = idxf(k).numel (); + + if (didx.numel () == tmp_cell.numel ()) + tmp_cell = tmp_cell.reshape (didx); + + + octave_base_matrix::assign (idxf, tmp_cell); + } + else if (idxf.all_scalars () || do_index_op (idxf, true).numel () == 1) + // Regularize a null matrix if stored into a cell. + octave_base_matrix::assign (idxf, Cell (t_rhs.storable_value ())); + else if (! error_state) + gripe_nonbraced_cs_list_assignment (); + + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + break; + + case '.': + { + if (is_empty ()) + { + // Allow conversion of empty cell array to some other + // type in cases like + // + // x = {}; x.f = rhs + + octave_value tmp = octave_value::empty_conv (type, rhs); + + return tmp.subsasgn (type, idx, rhs); + } + else + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + } + break; + + default: + panic_impossible (); + } + } + + return retval; +} + +bool +octave_cell::is_cellstr (void) const +{ + bool retval; + if (cellstr_cache.get ()) + retval = true; + else + { + retval = matrix.is_cellstr (); + // Allocate empty cache to mark that this is indeed a cellstr. + if (retval) + cellstr_cache.reset (new Array ()); + } + + return retval; +} + +void +octave_cell::assign (const octave_value_list& idx, const Cell& rhs) +{ + clear_cellstr_cache (); + octave_base_matrix::assign (idx, rhs); +} + +void +octave_cell::assign (const octave_value_list& idx, const octave_value& rhs) +{ + clear_cellstr_cache (); + octave_base_matrix::assign (idx, rhs); +} + + +void +octave_cell::delete_elements (const octave_value_list& idx) +{ + clear_cellstr_cache (); + octave_base_matrix::delete_elements (idx); +} + +size_t +octave_cell::byte_size (void) const +{ + size_t retval = 0; + + for (octave_idx_type i = 0; i < numel (); i++) + retval += matrix(i).byte_size (); + + return retval; +} + +octave_value +octave_cell::sort (octave_idx_type dim, sortmode mode) const +{ + octave_value retval; + + if (is_cellstr ()) + { + Array tmp = cellstr_value (); + + tmp = tmp.sort (dim, mode); + + // We already have the cache. + retval = new octave_cell (tmp); + } + else + error ("sort: only cell arrays of character strings may be sorted"); + + return retval; +} + +octave_value +octave_cell::sort (Array &sidx, octave_idx_type dim, + sortmode mode) const +{ + octave_value retval; + + if (is_cellstr ()) + { + Array tmp = cellstr_value (); + + tmp = tmp.sort (sidx, dim, mode); + + // We already have the cache. + retval = new octave_cell (tmp); + } + else + error ("sort: only cell arrays of character strings may be sorted"); + + return retval; +} + +sortmode +octave_cell::is_sorted (sortmode mode) const +{ + sortmode retval = UNSORTED; + + if (is_cellstr ()) + { + Array tmp = cellstr_value (); + + retval = tmp.is_sorted (mode); + } + else + error ("issorted: A is not a cell array of strings"); + + return retval; +} + + +Array +octave_cell::sort_rows_idx (sortmode mode) const +{ + Array retval; + + if (is_cellstr ()) + { + Array tmp = cellstr_value (); + + retval = tmp.sort_rows_idx (mode); + } + else + error ("sortrows: only cell arrays of character strings may be sorted"); + + return retval; +} + +sortmode +octave_cell::is_sorted_rows (sortmode mode) const +{ + sortmode retval = UNSORTED; + + if (is_cellstr ()) + { + Array tmp = cellstr_value (); + + retval = tmp.is_sorted_rows (mode); + } + else + error ("issorted: A is not a cell array of strings"); + + return retval; +} + +bool +octave_cell::is_true (void) const +{ + error ("invalid conversion from cell array to logical value"); + return false; +} + +octave_value_list +octave_cell::list_value (void) const +{ + return octave_value_list (matrix); +} + +string_vector +octave_cell::all_strings (bool pad) const +{ + string_vector retval; + + octave_idx_type nel = numel (); + + int n_elts = 0; + + octave_idx_type max_len = 0; + + std::queue strvec_queue; + + for (octave_idx_type i = 0; i < nel; i++) + { + string_vector s = matrix(i).all_strings (); + + if (error_state) + return retval; + + octave_idx_type s_len = s.length (); + + n_elts += s_len ? s_len : 1; + + octave_idx_type s_max_len = s.max_length (); + + if (s_max_len > max_len) + max_len = s_max_len; + + strvec_queue.push (s); + } + + retval = string_vector (n_elts); + + octave_idx_type k = 0; + + for (octave_idx_type i = 0; i < nel; i++) + { + const string_vector s = strvec_queue.front (); + strvec_queue.pop (); + + octave_idx_type s_len = s.length (); + + if (s_len) + { + for (octave_idx_type j = 0; j < s_len; j++) + { + std::string t = s[j]; + int t_len = t.length (); + + if (pad && max_len > t_len) + t += std::string (max_len - t_len, ' '); + + retval[k++] = t; + } + } + else if (pad) + retval[k++] = std::string (max_len, ' '); + else + retval[k++] = std::string (); + } + + return retval; +} + +Array +octave_cell::cellstr_value (void) const +{ + Array retval; + + if (is_cellstr ()) + { + if (cellstr_cache->is_empty ()) + *cellstr_cache = matrix.cellstr_value (); + + return *cellstr_cache; + } + else + error ("invalid conversion from cell array to array of strings"); + + return retval; +} + +bool +octave_cell::print_as_scalar (void) const +{ + return true; +} + +void +octave_cell::print (std::ostream& os, bool) const +{ + print_raw (os); +} + +void +octave_cell::print_raw (std::ostream& os, bool) const +{ + int nd = matrix.ndims (); + + if (nd == 2) + { + octave_idx_type nr = rows (); + octave_idx_type nc = columns (); + + if (nr > 0 && nc > 0) + { + newline (os); + indent (os); + os << "{"; + newline (os); + + increment_indent_level (); + + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_quit (); + + std::ostringstream buf; + buf << "[" << i+1 << "," << j+1 << "]"; + + octave_value val = matrix(i,j); + + val.print_with_name (os, buf.str ()); + } + } + + decrement_indent_level (); + + indent (os); + os << "}"; + newline (os); + } + else + { + indent (os); + os << "{}"; + if (Vprint_empty_dimensions) + os << "(" << nr << "x" << nc << ")"; + newline (os); + } + } + else + { + indent (os); + dim_vector dv = matrix.dims (); + os << "{" << dv.str () << " Cell Array}"; + newline (os); + } +} + +#define CELL_ELT_TAG "" + +bool +octave_cell::save_ascii (std::ostream& os) +{ + dim_vector d = dims (); + if (d.length () > 2) + { + os << "# ndims: " << d.length () << "\n"; + + for (int i = 0; i < d.length (); i++) + os << " " << d (i); + os << "\n"; + + Cell tmp = cell_value (); + + for (octave_idx_type i = 0; i < d.numel (); i++) + { + octave_value o_val = tmp.elem (i); + + // Recurse to print sub-value. + bool b = save_ascii_data (os, o_val, CELL_ELT_TAG, false, 0); + + if (! b) + return os; + } + } + else + { + // Keep this case, rather than use generic code above for backward + // compatiability. Makes load_ascii much more complex!! + os << "# rows: " << rows () << "\n" + << "# columns: " << columns () << "\n"; + + Cell tmp = cell_value (); + + for (octave_idx_type j = 0; j < tmp.cols (); j++) + { + for (octave_idx_type i = 0; i < tmp.rows (); i++) + { + octave_value o_val = tmp.elem (i, j); + + // Recurse to print sub-value. + bool b = save_ascii_data (os, o_val, CELL_ELT_TAG, false, 0); + + if (! b) + return os; + } + + os << "\n"; + } + } + + return true; +} + +bool +octave_cell::load_ascii (std::istream& is) +{ + bool success = true; + + clear_cellstr_cache (); + + string_vector keywords(2); + + keywords[0] = "ndims"; + keywords[1] = "rows"; + + std::string kw; + octave_idx_type val = 0; + + if (extract_keyword (is, keywords, kw, val, true)) + { + if (kw == "ndims") + { + int mdims = static_cast (val); + + if (mdims >= 0) + { + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + is >> dv(i); + + Cell tmp(dv); + + for (octave_idx_type i = 0; i < dv.numel (); i++) + { + octave_value t2; + bool dummy; + + // recurse to read cell elements + std::string nm = read_ascii_data (is, std::string (), + dummy, t2, i); + + if (nm == CELL_ELT_TAG) + { + if (is) + tmp.elem (i) = t2; + } + else + { + error ("load: cell array element had unexpected name"); + success = false; + break; + } + } + + if (is) + matrix = tmp; + else + { + error ("load: failed to load matrix constant"); + success = false; + } + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + } + else if (kw == "rows") + { + octave_idx_type nr = val; + octave_idx_type nc = 0; + + if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) + { + if (nr > 0 && nc > 0) + { + Cell tmp (nr, nc); + + for (octave_idx_type j = 0; j < nc; j++) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_value t2; + bool dummy; + + // recurse to read cell elements + std::string nm = read_ascii_data (is, std::string (), + dummy, t2, i); + + if (nm == CELL_ELT_TAG) + { + if (is) + tmp.elem (i, j) = t2; + } + else + { + error ("load: cell array element had unexpected name"); + success = false; + goto cell_read_error; + } + } + } + + cell_read_error: + + if (is) + matrix = tmp; + else + { + error ("load: failed to load cell element"); + success = false; + } + } + else if (nr == 0 || nc == 0) + matrix = Cell (nr, nc); + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns for cell array"); + success = false; + } + } + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + + return success; +} + +bool +octave_cell::save_binary (std::ostream& os, bool& save_as_floats) +{ + dim_vector d = dims (); + if (d.length () < 1) + return false; + + // Use negative value for ndims + int32_t di = - d.length (); + os.write (reinterpret_cast (&di), 4); + for (int i = 0; i < d.length (); i++) + { + di = d(i); + os.write (reinterpret_cast (&di), 4); + } + + Cell tmp = cell_value (); + + for (octave_idx_type i = 0; i < d.numel (); i++) + { + octave_value o_val = tmp.elem (i); + + // Recurse to print sub-value. + bool b = save_binary_data (os, o_val, CELL_ELT_TAG, "", 0, + save_as_floats); + + if (! b) + return false; + } + + return true; +} + +bool +octave_cell::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + clear_cellstr_cache (); + + bool success = true; + int32_t mdims; + if (! is.read (reinterpret_cast (&mdims), 4)) + return false; + if (swap) + swap_bytes<4> (&mdims); + if (mdims >= 0) + return false; + + mdims = -mdims; + int32_t di; + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + { + if (! is.read (reinterpret_cast (&di), 4)) + return false; + if (swap) + swap_bytes<4> (&di); + dv(i) = di; + } + + // Convert an array with a single dimension to be a row vector. + // Octave should never write files like this, other software + // might. + + if (mdims == 1) + { + mdims = 2; + dv.resize (mdims); + dv(1) = dv(0); + dv(0) = 1; + } + + octave_idx_type nel = dv.numel (); + Cell tmp(dv); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value t2; + bool dummy; + std::string doc; + + // recurse to read cell elements + std::string nm = read_binary_data (is, swap, fmt, std::string (), + dummy, t2, doc); + + if (nm == CELL_ELT_TAG) + { + if (is) + tmp.elem (i) = t2; + } + else + { + error ("load: cell array element had unexpected name"); + success = false; + break; + } + } + + if (is) + matrix = tmp; + else + { + error ("load: failed to load matrix constant"); + success = false; + } + + return success; +} + +void * +octave_cell::mex_get_data (void) const +{ + clear_cellstr_cache (); + return matrix.mex_get_data (); +} + +#if defined (HAVE_HDF5) + +bool +octave_cell::save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) +{ + dim_vector dv = dims (); + int empty = save_hdf5_empty (loc_id, name, dv); + if (empty) + return (empty > 0); + + hsize_t rank = dv.length (); + hid_t space_hid = -1, data_hid = -1, size_hid = -1; + +#if HAVE_HDF5_18 + data_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Gcreate (loc_id, name, 0); +#endif + + if (data_hid < 0) + return false; + + // Have to save cell array shape, since can't have a + // dataset of groups.... + + space_hid = H5Screate_simple (1, &rank, 0); + + if (space_hid < 0) + { + H5Gclose (data_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (octave_idx_type, hdims, rank); + + // Octave uses column-major, while HDF5 uses row-major ordering + for (hsize_t i = 0; i < rank; i++) + hdims[i] = dv(rank-i-1); + +#if HAVE_HDF5_18 + size_hid = H5Dcreate (data_hid, "dims", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + size_hid = H5Dcreate (data_hid, "dims", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (size_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (data_hid); + return false; + } + + if (H5Dwrite (size_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, hdims) < 0) + { + H5Dclose (size_hid); + H5Sclose (space_hid); + H5Gclose (data_hid); + return false; + } + + H5Dclose (size_hid); + H5Sclose (space_hid); + + // Recursively add each element of the cell to this group. + + Cell tmp = cell_value (); + + octave_idx_type nel = dv.numel (); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::ostringstream buf; + int digits = static_cast (gnulib::floor (::log10 (static_cast (nel)) + 1.0)); + buf << "_" << std::setw (digits) << std::setfill ('0') << i; + std::string s = buf.str (); + + if (! add_hdf5_data (data_hid, tmp.elem (i), s.c_str (), "", false, + save_as_floats)) + { + H5Gclose (data_hid); + return false; + } + } + + H5Gclose (data_hid); + + return true; +} + +bool +octave_cell::load_hdf5 (hid_t loc_id, const char *name) +{ + clear_cellstr_cache (); + + bool retval = false; + + dim_vector dv; + int empty = load_hdf5_empty (loc_id, name, dv); + if (empty > 0) + matrix.resize (dv); + if (empty) + return (empty > 0); + +#if HAVE_HDF5_18 + hid_t group_id = H5Gopen (loc_id, name, H5P_DEFAULT); +#else + hid_t group_id = H5Gopen (loc_id, name); +#endif + + if (group_id < 0) + return false; + +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (group_id, "dims", H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (group_id, "dims"); +#endif + hid_t space_hid = H5Dget_space (data_hid); + hsize_t rank = H5Sget_simple_extent_ndims (space_hid); + if (rank != 1) + { + H5Dclose (data_hid); + H5Gclose (group_id); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + // Octave uses column-major, while HDF5 uses row-major ordering. + + dv.resize (hdims[0]); + + OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, hdims[0]); + + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, tmp) < 0) + { + H5Dclose (data_hid); + H5Gclose (group_id); + return false; + } + + H5Dclose (data_hid); + H5Gclose (group_id); + + for (hsize_t i = 0, j = hdims[0] - 1; i < hdims[0]; i++, j--) + dv(j) = tmp[i]; + + hdf5_callback_data dsub; + + herr_t retval2 = -1; + + Cell m (dv); + + int current_item = 0; + + hsize_t num_obj = 0; +#if HAVE_HDF5_18 + group_id = H5Gopen (loc_id, name, H5P_DEFAULT); +#else + group_id = H5Gopen (loc_id, name); +#endif + H5Gget_num_objs (group_id, &num_obj); + H5Gclose (group_id); + + for (octave_idx_type i = 0; i < dv.numel (); i++) + { + + if (current_item >= static_cast (num_obj)) + retval2 = -1; + else + retval2 = H5Giterate (loc_id, name, ¤t_item, + hdf5_read_next_data, &dsub); + + if (retval2 <= 0) + break; + + octave_value ov = dsub.tc; + m.elem (i) = ov; + + } + + if (retval2 >= 0) + { + matrix = m; + retval = true; + } + + return retval; +} + +#endif + +DEFUN (iscell, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} iscell (@var{x})\n\ +Return true if @var{x} is a cell array object.\n\ +@seealso{ismatrix, isstruct, iscellstr, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_cell (); + else + print_usage (); + + return retval; +} + +DEFUN (cell, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cell (@var{n})\n\ +@deftypefnx {Built-in Function} {} cell (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} cell (@var{m}, @var{n}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} cell ([@var{m} @var{n} @dots{}])\n\ +Create a new cell array object.\n\ +If invoked with a single scalar integer argument, return a square\n\ +@nospell{NxN} cell array. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +the given dimensions.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + dim_vector dims; + + switch (nargin) + { + case 0: + dims = dim_vector (0, 0); + break; + + case 1: + get_dimensions (args(0), "cell", dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).nint_value (); + + if (error_state) + { + error ("cell: expecting scalar arguments"); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, "cell"); + + if (! error_state) + retval = Cell (dims, Matrix ()); + } + + return retval; +} + +DEFUN (iscellstr, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} iscellstr (@var{cell})\n\ +Return true if every element of the cell array @var{cell} is a\n\ +character string.\n\ +@seealso{ischar}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_cellstr (); + else + print_usage (); + + return retval; +} + +// Note that since Fcellstr calls Fiscellstr, we need to have +// Fiscellstr defined first (to provide a declaration) and also we +// should keep it in the same file (so we don't have to provide a +// declaration) and so we don't have to use feval to call it. + +DEFUN (cellstr, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cellstr (@var{string})\n\ +Create a new cell array object from the elements of the string\n\ +array @var{string}.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + octave_value_list tmp = Fiscellstr (args, 1); + + if (tmp(0).is_true ()) + retval = args(0); + else + { + string_vector s = args(0).all_strings (); + + if (! error_state) + retval = (s.is_empty () + ? Cell (octave_value (std::string ())) + : Cell (s, true)); + else + error ("cellstr: argument STRING must be a 2-D character array"); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (struct2cell, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} struct2cell (@var{S})\n\ +Create a new cell array from the objects stored in the struct object.\n\ +If @var{f} is the number of fields in the structure, the resulting\n\ +cell array will have a dimension vector corresponding to\n\ +@code{[@var{F} size(@var{S})]}. For example:\n\ +\n\ +@example\n\ +@group\n\ +s = struct (\"name\", @{\"Peter\", \"Hannah\", \"Robert\"@},\n\ + \"age\", @{23, 16, 3@});\n\ +c = struct2cell (s)\n\ + @result{} c = @{1x1x3 Cell Array@}\n\ +c(1,1,:)(:)\n\ + @result{}\n\ + @{\n\ + [1,1] = Peter\n\ + [2,1] = Hannah\n\ + [3,1] = Robert\n\ + @}\n\ +c(2,1,:)(:)\n\ + @result{}\n\ + @{\n\ + [1,1] = 23\n\ + [2,1] = 16\n\ + [3,1] = 3\n\ + @}\n\ +@end group\n\ +@end example\n\ +\n\ +@seealso{cell2struct, fieldnames}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + const octave_map m = args(0).map_value (); + + if (! error_state) + { + const dim_vector m_dv = m.dims (); + + octave_idx_type num_fields = m.nfields (); + + // The resulting dim_vector should have dimensions: + // [numel(fields) size(struct)] + // except if the struct is a column vector. + + dim_vector result_dv; + if (m_dv (m_dv.length () - 1) == 1) + result_dv.resize (m_dv.length ()); + else + result_dv.resize (m_dv.length () + 1); // Add 1 for the fields. + + result_dv(0) = num_fields; + + for (int i = 1; i < result_dv.length (); i++) + result_dv(i) = m_dv(i-1); + + NoAlias c (result_dv); + + octave_idx_type n_elts = m.numel (); + + // Fill c in one sweep. Note that thanks to octave_map structure, + // we don't need a key lookup at all. + for (octave_idx_type j = 0; j < n_elts; j++) + for (octave_idx_type i = 0; i < num_fields; i++) + c(i,j) = m.contents(i)(j); + + retval = c; + } + else + error ("struct2cell: argument S must be a structure"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! keys = cellstr (char (floor (rand (11,10)*24+65)))'; +%! vals = cellfun (@(x) mat2cell (rand (19,1), ones (19,1), 1), ... +%! mat2cell ([1:11]', ones (11,1), 1), "uniformoutput", false)'; +%! s = struct ([keys; vals]{:}); +%! t = cell2struct ([vals{:}], keys, 2); +%! assert (s, t); +%! assert (struct2cell (s), [vals{:}]'); +%! assert (fieldnames (s), keys'); +*/ + +mxArray * +octave_cell::as_mxArray (void) const +{ + mxArray *retval = new mxArray (dims ()); + + mxArray **elts = static_cast (retval->get_data ()); + + mwSize nel = numel (); + + const octave_value *p = matrix.data (); + + for (mwIndex i = 0; i < nel; i++) + elts[i] = new mxArray (p[i]); + + return retval; +} + +octave_value +octave_cell::map (unary_mapper_t umap) const +{ + switch (umap) + { +#define FORWARD_MAPPER(UMAP) \ + case umap_ ## UMAP: \ + return matrix.UMAP () + FORWARD_MAPPER (xisalnum); + FORWARD_MAPPER (xisalpha); + FORWARD_MAPPER (xisascii); + FORWARD_MAPPER (xiscntrl); + FORWARD_MAPPER (xisdigit); + FORWARD_MAPPER (xisgraph); + FORWARD_MAPPER (xislower); + FORWARD_MAPPER (xisprint); + FORWARD_MAPPER (xispunct); + FORWARD_MAPPER (xisspace); + FORWARD_MAPPER (xisupper); + FORWARD_MAPPER (xisxdigit); + FORWARD_MAPPER (xtoascii); + FORWARD_MAPPER (xtolower); + FORWARD_MAPPER (xtoupper); + + default: + return octave_base_value::map (umap); + } +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-cell.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-cell.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,180 @@ +/* + +Copyright (C) 1999-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_cell_h) +#define octave_cell_h 1 + +#include + +#include +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "Cell.h" +#include "error.h" +#include "ov-base-mat.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// Cells. + +class +octave_cell : public octave_base_matrix +{ +public: + + octave_cell (void) + : octave_base_matrix (), cellstr_cache () { } + + octave_cell (const Cell& c) + : octave_base_matrix (c), cellstr_cache () { } + + octave_cell (const Array& str) + : octave_base_matrix (Cell (str)), cellstr_cache (new Array (str)) { } + + octave_cell (const octave_cell& c) + : octave_base_matrix (c), cellstr_cache () { } + + ~octave_cell (void) { } + + octave_base_value *clone (void) const { return new octave_cell (*this); } + octave_base_value *empty_clone (void) const { return new octave_cell (); } + +#if 0 + octave_base_value *try_narrowing_conversion (void); +#endif + + octave_value subsref (const std::string& type, + const std::list& idx) + { + octave_value_list tmp = subsref (type, idx, 1); + return tmp.length () > 0 ? tmp(0) : octave_value (); + } + + octave_value_list subsref (const std::string& type, + const std::list& idx, int); + + octave_value subsref (const std::string& type, + const std::list& idx, + bool auto_add); + + octave_value subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + void assign (const octave_value_list& idx, const Cell& rhs); + + void assign (const octave_value_list& idx, const octave_value& rhs); + + void delete_elements (const octave_value_list& idx); + + size_t byte_size (void) const; + + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const; + + octave_value sort (Array &sidx, octave_idx_type dim = 0, + sortmode mode = ASCENDING) const; + + sortmode is_sorted (sortmode mode = UNSORTED) const; + + Array sort_rows_idx (sortmode mode = ASCENDING) const; + + sortmode is_sorted_rows (sortmode mode = UNSORTED) const; + + bool is_matrix_type (void) const { return false; } + + bool is_numeric_type (void) const { return false; } + + bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + + bool is_cell (void) const { return true; } + + builtin_type_t builtin_type (void) const { return btyp_cell; } + + bool is_cellstr (void) const; + + bool is_true (void) const; + + Cell cell_value (void) const { return matrix; } + + octave_value_list list_value (void) const; + + octave_value convert_to_str_internal (bool pad, bool, char type) const + { return octave_value (all_strings (pad), type); } + + string_vector all_strings (bool pad = false) const; + + Array cellstr_value (void) const; + + bool print_as_scalar (void) const; + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + octave_value map (unary_mapper_t umap) const; + + mxArray *as_mxArray (void) const; + + // Unsafe. This function exists to support the MEX interface. + // You should not use it anywhere else. + void *mex_get_data (void) const; + +private: + + void clear_cellstr_cache (void) const + { cellstr_cache.reset (); } + + mutable std::auto_ptr > cellstr_cache; + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-ch-mat.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-ch-mat.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,197 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "lo-ieee.h" +#include "mx-base.h" + +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-base-mat.cc" +#include "ov-ch-mat.h" +#include "gripes.h" +#include "pr-output.h" + +template class octave_base_matrix; + +idx_vector +octave_char_matrix::index_vector (void) const +{ + const char *p = matrix.data (); + if (numel () == 1 && *p == ':') + return idx_vector (':'); + else + return idx_vector (array_value (true)); +} + +double +octave_char_matrix::double_value (bool) const +{ + double retval = lo_ieee_nan_value (); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "character matrix", "real scalar"); + + retval = static_cast (matrix (0, 0)); + } + else + gripe_invalid_conversion ("character matrix", "real scalar"); + + return retval; +} + +float +octave_char_matrix::float_value (bool) const +{ + float retval = lo_ieee_float_nan_value (); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "character matrix", "real scalar"); + + retval = static_cast (matrix (0, 0)); + } + else + gripe_invalid_conversion ("character matrix", "real scalar"); + + return retval; +} + +Complex +octave_char_matrix::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "character matrix", "complex scalar"); + + retval = static_cast (matrix (0, 0)); + } + else + gripe_invalid_conversion ("character matrix", "complex scalar"); + + return retval; +} + +FloatComplex +octave_char_matrix::float_complex_value (bool) const +{ + float tmp = lo_ieee_float_nan_value (); + + FloatComplex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "character matrix", "complex scalar"); + + retval = static_cast (matrix (0, 0)); + } + else + gripe_invalid_conversion ("character matrix", "complex scalar"); + + return retval; +} + +void +octave_char_matrix::print_raw (std::ostream& os, + bool pr_as_read_syntax) const +{ + octave_print_internal (os, matrix, pr_as_read_syntax, + current_print_indent_level ()); +} + +mxArray * +octave_char_matrix::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxCHAR_CLASS, dims (), mxREAL); + + mxChar *pr = static_cast (retval->get_data ()); + + mwSize nel = numel (); + + const char *p = matrix.data (); + + for (mwIndex i = 0; i < nel; i++) + pr[i] = p[i]; + + return retval; +} + +// The C++ standard guarantees cctype defines functions, not macros (and hence macros *CAN'T* +// be defined if only cctype is included) +// so there's no need to f*ck around. The exceptions are isascii and toascii, +// which are not C++. +// Oddly enough, all those character functions are int (*) (int), even +// in C++. Wicked! +static inline int xisascii (int c) +{ return isascii (c); } + +static inline int xtoascii (int c) +{ return toascii (c); } + +octave_value +octave_char_matrix::map (unary_mapper_t umap) const +{ + switch (umap) + { +#define STRING_MAPPER(UMAP,FCN,TYPE) \ + case umap_ ## UMAP: \ + return octave_value (matrix.map (FCN)) + + STRING_MAPPER (xisalnum, std::isalnum, bool); + STRING_MAPPER (xisalpha, std::isalpha, bool); + STRING_MAPPER (xisascii, xisascii, bool); + STRING_MAPPER (xiscntrl, std::iscntrl, bool); + STRING_MAPPER (xisdigit, std::isdigit, bool); + STRING_MAPPER (xisgraph, std::isgraph, bool); + STRING_MAPPER (xislower, std::islower, bool); + STRING_MAPPER (xisprint, std::isprint, bool); + STRING_MAPPER (xispunct, std::ispunct, bool); + STRING_MAPPER (xisspace, std::isspace, bool); + STRING_MAPPER (xisupper, std::isupper, bool); + STRING_MAPPER (xisxdigit, std::isxdigit, bool); + STRING_MAPPER (xtoascii, xtoascii, double); + STRING_MAPPER (xtolower, std::tolower, char); + STRING_MAPPER (xtoupper, std::toupper, char); + + default: + { + octave_matrix m (array_value (true)); + return m.map (umap); + } + } +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-ch-mat.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-ch-mat.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,155 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_char_matrix_h) +#define octave_char_matrix_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "error.h" +#include "ov.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// Character matrix values. + +class +octave_char_matrix : public octave_base_matrix +{ +protected: + + octave_char_matrix (void) + : octave_base_matrix () { } + + octave_char_matrix (const charMatrix& chm) + : octave_base_matrix (chm) { } + + octave_char_matrix (const charNDArray& chm) + : octave_base_matrix (chm) { } + + octave_char_matrix (const Array& chm) + : octave_base_matrix (chm) { } + + octave_char_matrix (char c) + : octave_base_matrix (c) { } + + octave_char_matrix (const char *s) + : octave_base_matrix (s) { } + + octave_char_matrix (const std::string& s) + : octave_base_matrix (s) { } + + octave_char_matrix (const string_vector& s) + : octave_base_matrix (s) { } + + octave_char_matrix (const octave_char_matrix& chm) + : octave_base_matrix (chm) { } + +public: + + ~octave_char_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_char_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_char_matrix (); } + + idx_vector index_vector (void) const; + + builtin_type_t builtin_type (void) const { return btyp_char; } + + bool is_char_matrix (void) const { return true; } + bool is_real_matrix (void) const { return true; } + + bool is_real_type (void) const { return true; } + + double double_value (bool = false) const; + + float float_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + float float_scalar_value (bool frc_str_conv = false) const + { return float_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const + { return Matrix (matrix.matrix_value ()); } + + FloatMatrix float_matrix_value (bool = false) const + { return FloatMatrix (matrix.matrix_value ()); } + + NDArray array_value (bool = false) const + { return NDArray (matrix); } + + FloatNDArray float_array_value (bool = false) const + { return FloatNDArray (matrix); } + + Complex complex_value (bool = false) const; + + FloatComplex float_complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const + { return ComplexMatrix (matrix.matrix_value ()); } + + FloatComplexMatrix float_complex_matrix_value (bool = false) const + { return FloatComplexMatrix (matrix.matrix_value ()); } + + ComplexNDArray complex_array_value (bool = false) const + { return ComplexNDArray (matrix); } + + FloatComplexNDArray float_complex_array_value (bool = false) const + { return FloatComplexNDArray (matrix); } + + charMatrix char_matrix_value (bool = false) const + { return matrix.matrix_value (); } + + charNDArray char_array_value (bool = false) const + { return matrix; } + + octave_value convert_to_str_internal (bool, bool, char type) const + { return octave_value (matrix, type); } + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + // Unsafe. This function exists to support the MEX interface. + // You should not use it anywhere else. + void *mex_get_data (void) const { return matrix.mex_get_data (); } + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const; +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-class.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-class.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,2282 @@ +/* + +Copyright (C) 2007-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "Array-util.h" +#include "byte-swap.h" +#include "oct-locbuf.h" +#include "lo-mappers.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "file-ops.h" +#include "gripes.h" +#include "load-path.h" +#include "ls-hdf5.h" +#include "ls-oct-ascii.h" +#include "ls-oct-binary.h" +#include "ls-utils.h" +#include "oct-lvalue.h" +#include "ov-class.h" +#include "ov-fcn.h" +#include "ov-usr-fcn.h" +#include "pager.h" +#include "parse.h" +#include "pr-output.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "variables.h" + +DEFINE_OCTAVE_ALLOCATOR(octave_class); + +int octave_class::t_id (-1); + +const std::string octave_class::t_name ("class"); + +void +octave_class::register_type (void) +{ + t_id = octave_value_typeinfo::register_type + (octave_class::t_name, "", octave_value (new octave_class ())); +} + +octave_class::octave_class (const octave_map& m, const std::string& id, + const octave_value_list& parents) + : octave_base_value (), map (m), c_name (id), obsolete_copies (0) +{ + octave_idx_type n = parents.length (); + + for (octave_idx_type idx = 0; idx < n; idx++) + { + octave_value parent = parents(idx); + + if (! parent.is_object ()) + error ("parents must be objects"); + else + { + std::string pcnm = parent.class_name (); + + if (find_parent_class (pcnm)) + error ("duplicate class in parent tree"); + else + { + parent_list.push_back (pcnm); + + octave_idx_type nel = map.numel (); + octave_idx_type p_nel = parent.numel (); + + if (nel == 0) + { + if (p_nel == 0) + { + // No elements in MAP or the parent class object, + // so just add the field name. + + map.assign (pcnm, Cell (map.dims ())); + } + else if (p_nel == 1) + { + if (map.nfields () == 0) + { + // No elements or fields in MAP, but the + // parent is class object with one element. + // Resize to match size of parent class and + // make the parent a field in MAP. + + map.resize (parent.dims ()); + + map.assign (pcnm, parent); + } + else + { + // No elements in MAP, but we have at least + // one field. So don't resize, just add the + // field name. + + map.assign (pcnm, Cell (map.dims ())); + } + } + else if (map.nfields () == 0) + { + // No elements or fields in MAP and more than one + // element in the parent class object, so we can + // resize MAP to match parent dimsenions, then + // distribute the elements of the parent object to + // the elements of MAP. + + dim_vector parent_dims = parent.dims (); + + map.resize (parent_dims); + + Cell c (parent_dims); + + octave_map pmap = parent.map_value (); + + std::list plist + = parent.parent_class_name_list (); + + for (octave_idx_type i = 0; i < p_nel; i++) + c(i) = octave_value (pmap.index (i), pcnm, plist); + + map.assign (pcnm, c); + } + else + error ("class: parent class dimension mismatch"); + } + else if (nel == 1 && p_nel == 1) + { + // Simple assignment. + + map.assign (pcnm, parent); + } + else + { + if (p_nel == 1) + { + // Broadcast the scalar parent class object to + // each element of MAP. + + Cell pcell (map.dims (), parent); + + map.assign (pcnm, pcell); + } + + else if (nel == p_nel) + { + // FIXME -- is there a better way to do this? + + // The parent class object has the same number of + // elements as the map we are using to create the + // new object, so distribute those elements to + // each element of the new object by first + // splitting the elements of the parent class + // object into a cell array with one element per + // cell. Then do the assignment all at once. + + Cell c (parent.dims ()); + + octave_map pmap = parent.map_value (); + + std::list plist + = parent.parent_class_name_list (); + + for (octave_idx_type i = 0; i < p_nel; i++) + c(i) = octave_value (pmap.index (i), pcnm, plist); + + map.assign (pcnm, c); + } + else + error ("class: parent class dimension mismatch"); + } + } + } + } + + if (! error_state) + symbol_table::add_to_parent_map (id, parent_list); +} + +octave_base_value * +octave_class::unique_clone (void) +{ + if (count == obsolete_copies) + { + // All remaining copies are obsolete. We don't actually need to clone. + count++; + return this; + } + else + { + // In theory, this shouldn't be happening, but it's here just in case. + if (count < obsolete_copies) + obsolete_copies = 0; + + return clone (); + } +} + +std::string +octave_class::get_current_method_class (void) +{ + std::string retval = class_name (); + + if (nparents () > 0) + { + octave_function *fcn = octave_call_stack::current (); + + // Here we are just looking to see if FCN is a method or constructor + // for any class, not specifically this one. + if (fcn && (fcn->is_class_method () || fcn->is_class_constructor ())) + retval = fcn->dispatch_class (); + } + + return retval; +} + +static void +gripe_invalid_index1 (void) +{ + error ("invalid index for class"); +} + +static void +gripe_invalid_index_for_assignment (void) +{ + error ("invalid index for class assignment"); +} + +static void +gripe_invalid_index_type (const std::string& nm, char t) +{ + error ("%s cannot be indexed with %c", nm.c_str (), t); +} + +static void +gripe_failed_assignment (void) +{ + error ("assignment to class element failed"); +} + +static inline octave_value_list +sanitize (const octave_value_list& ovl) +{ + octave_value_list retval = ovl; + + for (octave_idx_type i = 0; i < ovl.length (); i++) + { + if (retval(i).is_magic_colon ()) + retval(i) = ":"; + } + + return retval; +} + +static inline octave_value +make_idx_args (const std::string& type, + const std::list& idx, + const std::string& who) +{ + octave_value retval; + + size_t len = type.length (); + + if (len == idx.size ()) + { + Cell type_field (1, len); + Cell subs_field (1, len); + + std::list::const_iterator p = idx.begin (); + + for (size_t i = 0; i < len; i++) + { + char t = type[i]; + + switch (t) + { + case '(': + type_field(i) = "()"; + subs_field(i) = Cell (sanitize (*p++)); + break; + + case '{': + type_field(i) = "{}"; + subs_field(i) = Cell (sanitize (*p++)); + break; + + case '.': + { + type_field(i) = "."; + + octave_value_list vlist = *p++; + + if (vlist.length () == 1) + { + octave_value val = vlist(0); + + if (val.is_string ()) + subs_field(i) = val; + else + { + error ("expecting character string argument for `.' index"); + return retval; + } + } + else + { + error ("expecting single argument for `.' index"); + return retval; + } + } + break; + + default: + panic_impossible (); + break; + } + } + + octave_map m; + + m.assign ("type", type_field); + m.assign ("subs", subs_field); + + retval = m; + } + else + error ("invalid index for %s", who.c_str ()); + + return retval; +} + +Cell +octave_class::dotref (const octave_value_list& idx) +{ + Cell retval; + + assert (idx.length () == 1); + + std::string method_class = get_current_method_class (); + + // Find the class in which this method resides before attempting to access + // the requested field. + + octave_base_value *obvp = find_parent_class (method_class); + + if (obvp == 0) + { + error ("malformed class"); + return retval; + } + + octave_map my_map = (obvp != this) ? obvp->map_value () : map; + + std::string nm = idx(0).string_value (); + + if (! error_state) + { + octave_map::const_iterator p = my_map.seek (nm); + + if (p != my_map.end ()) + retval = my_map.contents (p); + else + error ("class has no member `%s'", nm.c_str ()); + } + else + gripe_invalid_index1 (); + + return retval; +} + +static bool +called_from_builtin (void) +{ + octave_function *fcn = octave_call_stack::caller (); + + // FIXME -- we probably need a better check here, or some other + // mechanism to avoid overloaded functions when builtin is used. + // For example, what if someone overloads the builtin function? + // Also, are there other places where using builtin is not properly + // avoiding dispatch? + + return (fcn && fcn->name () == "builtin"); +} + +Matrix +octave_class::size (void) +{ + if (in_class_method () || called_from_builtin ()) + return octave_base_value::size (); + + Matrix retval (1, 2, 1.0); + octave_value meth = symbol_table::find_method ("size", class_name ()); + + if (meth.is_defined ()) + { + count++; + octave_value_list args (1, octave_value (this)); + + octave_value_list lv = feval (meth.function_value (), args, 1); + if (lv.length () > 0 && lv(0).is_matrix_type () && lv(0).dims ().is_vector ()) + retval = lv(0).matrix_value (); + else + error ("@%s/size: invalid return value", class_name ().c_str ()); + } + else + { + dim_vector dv = dims (); + + int nd = dv.length (); + + retval.resize (1, nd); + + for (int i = 0; i < nd; i++) + retval(i) = dv(i); + } + + return retval; +} + +octave_idx_type +octave_class::numel (const octave_value_list& idx) +{ + if (in_class_method () || called_from_builtin ()) + return octave_base_value::numel (idx); + + octave_idx_type retval = -1; + const std::string cn = class_name (); + + octave_value meth = symbol_table::find_method ("numel", cn); + + if (meth.is_defined ()) + { + octave_value_list args (idx.length () + 1, octave_value ()); + + count++; + args(0) = octave_value (this); + + for (octave_idx_type i = 0; i < idx.length (); i++) + args(i+1) = idx(i); + + octave_value_list lv = feval (meth.function_value (), args, 1); + if (lv.length () == 1 && lv(0).is_scalar_type ()) + retval = lv(0).idx_type_value (true); + else + error ("@%s/numel: invalid return value", cn.c_str ()); + } + else + retval = octave_base_value::numel (idx); + + return retval; +} + +octave_value_list +octave_class::subsref (const std::string& type, + const std::list& idx, + int nargout) +{ + octave_value_list retval; + + if (in_class_method () || called_from_builtin ()) + { + // FIXME -- this block of code is the same as the body of + // octave_struct::subsref. Maybe it could be shared instead of + // duplicated. + + int skip = 1; + + switch (type[0]) + { + case '(': + { + if (type.length () > 1 && type[1] == '.') + { + std::list::const_iterator p = idx.begin (); + octave_value_list key_idx = *++p; + + Cell tmp = dotref (key_idx); + + if (! error_state) + { + Cell t = tmp.index (idx.front ()); + + retval(0) = (t.length () == 1) ? t(0) : octave_value (t, true); + + // We handled two index elements, so tell + // next_subsref to skip both of them. + + skip++; + } + } + else + retval(0) = octave_value (map.index (idx.front ()), + c_name, parent_list); + } + break; + + case '.': + { + if (map.numel () > 0) + { + Cell t = dotref (idx.front ()); + + retval(0) = (t.length () == 1) ? t(0) : octave_value (t, true); + } + } + break; + + case '{': + gripe_invalid_index_type (type_name (), type[0]); + break; + + default: + panic_impossible (); + } + + // FIXME -- perhaps there should be an + // octave_value_list::next_subsref member function? See also + // octave_user_function::subsref. + + if (idx.size () > 1) + retval = retval(0).next_subsref (nargout, type, idx, skip); + } + else + { + octave_value meth = symbol_table::find_method ("subsref", class_name ()); + + if (meth.is_defined ()) + { + octave_value_list args; + + args(1) = make_idx_args (type, idx, "subsref"); + + if (error_state) + return octave_value_list (); + + count++; + args(0) = octave_value (this); + + // FIXME: for Matlab compatibility, let us attempt to set up a proper + // value for nargout at least in the simple case where the + // cs-list-type expression - i.e., {} or ().x, is the leading one. + // Note that Octave does not actually need this, since it will + // be able to properly react to varargout a posteriori. + bool maybe_cs_list_query = (type[0] == '.' || type[0] == '{' + || (type.length () > 1 && type[0] == '(' + && type[1] == '.')); + + int true_nargout = nargout; + + if (maybe_cs_list_query) + { + // Set up a proper nargout for the subsref call by calling numel. + octave_value_list tmp; + if (type[0] != '.') tmp = idx.front (); + true_nargout = numel (tmp); + } + + retval = feval (meth.function_value (), args, true_nargout); + + // Since we're handling subsref, return the list in the first value + // if it has more than one element, to be able to pass through + // rvalue1 calls. + if (retval.length () > 1) + retval = octave_value (retval, true); + } + else + { + if (type.length () == 1 && type[0] == '(') + retval(0) = octave_value (map.index (idx.front ()), c_name, + parent_list); + else + gripe_invalid_index1 (); + } + } + + return retval; +} + +octave_value +octave_class::numeric_conv (const Cell& val, const std::string& type) +{ + octave_value retval; + + if (val.length () == 1) + { + retval = val(0); + + if (type.length () > 0 && type[0] == '.' && ! retval.is_map ()) + retval = octave_map (); + } + else + gripe_invalid_index_for_assignment (); + + return retval; +} + +octave_value +octave_class::subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + count++; + return subsasgn_common (octave_value (this), type, idx, rhs); +} + +octave_value +octave_class::undef_subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + // For compatibility with Matlab, pass [] as the first argument to the + // the subsasgn function when the LHS of an indexed assignment is + // undefined. + + return subsasgn_common (Matrix (), type, idx, rhs); +} + +octave_value +octave_class::subsasgn_common (const octave_value& obj, + const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + octave_value retval; + + if (! (in_class_method () || called_from_builtin ())) + { + octave_value meth = symbol_table::find_method ("subsasgn", class_name ()); + + if (meth.is_defined ()) + { + octave_value_list args; + + if (rhs.is_cs_list ()) + { + octave_value_list lrhs = rhs.list_value (); + args.resize (2 + lrhs.length ()); + for (octave_idx_type i = 0; i < lrhs.length (); i++) + args(2+i) = lrhs(i); + } + else + args(2) = rhs; + + args(1) = make_idx_args (type, idx, "subsasgn"); + + if (error_state) + return octave_value_list (); + + args(0) = obj; + + // Now comes the magic. Count copies with me: + // 1. myself (obsolete) + // 2. the copy inside args (obsolete) + // 3. the copy in method's symbol table (working) + // ... possibly more (not obsolete). + // + // So we mark 2 copies as obsolete and hold our fingers crossed. + // But prior to doing that, check whether the routine is amenable + // to the optimization. + // It is essential that the handling function doesn't store extra + // copies anywhere. If it does, things will not break but the + // optimization won't work. + + octave_value_list tmp; + + if (obsolete_copies == 0 && meth.is_user_function () + && meth.user_function_value ()->subsasgn_optimization_ok ()) + { + unwind_protect frame; + frame.protect_var (obsolete_copies); + obsolete_copies = 2; + + tmp = feval (meth.function_value (), args); + } + else + tmp = feval (meth.function_value (), args); + + // FIXME -- should the subsasgn method be able to return + // more than one value? + + if (tmp.length () > 1) + error ("expecting single return value from @%s/subsasgn", + class_name ().c_str ()); + + else + retval = tmp(0); + + return retval; + } + } + + // Find the class in which this method resides before + // attempting to do the indexed assignment. + + std::string method_class = get_current_method_class (); + + octave_base_value *obvp = unique_parent_class (method_class); + if (obvp != this) + { + + if (obvp) + { + obvp->subsasgn (type, idx, rhs); + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + else + error ("malformed class"); + + return retval; + } + + // FIXME -- this block of code is the same as the body of + // octave_struct::subsasgn. Maybe it could be shared instead of + // duplicated. + + int n = type.length (); + + octave_value t_rhs = rhs; + + if (n > 1 && ! (type.length () == 2 && type[0] == '(' && type[1] == '.')) + { + switch (type[0]) + { + case '(': + { + if (type.length () > 1 && type[1] == '.') + { + std::list::const_iterator p = idx.begin (); + octave_value_list t_idx = *p; + + octave_value_list key_idx = *++p; + + assert (key_idx.length () == 1); + + std::string key = key_idx(0).string_value (); + + if (! error_state) + { + octave_value u; + + if (! map.contains (key)) + u = octave_value::empty_conv (type.substr (2), rhs); + else + { + Cell map_val = map.contents (key); + + Cell map_elt = map_val.index (idx.front (), true); + + u = numeric_conv (map_elt, type.substr (2)); + } + + if (! error_state) + { + std::list next_idx (idx); + + // We handled two index elements, so subsasgn to + // needs to skip both of them. + + next_idx.erase (next_idx.begin ()); + next_idx.erase (next_idx.begin ()); + + u.make_unique (); + + t_rhs = u.subsasgn (type.substr (2), next_idx, rhs); + } + } + else + gripe_invalid_index_for_assignment (); + } + else + gripe_invalid_index_for_assignment (); + } + break; + + case '.': + { + octave_value_list key_idx = idx.front (); + + assert (key_idx.length () == 1); + + std::string key = key_idx(0).string_value (); + + std::list next_idx (idx); + + next_idx.erase (next_idx.begin ()); + + std::string next_type = type.substr (1); + + Cell tmpc (1, 1); + octave_map::iterator pkey = map.seek (key); + if (pkey != map.end ()) + { + map.contents (pkey).make_unique (); + tmpc = map.contents (pkey); + } + + // FIXME: better code reuse? + if (! error_state) + { + if (tmpc.numel () == 1) + { + octave_value& tmp = tmpc(0); + + if (! tmp.is_defined () || tmp.is_zero_by_zero ()) + { + tmp = octave_value::empty_conv (next_type, rhs); + tmp.make_unique (); // probably a no-op. + } + else + // optimization: ignore the copy still stored inside our map. + tmp.make_unique (1); + + if (! error_state) + t_rhs = tmp.subsasgn (next_type, next_idx, rhs); + } + else + gripe_indexed_cs_list (); + } + } + break; + + case '{': + gripe_invalid_index_type (type_name (), type[0]); + break; + + default: + panic_impossible (); + } + } + + if (! error_state) + { + switch (type[0]) + { + case '(': + { + if (n > 1 && type[1] == '.') + { + std::list::const_iterator p = idx.begin (); + octave_value_list key_idx = *++p; + + assert (key_idx.length () == 1); + + std::string key = key_idx(0).string_value (); + + if (! error_state) + { + map.assign (idx.front (), key, t_rhs); + + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + else + gripe_failed_assignment (); + } + else + { + if (t_rhs.is_object () || t_rhs.is_map ()) + { + octave_map rhs_map = t_rhs.map_value (); + + if (! error_state) + { + map.assign (idx.front (), rhs_map); + + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + else + error ("invalid class assignment"); + } + else + { + if (t_rhs.is_empty ()) + { + map.delete_elements (idx.front ()); + + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + else + error ("invalid class assignment"); + } + } + } + break; + + case '.': + { + octave_value_list key_idx = idx.front (); + + assert (key_idx.length () == 1); + + std::string key = key_idx(0).string_value (); + + if (t_rhs.is_cs_list ()) + { + Cell tmp_cell = Cell (t_rhs.list_value ()); + + // The shape of the RHS is irrelevant, we just want + // the number of elements to agree and to preserve the + // shape of the left hand side of the assignment. + + if (numel () == tmp_cell.numel ()) + tmp_cell = tmp_cell.reshape (dims ()); + + map.setfield (key, tmp_cell); + } + else + { + Cell tmp_cell(1, 1); + tmp_cell(0) = t_rhs.storable_value (); + map.setfield (key, tmp_cell); + } + + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + break; + + case '{': + gripe_invalid_index_type (type_name (), type[0]); + break; + + default: + panic_impossible (); + } + } + else + gripe_failed_assignment (); + + return retval; +} + +idx_vector +octave_class::index_vector (void) const +{ + idx_vector retval; + + octave_value meth = symbol_table::find_method ("subsindex", class_name ()); + + if (meth.is_defined ()) + { + octave_value_list args; + args(0) = octave_value (new octave_class (map, c_name, parent_list)); + + octave_value_list tmp = feval (meth.function_value (), args, 1); + + if (!error_state && tmp.length () >= 1) + { + if (tmp(0).is_object ()) + error ("subsindex function must return a valid index vector"); + else + // Index vector returned by subsindex is zero based + // (why this inconsistency Mathworks?), and so we must + // add one to the value returned as the index_vector method + // expects it to be one based. + retval = do_binary_op (octave_value::op_add, tmp (0), + octave_value (1.0)).index_vector (); + } + } + else + error ("no subsindex method defined for class %s", + class_name ().c_str ()); + + return retval; +} + +size_t +octave_class::byte_size (void) const +{ + // Neglect the size of the fieldnames. + + size_t retval = 0; + + for (octave_map::const_iterator p = map.begin (); p != map.end (); p++) + { + std::string key = map.key (p); + + octave_value val = octave_value (map.contents (p)); + + retval += val.byte_size (); + } + + return retval; +} + +string_vector +octave_class::map_keys (void) const +{ + string_vector retval; + gripe_wrong_type_arg ("octave_class::map_keys()", type_name ()); + return retval; +} + +octave_base_value * +octave_class::find_parent_class (const std::string& parent_class_name) +{ + octave_base_value* retval = 0; + + if (parent_class_name == class_name ()) + retval = this; + else + { + for (std::list::iterator pit = parent_list.begin (); + pit != parent_list.end (); + pit++) + { + octave_map::const_iterator smap = map.seek (*pit); + + const Cell& tmp = map.contents (smap); + + octave_value vtmp = tmp(0); + + octave_base_value *obvp = vtmp.internal_rep (); + + retval = obvp->find_parent_class (parent_class_name); + + if (retval) + break; + } + } + + return retval; +} + +octave_base_value * +octave_class::unique_parent_class (const std::string& parent_class_name) +{ + octave_base_value* retval = 0; + + if (parent_class_name == class_name ()) + retval = this; + else + { + for (std::list::iterator pit = parent_list.begin (); + pit != parent_list.end (); + pit++) + { + octave_map::iterator smap = map.seek (*pit); + + Cell& tmp = map.contents (smap); + + octave_value& vtmp = tmp(0); + + octave_base_value *obvp = vtmp.internal_rep (); + + // Use find_parent_class first to avoid uniquifying if not necessary. + retval = obvp->find_parent_class (parent_class_name); + + if (retval) + { + vtmp.make_unique (); + obvp = vtmp.internal_rep (); + retval = obvp->unique_parent_class (parent_class_name); + + break; + } + } + } + + return retval; +} + +string_vector +octave_class::all_strings (bool pad) const +{ + string_vector retval; + + octave_value meth = symbol_table::find_method ("char", class_name ()); + + if (meth.is_defined ()) + { + octave_value_list args; + args(0) = octave_value (new octave_class (map, c_name, parent_list)); + + octave_value_list tmp = feval (meth.function_value (), args, 1); + + if (!error_state && tmp.length () >= 1) + { + if (tmp(0).is_string ()) + retval = tmp(0).all_strings (pad); + else + error ("cname/char method did not return a character string"); + } + } + else + error ("no char method defined for class %s", class_name ().c_str ()); + + return retval; +} + + +void +octave_class::print (std::ostream& os, bool) const +{ + print_raw (os); +} + +void +octave_class::print_raw (std::ostream& os, bool) const +{ + unwind_protect frame; + + indent (os); + os << " "; + newline (os); +} + +bool +octave_class::print_name_tag (std::ostream& os, const std::string& name) const +{ + bool retval = false; + + indent (os); + os << name << " ="; + newline (os); + if (! Vcompact_format) + newline (os); + + return retval; +} + +void +octave_class::print_with_name (std::ostream& os, const std::string& name, + bool) +{ + octave_value fcn = symbol_table::find_method ("display", class_name ()); + + if (fcn.is_defined ()) + { + octave_value_list args; + + count++; + args(0) = octave_value (this); + + string_vector arg_names (1); + + arg_names[0] = name; + + args.stash_name_tags (arg_names); + + feval (fcn.function_value (), args); + } + else + { + indent (os); + os << name << " = "; + newline (os); + } +} + +// Loading a class properly requires an exemplar map entry for success. +// If we don't have one, we attempt to create one by calling the constructor +// with no arguments. +bool +octave_class::reconstruct_exemplar (void) +{ + bool retval = false; + + octave_class::exemplar_const_iterator it + = octave_class::exemplar_map.find (c_name); + + if (it != octave_class::exemplar_map.end ()) + retval = true; + else + { + octave_value ctor = symbol_table::find_method (c_name, c_name); + + bool have_ctor = false; + + if (ctor.is_defined () && ctor.is_function ()) + { + octave_function *fcn = ctor.function_value (); + + if (fcn && fcn->is_class_constructor (c_name)) + have_ctor = true; + + // Something has gone terribly wrong if + // symbol_table::find_method (c_name, c_name) does not return + // a class constructor for the class c_name... + assert (have_ctor); + } + + if (have_ctor) + { + octave_value_list result + = ctor.do_multi_index_op (1, octave_value_list ()); + + if (result.length () == 1) + retval = true; + else + warning ("call to constructor for class %s failed", c_name.c_str ()); + } + else + warning ("no constructor for class %s", c_name.c_str ()); + } + + return retval; +} + +void +octave_class::clear_exemplar_map (void) +{ + exemplar_map.clear (); +} + +// Load/save does not provide enough information to reconstruct the +// class inheritance structure. reconstruct_parents () attempts to +// do so. If successful, a "true" value is returned. +// +// Note that we don't check the loaded object structure against the +// class structure here so the user's loadobj method has a chance +// to do its magic. +bool +octave_class::reconstruct_parents (void) +{ + bool retval = true, might_have_inheritance = false; + std::string dbgstr = "dork"; + + // First, check to see if there might be an issue with inheritance. + for (octave_map::const_iterator p = map.begin (); p != map.end (); p++) + { + std::string key = map.key (p); + Cell val = map.contents (p); + if ( val(0).is_object () ) + { + dbgstr = "blork"; + if ( key == val(0).class_name () ) + { + might_have_inheritance = true; + dbgstr = "cork"; + break; + } + } + } + + if (might_have_inheritance) + { + octave_class::exemplar_const_iterator it + = octave_class::exemplar_map.find (c_name); + + if (it == octave_class::exemplar_map.end ()) + retval = false; + else + { + octave_class::exemplar_info exmplr = it->second; + parent_list = exmplr.parents (); + for (std::list::iterator pit = parent_list.begin (); + pit != parent_list.end (); + pit++) + { + dbgstr = *pit; + bool dbgbool = map.contains (*pit); + if (!dbgbool) + { + retval = false; + break; + } + } + } + } + + return retval; +} + +bool +octave_class::save_ascii (std::ostream& os) +{ + os << "# classname: " << class_name () << "\n"; + octave_map m; + if (load_path::find_method (class_name (), "saveobj") != std::string ()) + { + octave_value in = new octave_class (*this); + octave_value_list tmp = feval ("saveobj", in, 1); + if (! error_state) + m = tmp(0).map_value (); + else + return false; + } + else + m = map_value (); + + os << "# length: " << m.nfields () << "\n"; + + octave_map::iterator i = m.begin (); + while (i != m.end ()) + { + octave_value val = map.contents (i); + + bool b = save_ascii_data (os, val, m.key (i), false, 0); + + if (! b) + return os; + + i++; + } + + return true; +} + +bool +octave_class::load_ascii (std::istream& is) +{ + octave_idx_type len = 0; + std::string classname; + bool success = true; + + if (extract_keyword (is, "classname", classname) && classname != "") + { + if (extract_keyword (is, "length", len) && len >= 0) + { + if (len > 0) + { + octave_map m (map); + + for (octave_idx_type j = 0; j < len; j++) + { + octave_value t2; + bool dummy; + + // recurse to read cell elements + std::string nm + = read_ascii_data (is, std::string (), dummy, t2, j); + + if (! is) + break; + + Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); + + if (error_state) + { + error ("load: internal error loading class elements"); + return false; + } + + m.assign (nm, tcell); + } + + if (is) + { + c_name = classname; + reconstruct_exemplar (); + + map = m; + + if (! reconstruct_parents ()) + warning ("load: unable to reconstruct object inheritance"); + else + { + if (load_path::find_method (classname, "loadobj") + != std::string ()) + { + octave_value in = new octave_class (*this); + octave_value_list tmp = feval ("loadobj", in, 1); + + if (! error_state) + map = tmp(0).map_value (); + else + success = false; + } + } + } + else + { + error ("load: failed to load class"); + success = false; + } + } + else if (len == 0 ) + { + map = octave_map (dim_vector (1, 1)); + c_name = classname; + } + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of elements in class"); + success = false; + } + } + else + { + error ("load: failed to extract name of class"); + success = false; + } + + return success; +} + +bool +octave_class::save_binary (std::ostream& os, bool& save_as_floats) +{ + int32_t classname_len = class_name ().length (); + + os.write (reinterpret_cast (&classname_len), 4); + os << class_name (); + + octave_map m; + if (load_path::find_method (class_name (), "saveobj") != std::string ()) + { + octave_value in = new octave_class (*this); + octave_value_list tmp = feval ("saveobj", in, 1); + if (! error_state) + m = tmp(0).map_value (); + else + return false; + } + else + m = map_value (); + + int32_t len = m.nfields (); + os.write (reinterpret_cast (&len), 4); + + octave_map::iterator i = m.begin (); + while (i != m.end ()) + { + octave_value val = map.contents (i); + + bool b = save_binary_data (os, val, m.key (i), "", 0, save_as_floats); + + if (! b) + return os; + + i++; + } + + return true; +} + +bool +octave_class::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + bool success = true; + + int32_t classname_len; + + is.read (reinterpret_cast (&classname_len), 4); + if (! is) + return false; + else if (swap) + swap_bytes<4> (&classname_len); + + { + OCTAVE_LOCAL_BUFFER (char, classname, classname_len+1); + classname[classname_len] = '\0'; + if (! is.read (reinterpret_cast (classname), classname_len)) + return false; + c_name = classname; + } + reconstruct_exemplar (); + + int32_t len; + if (! is.read (reinterpret_cast (&len), 4)) + return false; + if (swap) + swap_bytes<4> (&len); + + if (len > 0) + { + octave_map m (map); + + for (octave_idx_type j = 0; j < len; j++) + { + octave_value t2; + bool dummy; + std::string doc; + + // recurse to read cell elements + std::string nm = read_binary_data (is, swap, fmt, std::string (), + dummy, t2, doc); + + if (! is) + break; + + Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); + + if (error_state) + { + error ("load: internal error loading class elements"); + return false; + } + + m.assign (nm, tcell); + } + + if (is) + { + map = m; + + if (! reconstruct_parents ()) + warning ("load: unable to reconstruct object inheritance"); + else + { + if (load_path::find_method (c_name, "loadobj") != std::string ()) + { + octave_value in = new octave_class (*this); + octave_value_list tmp = feval ("loadobj", in, 1); + + if (! error_state) + map = tmp(0).map_value (); + else + success = false; + } + } + } + else + { + warning ("load: failed to load class"); + success = false; + } + } + else if (len == 0 ) + map = octave_map (dim_vector (1, 1)); + else + panic_impossible (); + + return success; +} + +#if defined (HAVE_HDF5) + +bool +octave_class::save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) +{ + hsize_t hdims[3]; + hid_t group_hid = -1; + hid_t type_hid = -1; + hid_t space_hid = -1; + hid_t class_hid = -1; + hid_t data_hid = -1; + octave_map m; + octave_map::iterator i; + +#if HAVE_HDF5_18 + group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + group_hid = H5Gcreate (loc_id, name, 0); +#endif + if (group_hid < 0) + goto error_cleanup; + + // Add the class name to the group + type_hid = H5Tcopy (H5T_C_S1); H5Tset_size (type_hid, c_name.length () + 1); + if (type_hid < 0) + goto error_cleanup; + + hdims[0] = 0; + space_hid = H5Screate_simple (0 , hdims, 0); + if (space_hid < 0) + goto error_cleanup; +#if HAVE_HDF5_18 + class_hid = H5Dcreate (group_hid, "classname", type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + class_hid = H5Dcreate (group_hid, "classname", type_hid, space_hid, + H5P_DEFAULT); +#endif + if (class_hid < 0 || H5Dwrite (class_hid, type_hid, H5S_ALL, H5S_ALL, + H5P_DEFAULT, c_name.c_str ()) < 0) + goto error_cleanup; + +#if HAVE_HDF5_18 + data_hid = H5Gcreate (group_hid, "value", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Gcreate (group_hid, "value", 0); +#endif + if (data_hid < 0) + goto error_cleanup; + + if (load_path::find_method (class_name (), "saveobj") != std::string ()) + { + octave_value in = new octave_class (*this); + octave_value_list tmp = feval ("saveobj", in, 1); + if (! error_state) + m = tmp(0).map_value (); + else + goto error_cleanup; + } + else + m = map_value (); + + // recursively add each element of the class to this group + i = m.begin (); + while (i != m.end ()) + { + octave_value val = map.contents (i); + + bool retval2 = add_hdf5_data (data_hid, val, m.key (i), "", false, + save_as_floats); + + if (! retval2) + break; + + i++; + } + + error_cleanup: + + if (data_hid > 0) + H5Gclose (data_hid); + + if (class_hid > 0) + H5Dclose (class_hid); + + if (space_hid > 0) + H5Sclose (space_hid); + + if (type_hid > 0) + H5Tclose (type_hid); + + if (group_hid > 0) + H5Gclose (group_hid); + + return true; +} + +bool +octave_class::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; + + hid_t group_hid = -1; + hid_t data_hid = -1; + hid_t type_hid = -1; + hid_t type_class_hid = -1; + hid_t space_hid = -1; + hid_t subgroup_hid = -1; + hid_t st_id = -1; + + hdf5_callback_data dsub; + + herr_t retval2 = 0; + octave_map m (dim_vector (1, 1)); + int current_item = 0; + hsize_t num_obj = 0; + int slen = 0; + hsize_t rank = 0; + +#if HAVE_HDF5_18 + group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); +#else + group_hid = H5Gopen (loc_id, name); +#endif + if (group_hid < 0) + goto error_cleanup; + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "classname", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "classname"); +#endif + + if (data_hid < 0) + goto error_cleanup; + + type_hid = H5Dget_type (data_hid); + + type_class_hid = H5Tget_class (type_hid); + + if (type_class_hid != H5T_STRING) + goto error_cleanup; + + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + goto error_cleanup; + + slen = H5Tget_size (type_hid); + if (slen < 0) + goto error_cleanup; + + // do-while loop here to prevent goto crossing initialization of classname + do + { + OCTAVE_LOCAL_BUFFER (char, classname, slen); + + // create datatype for (null-terminated) string to read into: + st_id = H5Tcopy (H5T_C_S1); + H5Tset_size (st_id, slen); + + if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, + classname) < 0) + { + H5Tclose (st_id); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Tclose (st_id); + H5Dclose (data_hid); + data_hid = -1; + + c_name = classname; + } + while (0); + reconstruct_exemplar (); + +#if HAVE_HDF5_18 + subgroup_hid = H5Gopen (group_hid, name, H5P_DEFAULT); +#else + subgroup_hid = H5Gopen (group_hid, name); +#endif + H5Gget_num_objs (subgroup_hid, &num_obj); + H5Gclose (subgroup_hid); + + while (current_item < static_cast (num_obj) + && (retval2 = H5Giterate (group_hid, name, ¤t_item, + hdf5_read_next_data, &dsub)) > 0) + { + octave_value t2 = dsub.tc; + + Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); + + if (error_state) + { + error ("load: internal error loading class elements"); + return false; + } + + m.assign (dsub.name, tcell); + + } + + if (retval2 >= 0) + { + map = m; + + if (!reconstruct_parents ()) + warning ("load: unable to reconstruct object inheritance"); + else + { + if (load_path::find_method (c_name, "loadobj") != std::string ()) + { + octave_value in = new octave_class (*this); + octave_value_list tmp = feval ("loadobj", in, 1); + + if (! error_state) + { + map = tmp(0).map_value (); + retval = true; + } + else + retval = false; + } + else + retval = true; + } + } + + error_cleanup: + if (data_hid > 0) + H5Dclose (data_hid); + + if (data_hid > 0) + H5Gclose (group_hid); + + return retval; +} + +#endif + +mxArray * +octave_class::as_mxArray (void) const +{ + gripe_wrong_type_arg ("octave_class::as_mxArray ()", type_name ()); + + return 0; +} + +bool +octave_class::in_class_method (void) +{ + octave_function *fcn = octave_call_stack::current (); + + return (fcn + && (fcn->is_class_method () + || fcn->is_class_constructor () + || fcn->is_anonymous_function_of_class () + || fcn->is_private_function_of_class (class_name ())) + && find_parent_class (fcn->dispatch_class ())); +} + +octave_class::exemplar_info::exemplar_info (const octave_value& obj) + : field_names (), parent_class_names () +{ + if (obj.is_object ()) + { + octave_map m = obj.map_value (); + field_names = m.keys (); + + parent_class_names = obj.parent_class_name_list (); + } + else + error ("invalid call to exemplar_info constructor"); +} + + +// A map from class names to lists of fields. +std::map octave_class::exemplar_map; + +bool +octave_class::exemplar_info::compare (const octave_value& obj) const +{ + bool retval = true; + + if (obj.is_object ()) + { + if (nfields () == obj.nfields ()) + { + octave_map obj_map = obj.map_value (); + string_vector obj_fnames = obj_map.keys (); + string_vector fnames = fields (); + + for (octave_idx_type i = 0; i < nfields (); i++) + { + if (obj_fnames[i] != fnames[i]) + { + retval = false; + error ("mismatch in field names"); + break; + } + } + + if (nparents () == obj.nparents ()) + { + std::list obj_parents + = obj.parent_class_name_list (); + std::list pnames = parents (); + + std::list::const_iterator p = obj_parents.begin (); + std::list::const_iterator q = pnames.begin (); + + while (p != obj_parents.end ()) + { + if (*p++ != *q++) + { + retval = false; + error ("mismatch in parent classes"); + break; + } + } + } + else + { + retval = false; + error ("mismatch in number of parent classes"); + } + } + else + { + retval = false; + error ("mismatch in number of fields"); + } + } + else + { + retval = false; + error ("invalid comparison of class exemplar to non-class object"); + } + + return retval; +} + +DEFUN (class, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} class (@var{expr})\n\ +@deftypefnx {Built-in Function} {} class (@var{s}, @var{id})\n\ +@deftypefnx {Built-in Function} {} class (@var{s}, @var{id}, @var{p}, @dots{})\n\ +Return the class of the expression @var{expr} or create a class with\n\ +fields from structure @var{s} and name (string) @var{id}. Additional\n\ +arguments name a list of parent classes from which the new class is\n\ +derived.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + print_usage (); + else if (nargin == 1) + retval = args(0).class_name (); + else + { + octave_function *fcn = octave_call_stack::caller (); + + std::string id = args(1).string_value (); + + if (! error_state) + { + if (fcn) + { + if (fcn->is_class_constructor (id) || fcn->is_class_method (id)) + { + octave_map m = args(0).map_value (); + + if (! error_state) + { + if (nargin == 2) + retval + = octave_value (new octave_class + (m, id, std::list ())); + else + { + octave_value_list parents = args.slice (2, nargin-2); + + retval + = octave_value (new octave_class (m, id, parents)); + } + + if (! error_state) + { + octave_class::exemplar_const_iterator it + = octave_class::exemplar_map.find (id); + + if (it == octave_class::exemplar_map.end ()) + octave_class::exemplar_map[id] + = octave_class::exemplar_info (retval); + else if (! it->second.compare (retval)) + error ("class: object of class `%s' does not match previously constructed objects", + id.c_str ()); + } + } + else + error ("class: expecting structure S as first argument"); + } + else + error ("class: `%s' is invalid as a class name in this context", + id.c_str ()); + } + else + error ("class: invalid call from outside class constructor or method"); + } + else + error ("class: ID (class name) must be a character string"); + } + + return retval; +} + +DEFUN (__isa_parent__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __isa_parent__ (@var{class}, @var{name})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 2) + { + octave_value cls = args(0); + octave_value nm = args(1); + + if (! error_state) + { + if (cls.find_parent_class (nm.string_value ())) + retval = true; + } + else + error ("__isa_parent__: expecting arguments to be character strings"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__parent_classes__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __parent_classes__ (@var{x})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval = Cell (); + + if (args.length () == 1) + { + octave_value arg = args(0); + + if (arg.is_object ()) + retval = Cell (arg.parent_class_names ()); + } + else + print_usage (); + + return retval; +} + +DEFUN (isobject, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isobject (@var{x})\n\ +Return true if @var{x} is a class object.\n\ +@seealso{class, typeinfo, isa, ismethod}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_object (); + else + print_usage (); + + return retval; +} + +DEFUN (ismethod, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ismethod (@var{x}, @var{method})\n\ +Return true if @var{x} is a class object and the string @var{method}\n\ +is a method of this class.\n\ +@seealso{isobject}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + octave_value arg = args(0); + + std::string class_name; + + if (arg.is_object ()) + class_name = arg.class_name (); + else if (arg.is_string ()) + class_name = arg.string_value (); + else + error ("ismethod: expecting object or class name as first argument"); + + if (! error_state) + { + std::string method = args(1).string_value (); + + if (! error_state) + { + if (load_path::find_method (class_name, method) != std::string ()) + retval = true; + else + retval = false; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (methods, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} methods (@var{x})\n\ +@deftypefnx {Built-in Function} {} methods (\"classname\")\n\ +Return a cell array containing the names of the methods for the\n\ +object @var{x} or the named class.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + octave_value arg = args(0); + + std::string class_name; + + if (arg.is_object ()) + class_name = arg.class_name (); + else if (arg.is_string ()) + class_name = arg.string_value (); + else + error ("methods: expecting object or class name as argument"); + + if (! error_state) + { + string_vector sv = load_path::methods (class_name); + + if (nargout == 0) + { + octave_stdout << "Methods for class " << class_name << ":\n\n"; + + sv.list_in_columns (octave_stdout); + + octave_stdout << std::endl; + } + else + retval = Cell (sv); + } + } + else + print_usage (); + + return retval; +} + +static bool +is_built_in_class (const std::string& cn) +{ + static std::set built_in_class_names; + + if (built_in_class_names.empty ()) + { + built_in_class_names.insert ("double"); + built_in_class_names.insert ("single"); + built_in_class_names.insert ("cell"); + built_in_class_names.insert ("struct"); + built_in_class_names.insert ("logical"); + built_in_class_names.insert ("char"); + built_in_class_names.insert ("function handle"); + built_in_class_names.insert ("int8"); + built_in_class_names.insert ("uint8"); + built_in_class_names.insert ("int16"); + built_in_class_names.insert ("uint16"); + built_in_class_names.insert ("int32"); + built_in_class_names.insert ("uint32"); + built_in_class_names.insert ("int64"); + built_in_class_names.insert ("uint64"); + } + + return built_in_class_names.find (cn) != built_in_class_names.end (); +} + +DEFUN (superiorto, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} superiorto (@var{class_name}, @dots{})\n\ +When called from a class constructor, mark the object currently\n\ +constructed as having a higher precedence than @var{class_name}.\n\ +More that one such class can be specified in a single call.\n\ +This function may only be called from a class constructor.\n\ +@end deftypefn") +{ + octave_value retval; + + octave_function *fcn = octave_call_stack::caller (); + + if (fcn && fcn->is_class_constructor ()) + { + for (int i = 0; i < args.length (); i++) + { + std::string class_name = args(i).string_value (); + + if (! error_state) + { + if (! is_built_in_class (class_name)) + { + std::string this_class_name = fcn->name (); + + if (! symbol_table::set_class_relationship (this_class_name, + class_name)) + { + error ("superiorto: precedence already set for %s and %s", + this_class_name.c_str (), class_name.c_str ()); + break; + } + } + else + { + // User defined classes always have higher precedence + // than built-in classes. + } + } + else + { + error ("superiorto: expecting argument to be class name"); + break; + } + } + } + else + error ("superiorto: invalid call from outside class constructor"); + + return retval; +} + +DEFUN (inferiorto, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} inferiorto (@var{class_name}, @dots{})\n\ +When called from a class constructor, mark the object currently\n\ +constructed as having a lower precedence than @var{class_name}.\n\ +More that one such class can be specified in a single call.\n\ +This function may only be called from a class constructor.\n\ +@end deftypefn") +{ + octave_value retval; + + octave_function *fcn = octave_call_stack::caller (); + + if (fcn && fcn->is_class_constructor ()) + { + for (int i = 0; i < args.length (); i++) + { + std::string class_name = args(i).string_value (); + + if (! error_state) + { + if (! is_built_in_class (class_name)) + { + std::string this_class_name = fcn->name (); + + symbol_table::set_class_relationship (class_name, + this_class_name); + + if (! symbol_table::set_class_relationship (this_class_name, + class_name)) + { + error ("inferiorto: precedence already set for %s and %s", + this_class_name.c_str (), class_name.c_str ()); + break; + } + } + else + { + error ("inferiorto: cannot give user-defined class lower precedence than built-in class"); + break; + } + } + else + { + error ("inferiorto: expecting argument to be class name"); + break; + } + } + } + else + error ("inferiorto: invalid call from outside class constructor"); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-class.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-class.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,285 @@ +/* + +Copyright (C) 2007-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_class_h) +#define octave_class_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-alloc.h" +#include "oct-map.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// Data structures. + +class +octave_class : public octave_base_value +{ +public: + + octave_class (void) + : octave_base_value (), map (), c_name (), + parent_list (), obsolete_copies (0) + { } + + octave_class (const octave_map& m, const std::string& id, + const std::list& plist) + : octave_base_value (), map (m), c_name (id), + parent_list (plist), obsolete_copies (0) + { } + + octave_class (const octave_map& m, const std::string& id, + const octave_value_list& parents); + + octave_class (const octave_class& s) + : octave_base_value (s), map (s.map), c_name (s.c_name), + parent_list (s.parent_list), obsolete_copies (0) { } + + ~octave_class (void) { } + + octave_base_value *clone (void) const { return new octave_class (*this); } + + octave_base_value *unique_clone (void); + + octave_base_value *empty_clone (void) const + { + return new octave_class (octave_map (map.keys ()), c_name, parent_list); + } + + Cell dotref (const octave_value_list& idx); + + Matrix size (void); + + octave_idx_type numel (const octave_value_list&); + + octave_value subsref (const std::string& type, + const std::list& idx) + { + octave_value_list tmp = subsref (type, idx, 1); + return tmp.length () > 0 ? tmp(0) : octave_value (); + } + + octave_value_list subsref (const std::string& type, + const std::list& idx, + int nargout); + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& idx) + { + return subsref ("(", std::list (1, idx), nargout); + } + + static octave_value numeric_conv (const Cell& val, + const std::string& type); + + void assign(const std::string& k, const octave_value& rhs) + { map.assign (k, rhs); }; + + octave_value subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + octave_value undef_subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + idx_vector index_vector (void) const; + + dim_vector dims (void) const { return map.dims (); } + + size_t byte_size (void) const; + + // This is the number of elements in each field. The total number + // of elements is numel () * nfields (). + octave_idx_type numel (void) const + { + dim_vector dv = dims (); + return dv.numel (); + } + + octave_idx_type nfields (void) const { return map.nfields (); } + + size_t nparents (void) const { return parent_list.size (); } + + octave_value reshape (const dim_vector& new_dims) const + { + octave_class retval = octave_class (*this); + retval.map = retval.map_value ().reshape (new_dims); + return octave_value (new octave_class (retval)); + } + + octave_value resize (const dim_vector& dv, bool = false) const + { + octave_class retval = octave_class (*this); + retval.map.resize (dv); + return octave_value (new octave_class (retval)); + } + + bool is_defined (void) const { return true; } + + bool is_map (void) const { return false; } + + bool is_object (void) const { return true; } + + octave_map map_value (void) const { return map; } + + string_vector map_keys (void) const; + + std::list parent_class_name_list (void) const + { return parent_list; } + + string_vector parent_class_names (void) const + { return string_vector (parent_list); } + + octave_base_value *find_parent_class (const std::string&); + + octave_base_value *unique_parent_class (const std::string&); + + string_vector all_strings (bool pad) const; + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool print_name_tag (std::ostream& os, const std::string& name) const; + + void print_with_name (std::ostream& os, const std::string& name, + bool print_padding = true); + + bool reconstruct_exemplar (void); + + static void clear_exemplar_map (void); + + bool reconstruct_parents (void); + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + mxArray *as_mxArray (void) const; + +private: + + octave_map map; + + DECLARE_OCTAVE_ALLOCATOR + +public: + int type_id (void) const { return t_id; } + std::string type_name (void) const { return t_name; } + std::string class_name (void) const { return c_name; } + + static int static_type_id (void) { return t_id; } + static std::string static_type_name (void) { return t_name; } + static std::string static_class_name (void) { return ""; } + static void register_type (void); + +private: + static int t_id; + + static const std::string t_name; + std::string c_name; + std::list parent_list; + + bool in_class_method (void); + std::string get_current_method_class (void); + + octave_value subsasgn_common (const octave_value& obj, + const std::string& type, + const std::list& idx, + const octave_value& rhs); + + int obsolete_copies; + +public: + // The list of field names and parent classes defines a class. We + // keep track of each class that has been created so that we know + class exemplar_info + { + public: + + exemplar_info (void) : field_names (), parent_class_names () { } + + exemplar_info (const octave_value& obj); + + exemplar_info (const exemplar_info& x) + : field_names (x.field_names), + parent_class_names (x.parent_class_names) { } + + exemplar_info& operator = (const exemplar_info& x) + { + if (&x != this) + { + field_names = x.field_names; + parent_class_names = x.parent_class_names; + } + return *this; + } + + octave_idx_type nfields (void) const { return field_names.length (); } + + size_t nparents (void) const { return parent_class_names.size (); } + + string_vector fields (void) const { return field_names; } + + std::list parents (void) const { return parent_class_names; } + + bool compare (const octave_value& obj) const; + + private: + + string_vector field_names; + std::list parent_class_names; + }; + + // A map from class names to lists of fields. + static std::map exemplar_map; + + typedef std::map::iterator exemplar_iterator; + typedef std::map::const_iterator exemplar_const_iterator; +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-colon.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-colon.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,48 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "error.h" +#include "pr-output.h" +#include "oct-obj.h" +#include "ov-colon.h" + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_magic_colon, + "magic-colon", "magic-colon"); + +void +octave_magic_colon::print (std::ostream& os, bool) const +{ + indent (os); + print_raw (os); +} + +void +octave_magic_colon::print_raw (std::ostream& os, bool) const +{ + os << ":"; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-colon.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-colon.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,77 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_magic_colon_h) +#define octave_magic_colon_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// A type to represent `:' as used for indexing. + +class +octave_magic_colon : public octave_base_value +{ +public: + + octave_magic_colon (void) + : octave_base_value () { } + + octave_magic_colon (const octave_magic_colon&) + : octave_base_value () { } + + ~octave_magic_colon (void) { } + + octave_base_value *clone (void) const { return new octave_magic_colon (*this); } + octave_base_value *empty_clone (void) const { return new octave_magic_colon (); } + + idx_vector index_vector (void) const { return idx_vector (':'); } + + bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + + bool is_magic_colon (void) const { return true; } + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + +private: + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-complex.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-complex.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,463 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "lo-ieee.h" +#include "lo-specfun.h" +#include "lo-mappers.h" + +#include "oct-obj.h" +#include "oct-stream.h" +#include "ops.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-base.h" +#include "ov-base-scalar.h" +#include "ov-base-scalar.cc" +#include "ov-cx-mat.h" +#include "ov-scalar.h" +#include "gripes.h" +#include "pr-output.h" +#include "ops.h" + +#include "ls-oct-ascii.h" +#include "ls-hdf5.h" + +template class octave_base_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_complex); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_complex, + "complex scalar", "double"); + +static octave_base_value * +default_numeric_demotion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_complex&); + + return new octave_float_complex (v.float_complex_value ()); +} + +octave_base_value::type_conv_info +octave_complex::numeric_demotion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_demotion_function, + octave_float_complex::static_type_id ()); +} + +octave_base_value * +octave_complex::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + double im = std::imag (scalar); + + if (im == 0.0) + retval = new octave_scalar (std::real (scalar)); + + return retval; +} + +octave_value +octave_complex::do_index_op (const octave_value_list& idx, bool resize_ok) +{ + // FIXME -- this doesn't solve the problem of + // + // a = i; a([1,1], [1,1], [1,1]) + // + // and similar constructions. Hmm... + + // FIXME -- using this constructor avoids narrowing the + // 1x1 matrix back to a scalar value. Need a better solution + // to this problem. + + octave_value tmp (new octave_complex_matrix (complex_matrix_value ())); + + return tmp.do_index_op (idx, resize_ok); +} + +double +octave_complex::double_value (bool force_conversion) const +{ + double retval = lo_ieee_nan_value (); + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real scalar"); + + retval = std::real (scalar); + + return retval; +} + +float +octave_complex::float_value (bool force_conversion) const +{ + float retval = lo_ieee_float_nan_value (); + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real scalar"); + + retval = std::real (scalar); + + return retval; +} + +Matrix +octave_complex::matrix_value (bool force_conversion) const +{ + Matrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real matrix"); + + retval = Matrix (1, 1, std::real (scalar)); + + return retval; +} + +FloatMatrix +octave_complex::float_matrix_value (bool force_conversion) const +{ + FloatMatrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real matrix"); + + retval = FloatMatrix (1, 1, std::real (scalar)); + + return retval; +} + +NDArray +octave_complex::array_value (bool force_conversion) const +{ + NDArray retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real matrix"); + + retval = NDArray (dim_vector (1, 1), std::real (scalar)); + + return retval; +} + +FloatNDArray +octave_complex::float_array_value (bool force_conversion) const +{ + FloatNDArray retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real matrix"); + + retval = FloatNDArray (dim_vector (1, 1), std::real (scalar)); + + return retval; +} + +Complex +octave_complex::complex_value (bool) const +{ + return scalar; +} + +FloatComplex +octave_complex::float_complex_value (bool) const +{ + return static_cast (scalar); +} + +ComplexMatrix +octave_complex::complex_matrix_value (bool) const +{ + return ComplexMatrix (1, 1, scalar); +} + +FloatComplexMatrix +octave_complex::float_complex_matrix_value (bool) const +{ + return FloatComplexMatrix (1, 1, static_cast (scalar)); +} + +ComplexNDArray +octave_complex::complex_array_value (bool /* force_conversion */) const +{ + return ComplexNDArray (dim_vector (1, 1), scalar); +} + +FloatComplexNDArray +octave_complex::float_complex_array_value (bool /* force_conversion */) const +{ + return FloatComplexNDArray (dim_vector (1, 1), static_cast (scalar)); +} + +octave_value +octave_complex::resize (const dim_vector& dv, bool fill) const +{ + if (fill) + { + ComplexNDArray retval (dv, Complex (0)); + + if (dv.numel ()) + retval(0) = scalar; + + return retval; + } + else + { + ComplexNDArray retval (dv); + + if (dv.numel ()) + retval(0) = scalar; + + return retval; + } +} + +octave_value +octave_complex::diag (octave_idx_type m, octave_idx_type n) const +{ + return ComplexDiagMatrix (Array (dim_vector (1, 1), scalar), m, n); +} + +bool +octave_complex::save_ascii (std::ostream& os) +{ + Complex c = complex_value (); + + octave_write_complex (os, c); + + os << "\n"; + + return true; +} + +bool +octave_complex::load_ascii (std::istream& is) +{ + scalar = octave_read_value (is); + + if (!is) + { + error ("load: failed to load complex scalar constant"); + return false; + } + + return true; +} + + +bool +octave_complex::save_binary (std::ostream& os, bool& /* save_as_floats */) +{ + char tmp = static_cast (LS_DOUBLE); + os.write (reinterpret_cast (&tmp), 1); + Complex ctmp = complex_value (); + os.write (reinterpret_cast (&ctmp), 16); + + return true; +} + +bool +octave_complex::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + char tmp; + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + + Complex ctmp; + read_doubles (is, reinterpret_cast (&ctmp), + static_cast (tmp), 2, swap, fmt); + if (error_state || ! is) + return false; + + scalar = ctmp; + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_complex::save_hdf5 (hid_t loc_id, const char *name, + bool /* save_as_floats */) +{ + hsize_t dimens[3]; + hid_t space_hid = -1, type_hid = -1, data_hid = -1; + bool retval = true; + + space_hid = H5Screate_simple (0, dimens, 0); + if (space_hid < 0) + return false; + + type_hid = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); + if (type_hid < 0) + { + H5Sclose (space_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + return false; + } + + Complex tmp = complex_value (); + retval = H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, H5P_DEFAULT, + &tmp) >= 0; + + H5Dclose (data_hid); + H5Tclose (type_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_complex::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t type_hid = H5Dget_type (data_hid); + + hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); + + if (! hdf5_types_compatible (type_hid, complex_type)) + { + H5Tclose (complex_type); + H5Dclose (data_hid); + return false; + } + + hid_t space_id = H5Dget_space (data_hid); + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank != 0) + { + H5Tclose (complex_type); + H5Sclose (space_id); + H5Dclose (data_hid); + return false; + } + + // complex scalar: + Complex ctmp; + if (H5Dread (data_hid, complex_type, H5S_ALL, H5S_ALL, H5P_DEFAULT, + &ctmp) >= 0) + { + retval = true; + scalar = ctmp; + } + + H5Tclose (complex_type); + H5Sclose (space_id); + H5Dclose (data_hid); + + return retval; +} + +#endif + +mxArray * +octave_complex::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxDOUBLE_CLASS, 1, 1, mxCOMPLEX); + + double *pr = static_cast (retval->get_data ()); + double *pi = static_cast (retval->get_imag_data ()); + + pr[0] = std::real (scalar); + pi[0] = std::imag (scalar); + + return retval; +} + +octave_value +octave_complex::map (unary_mapper_t umap) const +{ + switch (umap) + { +#define SCALAR_MAPPER(UMAP, FCN) \ + case umap_ ## UMAP: \ + return octave_value (FCN (scalar)) + + SCALAR_MAPPER (abs, std::abs); + SCALAR_MAPPER (acos, ::acos); + SCALAR_MAPPER (acosh, ::acosh); + SCALAR_MAPPER (angle, std::arg); + SCALAR_MAPPER (arg, std::arg); + SCALAR_MAPPER (asin, ::asin); + SCALAR_MAPPER (asinh, ::asinh); + SCALAR_MAPPER (atan, ::atan); + SCALAR_MAPPER (atanh, ::atanh); + SCALAR_MAPPER (ceil, ::ceil); + SCALAR_MAPPER (conj, std::conj); + SCALAR_MAPPER (cos, std::cos); + SCALAR_MAPPER (cosh, std::cosh); + SCALAR_MAPPER (exp, std::exp); + SCALAR_MAPPER (expm1, ::expm1); + SCALAR_MAPPER (fix, ::fix); + SCALAR_MAPPER (floor, ::floor); + SCALAR_MAPPER (imag, std::imag); + SCALAR_MAPPER (log, std::log); + SCALAR_MAPPER (log2, xlog2); + SCALAR_MAPPER (log10, std::log10); + SCALAR_MAPPER (log1p, ::log1p); + SCALAR_MAPPER (real, std::real); + SCALAR_MAPPER (round, xround); + SCALAR_MAPPER (roundb, xroundb); + SCALAR_MAPPER (signum, ::signum); + SCALAR_MAPPER (sin, std::sin); + SCALAR_MAPPER (sinh, std::sinh); + SCALAR_MAPPER (sqrt, std::sqrt); + SCALAR_MAPPER (tan, std::tan); + SCALAR_MAPPER (tanh, std::tanh); + SCALAR_MAPPER (finite, xfinite); + SCALAR_MAPPER (isinf, xisinf); + SCALAR_MAPPER (isna, octave_is_NA); + SCALAR_MAPPER (isnan, xisnan); + + default: + return octave_base_value::map (umap); + } +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-complex.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-complex.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,209 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_complex_h) +#define octave_complex_h 1 + +#include + +#include +#include + +#include "lo-ieee.h" +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "gripes.h" +#include "error.h" +#include "ov-base.h" +#include "ov-cx-mat.h" +#include "ov-base-scalar.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// Complex scalar values. + +class +OCTINTERP_API +octave_complex : public octave_base_scalar +{ +public: + + octave_complex (void) + : octave_base_scalar () { } + + octave_complex (const Complex& c) + : octave_base_scalar (c) { } + + octave_complex (const octave_complex& c) + : octave_base_scalar (c) { } + + ~octave_complex (void) { } + + octave_base_value *clone (void) const { return new octave_complex (*this); } + + // We return an octave_complex_matrix object here instead of an + // octave_complex object so that in expressions like A(2,2,2) = 2 + // (for A previously undefined), A will be empty instead of a 1x1 + // object. + octave_base_value *empty_clone (void) const + { return new octave_complex_matrix (); } + + type_conv_info numeric_demotion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + // Use this to give a more specific error message + idx_vector index_vector (void) const + { + error ( + "attempted to use a complex scalar as an index\n" + " (forgot to initialize i or j?)"); + return idx_vector (); + } + + octave_value any (int = 0) const + { + return (scalar != Complex (0, 0) + && ! (lo_ieee_isnan (std::real (scalar)) + || lo_ieee_isnan (std::imag (scalar)))); + } + + builtin_type_t builtin_type (void) const { return btyp_complex; } + + bool is_complex_scalar (void) const { return true; } + + bool is_complex_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + double double_value (bool = false) const; + + float float_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + float float_scalar_value (bool frc_str_conv = false) const + { return float_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const; + + FloatMatrix float_matrix_value (bool = false) const; + + NDArray array_value (bool = false) const; + + FloatNDArray float_array_value (bool = false) const; + + SparseMatrix sparse_matrix_value (bool = false) const + { return SparseMatrix (matrix_value ()); } + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const + { return SparseComplexMatrix (complex_matrix_value ()); } + + octave_value resize (const dim_vector& dv, bool fill = false) const; + + Complex complex_value (bool = false) const; + + FloatComplex float_complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + FloatComplexMatrix float_complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const; + + FloatComplexNDArray float_complex_array_value (bool = false) const; + + bool bool_value (bool warn = false) const + { + if (xisnan (scalar)) + gripe_nan_to_logical_conversion (); + else if (warn && scalar != 0.0 && scalar != 1.0) + gripe_logical_conversion (); + + return scalar != 0.0; + } + + boolNDArray bool_array_value (bool warn = false) const + { + if (xisnan (scalar)) + gripe_nan_to_logical_conversion (); + else if (warn && scalar != 0.0 && scalar != 1.0) + gripe_logical_conversion (); + + return boolNDArray (dim_vector (1, 1), scalar != 0.0); + } + + octave_value diag (octave_idx_type m, octave_idx_type n) const; + + void increment (void) { scalar += 1.0; } + + void decrement (void) { scalar -= 1.0; } + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { + // Yes, for compatibility, we drop the imaginary part here. + return os.write (array_value (true), block_size, output_type, + skip, flt_fmt); + } + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const; + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +typedef octave_complex octave_complex_scalar; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-cs-list.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-cs-list.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,62 @@ +/* + +Copyright (C) 2002-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "lo-utils.h" + +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "ov-cs-list.h" +#include "unwind-prot.h" + +DEFINE_OCTAVE_ALLOCATOR (octave_cs_list); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_cs_list, "cs-list", "cs-list"); + +octave_cs_list::octave_cs_list (const Cell& c) + : octave_base_value (), lst (c) +{ +} + +octave_value +octave_cs_list::subsref (const std::string&, + const std::list&) +{ + gripe_indexed_cs_list (); + return octave_value (); +} + +octave_value_list +octave_cs_list::subsref (const std::string&, + const std::list&, int) +{ + gripe_indexed_cs_list (); + return octave_value_list (); +} + diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-cs-list.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-cs-list.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,91 @@ +/* + +Copyright (C) 2002-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_cs_list_h) +#define octave_cs_list_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "str-vec.h" + +#include "Cell.h" +#include "error.h" +#include "oct-alloc.h" +#include "oct-obj.h" +#include "ov-typeinfo.h" + +class tree_walker; + +// Lists. + +class +octave_cs_list : public octave_base_value +{ +public: + + octave_cs_list (void) + : octave_base_value (), lst () { } + + octave_cs_list (const octave_value_list& l) + : octave_base_value (), lst (l) { } + + octave_cs_list (const Cell& c); + + octave_cs_list (const octave_cs_list& l) + : octave_base_value (), lst (l.lst) { } + + ~octave_cs_list (void) { } + + octave_base_value *clone (void) const { return new octave_cs_list (*this); } + octave_base_value *empty_clone (void) const { return new octave_cs_list (); } + + dim_vector dims (void) const { return dim_vector (1, lst.length ()); } + + bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + + bool is_cs_list (void) const { return true; } + + octave_value_list list_value (void) const { return lst; } + + octave_value subsref (const std::string& type, + const std::list& idx); + + octave_value_list subsref (const std::string& type, + const std::list& idx, int); + +private: + + // The list of Octave values. + octave_value_list lst; + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-cx-diag.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-cx-diag.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,238 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "byte-swap.h" + +#include "ov-cx-diag.h" +#include "ov-flt-cx-diag.h" +#include "ov-re-diag.h" +#include "ov-base-diag.cc" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ls-utils.h" + +template class octave_base_diag; + +DEFINE_OCTAVE_ALLOCATOR (octave_complex_diag_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_complex_diag_matrix, + "complex diagonal matrix", "double"); + +static octave_base_value * +default_numeric_conversion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_complex_diag_matrix&); + + return new octave_complex_matrix (v.complex_matrix_value ()); +} + +octave_base_value::type_conv_info +octave_complex_diag_matrix::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_conversion_function, + octave_complex_matrix::static_type_id ()); +} + +static octave_base_value * +default_numeric_demotion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_complex_diag_matrix&); + + return new octave_float_complex_diag_matrix (v.float_complex_diag_matrix_value ()); +} + +octave_base_value::type_conv_info +octave_complex_diag_matrix::numeric_demotion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_demotion_function, + octave_float_complex_diag_matrix::static_type_id ()); +} + +octave_base_value * +octave_complex_diag_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (matrix.nelem () == 1) + { + retval = new octave_complex (matrix (0, 0)); + octave_base_value *rv2 = retval->try_narrowing_conversion (); + if (rv2) + { + delete retval; + retval = rv2; + } + } + else if (matrix.all_elements_are_real ()) + { + return new octave_diag_matrix (::real (matrix)); + } + + return retval; +} + +DiagMatrix +octave_complex_diag_matrix::diag_matrix_value (bool force_conversion) const +{ + DiagMatrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + type_name (), "real matrix"); + + retval = ::real (matrix); + + return retval; +} + +FloatDiagMatrix +octave_complex_diag_matrix::float_diag_matrix_value (bool force_conversion) const +{ + DiagMatrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + type_name (), "real matrix"); + + retval = ::real (matrix); + + return retval; +} + +ComplexDiagMatrix +octave_complex_diag_matrix::complex_diag_matrix_value (bool) const +{ + return matrix; +} + +FloatComplexDiagMatrix +octave_complex_diag_matrix::float_complex_diag_matrix_value (bool) const +{ + return FloatComplexDiagMatrix (matrix); +} + +octave_value +octave_complex_diag_matrix::map (unary_mapper_t umap) const +{ + switch (umap) + { + case umap_abs: + return matrix.abs (); + case umap_real: + return ::real (matrix); + case umap_conj: + return ::conj (matrix); + case umap_imag: + return ::imag (matrix); + case umap_sqrt: + { + ComplexColumnVector tmp = matrix.diag ().map (std::sqrt); + ComplexDiagMatrix retval (tmp); + retval.resize (matrix.rows (), matrix.columns ()); + return retval; + } + default: + return to_dense ().map (umap); + } +} + +bool +octave_complex_diag_matrix::save_binary (std::ostream& os, bool& save_as_floats) +{ + + int32_t r = matrix.rows (), c = matrix.cols (); + os.write (reinterpret_cast (&r), 4); + os.write (reinterpret_cast (&c), 4); + + ComplexMatrix m = ComplexMatrix (matrix.diag ()); + save_type st = LS_DOUBLE; + if (save_as_floats) + { + if (m.too_large_for_float ()) + { + warning ("save: some values too large to save as floats --"); + warning ("save: saving as doubles instead"); + } + else + st = LS_FLOAT; + } + else if (matrix.length () > 4096) // FIXME -- make this configurable. + { + double max_val, min_val; + if (m.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + } + + const Complex *mtmp = m.data (); + write_doubles (os, reinterpret_cast (mtmp), st, 2 * m.numel ()); + + return true; +} + +bool +octave_complex_diag_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + int32_t r, c; + char tmp; + if (! (is.read (reinterpret_cast (&r), 4) + && is.read (reinterpret_cast (&c), 4) + && is.read (reinterpret_cast (&tmp), 1))) + return false; + if (swap) + { + swap_bytes<4> (&r); + swap_bytes<4> (&c); + } + + ComplexDiagMatrix m (r, c); + Complex *im = m.fortran_vec (); + octave_idx_type len = m.length (); + read_doubles (is, reinterpret_cast (im), + static_cast (tmp), 2 * len, swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + + return true; +} + +bool +octave_complex_diag_matrix::chk_valid_scalar (const octave_value& val, + Complex& x) const +{ + bool retval = val.is_complex_scalar () || val.is_real_scalar (); + if (retval) + x = val.complex_value (); + return retval; +} + +/* + +%% bug #36368 +%!assert (diag ([1+i, 1-i])^2 , diag ([2i, -2i]), 4*eps); + +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-cx-diag.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-cx-diag.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,95 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_complex_diag_matrix_h) +#define octave_complex_diag_matrix_h 1 + +#include "ov-base.h" +#include "ov-base-diag.h" +#include "ov-cx-mat.h" +#include "ov-typeinfo.h" + +// Real diagonal matrix values. + +class +OCTINTERP_API +octave_complex_diag_matrix + : public octave_base_diag +{ +public: + + octave_complex_diag_matrix (void) + : octave_base_diag () { } + + octave_complex_diag_matrix (const ComplexDiagMatrix& m) + : octave_base_diag (m) { } + + octave_complex_diag_matrix (const octave_complex_diag_matrix& m) + : octave_base_diag (m) { } + + ~octave_complex_diag_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_complex_diag_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_complex_diag_matrix (); } + + type_conv_info numeric_conversion_function (void) const; + + type_conv_info numeric_demotion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + builtin_type_t builtin_type (void) const { return btyp_complex; } + + bool is_complex_matrix (void) const { return true; } + + bool is_complex_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + DiagMatrix diag_matrix_value (bool = false) const; + + FloatDiagMatrix float_diag_matrix_value (bool = false) const; + + ComplexDiagMatrix complex_diag_matrix_value (bool = false) const; + + FloatComplexDiagMatrix float_complex_diag_matrix_value (bool = false) const; + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + + octave_value map (unary_mapper_t umap) const; + +private: + + bool chk_valid_scalar (const octave_value&, + Complex&) const; + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-cx-mat.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-cx-mat.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,803 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "data-conv.h" +#include "lo-ieee.h" +#include "lo-specfun.h" +#include "lo-mappers.h" +#include "mx-base.h" +#include "mach-info.h" +#include "oct-locbuf.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "oct-stream.h" +#include "ops.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-base-mat.cc" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-re-mat.h" +#include "ov-scalar.h" +#include "pr-output.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-hdf5.h" +#include "ls-utils.h" + +template class octave_base_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_complex_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_complex_matrix, + "complex matrix", "double"); + +static octave_base_value * +default_numeric_demotion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_complex_matrix&); + + return new octave_float_complex_matrix (v.float_complex_matrix_value ()); +} + +octave_base_value::type_conv_info +octave_complex_matrix::numeric_demotion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_demotion_function, + octave_float_complex_matrix::static_type_id ()); +} + +octave_base_value * +octave_complex_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (matrix.numel () == 1) + { + Complex c = matrix (0); + + if (std::imag (c) == 0.0) + retval = new octave_scalar (std::real (c)); + else + retval = new octave_complex (c); + } + else if (matrix.all_elements_are_real ()) + retval = new octave_matrix (::real (matrix)); + + return retval; +} + +double +octave_complex_matrix::double_value (bool force_conversion) const +{ + double retval = lo_ieee_nan_value (); + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real scalar"); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "complex matrix", "real scalar"); + + retval = std::real (matrix (0, 0)); + } + else + gripe_invalid_conversion ("complex matrix", "real scalar"); + + return retval; +} + +float +octave_complex_matrix::float_value (bool force_conversion) const +{ + float retval = lo_ieee_float_nan_value (); + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real scalar"); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "complex matrix", "real scalar"); + + retval = std::real (matrix (0, 0)); + } + else + gripe_invalid_conversion ("complex matrix", "real scalar"); + + return retval; +} + +Matrix +octave_complex_matrix::matrix_value (bool force_conversion) const +{ + Matrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real matrix"); + + retval = ::real (matrix.matrix_value ()); + + return retval; +} + +FloatMatrix +octave_complex_matrix::float_matrix_value (bool force_conversion) const +{ + FloatMatrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real matrix"); + + retval = ::real (matrix.matrix_value ()); + + return retval; +} + +Complex +octave_complex_matrix::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "complex matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("complex matrix", "complex scalar"); + + return retval; +} + +FloatComplex +octave_complex_matrix::float_complex_value (bool) const +{ + float tmp = lo_ieee_float_nan_value (); + + FloatComplex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "complex matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("complex matrix", "complex scalar"); + + return retval; +} + +ComplexMatrix +octave_complex_matrix::complex_matrix_value (bool) const +{ + return matrix.matrix_value (); +} + +FloatComplexMatrix +octave_complex_matrix::float_complex_matrix_value (bool) const +{ + return FloatComplexMatrix (matrix.matrix_value ()); +} + +boolNDArray +octave_complex_matrix::bool_array_value (bool warn) const +{ + if (matrix.any_element_is_nan ()) + gripe_nan_to_logical_conversion (); + else if (warn && (! matrix.all_elements_are_real () + || real (matrix).any_element_not_one_or_zero ())) + gripe_logical_conversion (); + + return mx_el_ne (matrix, Complex (0.0)); +} + +charNDArray +octave_complex_matrix::char_array_value (bool frc_str_conv) const +{ + charNDArray retval; + + if (! frc_str_conv) + gripe_implicit_conversion ("Octave:num-to-str", + "complex matrix", "string"); + else + { + retval = charNDArray (dims ()); + octave_idx_type nel = numel (); + + for (octave_idx_type i = 0; i < nel; i++) + retval.elem (i) = static_cast(std::real (matrix.elem (i))); + } + + return retval; +} + +FloatComplexNDArray +octave_complex_matrix::float_complex_array_value (bool) const +{ + return FloatComplexNDArray (matrix); +} + +SparseMatrix +octave_complex_matrix::sparse_matrix_value (bool force_conversion) const +{ + SparseMatrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real matrix"); + + retval = SparseMatrix (::real (matrix.matrix_value ())); + + return retval; +} + +SparseComplexMatrix +octave_complex_matrix::sparse_complex_matrix_value (bool) const +{ + return SparseComplexMatrix (matrix.matrix_value ()); +} + +octave_value +octave_complex_matrix::diag (octave_idx_type k) const +{ + octave_value retval; + if (k == 0 && matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + retval = ComplexDiagMatrix (DiagArray2 (matrix)); + else + retval = octave_base_matrix::diag (k); + + return retval; +} + +octave_value +octave_complex_matrix::diag (octave_idx_type m, octave_idx_type n) const +{ + octave_value retval; + + if (matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + { + ComplexMatrix mat = matrix.matrix_value (); + + retval = mat.diag (m, n); + } + else + error ("diag: expecting vector argument"); + + return retval; +} + +bool +octave_complex_matrix::save_ascii (std::ostream& os) +{ + dim_vector d = dims (); + if (d.length () > 2) + { + ComplexNDArray tmp = complex_array_value (); + + os << "# ndims: " << d.length () << "\n"; + + for (int i = 0; i < d.length (); i++) + os << " " << d (i); + + os << "\n" << tmp; + } + else + { + // Keep this case, rather than use generic code above for backward + // compatiability. Makes load_ascii much more complex!! + os << "# rows: " << rows () << "\n" + << "# columns: " << columns () << "\n"; + + os << complex_matrix_value (); + } + + return true; +} + +bool +octave_complex_matrix::load_ascii (std::istream& is) +{ + bool success = true; + + string_vector keywords(2); + + keywords[0] = "ndims"; + keywords[1] = "rows"; + + std::string kw; + octave_idx_type val = 0; + + if (extract_keyword (is, keywords, kw, val, true)) + { + if (kw == "ndims") + { + int mdims = static_cast (val); + + if (mdims >= 0) + { + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + is >> dv(i); + + if (is) + { + ComplexNDArray tmp(dv); + + is >> tmp; + + if (is) + matrix = tmp; + else + { + error ("load: failed to load matrix constant"); + success = false; + } + } + else + { + error ("load: failed to read dimensions"); + success = false; + } + } + else + { + error ("load: failed to extract number of dimensions"); + success = false; + } + } + else if (kw == "rows") + { + octave_idx_type nr = val; + octave_idx_type nc = 0; + + if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) + { + if (nr > 0 && nc > 0) + { + ComplexMatrix tmp (nr, nc); + is >> tmp; + if (is) + matrix = tmp; + else + { + error ("load: failed to load matrix constant"); + success = false; + } + } + else if (nr == 0 || nc == 0) + matrix = ComplexMatrix (nr, nc); + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + } + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + + return success; +} + +bool +octave_complex_matrix::save_binary (std::ostream& os, bool& save_as_floats) +{ + dim_vector d = dims (); + if (d.length () < 1) + return false; + + // Use negative value for ndims to differentiate with old format!! + int32_t tmp = - d.length (); + os.write (reinterpret_cast (&tmp), 4); + for (int i = 0; i < d.length (); i++) + { + tmp = d(i); + os.write (reinterpret_cast (&tmp), 4); + } + + ComplexNDArray m = complex_array_value (); + save_type st = LS_DOUBLE; + if (save_as_floats) + { + if (m.too_large_for_float ()) + { + warning ("save: some values too large to save as floats --"); + warning ("save: saving as doubles instead"); + } + else + st = LS_FLOAT; + } + else if (d.numel () > 4096) // FIXME -- make this configurable. + { + double max_val, min_val; + if (m.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + } + + + const Complex *mtmp = m.data (); + write_doubles (os, reinterpret_cast (mtmp), st, 2 * d.numel ()); + + return true; +} + +bool +octave_complex_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + char tmp; + int32_t mdims; + if (! is.read (reinterpret_cast (&mdims), 4)) + return false; + if (swap) + swap_bytes<4> (&mdims); + if (mdims < 0) + { + mdims = - mdims; + int32_t di; + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + { + if (! is.read (reinterpret_cast (&di), 4)) + return false; + if (swap) + swap_bytes<4> (&di); + dv(i) = di; + } + + // Convert an array with a single dimension to be a row vector. + // Octave should never write files like this, other software + // might. + + if (mdims == 1) + { + mdims = 2; + dv.resize (mdims); + dv(1) = dv(0); + dv(0) = 1; + } + + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + + ComplexNDArray m(dv); + Complex *im = m.fortran_vec (); + read_doubles (is, reinterpret_cast (im), + static_cast (tmp), 2 * dv.numel (), swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + } + else + { + int32_t nr, nc; + nr = mdims; + if (! is.read (reinterpret_cast (&nc), 4)) + return false; + if (swap) + swap_bytes<4> (&nc); + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + ComplexMatrix m (nr, nc); + Complex *im = m.fortran_vec (); + octave_idx_type len = nr * nc; + read_doubles (is, reinterpret_cast (im), + static_cast (tmp), 2*len, swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + } + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_complex_matrix::save_hdf5 (hid_t loc_id, const char *name, + bool save_as_floats) +{ + dim_vector dv = dims (); + int empty = save_hdf5_empty (loc_id, name, dv); + if (empty) + return (empty > 0); + + int rank = dv.length (); + hid_t space_hid = -1, data_hid = -1, type_hid = -1; + bool retval = true; + ComplexNDArray m = complex_array_value (); + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + + // Octave uses column-major, while HDF5 uses row-major ordering + for (int i = 0; i < rank; i++) + hdims[i] = dv (rank-i-1); + + space_hid = H5Screate_simple (rank, hdims, 0); + if (space_hid < 0) return false; + + hid_t save_type_hid = H5T_NATIVE_DOUBLE; + + if (save_as_floats) + { + if (m.too_large_for_float ()) + { + warning ("save: some values too large to save as floats --"); + warning ("save: saving as doubles instead"); + } + else + save_type_hid = H5T_NATIVE_FLOAT; + } +#if HAVE_HDF5_INT2FLOAT_CONVERSIONS + // hdf5 currently doesn't support float/integer conversions + else + { + double max_val, min_val; + + if (m.all_integers (max_val, min_val)) + save_type_hid + = save_type_to_hdf5 (get_save_type (max_val, min_val)); + } +#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ + + type_hid = hdf5_make_complex_type (save_type_hid); + if (type_hid < 0) + { + H5Sclose (space_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + return false; + } + + hid_t complex_type_hid = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); + if (complex_type_hid < 0) retval = false; + + if (retval) + { + Complex *mtmp = m.fortran_vec (); + if (H5Dwrite (data_hid, complex_type_hid, H5S_ALL, H5S_ALL, H5P_DEFAULT, + mtmp) < 0) + { + H5Tclose (complex_type_hid); + retval = false; + } + } + + H5Tclose (complex_type_hid); + H5Dclose (data_hid); + H5Tclose (type_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_complex_matrix::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; + + dim_vector dv; + int empty = load_hdf5_empty (loc_id, name, dv); + if (empty > 0) + matrix.resize (dv); + if (empty) + return (empty > 0); + +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t type_hid = H5Dget_type (data_hid); + + hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); + + if (! hdf5_types_compatible (type_hid, complex_type)) + { + H5Tclose (complex_type); + H5Dclose (data_hid); + return false; + } + + hid_t space_id = H5Dget_space (data_hid); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank < 1) + { + H5Tclose (complex_type); + H5Sclose (space_id); + H5Dclose (data_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_id, hdims, maxdims); + + // Octave uses column-major, while HDF5 uses row-major ordering + if (rank == 1) + { + dv.resize (2); + dv(0) = 1; + dv(1) = hdims[0]; + } + else + { + dv.resize (rank); + for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) + dv(j) = hdims[i]; + } + + ComplexNDArray m (dv); + Complex *reim = m.fortran_vec (); + if (H5Dread (data_hid, complex_type, H5S_ALL, H5S_ALL, H5P_DEFAULT, + reim) >= 0) + { + retval = true; + matrix = m; + } + + H5Tclose (complex_type); + H5Sclose (space_id); + H5Dclose (data_hid); + + return retval; +} + +#endif + +void +octave_complex_matrix::print_raw (std::ostream& os, + bool pr_as_read_syntax) const +{ + octave_print_internal (os, matrix, pr_as_read_syntax, + current_print_indent_level ()); +} + +mxArray * +octave_complex_matrix::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxDOUBLE_CLASS, dims (), mxCOMPLEX); + + double *pr = static_cast (retval->get_data ()); + double *pi = static_cast (retval->get_imag_data ()); + + mwSize nel = numel (); + + const Complex *p = matrix.data (); + + for (mwIndex i = 0; i < nel; i++) + { + pr[i] = std::real (p[i]); + pi[i] = std::imag (p[i]); + } + + return retval; +} + +octave_value +octave_complex_matrix::map (unary_mapper_t umap) const +{ + switch (umap) + { + // Mappers handled specially. + case umap_real: + return ::real (matrix); + case umap_imag: + return ::imag (matrix); + case umap_conj: + return ::conj (matrix); + +#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.FCN ()) + + ARRAY_METHOD_MAPPER (abs, abs); + ARRAY_METHOD_MAPPER (isnan, isnan); + ARRAY_METHOD_MAPPER (isinf, isinf); + ARRAY_METHOD_MAPPER (finite, isfinite); + +#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.map (FCN)) + + ARRAY_MAPPER (acos, Complex, ::acos); + ARRAY_MAPPER (acosh, Complex, ::acosh); + ARRAY_MAPPER (angle, double, std::arg); + ARRAY_MAPPER (arg, double, std::arg); + ARRAY_MAPPER (asin, Complex, ::asin); + ARRAY_MAPPER (asinh, Complex, ::asinh); + ARRAY_MAPPER (atan, Complex, ::atan); + ARRAY_MAPPER (atanh, Complex, ::atanh); + ARRAY_MAPPER (ceil, Complex, ::ceil); + ARRAY_MAPPER (cos, Complex, std::cos); + ARRAY_MAPPER (cosh, Complex, std::cosh); + ARRAY_MAPPER (exp, Complex, std::exp); + ARRAY_MAPPER (expm1, Complex, ::expm1); + ARRAY_MAPPER (fix, Complex, ::fix); + ARRAY_MAPPER (floor, Complex, ::floor); + ARRAY_MAPPER (log, Complex, std::log); + ARRAY_MAPPER (log2, Complex, xlog2); + ARRAY_MAPPER (log10, Complex, std::log10); + ARRAY_MAPPER (log1p, Complex, ::log1p); + ARRAY_MAPPER (round, Complex, xround); + ARRAY_MAPPER (roundb, Complex, xroundb); + ARRAY_MAPPER (signum, Complex, ::signum); + ARRAY_MAPPER (sin, Complex, std::sin); + ARRAY_MAPPER (sinh, Complex, std::sinh); + ARRAY_MAPPER (sqrt, Complex, std::sqrt); + ARRAY_MAPPER (tan, Complex, std::tan); + ARRAY_MAPPER (tanh, Complex, std::tanh); + ARRAY_MAPPER (isna, bool, octave_is_NA); + + default: + return octave_base_value::map (umap); + } +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-cx-mat.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-cx-mat.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,183 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_complex_matrix_h) +#define octave_complex_matrix_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-stream.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-typeinfo.h" + +#include "MatrixType.h" + +class octave_value_list; + +class tree_walker; + +// Complex matrix values. + +class +OCTINTERP_API +octave_complex_matrix : public octave_base_matrix +{ +public: + + octave_complex_matrix (void) + : octave_base_matrix () { } + + octave_complex_matrix (const ComplexNDArray& m) + : octave_base_matrix (m) { } + + octave_complex_matrix (const ComplexMatrix& m) + : octave_base_matrix (m) { } + + octave_complex_matrix (const ComplexMatrix& m, const MatrixType& t) + : octave_base_matrix (m, t) { } + + octave_complex_matrix (const Array& m) + : octave_base_matrix (ComplexNDArray (m)) { } + + octave_complex_matrix (const ComplexDiagMatrix& d) + : octave_base_matrix (ComplexMatrix (d)) { } + + octave_complex_matrix (const ComplexRowVector& v) + : octave_base_matrix (ComplexMatrix (v)) { } + + octave_complex_matrix (const ComplexColumnVector& v) + : octave_base_matrix (ComplexMatrix (v)) { } + + octave_complex_matrix (const octave_complex_matrix& cm) + : octave_base_matrix (cm) { } + + ~octave_complex_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_complex_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_complex_matrix (); } + + type_conv_info numeric_demotion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + builtin_type_t builtin_type (void) const { return btyp_complex; } + + bool is_complex_matrix (void) const { return true; } + + bool is_complex_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + double double_value (bool = false) const; + + float float_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + float float_scalar_value (bool frc_str_conv = false) const + { return float_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const; + + FloatMatrix float_matrix_value (bool = false) const; + + Complex complex_value (bool = false) const; + + FloatComplex float_complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + FloatComplexMatrix float_complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const { return matrix; } + + FloatComplexNDArray float_complex_array_value (bool = false) const; + + boolNDArray bool_array_value (bool warn = false) const; + + charNDArray char_array_value (bool frc_str_conv = false) const; + + SparseMatrix sparse_matrix_value (bool = false) const; + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; + + octave_value diag (octave_idx_type k = 0) const; + + octave_value diag (octave_idx_type m, octave_idx_type n) const; + + void increment (void) { matrix += Complex (1.0); } + + void decrement (void) { matrix -= Complex (1.0); } + + void changesign (void) { matrix.changesign (); } + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { + // Yes, for compatibility, we drop the imaginary part here. + return os.write (matrix_value (true), block_size, output_type, + skip, flt_fmt); + } + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const; + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-cx-sparse.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-cx-sparse.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,934 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "lo-specfun.h" +#include "lo-mappers.h" +#include "oct-locbuf.h" + +#include "ov-base.h" +#include "ov-scalar.h" +#include "ov-complex.h" +#include "gripes.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +#include "ov-base-sparse.h" +#include "ov-base-sparse.cc" + +#include "ov-bool-sparse.h" + +template class OCTINTERP_API octave_base_sparse; + +DEFINE_OCTAVE_ALLOCATOR (octave_sparse_complex_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_sparse_complex_matrix, "sparse complex matrix", "double"); + +octave_base_value * +octave_sparse_complex_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (Vsparse_auto_mutate) + { + int nr = matrix.rows (); + int nc = matrix.cols (); + + // Don't use numel, since it can overflow for very large matrices + // Note that for the tests on matrix size, they become approximative + // since they involves a cast to double to avoid issues of overflow + if (matrix.rows () == 1 && matrix.cols () == 1) + { + // Const copy of the matrix, so the right version of () operator used + const SparseComplexMatrix tmp (matrix); + + Complex c = tmp (0, 0); + + if (std::imag (c) == 0.0) + retval = new octave_scalar (std::real (c)); + else + retval = new octave_complex (c); + } + else if (nr == 0 || nc == 0) + retval = new octave_matrix (Matrix (nr, nc)); + else if (matrix.all_elements_are_real ()) + if (matrix.cols () > 0 && matrix.rows () > 0 + && (double (matrix.byte_size ()) > double (matrix.rows ()) + * double (matrix.cols ()) * sizeof (double))) + retval = new octave_matrix (::real (matrix.matrix_value ())); + else + retval = new octave_sparse_matrix (::real (matrix)); + else if (matrix.cols () > 0 && matrix.rows () > 0 + && (double (matrix.byte_size ()) > double (matrix.rows ()) + * double (matrix.cols ()) * sizeof (Complex))) + retval = new octave_complex_matrix (matrix.matrix_value ()); + } + else + { + if (matrix.all_elements_are_real ()) + retval = new octave_sparse_matrix (::real (matrix)); + } + + return retval; +} + +double +octave_sparse_complex_matrix::double_value (bool force_conversion) const +{ + double retval = lo_ieee_nan_value (); + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex sparse matrix", "real scalar"); + + // FIXME -- maybe this should be a function, valid_as_scalar() + if (numel () > 0) + { + if (numel () > 1) + gripe_implicit_conversion ("Octave:array-to-scalar", + "complex sparse matrix", "real scalar"); + + retval = std::real (matrix (0, 0)); + } + else + gripe_invalid_conversion ("complex sparse matrix", "real scalar"); + + return retval; +} + +Matrix +octave_sparse_complex_matrix::matrix_value (bool force_conversion) const +{ + Matrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex sparse matrix", "real matrix"); + + retval = ::real (matrix.matrix_value ()); + + return retval; +} + +Complex +octave_sparse_complex_matrix::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + // FIXME -- maybe this should be a function, valid_as_scalar() + if (numel () > 0) + { + if (numel () > 1) + gripe_implicit_conversion ("Octave:array-to-scalar", + "complex sparse matrix", "real scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("complex sparse matrix", "real scalar"); + + return retval; +} + +ComplexMatrix +octave_sparse_complex_matrix::complex_matrix_value (bool) const +{ + return matrix.matrix_value (); +} + +ComplexNDArray +octave_sparse_complex_matrix::complex_array_value (bool) const +{ + return ComplexNDArray (matrix.matrix_value ()); +} + +charNDArray +octave_sparse_complex_matrix::char_array_value (bool frc_str_conv) const +{ + charNDArray retval; + + if (! frc_str_conv) + gripe_implicit_conversion ("Octave:num-to-str", + "sparse complex matrix", "string"); + else + { + retval = charNDArray (dims (), 0); + octave_idx_type nc = matrix.cols (); + octave_idx_type nr = matrix.rows (); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = matrix.cidx (j); i < matrix.cidx (j+1); i++) + retval(matrix.ridx (i) + nr * j) = + static_cast(std::real (matrix.data (i))); + } + + return retval; +} + +SparseMatrix +octave_sparse_complex_matrix::sparse_matrix_value (bool force_conversion) const +{ + SparseMatrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex sparse matrix", + "real sparse matrix"); + + retval = ::real (matrix); + + return retval; +} + +SparseBoolMatrix +octave_sparse_complex_matrix::sparse_bool_matrix_value (bool warn) const +{ + if (matrix.any_element_is_nan ()) + gripe_nan_to_logical_conversion (); + else if (warn && (! matrix.all_elements_are_real () + || real (matrix).any_element_not_one_or_zero ())) + gripe_logical_conversion (); + + return mx_el_ne (matrix, Complex (0.0)); +} + +bool +octave_sparse_complex_matrix::save_binary (std::ostream& os, + bool&save_as_floats) +{ + dim_vector d = this->dims (); + if (d.length () < 1) + return false; + + // Ensure that additional memory is deallocated + matrix.maybe_compress (); + + int nr = d(0); + int nc = d(1); + int nz = nnz (); + + int32_t itmp; + // Use negative value for ndims to be consistent with other formats + itmp= -2; + os.write (reinterpret_cast (&itmp), 4); + + itmp= nr; + os.write (reinterpret_cast (&itmp), 4); + + itmp= nc; + os.write (reinterpret_cast (&itmp), 4); + + itmp= nz; + os.write (reinterpret_cast (&itmp), 4); + + save_type st = LS_DOUBLE; + if (save_as_floats) + { + if (matrix.too_large_for_float ()) + { + warning ("save: some values too large to save as floats --"); + warning ("save: saving as doubles instead"); + } + else + st = LS_FLOAT; + } + else if (matrix.nnz () > 8192) // FIXME -- make this configurable. + { + double max_val, min_val; + if (matrix.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + } + + // add one to the printed indices to go from + // zero-based to one-based arrays + for (int i = 0; i < nc+1; i++) + { + octave_quit (); + itmp = matrix.cidx (i); + os.write (reinterpret_cast (&itmp), 4); + } + + for (int i = 0; i < nz; i++) + { + octave_quit (); + itmp = matrix.ridx (i); + os.write (reinterpret_cast (&itmp), 4); + } + + write_doubles (os, reinterpret_cast (matrix.data ()), st, 2 * nz); + + return true; +} + +bool +octave_sparse_complex_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + int32_t nz, nc, nr, tmp; + char ctmp; + + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + + if (swap) + swap_bytes<4> (&tmp); + + if (tmp != -2) { + error ("load: only 2D sparse matrices are supported"); + return false; + } + + if (! is.read (reinterpret_cast (&nr), 4)) + return false; + if (! is.read (reinterpret_cast (&nc), 4)) + return false; + if (! is.read (reinterpret_cast (&nz), 4)) + return false; + + if (swap) + { + swap_bytes<4> (&nr); + swap_bytes<4> (&nc); + swap_bytes<4> (&nz); + } + + SparseComplexMatrix m (static_cast (nr), + static_cast (nc), + static_cast (nz)); + + for (int i = 0; i < nc+1; i++) + { + octave_quit (); + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + if (swap) + swap_bytes<4> (&tmp); + m.cidx (i) = tmp; + } + + for (int i = 0; i < nz; i++) + { + octave_quit (); + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + if (swap) + swap_bytes<4> (&tmp); + m.ridx (i) = tmp; + } + + if (! is.read (reinterpret_cast (&ctmp), 1)) + return false; + + read_doubles (is, reinterpret_cast (m.data ()), + static_cast (ctmp), 2 * nz, swap, fmt); + + if (error_state || ! is) + return false; + + if (! m.indices_ok ()) + return false; + + matrix = m; + + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_sparse_complex_matrix::save_hdf5 (hid_t loc_id, const char *name, + bool save_as_floats) +{ + dim_vector dv = dims (); + int empty = save_hdf5_empty (loc_id, name, dv); + if (empty) + return (empty > 0); + + // Ensure that additional memory is deallocated + matrix.maybe_compress (); + +#if HAVE_HDF5_18 + hid_t group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + hid_t group_hid = H5Gcreate (loc_id, name, 0); +#endif + if (group_hid < 0) + return false; + + hid_t space_hid = -1, data_hid = -1; + bool retval = true; + SparseComplexMatrix m = sparse_complex_matrix_value (); + octave_idx_type tmp; + hsize_t hdims[2]; + + space_hid = H5Screate_simple (0, hdims, 0); + if (space_hid < 0) + { + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + tmp = m.rows (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &tmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + tmp = m.cols (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &tmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + tmp = m.nnz (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &tmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + + hdims[0] = m.cols () + 1; + hdims[1] = 1; + + space_hid = H5Screate_simple (2, hdims, 0); + + if (space_hid < 0) + { + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + octave_idx_type * itmp = m.xcidx (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, itmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + + hdims[0] = m.nnz (); + hdims[1] = 1; + + space_hid = H5Screate_simple (2, hdims, 0); + + if (space_hid < 0) + { + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + itmp = m.xridx (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, itmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + hid_t save_type_hid = H5T_NATIVE_DOUBLE; + + if (save_as_floats) + { + if (m.too_large_for_float ()) + { + warning ("save: some values too large to save as floats --"); + warning ("save: saving as doubles instead"); + } + else + save_type_hid = H5T_NATIVE_FLOAT; + } +#if HAVE_HDF5_INT2FLOAT_CONVERSIONS + // hdf5 currently doesn't support float/integer conversions + else + { + double max_val, min_val; + + if (m.all_integers (max_val, min_val)) + save_type_hid + = save_type_to_hdf5 (get_save_type (max_val, min_val)); + } +#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ + + hid_t type_hid = hdf5_make_complex_type (save_type_hid); + if (type_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "data", type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "data", type_hid, space_hid, H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + + hid_t complex_type_hid = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); + retval = false; + if (complex_type_hid >= 0) + { + Complex * ctmp = m.xdata (); + + retval = H5Dwrite (data_hid, complex_type_hid, H5S_ALL, H5S_ALL, + H5P_DEFAULT, ctmp) >= 0; + } + + H5Dclose (data_hid); + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + + return retval; +} + +bool +octave_sparse_complex_matrix::load_hdf5 (hid_t loc_id, const char *name) +{ + octave_idx_type nr, nc, nz; + hid_t group_hid, data_hid, space_hid; + hsize_t rank; + + dim_vector dv; + int empty = load_hdf5_empty (loc_id, name, dv); + if (empty > 0) + matrix.resize (dv); + if (empty) + return (empty > 0); + +#if HAVE_HDF5_18 + group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); +#else + group_hid = H5Gopen (loc_id, name); +#endif + if (group_hid < 0 ) return false; + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "nr", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "nr"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nr) < 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "nc", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "nc"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nc) < 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "nz", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "nz"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nz) < 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + + SparseComplexMatrix m (static_cast (nr), + static_cast (nc), + static_cast (nz)); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "cidx", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "cidx"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 2) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + if (static_cast (hdims[0]) != nc + 1 + || static_cast (hdims[1]) != 1) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + octave_idx_type *itmp = m.xcidx (); + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, itmp) < 0) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "ridx", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "ridx"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 2) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + if (static_cast (hdims[0]) != nz + || static_cast (hdims[1]) != 1) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + itmp = m.xridx (); + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, itmp) < 0) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "data", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "data"); +#endif + hid_t type_hid = H5Dget_type (data_hid); + + hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); + + if (! hdf5_types_compatible (type_hid, complex_type)) + { + H5Tclose (complex_type); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 2) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + if (static_cast (hdims[0]) != nz + || static_cast (hdims[1]) != 1) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + Complex *ctmp = m.xdata (); + bool retval = false; + if (H5Dread (data_hid, complex_type, H5S_ALL, H5S_ALL, + H5P_DEFAULT, ctmp) >= 0 + && m.indices_ok ()) + { + retval = true; + matrix = m; + } + + H5Tclose (complex_type); + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + + return retval; +} + +#endif + +mxArray * +octave_sparse_complex_matrix::as_mxArray (void) const +{ + mwSize nz = nzmax (); + mxArray *retval = new mxArray (mxDOUBLE_CLASS, rows (), columns (), + nz, mxCOMPLEX); + double *pr = static_cast (retval->get_data ()); + double *pi = static_cast (retval->get_imag_data ()); + mwIndex *ir = retval->get_ir (); + mwIndex *jc = retval->get_jc (); + + for (mwIndex i = 0; i < nz; i++) + { + Complex val = matrix.data (i); + pr[i] = std::real (val); + pi[i] = std::imag (val); + ir[i] = matrix.ridx (i); + } + + for (mwIndex i = 0; i < columns () + 1; i++) + jc[i] = matrix.cidx (i); + + return retval; +} + +octave_value +octave_sparse_complex_matrix::map (unary_mapper_t umap) const +{ + switch (umap) + { + // Mappers handled specially. + case umap_real: + return ::real (matrix); + case umap_imag: + return ::imag (matrix); + +#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.FCN ()) + + ARRAY_METHOD_MAPPER (abs, abs); + +#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.map (FCN)) + + ARRAY_MAPPER (acos, Complex, ::acos); + ARRAY_MAPPER (acosh, Complex, ::acosh); + ARRAY_MAPPER (angle, double, std::arg); + ARRAY_MAPPER (arg, double, std::arg); + ARRAY_MAPPER (asin, Complex, ::asin); + ARRAY_MAPPER (asinh, Complex, ::asinh); + ARRAY_MAPPER (atan, Complex, ::atan); + ARRAY_MAPPER (atanh, Complex, ::atanh); + ARRAY_MAPPER (ceil, Complex, ::ceil); + ARRAY_MAPPER (conj, Complex, std::conj); + ARRAY_MAPPER (cos, Complex, std::cos); + ARRAY_MAPPER (cosh, Complex, std::cosh); + ARRAY_MAPPER (exp, Complex, std::exp); + ARRAY_MAPPER (expm1, Complex, ::expm1); + ARRAY_MAPPER (fix, Complex, ::fix); + ARRAY_MAPPER (floor, Complex, ::floor); + ARRAY_MAPPER (log, Complex, std::log); + ARRAY_MAPPER (log2, Complex, xlog2); + ARRAY_MAPPER (log10, Complex, std::log10); + ARRAY_MAPPER (log1p, Complex, ::log1p); + ARRAY_MAPPER (round, Complex, xround); + ARRAY_MAPPER (roundb, Complex, xroundb); + ARRAY_MAPPER (signum, Complex, ::signum); + ARRAY_MAPPER (sin, Complex, std::sin); + ARRAY_MAPPER (sinh, Complex, std::sinh); + ARRAY_MAPPER (sqrt, Complex, std::sqrt); + ARRAY_MAPPER (tan, Complex, std::tan); + ARRAY_MAPPER (tanh, Complex, std::tanh); + ARRAY_MAPPER (isnan, bool, xisnan); + ARRAY_MAPPER (isna, bool, octave_is_NA); + ARRAY_MAPPER (isinf, bool, xisinf); + ARRAY_MAPPER (finite, bool, xfinite); + + default: // Attempt to go via dense matrix. + return octave_base_sparse::map (umap); + } +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-cx-sparse.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-cx-sparse.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,160 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_sparse_complex_matrix_h) +#define octave_sparse_complex_matrix_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-stream.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +#include "CSparse.h" +#include "ov-base-sparse.h" +#include "ov-re-sparse.h" + +class octave_value_list; + +class tree_walker; + +class +OCTINTERP_API +octave_sparse_complex_matrix : public octave_base_sparse +{ +public: + + octave_sparse_complex_matrix (void) + : octave_base_sparse () { } + + octave_sparse_complex_matrix (const ComplexNDArray& m) + : octave_base_sparse (SparseComplexMatrix (m)) { } + + octave_sparse_complex_matrix (const ComplexMatrix& m) + : octave_base_sparse (SparseComplexMatrix (m)) { } + + octave_sparse_complex_matrix (const SparseComplexMatrix& m) + : octave_base_sparse (m) { } + + octave_sparse_complex_matrix (const SparseComplexMatrix& m, + const MatrixType &t) + : octave_base_sparse (m, t) { } + + octave_sparse_complex_matrix (const MSparse& m) + : octave_base_sparse (m) { } + + octave_sparse_complex_matrix (const MSparse& m, + const MatrixType &t) + : octave_base_sparse (m, t) { } + + octave_sparse_complex_matrix (const Sparse& m, + const MatrixType &t) + : octave_base_sparse (SparseComplexMatrix (m), t) { } + + octave_sparse_complex_matrix (const Sparse& m) + : octave_base_sparse (SparseComplexMatrix (m)) { } + + octave_sparse_complex_matrix (const octave_sparse_complex_matrix& cm) + : octave_base_sparse (cm) { } + + ~octave_sparse_complex_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_sparse_complex_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_sparse_complex_matrix (); } + + octave_base_value *try_narrowing_conversion (void); + + builtin_type_t builtin_type (void) const { return btyp_complex; } + + bool is_complex_matrix (void) const { return true; } + + bool is_complex_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + double double_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const; + + Complex complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const; + + charNDArray char_array_value (bool frc_str_conv = false) const; + + SparseMatrix sparse_matrix_value (bool = false) const; + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const + { return matrix; } + + SparseBoolMatrix sparse_bool_matrix_value (bool warn = false) const; + +#if 0 + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { + // Yes, for compatibility, we drop the imaginary part here. + return os.write (matrix_value (true), block_size, output_type, + skip, flt_fmt); + } +#endif + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const; + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-dld-fcn.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-dld-fcn.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,90 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "oct-shlib.h" + +#include +#include "dynamic-ld.h" +#include "error.h" +#include "oct-obj.h" +#include "ov-dld-fcn.h" +#include "ov.h" + +DEFINE_OCTAVE_ALLOCATOR (octave_dld_function); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_dld_function, + "dynamically-linked function", + "dynamically-linked function"); + + +octave_dld_function::octave_dld_function + (octave_builtin::fcn ff, const octave_shlib& shl, + const std::string& nm, const std::string& ds) + : octave_builtin (ff, nm, ds), sh_lib (shl) +{ + mark_fcn_file_up_to_date (time_parsed ()); + + std::string file_name = fcn_file_name (); + + system_fcn_file + = (! file_name.empty () + && Voct_file_dir == file_name.substr (0, Voct_file_dir.length ())); +} + +octave_dld_function::~octave_dld_function (void) +{ + octave_dynamic_loader::remove_oct (my_name, sh_lib); +} + +std::string +octave_dld_function::fcn_file_name (void) const +{ + return sh_lib.file_name (); +} + +octave_time +octave_dld_function::time_parsed (void) const +{ + return sh_lib.time_loaded (); +} + +// Note: this wrapper around the octave_dld_function constructor is +// necessary to work around a MSVC limitation handling in +// virtual destructors that prevents unloading a dynamic module +// before *all* objects (of class using a virtual dtor) have +// been fully deleted; indeed, MSVC attaches auto-generated code +// (scalar deleting destructor) to objects created in a dynamic +// module, and this code will be executed in the dynamic module +// context at object deletion; unloading the dynamic module +// before objects have been deleted will make the "delete" code +// of objects to point to an invalid code segment. + +octave_dld_function* +octave_dld_function::create (octave_builtin::fcn ff, const octave_shlib& shl, + const std::string& nm, const std::string& ds) +{ + return new octave_dld_function (ff, shl, nm, ds); +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-dld-fcn.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-dld-fcn.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,103 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_dld_function_h) +#define octave_dld_function_h 1 + +#include + +#include "oct-shlib.h" + +#include "ov-fcn.h" +#include "ov-builtin.h" +#include "ov-typeinfo.h" + +class octave_shlib; + +class octave_value; +class octave_value_list; + +// Dynamically-linked functions. + +class +OCTINTERP_API +octave_dld_function : public octave_builtin +{ +public: + + octave_dld_function (void) + : sh_lib (), t_checked (), system_fcn_file () + { } + + octave_dld_function (octave_builtin::fcn ff, const octave_shlib& shl, + const std::string& nm = std::string (), + const std::string& ds = std::string ()); + + ~octave_dld_function (void); + + void mark_fcn_file_up_to_date (const octave_time& t) { t_checked = t; } + + std::string fcn_file_name (void) const; + + octave_time time_parsed (void) const; + + octave_time time_checked (void) const { return t_checked; } + + bool is_system_fcn_file (void) const { return system_fcn_file; } + + bool is_builtin_function (void) const { return false; } + + bool is_dld_function (void) const { return true; } + + static octave_dld_function* create (octave_builtin::fcn ff, + const octave_shlib& shl, + const std::string& nm = std::string (), + const std::string& ds = std::string ()); + + octave_shlib get_shlib (void) const + { return sh_lib; } + +private: + + octave_shlib sh_lib; + + // The time the file was last checked to see if it needs to be + // parsed again. + mutable octave_time t_checked; + + // True if this function came from a file that is considered to be a + // system function. This affects whether we check the time stamp + // on the file to see if it has changed. + bool system_fcn_file; + + // No copying! + + octave_dld_function (const octave_dld_function& fn); + + octave_dld_function& operator = (const octave_dld_function& fn); + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-fcn-handle.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-fcn-handle.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,2000 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague, a.s. +Copyright (C) 2010 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "file-ops.h" +#include "oct-locbuf.h" + +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "oct-map.h" +#include "ov-base.h" +#include "ov-fcn-handle.h" +#include "ov-usr-fcn.h" +#include "pr-output.h" +#include "pt-pr-code.h" +#include "pt-misc.h" +#include "pt-stmt.h" +#include "pt-cmd.h" +#include "pt-exp.h" +#include "pt-assign.h" +#include "pt-arg-list.h" +#include "variables.h" +#include "parse.h" +#include "unwind-prot.h" +#include "defaults.h" +#include "file-stat.h" +#include "load-path.h" +#include "oct-env.h" + +#include "byte-swap.h" +#include "ls-ascii-helper.h" +#include "ls-hdf5.h" +#include "ls-oct-ascii.h" +#include "ls-oct-binary.h" +#include "ls-utils.h" + +DEFINE_OCTAVE_ALLOCATOR (octave_fcn_handle); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_fcn_handle, + "function handle", + "function_handle"); + +const std::string octave_fcn_handle::anonymous ("@"); + +octave_fcn_handle::octave_fcn_handle (const octave_value& f, + const std::string& n) + : fcn (f), nm (n), has_overloads (false) +{ + octave_user_function *uf = fcn.user_function_value (true); + + if (uf && nm != anonymous) + symbol_table::cache_name (uf->scope (), nm); + + if (uf && uf->is_nested_function ()) + ::error ("handles to nested functions are not yet supported"); +} + +octave_value_list +octave_fcn_handle::subsref (const std::string& type, + const std::list& idx, + int nargout) +{ + return octave_fcn_handle::subsref (type, idx, nargout, 0); +} + +octave_value_list +octave_fcn_handle::subsref (const std::string& type, + const std::list& idx, + int nargout, const std::list* lvalue_list) +{ + octave_value_list retval; + + switch (type[0]) + { + case '(': + { + int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout; + + retval = do_multi_index_op (tmp_nargout, idx.front (), + idx.size () == 1 ? lvalue_list : 0); + } + break; + + case '{': + case '.': + { + std::string tnm = type_name (); + error ("%s cannot be indexed with %c", tnm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + // FIXME -- perhaps there should be an + // octave_value_list::next_subsref member function? See also + // octave_builtin::subsref. + + if (idx.size () > 1) + retval = retval(0).next_subsref (nargout, type, idx); + + return retval; +} + +octave_value_list +octave_fcn_handle::do_multi_index_op (int nargout, + const octave_value_list& args) +{ + return do_multi_index_op (nargout, args, 0); +} + +octave_value_list +octave_fcn_handle::do_multi_index_op (int nargout, + const octave_value_list& args, + const std::list* lvalue_list) +{ + octave_value_list retval; + + out_of_date_check (fcn, std::string (), false); + + if (has_overloads) + { + // Possibly overloaded function. + octave_value ov_fcn; + + // Compute dispatch type. + builtin_type_t btyp; + std::string dispatch_type = get_dispatch_type (args, btyp); + + // Retrieve overload. + if (btyp != btyp_unknown) + { + out_of_date_check (builtin_overloads[btyp], dispatch_type, false); + ov_fcn = builtin_overloads[btyp]; + } + else + { + str_ov_map::iterator it = overloads.find (dispatch_type); + + if (it == overloads.end ()) + { + // Try parent classes too. + + std::list plist + = symbol_table::parent_classes (dispatch_type); + + std::list::const_iterator pit = plist.begin (); + + while (pit != plist.end ()) + { + std::string pname = *pit; + + std::string fnm = fcn_name (); + + octave_value ftmp = symbol_table::find_method (fnm, pname); + + if (ftmp.is_defined ()) + { + set_overload (pname, ftmp); + + out_of_date_check (ftmp, pname, false); + ov_fcn = ftmp; + + break; + } + + pit++; + } + } + else + { + out_of_date_check (it->second, dispatch_type, false); + ov_fcn = it->second; + } + } + + if (ov_fcn.is_defined ()) + retval = ov_fcn.do_multi_index_op (nargout, args, lvalue_list); + else if (fcn.is_defined ()) + retval = fcn.do_multi_index_op (nargout, args, lvalue_list); + else + error ("%s: no method for class %s", nm.c_str (), dispatch_type.c_str ()); + } + else + { + // Non-overloaded function (anonymous, subfunction, private function). + if (fcn.is_defined ()) + retval = fcn.do_multi_index_op (nargout, args, lvalue_list); + else + error ("%s: no longer valid function handle", nm.c_str ()); + } + + return retval; +} + +bool +octave_fcn_handle::is_equal_to (const octave_fcn_handle& h) const +{ + bool retval = fcn.is_copy_of (h.fcn) && (has_overloads == h.has_overloads); + retval = retval && (overloads.size () == h.overloads.size ()); + + if (retval && has_overloads) + { + for (int i = 0; i < btyp_num_types && retval; i++) + retval = builtin_overloads[i].is_copy_of (h.builtin_overloads[i]); + + str_ov_map::const_iterator iter = overloads.begin (), hiter = h.overloads.begin (); + for (; iter != overloads.end () && retval; iter++, hiter++) + retval = (iter->first == hiter->first) && (iter->second.is_copy_of (hiter->second)); + } + + return retval; +} + +bool +octave_fcn_handle::set_fcn (const std::string &octaveroot, + const std::string& fpath) +{ + bool success = true; + + if (octaveroot.length () != 0 + && fpath.length () >= octaveroot.length () + && fpath.substr (0, octaveroot.length ()) == octaveroot + && OCTAVE_EXEC_PREFIX != octaveroot) + { + // First check if just replacing matlabroot is enough + std::string str = OCTAVE_EXEC_PREFIX + + fpath.substr (octaveroot.length ()); + file_stat fs (str); + + if (fs.exists ()) + { + size_t xpos = str.find_last_of (file_ops::dir_sep_chars ()); + + std::string dir_name = str.substr (0, xpos); + + octave_function *xfcn + = load_fcn_from_file (str, dir_name, "", nm); + + if (xfcn) + { + octave_value tmp (xfcn); + + fcn = octave_value (new octave_fcn_handle (tmp, nm)); + } + else + { + error ("function handle points to non-existent function"); + success = false; + } + } + else + { + // Next just search for it anywhere in the system path + string_vector names(3); + names(0) = nm + ".oct"; + names(1) = nm + ".mex"; + names(2) = nm + ".m"; + + dir_path p (load_path::system_path ()); + + str = octave_env::make_absolute (p.find_first_of (names)); + + size_t xpos = str.find_last_of (file_ops::dir_sep_chars ()); + + std::string dir_name = str.substr (0, xpos); + + octave_function *xfcn = load_fcn_from_file (str, dir_name, "", nm); + + if (xfcn) + { + octave_value tmp (xfcn); + + fcn = octave_value (new octave_fcn_handle (tmp, nm)); + } + else + { + error ("function handle points to non-existent function"); + success = false; + } + } + } + else + { + if (fpath.length () > 0) + { + size_t xpos = fpath.find_last_of (file_ops::dir_sep_chars ()); + + std::string dir_name = fpath.substr (0, xpos); + + octave_function *xfcn = load_fcn_from_file (fpath, dir_name, "", nm); + + if (xfcn) + { + octave_value tmp (xfcn); + + fcn = octave_value (new octave_fcn_handle (tmp, nm)); + } + else + { + error ("function handle points to non-existent function"); + success = false; + } + } + else + { + fcn = symbol_table::find_function (nm); + + if (! fcn.is_function ()) + { + error ("function handle points to non-existent function"); + success = false; + } + } + } + + return success; +} + +bool +octave_fcn_handle::save_ascii (std::ostream& os) +{ + if (nm == anonymous) + { + os << nm << "\n"; + + print_raw (os, true); + os << "\n"; + + if (fcn.is_undefined ()) + return false; + + octave_user_function *f = fcn.user_function_value (); + + std::list vars + = symbol_table::all_variables (f->scope (), 0); + + size_t varlen = vars.size (); + + if (varlen > 0) + { + os << "# length: " << varlen << "\n"; + + for (std::list::const_iterator p = vars.begin (); + p != vars.end (); p++) + { + if (! save_ascii_data (os, p->varval (), p->name (), false, 0)) + return os; + } + } + } + else + { + octave_function *f = function_value (); + std::string fnm = f ? f->fcn_file_name () : std::string (); + + os << "# octaveroot: " << OCTAVE_EXEC_PREFIX << "\n"; + if (! fnm.empty ()) + os << "# path: " << fnm << "\n"; + os << nm << "\n"; + } + + return true; +} + +bool +octave_fcn_handle::load_ascii (std::istream& is) +{ + bool success = true; + + std::streampos pos = is.tellg (); + std::string octaveroot = extract_keyword (is, "octaveroot", true); + if (octaveroot.length () == 0) + { + is.seekg (pos); + is.clear (); + } + pos = is.tellg (); + std::string fpath = extract_keyword (is, "path", true); + if (fpath.length () == 0) + { + is.seekg (pos); + is.clear (); + } + + is >> nm; + + if (nm == anonymous) + { + skip_preceeding_newline (is); + + std::string buf; + + if (is) + { + + // Get a line of text whitespace characters included, leaving + // newline in the stream. + buf = read_until_newline (is, true); + + } + + pos = is.tellg (); + + unwind_protect_safe frame; + + // Set up temporary scope to use for evaluating the text that + // defines the anonymous function. + + symbol_table::scope_id local_scope = symbol_table::alloc_scope (); + frame.add_fcn (symbol_table::erase_scope, local_scope); + + symbol_table::set_scope (local_scope); + + octave_call_stack::push (local_scope, 0); + frame.add_fcn (octave_call_stack::pop); + + octave_idx_type len = 0; + + if (extract_keyword (is, "length", len, true) && len >= 0) + { + if (len > 0) + { + for (octave_idx_type i = 0; i < len; i++) + { + octave_value t2; + bool dummy; + + std::string name + = read_ascii_data (is, std::string (), dummy, t2, i); + + if (!is) + { + error ("load: failed to load anonymous function handle"); + break; + } + + symbol_table::varref (name, local_scope, 0) = t2; + } + } + } + else + { + is.seekg (pos); + is.clear (); + } + + if (is && success) + { + int parse_status; + octave_value anon_fcn_handle = + eval_string (buf, true, parse_status); + + if (parse_status == 0) + { + octave_fcn_handle *fh = + anon_fcn_handle.fcn_handle_value (); + + if (fh) + { + fcn = fh->fcn; + + octave_user_function *uf = fcn.user_function_value (true); + + if (uf) + symbol_table::cache_name (uf->scope (), nm); + } + else + success = false; + } + else + success = false; + } + else + success = false; + } + else + success = set_fcn (octaveroot, fpath); + + return success; +} + +bool +octave_fcn_handle::save_binary (std::ostream& os, bool& save_as_floats) +{ + if (nm == anonymous) + { + std::ostringstream nmbuf; + + if (fcn.is_undefined ()) + return false; + + octave_user_function *f = fcn.user_function_value (); + + std::list vars + = symbol_table::all_variables (f->scope (), 0); + + size_t varlen = vars.size (); + + if (varlen > 0) + nmbuf << nm << " " << varlen; + else + nmbuf << nm; + + std::string buf_str = nmbuf.str (); + int32_t tmp = buf_str.length (); + os.write (reinterpret_cast (&tmp), 4); + os.write (buf_str.c_str (), buf_str.length ()); + + std::ostringstream buf; + print_raw (buf, true); + std::string stmp = buf.str (); + tmp = stmp.length (); + os.write (reinterpret_cast (&tmp), 4); + os.write (stmp.c_str (), stmp.length ()); + + if (varlen > 0) + { + for (std::list::const_iterator p = vars.begin (); + p != vars.end (); p++) + { + if (! save_binary_data (os, p->varval (), p->name (), + "", 0, save_as_floats)) + return os; + } + } + } + else + { + std::ostringstream nmbuf; + + octave_function *f = function_value (); + std::string fnm = f ? f->fcn_file_name () : std::string (); + + nmbuf << nm << "\n" << OCTAVE_EXEC_PREFIX << "\n" << fnm; + + std::string buf_str = nmbuf.str (); + int32_t tmp = buf_str.length (); + os.write (reinterpret_cast (&tmp), 4); + os.write (buf_str.c_str (), buf_str.length ()); + } + + return true; +} + +bool +octave_fcn_handle::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + bool success = true; + + int32_t tmp; + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + if (swap) + swap_bytes<4> (&tmp); + + OCTAVE_LOCAL_BUFFER (char, ctmp1, tmp+1); + // is.get (ctmp1, tmp+1, 0); caused is.eof () to be true though + // effectively not reading over file end + is.read (ctmp1, tmp); + ctmp1[tmp] = 0; + nm = std::string (ctmp1); + + if (! is) + return false; + + size_t anl = anonymous.length (); + + if (nm.length () >= anl && nm.substr (0, anl) == anonymous) + { + octave_idx_type len = 0; + + if (nm.length () > anl) + { + std::istringstream nm_is (nm.substr (anl)); + nm_is >> len; + nm = nm.substr (0, anl); + } + + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + if (swap) + swap_bytes<4> (&tmp); + + OCTAVE_LOCAL_BUFFER (char, ctmp2, tmp+1); + // is.get (ctmp2, tmp+1, 0); caused is.eof () to be true though + // effectively not reading over file end + is.read (ctmp2, tmp); + ctmp2[tmp] = 0; + + unwind_protect_safe frame; + + // Set up temporary scope to use for evaluating the text that + // defines the anonymous function. + + symbol_table::scope_id local_scope = symbol_table::alloc_scope (); + frame.add_fcn (symbol_table::erase_scope, local_scope); + + symbol_table::set_scope (local_scope); + + octave_call_stack::push (local_scope, 0); + frame.add_fcn (octave_call_stack::pop); + + if (len > 0) + { + for (octave_idx_type i = 0; i < len; i++) + { + octave_value t2; + bool dummy; + std::string doc; + + std::string name = + read_binary_data (is, swap, fmt, std::string (), + dummy, t2, doc); + + if (!is) + { + error ("load: failed to load anonymous function handle"); + break; + } + + symbol_table::varref (name, local_scope) = t2; + } + } + + if (is && success) + { + int parse_status; + octave_value anon_fcn_handle = + eval_string (ctmp2, true, parse_status); + + if (parse_status == 0) + { + octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value (); + + if (fh) + { + fcn = fh->fcn; + + octave_user_function *uf = fcn.user_function_value (true); + + if (uf) + symbol_table::cache_name (uf->scope (), nm); + } + else + success = false; + } + else + success = false; + } + } + else + { + std::string octaveroot; + std::string fpath; + + if (nm.find_first_of ("\n") != std::string::npos) + { + size_t pos1 = nm.find_first_of ("\n"); + size_t pos2 = nm.find_first_of ("\n", pos1 + 1); + octaveroot = nm.substr (pos1 + 1, pos2 - pos1 - 1); + fpath = nm.substr (pos2 + 1); + nm = nm.substr (0, pos1); + } + + success = set_fcn (octaveroot, fpath); + } + + return success; +} + +#if defined (HAVE_HDF5) +bool +octave_fcn_handle::save_hdf5 (hid_t loc_id, const char *name, + bool save_as_floats) +{ + bool retval = true; + + hid_t group_hid = -1; +#if HAVE_HDF5_18 + group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + group_hid = H5Gcreate (loc_id, name, 0); +#endif + if (group_hid < 0) + return false; + + hid_t space_hid = -1, data_hid = -1, type_hid = -1;; + + // attach the type of the variable + type_hid = H5Tcopy (H5T_C_S1); + H5Tset_size (type_hid, nm.length () + 1); + if (type_hid < 0) + { + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, 2); + hdims[0] = 0; + hdims[1] = 0; + space_hid = H5Screate_simple (0 , hdims, 0); + if (space_hid < 0) + { + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "nm", type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "nm", type_hid, space_hid, H5P_DEFAULT); +#endif + if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, + H5P_DEFAULT, nm.c_str ()) < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + H5Dclose (data_hid); + + if (nm == anonymous) + { + std::ostringstream buf; + print_raw (buf, true); + std::string stmp = buf.str (); + + // attach the type of the variable + H5Tset_size (type_hid, stmp.length () + 1); + if (type_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "fcn", type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "fcn", type_hid, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, + H5P_DEFAULT, stmp.c_str ()) < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + + octave_user_function *f = fcn.user_function_value (); + + std::list vars + = symbol_table::all_variables (f->scope (), 0); + + size_t varlen = vars.size (); + + if (varlen > 0) + { + hid_t as_id = H5Screate (H5S_SCALAR); + + if (as_id >= 0) + { +#if HAVE_HDF5_18 + hid_t a_id = H5Acreate (group_hid, "SYMBOL_TABLE", + H5T_NATIVE_IDX, as_id, + H5P_DEFAULT, H5P_DEFAULT); + +#else + hid_t a_id = H5Acreate (group_hid, "SYMBOL_TABLE", + H5T_NATIVE_IDX, as_id, H5P_DEFAULT); +#endif + + if (a_id >= 0) + { + retval = (H5Awrite (a_id, H5T_NATIVE_IDX, &varlen) >= 0); + + H5Aclose (a_id); + } + else + retval = false; + + H5Sclose (as_id); + } + else + retval = false; +#if HAVE_HDF5_18 + data_hid = H5Gcreate (group_hid, "symbol table", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Gcreate (group_hid, "symbol table", 0); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + + for (std::list::const_iterator p = vars.begin (); + p != vars.end (); p++) + { + if (! add_hdf5_data (data_hid, p->varval (), p->name (), + "", false, save_as_floats)) + break; + } + H5Gclose (data_hid); + } + } + else + { + std::string octaveroot = OCTAVE_EXEC_PREFIX; + + octave_function *f = function_value (); + std::string fpath = f ? f->fcn_file_name () : std::string (); + + H5Sclose (space_hid); + hdims[0] = 1; + hdims[1] = octaveroot.length (); + space_hid = H5Screate_simple (0 , hdims, 0); + if (space_hid < 0) + { + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + + H5Tclose (type_hid); + type_hid = H5Tcopy (H5T_C_S1); + H5Tset_size (type_hid, octaveroot.length () + 1); +#if HAVE_HDF5_18 + hid_t a_id = H5Acreate (group_hid, "OCTAVEROOT", + type_hid, space_hid, H5P_DEFAULT, H5P_DEFAULT); +#else + hid_t a_id = H5Acreate (group_hid, "OCTAVEROOT", + type_hid, space_hid, H5P_DEFAULT); +#endif + + if (a_id >= 0) + { + retval = (H5Awrite (a_id, type_hid, octaveroot.c_str ()) >= 0); + + H5Aclose (a_id); + } + else + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + hdims[0] = 1; + hdims[1] = fpath.length (); + space_hid = H5Screate_simple (0 , hdims, 0); + if (space_hid < 0) + { + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + + H5Tclose (type_hid); + type_hid = H5Tcopy (H5T_C_S1); + H5Tset_size (type_hid, fpath.length () + 1); + +#if HAVE_HDF5_18 + a_id = H5Acreate (group_hid, "FILE", type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT); +#else + a_id = H5Acreate (group_hid, "FILE", type_hid, space_hid, H5P_DEFAULT); +#endif + + if (a_id >= 0) + { + retval = (H5Awrite (a_id, type_hid, fpath.c_str ()) >= 0); + + H5Aclose (a_id); + } + else + retval = false; + } + + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + + return retval; +} + +bool +octave_fcn_handle::load_hdf5 (hid_t loc_id, const char *name) +{ + bool success = true; + + hid_t group_hid, data_hid, space_hid, type_hid, type_class_hid, st_id; + hsize_t rank; + int slen; + +#if HAVE_HDF5_18 + group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); +#else + group_hid = H5Gopen (loc_id, name); +#endif + if (group_hid < 0) + return false; + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "nm", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "nm"); +#endif + + if (data_hid < 0) + { + H5Gclose (group_hid); + return false; + } + + type_hid = H5Dget_type (data_hid); + type_class_hid = H5Tget_class (type_hid); + + if (type_class_hid != H5T_STRING) + { + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + slen = H5Tget_size (type_hid); + if (slen < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (char, nm_tmp, slen); + + // create datatype for (null-terminated) string to read into: + st_id = H5Tcopy (H5T_C_S1); + H5Tset_size (st_id, slen); + + if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, nm_tmp) < 0) + { + H5Tclose (st_id); + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + H5Tclose (st_id); + H5Dclose (data_hid); + nm = nm_tmp; + + if (nm == anonymous) + { +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "fcn", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "fcn"); +#endif + + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + + H5Tclose (type_hid); + type_hid = H5Dget_type (data_hid); + type_class_hid = H5Tget_class (type_hid); + + if (type_class_hid != H5T_STRING) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + slen = H5Tget_size (type_hid); + if (slen < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (char, fcn_tmp, slen); + + // create datatype for (null-terminated) string to read into: + st_id = H5Tcopy (H5T_C_S1); + H5Tset_size (st_id, slen); + + if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, fcn_tmp) < 0) + { + H5Tclose (st_id); + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + H5Tclose (st_id); + H5Dclose (data_hid); + + octave_idx_type len = 0; + + // we have to pull some shenanigans here to make sure + // HDF5 doesn't print out all sorts of error messages if we + // call H5Aopen for a non-existing attribute + + H5E_auto_t err_func; + void *err_func_data; + + // turn off error reporting temporarily, but save the error + // reporting function: +#if HAVE_HDF5_18 + H5Eget_auto (H5E_DEFAULT, &err_func, &err_func_data); + H5Eset_auto (H5E_DEFAULT, 0, 0); +#else + H5Eget_auto (&err_func, &err_func_data); + H5Eset_auto (0, 0); +#endif + + hid_t attr_id = H5Aopen_name (group_hid, "SYMBOL_TABLE"); + + if (attr_id >= 0) + { + if (H5Aread (attr_id, H5T_NATIVE_IDX, &len) < 0) + success = false; + + H5Aclose (attr_id); + } + + // restore error reporting: +#if HAVE_HDF5_18 + H5Eset_auto (H5E_DEFAULT, err_func, err_func_data); +#else + H5Eset_auto (err_func, err_func_data); +#endif + + unwind_protect_safe frame; + + // Set up temporary scope to use for evaluating the text that + // defines the anonymous function. + + symbol_table::scope_id local_scope = symbol_table::alloc_scope (); + frame.add_fcn (symbol_table::erase_scope, local_scope); + + symbol_table::set_scope (local_scope); + + octave_call_stack::push (local_scope, 0); + frame.add_fcn (octave_call_stack::pop); + + if (len > 0 && success) + { + hsize_t num_obj = 0; +#if HAVE_HDF5_18 + data_hid = H5Gopen (group_hid, "symbol table", H5P_DEFAULT); +#else + data_hid = H5Gopen (group_hid, "symbol table"); +#endif + H5Gget_num_objs (data_hid, &num_obj); + H5Gclose (data_hid); + + if (num_obj != static_cast(len)) + { + error ("load: failed to load anonymous function handle"); + success = false; + } + + if (! error_state) + { + hdf5_callback_data dsub; + int current_item = 0; + for (octave_idx_type i = 0; i < len; i++) + { + if (H5Giterate (group_hid, "symbol table", ¤t_item, + hdf5_read_next_data, &dsub) <= 0) + { + error ("load: failed to load anonymous function handle"); + success = false; + break; + } + + symbol_table::varref (dsub.name, local_scope) = dsub.tc; + } + } + } + + if (success) + { + int parse_status; + octave_value anon_fcn_handle = + eval_string (fcn_tmp, true, parse_status); + + if (parse_status == 0) + { + octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value (); + + if (fh) + { + fcn = fh->fcn; + + octave_user_function *uf = fcn.user_function_value (true); + + if (uf) + symbol_table::cache_name (uf->scope (), nm); + } + else + success = false; + } + else + success = false; + } + + frame.run (); + } + else + { + std::string octaveroot; + std::string fpath; + + // we have to pull some shenanigans here to make sure + // HDF5 doesn't print out all sorts of error messages if we + // call H5Aopen for a non-existing attribute + + H5E_auto_t err_func; + void *err_func_data; + + // turn off error reporting temporarily, but save the error + // reporting function: +#if HAVE_HDF5_18 + H5Eget_auto (H5E_DEFAULT, &err_func, &err_func_data); + H5Eset_auto (H5E_DEFAULT, 0, 0); +#else + H5Eget_auto (&err_func, &err_func_data); + H5Eset_auto (0, 0); +#endif + + hid_t attr_id = H5Aopen_name (group_hid, "OCTAVEROOT"); + if (attr_id >= 0) + { + H5Tclose (type_hid); + type_hid = H5Aget_type (attr_id); + type_class_hid = H5Tget_class (type_hid); + + if (type_class_hid != H5T_STRING) + success = false; + else + { + slen = H5Tget_size (type_hid); + st_id = H5Tcopy (H5T_C_S1); + H5Tset_size (st_id, slen); + OCTAVE_LOCAL_BUFFER (char, root_tmp, slen); + + if (H5Aread (attr_id, st_id, root_tmp) < 0) + success = false; + else + octaveroot = root_tmp; + + H5Tclose (st_id); + } + + H5Aclose (attr_id); + } + + if (success) + { + attr_id = H5Aopen_name (group_hid, "FILE"); + if (attr_id >= 0) + { + H5Tclose (type_hid); + type_hid = H5Aget_type (attr_id); + type_class_hid = H5Tget_class (type_hid); + + if (type_class_hid != H5T_STRING) + success = false; + else + { + slen = H5Tget_size (type_hid); + st_id = H5Tcopy (H5T_C_S1); + H5Tset_size (st_id, slen); + OCTAVE_LOCAL_BUFFER (char, path_tmp, slen); + + if (H5Aread (attr_id, st_id, path_tmp) < 0) + success = false; + else + fpath = path_tmp; + + H5Tclose (st_id); + } + + H5Aclose (attr_id); + } + } + + // restore error reporting: +#if HAVE_HDF5_18 + H5Eset_auto (H5E_DEFAULT, err_func, err_func_data); +#else + H5Eset_auto (err_func, err_func_data); +#endif + + success = (success ? set_fcn (octaveroot, fpath) : success); + } + + H5Tclose (type_hid); + H5Sclose (space_hid); + H5Gclose (group_hid); + + return success; +} + +#endif + +/* +%!test +%! a = 2; +%! f = @(x) a + x; +%! g = @(x) 2 * x; +%! hm = @version; +%! hdld = @svd; +%! hbi = @log2; +%! f2 = f; +%! g2 = g; +%! hm2 = hm; +%! hdld2 = hdld; +%! hbi2 = hbi; +%! modes = {"-text", "-binary"}; +%! if (!isempty (findstr (octave_config_info ("DEFS"), "HAVE_HDF5"))) +%! modes(end+1) = "-hdf5"; +%! endif +%! for i = 1:numel (modes) +%! mode = modes{i}; +%! nm = tmpnam (); +%! unwind_protect +%! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2"); +%! clear f2 g2 hm2 hdld2 hbi2 +%! load (nm); +%! assert (f (2), f2 (2)); +%! assert (g (2), g2 (2)); +%! assert (g (3), g2 (3)); +%! unlink (nm); +%! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2"); +%! unwind_protect_cleanup +%! unlink (nm); +%! end_unwind_protect +%! endfor +*/ + +void +octave_fcn_handle::print (std::ostream& os, bool pr_as_read_syntax) const +{ + print_raw (os, pr_as_read_syntax); + newline (os); +} + +void +octave_fcn_handle::print_raw (std::ostream& os, bool pr_as_read_syntax) const +{ + bool printed = false; + + if (nm == anonymous) + { + tree_print_code tpc (os); + + // FCN is const because this member function is, so we can't + // use it to call user_function_value, so we make a copy first. + + octave_value ftmp = fcn; + + octave_user_function *f = ftmp.user_function_value (); + + if (f) + { + tree_parameter_list *p = f->parameter_list (); + + os << "@("; + + if (p) + p->accept (tpc); + + os << ") "; + + tpc.print_fcn_handle_body (f->body ()); + + printed = true; + } + } + + if (! printed) + octave_print_internal (os, "@" + nm, pr_as_read_syntax, + current_print_indent_level ()); +} + +octave_value +make_fcn_handle (const std::string& nm, bool local_funcs) +{ + octave_value retval; + + // Bow to the god of compatibility. + + // FIXME -- it seems ugly to put this here, but there is no single + // function in the parser that converts from the operator name to + // the corresponding function name. At least try to do it without N + // string compares. + + std::string tnm = nm; + + size_t len = nm.length (); + + if (len == 3 && nm == ".**") + tnm = "power"; + else if (len == 2) + { + if (nm[0] == '.') + { + switch (nm[1]) + { + case '\'': + tnm = "transpose"; + break; + + case '+': + tnm = "plus"; + break; + + case '-': + tnm = "minus"; + break; + + case '*': + tnm = "times"; + break; + + case '/': + tnm = "rdivide"; + break; + + case '^': + tnm = "power"; + break; + + case '\\': + tnm = "ldivide"; + break; + } + } + else if (nm[1] == '=') + { + switch (nm[0]) + { + case '<': + tnm = "le"; + break; + + case '=': + tnm = "eq"; + break; + + case '>': + tnm = "ge"; + break; + + case '~': + case '!': + tnm = "ne"; + break; + } + } + else if (nm == "**") + tnm = "mpower"; + } + else if (len == 1) + { + switch (nm[0]) + { + case '~': + case '!': + tnm = "not"; + break; + + case '\'': + tnm = "ctranspose"; + break; + + case '+': + tnm = "plus"; + break; + + case '-': + tnm = "minus"; + break; + + case '*': + tnm = "mtimes"; + break; + + case '/': + tnm = "mrdivide"; + break; + + case '^': + tnm = "mpower"; + break; + + case '\\': + tnm = "mldivide"; + break; + + case '<': + tnm = "lt"; + break; + + case '>': + tnm = "gt"; + break; + + case '&': + tnm = "and"; + break; + + case '|': + tnm = "or"; + break; + } + } + + octave_value f = symbol_table::find_function (tnm, octave_value_list (), + local_funcs); + + octave_function *fptr = f.function_value (true); + + // Here we are just looking to see if FCN is a method or constructor + // for any class. + if (local_funcs && fptr + && (fptr->is_subfunction () || fptr->is_private_function () + || fptr->is_class_constructor ())) + { + // Locally visible function. + retval = octave_value (new octave_fcn_handle (f, tnm)); + } + else + { + // Globally visible (or no match yet). Query overloads. + std::list classes = load_path::overloads (tnm); + bool any_match = fptr != 0 || classes.size () > 0; + if (! any_match) + { + // No match found, try updating load_path and query classes again. + load_path::update (); + classes = load_path::overloads (tnm); + any_match = classes.size () > 0; + } + + if (any_match) + { + octave_fcn_handle *fh = new octave_fcn_handle (f, tnm); + retval = fh; + + for (std::list::iterator iter = classes.begin (); + iter != classes.end (); iter++) + { + std::string class_name = *iter; + octave_value fmeth = symbol_table::find_method (tnm, class_name); + + bool is_builtin = false; + for (int i = 0; i < btyp_num_types; i++) + { + // FIXME: Too slow? Maybe binary lookup? + if (class_name == btyp_class_name[i]) + { + is_builtin = true; + fh->set_overload (static_cast (i), fmeth); + } + } + + if (! is_builtin) + fh->set_overload (class_name, fmeth); + } + } + else + error ("@%s: no function and no method found", tnm.c_str ()); + } + + return retval; +} + +/* +%!test +%! x = {".**", "power"; +%! ".'", "transpose"; +%! ".+", "plus"; +%! ".-", "minus"; +%! ".*", "times"; +%! "./", "rdivide"; +%! ".^", "power"; +%! ".\\", "ldivide"; +%! "<=", "le"; +%! "==", "eq"; +%! ">=", "ge"; +%! "~=", "ne"; +%! "!=", "ne"; +%! "**", "mpower"; +%! "~", "not"; +%! "!", "not"; +%! "\'", "ctranspose"; +%! "+", "plus"; +%! "-", "minus"; +%! "*", "mtimes"; +%! "/", "mrdivide"; +%! "^", "mpower"; +%! "\\", "mldivide"; +%! "<", "lt"; +%! ">", "gt"; +%! "&", "and"; +%! "|", "or"}; +%! for i = 1:rows (x) +%! assert (functions (str2func (x{i,1})).function, x{i,2}); +%! endfor +*/ + +DEFUN (functions, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} functions (@var{fcn_handle})\n\ +Return a struct containing information about the function handle\n\ +@var{fcn_handle}.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + octave_fcn_handle *fh = args(0).fcn_handle_value (); + + if (! error_state) + { + octave_function *fcn = fh ? fh->function_value () : 0; + + if (fcn) + { + octave_scalar_map m; + + std::string fh_nm = fh->fcn_name (); + + if (fh_nm == octave_fcn_handle::anonymous) + { + std::ostringstream buf; + fh->print_raw (buf); + m.setfield ("function", buf.str ()); + + m.setfield ("type", "anonymous"); + } + else + { + m.setfield ("function", fh_nm); + + if (fcn->is_subfunction ()) + { + m.setfield ("type", "subfunction"); + Cell parentage (dim_vector (1, 2)); + parentage.elem (0) = fh_nm; + parentage.elem (1) = fcn->parent_fcn_name (); + m.setfield ("parentage", octave_value (parentage)); + } + else if (fcn->is_private_function ()) + m.setfield ("type", "private"); + else if (fh->is_overloaded ()) + m.setfield ("type", "overloaded"); + else + m.setfield ("type", "simple"); + } + + std::string nm = fcn->fcn_file_name (); + + if (fh_nm == octave_fcn_handle::anonymous) + { + m.setfield ("file", nm); + + octave_user_function *fu = fh->user_function_value (); + + std::list vars + = symbol_table::all_variables (fu->scope (), 0); + + size_t varlen = vars.size (); + + if (varlen > 0) + { + octave_scalar_map ws; + for (std::list::const_iterator p = vars.begin (); + p != vars.end (); p++) + { + ws.assign (p->name (), p->varval (0)); + } + + m.setfield ("workspace", ws); + } + } + else if (fcn->is_user_function () || fcn->is_user_script ()) + { + octave_function *fu = fh->function_value (); + m.setfield ("file", fu->fcn_file_name ()); + } + else + m.setfield ("file", ""); + + retval = m; + } + else + error ("functions: FCN_HANDLE is not a valid function handle object"); + } + else + error ("functions: FCN_HANDLE argument must be a function handle object"); + } + else + print_usage (); + + return retval; +} + +DEFUN (func2str, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} func2str (@var{fcn_handle})\n\ +Return a string containing the name of the function referenced by\n\ +the function handle @var{fcn_handle}.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + octave_fcn_handle *fh = args(0).fcn_handle_value (); + + if (! error_state && fh) + { + std::string fh_nm = fh->fcn_name (); + + if (fh_nm == octave_fcn_handle::anonymous) + { + std::ostringstream buf; + + fh->print_raw (buf); + + retval = buf.str (); + } + else + retval = fh_nm; + } + else + error ("func2str: FCN_HANDLE must be a valid function handle"); + } + else + print_usage (); + + return retval; +} + +DEFUN (str2func, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} str2func (@var{fcn_name})\n\ +@deftypefnx {Built-in Function} {} str2func (@var{fcn_name}, \"global\")\n\ +Return a function handle constructed from the string @var{fcn_name}.\n\ +If the optional \"global\" argument is passed, locally visible functions\n\ +are ignored in the lookup.\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string nm = args(0).string_value (); + + if (! error_state) + retval = make_fcn_handle (nm, nargin != 2); + else + error ("str2func: FCN_NAME must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!function y = __testrecursionfunc (f, x, n) +%! if (nargin < 3) +%! n = 0; +%! endif +%! if (n > 2) +%! y = f (x); +%! else +%! n++; +%! y = __testrecursionfunc (@(x) f (2*x), x, n); +%! endif +%!endfunction +%! +%!assert (__testrecursionfunc (@(x) x, 1), 8) +*/ + +DEFUN (is_function_handle, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_function_handle (@var{x})\n\ +Return true if @var{x} is a function handle.\n\ +@seealso{isa, typeinfo, class}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + retval = args(0).is_function_handle (); + else + print_usage (); + + return retval; +} + +/* +%!shared fh +%! fh = @(x) x; + +%!assert (is_function_handle (fh)) +%!assert (! is_function_handle ({fh})) +%!assert (! is_function_handle (1)) + +%!error is_function_handle () +%!error is_function_handle (1, 2) +*/ + +octave_fcn_binder::octave_fcn_binder (const octave_value& f, + const octave_value& root, + const octave_value_list& templ, + const std::vector& mask, + int exp_nargin) +: octave_fcn_handle (f), root_handle (root), arg_template (templ), + arg_mask (mask), expected_nargin (exp_nargin) +{ +} + +octave_fcn_handle * +octave_fcn_binder::maybe_binder (const octave_value& f) +{ + octave_fcn_handle *retval = 0; + + octave_user_function *usr_fcn = f.user_function_value (false); + tree_parameter_list *param_list = usr_fcn ? usr_fcn->parameter_list () : 0; + + // Verify that the body is a single expression (always true in theory). + + tree_statement_list *cmd_list = usr_fcn ? usr_fcn->body () : 0; + tree_expression *body_expr = (cmd_list->length () == 1 + ? cmd_list->front ()->expression () : 0); + + + if (body_expr && body_expr->is_index_expression () + && ! (param_list && param_list->takes_varargs ())) + { + // It's an index expression. + tree_index_expression *idx_expr = dynamic_cast (body_expr); + tree_expression *head_expr = idx_expr->expression (); + std::list arg_lists = idx_expr->arg_lists (); + std::string type_tags = idx_expr->type_tags (); + + if (type_tags.length () == 1 && type_tags[0] == '(' + && head_expr->is_identifier ()) + { + assert (arg_lists.size () == 1); + + // It's a single index expression: a(x,y,....) + tree_identifier *head_id = dynamic_cast (head_expr); + tree_argument_list *arg_list = arg_lists.front (); + + // Build a map of input params to their position. + std::map arginmap; + int npar = 0; + + if (param_list) + { + for (tree_parameter_list::iterator it = param_list->begin (); + it != param_list->end (); ++it, ++npar) + { + tree_decl_elt *elt = *it; + tree_identifier *id = elt ? elt->ident () : 0; + if (id && ! id->is_black_hole ()) + arginmap[id->name ()] = npar; + } + } + + if (arg_list && arg_list->length () > 0) + { + bool bad = false; + int nargs = arg_list->length (); + octave_value_list arg_template (nargs); + std::vector arg_mask (nargs); + + // Verify that each argument is either a named param, a constant, or a defined identifier. + int iarg = 0; + for (tree_argument_list::iterator it = arg_list->begin (); + it != arg_list->end (); ++it, ++iarg) + { + tree_expression *elt = *it; + if (elt && elt->is_constant ()) + { + arg_template(iarg) = elt->rvalue1 (); + arg_mask[iarg] = -1; + } + else if (elt && elt->is_identifier ()) + { + tree_identifier *elt_id = dynamic_cast (elt); + if (arginmap.find (elt_id->name ()) != arginmap.end ()) + { + arg_mask[iarg] = arginmap[elt_id->name ()]; + } + else if (elt_id->is_defined ()) + { + arg_template(iarg) = elt_id->rvalue1 (); + arg_mask[iarg] = -1; + } + else + { + bad = true; + break; + } + } + else + { + bad = true; + break; + } + } + + octave_value root_val; + + if (! bad) + { + // If the head is a value, use it as root. + if (head_id->is_defined ()) + root_val = head_id->rvalue1 (); + else + { + // It's a name. + std::string head_name = head_id->name (); + // Function handles can't handle legacy dispatch, so + // we make sure it's not defined. + if (symbol_table::get_dispatch (head_name).size () > 0) + bad = true; + else + { + // Simulate try/catch. + unwind_protect frame; + interpreter_try (frame); + + root_val = make_fcn_handle (head_name); + if (error_state) + bad = true; + } + } + } + + if (! bad) + { + // Stash proper name tags. + std::list arg_names = idx_expr->arg_names (); + assert (arg_names.size () == 1); + arg_template.stash_name_tags (arg_names.front ()); + + retval = new octave_fcn_binder (f, root_val, arg_template, + arg_mask, npar); + } + } + } + } + + if (! retval) + retval = new octave_fcn_handle (f, octave_fcn_handle::anonymous); + + return retval; +} + +octave_value_list +octave_fcn_binder::do_multi_index_op (int nargout, + const octave_value_list& args) +{ + return do_multi_index_op (nargout, args, 0); +} + +octave_value_list +octave_fcn_binder::do_multi_index_op (int nargout, + const octave_value_list& args, + const std::list* lvalue_list) +{ + octave_value_list retval; + + if (args.length () == expected_nargin) + { + for (int i = 0; i < arg_template.length (); i++) + { + int j = arg_mask[i]; + if (j >= 0) + arg_template(i) = args(j); // May force a copy... + } + + // Make a shallow copy of arg_template, to ensure consistency throughout the following + // call even if we happen to get back here. + octave_value_list tmp (arg_template); + retval = root_handle.do_multi_index_op (nargout, tmp, lvalue_list); + } + else + retval = octave_fcn_handle::do_multi_index_op (nargout, args, lvalue_list); + + return retval; +} + +/* +%!function r = __f (g, i) +%! r = g(i); +%!endfunction +%!test +%! x = [1,2;3,4]; +%! assert (__f (@(i) x(:,i), 1), [1;3]); +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-fcn-handle.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-fcn-handle.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,219 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_fcn_handle_h) +#define octave_fcn_handle_h 1 + +#include +#include +#include + +#include "oct-alloc.h" + +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-fcn.h" +#include "ov-typeinfo.h" + +// Function handles. + +class +OCTINTERP_API +octave_fcn_handle : public octave_base_value +{ +private: + + typedef std::map str_ov_map; + +public: + + static const std::string anonymous; + + octave_fcn_handle (void) + : fcn (), nm (), has_overloads (false), overloads () { } + + octave_fcn_handle (const std::string& n) + : fcn (), nm (n), has_overloads (false), overloads () { } + + octave_fcn_handle (const octave_value& f, const std::string& n = anonymous); + + octave_fcn_handle (const octave_fcn_handle& fh) + : octave_base_value (fh), fcn (fh.fcn), nm (fh.nm), + has_overloads (fh.has_overloads), overloads () + { + for (int i = 0; i < btyp_num_types; i++) + builtin_overloads[i] = fh.builtin_overloads[i]; + + overloads = fh.overloads; + } + + ~octave_fcn_handle (void) { } + + octave_base_value *clone (void) const { return new octave_fcn_handle (*this); } + octave_base_value *empty_clone (void) const { return new octave_fcn_handle (); } + + octave_value subsref (const std::string& type, + const std::list& idx) + { + octave_value_list tmp = subsref (type, idx, 1); + return tmp.length () > 0 ? tmp(0) : octave_value (); + } + + octave_value_list subsref (const std::string& type, + const std::list& idx, + int nargout); + + octave_value_list subsref (const std::string& type, + const std::list& idx, + int nargout, const std::list* lvalue_list); + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& args); + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& args, + const std::list* lvalue_list); + + bool is_defined (void) const { return true; } + + bool is_function_handle (void) const { return true; } + + builtin_type_t builtin_type (void) const { return btyp_func_handle; } + + bool is_overloaded (void) const { return has_overloads; } + + dim_vector dims (void) const { static dim_vector dv (1, 1); return dv; } + + octave_function *function_value (bool = false) + { return fcn.function_value (); } + + octave_user_function *user_function_value (bool = false) + { return fcn.user_function_value (); } + + octave_fcn_handle *fcn_handle_value (bool = false) { return this; } + + octave_value fcn_val (void) const { return fcn; } + + std::string fcn_name (void) const { return nm; } + + void set_overload (builtin_type_t btyp, const octave_value& ov_fcn) + { + if (btyp != btyp_unknown) + { + has_overloads = true; + builtin_overloads[btyp] = ov_fcn; + } + + } + + void set_overload (const std::string& dispatch_type, const octave_value& ov_fcn) + { + has_overloads = true; + overloads[dispatch_type] = ov_fcn; + } + + bool is_equal_to (const octave_fcn_handle&) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + // Simple function handles are printed without a newline. + bool print_as_scalar (void) const { return nm != anonymous; } + +private: + + bool set_fcn (const std::string &octaveroot, const std::string& fpath); + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA + +protected: + + // The function we are handling. + octave_value fcn; + + // The name of the handle, including the "@". + std::string nm; + + // Whether the function is overloaded at all. + bool has_overloads; + + // Overloads for builtin types. We use array to make lookup faster. + octave_value builtin_overloads[btyp_num_types]; + + // Overloads for other classes. + str_ov_map overloads; + + friend octave_value make_fcn_handle (const std::string &, bool); +}; + +extern octave_value make_fcn_handle (const std::string& nm, + bool local_funcs = true); + +class +OCTINTERP_API +octave_fcn_binder : public octave_fcn_handle +{ +private: + // Private ctor. + octave_fcn_binder (const octave_value& f, const octave_value& root, + const octave_value_list& templ, + const std::vector& mask, int exp_nargin); + +public: + + // Factory method. + static octave_fcn_handle *maybe_binder (const octave_value& f); + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& args); + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& args, + const std::list* lvalue_list); + +protected: + + octave_value root_handle; + octave_value_list arg_template; + std::vector arg_mask; + int expected_nargin; +}; +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-fcn-inline.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-fcn-inline.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1019 @@ +/* + +Copyright (C) 2004-2012 David Bateman + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +In addition to the terms of the GPL, you are permitted to link +this program with any Open Source program, as defined by the +Open Source Initiative (www.opensource.org) + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include + +#include "oct-locbuf.h" + +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "oct-map.h" +#include "ov-base.h" +#include "ov-fcn-inline.h" +#include "ov-usr-fcn.h" +#include "pr-output.h" +#include "variables.h" +#include "parse.h" +#include "toplev.h" + +#include "byte-swap.h" +#include "ls-ascii-helper.h" +#include "ls-oct-ascii.h" +#include "ls-hdf5.h" +#include "ls-utils.h" + +DEFINE_OCTAVE_ALLOCATOR (octave_fcn_inline); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_fcn_inline, + "inline function", + "function_handle"); + +octave_fcn_inline::octave_fcn_inline (const std::string& f, + const string_vector& a, + const std::string& n) + : octave_fcn_handle (n), iftext (f), ifargs (a) +{ + // Form a string representing the function. + + std::ostringstream buf; + + buf << "@("; + + for (int i = 0; i < ifargs.length (); i++) + { + if (i > 0) + buf << ", "; + + buf << ifargs(i); + } + + buf << ") " << iftext; + + int parse_status; + octave_value anon_fcn_handle = eval_string (buf.str (), true, parse_status); + + if (parse_status == 0) + { + octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value (); + + if (fh) + { + fcn = fh->fcn_val (); + + octave_user_function *uf = fcn.user_function_value (); + + if (uf) + { + octave_function *curr_fcn = octave_call_stack::current (); + + if (curr_fcn) + { + symbol_table::scope_id parent_scope + = curr_fcn->parent_fcn_scope (); + + if (parent_scope < 0) + parent_scope = curr_fcn->scope (); + + uf->stash_parent_fcn_scope (parent_scope); + } + } + } + } + + if (fcn.is_undefined ()) + error ("inline: unable to define function"); +} + +// This function is supplied to allow a Matlab style class structure +// to be returned.. +octave_map +octave_fcn_inline::map_value (void) const +{ + octave_scalar_map m; + + m.assign ("version", 1.0); + m.assign ("isEmpty", 0.0); + m.assign ("expr", fcn_text ()); + + string_vector args = fcn_arg_names (); + + m.assign ("numArgs", args.length ()); + m.assign ("args", args); + + std::ostringstream buf; + + for (int i = 0; i < args.length (); i++) + buf << args(i) << " = INLINE_INPUTS_{" << i + 1 << "}; "; + + m.assign ("inputExpr", buf.str ()); + + return m; +} + +bool +octave_fcn_inline::save_ascii (std::ostream& os) +{ + os << "# nargs: " << ifargs.length () << "\n"; + for (int i = 0; i < ifargs.length (); i++) + os << ifargs(i) << "\n"; + if (nm.length () < 1) + // Write an invalid value to flag empty fcn handle name. + os << "0\n"; + else + os << nm << "\n"; + os << iftext << "\n"; + return true; +} + +bool +octave_fcn_inline::load_ascii (std::istream& is) +{ + int nargs; + if (extract_keyword (is, "nargs", nargs, true)) + { + ifargs.resize (nargs); + for (int i = 0; i < nargs; i++) + is >> ifargs(i); + is >> nm; + if (nm == "0") + nm = ""; + + skip_preceeding_newline (is); + + std::string buf; + + if (is) + { + + // Get a line of text whitespace characters included, + // leaving newline in the stream. + buf = read_until_newline (is, true); + } + + iftext = buf; + + octave_fcn_inline tmp (iftext, ifargs, nm); + fcn = tmp.fcn; + + return true; + } + else + return false; +} + +bool +octave_fcn_inline::save_binary (std::ostream& os, bool&) +{ + int32_t tmp = ifargs.length (); + os.write (reinterpret_cast (&tmp), 4); + for (int i = 0; i < ifargs.length (); i++) + { + tmp = ifargs(i).length (); + os.write (reinterpret_cast (&tmp), 4); + os.write (ifargs(i).c_str (), ifargs(i).length ()); + } + tmp = nm.length (); + os.write (reinterpret_cast (&tmp), 4); + os.write (nm.c_str (), nm.length ()); + tmp = iftext.length (); + os.write (reinterpret_cast (&tmp), 4); + os.write (iftext.c_str (), iftext.length ()); + return true; +} + +bool +octave_fcn_inline::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format) +{ + int32_t nargs; + if (! is.read (reinterpret_cast (&nargs), 4)) + return false; + if (swap) + swap_bytes<4> (&nargs); + + if (nargs < 1) + return false; + else + { + int32_t tmp; + ifargs.resize (nargs); + for (int i = 0; i < nargs; i++) + { + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + if (swap) + swap_bytes<4> (&tmp); + + OCTAVE_LOCAL_BUFFER (char, ctmp, tmp+1); + is.read (ctmp, tmp); + ifargs(i) = std::string (ctmp); + + if (! is) + return false; + } + + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + if (swap) + swap_bytes<4> (&tmp); + + OCTAVE_LOCAL_BUFFER (char, ctmp1, tmp+1); + is.read (ctmp1, tmp); + nm = std::string (ctmp1); + + if (! is) + return false; + + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + if (swap) + swap_bytes<4> (&tmp); + + OCTAVE_LOCAL_BUFFER (char, ctmp2, tmp+1); + is.read (ctmp2, tmp); + iftext = std::string (ctmp2); + + if (! is) + return false; + + octave_fcn_inline ftmp (iftext, ifargs, nm); + fcn = ftmp.fcn; + } + return true; +} + +#if defined (HAVE_HDF5) +bool +octave_fcn_inline::save_hdf5 (hid_t loc_id, const char *name, + bool /* save_as_floats */) +{ + hid_t group_hid = -1; +#if HAVE_HDF5_18 + group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + group_hid = H5Gcreate (loc_id, name, 0); +#endif + if (group_hid < 0 ) return false; + + size_t len = 0; + for (int i = 0; i < ifargs.length (); i++) + if (len < ifargs(i).length ()) + len = ifargs(i).length (); + + hid_t space_hid = -1, data_hid = -1, type_hid = -1;; + bool retval = true; + + // FIXME Is there a better way of saving string vectors, than a + // null padded matrix? + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, 2); + + // Octave uses column-major, while HDF5 uses row-major ordering + hdims[1] = ifargs.length (); + hdims[0] = len + 1; + + space_hid = H5Screate_simple (2, hdims, 0); + if (space_hid < 0) + { + H5Gclose (group_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "args", H5T_NATIVE_CHAR, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "args", H5T_NATIVE_CHAR, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (char, s, ifargs.length () * (len + 1)); + + // Save the args as a null teminated list + for (int i = 0; i < ifargs.length (); i++) + { + const char * cptr = ifargs(i).c_str (); + for (size_t j = 0; j < ifargs(i).length (); j++) + s[i*(len+1)+j] = *cptr++; + s[ifargs(i).length ()] = '\0'; + } + + retval = H5Dwrite (data_hid, H5T_NATIVE_CHAR, H5S_ALL, H5S_ALL, + H5P_DEFAULT, s) >= 0; + + H5Dclose (data_hid); + H5Sclose (space_hid); + + if (!retval) + { + H5Gclose (group_hid); + return false; + } + + // attach the type of the variable + type_hid = H5Tcopy (H5T_C_S1); + H5Tset_size (type_hid, nm.length () + 1); + if (type_hid < 0) + { + H5Gclose (group_hid); + return false; + } + + hdims[0] = 0; + space_hid = H5Screate_simple (0 , hdims, 0); + if (space_hid < 0) + { + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "nm", type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "nm", type_hid, space_hid, H5P_DEFAULT); +#endif + if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, + H5P_DEFAULT, nm.c_str ()) < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + H5Dclose (data_hid); + + // attach the type of the variable + H5Tset_size (type_hid, iftext.length () + 1); + if (type_hid < 0) + { + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "iftext", type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "iftext", type_hid, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, + H5P_DEFAULT, iftext.c_str ()) < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + + return retval; +} + +bool +octave_fcn_inline::load_hdf5 (hid_t loc_id, const char *name) +{ + hid_t group_hid, data_hid, space_hid, type_hid, type_class_hid, st_id; + hsize_t rank; + int slen; + +#if HAVE_HDF5_18 + group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); +#else + group_hid = H5Gopen (loc_id, name); +#endif + if (group_hid < 0 ) return false; + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "args", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "args"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 2) + { + H5Dclose (data_hid); + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + ifargs.resize (hdims[1]); + + OCTAVE_LOCAL_BUFFER (char, s1, hdims[0] * hdims[1]); + + if (H5Dread (data_hid, H5T_NATIVE_UCHAR, H5S_ALL, H5S_ALL, + H5P_DEFAULT, s1) < 0) + { + H5Dclose (data_hid); + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + H5Sclose (space_hid); + + for (size_t i = 0; i < hdims[1]; i++) + ifargs(i) = std::string (s1 + i*hdims[0]); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "nm", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "nm"); +#endif + + if (data_hid < 0) + { + H5Gclose (group_hid); + return false; + } + + type_hid = H5Dget_type (data_hid); + type_class_hid = H5Tget_class (type_hid); + + if (type_class_hid != H5T_STRING) + { + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + slen = H5Tget_size (type_hid); + if (slen < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (char, nm_tmp, slen); + + // create datatype for (null-terminated) string to read into: + st_id = H5Tcopy (H5T_C_S1); + H5Tset_size (st_id, slen); + + if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, nm_tmp) < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + H5Tclose (st_id); + H5Dclose (data_hid); + nm = nm_tmp; + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "iftext", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "iftext"); +#endif + + if (data_hid < 0) + { + H5Gclose (group_hid); + return false; + } + + type_hid = H5Dget_type (data_hid); + type_class_hid = H5Tget_class (type_hid); + + if (type_class_hid != H5T_STRING) + { + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + slen = H5Tget_size (type_hid); + if (slen < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (char, iftext_tmp, slen); + + // create datatype for (null-terminated) string to read into: + st_id = H5Tcopy (H5T_C_S1); + H5Tset_size (st_id, slen); + + if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, iftext_tmp) < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + H5Gclose (group_hid); + return false; + } + H5Tclose (st_id); + H5Dclose (data_hid); + iftext = iftext_tmp; + + octave_fcn_inline ftmp (iftext, ifargs, nm); + fcn = ftmp.fcn; + + return true; +} +#endif + +void +octave_fcn_inline::print (std::ostream& os, bool pr_as_read_syntax) const +{ + print_raw (os, pr_as_read_syntax); + newline (os); +} + +void +octave_fcn_inline::print_raw (std::ostream& os, bool pr_as_read_syntax) const +{ + std::ostringstream buf; + + if (nm.empty ()) + buf << "f("; + else + buf << nm << "("; + + for (int i = 0; i < ifargs.length (); i++) + { + if (i) + buf << ", "; + + buf << ifargs(i); + } + + buf << ") = " << iftext; + + octave_print_internal (os, buf.str (), pr_as_read_syntax, + current_print_indent_level ()); +} + +octave_value +octave_fcn_inline::convert_to_str_internal (bool, bool, char type) const +{ + return octave_value (fcn_text (), type); +} + +DEFUNX ("inline", Finline, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} inline (@var{str})\n\ +@deftypefnx {Built-in Function} {} inline (@var{str}, @var{arg1}, @dots{})\n\ +@deftypefnx {Built-in Function} {} inline (@var{str}, @var{n})\n\ +Create an inline function from the character string @var{str}.\n\ +If called with a single argument, the arguments of the generated\n\ +function are extracted from the function itself. The generated\n\ +function arguments will then be in alphabetical order. It should\n\ +be noted that i, and j are ignored as arguments due to the\n\ +ambiguity between their use as a variable or their use as an inbuilt\n\ +constant. All arguments followed by a parenthesis are considered\n\ +to be functions.\n\ +\n\ +If the second and subsequent arguments are character strings,\n\ +they are the names of the arguments of the function.\n\ +\n\ +If the second argument is an integer @var{n}, the arguments are\n\ +@code{\"x\"}, @code{\"P1\"}, @dots{}, @code{\"P@var{N}\"}.\n\ +@seealso{argnames, formula, vectorize}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin > 0) + { + if (args(0).is_string ()) + { + std::string fun = args(0).string_value (); + string_vector fargs; + + if (nargin == 1) + { + bool is_arg = false; + bool in_string = false; + std::string tmp_arg; + size_t i = 0; + size_t fun_length = fun.length (); + + while (i < fun_length) + { + bool terminate_arg = false; + char c = fun[i++]; + + if (in_string) + { + if (c == '\'' || c == '\"') + in_string = false; + } + else if (c == '\'' || c == '\"') + { + in_string = true; + if (is_arg) + terminate_arg = true; + } + else if (! isalpha (c) && c != '_') + if (! is_arg) + continue; + else if (isdigit (c)) + tmp_arg.append (1, c); + else + { + // Before we do anything remove trailing whitespaces. + while (i < fun_length && isspace (c)) + c = fun[i++]; + + // Do we have a variable or a function? + if (c != '(') + terminate_arg = true; + else + { + tmp_arg = std::string (); + is_arg = false; + } + } + else if (! is_arg) + { + if (c == 'e' || c == 'E') + { + // possible number in exponent form, not arg + if (isdigit (fun[i]) + || fun[i] == '-' || fun[i] == '+') + continue; + } + is_arg = true; + tmp_arg.append (1, c); + } + else + { + tmp_arg.append (1, c); + } + + if (terminate_arg || (i == fun_length && is_arg)) + { + bool have_arg = false; + + for (int j = 0; j < fargs.length (); j++) + if (tmp_arg == fargs (j)) + { + have_arg = true; + break; + } + + if (! have_arg && tmp_arg != "i" && tmp_arg != "j" && + tmp_arg != "NaN" && tmp_arg != "nan" && + tmp_arg != "Inf" && tmp_arg != "inf" && + tmp_arg != "NA" && tmp_arg != "pi" && + tmp_arg != "e" && tmp_arg != "eps") + fargs.append (tmp_arg); + + tmp_arg = std::string (); + is_arg = false; + } + } + + // Sort the arguments into ascii order. + fargs.sort (); + } + else if (nargin == 2 && args(1).is_numeric_type ()) + { + if (! args(1).is_scalar_type ()) + { + error ("inline: N must be an integer"); + return retval; + } + + int n = args(1).int_value (); + + if (! error_state) + { + if (n >= 0) + { + fargs.resize (n+1); + + fargs(0) = "x"; + + for (int i = 1; i < n+1; i++) + { + std::ostringstream buf; + buf << "P" << i; + fargs(i) = buf.str (); + } + } + else + { + error ("inline: N must be a positive integer or zero"); + return retval; + } + } + else + { + error ("inline: N must be an integer"); + return retval; + } + } + else + { + fargs.resize (nargin - 1); + + for (int i = 1; i < nargin; i++) + { + if (args(i).is_string ()) + { + std::string s = args(i).string_value (); + fargs(i-1) = s; + } + else + { + error ("inline: expecting string arguments"); + return retval; + } + } + } + + retval = octave_value (new octave_fcn_inline (fun, fargs)); + } + else + error ("inline: STR argument must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!shared fn +%! fn = inline ("x.^2 + 1"); +%!assert (feval (fn, 6), 37) +%!assert (fn (6), 37) +## FIXME: Need tests for other 2 calling forms of inline() + +## Test input validation +%!error inline () +%!error inline (1) +%!error inline ("2", ones (2,2)) +%!error inline ("2", -1) +%!error inline ("2", "x", -1, "y") +*/ + +DEFUN (formula, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} formula (@var{fun})\n\ +Return a character string representing the inline function @var{fun}.\n\ +Note that @code{char (@var{fun})} is equivalent to\n\ +@code{formula (@var{fun})}.\n\ +@seealso{argnames, inline, vectorize}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_fcn_inline* fn = args(0).fcn_inline_value (true); + + if (fn) + retval = octave_value (fn->fcn_text ()); + else + error ("formula: FUN must be an inline function"); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (formula (fn), "x.^2 + 1") +%!assert (formula (fn), char (fn)) + +## Test input validation +%!error formula () +%!error formula (1, 2) +%!error formula (1) +*/ + +DEFUN (argnames, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} argnames (@var{fun})\n\ +Return a cell array of character strings containing the names of\n\ +the arguments of the inline function @var{fun}.\n\ +@seealso{inline, formula, vectorize}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_fcn_inline *fn = args(0).fcn_inline_value (true); + + if (fn) + { + string_vector t1 = fn->fcn_arg_names (); + + Cell t2 (dim_vector (t1.length (), 1)); + + for (int i = 0; i < t1.length (); i++) + t2(i) = t1(i); + + retval = t2; + } + else + error ("argnames: FUN must be an inline function"); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (argnames (fn), {"x"}) +%!assert (argnames (inline ("1e-3*y + 2e4*z")), {"y"; "z"}) +%!assert (argnames (inline ("2", 2)), {"x"; "P1"; "P2"}) + +## Test input validation +%!error argnames () +%!error argnames (1, 2) +%!error argnames (1) +*/ + +DEFUN (vectorize, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} vectorize (@var{fun})\n\ +Create a vectorized version of the inline function @var{fun}\n\ +by replacing all occurrences of @code{*}, @code{/}, etc., with\n\ +@code{.*}, @code{./}, etc.\n\ +\n\ +This may be useful, for example, when using inline functions with\n\ +numerical integration or optimization where a vector-valued function\n\ +is expected.\n\ +\n\ +@example\n\ +@group\n\ +fcn = vectorize (inline (\"x^2 - 1\"))\n\ + @result{} fcn = f(x) = x.^2 - 1\n\ +quadv (fcn, 0, 3)\n\ + @result{} 6\n\ +@end group\n\ +@end example\n\ +@seealso{inline, formula, argnames}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + std::string old_func; + octave_fcn_inline* old = 0; + bool func_is_string = true; + + if (args(0).is_string ()) + old_func = args(0).string_value (); + else + { + old = args(0).fcn_inline_value (true); + func_is_string = false; + + if (old) + old_func = old->fcn_text (); + else + error ("vectorize: FUN must be a string or inline function"); + } + + if (! error_state) + { + std::string new_func; + size_t i = 0; + + while (i < old_func.length ()) + { + std::string t1 = old_func.substr (i, 1); + + if (t1 == "*" || t1 == "/" || t1 == "\\" || t1 == "^") + { + if (i && old_func.substr (i-1, 1) != ".") + new_func.append ("."); + + // Special case for ** operator. + if (t1 == "*" && i < (old_func.length () - 1) + && old_func.substr (i+1, 1) == "*") + { + new_func.append ("*"); + i++; + } + } + new_func.append (t1); + i++; + } + + if (func_is_string) + retval = octave_value (new_func); + else + retval = octave_value (new octave_fcn_inline + (new_func, old->fcn_arg_names ())); + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (char (vectorize (fn)), "x.^2 + 1") +%!assert (char (vectorize (inline ("1e-3*y + 2e4*z"))), "1e-3.*y + 2e4.*z") +%!assert (char (vectorize (inline ("2**x^5"))), "2.**x.^5") +%!assert (vectorize ("x.^2 + 1"), "x.^2 + 1") +%!assert (vectorize ("1e-3*y + 2e4*z"), "1e-3.*y + 2e4.*z") +%!assert (vectorize ("2**x^5"), "2.**x.^5") + +## Test input validation +%!error vectorize () +%!error vectorize (1, 2) +%!error vectorize (1) +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-fcn-inline.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-fcn-inline.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,104 @@ +/* + +Copyright (C) 2004-2012 David Bateman + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_fcn_inline_h) +#define octave_fcn_inline_h 1 + +#include +#include + +#include "oct-alloc.h" + +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-fcn.h" +#include "ov-typeinfo.h" +#include "symtab.h" +#include "ov-fcn-handle.h" + +// Inline functions. + +class +OCTINTERP_API +octave_fcn_inline : public octave_fcn_handle +{ +public: + + octave_fcn_inline (void) + : octave_fcn_handle (), iftext (), ifargs () { } + + octave_fcn_inline (const std::string& f, const string_vector& a, + const std::string& n = std::string ()); + + octave_fcn_inline (const octave_fcn_inline& fi) + : octave_fcn_handle (fi), iftext (fi.iftext), ifargs (fi.ifargs) { } + + ~octave_fcn_inline (void) { } + + octave_base_value *clone (void) const { return new octave_fcn_inline (*this); } + octave_base_value *empty_clone (void) const { return new octave_fcn_inline (); } + + bool is_inline_function (void) const { return true; } + + octave_fcn_inline *fcn_inline_value (bool = false) { return this; } + + std::string fcn_text (void) const { return iftext; } + + string_vector fcn_arg_names (void) const { return ifargs; } + + octave_value convert_to_str_internal (bool, bool, char) const; + + octave_map map_value (void) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA + + // The expression of an inline function. + std::string iftext; + + // The args of an inline function. + string_vector ifargs; +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-fcn.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-fcn.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,45 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "oct-obj.h" +#include "ov-fcn.h" + +DEFINE_OCTAVE_ALLOCATOR (octave_function); + +octave_base_value * +octave_function::clone (void) const +{ + panic_impossible (); + return 0; +} + +octave_base_value * +octave_function::empty_clone (void) const +{ + panic_impossible (); + return 0; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-fcn.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-fcn.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,193 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_function_h) +#define octave_function_h 1 + +#include + +#include "oct-time.h" +#include "str-vec.h" + +#include "oct-alloc.h" +#include "oct-obj.h" +#include "ov-base.h" +#include "ov-typeinfo.h" +#include "symtab.h" + +class tree_walker; + +// Functions. + +class +OCTINTERP_API +octave_function : public octave_base_value +{ +public: + + octave_function (void) + : relative (false), locked (false), private_function (false), + xdispatch_class (), my_name (), my_dir_name (), doc () { } + + ~octave_function (void) { } + + octave_base_value *clone (void) const; + octave_base_value *empty_clone (void) const; + + bool is_defined (void) const { return true; } + + bool is_function (void) const { return true; } + + virtual bool is_system_fcn_file (void) const { return false; } + + virtual std::string fcn_file_name (void) const { return std::string (); } + + virtual std::string src_file_name (void) const { return std::string (); } + + // The name to show in the profiler (also used as map-key). + virtual std::string profiler_name (void) const { return name (); } + + virtual std::string parent_fcn_name (void) const { return std::string (); } + + virtual symbol_table::scope_id parent_fcn_scope (void) const { return -1; } + + virtual void mark_fcn_file_up_to_date (const octave_time&) { } + + virtual symbol_table::scope_id scope (void) { return -1; } + + virtual octave_time time_parsed (void) const + { return octave_time (static_cast (0)); } + + virtual octave_time time_checked (void) const + { return octave_time (static_cast (0)); } + + virtual bool is_subfunction (void) const { return false; } + + virtual bool is_class_constructor (const std::string& = std::string ()) const + { return false; } + + virtual bool is_class_method (const std::string& = std::string ()) const + { return false; } + + virtual bool takes_varargs (void) const { return false; } + + virtual bool takes_var_return (void) const { return false; } + + void stash_dispatch_class (const std::string& nm) { xdispatch_class = nm; } + + std::string dispatch_class (void) const { return xdispatch_class; } + + virtual void + mark_as_private_function (const std::string& cname = std::string ()) + { + private_function = true; + xdispatch_class = cname; + } + + bool is_private_function (void) const { return private_function; } + + bool is_private_function_of_class (const std::string& nm) const + { return private_function && xdispatch_class == nm; } + + virtual bool + is_anonymous_function_of_class (const std::string& = std::string ()) const + { return false; } + + std::string dir_name (void) const { return my_dir_name; } + + void stash_dir_name (const std::string& dir) { my_dir_name = dir; } + + void lock (void) + { + this->lock_subfunctions (); + locked = true; + } + + void unlock (void) + { + this->unlock_subfunctions (); + locked = false; + } + + bool islocked (void) const { return locked; } + + virtual void lock_subfunctions (void) { } + + virtual void unlock_subfunctions (void) { } + + void mark_relative (void) { relative = true; } + + bool is_relative (void) const { return relative; } + + std::string name (void) const { return my_name; } + + void document (const std::string& ds) { doc = ds; } + + std::string doc_string (void) const { return doc; } + + virtual void unload (void) { } + + virtual void accept (tree_walker&) { } + +protected: + + octave_function (const std::string& nm, + const std::string& ds = std::string ()) + : relative (false), locked (false), private_function (false), + xdispatch_class (), my_name (nm), my_dir_name (), doc (ds) { } + + // TRUE if this function was found from a relative path element. + bool relative; + + // TRUE if this function is tagged so that it can't be cleared. + bool locked; + + // TRUE means this is a private function. + bool private_function; + + // If this object is a class method or constructor, or a private + // function inside a class directory, this is the name of the class + // to which the method belongs. + std::string xdispatch_class; + + // The name of this function. + std::string my_name; + + // The name of the directory in the path where we found this + // function. May be relative. + std::string my_dir_name; + + // The help text for this function. + std::string doc; + +private: + + // No copying! + + octave_function (const octave_function& f); + + octave_function& operator = (const octave_function& f); + + DECLARE_OCTAVE_ALLOCATOR +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-float.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-float.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,346 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "data-conv.h" +#include "mach-info.h" +#include "lo-specfun.h" +#include "lo-mappers.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-stream.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-base.h" +#include "ov-base-scalar.h" +#include "ov-base-scalar.cc" +#include "ov-flt-re-mat.h" +#include "ov-typeinfo.h" +#include "pr-output.h" +#include "xdiv.h" +#include "xpow.h" +#include "ops.h" + +#include "ls-oct-ascii.h" +#include "ls-hdf5.h" + +template class octave_base_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_float_scalar); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_scalar, "float scalar", "single"); + +octave_value +octave_float_scalar::do_index_op (const octave_value_list& idx, bool resize_ok) +{ + // FIXME -- this doesn't solve the problem of + // + // a = 1; a([1,1], [1,1], [1,1]) + // + // and similar constructions. Hmm... + + // FIXME -- using this constructor avoids narrowing the + // 1x1 matrix back to a scalar value. Need a better solution + // to this problem. + + octave_value tmp (new octave_float_matrix (float_matrix_value ())); + + return tmp.do_index_op (idx, resize_ok); +} + +octave_value +octave_float_scalar::resize (const dim_vector& dv, bool fill) const +{ + if (fill) + { + FloatNDArray retval (dv, 0); + + if (dv.numel ()) + retval(0) = scalar; + + return retval; + } + else + { + FloatNDArray retval (dv); + + if (dv.numel ()) + retval(0) = scalar; + + return retval; + } +} + +octave_value +octave_float_scalar::diag (octave_idx_type m, octave_idx_type n) const +{ + return FloatDiagMatrix (Array (dim_vector (1, 1), scalar), m, n); +} + +octave_value +octave_float_scalar::convert_to_str_internal (bool, bool, char type) const +{ + octave_value retval; + + if (xisnan (scalar)) + gripe_nan_to_character_conversion (); + else + { + int ival = NINT (scalar); + + if (ival < 0 || ival > UCHAR_MAX) + { + // FIXME -- is there something better we could do? + + ival = 0; + + ::warning ("range error for conversion to character value"); + } + + retval = octave_value (std::string (1, static_cast (ival)), type); + } + + return retval; +} + +bool +octave_float_scalar::save_ascii (std::ostream& os) +{ + float d = float_value (); + + octave_write_float (os, d); + + os << "\n"; + + return true; +} + +bool +octave_float_scalar::load_ascii (std::istream& is) +{ + scalar = octave_read_value (is); + if (!is) + { + error ("load: failed to load scalar constant"); + return false; + } + + return true; +} + +bool +octave_float_scalar::save_binary (std::ostream& os, bool& /* save_as_floats */) +{ + char tmp = LS_FLOAT; + os.write (reinterpret_cast (&tmp), 1); + float dtmp = float_value (); + os.write (reinterpret_cast (&dtmp), 4); + + return true; +} + +bool +octave_float_scalar::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + char tmp; + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + + float dtmp; + read_floats (is, &dtmp, static_cast (tmp), 1, swap, fmt); + if (error_state || ! is) + return false; + + scalar = dtmp; + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_float_scalar::save_hdf5 (hid_t loc_id, const char *name, + bool /* save_as_floats */) +{ + hsize_t dimens[3]; + hid_t space_hid = -1, data_hid = -1; + bool retval = true; + + space_hid = H5Screate_simple (0, dimens, 0); + if (space_hid < 0) return false; +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_FLOAT, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_FLOAT, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + return false; + } + + float tmp = float_value (); + retval = H5Dwrite (data_hid, H5T_NATIVE_FLOAT, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &tmp) >= 0; + + H5Dclose (data_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_float_scalar::load_hdf5 (hid_t loc_id, const char *name) +{ +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t space_id = H5Dget_space (data_hid); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank != 0) + { + H5Dclose (data_hid); + return false; + } + + float dtmp; + if (H5Dread (data_hid, H5T_NATIVE_FLOAT, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &dtmp) < 0) + { + H5Dclose (data_hid); + return false; + } + + scalar = dtmp; + + H5Dclose (data_hid); + + return true; +} + +#endif + +mxArray * +octave_float_scalar::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxSINGLE_CLASS, 1, 1, mxREAL); + + float *pr = static_cast (retval->get_data ()); + + pr[0] = scalar; + + return retval; +} + +octave_value +octave_float_scalar::map (unary_mapper_t umap) const +{ + switch (umap) + { + case umap_imag: + return 0.0f; + + case umap_real: + case umap_conj: + return scalar; + +#define SCALAR_MAPPER(UMAP, FCN) \ + case umap_ ## UMAP: \ + return octave_value (FCN (scalar)) + + SCALAR_MAPPER (abs, ::fabsf); + SCALAR_MAPPER (acos, rc_acos); + SCALAR_MAPPER (acosh, rc_acosh); + SCALAR_MAPPER (angle, ::arg); + SCALAR_MAPPER (arg, ::arg); + SCALAR_MAPPER (asin, rc_asin); + SCALAR_MAPPER (asinh, ::asinhf); + SCALAR_MAPPER (atan, ::atanf); + SCALAR_MAPPER (atanh, rc_atanh); + SCALAR_MAPPER (erf, ::erff); + SCALAR_MAPPER (erfinv, ::erfinv); + SCALAR_MAPPER (erfcinv, ::erfcinv); + SCALAR_MAPPER (erfc, ::erfcf); + SCALAR_MAPPER (erfcx, ::erfcx); + SCALAR_MAPPER (gamma, xgamma); + SCALAR_MAPPER (lgamma, rc_lgamma); + SCALAR_MAPPER (cbrt, ::cbrtf); + SCALAR_MAPPER (ceil, ::ceilf); + SCALAR_MAPPER (cos, ::cosf); + SCALAR_MAPPER (cosh, ::coshf); + SCALAR_MAPPER (exp, ::expf); + SCALAR_MAPPER (expm1, ::expm1f); + SCALAR_MAPPER (fix, ::fix); + SCALAR_MAPPER (floor, ::floorf); + SCALAR_MAPPER (log, rc_log); + SCALAR_MAPPER (log2, rc_log2); + SCALAR_MAPPER (log10, rc_log10); + SCALAR_MAPPER (log1p, rc_log1p); + SCALAR_MAPPER (round, xround); + SCALAR_MAPPER (roundb, xroundb); + SCALAR_MAPPER (signum, ::signum); + SCALAR_MAPPER (sin, ::sinf); + SCALAR_MAPPER (sinh, ::sinhf); + SCALAR_MAPPER (sqrt, rc_sqrt); + SCALAR_MAPPER (tan, ::tanf); + SCALAR_MAPPER (tanh, ::tanhf); + SCALAR_MAPPER (finite, xfinite); + SCALAR_MAPPER (isinf, xisinf); + SCALAR_MAPPER (isna, octave_is_NA); + SCALAR_MAPPER (isnan, xisnan); + + default: + return octave_base_value::map (umap); + } +} + +bool +octave_float_scalar::fast_elem_insert_self (void *where, builtin_type_t btyp) const +{ + + // Support inline real->complex conversion. + if (btyp == btyp_float) + { + *(reinterpret_cast(where)) = scalar; + return true; + } + else if (btyp == btyp_float_complex) + { + *(reinterpret_cast(where)) = scalar; + return true; + } + else + return false; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-float.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-float.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,258 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_float_h) +#define octave_float_h 1 + +#include + +#include +#include + +#include "lo-ieee.h" +#include "lo-mappers.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "gripes.h" +#include "ov-base.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-base-scalar.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +OCTINTERP_API +octave_float_scalar : public octave_base_scalar +{ +public: + + octave_float_scalar (void) + : octave_base_scalar (0.0) { } + + octave_float_scalar (float d) + : octave_base_scalar (d) { } + + octave_float_scalar (const octave_float_scalar& s) + : octave_base_scalar (s) { } + + ~octave_float_scalar (void) { } + + octave_base_value *clone (void) const { return new octave_float_scalar (*this); } + + // We return an octave_matrix here instead of an octave_float_scalar so + // that in expressions like A(2,2,2) = 2 (for A previously + // undefined), A will be empty instead of a 1x1 object. + octave_base_value *empty_clone (void) const { return new octave_float_matrix (); } + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + idx_vector index_vector (void) const { return idx_vector (scalar); } + + octave_value any (int = 0) const + { return (scalar != 0 && ! lo_ieee_isnan (scalar)); } + + builtin_type_t builtin_type (void) const { return btyp_float; } + + bool is_real_scalar (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_single_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + int8NDArray + int8_array_value (void) const + { return int8NDArray (dim_vector (1, 1), scalar); } + + int16NDArray + int16_array_value (void) const + { return int16NDArray (dim_vector (1, 1), scalar); } + + int32NDArray + int32_array_value (void) const + { return int32NDArray (dim_vector (1, 1), scalar); } + + int64NDArray + int64_array_value (void) const + { return int64NDArray (dim_vector (1, 1), scalar); } + + uint8NDArray + uint8_array_value (void) const + { return uint8NDArray (dim_vector (1, 1), scalar); } + + uint16NDArray + uint16_array_value (void) const + { return uint16NDArray (dim_vector (1, 1), scalar); } + + uint32NDArray + uint32_array_value (void) const + { return uint32NDArray (dim_vector (1, 1), scalar); } + + uint64NDArray + uint64_array_value (void) const + { return uint64NDArray (dim_vector (1, 1), scalar); } + +#define DEFINE_INT_SCALAR_VALUE(TYPE) \ + octave_ ## TYPE \ + TYPE ## _scalar_value (void) const \ + { return octave_ ## TYPE (scalar); } + + DEFINE_INT_SCALAR_VALUE (int8) + DEFINE_INT_SCALAR_VALUE (int16) + DEFINE_INT_SCALAR_VALUE (int32) + DEFINE_INT_SCALAR_VALUE (int64) + DEFINE_INT_SCALAR_VALUE (uint8) + DEFINE_INT_SCALAR_VALUE (uint16) + DEFINE_INT_SCALAR_VALUE (uint32) + DEFINE_INT_SCALAR_VALUE (uint64) + +#undef DEFINE_INT_SCALAR_VALUE + + double double_value (bool = false) const { return static_cast (scalar); } + + float float_value (bool = false) const { return scalar; } + + double scalar_value (bool = false) const { return static_cast (scalar); } + + float float_scalar_value (bool = false) const { return scalar; } + + Matrix matrix_value (bool = false) const + { return Matrix (1, 1, scalar); } + + FloatMatrix float_matrix_value (bool = false) const + { return FloatMatrix (1, 1, scalar); } + + NDArray array_value (bool = false) const + { return NDArray (dim_vector (1, 1), scalar); } + + FloatNDArray float_array_value (bool = false) const + { return FloatNDArray (dim_vector (1, 1), scalar); } + + SparseMatrix sparse_matrix_value (bool = false) const + { return SparseMatrix (Matrix (1, 1, scalar)); } + + // FIXME Need SparseComplexMatrix (Matrix) constructor!!! + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const + { return SparseComplexMatrix (sparse_matrix_value ()); } + + octave_value resize (const dim_vector& dv, bool fill = false) const; + + Complex complex_value (bool = false) const { return scalar; } + + FloatComplex float_complex_value (bool = false) const { return scalar; } + + ComplexMatrix complex_matrix_value (bool = false) const + { return ComplexMatrix (1, 1, Complex (scalar)); } + + FloatComplexMatrix float_complex_matrix_value (bool = false) const + { return FloatComplexMatrix (1, 1, FloatComplex (scalar)); } + + ComplexNDArray complex_array_value (bool = false) const + { return ComplexNDArray (dim_vector (1, 1), Complex (scalar)); } + + FloatComplexNDArray float_complex_array_value (bool = false) const + { return FloatComplexNDArray (dim_vector (1, 1), FloatComplex (scalar)); } + + charNDArray + char_array_value (bool = false) const + { + charNDArray retval (dim_vector (1, 1)); + retval(0) = static_cast (scalar); + return retval; + } + + bool bool_value (bool warn = false) const + { + if (xisnan (scalar)) + gripe_nan_to_logical_conversion (); + else if (warn && scalar != 0 && scalar != 1) + gripe_logical_conversion (); + + return scalar; + } + + boolNDArray bool_array_value (bool warn = false) const + { + if (xisnan (scalar)) + gripe_nan_to_logical_conversion (); + else if (warn && scalar != 0 && scalar != 1) + gripe_logical_conversion (); + + return boolNDArray (dim_vector (1, 1), scalar); + } + + octave_value diag (octave_idx_type m, octave_idx_type n) const; + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + + void increment (void) { ++scalar; } + + void decrement (void) { --scalar; } + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { + return os.write (array_value (), block_size, output_type, + skip, flt_fmt); + } + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const; + + bool fast_elem_insert_self (void *where, builtin_type_t btyp) const; + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-flt-complex.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-flt-complex.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,448 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "lo-ieee.h" +#include "lo-specfun.h" +#include "lo-mappers.h" + +#include "oct-obj.h" +#include "oct-stream.h" +#include "ops.h" +#include "ov-complex.h" +#include "ov-base.h" +#include "ov-base-scalar.h" +#include "ov-base-scalar.cc" +#include "ov-flt-cx-mat.h" +#include "ov-float.h" +#include "ov-flt-complex.h" +#include "gripes.h" +#include "pr-output.h" +#include "ops.h" + +#include "ls-oct-ascii.h" +#include "ls-hdf5.h" + +template class octave_base_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_float_complex); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_complex, + "float complex scalar", "single"); + +octave_base_value * +octave_float_complex::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + float im = std::imag (scalar); + + if (im == 0.0) + retval = new octave_float_scalar (std::real (scalar)); + + return retval; +} + +octave_value +octave_float_complex::do_index_op (const octave_value_list& idx, bool resize_ok) +{ + // FIXME -- this doesn't solve the problem of + // + // a = i; a([1,1], [1,1], [1,1]) + // + // and similar constructions. Hmm... + + // FIXME -- using this constructor avoids narrowing the + // 1x1 matrix back to a scalar value. Need a better solution + // to this problem. + + octave_value tmp (new octave_float_complex_matrix (float_complex_matrix_value ())); + + return tmp.do_index_op (idx, resize_ok); +} + +double +octave_float_complex::double_value (bool force_conversion) const +{ + double retval = lo_ieee_nan_value (); + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real scalar"); + + retval = std::real (scalar); + + return retval; +} + +float +octave_float_complex::float_value (bool force_conversion) const +{ + float retval = lo_ieee_float_nan_value (); + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real scalar"); + + retval = std::real (scalar); + + return retval; +} + +Matrix +octave_float_complex::matrix_value (bool force_conversion) const +{ + Matrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real matrix"); + + retval = Matrix (1, 1, std::real (scalar)); + + return retval; +} + +FloatMatrix +octave_float_complex::float_matrix_value (bool force_conversion) const +{ + FloatMatrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real matrix"); + + retval = FloatMatrix (1, 1, std::real (scalar)); + + return retval; +} + +NDArray +octave_float_complex::array_value (bool force_conversion) const +{ + NDArray retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real matrix"); + + retval = NDArray (dim_vector (1, 1), std::real (scalar)); + + return retval; +} + +FloatNDArray +octave_float_complex::float_array_value (bool force_conversion) const +{ + FloatNDArray retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex scalar", "real matrix"); + + retval = FloatNDArray (dim_vector (1, 1), std::real (scalar)); + + return retval; +} + +Complex +octave_float_complex::complex_value (bool) const +{ + return scalar; +} + +FloatComplex +octave_float_complex::float_complex_value (bool) const +{ + return static_cast (scalar); +} + +ComplexMatrix +octave_float_complex::complex_matrix_value (bool) const +{ + return ComplexMatrix (1, 1, scalar); +} + +FloatComplexMatrix +octave_float_complex::float_complex_matrix_value (bool) const +{ + return FloatComplexMatrix (1, 1, scalar); +} + +ComplexNDArray +octave_float_complex::complex_array_value (bool /* force_conversion */) const +{ + return ComplexNDArray (dim_vector (1, 1), scalar); +} + +FloatComplexNDArray +octave_float_complex::float_complex_array_value (bool /* force_conversion */) const +{ + return FloatComplexNDArray (dim_vector (1, 1), scalar); +} + +octave_value +octave_float_complex::resize (const dim_vector& dv, bool fill) const +{ + if (fill) + { + FloatComplexNDArray retval (dv, FloatComplex (0)); + + if (dv.numel ()) + retval(0) = scalar; + + return retval; + } + else + { + FloatComplexNDArray retval (dv); + + if (dv.numel ()) + retval(0) = scalar; + + return retval; + } +} + +octave_value +octave_float_complex::diag (octave_idx_type m, octave_idx_type n) const +{ + return FloatComplexDiagMatrix (Array (dim_vector (1, 1), scalar), m, n); +} + +bool +octave_float_complex::save_ascii (std::ostream& os) +{ + FloatComplex c = float_complex_value (); + + octave_write_float_complex (os, c); + + os << "\n"; + + return true; +} + +bool +octave_float_complex::load_ascii (std::istream& is) +{ + scalar = octave_read_value (is); + + if (!is) + { + error ("load: failed to load complex scalar constant"); + return false; + } + + return true; +} + + +bool +octave_float_complex::save_binary (std::ostream& os, bool& /* save_as_floats */) +{ + char tmp = static_cast (LS_FLOAT); + os.write (reinterpret_cast (&tmp), 1); + FloatComplex ctmp = float_complex_value (); + os.write (reinterpret_cast (&ctmp), 8); + + return true; +} + +bool +octave_float_complex::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + char tmp; + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + + FloatComplex ctmp; + read_floats (is, reinterpret_cast (&ctmp), + static_cast (tmp), 2, swap, fmt); + if (error_state || ! is) + return false; + + scalar = ctmp; + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_float_complex::save_hdf5 (hid_t loc_id, const char *name, + bool /* save_as_floats */) +{ + hsize_t dimens[3]; + hid_t space_hid = -1, type_hid = -1, data_hid = -1; + bool retval = true; + + space_hid = H5Screate_simple (0, dimens, 0); + if (space_hid < 0) + return false; + + type_hid = hdf5_make_complex_type (H5T_NATIVE_FLOAT); + if (type_hid < 0) + { + H5Sclose (space_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + return false; + } + + FloatComplex tmp = float_complex_value (); + retval = H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, H5P_DEFAULT, + &tmp) >= 0; + + H5Dclose (data_hid); + H5Tclose (type_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_float_complex::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t type_hid = H5Dget_type (data_hid); + + hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_FLOAT); + + if (! hdf5_types_compatible (type_hid, complex_type)) + { + H5Tclose (complex_type); + H5Dclose (data_hid); + return false; + } + + hid_t space_id = H5Dget_space (data_hid); + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank != 0) + { + H5Tclose (complex_type); + H5Sclose (space_id); + H5Dclose (data_hid); + return false; + } + + // complex scalar: + FloatComplex ctmp; + if (H5Dread (data_hid, complex_type, H5S_ALL, H5S_ALL, H5P_DEFAULT, + &ctmp) >= 0) + { + retval = true; + scalar = ctmp; + } + + H5Tclose (complex_type); + H5Sclose (space_id); + H5Dclose (data_hid); + + return retval; +} + +#endif + +mxArray * +octave_float_complex::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxSINGLE_CLASS, 1, 1, mxCOMPLEX); + + float *pr = static_cast (retval->get_data ()); + float *pi = static_cast (retval->get_imag_data ()); + + pr[0] = std::real (scalar); + pi[0] = std::imag (scalar); + + return retval; +} + +octave_value +octave_float_complex::map (unary_mapper_t umap) const +{ + switch (umap) + { +#define SCALAR_MAPPER(UMAP, FCN) \ + case umap_ ## UMAP: \ + return octave_value (FCN (scalar)) + + SCALAR_MAPPER (abs, std::abs); + SCALAR_MAPPER (acos, ::acos); + SCALAR_MAPPER (acosh, ::acosh); + SCALAR_MAPPER (angle, std::arg); + SCALAR_MAPPER (arg, std::arg); + SCALAR_MAPPER (asin, ::asin); + SCALAR_MAPPER (asinh, ::asinh); + SCALAR_MAPPER (atan, ::atan); + SCALAR_MAPPER (atanh, ::atanh); + SCALAR_MAPPER (ceil, ::ceil); + SCALAR_MAPPER (conj, std::conj); + SCALAR_MAPPER (cos, std::cos); + SCALAR_MAPPER (cosh, std::cosh); + SCALAR_MAPPER (exp, std::exp); + SCALAR_MAPPER (expm1, ::expm1); + SCALAR_MAPPER (fix, ::fix); + SCALAR_MAPPER (floor, ::floor); + SCALAR_MAPPER (imag, std::imag); + SCALAR_MAPPER (log, std::log); + SCALAR_MAPPER (log2, xlog2); + SCALAR_MAPPER (log10, std::log10); + SCALAR_MAPPER (log1p, ::log1p); + SCALAR_MAPPER (real, std::real); + SCALAR_MAPPER (round, xround); + SCALAR_MAPPER (roundb, xroundb); + SCALAR_MAPPER (signum, ::signum); + SCALAR_MAPPER (sin, std::sin); + SCALAR_MAPPER (sinh, std::sinh); + SCALAR_MAPPER (sqrt, std::sqrt); + SCALAR_MAPPER (tan, std::tan); + SCALAR_MAPPER (tanh, std::tanh); + SCALAR_MAPPER (finite, xfinite); + SCALAR_MAPPER (isinf, xisinf); + SCALAR_MAPPER (isna, octave_is_NA); + SCALAR_MAPPER (isnan, xisnan); + + default: + return octave_base_value::map (umap); + } +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-flt-complex.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-flt-complex.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,198 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_float_complex_h) +#define octave_float_complex_h 1 + +#include + +#include +#include + +#include "lo-ieee.h" +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "gripes.h" +#include "error.h" +#include "ov-base.h" +#include "ov-flt-cx-mat.h" +#include "ov-base-scalar.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// Complex scalar values. + +class +OCTINTERP_API +octave_float_complex : public octave_base_scalar +{ +public: + + octave_float_complex (void) + : octave_base_scalar () { } + + octave_float_complex (const FloatComplex& c) + : octave_base_scalar (c) { } + + octave_float_complex (const octave_float_complex& c) + : octave_base_scalar (c) { } + + ~octave_float_complex (void) { } + + octave_base_value *clone (void) const { return new octave_float_complex (*this); } + + // We return an octave_float_complex_matrix object here instead of an + // octave_float_complex object so that in expressions like A(2,2,2) = 2 + // (for A previously undefined), A will be empty instead of a 1x1 + // object. + octave_base_value *empty_clone (void) const + { return new octave_float_complex_matrix (); } + + octave_base_value *try_narrowing_conversion (void); + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + octave_value any (int = 0) const + { + return (scalar != FloatComplex (0, 0) + && ! (lo_ieee_isnan (std::real (scalar)) + || lo_ieee_isnan (std::imag (scalar)))); + } + + builtin_type_t builtin_type (void) const { return btyp_float_complex; } + + bool is_complex_scalar (void) const { return true; } + + bool is_complex_type (void) const { return true; } + + bool is_single_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + double double_value (bool = false) const; + + float float_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + float float_scalar_value (bool frc_str_conv = false) const + { return float_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const; + + FloatMatrix float_matrix_value (bool = false) const; + + NDArray array_value (bool = false) const; + + FloatNDArray float_array_value (bool = false) const; + + SparseMatrix sparse_matrix_value (bool = false) const + { return SparseMatrix (matrix_value ()); } + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const + { return SparseComplexMatrix (complex_matrix_value ()); } + + octave_value resize (const dim_vector& dv, bool fill = false) const; + + Complex complex_value (bool = false) const; + + FloatComplex float_complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + FloatComplexMatrix float_complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const; + + FloatComplexNDArray float_complex_array_value (bool = false) const; + + bool bool_value (bool warn = false) const + { + if (xisnan (scalar)) + gripe_nan_to_logical_conversion (); + else if (warn && scalar != 0.0f && scalar != 1.0f) + gripe_logical_conversion (); + + return scalar != 0.0f; + } + + boolNDArray bool_array_value (bool warn = false) const + { + if (xisnan (scalar)) + gripe_nan_to_logical_conversion (); + else if (warn && scalar != 0.0f && scalar != 1.0f) + gripe_logical_conversion (); + + return boolNDArray (dim_vector (1, 1), scalar != 1.0f); + } + + octave_value diag (octave_idx_type m, octave_idx_type n) const; + + void increment (void) { scalar += 1.0; } + + void decrement (void) { scalar -= 1.0; } + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { + // Yes, for compatibility, we drop the imaginary part here. + return os.write (array_value (true), block_size, output_type, + skip, flt_fmt); + } + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const; + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +typedef octave_float_complex octave_float_complex_scalar; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-flt-cx-diag.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-flt-cx-diag.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,207 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "byte-swap.h" + +#include "ov-flt-cx-diag.h" +#include "ov-base-diag.cc" +#include "ov-flt-re-diag.h" +#include "ov-flt-complex.h" +#include "ov-flt-cx-mat.h" +#include "ls-utils.h" + +template class octave_base_diag; + +DEFINE_OCTAVE_ALLOCATOR (octave_float_complex_diag_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_complex_diag_matrix, + "float complex diagonal matrix", "single"); + +static octave_base_value * +default_numeric_conversion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_float_complex_diag_matrix&); + + return new octave_float_complex_matrix (v.float_complex_matrix_value ()); +} + +octave_base_value::type_conv_info +octave_float_complex_diag_matrix::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_conversion_function, + octave_float_complex_matrix::static_type_id ()); +} + +octave_base_value * +octave_float_complex_diag_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (matrix.nelem () == 1) + { + retval = new octave_float_complex (matrix (0, 0)); + octave_base_value *rv2 = retval->try_narrowing_conversion (); + if (rv2) + { + delete retval; + retval = rv2; + } + } + else if (matrix.all_elements_are_real ()) + { + return new octave_float_diag_matrix (::real (matrix)); + } + + return retval; +} + +DiagMatrix +octave_float_complex_diag_matrix::diag_matrix_value (bool force_conversion) const +{ + DiagMatrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + type_name (), "real matrix"); + + retval = ::real (matrix); + + return retval; +} + +FloatDiagMatrix +octave_float_complex_diag_matrix::float_diag_matrix_value (bool force_conversion) const +{ + DiagMatrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + type_name (), "real matrix"); + + retval = ::real (matrix); + + return retval; +} + +ComplexDiagMatrix +octave_float_complex_diag_matrix::complex_diag_matrix_value (bool) const +{ + return ComplexDiagMatrix (matrix); +} + +FloatComplexDiagMatrix +octave_float_complex_diag_matrix::float_complex_diag_matrix_value (bool) const +{ + return matrix; +} + +octave_value +octave_float_complex_diag_matrix::map (unary_mapper_t umap) const +{ + switch (umap) + { + case umap_abs: + return matrix.abs (); + case umap_real: + return ::real (matrix); + case umap_conj: + return ::conj (matrix); + case umap_imag: + return ::imag (matrix); + case umap_sqrt: + { + FloatComplexColumnVector tmp = matrix.diag ().map (std::sqrt); + FloatComplexDiagMatrix retval (tmp); + retval.resize (matrix.rows (), matrix.columns ()); + return retval; + } + default: + return to_dense ().map (umap); + } +} + + +bool +octave_float_complex_diag_matrix::save_binary (std::ostream& os, + bool& /* save_as_floats */) +{ + + int32_t r = matrix.rows (), c = matrix.cols (); + os.write (reinterpret_cast (&r), 4); + os.write (reinterpret_cast (&c), 4); + + FloatComplexMatrix m = FloatComplexMatrix (matrix.diag ()); + save_type st = LS_FLOAT; + if (matrix.length () > 4096) // FIXME -- make this configurable. + { + float max_val, min_val; + if (m.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + } + + const FloatComplex *mtmp = m.data (); + write_floats (os, reinterpret_cast (mtmp), st, 2 * m.numel ()); + + return true; +} + +bool +octave_float_complex_diag_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + int32_t r, c; + char tmp; + if (! (is.read (reinterpret_cast (&r), 4) + && is.read (reinterpret_cast (&c), 4) + && is.read (reinterpret_cast (&tmp), 1))) + return false; + if (swap) + { + swap_bytes<4> (&r); + swap_bytes<4> (&c); + } + + FloatComplexDiagMatrix m (r, c); + FloatComplex *re = m.fortran_vec (); + octave_idx_type len = m.length (); + read_floats (is, reinterpret_cast (re), + static_cast (tmp), 2 * len, swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + + return true; +} + +bool +octave_float_complex_diag_matrix::chk_valid_scalar (const octave_value& val, + FloatComplex& x) const +{ + bool retval = val.is_complex_scalar () || val.is_real_scalar (); + if (retval) + x = val.float_complex_value (); + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-flt-cx-diag.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-flt-cx-diag.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,93 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_float_complex_diag_matrix_h) +#define octave_float_complex_diag_matrix_h 1 + +#include "ov-base.h" +#include "ov-base-diag.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" + +// Real diagonal matrix values. + +class +OCTINTERP_API +octave_float_complex_diag_matrix + : public octave_base_diag +{ +public: + + octave_float_complex_diag_matrix (void) + : octave_base_diag () { } + + octave_float_complex_diag_matrix (const FloatComplexDiagMatrix& m) + : octave_base_diag (m) { } + + octave_float_complex_diag_matrix (const octave_float_complex_diag_matrix& m) + : octave_base_diag (m) { } + + ~octave_float_complex_diag_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_float_complex_diag_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_float_complex_diag_matrix (); } + + type_conv_info numeric_conversion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + builtin_type_t builtin_type (void) const { return btyp_float_complex; } + + bool is_complex_matrix (void) const { return true; } + + bool is_complex_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + DiagMatrix diag_matrix_value (bool = false) const; + + FloatDiagMatrix float_diag_matrix_value (bool = false) const; + + ComplexDiagMatrix complex_diag_matrix_value (bool = false) const; + + FloatComplexDiagMatrix float_complex_diag_matrix_value (bool = false) const; + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + + octave_value map (unary_mapper_t umap) const; + +private: + + bool chk_valid_scalar (const octave_value&, + FloatComplex&) const; + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-flt-cx-mat.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-flt-cx-mat.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,770 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "data-conv.h" +#include "lo-ieee.h" +#include "lo-specfun.h" +#include "lo-mappers.h" +#include "mx-base.h" +#include "mach-info.h" +#include "oct-locbuf.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "oct-stream.h" +#include "ops.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-base-mat.cc" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "pr-output.h" +#include "ops.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-hdf5.h" +#include "ls-utils.h" + +template class octave_base_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_float_complex_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_complex_matrix, + "float complex matrix", "single"); + +octave_base_value * +octave_float_complex_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (matrix.numel () == 1) + { + FloatComplex c = matrix (0); + + if (std::imag (c) == 0.0) + retval = new octave_float_scalar (std::real (c)); + else + retval = new octave_float_complex (c); + } + else if (matrix.all_elements_are_real ()) + retval = new octave_float_matrix (::real (matrix)); + + return retval; +} + +double +octave_float_complex_matrix::double_value (bool force_conversion) const +{ + double retval = lo_ieee_nan_value (); + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real scalar"); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "complex matrix", "real scalar"); + + retval = std::real (matrix (0, 0)); + } + else + gripe_invalid_conversion ("complex matrix", "real scalar"); + + return retval; +} + +float +octave_float_complex_matrix::float_value (bool force_conversion) const +{ + float retval = lo_ieee_float_nan_value (); + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real scalar"); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "complex matrix", "real scalar"); + + retval = std::real (matrix (0, 0)); + } + else + gripe_invalid_conversion ("complex matrix", "real scalar"); + + return retval; +} + +Matrix +octave_float_complex_matrix::matrix_value (bool force_conversion) const +{ + Matrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real matrix"); + + retval = ::real (matrix.matrix_value ()); + + return retval; +} + +FloatMatrix +octave_float_complex_matrix::float_matrix_value (bool force_conversion) const +{ + FloatMatrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real matrix"); + + retval = ::real (matrix.matrix_value ()); + + return retval; +} + +Complex +octave_float_complex_matrix::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "complex matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("complex matrix", "complex scalar"); + + return retval; +} + +FloatComplex +octave_float_complex_matrix::float_complex_value (bool) const +{ + float tmp = lo_ieee_float_nan_value (); + + FloatComplex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "complex matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("complex matrix", "complex scalar"); + + return retval; +} + +ComplexMatrix +octave_float_complex_matrix::complex_matrix_value (bool) const +{ + return matrix.matrix_value (); +} + +FloatComplexMatrix +octave_float_complex_matrix::float_complex_matrix_value (bool) const +{ + return FloatComplexMatrix (matrix.matrix_value ()); +} + +boolNDArray +octave_float_complex_matrix::bool_array_value (bool warn) const +{ + if (matrix.any_element_is_nan ()) + gripe_nan_to_logical_conversion (); + else if (warn && (! matrix.all_elements_are_real () + || real (matrix).any_element_not_one_or_zero ())) + gripe_logical_conversion (); + + return mx_el_ne (matrix, FloatComplex (0.0)); +} + +charNDArray +octave_float_complex_matrix::char_array_value (bool frc_str_conv) const +{ + charNDArray retval; + + if (! frc_str_conv) + gripe_implicit_conversion ("Octave:num-to-str", + "complex matrix", "string"); + else + { + retval = charNDArray (dims ()); + octave_idx_type nel = numel (); + + for (octave_idx_type i = 0; i < nel; i++) + retval.elem (i) = static_cast(std::real (matrix.elem (i))); + } + + return retval; +} + +FloatComplexNDArray +octave_float_complex_matrix::float_complex_array_value (bool) const +{ + return FloatComplexNDArray (matrix); +} + +SparseMatrix +octave_float_complex_matrix::sparse_matrix_value (bool force_conversion) const +{ + SparseMatrix retval; + + if (! force_conversion) + gripe_implicit_conversion ("Octave:imag-to-real", + "complex matrix", "real matrix"); + + retval = SparseMatrix (::real (complex_matrix_value ())); + + return retval; +} + +SparseComplexMatrix +octave_float_complex_matrix::sparse_complex_matrix_value (bool) const +{ + return SparseComplexMatrix (complex_matrix_value ()); +} + +octave_value +octave_float_complex_matrix::diag (octave_idx_type k) const +{ + octave_value retval; + if (k == 0 && matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + retval = FloatComplexDiagMatrix (DiagArray2 (matrix)); + else + retval = octave_base_matrix::diag (k); + + return retval; +} + +octave_value +octave_float_complex_matrix::diag (octave_idx_type m, octave_idx_type n) const +{ + octave_value retval; + + if (matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + { + FloatComplexMatrix mat = matrix.matrix_value (); + + retval = mat.diag (m, n); + } + else + error ("diag: expecting vector argument"); + + return retval; +} + +bool +octave_float_complex_matrix::save_ascii (std::ostream& os) +{ + dim_vector d = dims (); + if (d.length () > 2) + { + FloatComplexNDArray tmp = complex_array_value (); + + os << "# ndims: " << d.length () << "\n"; + + for (int i = 0; i < d.length (); i++) + os << " " << d (i); + + os << "\n" << tmp; + } + else + { + // Keep this case, rather than use generic code above for backward + // compatiability. Makes load_ascii much more complex!! + os << "# rows: " << rows () << "\n" + << "# columns: " << columns () << "\n"; + + os << complex_matrix_value (); + } + + return true; +} + +bool +octave_float_complex_matrix::load_ascii (std::istream& is) +{ + bool success = true; + + string_vector keywords(2); + + keywords[0] = "ndims"; + keywords[1] = "rows"; + + std::string kw; + octave_idx_type val = 0; + + if (extract_keyword (is, keywords, kw, val, true)) + { + if (kw == "ndims") + { + int mdims = static_cast (val); + + if (mdims >= 0) + { + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + is >> dv(i); + + if (is) + { + FloatComplexNDArray tmp(dv); + + is >> tmp; + + if (is) + matrix = tmp; + else + { + error ("load: failed to load matrix constant"); + success = false; + } + } + else + { + error ("load: failed to read dimensions"); + success = false; + } + } + else + { + error ("load: failed to extract number of dimensions"); + success = false; + } + } + else if (kw == "rows") + { + octave_idx_type nr = val; + octave_idx_type nc = 0; + + if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) + { + if (nr > 0 && nc > 0) + { + FloatComplexMatrix tmp (nr, nc); + is >> tmp; + if (is) + matrix = tmp; + else + { + error ("load: failed to load matrix constant"); + success = false; + } + } + else if (nr == 0 || nc == 0) + matrix = FloatComplexMatrix (nr, nc); + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + } + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + + return success; +} + +bool +octave_float_complex_matrix::save_binary (std::ostream& os, bool&) +{ + dim_vector d = dims (); + if (d.length () < 1) + return false; + + // Use negative value for ndims to differentiate with old format!! + int32_t tmp = - d.length (); + os.write (reinterpret_cast (&tmp), 4); + for (int i = 0; i < d.length (); i++) + { + tmp = d(i); + os.write (reinterpret_cast (&tmp), 4); + } + + FloatComplexNDArray m = complex_array_value (); + save_type st = LS_FLOAT; + if (d.numel () > 4096) // FIXME -- make this configurable. + { + float max_val, min_val; + if (m.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + } + + const FloatComplex *mtmp = m.data (); + write_floats (os, reinterpret_cast (mtmp), st, 2 * d.numel ()); + + return true; +} + +bool +octave_float_complex_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + char tmp; + int32_t mdims; + if (! is.read (reinterpret_cast (&mdims), 4)) + return false; + if (swap) + swap_bytes<4> (&mdims); + if (mdims < 0) + { + mdims = - mdims; + int32_t di; + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + { + if (! is.read (reinterpret_cast (&di), 4)) + return false; + if (swap) + swap_bytes<4> (&di); + dv(i) = di; + } + + // Convert an array with a single dimension to be a row vector. + // Octave should never write files like this, other software + // might. + + if (mdims == 1) + { + mdims = 2; + dv.resize (mdims); + dv(1) = dv(0); + dv(0) = 1; + } + + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + + FloatComplexNDArray m(dv); + FloatComplex *im = m.fortran_vec (); + read_floats (is, reinterpret_cast (im), + static_cast (tmp), 2 * dv.numel (), swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + } + else + { + int32_t nr, nc; + nr = mdims; + if (! is.read (reinterpret_cast (&nc), 4)) + return false; + if (swap) + swap_bytes<4> (&nc); + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + FloatComplexMatrix m (nr, nc); + FloatComplex *im = m.fortran_vec (); + octave_idx_type len = nr * nc; + read_floats (is, reinterpret_cast (im), + static_cast (tmp), 2*len, swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + } + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_float_complex_matrix::save_hdf5 (hid_t loc_id, const char *name, bool) +{ + dim_vector dv = dims (); + int empty = save_hdf5_empty (loc_id, name, dv); + if (empty) + return (empty > 0); + + int rank = dv.length (); + hid_t space_hid = -1, data_hid = -1, type_hid = -1; + bool retval = true; + FloatComplexNDArray m = complex_array_value (); + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + + // Octave uses column-major, while HDF5 uses row-major ordering + for (int i = 0; i < rank; i++) + hdims[i] = dv (rank-i-1); + + space_hid = H5Screate_simple (rank, hdims, 0); + if (space_hid < 0) return false; + + hid_t save_type_hid = H5T_NATIVE_FLOAT; + +#if HAVE_HDF5_INT2FLOAT_CONVERSIONS + // hdf5 currently doesn't support float/integer conversions + else + { + float max_val, min_val; + + if (m.all_integers (max_val, min_val)) + save_type_hid + = save_type_to_hdf5 (get_save_type (max_val, min_val)); + } +#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ + + type_hid = hdf5_make_complex_type (save_type_hid); + if (type_hid < 0) + { + H5Sclose (space_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + return false; + } + + hid_t complex_type_hid = hdf5_make_complex_type (H5T_NATIVE_FLOAT); + if (complex_type_hid < 0) retval = false; + + if (retval) + { + FloatComplex *mtmp = m.fortran_vec (); + if (H5Dwrite (data_hid, complex_type_hid, H5S_ALL, H5S_ALL, H5P_DEFAULT, + mtmp) < 0) + { + H5Tclose (complex_type_hid); + retval = false; + } + } + + H5Tclose (complex_type_hid); + H5Dclose (data_hid); + H5Tclose (type_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_float_complex_matrix::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; + + dim_vector dv; + int empty = load_hdf5_empty (loc_id, name, dv); + if (empty > 0) + matrix.resize (dv); + if (empty) + return (empty > 0); + +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t type_hid = H5Dget_type (data_hid); + + hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_FLOAT); + + if (! hdf5_types_compatible (type_hid, complex_type)) + { + H5Tclose (complex_type); + H5Dclose (data_hid); + return false; + } + + hid_t space_id = H5Dget_space (data_hid); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank < 1) + { + H5Tclose (complex_type); + H5Sclose (space_id); + H5Dclose (data_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_id, hdims, maxdims); + + // Octave uses column-major, while HDF5 uses row-major ordering + if (rank == 1) + { + dv.resize (2); + dv(0) = 1; + dv(1) = hdims[0]; + } + else + { + dv.resize (rank); + for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) + dv(j) = hdims[i]; + } + + FloatComplexNDArray m (dv); + FloatComplex *reim = m.fortran_vec (); + if (H5Dread (data_hid, complex_type, H5S_ALL, H5S_ALL, H5P_DEFAULT, + reim) >= 0) + { + retval = true; + matrix = m; + } + + H5Tclose (complex_type); + H5Sclose (space_id); + H5Dclose (data_hid); + + return retval; +} + +#endif + +void +octave_float_complex_matrix::print_raw (std::ostream& os, + bool pr_as_read_syntax) const +{ + octave_print_internal (os, matrix, pr_as_read_syntax, + current_print_indent_level ()); +} + +mxArray * +octave_float_complex_matrix::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxSINGLE_CLASS, dims (), mxCOMPLEX); + + float *pr = static_cast (retval->get_data ()); + float *pi = static_cast (retval->get_imag_data ()); + + mwSize nel = numel (); + + const FloatComplex *p = matrix.data (); + + for (mwIndex i = 0; i < nel; i++) + { + pr[i] = std::real (p[i]); + pi[i] = std::imag (p[i]); + } + + return retval; +} + +octave_value +octave_float_complex_matrix::map (unary_mapper_t umap) const +{ + switch (umap) + { + // Mappers handled specially. + case umap_real: + return ::real (matrix); + case umap_imag: + return ::imag (matrix); + case umap_conj: + return ::conj (matrix); + +#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.FCN ()) + + ARRAY_METHOD_MAPPER (abs, abs); + ARRAY_METHOD_MAPPER (isnan, isnan); + ARRAY_METHOD_MAPPER (isinf, isinf); + ARRAY_METHOD_MAPPER (finite, isfinite); + +#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.map (FCN)) + + ARRAY_MAPPER (acos, FloatComplex, ::acos); + ARRAY_MAPPER (acosh, FloatComplex, ::acosh); + ARRAY_MAPPER (angle, float, std::arg); + ARRAY_MAPPER (arg, float, std::arg); + ARRAY_MAPPER (asin, FloatComplex, ::asin); + ARRAY_MAPPER (asinh, FloatComplex, ::asinh); + ARRAY_MAPPER (atan, FloatComplex, ::atan); + ARRAY_MAPPER (atanh, FloatComplex, ::atanh); + ARRAY_MAPPER (ceil, FloatComplex, ::ceil); + ARRAY_MAPPER (cos, FloatComplex, std::cos); + ARRAY_MAPPER (cosh, FloatComplex, std::cosh); + ARRAY_MAPPER (exp, FloatComplex, std::exp); + ARRAY_MAPPER (expm1, FloatComplex, ::expm1); + ARRAY_MAPPER (fix, FloatComplex, ::fix); + ARRAY_MAPPER (floor, FloatComplex, ::floor); + ARRAY_MAPPER (log, FloatComplex, std::log); + ARRAY_MAPPER (log2, FloatComplex, xlog2); + ARRAY_MAPPER (log10, FloatComplex, std::log10); + ARRAY_MAPPER (log1p, FloatComplex, ::log1p); + ARRAY_MAPPER (round, FloatComplex, xround); + ARRAY_MAPPER (roundb, FloatComplex, xroundb); + ARRAY_MAPPER (signum, FloatComplex, ::signum); + ARRAY_MAPPER (sin, FloatComplex, std::sin); + ARRAY_MAPPER (sinh, FloatComplex, std::sinh); + ARRAY_MAPPER (sqrt, FloatComplex, std::sqrt); + ARRAY_MAPPER (tan, FloatComplex, std::tan); + ARRAY_MAPPER (tanh, FloatComplex, std::tanh); + ARRAY_MAPPER (isna, bool, octave_is_NA); + + default: + return octave_base_value::map (umap); + } +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-flt-cx-mat.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-flt-cx-mat.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,181 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_float_complex_matrix_h) +#define octave_float_complex_matrix_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-stream.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-typeinfo.h" + +#include "MatrixType.h" + +class octave_value_list; + +class tree_walker; + +// Complex matrix values. + +class +OCTINTERP_API +octave_float_complex_matrix : public octave_base_matrix +{ +public: + + octave_float_complex_matrix (void) + : octave_base_matrix () { } + + octave_float_complex_matrix (const FloatComplexNDArray& m) + : octave_base_matrix (m) { } + + octave_float_complex_matrix (const FloatComplexMatrix& m) + : octave_base_matrix (m) { } + + octave_float_complex_matrix (const FloatComplexMatrix& m, const MatrixType& t) + : octave_base_matrix (m, t) { } + + octave_float_complex_matrix (const Array& m) + : octave_base_matrix (FloatComplexNDArray (m)) { } + + octave_float_complex_matrix (const FloatComplexDiagMatrix& d) + : octave_base_matrix (FloatComplexMatrix (d)) { } + + octave_float_complex_matrix (const FloatComplexRowVector& v) + : octave_base_matrix (FloatComplexMatrix (v)) { } + + octave_float_complex_matrix (const FloatComplexColumnVector& v) + : octave_base_matrix (FloatComplexMatrix (v)) { } + + octave_float_complex_matrix (const octave_float_complex_matrix& cm) + : octave_base_matrix (cm) { } + + ~octave_float_complex_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_float_complex_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_float_complex_matrix (); } + + octave_base_value *try_narrowing_conversion (void); + + builtin_type_t builtin_type (void) const { return btyp_float_complex; } + + bool is_complex_matrix (void) const { return true; } + + bool is_complex_type (void) const { return true; } + + bool is_single_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + double double_value (bool = false) const; + + float float_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + float float_scalar_value (bool frc_str_conv = false) const + { return float_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const; + + FloatMatrix float_matrix_value (bool = false) const; + + Complex complex_value (bool = false) const; + + FloatComplex float_complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + FloatComplexMatrix float_complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const { return matrix; } + + FloatComplexNDArray float_complex_array_value (bool = false) const; + + boolNDArray bool_array_value (bool warn = false) const; + + charNDArray char_array_value (bool frc_str_conv = false) const; + + SparseMatrix sparse_matrix_value (bool = false) const; + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; + + octave_value diag (octave_idx_type k = 0) const; + + octave_value diag (octave_idx_type m, octave_idx_type n) const; + + void increment (void) { matrix += FloatComplex (1.0); } + + void decrement (void) { matrix -= FloatComplex (1.0); } + + void changesign (void) { matrix.changesign (); } + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { + // Yes, for compatibility, we drop the imaginary part here. + return os.write (matrix_value (true), block_size, output_type, + skip, flt_fmt); + } + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const; + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-flt-re-diag.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-flt-re-diag.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,175 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "byte-swap.h" + +#include "ov-flt-re-diag.h" +#include "ov-base-diag.cc" +#include "ov-float.h" +#include "ov-flt-re-mat.h" +#include "ls-utils.h" + +template class octave_base_diag; + +DEFINE_OCTAVE_ALLOCATOR (octave_float_diag_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_diag_matrix, + "float diagonal matrix", "single"); + +static octave_base_value * +default_numeric_conversion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_float_diag_matrix&); + + return new octave_float_matrix (v.float_matrix_value ()); +} + +octave_base_value::type_conv_info +octave_float_diag_matrix::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_conversion_function, + octave_float_matrix::static_type_id ()); +} + +octave_base_value * +octave_float_diag_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (matrix.nelem () == 1) + retval = new octave_float_scalar (matrix (0, 0)); + + return retval; +} + +DiagMatrix +octave_float_diag_matrix::diag_matrix_value (bool) const +{ + return DiagMatrix (matrix); +} + +FloatDiagMatrix +octave_float_diag_matrix::float_diag_matrix_value (bool) const +{ + return matrix; +} + +ComplexDiagMatrix +octave_float_diag_matrix::complex_diag_matrix_value (bool) const +{ + return ComplexDiagMatrix (matrix); +} + +FloatComplexDiagMatrix +octave_float_diag_matrix::float_complex_diag_matrix_value (bool) const +{ + return FloatComplexDiagMatrix (matrix); +} + +octave_value +octave_float_diag_matrix::map (unary_mapper_t umap) const +{ + switch (umap) + { + case umap_abs: + return matrix.abs (); + case umap_real: + case umap_conj: + return matrix; + case umap_imag: + return DiagMatrix (matrix.rows (), matrix.cols (), 0.0); + case umap_sqrt: + { + FloatComplexColumnVector tmp = matrix.diag ().map (rc_sqrt); + FloatComplexDiagMatrix retval (tmp); + retval.resize (matrix.rows (), matrix.columns ()); + return retval; + } + default: + return to_dense ().map (umap); + } +} + +bool +octave_float_diag_matrix::save_binary (std::ostream& os, + bool& /* save_as_floats*/) +{ + + int32_t r = matrix.rows (), c = matrix.cols (); + os.write (reinterpret_cast (&r), 4); + os.write (reinterpret_cast (&c), 4); + + FloatMatrix m = FloatMatrix (matrix.diag ()); + save_type st = LS_FLOAT; + if (matrix.length () > 8192) // FIXME -- make this configurable. + { + float max_val, min_val; + if (m.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + } + + const float *mtmp = m.data (); + write_floats (os, mtmp, st, m.numel ()); + + return true; +} + +bool +octave_float_diag_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + int32_t r, c; + char tmp; + if (! (is.read (reinterpret_cast (&r), 4) + && is.read (reinterpret_cast (&c), 4) + && is.read (reinterpret_cast (&tmp), 1))) + return false; + if (swap) + { + swap_bytes<4> (&r); + swap_bytes<4> (&c); + } + + FloatDiagMatrix m (r, c); + float *re = m.fortran_vec (); + octave_idx_type len = m.length (); + read_floats (is, re, static_cast (tmp), len, swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + + return true; +} + +bool +octave_float_diag_matrix::chk_valid_scalar (const octave_value& val, + float& x) const +{ + bool retval = val.is_real_scalar (); + if (retval) + x = val.float_value (); + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-flt-re-diag.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-flt-re-diag.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,93 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_float_diag_matrix_h) +#define octave_float_diag_matrix_h 1 + +#include "ov-base.h" +#include "ov-base-diag.h" +#include "ov-flt-re-mat.h" +#include "ov-typeinfo.h" + +// Real diagonal matrix values. + +class +OCTINTERP_API +octave_float_diag_matrix + : public octave_base_diag +{ +public: + + octave_float_diag_matrix (void) + : octave_base_diag () { } + + octave_float_diag_matrix (const FloatDiagMatrix& m) + : octave_base_diag (m) { } + + octave_float_diag_matrix (const octave_float_diag_matrix& m) + : octave_base_diag (m) { } + + ~octave_float_diag_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_float_diag_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_float_diag_matrix (); } + + type_conv_info numeric_conversion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + builtin_type_t builtin_type (void) const { return btyp_float; } + + bool is_real_matrix (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_single_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + DiagMatrix diag_matrix_value (bool = false) const; + + FloatDiagMatrix float_diag_matrix_value (bool = false) const; + + ComplexDiagMatrix complex_diag_matrix_value (bool = false) const; + + FloatComplexDiagMatrix float_complex_diag_matrix_value (bool = false) const; + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + + octave_value map (unary_mapper_t umap) const; + +private: + + bool chk_valid_scalar (const octave_value&, + float&) const; + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-flt-re-mat.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-flt-re-mat.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,886 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "data-conv.h" +#include "lo-ieee.h" +#include "lo-utils.h" +#include "lo-specfun.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "mx-base.h" +#include "quit.h" +#include "oct-locbuf.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "oct-stream.h" +#include "ops.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-base-mat.cc" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-flt-complex.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-re-sparse.h" +#include "ov-flt-re-diag.h" +#include "ov-flt-cx-diag.h" +#include "ov-type-conv.h" +#include "pr-output.h" +#include "variables.h" +#include "ops.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +#if ! defined (UCHAR_MAX) +#define UCHAR_MAX 255 +#endif + +template class octave_base_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_float_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_matrix, "float matrix", "single"); + +octave_base_value * +octave_float_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (matrix.nelem () == 1) + retval = new octave_float_scalar (matrix (0)); + + return retval; +} + +double +octave_float_matrix::double_value (bool) const +{ + double retval = lo_ieee_nan_value (); + + if (numel () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "real matrix", "real scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("real matrix", "real scalar"); + + return retval; +} + +float +octave_float_matrix::float_value (bool) const +{ + float retval = lo_ieee_float_nan_value (); + + if (numel () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "real matrix", "real scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("real matrix", "real scalar"); + + return retval; +} + +// FIXME + +Matrix +octave_float_matrix::matrix_value (bool) const +{ + return Matrix (matrix.matrix_value ()); +} + +FloatMatrix +octave_float_matrix::float_matrix_value (bool) const +{ + return matrix.matrix_value (); +} + +Complex +octave_float_matrix::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "real matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("real matrix", "complex scalar"); + + return retval; +} + +FloatComplex +octave_float_matrix::float_complex_value (bool) const +{ + double tmp = lo_ieee_float_nan_value (); + + FloatComplex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "real matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("real matrix", "complex scalar"); + + return retval; +} + +// FIXME + +ComplexMatrix +octave_float_matrix::complex_matrix_value (bool) const +{ + return ComplexMatrix (matrix.matrix_value ()); +} + +FloatComplexMatrix +octave_float_matrix::float_complex_matrix_value (bool) const +{ + return FloatComplexMatrix (matrix.matrix_value ()); +} + +ComplexNDArray +octave_float_matrix::complex_array_value (bool) const +{ + return ComplexNDArray (matrix); +} + +FloatComplexNDArray +octave_float_matrix::float_complex_array_value (bool) const +{ + return FloatComplexNDArray (matrix); +} + +NDArray +octave_float_matrix::array_value (bool) const +{ + return NDArray (matrix); +} + +boolNDArray +octave_float_matrix::bool_array_value (bool warn) const +{ + if (matrix.any_element_is_nan ()) + gripe_nan_to_logical_conversion (); + else if (warn && matrix.any_element_not_one_or_zero ()) + gripe_logical_conversion (); + + return boolNDArray (matrix); +} + +charNDArray +octave_float_matrix::char_array_value (bool) const +{ + charNDArray retval (dims ()); + + octave_idx_type nel = numel (); + + for (octave_idx_type i = 0; i < nel; i++) + retval.elem (i) = static_cast(matrix.elem (i)); + + return retval; +} + +SparseMatrix +octave_float_matrix::sparse_matrix_value (bool) const +{ + return SparseMatrix (matrix_value ()); +} + +SparseComplexMatrix +octave_float_matrix::sparse_complex_matrix_value (bool) const +{ + // FIXME Need a SparseComplexMatrix (Matrix) constructor to make + // this function more efficient. Then this should become + // return SparseComplexMatrix (matrix.matrix_value ()); + return SparseComplexMatrix (sparse_matrix_value ()); +} + +octave_value +octave_float_matrix::diag (octave_idx_type k) const +{ + octave_value retval; + if (k == 0 && matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + retval = FloatDiagMatrix (DiagArray2 (matrix)); + else + retval = octave_base_matrix::diag (k); + + return retval; +} + +octave_value +octave_float_matrix::diag (octave_idx_type m, octave_idx_type n) const +{ + octave_value retval; + + if (matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + { + FloatMatrix mat = matrix.matrix_value (); + + retval = mat.diag (m, n); + } + else + error ("diag: expecting vector argument"); + + return retval; +} + +octave_value +octave_float_matrix::convert_to_str_internal (bool, bool, char type) const +{ + octave_value retval; + dim_vector dv = dims (); + octave_idx_type nel = dv.numel (); + + charNDArray chm (dv); + + bool warned = false; + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_quit (); + + float d = matrix (i); + + if (xisnan (d)) + { + gripe_nan_to_character_conversion (); + return retval; + } + else + { + int ival = NINT (d); + + if (ival < 0 || ival > UCHAR_MAX) + { + // FIXME -- is there something + // better we could do? + + ival = 0; + + if (! warned) + { + ::warning ("range error for conversion to character value"); + warned = true; + } + } + + chm (i) = static_cast (ival); + } + } + + retval = octave_value (chm, type); + + return retval; +} + +bool +octave_float_matrix::save_ascii (std::ostream& os) +{ + dim_vector d = dims (); + + if (d.length () > 2) + { + FloatNDArray tmp = float_array_value (); + + os << "# ndims: " << d.length () << "\n"; + + for (int i=0; i < d.length (); i++) + os << " " << d (i); + + os << "\n" << tmp; + } + else + { + // Keep this case, rather than use generic code above for backward + // compatiability. Makes load_ascii much more complex!! + os << "# rows: " << rows () << "\n" + << "# columns: " << columns () << "\n"; + + os << float_matrix_value (); + } + + return true; +} + +bool +octave_float_matrix::load_ascii (std::istream& is) +{ + bool success = true; + + string_vector keywords(2); + + keywords[0] = "ndims"; + keywords[1] = "rows"; + + std::string kw; + octave_idx_type val = 0; + + if (extract_keyword (is, keywords, kw, val, true)) + { + if (kw == "ndims") + { + int mdims = static_cast (val); + + if (mdims >= 0) + { + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + is >> dv(i); + + if (is) + { + FloatNDArray tmp(dv); + + is >> tmp; + + if (is) + matrix = tmp; + else + { + error ("load: failed to load matrix constant"); + success = false; + } + } + else + { + error ("load: failed to read dimensions"); + success = false; + } + } + else + { + error ("load: failed to extract number of dimensions"); + success = false; + } + } + else if (kw == "rows") + { + octave_idx_type nr = val; + octave_idx_type nc = 0; + + if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) + { + if (nr > 0 && nc > 0) + { + FloatMatrix tmp (nr, nc); + is >> tmp; + if (is) + matrix = tmp; + else + { + error ("load: failed to load matrix constant"); + success = false; + } + } + else if (nr == 0 || nc == 0) + matrix = FloatMatrix (nr, nc); + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + } + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + + return success; +} + +bool +octave_float_matrix::save_binary (std::ostream& os, bool&) +{ + + dim_vector d = dims (); + if (d.length () < 1) + return false; + + // Use negative value for ndims to differentiate with old format!! + int32_t tmp = - d.length (); + os.write (reinterpret_cast (&tmp), 4); + for (int i = 0; i < d.length (); i++) + { + tmp = d(i); + os.write (reinterpret_cast (&tmp), 4); + } + + FloatNDArray m = float_array_value (); + save_type st = LS_FLOAT; + if (d.numel () > 8192) // FIXME -- make this configurable. + { + float max_val, min_val; + if (m.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + } + + const float *mtmp = m.data (); + write_floats (os, mtmp, st, d.numel ()); + + return true; +} + +bool +octave_float_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + char tmp; + int32_t mdims; + if (! is.read (reinterpret_cast (&mdims), 4)) + return false; + if (swap) + swap_bytes<4> (&mdims); + if (mdims < 0) + { + mdims = - mdims; + int32_t di; + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + { + if (! is.read (reinterpret_cast (&di), 4)) + return false; + if (swap) + swap_bytes<4> (&di); + dv(i) = di; + } + + // Convert an array with a single dimension to be a row vector. + // Octave should never write files like this, other software + // might. + + if (mdims == 1) + { + mdims = 2; + dv.resize (mdims); + dv(1) = dv(0); + dv(0) = 1; + } + + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + + FloatNDArray m(dv); + float *re = m.fortran_vec (); + read_floats (is, re, static_cast (tmp), dv.numel (), swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + } + else + { + int32_t nr, nc; + nr = mdims; + if (! is.read (reinterpret_cast (&nc), 4)) + return false; + if (swap) + swap_bytes<4> (&nc); + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + FloatMatrix m (nr, nc); + float *re = m.fortran_vec (); + octave_idx_type len = nr * nc; + read_floats (is, re, static_cast (tmp), len, swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + } + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_float_matrix::save_hdf5 (hid_t loc_id, const char *name, bool) +{ + dim_vector dv = dims (); + int empty = save_hdf5_empty (loc_id, name, dv); + if (empty) + return (empty > 0); + + int rank = dv.length (); + hid_t space_hid = -1, data_hid = -1; + bool retval = true; + FloatNDArray m = array_value (); + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + + // Octave uses column-major, while HDF5 uses row-major ordering + for (int i = 0; i < rank; i++) + hdims[i] = dv (rank-i-1); + + space_hid = H5Screate_simple (rank, hdims, 0); + + if (space_hid < 0) return false; + + hid_t save_type_hid = H5T_NATIVE_FLOAT; + +#if HAVE_HDF5_INT2FLOAT_CONVERSIONS + // hdf5 currently doesn't support float/integer conversions + else + { + float max_val, min_val; + + if (m.all_integers (max_val, min_val)) + save_type_hid + = save_type_to_hdf5 (get_save_type (max_val, min_val)); + } +#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + return false; + } + + float *mtmp = m.fortran_vec (); + retval = H5Dwrite (data_hid, H5T_NATIVE_FLOAT, H5S_ALL, H5S_ALL, + H5P_DEFAULT, mtmp) >= 0; + + H5Dclose (data_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_float_matrix::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; + + dim_vector dv; + int empty = load_hdf5_empty (loc_id, name, dv); + if (empty > 0) + matrix.resize (dv); + if (empty) + return (empty > 0); + +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t space_id = H5Dget_space (data_hid); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank < 1) + { + H5Sclose (space_id); + H5Dclose (data_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_id, hdims, maxdims); + + // Octave uses column-major, while HDF5 uses row-major ordering + if (rank == 1) + { + dv.resize (2); + dv(0) = 1; + dv(1) = hdims[0]; + } + else + { + dv.resize (rank); + for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) + dv(j) = hdims[i]; + } + + FloatNDArray m (dv); + float *re = m.fortran_vec (); + if (H5Dread (data_hid, H5T_NATIVE_FLOAT, H5S_ALL, H5S_ALL, + H5P_DEFAULT, re) >= 0) + { + retval = true; + matrix = m; + } + + H5Sclose (space_id); + H5Dclose (data_hid); + + return retval; +} + +#endif + +void +octave_float_matrix::print_raw (std::ostream& os, + bool pr_as_read_syntax) const +{ + octave_print_internal (os, matrix, pr_as_read_syntax, + current_print_indent_level ()); +} + +mxArray * +octave_float_matrix::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxSINGLE_CLASS, dims (), mxREAL); + + float *pr = static_cast (retval->get_data ()); + + mwSize nel = numel (); + + const float *p = matrix.data (); + + for (mwIndex i = 0; i < nel; i++) + pr[i] = p[i]; + + return retval; +} + +// This uses a smarter strategy for doing the complex->real mappers. We +// allocate an array for a real result and keep filling it until a complex +// result is produced. +static octave_value +do_rc_map (const FloatNDArray& a, FloatComplex (&fcn) (float)) +{ + octave_idx_type n = a.numel (); + NoAlias rr (a.dims ()); + + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + + FloatComplex tmp = fcn (a(i)); + if (tmp.imag () == 0.0) + rr(i) = tmp.real (); + else + { + NoAlias rc (a.dims ()); + + for (octave_idx_type j = 0; j < i; j++) + rc(j) = rr(j); + + rc(i) = tmp; + + for (octave_idx_type j = i+1; j < n; j++) + { + octave_quit (); + + rc(j) = fcn (a(j)); + } + + return new octave_float_complex_matrix (rc); + } + } + + return rr; +} + +octave_value +octave_float_matrix::map (unary_mapper_t umap) const +{ + switch (umap) + { + case umap_imag: + return FloatNDArray (matrix.dims (), 0.0); + + case umap_real: + case umap_conj: + return matrix; + + // Mappers handled specially. +#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.FCN ()) + + ARRAY_METHOD_MAPPER (abs, abs); + ARRAY_METHOD_MAPPER (isnan, isnan); + ARRAY_METHOD_MAPPER (isinf, isinf); + ARRAY_METHOD_MAPPER (finite, isfinite); + +#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.map (FCN)) + +#define RC_ARRAY_MAPPER(UMAP, TYPE, FCN) \ + case umap_ ## UMAP: \ + return do_rc_map (matrix, FCN) + + RC_ARRAY_MAPPER (acos, FloatComplex, rc_acos); + RC_ARRAY_MAPPER (acosh, FloatComplex, rc_acosh); + ARRAY_MAPPER (angle, float, ::arg); + ARRAY_MAPPER (arg, float, ::arg); + RC_ARRAY_MAPPER (asin, FloatComplex, rc_asin); + ARRAY_MAPPER (asinh, float, ::asinhf); + ARRAY_MAPPER (atan, float, ::atanf); + RC_ARRAY_MAPPER (atanh, FloatComplex, rc_atanh); + ARRAY_MAPPER (erf, float, ::erff); + ARRAY_MAPPER (erfinv, float, ::erfinv); + ARRAY_MAPPER (erfcinv, float, ::erfcinv); + ARRAY_MAPPER (erfc, float, ::erfcf); + ARRAY_MAPPER (erfcx, float, ::erfcx); + ARRAY_MAPPER (gamma, float, xgamma); + RC_ARRAY_MAPPER (lgamma, FloatComplex, rc_lgamma); + ARRAY_MAPPER (cbrt, float, ::cbrtf); + ARRAY_MAPPER (ceil, float, ::ceilf); + ARRAY_MAPPER (cos, float, ::cosf); + ARRAY_MAPPER (cosh, float, ::coshf); + ARRAY_MAPPER (exp, float, ::expf); + ARRAY_MAPPER (expm1, float, ::expm1f); + ARRAY_MAPPER (fix, float, ::fix); + ARRAY_MAPPER (floor, float, ::floorf); + RC_ARRAY_MAPPER (log, FloatComplex, rc_log); + RC_ARRAY_MAPPER (log2, FloatComplex, rc_log2); + RC_ARRAY_MAPPER (log10, FloatComplex, rc_log10); + RC_ARRAY_MAPPER (log1p, FloatComplex, rc_log1p); + ARRAY_MAPPER (round, float, xround); + ARRAY_MAPPER (roundb, float, xroundb); + ARRAY_MAPPER (signum, float, ::signum); + ARRAY_MAPPER (sin, float, ::sinf); + ARRAY_MAPPER (sinh, float, ::sinhf); + RC_ARRAY_MAPPER (sqrt, FloatComplex, rc_sqrt); + ARRAY_MAPPER (tan, float, ::tanf); + ARRAY_MAPPER (tanh, float, ::tanhf); + ARRAY_MAPPER (isna, bool, octave_is_NA); + + default: + return octave_base_value::map (umap); + } +} + +DEFUN (single, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} single (@var{x})\n\ +Convert @var{x} to single precision type.\n\ +@seealso{double}\n\ +@end deftypefn") +{ + // The OCTAVE_TYPE_CONV_BODY3 macro declares retval, so they go + // inside their own scopes, and we don't declare retval here to + // avoid a shadowed declaration warning. + + if (args.length () == 1) + { + if (args(0).is_diag_matrix ()) + { + if (args(0).is_complex_type ()) + { + OCTAVE_TYPE_CONV_BODY3 (single, octave_float_complex_diag_matrix, octave_float_complex); + } + else + { + OCTAVE_TYPE_CONV_BODY3 (single, octave_float_diag_matrix, octave_float_scalar); + } + } + else if (args(0).is_sparse_type ()) + { + error ("single: sparse type does not support single precision"); + } + else if (args(0).is_complex_type ()) + { + OCTAVE_TYPE_CONV_BODY3 (single, octave_float_complex_matrix, octave_float_complex); + } + else + { + OCTAVE_TYPE_CONV_BODY3 (single, octave_float_matrix, octave_float_scalar); + } + } + else + print_usage (); + + return octave_value (); +} + +/* +%!assert (class (single (1)), "single") +%!assert (class (single (1 + i)), "single") +%!assert (class (single (int8 (1))), "single") +%!assert (class (single (uint8 (1))), "single") +%!assert (class (single (int16 (1))), "single") +%!assert (class (single (uint16 (1))), "single") +%!assert (class (single (int32 (1))), "single") +%!assert (class (single (uint32 (1))), "single") +%!assert (class (single (int64 (1))), "single") +%!assert (class (single (uint64 (1))), "single") +%!assert (class (single (true)), "single") +%!assert (class (single ("A")), "single") +%!error (single (sparse (1))) +%!test +%! x = diag ([1 3 2]); +%! y = single (x); +%! assert (class (x), "double"); +%! assert (class (y), "single"); +%!test +%! x = diag ([i 3 2]); +%! y = single (x); +%! assert (class (x), "double"); +%! assert (class (y), "single"); +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-flt-re-mat.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-flt-re-mat.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,214 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_float_matrix_h) +#define octave_float_matrix_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-stream.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-typeinfo.h" + +#include "MatrixType.h" + +class octave_value_list; + +class tree_walker; + +// Real matrix values. + +class +OCTINTERP_API +octave_float_matrix : public octave_base_matrix +{ +public: + + octave_float_matrix (void) + : octave_base_matrix () { } + + octave_float_matrix (const FloatMatrix& m) + : octave_base_matrix (m) { } + + octave_float_matrix (const FloatMatrix& m, const MatrixType& t) + : octave_base_matrix (m, t) { } + + octave_float_matrix (const FloatNDArray& nda) + : octave_base_matrix (nda) { } + + octave_float_matrix (const Array& m) + : octave_base_matrix (FloatNDArray (m)) { } + + octave_float_matrix (const FloatDiagMatrix& d) + : octave_base_matrix (FloatMatrix (d)) { } + + octave_float_matrix (const FloatRowVector& v) + : octave_base_matrix (FloatMatrix (v)) { } + + octave_float_matrix (const FloatColumnVector& v) + : octave_base_matrix (FloatMatrix (v)) { } + + octave_float_matrix (const octave_float_matrix& m) + : octave_base_matrix (m) { } + + ~octave_float_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_float_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_float_matrix (); } + + octave_base_value *try_narrowing_conversion (void); + + idx_vector index_vector (void) const + { return idx_cache ? *idx_cache : set_idx_cache (idx_vector (matrix)); } + + builtin_type_t builtin_type (void) const { return btyp_float; } + + bool is_real_matrix (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_single_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + int8NDArray + int8_array_value (void) const { return int8NDArray (matrix); } + + int16NDArray + int16_array_value (void) const { return int16NDArray (matrix); } + + int32NDArray + int32_array_value (void) const { return int32NDArray (matrix); } + + int64NDArray + int64_array_value (void) const { return int64NDArray (matrix); } + + uint8NDArray + uint8_array_value (void) const { return uint8NDArray (matrix); } + + uint16NDArray + uint16_array_value (void) const { return uint16NDArray (matrix); } + + uint32NDArray + uint32_array_value (void) const { return uint32NDArray (matrix); } + + uint64NDArray + uint64_array_value (void) const { return uint64NDArray (matrix); } + + double double_value (bool = false) const; + + float float_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + float float_scalar_value (bool frc_str_conv = false) const + { return float_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const; + + FloatMatrix float_matrix_value (bool = false) const; + + Complex complex_value (bool = false) const; + + FloatComplex float_complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + FloatComplexMatrix float_complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const; + + FloatComplexNDArray float_complex_array_value (bool = false) const; + + boolNDArray bool_array_value (bool warn = false) const; + + charNDArray char_array_value (bool = false) const; + + NDArray array_value (bool = false) const; + + FloatNDArray float_array_value (bool = false) const { return matrix; } + + SparseMatrix sparse_matrix_value (bool = false) const; + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; + + octave_value diag (octave_idx_type k = 0) const; + + octave_value diag (octave_idx_type m, octave_idx_type n) const; + + // Use matrix_ref here to clear index cache. + void increment (void) { matrix_ref () += 1.0; } + + void decrement (void) { matrix_ref () -= 1.0; } + + void changesign (void) { matrix_ref ().changesign (); } + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { return os.write (matrix, block_size, output_type, skip, flt_fmt); } + + // Unsafe. This function exists to support the MEX interface. + // You should not use it anywhere else. + void *mex_get_data (void) const { return matrix.mex_get_data (); } + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const; + +private: + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-int-traits.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-int-traits.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,63 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_value_int_traits_h) +#define octave_value_int_traits_h 1 + +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" + +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" + +template +class +octave_value_int_traits +{ +public: + typedef T scalar_type; +}; + +#define OCTAVE_VALUE_INT_TRAITS(MT, ST) \ + template<> \ + class \ + octave_value_int_traits \ + { \ + public: \ + typedef ST scalar_type; \ + } + +OCTAVE_VALUE_INT_TRAITS(int8NDArray, octave_int8_scalar); +OCTAVE_VALUE_INT_TRAITS(int16NDArray, octave_int16_scalar); +OCTAVE_VALUE_INT_TRAITS(int32NDArray, octave_int32_scalar); +OCTAVE_VALUE_INT_TRAITS(int64NDArray, octave_int64_scalar); + +OCTAVE_VALUE_INT_TRAITS(uint8NDArray, octave_uint8_scalar); +OCTAVE_VALUE_INT_TRAITS(uint16NDArray, octave_uint16_scalar); +OCTAVE_VALUE_INT_TRAITS(uint32NDArray, octave_uint32_scalar); +OCTAVE_VALUE_INT_TRAITS(uint64NDArray, octave_uint64_scalar); + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-int16.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-int16.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,93 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "lo-ieee.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "quit.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "ops.h" +#include "ov-base.h" + +#ifdef HAVE_HDF5 +#define HDF5_SAVE_TYPE H5T_NATIVE_INT16 +#endif + +#include "ov-base-int.h" +#include "ov-base-int.cc" +#include "ov-int16.h" +#include "ov-type-conv.h" +#include "pr-output.h" +#include "variables.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +template class octave_base_matrix; + +template class octave_base_int_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_int16_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int16_matrix, + "int16 matrix", "int16"); + +template class octave_base_scalar; + +template class octave_base_int_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_int16_scalar); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int16_scalar, + "int16 scalar", "int16"); + +DEFUN (int16, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} int16 (@var{x})\n\ +Convert @var{x} to 16-bit integer type.\n\ +@end deftypefn") +{ + OCTAVE_TYPE_CONV_BODY (int16); +} + +/* +%!assert (class (int16 (1)), "int16") +%!assert (int16 (1.25), int16 (1)) +%!assert (int16 (1.5), int16 (2)) +%!assert (int16 (-1.5), int16 (-2)) +%!assert (int16 (2^17), int16 (2^16-1)) +%!assert (int16 (-2^17), int16 (-2^16)) +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-int16.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-int16.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,56 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_int16_h) +#define octave_int16_h 1 + +#define OCTAVE_INT_T octave_int16 + +#define OCTAVE_VALUE_INT_MATRIX_T octave_int16_matrix +#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION int16_array_value + +#define OCTAVE_VALUE_INT_SCALAR_T octave_int16_scalar +#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION int16_scalar_value + +#define OCTAVE_TYPE_PREDICATE_FUNCTION is_int16_type + +#define OCTAVE_INT_MX_CLASS mxINT16_CLASS + +#define OCTAVE_INT_BTYP btyp_int16 + +#include "ov-intx.h" + +#undef OCTAVE_INT_T + +#undef OCTAVE_VALUE_INT_MATRIX_T +#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION + +#undef OCTAVE_VALUE_INT_SCALAR_T +#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION + +#undef OCTAVE_TYPE_PREDICATE_FUNCTION + +#undef OCTAVE_INT_MX_CLASS + +#undef OCTAVE_INT_BTYP + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-int32.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-int32.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,93 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "lo-ieee.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "quit.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "ops.h" +#include "ov-base.h" + +#ifdef HAVE_HDF5 +#define HDF5_SAVE_TYPE H5T_NATIVE_INT32 +#endif + +#include "ov-base-int.h" +#include "ov-base-int.cc" +#include "ov-int32.h" +#include "ov-type-conv.h" +#include "pr-output.h" +#include "variables.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +template class octave_base_matrix; + +template class octave_base_int_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_int32_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int32_matrix, + "int32 matrix", "int32"); + +template class octave_base_scalar; + +template class octave_base_int_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_int32_scalar); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int32_scalar, + "int32 scalar", "int32"); + +DEFUN (int32, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} int32 (@var{x})\n\ +Convert @var{x} to 32-bit integer type.\n\ +@end deftypefn") +{ + OCTAVE_TYPE_CONV_BODY (int32); +} + +/* +%!assert (class (int32 (1)), "int32") +%!assert (int32 (1.25), int32 (1)) +%!assert (int32 (1.5), int32 (2)) +%!assert (int32 (-1.5), int32 (-2)) +%!assert (int32 (2^33), int32 (2^32-1)) +%!assert (int32 (-2^33), int32 (-2^32)) +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-int32.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-int32.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,56 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_int32_h) +#define octave_int32_h 1 + +#define OCTAVE_INT_T octave_int32 + +#define OCTAVE_VALUE_INT_MATRIX_T octave_int32_matrix +#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION int32_array_value + +#define OCTAVE_VALUE_INT_SCALAR_T octave_int32_scalar +#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION int32_scalar_value + +#define OCTAVE_TYPE_PREDICATE_FUNCTION is_int32_type + +#define OCTAVE_INT_MX_CLASS mxINT32_CLASS + +#define OCTAVE_INT_BTYP btyp_int32 + +#include "ov-intx.h" + +#undef OCTAVE_INT_T + +#undef OCTAVE_VALUE_INT_MATRIX_T +#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION + +#undef OCTAVE_VALUE_INT_SCALAR_T +#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION + +#undef OCTAVE_TYPE_PREDICATE_FUNCTION + +#undef OCTAVE_INT_MX_CLASS + +#undef OCTAVE_INT_BTYP + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-int64.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-int64.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,93 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "lo-ieee.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "quit.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "ops.h" +#include "ov-base.h" + +#ifdef HAVE_HDF5 +#define HDF5_SAVE_TYPE H5T_NATIVE_INT64 +#endif + +#include "ov-base-int.h" +#include "ov-base-int.cc" +#include "ov-int64.h" +#include "ov-type-conv.h" +#include "pr-output.h" +#include "variables.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +template class octave_base_matrix; + +template class octave_base_int_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_int64_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int64_matrix, + "int64 matrix", "int64"); + +template class octave_base_scalar; + +template class octave_base_int_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_int64_scalar); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int64_scalar, + "int64 scalar", "int64"); + +DEFUN (int64, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} int64 (@var{x})\n\ +Convert @var{x} to 64-bit integer type.\n\ +@end deftypefn") +{ + OCTAVE_TYPE_CONV_BODY (int64); +} + +/* +%!assert (class (int64 (1)), "int64") +%!assert (int64 (1.25), int64 (1)) +%!assert (int64 (1.5), int64 (2)) +%!assert (int64 (-1.5), int64 (-2)) +%!assert (int64 (2^65), int64 (2^64-1)) +%!assert (int64 (-2^65), int64 (-2^64)) +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-int64.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-int64.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,56 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_int64_h) +#define octave_int64_h 1 + +#define OCTAVE_INT_T octave_int64 + +#define OCTAVE_VALUE_INT_MATRIX_T octave_int64_matrix +#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION int64_array_value + +#define OCTAVE_VALUE_INT_SCALAR_T octave_int64_scalar +#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION int64_scalar_value + +#define OCTAVE_TYPE_PREDICATE_FUNCTION is_int64_type + +#define OCTAVE_INT_MX_CLASS mxINT64_CLASS + +#define OCTAVE_INT_BTYP btyp_int64 + +#include "ov-intx.h" + +#undef OCTAVE_INT_T + +#undef OCTAVE_VALUE_INT_MATRIX_T +#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION + +#undef OCTAVE_VALUE_INT_SCALAR_T +#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION + +#undef OCTAVE_TYPE_PREDICATE_FUNCTION + +#undef OCTAVE_INT_MX_CLASS + +#undef OCTAVE_INT_BTYP + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-int8.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-int8.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,93 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "lo-ieee.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "quit.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "ops.h" +#include "ov-base.h" + +#ifdef HAVE_HDF5 +#define HDF5_SAVE_TYPE H5T_NATIVE_INT8 +#endif + +#include "ov-base-int.h" +#include "ov-base-int.cc" +#include "ov-int8.h" +#include "ov-type-conv.h" +#include "pr-output.h" +#include "variables.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +template class octave_base_matrix; + +template class octave_base_int_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_int8_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int8_matrix, + "int8 matrix", "int8"); + +template class octave_base_scalar; + +template class octave_base_int_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_int8_scalar); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int8_scalar, + "int8 scalar", "int8"); + +DEFUN (int8, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} int8 (@var{x})\n\ +Convert @var{x} to 8-bit integer type.\n\ +@end deftypefn") +{ + OCTAVE_TYPE_CONV_BODY (int8); +} + +/* +%!assert (class (int8 (1)), "int8") +%!assert (int8 (1.25), int8 (1)) +%!assert (int8 (1.5), int8 (2)) +%!assert (int8 (-1.5), int8 (-2)) +%!assert (int8 (2^9), int8 (2^8-1)) +%!assert (int8 (-2^9), int8 (-2^8)) +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-int8.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-int8.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,56 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_int8_h) +#define octave_int8_h 1 + +#define OCTAVE_INT_T octave_int8 + +#define OCTAVE_VALUE_INT_MATRIX_T octave_int8_matrix +#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION int8_array_value + +#define OCTAVE_VALUE_INT_SCALAR_T octave_int8_scalar +#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION int8_scalar_value + +#define OCTAVE_TYPE_PREDICATE_FUNCTION is_int8_type + +#define OCTAVE_INT_MX_CLASS mxINT8_CLASS + +#define OCTAVE_INT_BTYP btyp_int8 + +#include "ov-intx.h" + +#undef OCTAVE_INT_T + +#undef OCTAVE_VALUE_INT_MATRIX_T +#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION + +#undef OCTAVE_VALUE_INT_SCALAR_T +#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION + +#undef OCTAVE_TYPE_PREDICATE_FUNCTION + +#undef OCTAVE_INT_MX_CLASS + +#undef OCTAVE_INT_BTYP + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-intx.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-intx.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,668 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#include + +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-stream.h" +#include "ov-base.h" +#include "ov-base-int.h" +#include "ov-typeinfo.h" +#include "gripes.h" + +#include "ov-re-mat.h" +#include "ov-scalar.h" + +class +OCTINTERP_API +OCTAVE_VALUE_INT_MATRIX_T + : public octave_base_int_matrix > +{ +public: + + OCTAVE_VALUE_INT_MATRIX_T (void) + : octave_base_int_matrix > () { } + + OCTAVE_VALUE_INT_MATRIX_T (const intNDArray& nda) + : octave_base_int_matrix > (nda) { } + + OCTAVE_VALUE_INT_MATRIX_T (const Array& nda) + : octave_base_int_matrix > + (intNDArray (nda)) { } + + ~OCTAVE_VALUE_INT_MATRIX_T (void) { } + + octave_base_value *clone (void) const + { return new OCTAVE_VALUE_INT_MATRIX_T (*this); } + + octave_base_value *empty_clone (void) const + { return new OCTAVE_VALUE_INT_MATRIX_T (); } + + bool OCTAVE_TYPE_PREDICATE_FUNCTION (void) const { return true; } + + bool is_integer_type (void) const { return true; } + + builtin_type_t builtin_type (void) const { return OCTAVE_INT_BTYP; } + +public: + + int8NDArray + int8_array_value (void) const { return int8NDArray (matrix); } + + int16NDArray + int16_array_value (void) const { return int16NDArray (matrix); } + + int32NDArray + int32_array_value (void) const { return int32NDArray (matrix); } + + int64NDArray + int64_array_value (void) const { return int64NDArray (matrix); } + + uint8NDArray + uint8_array_value (void) const { return uint8NDArray (matrix); } + + uint16NDArray + uint16_array_value (void) const { return uint16NDArray (matrix); } + + uint32NDArray + uint32_array_value (void) const { return uint32NDArray (matrix); } + + uint64NDArray + uint64_array_value (void) const { return uint64NDArray (matrix); } + + double + double_value (bool = false) const + { + double retval = lo_ieee_nan_value (); + + if (numel () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + type_name (), "real scalar"); + + retval = matrix(0).double_value (); + } + else + gripe_invalid_conversion (type_name (), "real scalar"); + + return retval; + + } + + float + float_value (bool = false) const + { + float retval = lo_ieee_float_nan_value (); + + if (numel () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + type_name (), "real scalar"); + + retval = matrix(0).float_value (); + } + else + gripe_invalid_conversion (type_name (), "real scalar"); + + return retval; + + } + + double scalar_value (bool = false) const { return double_value (); } + + float float_scalar_value (bool = false) const { return float_value (); } + + Matrix + matrix_value (bool = false) const + { + Matrix retval; + dim_vector dv = dims (); + if (dv.length () > 2) + error ("invalid conversion of %s to Matrix", type_name ().c_str ()); + else + { + retval = Matrix (dv(0), dv(1)); + double *vec = retval.fortran_vec (); + octave_idx_type nel = matrix.numel (); + for (octave_idx_type i = 0; i < nel; i++) + vec[i] = matrix(i).double_value (); + } + return retval; + } + + FloatMatrix + float_matrix_value (bool = false) const + { + FloatMatrix retval; + dim_vector dv = dims (); + if (dv.length () > 2) + error ("invalid conversion of %s to FloatMatrix", type_name ().c_str ()); + else + { + retval = FloatMatrix (dv(0), dv(1)); + float *vec = retval.fortran_vec (); + octave_idx_type nel = matrix.numel (); + for (octave_idx_type i = 0; i < nel; i++) + vec[i] = matrix(i).float_value (); + } + return retval; + } + + ComplexMatrix + complex_matrix_value (bool = false) const + { + ComplexMatrix retval; + dim_vector dv = dims (); + if (dv.length () > 2) + error ("invalid conversion of %s to Matrix", type_name ().c_str ()); + else + { + retval = ComplexMatrix (dv(0), dv(1)); + Complex *vec = retval.fortran_vec (); + octave_idx_type nel = matrix.numel (); + for (octave_idx_type i = 0; i < nel; i++) + vec[i] = Complex (matrix(i).double_value ()); + } + return retval; + } + + FloatComplexMatrix + float_complex_matrix_value (bool = false) const + { + FloatComplexMatrix retval; + dim_vector dv = dims (); + if (dv.length () > 2) + error ("invalid conversion of %s to FloatMatrix", type_name ().c_str ()); + else + { + retval = FloatComplexMatrix (dv(0), dv(1)); + FloatComplex *vec = retval.fortran_vec (); + octave_idx_type nel = matrix.numel (); + for (octave_idx_type i = 0; i < nel; i++) + vec[i] = FloatComplex (matrix(i).float_value ()); + } + return retval; + } + + NDArray + array_value (bool = false) const + { + NDArray retval (matrix.dims ()); + double *vec = retval.fortran_vec (); + octave_idx_type nel = matrix.numel (); + for (octave_idx_type i = 0; i < nel; i++) + vec[i] = matrix(i).double_value (); + return retval; + } + + FloatNDArray + float_array_value (bool = false) const + { + FloatNDArray retval (matrix.dims ()); + float *vec = retval.fortran_vec (); + octave_idx_type nel = matrix.numel (); + for (octave_idx_type i = 0; i < nel; i++) + vec[i] = matrix(i).float_value (); + return retval; + } + + ComplexNDArray + complex_array_value (bool = false) const + { + ComplexNDArray retval (matrix.dims ()); + Complex *vec = retval.fortran_vec (); + octave_idx_type nel = matrix.numel (); + for (octave_idx_type i = 0; i < nel; i++) + vec[i] = Complex (matrix(i).double_value ()); + return retval; + } + + FloatComplexNDArray + float_complex_array_value (bool = false) const + { + FloatComplexNDArray retval (matrix.dims ()); + FloatComplex *vec = retval.fortran_vec (); + octave_idx_type nel = matrix.numel (); + for (octave_idx_type i = 0; i < nel; i++) + vec[i] = FloatComplex (matrix(i).float_value ()); + return retval; + } + + boolNDArray + bool_array_value (bool warn = false) const + { + boolNDArray retval (dims ()); + + octave_idx_type nel = numel (); + + if (warn && matrix.any_element_not_one_or_zero ()) + gripe_logical_conversion (); + + bool *vec = retval.fortran_vec (); + for (octave_idx_type i = 0; i < nel; i++) + vec[i] = matrix(i).bool_value (); + + return retval; + } + + charNDArray + char_array_value (bool = false) const + { + charNDArray retval (dims ()); + + octave_idx_type nel = numel (); + + char *vec = retval.fortran_vec (); + for (octave_idx_type i = 0; i < nel; i++) + vec[i] = matrix(i).char_value (); + + return retval; + } + + // Use matrix_ref here to clear index cache. + void increment (void) + { + matrix_ref () += OCTAVE_INT_T (1); + } + + void decrement (void) + { + matrix_ref () -= OCTAVE_INT_T (1); + } + + void changesign (void) + { + matrix_ref ().changesign (); + } + + idx_vector index_vector (void) const + { return idx_cache ? *idx_cache : set_idx_cache (idx_vector (matrix)); } + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { return os.write (matrix, block_size, output_type, skip, flt_fmt); } + + // Unsafe. This function exists to support the MEX interface. + // You should not use it anywhere else. + void *mex_get_data (void) const { return matrix.mex_get_data (); } + + mxArray *as_mxArray (void) const + { + mxArray *retval = new mxArray (OCTAVE_INT_MX_CLASS, dims (), mxREAL); + + OCTAVE_INT_T::val_type *pr = static_cast (retval->get_data ()); + + mwSize nel = numel (); + + const OCTAVE_INT_T *p = matrix.data (); + + for (mwIndex i = 0; i < nel; i++) + pr[i] = p[i].value (); + + return retval; + } + + octave_value map (unary_mapper_t umap) const + { + switch (umap) + { + case umap_abs: + return matrix.abs (); + case umap_signum: + return matrix.signum (); + case umap_ceil: + case umap_conj: + case umap_fix: + case umap_floor: + case umap_real: + case umap_round: + return matrix; + case umap_imag: + return intNDArray (matrix.dims (), OCTAVE_INT_T ()); + case umap_isnan: + case umap_isna: + case umap_isinf: + return boolNDArray (matrix.dims (), false); + case umap_finite: + return boolNDArray (matrix.dims (), true); + + default: + { + octave_matrix m (array_value ()); + return m.map (umap); + } + } + } + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +class +OCTINTERP_API +OCTAVE_VALUE_INT_SCALAR_T + : public octave_base_int_scalar +{ +public: + + OCTAVE_VALUE_INT_SCALAR_T (void) + : octave_base_int_scalar () { } + + OCTAVE_VALUE_INT_SCALAR_T (const OCTAVE_INT_T& nda) + : octave_base_int_scalar (nda) { } + + ~OCTAVE_VALUE_INT_SCALAR_T (void) { } + + octave_base_value *clone (void) const + { return new OCTAVE_VALUE_INT_SCALAR_T (*this); } + + octave_base_value *empty_clone (void) const + { return new OCTAVE_VALUE_INT_MATRIX_T (); } + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false) + { + // FIXME -- this doesn't solve the problem of + // + // a = 1; a([1,1], [1,1], [1,1]) + // + // and similar constructions. Hmm... + + // FIXME -- using this constructor avoids narrowing the + // 1x1 matrix back to a scalar value. Need a better solution + // to this problem. + + octave_value tmp + (new OCTAVE_VALUE_INT_MATRIX_T + (OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION ())); + + return tmp.do_index_op (idx, resize_ok); + } + + bool OCTAVE_TYPE_PREDICATE_FUNCTION (void) const { return true; } + + bool is_integer_type (void) const { return true; } + + builtin_type_t builtin_type (void) const { return OCTAVE_INT_BTYP; } + +public: + + octave_int8 + int8_scalar_value (void) const { return octave_int8 (scalar); } + + octave_int16 + int16_scalar_value (void) const { return octave_int16 (scalar); } + + octave_int32 + int32_scalar_value (void) const { return octave_int32 (scalar); } + + octave_int64 + int64_scalar_value (void) const { return octave_int64 (scalar); } + + octave_uint8 + uint8_scalar_value (void) const { return octave_uint8 (scalar); } + + octave_uint16 + uint16_scalar_value (void) const { return octave_uint16 (scalar); } + + octave_uint32 + uint32_scalar_value (void) const { return octave_uint32 (scalar); } + + octave_uint64 + uint64_scalar_value (void) const { return octave_uint64 (scalar); } + + int8NDArray + int8_array_value (void) const + { return int8NDArray (dim_vector (1, 1), int8_scalar_value ()); } + + int16NDArray + int16_array_value (void) const + { return int16NDArray (dim_vector (1, 1), int16_scalar_value ()); } + + int32NDArray + int32_array_value (void) const + { return int32NDArray (dim_vector (1, 1), int32_scalar_value ()); } + + int64NDArray + int64_array_value (void) const + { return int64NDArray (dim_vector (1, 1), int64_scalar_value ()); } + + uint8NDArray + uint8_array_value (void) const + { return uint8NDArray (dim_vector (1, 1), uint8_scalar_value ()); } + + uint16NDArray + uint16_array_value (void) const + { return uint16NDArray (dim_vector (1, 1), uint16_scalar_value ()); } + + uint32NDArray + uint32_array_value (void) const + { return uint32NDArray (dim_vector (1, 1), uint32_scalar_value ()); } + + uint64NDArray + uint64_array_value (void) const + { return uint64NDArray (dim_vector (1, 1), uint64_scalar_value ()); } + + octave_value resize (const dim_vector& dv, bool fill = false) const + { + if (fill) + { + intNDArray retval (dv, 0); + if (dv.numel ()) + retval(0) = scalar; + return retval; + } + else + { + intNDArray retval (dv); + if (dv.numel ()) + retval(0) = scalar; + return retval; + } + } + + double double_value (bool = false) const { return scalar.double_value (); } + + float float_value (bool = false) const { return scalar.float_value (); } + + double scalar_value (bool = false) const { return scalar.double_value (); } + + float float_scalar_value (bool = false) const { return scalar.float_value (); } + + Matrix + matrix_value (bool = false) const + { + Matrix retval (1, 1); + retval(0,0) = scalar.double_value (); + return retval; + } + + FloatMatrix + float_matrix_value (bool = false) const + { + FloatMatrix retval (1, 1); + retval(0,0) = scalar.float_value (); + return retval; + } + + ComplexMatrix + complex_matrix_value (bool = false) const + { + ComplexMatrix retval (1, 1); + retval(0,0) = Complex (scalar.double_value ()); + return retval; + } + + FloatComplexMatrix + float_complex_matrix_value (bool = false) const + { + FloatComplexMatrix retval (1, 1); + retval(0,0) = FloatComplex (scalar.float_value ()); + return retval; + } + + NDArray + array_value (bool = false) const + { + NDArray retval (dim_vector (1, 1)); + retval(0) = scalar.double_value (); + return retval; + } + + FloatNDArray + float_array_value (bool = false) const + { + FloatNDArray retval (dim_vector (1, 1)); + retval(0) = scalar.float_value (); + return retval; + } + + ComplexNDArray + complex_array_value (bool = false) const + { + ComplexNDArray retval (dim_vector (1, 1)); + retval(0) = FloatComplex (scalar.double_value ()); + return retval; + } + + FloatComplexNDArray + float_complex_array_value (bool = false) const + { + FloatComplexNDArray retval (dim_vector (1, 1)); + retval(0) = FloatComplex (scalar.float_value ()); + return retval; + } + + bool bool_value (bool warn = false) const + { + if (warn && scalar != 0.0 && scalar != 1.0) + gripe_logical_conversion (); + + return scalar.bool_value (); + } + + boolNDArray + bool_array_value (bool warn = false) const + { + boolNDArray retval (dim_vector (1, 1)); + + if (warn && scalar != 0.0 && scalar != 1.0) + gripe_logical_conversion (); + + retval(0) = scalar.bool_value (); + + return retval; + } + + charNDArray + char_array_value (bool = false) const + { + charNDArray retval (dim_vector (1, 1)); + retval(0) = scalar.char_value (); + return retval; + } + + void increment (void) + { + scalar += OCTAVE_INT_T (1); + } + + void decrement (void) + { + scalar -= OCTAVE_INT_T (1); + } + + idx_vector index_vector (void) const { return idx_vector (scalar); } + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, octave_idx_type skip, + oct_mach_info::float_format flt_fmt) const + { + return os.write (OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION (), + block_size, output_type, skip, flt_fmt); + } + + // Unsafe. This function exists to support the MEX interface. + // You should not use it anywhere else. + void *mex_get_data (void) const { return scalar.mex_get_data (); } + + mxArray *as_mxArray (void) const + { + mxArray *retval = new mxArray (OCTAVE_INT_MX_CLASS, 1, 1, mxREAL); + + OCTAVE_INT_T::val_type *pr = static_cast (retval->get_data ()); + + pr[0] = scalar.value (); + + return retval; + } + + octave_value map (unary_mapper_t umap) const + { + switch (umap) + { + case umap_abs: + return scalar.abs (); + case umap_signum: + return scalar.signum (); + case umap_ceil: + case umap_conj: + case umap_fix: + case umap_floor: + case umap_real: + case umap_round: + return scalar; + case umap_imag: + return OCTAVE_INT_T (); + case umap_isnan: + case umap_isna: + case umap_isinf: + return false; + case umap_finite: + return true; + + default: + { + octave_scalar m (scalar_value ()); + return m.map (umap); + } + } + } + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-lazy-idx.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-lazy-idx.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,197 @@ +/* + +Copyright (C) 2010-2012 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "ov-lazy-idx.h" +#include "ops.h" +#include "ov-scalar.h" +#include "ls-oct-ascii.h" +#include "ls-oct-binary.h" + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_lazy_index, "lazy_index", "double"); + +static octave_base_value * +default_numeric_conversion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_lazy_index&); + + return v.full_value ().clone (); +} + +octave_base_value::type_conv_info +octave_lazy_index::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_conversion_function, + octave_matrix::static_type_id ()); +} + +octave_base_value * +octave_lazy_index::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + switch (index.length (0)) + { + case 1: + retval = new octave_scalar (static_cast (index(0) + 1)); + break; + + case 0: + retval = new octave_matrix (NDArray (index.orig_dimensions ())); + break; + + default: + break; + } + + return retval; +} + +octave_value +octave_lazy_index::reshape (const dim_vector& new_dims) const +{ + return idx_vector (index.as_array ().reshape (new_dims), + index.extent (0)); +} + +octave_value +octave_lazy_index::permute (const Array& vec, bool inv) const +{ + // If the conversion has already been made, forward the operation. + if (value.is_defined ()) + return value.permute (vec, inv); + else + return idx_vector (index.as_array ().permute (vec, inv), + index.extent (0)); +} + +octave_value +octave_lazy_index::squeeze (void) const +{ + return idx_vector (index.as_array ().squeeze (), + index.extent (0)); +} + +octave_value +octave_lazy_index::sort (octave_idx_type dim, sortmode mode) const +{ + const dim_vector odims = index.orig_dimensions (); + // index_vector can employ a more efficient sorting algorithm. + if (mode == ASCENDING && odims.length () == 2 + && (dim >= 0 && dim <= 1) && odims (1-dim) == 1) + return index_vector ().sorted (); + else + return idx_vector (index.as_array ().sort (dim, mode), + index.extent (0)); +} + +octave_value +octave_lazy_index::sort (Array &sidx, octave_idx_type dim, + sortmode mode) const +{ + const dim_vector odims = index.orig_dimensions (); + // index_vector can employ a more efficient sorting algorithm. + if (mode == ASCENDING && odims.length () == 2 + && (dim >= 0 && dim <= 1) && odims (1-dim) == 1) + return index_vector ().sorted (sidx); + else + return idx_vector (index.as_array ().sort (sidx, dim, mode), + index.extent (0)); +} + +sortmode +octave_lazy_index::is_sorted (sortmode mode) const +{ + if (index.is_range ()) + { + // Avoid the array conversion. + octave_idx_type inc = index.increment (); + if (inc == 0) + return (mode == UNSORTED ? ASCENDING : mode); + else if (inc > 0) + return (mode == DESCENDING ? UNSORTED : ASCENDING); + else + return (mode == ASCENDING ? UNSORTED : DESCENDING); + } + else + return index.as_array ().is_sorted (mode); +} + +Array +octave_lazy_index::sort_rows_idx (sortmode mode) const +{ + return index.as_array ().sort_rows_idx (mode); +} + +sortmode +octave_lazy_index::is_sorted_rows (sortmode mode) const +{ + return index.as_array ().is_sorted_rows (mode); +} + +static const std::string value_save_tag ("index_value"); + +bool octave_lazy_index::save_ascii (std::ostream& os) +{ + return save_ascii_data (os, make_value (), value_save_tag, false, 0); +} + +bool octave_lazy_index::load_ascii (std::istream& is) +{ + bool dummy; + + std::string nm = read_ascii_data (is, std::string (), dummy, value, 0); + + if (nm != value_save_tag) + error ("lazy_index: corrupted data on load"); + else + index = value.index_vector (); + + return ! error_state; +} + + +bool octave_lazy_index::save_binary (std::ostream& os, bool& save_as_floats) +{ + return save_binary_data (os, make_value (), value_save_tag, + std::string (), false, save_as_floats); +} + +bool octave_lazy_index::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + bool dummy; + std::string doc; + + std::string nm = read_binary_data (is, swap, fmt, std::string (), + dummy, value, doc); + + if (nm != value_save_tag) + error ("lazy_index: corrupted data on load"); + else + index = value.index_vector (); + + return ! error_state; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-lazy-idx.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-lazy-idx.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,250 @@ +/* + +Copyright (C) 2010-2012 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_lazy_idx_h) +#define octave_lazy_idx_h 1 + +#include "ov-re-mat.h" + +// Lazy indices that stay in idx_vector form until the conversion to NDArray is +// actually needed. + +class +OCTINTERP_API +octave_lazy_index : public octave_base_value +{ +public: + + octave_lazy_index (void) + : octave_base_value (), index (), value () { } + + octave_lazy_index (const idx_vector& idx) + : octave_base_value (), index (idx), value () { } + + octave_lazy_index (const octave_lazy_index& i) + : octave_base_value (), index (i.index), value (i.value) { } + + ~octave_lazy_index (void) { } + + octave_base_value *clone (void) const { return new octave_lazy_index (*this); } + octave_base_value *empty_clone (void) const { return new octave_matrix (); } + + type_conv_info numeric_conversion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + size_t byte_size (void) const { return numel () * sizeof (octave_idx_type); } + + octave_value squeeze (void) const; + + octave_value full_value (void) const { return make_value (); } + + idx_vector index_vector (void) const + { return index; } + + builtin_type_t builtin_type (void) const { return btyp_double; } + + bool is_real_matrix (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + octave_value subsref (const std::string& type, + const std::list& idx) + { return make_value ().subsref (type, idx); } + + octave_value_list subsref (const std::string& type, + const std::list& idx, int) + { return subsref (type, idx); } + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false) + { return make_value ().do_index_op (idx, resize_ok); } + + dim_vector dims (void) const { return index.orig_dimensions (); } + + octave_idx_type numel (void) const { return index.length (0); } + + octave_idx_type nnz (void) const { return numel (); } + + octave_value reshape (const dim_vector& new_dims) const; + + octave_value permute (const Array& vec, bool inv = false) const; + + octave_value resize (const dim_vector& dv, bool fill = false) const + { return make_value ().resize (dv, fill); } + + octave_value all (int dim = 0) const { return make_value ().all (dim); } + octave_value any (int dim = 0) const { return make_value ().any (dim); } + + MatrixType matrix_type (void) const { return make_value ().matrix_type (); } + MatrixType matrix_type (const MatrixType& _typ) const + { return make_value ().matrix_type (_typ); } + + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const; + + octave_value sort (Array &sidx, octave_idx_type dim = 0, + sortmode mode = ASCENDING) const; + + sortmode is_sorted (sortmode mode = UNSORTED) const; + + Array sort_rows_idx (sortmode mode = ASCENDING) const; + + sortmode is_sorted_rows (sortmode mode = UNSORTED) const; + + bool is_matrix_type (void) const { return true; } + + bool is_numeric_type (void) const { return true; } + + bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + + bool is_true (void) const + { return make_value ().is_true (); } + + bool print_as_scalar (void) const + { return make_value ().print_as_scalar (); } + + void print (std::ostream& os, bool pr_as_read_syntax = false) const + { make_value ().print (os, pr_as_read_syntax); } + + void print_info (std::ostream& os, const std::string& prefix) const + { make_value ().print_info (os, prefix); } + +#define FORWARD_VALUE_QUERY(TYPE,NAME) \ + TYPE \ + NAME (void) const { return make_value ().NAME (); } + + FORWARD_VALUE_QUERY (int8NDArray, int8_array_value) + FORWARD_VALUE_QUERY (int16NDArray, int16_array_value) + FORWARD_VALUE_QUERY (int32NDArray, int32_array_value) + FORWARD_VALUE_QUERY (int64NDArray, int64_array_value) + FORWARD_VALUE_QUERY (uint8NDArray, uint8_array_value) + FORWARD_VALUE_QUERY (uint16NDArray, uint16_array_value) + FORWARD_VALUE_QUERY (uint32NDArray, uint32_array_value) + FORWARD_VALUE_QUERY (uint64NDArray, uint64_array_value) + +#define FORWARD_VALUE_QUERY1(TYPE,NAME) \ + TYPE \ + NAME (bool flag = false) const { return make_value ().NAME (flag); } + + FORWARD_VALUE_QUERY1 (double, double_value) + + FORWARD_VALUE_QUERY1 (float, float_value) + + FORWARD_VALUE_QUERY1 (double, scalar_value) + + FORWARD_VALUE_QUERY1 (Matrix, matrix_value) + + FORWARD_VALUE_QUERY1 (FloatMatrix, float_matrix_value) + + FORWARD_VALUE_QUERY1 (Complex, complex_value) + + FORWARD_VALUE_QUERY1 (FloatComplex, float_complex_value) + + FORWARD_VALUE_QUERY1 (ComplexMatrix, complex_matrix_value) + + FORWARD_VALUE_QUERY1 (FloatComplexMatrix, float_complex_matrix_value) + + FORWARD_VALUE_QUERY1 (ComplexNDArray, complex_array_value) + + FORWARD_VALUE_QUERY1 (FloatComplexNDArray, float_complex_array_value) + + FORWARD_VALUE_QUERY1 (boolNDArray, bool_array_value) + + FORWARD_VALUE_QUERY1 (charNDArray, char_array_value) + + FORWARD_VALUE_QUERY1 (NDArray, array_value) + + FORWARD_VALUE_QUERY1 (FloatNDArray, float_array_value) + + FORWARD_VALUE_QUERY1 (SparseMatrix, sparse_matrix_value) + + FORWARD_VALUE_QUERY1 (SparseComplexMatrix, sparse_complex_matrix_value) + + octave_value diag (octave_idx_type k = 0) const + { return make_value ().diag (k); } + + octave_value convert_to_str_internal (bool pad, bool force, char type) const + { return make_value ().convert_to_str_internal (pad, force, type); } + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const + { return make_value ().print_raw (os, pr_as_read_syntax); } + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + + // HDF5 functions not defined. + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { return make_value ().write (os, block_size, output_type, skip, flt_fmt); } + + // Unsafe. This function exists to support the MEX interface. + // You should not use it anywhere else. + void *mex_get_data (void) const + { return make_value ().mex_get_data (); } + + mxArray *as_mxArray (void) const + { return make_value ().as_mxArray (); } + + octave_value map (unary_mapper_t umap) const + { return make_value ().map (umap); } + +private: + const octave_value& make_value (void) const + { + if (value.is_undefined ()) + value = octave_value (index, false); + + return value; + } + + octave_value& make_value (void) + { + if (value.is_undefined ()) + value = octave_value (index, false); + + return value; + } + + idx_vector index; + mutable octave_value value; + + static octave_base_value *numeric_conversion_function (const octave_base_value&); + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif + diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-mex-fcn.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-mex-fcn.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,162 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "oct-shlib.h" + +#include +#include "dynamic-ld.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "ov-mex-fcn.h" +#include "ov.h" +#include "profiler.h" +#include "toplev.h" +#include "unwind-prot.h" + +DEFINE_OCTAVE_ALLOCATOR (octave_mex_function); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_mex_function, + "mex function", "mex function"); + +octave_mex_function::octave_mex_function + (void *fptr, bool fmex, const octave_shlib& shl, + const std::string& nm) + : octave_function (nm), mex_fcn_ptr (fptr), exit_fcn_ptr (0), + have_fmex (fmex), sh_lib (shl) +{ + mark_fcn_file_up_to_date (time_parsed ()); + + std::string file_name = fcn_file_name (); + + system_fcn_file + = (! file_name.empty () + && Voct_file_dir == file_name.substr (0, Voct_file_dir.length ())); +} + +octave_mex_function::~octave_mex_function (void) +{ + if (exit_fcn_ptr) + (*exit_fcn_ptr) (); + + octave_dynamic_loader::remove_mex (my_name, sh_lib); +} + +std::string +octave_mex_function::fcn_file_name (void) const +{ + return sh_lib.file_name (); +} + +octave_time +octave_mex_function::time_parsed (void) const +{ + return sh_lib.time_loaded (); +} + +octave_value_list +octave_mex_function::subsref (const std::string& type, + const std::list& idx, + int nargout) +{ + octave_value_list retval; + + switch (type[0]) + { + case '(': + { + int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout; + + retval = do_multi_index_op (tmp_nargout, idx.front ()); + } + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + // FIXME -- perhaps there should be an + // octave_value_list::next_subsref member function? See also + // octave_user_function::subsref. + // + // FIXME -- Note that if a function call returns multiple + // values, and there is further indexing to perform, then we are + // ignoring all but the first value. Is this really what we want to + // do? If it is not, then what should happen for stat("file").size, + // for exmaple? + + if (idx.size () > 1) + retval = retval(0).next_subsref (nargout, type, idx); + + return retval; +} + +// FIXME -- shouldn't this declaration be a header file somewhere? +extern octave_value_list +call_mex (bool have_fmex, void *f, const octave_value_list& args, + int nargout, octave_mex_function *curr_mex_fcn); + +octave_value_list +octave_mex_function::do_multi_index_op (int nargout, + const octave_value_list& args) +{ + octave_value_list retval; + + if (error_state) + return retval; + + if (args.has_magic_colon ()) + ::error ("invalid use of colon in function argument list"); + else + { + unwind_protect frame; + + octave_call_stack::push (this); + + frame.add_fcn (octave_call_stack::pop); + + try + { + BEGIN_PROFILER_BLOCK (profiler_name ()) + retval = call_mex (have_fmex, mex_fcn_ptr, args, nargout, this); + END_PROFILER_BLOCK + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-mex-fcn.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-mex-fcn.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,122 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_mex_function_h) +#define octave_mex_function_h 1 + +#include + +#include "oct-shlib.h" + +#include "ov-fcn.h" +#include "ov-builtin.h" +#include "ov-typeinfo.h" + +class octave_shlib; + +class octave_value; +class octave_value_list; + +// Dynamically-linked functions. + +class +octave_mex_function : public octave_function +{ +public: + + octave_mex_function (void) + : mex_fcn_ptr (), exit_fcn_ptr (), have_fmex (), sh_lib (), + t_checked (), system_fcn_file () { } + + octave_mex_function (void *fptr, bool fmex, const octave_shlib& shl, + const std::string& nm = std::string ()); + + ~octave_mex_function (void); + + octave_value subsref (const std::string& type, + const std::list& idx) + { + octave_value_list tmp = subsref (type, idx, 1); + return tmp.length () > 0 ? tmp(0) : octave_value (); + } + + octave_value_list subsref (const std::string& type, + const std::list& idx, + int nargout); + + octave_function *function_value (bool = false) { return this; } + + const octave_function *function_value (bool = false) const { return this; } + + void mark_fcn_file_up_to_date (const octave_time& t) { t_checked = t; } + + std::string fcn_file_name (void) const; + + octave_time time_parsed (void) const; + + octave_time time_checked (void) const { return t_checked; } + + bool is_system_fcn_file (void) const { return system_fcn_file; } + + bool is_builtin_function (void) const { return false; } + + bool is_mex_function (void) const { return true; } + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& args); + + void atexit (void (*fcn) (void)) { exit_fcn_ptr = fcn; } + + octave_shlib get_shlib (void) const + { return sh_lib; } + +private: + + void *mex_fcn_ptr; + + void (*exit_fcn_ptr) (void); + + bool have_fmex; + + octave_shlib sh_lib; + + // The time the file was last checked to see if it needs to be + // parsed again. + mutable octave_time t_checked; + + // True if this function came from a file that is considered to be a + // system function. This affects whether we check the time stamp + // on the file to see if it has changed. + bool system_fcn_file; + + // No copying! + + octave_mex_function (const octave_mex_function& fn); + + octave_mex_function& operator = (const octave_mex_function& fn); + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-null-mat.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-null-mat.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,133 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "ov-null-mat.h" +#include "ops.h" +#include "defun.h" + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_null_matrix, "null_matrix", "double"); + +const octave_value octave_null_matrix::instance (new octave_null_matrix ()); + +static octave_base_value * +default_null_matrix_numeric_conversion_function (const octave_base_value& a) +{ + // The cast is not necessary? + // CAST_CONV_ARG (const octave_null_matrix&); + + return a.empty_clone (); +} + +octave_base_value::type_conv_info +octave_null_matrix::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_null_matrix_numeric_conversion_function, + octave_matrix::static_type_id ()); +} + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_null_str, "null_string", "char"); + +const octave_value octave_null_str::instance (new octave_null_str ()); + +static octave_base_value * +default_null_str_numeric_conversion_function (const octave_base_value& a) +{ + // The cast is not necessary? + // CAST_CONV_ARG (const octave_null_str&); + + return a.empty_clone (); +} + +octave_base_value::type_conv_info +octave_null_str::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_null_str_numeric_conversion_function, + octave_char_matrix_str::static_type_id ()); +} + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_null_sq_str, "null_sq_string", "char"); + +const octave_value octave_null_sq_str::instance (new octave_null_sq_str ()); + +static octave_base_value * +default_null_sq_str_numeric_conversion_function (const octave_base_value& a) +{ + // The cast is not necessary? + // CAST_CONV_ARG (const octave_null_sq_str&); + + return a.empty_clone (); +} + +octave_base_value::type_conv_info +octave_null_sq_str::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_null_sq_str_numeric_conversion_function, + octave_char_matrix_sq_str::static_type_id ()); +} + +DEFUN (isnull, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isnull (@var{x})\n\ +Return true if @var{x} is a special null matrix, string, or single quoted\n\ +string. Indexed assignment with such a value on the right-hand side should\n\ +delete array elements. This function should be used when overloading\n\ +indexed assignment for user-defined classes instead of @code{isempty}, to\n\ +distinguish the cases:\n\ +\n\ +@table @asis\n\ +@item @code{A(I) = []}\n\ +This should delete elements if @code{I} is nonempty.\n\ +\n\ +@item @code{X = []; A(I) = X}\n\ +This should give an error if @code{I} is nonempty.\n\ +@end table\n\ +@seealso{isempty, isindex}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 && args(0).is_defined ()) + retval = args(0).is_null_value (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isnull ([]), true) +%!assert (isnull ([1]), false) +%!assert (isnull (zeros (0,3)), false) +%!assert (isnull (""), true) +%!assert (isnull ("A"), false) +%!assert (isnull (''), true) +%!assert (isnull ('A'), false) +%!test +%! x = []; +%! assert (isnull (x), false); +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-null-mat.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-null-mat.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,100 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_null_matrix_h) +#define octave_null_matrix_h 1 + +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-str-mat.h" + +// Design rationale: +// The constructors are hidden. There is only one null matrix (or null string) object, +// that can have shallow copies. Cloning the object returns just a normal empty matrix, +// so all the shallow copies are, in fact, read-only. This conveniently ensures that any +// attempt to fiddle with the null matrix destroys its special status. + +// The special [] value. + +class +OCTINTERP_API +octave_null_matrix : public octave_matrix +{ + octave_null_matrix (void) : octave_matrix () { } + +public: + + static const octave_value instance; + + bool is_null_value (void) const { return true; } + + type_conv_info numeric_conversion_function (void) const; + +private: + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +// The special "" value + +class +OCTINTERP_API +octave_null_str : public octave_char_matrix_str +{ + octave_null_str (void) : octave_char_matrix_str () { } + +public: + + static const octave_value instance; + + bool is_null_value (void) const { return true; } + + type_conv_info numeric_conversion_function (void) const; + + +private: + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +// The special '' value + +class +OCTINTERP_API +octave_null_sq_str : public octave_char_matrix_sq_str +{ + octave_null_sq_str (void) : octave_char_matrix_sq_str () { } + +public: + + static const octave_value instance; + + bool is_null_value (void) const { return true; } + + type_conv_info numeric_conversion_function (void) const; + +private: + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-oncleanup.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-oncleanup.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,225 @@ +/* + +Copyright (C) 2010-2012 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "defun.h" +#include "ov-oncleanup.h" +#include "ov-fcn.h" +#include "ov-usr-fcn.h" +#include "pt-misc.h" +#include "toplev.h" + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_oncleanup, "onCleanup", + "onCleanup"); + +octave_oncleanup::octave_oncleanup (const octave_value& f) + : fcn (f) +{ + if (f.is_function_handle ()) + { + octave_function *fptr = f.function_value (true); + if (fptr) + { + octave_user_function *uptr + = dynamic_cast (fptr); + + if (uptr != 0) + { + tree_parameter_list *pl = uptr->parameter_list (); + + if (pl != 0 && pl->length () > 0) + warning ("onCleanup: cleanup action takes parameters"); + } + } + else + error ("onCleanup: no default dispatch for function handle"); + } + else + { + fcn = octave_value (); + error ("onCleanup: argument must be a function handle"); + } +} + +octave_oncleanup::~octave_oncleanup (void) +{ + if (fcn.is_undefined ()) + return; + + unwind_protect frame; + + // Clear interrupts. + frame.protect_var (octave_interrupt_state); + octave_interrupt_state = 0; + + // Disallow quit(). + frame.protect_var (quit_allowed); + quit_allowed = false; + + // Clear errors. + frame.protect_var (error_state); + error_state = 0; + + try + { + // Run the actual code. + fcn.do_multi_index_op (0, octave_value_list ()); + } + catch (octave_interrupt_exception) + { + // Swallow the interrupt. + warning ("onCleanup: interrupt occured in cleanup action"); + } + catch (std::bad_alloc) + { + // Swallow the exception. + warning ("onCleanup: out of memory occured in cleanup action"); + } + catch (...) // Yes, the black hole. We're in a d-tor. + { + // This shouldn't happen, in theory. + error ("onCleanup: internal error: unhandled exception in cleanup action"); + } + + // We don't want to ignore errors that occur in the cleanup code, so + // if an error is encountered there, leave error_state alone. + // Otherwise, set it back to what it was before. + if (error_state) + { + frame.discard_top (); + octave_call_stack::backtrace_error_message (); + } +} + +octave_scalar_map +octave_oncleanup::scalar_map_value (void) const +{ + octave_scalar_map retval; + retval.setfield ("task", fcn); + return retval; +} + +static void +warn_save_load (void) +{ + warning ("onCleanup: load and save not supported"); +} + +bool +octave_oncleanup::save_ascii (std::ostream& /* os */) +{ + warn_save_load (); + return true; +} + +bool +octave_oncleanup::load_ascii (std::istream& /* is */) +{ + warn_save_load (); + return true; +} + +bool +octave_oncleanup::save_binary (std::ostream& /* os */, bool& /* save_as_floats */) +{ + warn_save_load (); + return true; +} + +bool +octave_oncleanup::load_binary (std::istream& /* is */, bool /* swap */, + oct_mach_info::float_format /* fmt */) +{ + warn_save_load (); + return true; +} + +#if defined (HAVE_HDF5) +bool +octave_oncleanup::save_hdf5 (hid_t /* loc_id */, const char * /* name */, + bool /* save_as_floats */) +{ + warn_save_load (); + return true; +} + +bool +octave_oncleanup::load_hdf5 (hid_t /* loc_id */, const char * /* name */) +{ + warn_save_load (); + return true; +} +#endif + +void +octave_oncleanup::print (std::ostream& os, bool pr_as_read_syntax) const +{ + print_raw (os, pr_as_read_syntax); + newline (os); +} + +void +octave_oncleanup::print_raw (std::ostream& os, bool pr_as_read_syntax) const +{ + os << "onCleanup ("; + if (fcn.is_defined ()) + fcn.print_raw (os, pr_as_read_syntax); + os << ")"; +} + +DEFUN (onCleanup, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{c} =} onCleanup (@var{action})\n\ +Create a special object that executes a given function upon destruction.\n\ +If the object is copied to multiple variables (or cell or struct array\n\ +elements) or returned from a function, @var{action} will be executed after\n\ +clearing the last copy of the object. Note that if multiple local onCleanup\n\ +variables are created, the order in which they are called is unspecified.\n\ +For similar functionality @xref{The @code{unwind_protect} Statement}.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = octave_value (new octave_oncleanup (args(0))); + else + print_usage (); + + return retval; +} + +/* +%!test +%! old_wstate = warning ("query"); +%! unwind_protect +%! trigger = onCleanup (@() warning ("on", "__MY_WARNING__")); +%! warning ("off", "__MY_WARNING__"); +%! assert ((warning ("query", "__MY_WARNING__")).state, "off"); +%! clear trigger; +%! assert ((warning ("query", "__MY_WARNING__")).state, "on"); +%! unwind_protect_cleanup +%! warning (old_wstate); +%! end_unwind_protect +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-oncleanup.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-oncleanup.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,101 @@ +/* + +Copyright (C) 2010-2012 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "ov-base.h" +#include "ov-struct.h" +#include "ov.h" + +static void +gripe_internal (void) +{ + error ("onCleanup: internal error: cloning nonempty object"); +} + +class octave_oncleanup : public octave_base_value +{ +public: + octave_oncleanup (void) : fcn () { } + + octave_oncleanup (const octave_value& fcn); + + octave_base_value *clone (void) const + { + if (fcn.is_defined ()) + gripe_internal (); + + return empty_clone (); + } + + octave_base_value *empty_clone (void) const + { + return new octave_oncleanup (); + } + + ~octave_oncleanup (void); + + bool is_defined (void) const { return true; } + + bool is_object (void) const { return true; } // do we want this? + + octave_map map_value (void) const { return scalar_map_value (); } + + octave_scalar_map scalar_map_value (void) const; + + dim_vector dims (void) const + { + static dim_vector dv (1, 1); + return dv; + } + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + +private: + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA + +protected: + + octave_value fcn; +}; diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-perm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-perm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,449 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "byte-swap.h" + +#include "ov-perm.h" +#include "ov-re-mat.h" +#include "ov-scalar.h" +#include "error.h" +#include "gripes.h" +#include "ops.h" +#include "pr-output.h" + +#include "ls-oct-ascii.h" + +octave_value +octave_perm_matrix::subsref (const std::string& type, + const std::list& idx) +{ + octave_value retval; + + switch (type[0]) + { + case '(': + retval = do_index_op (idx.front ()); + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + return retval.next_subsref (type, idx); +} + +octave_value +octave_perm_matrix::do_index_op (const octave_value_list& idx, + bool resize_ok) +{ + octave_value retval; + octave_idx_type nidx = idx.length (); + idx_vector idx0, idx1; + if (nidx == 2) + { + idx0 = idx(0).index_vector (); + idx1 = idx(1).index_vector (); + } + + // This hack is to allow constructing permutation matrices using + // eye(n)(p,:), eye(n)(:,q) && eye(n)(p,q) where p & q are permutation + // vectors. + // Note that, for better consistency, eye(n)(:,:) still converts to a full + // matrix. + if (! error_state && nidx == 2) + { + bool left = idx0.is_permutation (matrix.rows ()); + bool right = idx1.is_permutation (matrix.cols ()); + + if (left && right) + { + if (idx0.is_colon ()) left = false; + if (idx1.is_colon ()) right = false; + if (left || right) + { + PermMatrix p = matrix; + if (left) + p = PermMatrix (idx0, false) * p; + if (right) + p = p * PermMatrix (idx1, true); + retval = p; + } + else + { + retval = this; + this->count++; + } + } + } + + // if error_state is set, we've already griped. + if (! error_state && ! retval.is_defined ()) + { + if (nidx == 2 && ! resize_ok && + idx0.is_scalar () && idx1.is_scalar ()) + { + retval = matrix.checkelem (idx0(0), idx1(0)); + } + else + retval = to_dense ().do_index_op (idx, resize_ok); + } + + return retval; +} + +bool +octave_perm_matrix::is_true (void) const +{ + return to_dense ().is_true (); +} + +double +octave_perm_matrix::double_value (bool) const +{ + double retval = lo_ieee_nan_value (); + + if (numel () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + type_name (), "real scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion (type_name (), "real scalar"); + + return retval; +} + +float +octave_perm_matrix::float_value (bool) const +{ + float retval = lo_ieee_float_nan_value (); + + if (numel () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + type_name (), "real scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion (type_name (), "real scalar"); + + return retval; +} + +Complex +octave_perm_matrix::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + type_name (), "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion (type_name (), "complex scalar"); + + return retval; +} + +FloatComplex +octave_perm_matrix::float_complex_value (bool) const +{ + float tmp = lo_ieee_float_nan_value (); + + FloatComplex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + type_name (), "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion (type_name (), "complex scalar"); + + return retval; +} + +#define FORWARD_MATRIX_VALUE(TYPE, PREFIX) \ +TYPE \ +octave_perm_matrix::PREFIX ## _value (bool frc_str_conv) const \ +{ \ + return to_dense ().PREFIX ## _value (frc_str_conv); \ +} + +SparseMatrix +octave_perm_matrix::sparse_matrix_value (bool) const +{ + return SparseMatrix (matrix); +} + +SparseBoolMatrix +octave_perm_matrix::sparse_bool_matrix_value (bool) const +{ + return SparseBoolMatrix (matrix); +} + +SparseComplexMatrix +octave_perm_matrix::sparse_complex_matrix_value (bool) const +{ + return SparseComplexMatrix (sparse_matrix_value ()); +} + +FORWARD_MATRIX_VALUE (Matrix, matrix) +FORWARD_MATRIX_VALUE (FloatMatrix, float_matrix) +FORWARD_MATRIX_VALUE (ComplexMatrix, complex_matrix) +FORWARD_MATRIX_VALUE (FloatComplexMatrix, float_complex_matrix) + +FORWARD_MATRIX_VALUE (NDArray, array) +FORWARD_MATRIX_VALUE (FloatNDArray, float_array) +FORWARD_MATRIX_VALUE (ComplexNDArray, complex_array) +FORWARD_MATRIX_VALUE (FloatComplexNDArray, float_complex_array) + +FORWARD_MATRIX_VALUE (boolNDArray, bool_array) +FORWARD_MATRIX_VALUE (charNDArray, char_array) + +idx_vector +octave_perm_matrix::index_vector (void) const +{ + return to_dense ().index_vector (); +} + +octave_value +octave_perm_matrix::convert_to_str_internal (bool pad, bool force, char type) const +{ + return to_dense ().convert_to_str_internal (pad, force, type); +} + +bool +octave_perm_matrix::save_ascii (std::ostream& os) +{ + typedef octave_int idx_int_type; + + os << "# size: " << matrix.rows () << "\n"; + os << "# orient: " << (matrix.is_col_perm () ? 'c' : 'r') << '\n'; + + Array pvec = matrix.pvec (); + octave_idx_type n = pvec.length (); + ColumnVector tmp (n); + for (octave_idx_type i = 0; i < n; i++) tmp(i) = pvec(i) + 1; + os << tmp; + + return true; +} + +bool +octave_perm_matrix::load_ascii (std::istream& is) +{ + typedef octave_int idx_int_type; + octave_idx_type n; + bool success = true; + char orient; + + if (extract_keyword (is, "size", n, true) + && extract_keyword (is, "orient", orient, true)) + { + bool colp = orient == 'c'; + ColumnVector tmp (n); + is >> tmp; + if (!is) + { + error ("load: failed to load permutation matrix constant"); + success = false; + } + else + { + Array pvec (dim_vector (n, 1)); + for (octave_idx_type i = 0; i < n; i++) pvec(i) = tmp(i) - 1; + matrix = PermMatrix (pvec, colp); + + // Invalidate cache. Probably not necessary, but safe. + dense_cache = octave_value (); + } + } + else + { + error ("load: failed to extract size & orientation"); + success = false; + } + + return success; +} + +bool +octave_perm_matrix::save_binary (std::ostream& os, bool&) +{ + + int32_t sz = matrix.rows (); + bool colp = matrix.is_col_perm (); + os.write (reinterpret_cast (&sz), 4); + os.write (reinterpret_cast (&colp), 1); + os.write (reinterpret_cast (matrix.data ()), matrix.byte_size ()); + + return true; +} + +bool +octave_perm_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format ) +{ + int32_t sz; + bool colp; + if (! (is.read (reinterpret_cast (&sz), 4) + && is.read (reinterpret_cast (&colp), 1))) + return false; + + MArray m (dim_vector (sz, 1)); + + if (! is.read (reinterpret_cast (m.fortran_vec ()), m.byte_size ())) + return false; + + if (swap) + { + int nel = m.numel (); + for (int i = 0; i < nel; i++) + switch (sizeof (octave_idx_type)) + { + case 8: + swap_bytes<8> (&m(i)); + break; + case 4: + swap_bytes<4> (&m(i)); + break; + case 2: + swap_bytes<2> (&m(i)); + break; + case 1: + default: + break; + } + } + + matrix = PermMatrix (m, colp); + return true; +} + +void +octave_perm_matrix::print_raw (std::ostream& os, + bool pr_as_read_syntax) const +{ + return octave_print_internal (os, matrix, pr_as_read_syntax, + current_print_indent_level ()); +} + +mxArray * +octave_perm_matrix::as_mxArray (void) const +{ + return to_dense ().as_mxArray (); +} + +bool +octave_perm_matrix::print_as_scalar (void) const +{ + dim_vector dv = dims (); + + return (dv.all_ones () || dv.any_zero ()); +} + +void +octave_perm_matrix::print (std::ostream& os, bool pr_as_read_syntax) const +{ + print_raw (os, pr_as_read_syntax); + newline (os); +} + +int +octave_perm_matrix::write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const +{ + return to_dense ().write (os, block_size, output_type, skip, flt_fmt); +} + +void +octave_perm_matrix::print_info (std::ostream& os, + const std::string& prefix) const +{ + matrix.print_info (os, prefix); +} + + +octave_value +octave_perm_matrix::to_dense (void) const +{ + if (! dense_cache.is_defined ()) + dense_cache = Matrix (matrix); + + return dense_cache; +} + +DEFINE_OCTAVE_ALLOCATOR (octave_perm_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_perm_matrix, + "permutation matrix", "double"); + +static octave_base_value * +default_numeric_conversion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_perm_matrix&); + + return new octave_matrix (v.matrix_value ()); +} + +octave_base_value::type_conv_info +octave_perm_matrix::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_conversion_function, + octave_matrix::static_type_id ()); +} + +octave_base_value * +octave_perm_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (matrix.nelem () == 1) + retval = new octave_scalar (matrix (0, 0)); + + return retval; +} + diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-perm.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-perm.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,234 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_perm_matrix_h) +#define octave_perm_matrix_h 1 + +#include "mx-base.h" +#include "str-vec.h" + +#include "ov-base.h" +#include "ov-typeinfo.h" +#include "oct-obj.h" + +class +OCTINTERP_API +octave_perm_matrix : public octave_base_value +{ +public: + octave_perm_matrix (void) : matrix (), dense_cache () { } + + octave_perm_matrix (const PermMatrix& p) : matrix (p), dense_cache () { } + + octave_base_value *clone (void) const { return new octave_perm_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_perm_matrix (); } + + type_conv_info numeric_conversion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + size_t byte_size (void) const { return matrix.byte_size (); } + + octave_value squeeze (void) const { return matrix; } + + octave_value full_value (void) const { return to_dense (); } + + octave_value subsref (const std::string& type, + const std::list& idx); + + octave_value_list subsref (const std::string& type, + const std::list& idx, int) + { return subsref (type, idx); } + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + dim_vector dims (void) const { return matrix.dims (); } + + octave_idx_type nnz (void) const { return matrix.rows (); } + + octave_value reshape (const dim_vector& new_dims) const + { return to_dense ().reshape (new_dims); } + + octave_value permute (const Array& vec, bool inv = false) const + { return to_dense ().permute (vec, inv); } + + octave_value resize (const dim_vector& dv, bool fill = false) const + { return to_dense ().resize (dv, fill); } + + octave_value all (int dim = 0) const { return to_dense ().all (dim); } + octave_value any (int dim = 0) const { return to_dense ().any (dim); } + + MatrixType matrix_type (void) const { return MatrixType::Permuted_Diagonal; } + MatrixType matrix_type (const MatrixType&) const + { return matrix_type (); } + + octave_value diag (octave_idx_type k = 0) const + { return to_dense () .diag (k); } + + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const + { return to_dense ().sort (dim, mode); } + octave_value sort (Array &sidx, octave_idx_type dim = 0, + sortmode mode = ASCENDING) const + { return to_dense ().sort (sidx, dim, mode); } + + sortmode is_sorted (sortmode mode = UNSORTED) const + { return to_dense ().is_sorted (mode); } + + Array sort_rows_idx (sortmode mode = ASCENDING) const + { return to_dense ().sort_rows_idx (mode); } + + sortmode is_sorted_rows (sortmode mode = UNSORTED) const + { return to_dense ().is_sorted_rows (mode); } + + builtin_type_t builtin_type (void) const { return btyp_double; } + + bool is_perm_matrix (void) const { return true; } + + bool is_matrix_type (void) const { return true; } + + bool is_numeric_type (void) const { return true; } + + bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + + bool is_real_matrix (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + bool is_true (void) const; + + double double_value (bool = false) const; + + float float_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + idx_vector index_vector (void) const; + + PermMatrix perm_matrix_value (void) const + { return matrix; } + + Matrix matrix_value (bool = false) const; + + FloatMatrix float_matrix_value (bool = false) const; + + Complex complex_value (bool = false) const; + + FloatComplex float_complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + FloatComplexMatrix float_complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const; + + FloatComplexNDArray float_complex_array_value (bool = false) const; + + boolNDArray bool_array_value (bool warn = false) const; + + charNDArray char_array_value (bool = false) const; + + NDArray array_value (bool = false) const; + + FloatNDArray float_array_value (bool = false) const; + + SparseMatrix sparse_matrix_value (bool = false) const; + + SparseBoolMatrix sparse_bool_matrix_value (bool = false) const; + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; + + int8NDArray + int8_array_value (void) const { return to_dense ().int8_array_value (); } + + int16NDArray + int16_array_value (void) const { return to_dense ().int16_array_value (); } + + int32NDArray + int32_array_value (void) const { return to_dense ().int32_array_value (); } + + int64NDArray + int64_array_value (void) const { return to_dense ().int64_array_value (); } + + uint8NDArray + uint8_array_value (void) const { return to_dense ().uint8_array_value (); } + + uint16NDArray + uint16_array_value (void) const { return to_dense ().uint16_array_value (); } + + uint32NDArray + uint32_array_value (void) const { return to_dense ().uint32_array_value (); } + + uint64NDArray + uint64_array_value (void) const { return to_dense ().uint64_array_value (); } + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const; + + mxArray *as_mxArray (void) const; + + bool print_as_scalar (void) const; + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_info (std::ostream& os, const std::string& prefix) const; + + octave_value map (unary_mapper_t umap) const + { return to_dense ().map (umap); } + +protected: + + PermMatrix matrix; + + virtual octave_value to_dense (void) const; + + mutable octave_value dense_cache; + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-range.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-range.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,691 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "lo-ieee.h" +#include "lo-utils.h" + +#include "defun.h" +#include "variables.h" +#include "gripes.h" +#include "ops.h" +#include "oct-obj.h" +#include "ov-range.h" +#include "ov-re-mat.h" +#include "ov-scalar.h" +#include "pr-output.h" + +#include "byte-swap.h" +#include "ls-ascii-helper.h" +#include "ls-hdf5.h" +#include "ls-utils.h" + +// If TRUE, allow ranges with non-integer elements as array indices. +bool Vallow_noninteger_range_as_index = false; + +DEFINE_OCTAVE_ALLOCATOR (octave_range); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_range, "range", "double"); + +static octave_base_value * +default_numeric_conversion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_range&); + + return new octave_matrix (v.matrix_value ()); +} + +octave_base_value::type_conv_info +octave_range::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_conversion_function, + octave_matrix::static_type_id ()); +} + +octave_base_value * +octave_range::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + switch (range.nelem ()) + { + case 1: + retval = new octave_scalar (range.base ()); + break; + + case 0: + retval = new octave_matrix (Matrix (1, 0)); + break; + + case -2: + retval = new octave_matrix (range.matrix_value ()); + break; + + default: + break; + } + + return retval; +} + +octave_value +octave_range::subsref (const std::string& type, + const std::list& idx) +{ + octave_value retval; + + switch (type[0]) + { + case '(': + retval = do_index_op (idx.front ()); + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + return retval.next_subsref (type, idx); +} + +octave_value +octave_range::do_index_op (const octave_value_list& idx, bool resize_ok) +{ + if (idx.length () == 1 && ! resize_ok) + { + octave_value retval; + + // The range can handle a single subscript. + idx_vector i = idx(0).index_vector (); + if (! error_state) + { + if (i.is_scalar () && i(0) < range.nelem ()) + retval = range.elem (i(0)); + else + retval = range.index (i); + } + + return retval; + } + else + { + octave_value tmp (new octave_matrix (range.matrix_value ())); + + return tmp.do_index_op (idx, resize_ok); + } +} + +idx_vector +octave_range::index_vector (void) const +{ + if (idx_cache) + return *idx_cache; + else + { + if (! Vallow_noninteger_range_as_index + || range.all_elements_are_ints ()) + return set_idx_cache (idx_vector (range)); + else + { + warning_with_id ("Octave:noninteger-range-as-index", + "non-integer range used as index"); + + return octave_value (matrix_value ()).round ().index_vector (); + } + } +} + +double +octave_range::double_value (bool) const +{ + double retval = lo_ieee_nan_value (); + + octave_idx_type nel = range.nelem (); + + if (nel > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "range", "real scalar"); + + retval = range.base (); + } + else + gripe_invalid_conversion ("range", "real scalar"); + + return retval; +} + +float +octave_range::float_value (bool) const +{ + float retval = lo_ieee_float_nan_value (); + + octave_idx_type nel = range.nelem (); + + if (nel > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "range", "real scalar"); + + retval = range.base (); + } + else + gripe_invalid_conversion ("range", "real scalar"); + + return retval; +} + +charNDArray +octave_range::char_array_value (bool) const +{ + const Matrix matrix = range.matrix_value (); + charNDArray retval (dims ()); + + octave_idx_type nel = numel (); + + for (octave_idx_type i = 0; i < nel; i++) + retval.elem (i) = static_cast(matrix.elem (i)); + + return retval; +} + +octave_value +octave_range::all (int dim) const +{ + // FIXME -- this is a potential waste of memory. + + Matrix m = range.matrix_value (); + + return m.all (dim); +} + +octave_value +octave_range::any (int dim) const +{ + // FIXME -- this is a potential waste of memory. + + Matrix m = range.matrix_value (); + + return m.any (dim); +} + +octave_value +octave_range::diag (octave_idx_type k) const +{ + return (k == 0 + ? octave_value (DiagMatrix (DiagArray2 (range.matrix_value ()))) + : octave_value (range.diag (k))); +} + +octave_value +octave_range::diag (octave_idx_type m, octave_idx_type n) const +{ + Matrix mat = range.matrix_value (); + + return mat.diag (m, n); +} + +bool +octave_range::is_true (void) const +{ + bool retval = false; + + if (range.nelem () != 0) + { + // FIXME -- this is a potential waste of memory. + + Matrix m ((range.matrix_value () . all ()) . all ()); + + retval = (m.rows () == 1 && m.columns () == 1 && m (0, 0) != 0.0); + } + + return retval; +} + +Complex +octave_range::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + octave_idx_type nel = range.nelem (); + + if (nel > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "range", "complex scalar"); + + retval = range.base (); + } + else + gripe_invalid_conversion ("range", "complex scalar"); + + return retval; +} + +FloatComplex +octave_range::float_complex_value (bool) const +{ + float tmp = lo_ieee_float_nan_value (); + + FloatComplex retval (tmp, tmp); + + octave_idx_type nel = range.nelem (); + + if (nel > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "range", "complex scalar"); + + retval = range.base (); + } + else + gripe_invalid_conversion ("range", "complex scalar"); + + return retval; +} + +boolNDArray +octave_range::bool_array_value (bool warn) const +{ + Matrix m = range.matrix_value (); + + if (m.any_element_is_nan ()) + gripe_nan_to_logical_conversion (); + else if (warn && m.any_element_not_one_or_zero ()) + gripe_logical_conversion (); + + return boolNDArray (m); +} + +octave_value +octave_range::resize (const dim_vector& dv, bool fill) const +{ + NDArray retval = array_value (); + if (fill) + retval.resize (dv, 0); + else + retval.resize (dv); + return retval; +} + +octave_value +octave_range::convert_to_str_internal (bool pad, bool force, char type) const +{ + octave_value tmp (range.matrix_value ()); + return tmp.convert_to_str (pad, force, type); +} + +void +octave_range::print (std::ostream& os, bool pr_as_read_syntax) const +{ + print_raw (os, pr_as_read_syntax); + newline (os); +} + +void +octave_range::print_raw (std::ostream& os, bool pr_as_read_syntax) const +{ + octave_print_internal (os, range, pr_as_read_syntax, + current_print_indent_level ()); +} + +bool +octave_range::print_name_tag (std::ostream& os, const std::string& name) const +{ + bool retval = false; + + octave_idx_type n = range.nelem (); + + indent (os); + + if (n == 0 || n == 1) + os << name << " = "; + else + { + os << name << " ="; + newline (os); + if (! Vcompact_format) + newline (os); + + retval = true; + } + + return retval; +} + +// Skip white space and comments on stream IS. + +static void +skip_comments (std::istream& is) +{ + char c = '\0'; + while (is.get (c)) + { + if (c == ' ' || c == '\t' || c == '\n') + ; // Skip whitespace on way to beginning of next line. + else + break; + } + + skip_until_newline (is, false); +} + +bool +octave_range::save_ascii (std::ostream& os) +{ + Range r = range_value (); + double base = r.base (); + double limit = r.limit (); + double inc = r.inc (); + octave_idx_type len = r.nelem (); + + if (inc != 0) + os << "# base, limit, increment\n"; + else + os << "# base, length, increment\n"; + + octave_write_double (os, base); + os << " "; + if (inc != 0) + octave_write_double (os, limit); + else + os << len; + os << " "; + octave_write_double (os, inc); + os << "\n"; + + return true; +} + +bool +octave_range::load_ascii (std::istream& is) +{ + // # base, limit, range comment added by save (). + skip_comments (is); + + double base, limit, inc; + is >> base >> limit >> inc; + + if (!is) + { + error ("load: failed to load range constant"); + return false; + } + + if (inc != 0) + range = Range (base, limit, inc); + else + range = Range (base, inc, static_cast (limit)); + + return true; +} + +bool +octave_range::save_binary (std::ostream& os, bool& /* save_as_floats */) +{ + char tmp = LS_DOUBLE; + os.write (reinterpret_cast (&tmp), 1); + Range r = range_value (); + double bas = r.base (); + double lim = r.limit (); + double inc = r.inc (); + if (inc == 0) + lim = r.nelem (); + + os.write (reinterpret_cast (&bas), 8); + os.write (reinterpret_cast (&lim), 8); + os.write (reinterpret_cast (&inc), 8); + + return true; +} + +bool +octave_range::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format /* fmt */) +{ + char tmp; + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + double bas, lim, inc; + if (! is.read (reinterpret_cast (&bas), 8)) + return false; + if (swap) + swap_bytes<8> (&bas); + if (! is.read (reinterpret_cast (&lim), 8)) + return false; + if (swap) + swap_bytes<8> (&lim); + if (! is.read (reinterpret_cast (&inc), 8)) + return false; + if (swap) + swap_bytes<8> (&inc); + if (inc != 0) + range = Range (bas, lim, inc); + else + range = Range (bas, inc, static_cast (lim)); + + return true; +} + +#if defined (HAVE_HDF5) + +// The following subroutines creates an HDF5 representation of the way +// we will store Octave range types (triplets of floating-point numbers). +// NUM_TYPE is the HDF5 numeric type to use for storage (e.g. +// H5T_NATIVE_DOUBLE to save as 'double'). Note that any necessary +// conversions are handled automatically by HDF5. + +static hid_t +hdf5_make_range_type (hid_t num_type) +{ + hid_t type_id = H5Tcreate (H5T_COMPOUND, sizeof (double) * 3); + + H5Tinsert (type_id, "base", 0 * sizeof (double), num_type); + H5Tinsert (type_id, "limit", 1 * sizeof (double), num_type); + H5Tinsert (type_id, "increment", 2 * sizeof (double), num_type); + + return type_id; +} + +bool +octave_range::save_hdf5 (hid_t loc_id, const char *name, + bool /* save_as_floats */) +{ + hsize_t dimens[3]; + hid_t space_hid = -1, type_hid = -1, data_hid = -1; + bool retval = true; + + space_hid = H5Screate_simple (0, dimens, 0); + if (space_hid < 0) return false; + + type_hid = hdf5_make_range_type (H5T_NATIVE_DOUBLE); + if (type_hid < 0) + { + H5Sclose (space_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Tclose (type_hid); + return false; + } + + Range r = range_value (); + double range_vals[3]; + range_vals[0] = r.base (); + range_vals[1] = r.inc () != 0 ? r.limit () : r.nelem (); + range_vals[2] = r.inc (); + + if (H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, H5P_DEFAULT, + range_vals) >= 0) + { + octave_idx_type nel = r.nelem (); + retval = hdf5_add_scalar_attr (data_hid, H5T_NATIVE_IDX, + "OCTAVE_RANGE_NELEM", &nel) >= 0; + } + else + retval = false; + + H5Dclose (data_hid); + H5Tclose (type_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_range::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; + +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t type_hid = H5Dget_type (data_hid); + + hid_t range_type = hdf5_make_range_type (H5T_NATIVE_DOUBLE); + + if (! hdf5_types_compatible (type_hid, range_type)) + { + H5Tclose (range_type); + H5Dclose (data_hid); + return false; + } + + hid_t space_hid = H5Dget_space (data_hid); + hsize_t rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Tclose (range_type); + H5Sclose (space_hid); + H5Dclose (data_hid); + return false; + } + + double rangevals[3]; + if (H5Dread (data_hid, range_type, H5S_ALL, H5S_ALL, H5P_DEFAULT, + rangevals) >= 0) + { + retval = true; + octave_idx_type nel; + if (hdf5_get_scalar_attr (data_hid, H5T_NATIVE_IDX, + "OCTAVE_RANGE_NELEM", &nel)) + range = Range (rangevals[0], rangevals[2], nel); + else + { + if (rangevals[2] != 0) + range = Range (rangevals[0], rangevals[1], rangevals[2]); + else + range = Range (rangevals[0], rangevals[2], + static_cast (rangevals[1])); + } + } + + H5Tclose (range_type); + H5Sclose (space_hid); + H5Dclose (data_hid); + + return retval; +} + +#endif + +mxArray * +octave_range::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxDOUBLE_CLASS, dims (), mxREAL); + + double *pr = static_cast (retval->get_data ()); + + mwSize nel = numel (); + + Matrix m = matrix_value (); + + const double *p = m.data (); + + for (mwSize i = 0; i < nel; i++) + pr[i] = p[i]; + + return retval; +} + +DEFUN (allow_noninteger_range_as_index, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} allow_noninteger_range_as_index ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} allow_noninteger_range_as_index (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} allow_noninteger_range_as_index (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether non-integer\n\ +ranges are allowed as indices. This might be useful for @sc{matlab}\n\ +compatibility; however, it is still not entirely compatible because\n\ +@sc{matlab} treats the range expression differently in different contexts.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (allow_noninteger_range_as_index); +} + +/* +%!test +%! x = 0:10; +%! save = allow_noninteger_range_as_index (); +%! warn_state = warning ("query", "Octave:noninteger-range-as-index"); +%! unwind_protect +%! allow_noninteger_range_as_index (false); +%! fail ("x(2.1:5)"); +%! assert (x(2:5), 1:4); +%! allow_noninteger_range_as_index (true); +%! warning ("off", "Octave:noninteger-range-as-index"); +%! assert (x(2.49:5), 1:3); +%! assert (x(2.5:5), 2:4); +%! assert (x(2.51:5), 2:4); +%! unwind_protect_cleanup +%! allow_noninteger_range_as_index (save); +%! warning (warn_state.state, warn_state.identifier); +%! end_unwind_protect +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-range.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-range.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,322 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_range_h) +#define octave_range_h 1 + +#include + +#include +#include + +#include "Range.h" + +#include "lo-mappers.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-stream.h" +#include "ov-base.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// Range values. + +class +octave_range : public octave_base_value +{ +public: + + octave_range (void) + : octave_base_value (), range (), idx_cache () { } + + octave_range (double base, double limit, double inc) + : octave_base_value (), range (base, limit, inc), idx_cache () + { + if (range.nelem () < 0) + ::error ("invalid range"); + } + + octave_range (const Range& r) + : octave_base_value (), range (r), idx_cache () + { + if (range.nelem () < 0 && range.nelem () != -2) + ::error ("invalid range"); + } + + octave_range (const octave_range& r) + : octave_base_value (), range (r.range), + idx_cache (r.idx_cache ? new idx_vector (*r.idx_cache) : 0) + { } + + octave_range (const Range& r, const idx_vector& cache) + : octave_base_value (), range (r), idx_cache () + { + set_idx_cache (cache); + } + + ~octave_range (void) { clear_cached_info (); } + + octave_base_value *clone (void) const { return new octave_range (*this); } + + // A range is really just a special kind of real matrix object. In + // the places where we need to call empty_clone, it makes more sense + // to create an empty matrix (0x0) instead of an empty range (1x0). + octave_base_value *empty_clone (void) const { return new octave_matrix (); } + + type_conv_info numeric_conversion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + octave_value subsref (const std::string& type, + const std::list& idx); + + octave_value_list subsref (const std::string& type, + const std::list& idx, int) + { return subsref (type, idx); } + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + idx_vector index_vector (void) const; + + dim_vector dims (void) const + { + octave_idx_type n = range.nelem (); + return dim_vector (n > 0, n); + } + + octave_value resize (const dim_vector& dv, bool fill = false) const; + + + size_t byte_size (void) const { return 3 * sizeof (double); } + + octave_value reshape (const dim_vector& new_dims) const + { return NDArray (array_value ().reshape (new_dims)); } + + octave_value permute (const Array& vec, bool inv = false) const + { return NDArray (array_value ().permute (vec, inv)); } + + octave_value squeeze (void) const { return range; } + + octave_value full_value (void) const { return range.matrix_value (); } + + bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + + bool is_range (void) const { return true; } + + octave_value all (int dim = 0) const; + + octave_value any (int dim = 0) const; + + octave_value diag (octave_idx_type k = 0) const; + + octave_value diag (octave_idx_type m, octave_idx_type n) const; + + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const + { return range.sort (dim, mode); } + + octave_value sort (Array& sidx, octave_idx_type dim = 0, + sortmode mode = ASCENDING) const + { return range.sort (sidx, dim, mode); } + + sortmode is_sorted (sortmode mode = UNSORTED) const + { return range.is_sorted (mode); } + + Array sort_rows_idx (sortmode) const + { return Array (dim_vector (1, 0)); } + + sortmode is_sorted_rows (sortmode mode = UNSORTED) const + { return mode ? mode : ASCENDING; } + + builtin_type_t builtin_type (void) const { return btyp_double; } + + bool is_real_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + bool is_numeric_type (void) const { return true; } + + bool is_true (void) const; + + double double_value (bool = false) const; + + float float_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + float float_scalar_value (bool frc_str_conv = false) const + { return float_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const + { return range.matrix_value (); } + + FloatMatrix float_matrix_value (bool = false) const + { return range.matrix_value (); } + + NDArray array_value (bool = false) const + { return range.matrix_value (); } + + FloatNDArray float_array_value (bool = false) const + { return FloatMatrix (range.matrix_value ()); } + + charNDArray char_array_value (bool = false) const; + + // FIXME -- it would be better to have Range::intXNDArray_value + // functions to avoid the intermediate conversion to a matrix + // object. + + int8NDArray + int8_array_value (void) const { return int8NDArray (array_value ()); } + + int16NDArray + int16_array_value (void) const { return int16NDArray (array_value ()); } + + int32NDArray + int32_array_value (void) const { return int32NDArray (array_value ()); } + + int64NDArray + int64_array_value (void) const { return int64NDArray (array_value ()); } + + uint8NDArray + uint8_array_value (void) const { return uint8NDArray (array_value ()); } + + uint16NDArray + uint16_array_value (void) const { return uint16NDArray (array_value ()); } + + uint32NDArray + uint32_array_value (void) const { return uint32NDArray (array_value ()); } + + uint64NDArray + uint64_array_value (void) const { return uint64NDArray (array_value ()); } + + SparseMatrix sparse_matrix_value (bool = false) const + { return SparseMatrix (range.matrix_value ()); } + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const + { return SparseComplexMatrix (sparse_matrix_value ()); } + + Complex complex_value (bool = false) const; + + FloatComplex float_complex_value (bool = false) const; + + boolNDArray bool_array_value (bool warn = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const + { return ComplexMatrix (range.matrix_value ()); } + + FloatComplexMatrix float_complex_matrix_value (bool = false) const + { return FloatComplexMatrix (range.matrix_value ()); } + + ComplexNDArray complex_array_value (bool = false) const + { return ComplexMatrix (range.matrix_value ()); } + + FloatComplexNDArray float_complex_array_value (bool = false) const + { return FloatComplexMatrix (range.matrix_value ()); } + + Range range_value (void) const { return range; } + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool print_name_tag (std::ostream& os, const std::string& name) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { + // FIXME -- could be more memory efficient by having a + // special case of the octave_stream::write method for ranges. + + return os.write (matrix_value (), block_size, output_type, skip, + flt_fmt); + } + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const + { + octave_matrix m (matrix_value ()); + return m.map (umap); + } + +private: + + Range range; + + idx_vector set_idx_cache (const idx_vector& idx) const + { + delete idx_cache; + idx_cache = idx ? new idx_vector (idx) : 0; + return idx; + } + + void clear_cached_info (void) const + { + delete idx_cache; idx_cache = 0; + } + + mutable idx_vector *idx_cache; + + // No assignment. + + octave_range& operator = (const octave_range&); + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +// If TRUE, allow ranges with non-integer elements as array indices. +extern bool Vallow_noninteger_range_as_index; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-re-diag.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-re-diag.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,244 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "byte-swap.h" + +#include "ov-re-diag.h" +#include "ov-flt-re-diag.h" +#include "ov-base-diag.cc" +#include "ov-scalar.h" +#include "ov-re-mat.h" +#include "ls-utils.h" + +template class octave_base_diag; + +DEFINE_OCTAVE_ALLOCATOR (octave_diag_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_diag_matrix, "diagonal matrix", "double"); + +static octave_base_value * +default_numeric_conversion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_diag_matrix&); + + return new octave_matrix (v.matrix_value ()); +} + +octave_base_value::type_conv_info +octave_diag_matrix::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_conversion_function, + octave_matrix::static_type_id ()); +} + +static octave_base_value * +default_numeric_demotion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_diag_matrix&); + + return new octave_float_diag_matrix (v.float_diag_matrix_value ()); +} + +octave_base_value::type_conv_info +octave_diag_matrix::numeric_demotion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_demotion_function, + octave_float_diag_matrix::static_type_id ()); +} + +octave_base_value * +octave_diag_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (matrix.nelem () == 1) + retval = new octave_scalar (matrix (0, 0)); + + return retval; +} + +octave_value +octave_diag_matrix::do_index_op (const octave_value_list& idx, + bool resize_ok) +{ + octave_value retval; + + // This hack is to allow constructing permutation matrices using + // eye(n)(p,:), eye(n)(:,q) && eye(n)(p,q) where p & q are permutation + // vectors. + if (! resize_ok && idx.length () == 2 && matrix.is_multiple_of_identity (1)) + { + idx_vector idx0 = idx(0).index_vector (); + idx_vector idx1 = idx(1).index_vector (); + + if (! error_state) + { + bool left = idx0.is_permutation (matrix.rows ()); + bool right = idx1.is_permutation (matrix.cols ()); + + if (left && right) + { + if (idx0.is_colon ()) left = false; + if (idx1.is_colon ()) right = false; + if (left && right) + retval = PermMatrix (idx0, false) * PermMatrix (idx1, true); + else if (left) + retval = PermMatrix (idx0, false); + else if (right) + retval = PermMatrix (idx1, true); + else + { + retval = this; + this->count++; + } + } + } + } + + // if error_state is set, we've already griped. + if (! error_state && retval.is_undefined ()) + retval = octave_base_diag::do_index_op (idx, resize_ok); + + return retval; +} + +DiagMatrix +octave_diag_matrix::diag_matrix_value (bool) const +{ + return matrix; +} + +FloatDiagMatrix +octave_diag_matrix::float_diag_matrix_value (bool) const +{ + return FloatDiagMatrix (matrix); +} + +ComplexDiagMatrix +octave_diag_matrix::complex_diag_matrix_value (bool) const +{ + return ComplexDiagMatrix (matrix); +} + +FloatComplexDiagMatrix +octave_diag_matrix::float_complex_diag_matrix_value (bool) const +{ + return FloatComplexDiagMatrix (matrix); +} + +octave_value +octave_diag_matrix::map (unary_mapper_t umap) const +{ + switch (umap) + { + case umap_abs: + return matrix.abs (); + case umap_real: + case umap_conj: + return matrix; + case umap_imag: + return DiagMatrix (matrix.rows (), matrix.cols (), 0.0); + case umap_sqrt: + { + ComplexColumnVector tmp = matrix.diag ().map (rc_sqrt); + ComplexDiagMatrix retval (tmp); + retval.resize (matrix.rows (), matrix.columns ()); + return retval; + } + default: + return to_dense ().map (umap); + } +} + +bool +octave_diag_matrix::save_binary (std::ostream& os, bool& save_as_floats) +{ + + int32_t r = matrix.rows (), c = matrix.cols (); + os.write (reinterpret_cast (&r), 4); + os.write (reinterpret_cast (&c), 4); + + Matrix m = Matrix (matrix.diag ()); + save_type st = LS_DOUBLE; + if (save_as_floats) + { + if (m.too_large_for_float ()) + { + warning ("save: some values too large to save as floats --"); + warning ("save: saving as doubles instead"); + } + else + st = LS_FLOAT; + } + else if (matrix.length () > 8192) // FIXME -- make this configurable. + { + double max_val, min_val; + if (m.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + } + + const double *mtmp = m.data (); + write_doubles (os, mtmp, st, m.numel ()); + + return true; +} + +bool +octave_diag_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + int32_t r, c; + char tmp; + if (! (is.read (reinterpret_cast (&r), 4) + && is.read (reinterpret_cast (&c), 4) + && is.read (reinterpret_cast (&tmp), 1))) + return false; + if (swap) + { + swap_bytes<4> (&r); + swap_bytes<4> (&c); + } + + DiagMatrix m (r, c); + double *re = m.fortran_vec (); + octave_idx_type len = m.length (); + read_doubles (is, re, static_cast (tmp), len, swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + + return true; +} + +bool +octave_diag_matrix::chk_valid_scalar (const octave_value& val, + double& x) const +{ + bool retval = val.is_real_scalar (); + if (retval) + x = val.double_value (); + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-re-diag.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-re-diag.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,98 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_diag_matrix_h) +#define octave_diag_matrix_h 1 + +#include "ov-base.h" +#include "ov-base-diag.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" + +// Real diagonal matrix values. + +class +OCTINTERP_API +octave_diag_matrix + : public octave_base_diag +{ +public: + + octave_diag_matrix (void) + : octave_base_diag () { } + + octave_diag_matrix (const DiagMatrix& m) + : octave_base_diag (m) { } + + octave_diag_matrix (const octave_diag_matrix& m) + : octave_base_diag (m) { } + + ~octave_diag_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_diag_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_diag_matrix (); } + + type_conv_info numeric_conversion_function (void) const; + + type_conv_info numeric_demotion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + builtin_type_t builtin_type (void) const { return btyp_double; } + + bool is_real_matrix (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + DiagMatrix diag_matrix_value (bool = false) const; + + FloatDiagMatrix float_diag_matrix_value (bool = false) const; + + ComplexDiagMatrix complex_diag_matrix_value (bool = false) const; + + FloatComplexDiagMatrix float_complex_diag_matrix_value (bool = false) const; + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + + octave_value map (unary_mapper_t umap) const; + +private: + + bool chk_valid_scalar (const octave_value&, + double&) const; + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-re-mat.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-re-mat.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1031 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "data-conv.h" +#include "lo-ieee.h" +#include "lo-utils.h" +#include "lo-specfun.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "mx-base.h" +#include "quit.h" +#include "oct-locbuf.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "oct-stream.h" +#include "ops.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-base-mat.cc" +#include "ov-scalar.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ov-re-sparse.h" +#include "ov-re-diag.h" +#include "ov-cx-diag.h" +#include "ov-lazy-idx.h" +#include "ov-perm.h" +#include "ov-type-conv.h" +#include "pr-output.h" +#include "variables.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +#if ! defined (UCHAR_MAX) +#define UCHAR_MAX 255 +#endif + +template class octave_base_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_matrix, "matrix", "double"); + +static octave_base_value * +default_numeric_demotion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_matrix&); + + return new octave_float_matrix (v.float_array_value ()); +} + +octave_base_value::type_conv_info +octave_matrix::numeric_demotion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_demotion_function, + octave_float_matrix::static_type_id ()); +} + +octave_base_value * +octave_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (matrix.nelem () == 1) + retval = new octave_scalar (matrix (0)); + + return retval; +} + +double +octave_matrix::double_value (bool) const +{ + double retval = lo_ieee_nan_value (); + + if (numel () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "real matrix", "real scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("real matrix", "real scalar"); + + return retval; +} + +float +octave_matrix::float_value (bool) const +{ + float retval = lo_ieee_float_nan_value (); + + if (numel () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "real matrix", "real scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("real matrix", "real scalar"); + + return retval; +} + +// FIXME + +Matrix +octave_matrix::matrix_value (bool) const +{ + return matrix.matrix_value (); +} + +FloatMatrix +octave_matrix::float_matrix_value (bool) const +{ + return FloatMatrix (matrix.matrix_value ()); +} + +Complex +octave_matrix::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "real matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("real matrix", "complex scalar"); + + return retval; +} + +FloatComplex +octave_matrix::float_complex_value (bool) const +{ + float tmp = lo_ieee_float_nan_value (); + + FloatComplex retval (tmp, tmp); + + if (rows () > 0 && columns () > 0) + { + gripe_implicit_conversion ("Octave:array-to-scalar", + "real matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("real matrix", "complex scalar"); + + return retval; +} + +// FIXME + +ComplexMatrix +octave_matrix::complex_matrix_value (bool) const +{ + return ComplexMatrix (matrix.matrix_value ()); +} + +FloatComplexMatrix +octave_matrix::float_complex_matrix_value (bool) const +{ + return FloatComplexMatrix (matrix.matrix_value ()); +} + +ComplexNDArray +octave_matrix::complex_array_value (bool) const +{ + return ComplexNDArray (matrix); +} + +FloatComplexNDArray +octave_matrix::float_complex_array_value (bool) const +{ + return FloatComplexNDArray (matrix); +} + +boolNDArray +octave_matrix::bool_array_value (bool warn) const +{ + if (matrix.any_element_is_nan ()) + gripe_nan_to_logical_conversion (); + else if (warn && matrix.any_element_not_one_or_zero ()) + gripe_logical_conversion (); + + return boolNDArray (matrix); +} + +charNDArray +octave_matrix::char_array_value (bool) const +{ + charNDArray retval (dims ()); + + octave_idx_type nel = numel (); + + for (octave_idx_type i = 0; i < nel; i++) + retval.elem (i) = static_cast(matrix.elem (i)); + + return retval; +} + +SparseMatrix +octave_matrix::sparse_matrix_value (bool) const +{ + return SparseMatrix (matrix.matrix_value ()); +} + +SparseComplexMatrix +octave_matrix::sparse_complex_matrix_value (bool) const +{ + // FIXME Need a SparseComplexMatrix (Matrix) constructor to make + // this function more efficient. Then this should become + // return SparseComplexMatrix (matrix.matrix_value ()); + return SparseComplexMatrix (sparse_matrix_value ()); +} + +octave_value +octave_matrix::diag (octave_idx_type k) const +{ + octave_value retval; + if (k == 0 && matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + retval = DiagMatrix (DiagArray2 (matrix)); + else + retval = octave_base_matrix::diag (k); + + return retval; +} + +octave_value +octave_matrix::diag (octave_idx_type m, octave_idx_type n) const +{ + octave_value retval; + + if (matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + { + Matrix mat = matrix.matrix_value (); + + retval = mat.diag (m, n); + } + else + error ("diag: expecting vector argument"); + + return retval; +} + +// We override these two functions to allow reshaping both +// the matrix and the index cache. +octave_value +octave_matrix::reshape (const dim_vector& new_dims) const +{ + if (idx_cache) + { + return new octave_matrix (matrix.reshape (new_dims), + idx_vector (idx_cache->as_array ().reshape (new_dims), + idx_cache->extent (0))); + } + else + return octave_base_matrix::reshape (new_dims); +} + +octave_value +octave_matrix::squeeze (void) const +{ + if (idx_cache) + { + return new octave_matrix (matrix.squeeze (), + idx_vector (idx_cache->as_array ().squeeze (), + idx_cache->extent (0))); + } + else + return octave_base_matrix::squeeze (); +} + +octave_value +octave_matrix::sort (octave_idx_type dim, sortmode mode) const +{ + if (idx_cache) + { + // This is a valid index matrix, so sort via integers because it's + // generally more efficient. + return octave_lazy_index (*idx_cache).sort (dim, mode); + } + else + return octave_base_matrix::sort (dim, mode); +} + +octave_value +octave_matrix::sort (Array &sidx, octave_idx_type dim, + sortmode mode) const +{ + if (idx_cache) + { + // This is a valid index matrix, so sort via integers because it's + // generally more efficient. + return octave_lazy_index (*idx_cache).sort (sidx, dim, mode); + } + else + return octave_base_matrix::sort (sidx, dim, mode); +} + +sortmode +octave_matrix::is_sorted (sortmode mode) const +{ + if (idx_cache) + { + // This is a valid index matrix, so check via integers because it's + // generally more efficient. + return idx_cache->as_array ().is_sorted (mode); + } + else + return octave_base_matrix::is_sorted (mode); +} +Array +octave_matrix::sort_rows_idx (sortmode mode) const +{ + if (idx_cache) + { + // This is a valid index matrix, so sort via integers because it's + // generally more efficient. + return octave_lazy_index (*idx_cache).sort_rows_idx (mode); + } + else + return octave_base_matrix::sort_rows_idx (mode); +} + +sortmode +octave_matrix::is_sorted_rows (sortmode mode) const +{ + if (idx_cache) + { + // This is a valid index matrix, so check via integers because it's + // generally more efficient. + return idx_cache->as_array ().is_sorted_rows (mode); + } + else + return octave_base_matrix::is_sorted_rows (mode); +} + +octave_value +octave_matrix::convert_to_str_internal (bool, bool, char type) const +{ + octave_value retval; + dim_vector dv = dims (); + octave_idx_type nel = dv.numel (); + + charNDArray chm (dv); + + bool warned = false; + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_quit (); + + double d = matrix (i); + + if (xisnan (d)) + { + gripe_nan_to_character_conversion (); + return retval; + } + else + { + int ival = NINT (d); + + if (ival < 0 || ival > UCHAR_MAX) + { + // FIXME -- is there something + // better we could do? + + ival = 0; + + if (! warned) + { + ::warning ("range error for conversion to character value"); + warned = true; + } + } + + chm (i) = static_cast (ival); + } + } + + retval = octave_value (chm, type); + + return retval; +} + +bool +octave_matrix::save_ascii (std::ostream& os) +{ + dim_vector d = dims (); + + if (d.length () > 2) + { + NDArray tmp = array_value (); + + os << "# ndims: " << d.length () << "\n"; + + for (int i=0; i < d.length (); i++) + os << " " << d (i); + + os << "\n" << tmp; + } + else + { + // Keep this case, rather than use generic code above for backward + // compatiability. Makes load_ascii much more complex!! + os << "# rows: " << rows () << "\n" + << "# columns: " << columns () << "\n"; + + os << matrix_value (); + } + + return true; +} + +bool +octave_matrix::load_ascii (std::istream& is) +{ + bool success = true; + + string_vector keywords(2); + + keywords[0] = "ndims"; + keywords[1] = "rows"; + + std::string kw; + octave_idx_type val = 0; + + if (extract_keyword (is, keywords, kw, val, true)) + { + if (kw == "ndims") + { + int mdims = static_cast (val); + + if (mdims >= 0) + { + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + is >> dv(i); + + if (is) + { + NDArray tmp(dv); + + is >> tmp; + + if (is) + matrix = tmp; + else + { + error ("load: failed to load matrix constant"); + success = false; + } + } + else + { + error ("load: failed to read dimensions"); + success = false; + } + } + else + { + error ("load: failed to extract number of dimensions"); + success = false; + } + } + else if (kw == "rows") + { + octave_idx_type nr = val; + octave_idx_type nc = 0; + + if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) + { + if (nr > 0 && nc > 0) + { + Matrix tmp (nr, nc); + is >> tmp; + if (is) + matrix = tmp; + else + { + error ("load: failed to load matrix constant"); + success = false; + } + } + else if (nr == 0 || nc == 0) + matrix = Matrix (nr, nc); + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + } + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + + return success; +} + +bool +octave_matrix::save_binary (std::ostream& os, bool& save_as_floats) +{ + + dim_vector d = dims (); + if (d.length () < 1) + return false; + + // Use negative value for ndims to differentiate with old format!! + int32_t tmp = - d.length (); + os.write (reinterpret_cast (&tmp), 4); + for (int i = 0; i < d.length (); i++) + { + tmp = d(i); + os.write (reinterpret_cast (&tmp), 4); + } + + NDArray m = array_value (); + save_type st = LS_DOUBLE; + if (save_as_floats) + { + if (m.too_large_for_float ()) + { + warning ("save: some values too large to save as floats --"); + warning ("save: saving as doubles instead"); + } + else + st = LS_FLOAT; + } + else if (d.numel () > 8192) // FIXME -- make this configurable. + { + double max_val, min_val; + if (m.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + } + + const double *mtmp = m.data (); + write_doubles (os, mtmp, st, d.numel ()); + + return true; +} + +bool +octave_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + char tmp; + int32_t mdims; + if (! is.read (reinterpret_cast (&mdims), 4)) + return false; + if (swap) + swap_bytes<4> (&mdims); + if (mdims < 0) + { + mdims = - mdims; + int32_t di; + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + { + if (! is.read (reinterpret_cast (&di), 4)) + return false; + if (swap) + swap_bytes<4> (&di); + dv(i) = di; + } + + // Convert an array with a single dimension to be a row vector. + // Octave should never write files like this, other software + // might. + + if (mdims == 1) + { + mdims = 2; + dv.resize (mdims); + dv(1) = dv(0); + dv(0) = 1; + } + + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + + NDArray m(dv); + double *re = m.fortran_vec (); + read_doubles (is, re, static_cast (tmp), dv.numel (), swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + } + else + { + int32_t nr, nc; + nr = mdims; + if (! is.read (reinterpret_cast (&nc), 4)) + return false; + if (swap) + swap_bytes<4> (&nc); + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + Matrix m (nr, nc); + double *re = m.fortran_vec (); + octave_idx_type len = nr * nc; + read_doubles (is, re, static_cast (tmp), len, swap, fmt); + if (error_state || ! is) + return false; + matrix = m; + } + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_matrix::save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) +{ + dim_vector dv = dims (); + int empty = save_hdf5_empty (loc_id, name, dv); + if (empty) + return (empty > 0); + + int rank = dv.length (); + hid_t space_hid = -1, data_hid = -1; + bool retval = true; + NDArray m = array_value (); + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + + // Octave uses column-major, while HDF5 uses row-major ordering + for (int i = 0; i < rank; i++) + hdims[i] = dv (rank-i-1); + + space_hid = H5Screate_simple (rank, hdims, 0); + + if (space_hid < 0) return false; + + hid_t save_type_hid = H5T_NATIVE_DOUBLE; + + if (save_as_floats) + { + if (m.too_large_for_float ()) + { + warning ("save: some values too large to save as floats --"); + warning ("save: saving as doubles instead"); + } + else + save_type_hid = H5T_NATIVE_FLOAT; + } +#if HAVE_HDF5_INT2FLOAT_CONVERSIONS + // hdf5 currently doesn't support float/integer conversions + else + { + double max_val, min_val; + + if (m.all_integers (max_val, min_val)) + save_type_hid + = save_type_to_hdf5 (get_save_type (max_val, min_val)); + } +#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + return false; + } + + double *mtmp = m.fortran_vec (); + retval = H5Dwrite (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, + H5P_DEFAULT, mtmp) >= 0; + + H5Dclose (data_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_matrix::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; + + dim_vector dv; + int empty = load_hdf5_empty (loc_id, name, dv); + if (empty > 0) + matrix.resize (dv); + if (empty) + return (empty > 0); + +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t space_id = H5Dget_space (data_hid); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank < 1) + { + H5Sclose (space_id); + H5Dclose (data_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_id, hdims, maxdims); + + // Octave uses column-major, while HDF5 uses row-major ordering + if (rank == 1) + { + dv.resize (2); + dv(0) = 1; + dv(1) = hdims[0]; + } + else + { + dv.resize (rank); + for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) + dv(j) = hdims[i]; + } + + NDArray m (dv); + double *re = m.fortran_vec (); + if (H5Dread (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, + H5P_DEFAULT, re) >= 0) + { + retval = true; + matrix = m; + } + + H5Sclose (space_id); + H5Dclose (data_hid); + + return retval; +} + +#endif + +void +octave_matrix::print_raw (std::ostream& os, + bool pr_as_read_syntax) const +{ + octave_print_internal (os, matrix, pr_as_read_syntax, + current_print_indent_level ()); +} + +mxArray * +octave_matrix::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxDOUBLE_CLASS, dims (), mxREAL); + + double *pr = static_cast (retval->get_data ()); + + mwSize nel = numel (); + + const double *p = matrix.data (); + + for (mwIndex i = 0; i < nel; i++) + pr[i] = p[i]; + + return retval; +} + +// This uses a smarter strategy for doing the complex->real mappers. We +// allocate an array for a real result and keep filling it until a complex +// result is produced. +static octave_value +do_rc_map (const NDArray& a, Complex (&fcn) (double)) +{ + octave_idx_type n = a.numel (); + NoAlias rr (a.dims ()); + + for (octave_idx_type i = 0; i < n; i++) + { + octave_quit (); + + Complex tmp = fcn (a(i)); + if (tmp.imag () == 0.0) + rr(i) = tmp.real (); + else + { + NoAlias rc (a.dims ()); + + for (octave_idx_type j = 0; j < i; j++) + rc(j) = rr(j); + + rc(i) = tmp; + + for (octave_idx_type j = i+1; j < n; j++) + { + octave_quit (); + + rc(j) = fcn (a(j)); + } + + return new octave_complex_matrix (rc); + } + } + + return rr; +} + +octave_value +octave_matrix::map (unary_mapper_t umap) const +{ + switch (umap) + { + case umap_imag: + return NDArray (matrix.dims (), 0.0); + + case umap_real: + case umap_conj: + return matrix; + + // Mappers handled specially. +#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.FCN ()) + + ARRAY_METHOD_MAPPER (abs, abs); + ARRAY_METHOD_MAPPER (isnan, isnan); + ARRAY_METHOD_MAPPER (isinf, isinf); + ARRAY_METHOD_MAPPER (finite, isfinite); + +#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.map (FCN)) + +#define RC_ARRAY_MAPPER(UMAP, TYPE, FCN) \ + case umap_ ## UMAP: \ + return do_rc_map (matrix, FCN) + + RC_ARRAY_MAPPER (acos, Complex, rc_acos); + RC_ARRAY_MAPPER (acosh, Complex, rc_acosh); + ARRAY_MAPPER (angle, double, ::arg); + ARRAY_MAPPER (arg, double, ::arg); + RC_ARRAY_MAPPER (asin, Complex, rc_asin); + ARRAY_MAPPER (asinh, double, ::asinh); + ARRAY_MAPPER (atan, double, ::atan); + RC_ARRAY_MAPPER (atanh, Complex, rc_atanh); + ARRAY_MAPPER (erf, double, ::erf); + ARRAY_MAPPER (erfinv, double, ::erfinv); + ARRAY_MAPPER (erfcinv, double, ::erfcinv); + ARRAY_MAPPER (erfc, double, ::erfc); + ARRAY_MAPPER (erfcx, double, ::erfcx); + ARRAY_MAPPER (gamma, double, xgamma); + RC_ARRAY_MAPPER (lgamma, Complex, rc_lgamma); + ARRAY_MAPPER (cbrt, double, ::cbrt); + ARRAY_MAPPER (ceil, double, ::ceil); + ARRAY_MAPPER (cos, double, ::cos); + ARRAY_MAPPER (cosh, double, ::cosh); + ARRAY_MAPPER (exp, double, ::exp); + ARRAY_MAPPER (expm1, double, ::expm1); + ARRAY_MAPPER (fix, double, ::fix); + ARRAY_MAPPER (floor, double, ::floor); + RC_ARRAY_MAPPER (log, Complex, rc_log); + RC_ARRAY_MAPPER (log2, Complex, rc_log2); + RC_ARRAY_MAPPER (log10, Complex, rc_log10); + RC_ARRAY_MAPPER (log1p, Complex, rc_log1p); + ARRAY_MAPPER (round, double, xround); + ARRAY_MAPPER (roundb, double, xroundb); + ARRAY_MAPPER (signum, double, ::signum); + ARRAY_MAPPER (sin, double, ::sin); + ARRAY_MAPPER (sinh, double, ::sinh); + RC_ARRAY_MAPPER (sqrt, Complex, rc_sqrt); + ARRAY_MAPPER (tan, double, ::tan); + ARRAY_MAPPER (tanh, double, ::tanh); + ARRAY_MAPPER (isna, bool, octave_is_NA); + + default: + if (umap >= umap_xisalnum && umap <= umap_xtoupper) + { + octave_value str_conv = convert_to_str (true, true); + return error_state ? octave_value () : str_conv.map (umap); + } + else + return octave_base_value::map (umap); + } +} + +DEFUN (double, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} double (@var{x})\n\ +Convert @var{x} to double precision type.\n\ +@seealso{single}\n\ +@end deftypefn") +{ + // The OCTAVE_TYPE_CONV_BODY3 macro declares retval, so they go + // inside their own scopes, and we don't declare retval here to + // avoid a shadowed declaration warning. + + if (args.length () == 1) + { + if (args(0).is_perm_matrix ()) + { + OCTAVE_TYPE_CONV_BODY3 (double, octave_perm_matrix, octave_scalar); + } + else if (args(0).is_diag_matrix ()) + { + if (args(0).is_complex_type ()) + { + OCTAVE_TYPE_CONV_BODY3 (double, octave_complex_diag_matrix, octave_complex); + } + else + { + OCTAVE_TYPE_CONV_BODY3 (double, octave_diag_matrix, octave_scalar); + } + } + else if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + OCTAVE_TYPE_CONV_BODY3 (double, octave_sparse_complex_matrix, octave_complex); + } + else + { + OCTAVE_TYPE_CONV_BODY3 (double, octave_sparse_matrix, octave_scalar); + } + } + else if (args(0).is_complex_type ()) + { + OCTAVE_TYPE_CONV_BODY3 (double, octave_complex_matrix, octave_complex); + } + else + { + OCTAVE_TYPE_CONV_BODY3 (double, octave_matrix, octave_scalar); + } + } + else + print_usage (); + + return octave_value (); +} + +/* +%!assert (class (double (single (1))), "double") +%!assert (class (double (single (1 + i))), "double") +%!assert (class (double (int8 (1))), "double") +%!assert (class (double (uint8 (1))), "double") +%!assert (class (double (int16 (1))), "double") +%!assert (class (double (uint16 (1))), "double") +%!assert (class (double (int32 (1))), "double") +%!assert (class (double (uint32 (1))), "double") +%!assert (class (double (int64 (1))), "double") +%!assert (class (double (uint64 (1))), "double") +%!assert (class (double (true)), "double") +%!assert (class (double ("A")), "double") +%!test +%! x = sparse (logical ([1 0; 0 1])); +%! y = double (x); +%! assert (class (x), "logical"); +%! assert (class (y), "double"); +%! assert (issparse (y)); +%!test +%! x = diag (single ([1 3 2])); +%! y = double (x); +%! assert (class (x), "single"); +%! assert (class (y), "double"); +%!test +%! x = diag (single ([i 3 2])); +%! y = double (x); +%! assert (class (x), "single"); +%! assert (class (y), "double"); +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-re-mat.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-re-mat.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,242 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_matrix_h) +#define octave_matrix_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-stream.h" +#include "ov-base.h" +#include "ov-base-mat.h" +#include "ov-typeinfo.h" + +#include "MatrixType.h" + +class octave_value_list; + +class tree_walker; + +// Real matrix values. + +class +OCTINTERP_API +octave_matrix : public octave_base_matrix +{ +public: + + octave_matrix (void) + : octave_base_matrix () { } + + octave_matrix (const Matrix& m) + : octave_base_matrix (m) { } + + octave_matrix (const Matrix& m, const MatrixType& t) + : octave_base_matrix (m, t) { } + + octave_matrix (const NDArray& nda) + : octave_base_matrix (nda) { } + + octave_matrix (const Array& m) + : octave_base_matrix (NDArray (m)) { } + + octave_matrix (const DiagMatrix& d) + : octave_base_matrix (Matrix (d)) { } + + octave_matrix (const RowVector& v) + : octave_base_matrix (Matrix (v)) { } + + octave_matrix (const ColumnVector& v) + : octave_base_matrix (Matrix (v)) { } + + octave_matrix (const octave_matrix& m) + : octave_base_matrix (m) { } + + octave_matrix (const Array& idx, + bool zero_based = false, bool cache_index = false) + : octave_base_matrix (NDArray (idx, zero_based)) + { + // Auto-create cache to speed up subsequent indexing. + if (zero_based && cache_index) + set_idx_cache (idx_vector (idx)); + } + + octave_matrix (const NDArray& nda, const idx_vector& cache) + : octave_base_matrix (nda) + { + set_idx_cache (cache); + } + + ~octave_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_matrix (); } + + type_conv_info numeric_demotion_function (void) const; + + octave_base_value *try_narrowing_conversion (void); + + idx_vector index_vector (void) const + { return idx_cache ? *idx_cache : set_idx_cache (idx_vector (matrix)); } + + builtin_type_t builtin_type (void) const { return btyp_double; } + + bool is_real_matrix (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + int8NDArray + int8_array_value (void) const { return int8NDArray (matrix); } + + int16NDArray + int16_array_value (void) const { return int16NDArray (matrix); } + + int32NDArray + int32_array_value (void) const { return int32NDArray (matrix); } + + int64NDArray + int64_array_value (void) const { return int64NDArray (matrix); } + + uint8NDArray + uint8_array_value (void) const { return uint8NDArray (matrix); } + + uint16NDArray + uint16_array_value (void) const { return uint16NDArray (matrix); } + + uint32NDArray + uint32_array_value (void) const { return uint32NDArray (matrix); } + + uint64NDArray + uint64_array_value (void) const { return uint64NDArray (matrix); } + + double double_value (bool = false) const; + + float float_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const; + + FloatMatrix float_matrix_value (bool = false) const; + + Complex complex_value (bool = false) const; + + FloatComplex float_complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + FloatComplexMatrix float_complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const; + + FloatComplexNDArray float_complex_array_value (bool = false) const; + + boolNDArray bool_array_value (bool warn = false) const; + + charNDArray char_array_value (bool = false) const; + + NDArray array_value (bool = false) const { return matrix; } + + FloatNDArray float_array_value (bool = false) const { return matrix; } + + SparseMatrix sparse_matrix_value (bool = false) const; + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; + + octave_value diag (octave_idx_type k = 0) const; + + octave_value diag (octave_idx_type m, octave_idx_type n) const; + + octave_value reshape (const dim_vector& new_dims) const; + + octave_value squeeze (void) const; + + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const; + octave_value sort (Array &sidx, octave_idx_type dim = 0, + sortmode mode = ASCENDING) const; + + sortmode is_sorted (sortmode mode = UNSORTED) const; + + Array sort_rows_idx (sortmode mode = ASCENDING) const; + + sortmode is_sorted_rows (sortmode mode = UNSORTED) const; + + // Use matrix_ref here to clear index cache. + void increment (void) { matrix_ref () += 1.0; } + + void decrement (void) { matrix_ref () -= 1.0; } + + void changesign (void) { matrix_ref ().changesign (); } + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { return os.write (matrix, block_size, output_type, skip, flt_fmt); } + + // Unsafe. This function exists to support the MEX interface. + // You should not use it anywhere else. + void *mex_get_data (void) const { return matrix.mex_get_data (); } + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const; + +private: + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-re-sparse.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-re-sparse.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,945 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "lo-specfun.h" +#include "lo-mappers.h" +#include "oct-locbuf.h" + +#include "ov-base.h" +#include "ov-scalar.h" +#include "gripes.h" + +#include "ls-hdf5.h" + +#include "ov-re-sparse.h" + +#include "ov-base-sparse.h" +#include "ov-base-sparse.cc" + +#include "ov-bool-sparse.h" + +template class OCTINTERP_API octave_base_sparse; + +DEFINE_OCTAVE_ALLOCATOR (octave_sparse_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_sparse_matrix, "sparse matrix", "double"); + +idx_vector +octave_sparse_matrix::index_vector (void) const +{ + if (matrix.numel () == matrix.nnz ()) + return idx_vector (array_value ()); + else + { + std::string nm = type_name (); + error ("%s type invalid as index value", nm.c_str ()); + return idx_vector (); + } +} + +octave_base_value * +octave_sparse_matrix::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (Vsparse_auto_mutate) + { + // Don't use numel, since it can overflow for very large matrices + // Note that for the second test, this means it becomes approximative + // since it involves a cast to double to avoid issues of overflow + if (matrix.rows () == 1 && matrix.cols () == 1) + { + // Const copy of the matrix, so the right version of () operator used + const SparseMatrix tmp (matrix); + + retval = new octave_scalar (tmp (0)); + } + else if (matrix.cols () > 0 && matrix.rows () > 0 + && (double (matrix.byte_size ()) > double (matrix.rows ()) + * double (matrix.cols ()) * sizeof (double))) + retval = new octave_matrix (matrix.matrix_value ()); + } + + return retval; +} + +double +octave_sparse_matrix::double_value (bool) const +{ + double retval = lo_ieee_nan_value (); + + if (numel () > 0) + { + if (numel () > 1) + gripe_implicit_conversion ("Octave:array-to-scalar", + "real sparse matrix", "real scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("real sparse matrix", "real scalar"); + + return retval; +} + +Complex +octave_sparse_matrix::complex_value (bool) const +{ + double tmp = lo_ieee_nan_value (); + + Complex retval (tmp, tmp); + + // FIXME -- maybe this should be a function, valid_as_scalar() + if (rows () > 0 && columns () > 0) + { + if (numel () > 1) + gripe_implicit_conversion ("Octave:array-to-scalar", + "real sparse matrix", "complex scalar"); + + retval = matrix (0, 0); + } + else + gripe_invalid_conversion ("real sparse matrix", "complex scalar"); + + return retval; +} + +Matrix +octave_sparse_matrix::matrix_value (bool) const +{ + return matrix.matrix_value (); +} + +boolNDArray +octave_sparse_matrix::bool_array_value (bool warn) const +{ + NDArray m = matrix.matrix_value (); + + if (m.any_element_is_nan ()) + gripe_nan_to_logical_conversion (); + else if (warn && m.any_element_not_one_or_zero ()) + gripe_logical_conversion (); + + return boolNDArray (m); +} + +charNDArray +octave_sparse_matrix::char_array_value (bool) const +{ + charNDArray retval (dims (), 0); + octave_idx_type nc = matrix.cols (); + octave_idx_type nr = matrix.rows (); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = matrix.cidx (j); i < matrix.cidx (j+1); i++) + retval(matrix.ridx (i) + nr * j) = static_cast(matrix.data (i)); + + return retval; +} + +ComplexMatrix +octave_sparse_matrix::complex_matrix_value (bool) const +{ + return ComplexMatrix (matrix.matrix_value ()); +} + +ComplexNDArray +octave_sparse_matrix::complex_array_value (bool) const +{ + return ComplexNDArray (ComplexMatrix (matrix.matrix_value ())); +} + +NDArray +octave_sparse_matrix::array_value (bool) const +{ + return NDArray (matrix.matrix_value ()); +} + +SparseBoolMatrix +octave_sparse_matrix::sparse_bool_matrix_value (bool warn) const +{ + if (matrix.any_element_is_nan ()) + gripe_nan_to_logical_conversion (); + else if (warn && matrix.any_element_not_one_or_zero ()) + gripe_logical_conversion (); + + return mx_el_ne (matrix, 0.0); +} + +octave_value +octave_sparse_matrix::convert_to_str_internal (bool, bool, char type) const +{ + octave_value retval; + dim_vector dv = dims (); + octave_idx_type nel = dv.numel (); + + if (nel == 0) + { + char s = '\0'; + retval = octave_value (&s, type); + } + else + { + octave_idx_type nr = matrix.rows (); + octave_idx_type nc = matrix.cols (); + charNDArray chm (dv, static_cast (0)); + + bool warned = false; + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = matrix.cidx (j); + i < matrix.cidx (j+1); i++) + { + octave_quit (); + + double d = matrix.data (i); + + if (xisnan (d)) + { + gripe_nan_to_character_conversion (); + return retval; + } + else + { + int ival = NINT (d); + + if (ival < 0 || ival > UCHAR_MAX) + { + // FIXME -- is there something + // better we could do? + + ival = 0; + + if (! warned) + { + ::warning ("range error for conversion to character value"); + warned = true; + } + } + + chm (matrix.ridx (i) + j * nr) = + static_cast (ival); + } + } + + retval = octave_value (chm, type); + } + + return retval; +} + +bool +octave_sparse_matrix::save_binary (std::ostream& os, bool&save_as_floats) +{ + dim_vector d = this->dims (); + if (d.length () < 1) + return false; + + // Ensure that additional memory is deallocated + matrix.maybe_compress (); + + int nr = d(0); + int nc = d(1); + int nz = nnz (); + + int32_t itmp; + // Use negative value for ndims to be consistent with other formats + itmp= -2; + os.write (reinterpret_cast (&itmp), 4); + + itmp= nr; + os.write (reinterpret_cast (&itmp), 4); + + itmp= nc; + os.write (reinterpret_cast (&itmp), 4); + + itmp= nz; + os.write (reinterpret_cast (&itmp), 4); + + save_type st = LS_DOUBLE; + if (save_as_floats) + { + if (matrix.too_large_for_float ()) + { + warning ("save: some values too large to save as floats --"); + warning ("save: saving as doubles instead"); + } + else + st = LS_FLOAT; + } + else if (matrix.nnz () > 8192) // FIXME -- make this configurable. + { + double max_val, min_val; + if (matrix.all_integers (max_val, min_val)) + st = get_save_type (max_val, min_val); + } + + // add one to the printed indices to go from + // zero-based to one-based arrays + for (int i = 0; i < nc+1; i++) + { + octave_quit (); + itmp = matrix.cidx (i); + os.write (reinterpret_cast (&itmp), 4); + } + + for (int i = 0; i < nz; i++) + { + octave_quit (); + itmp = matrix.ridx (i); + os.write (reinterpret_cast (&itmp), 4); + } + + write_doubles (os, matrix.data (), st, nz); + + return true; +} + +bool +octave_sparse_matrix::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + int32_t nz, nc, nr, tmp; + char ctmp; + + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + + if (swap) + swap_bytes<4> (&tmp); + + if (tmp != -2) { + error ("load: only 2D sparse matrices are supported"); + return false; + } + + if (! is.read (reinterpret_cast (&nr), 4)) + return false; + if (! is.read (reinterpret_cast (&nc), 4)) + return false; + if (! is.read (reinterpret_cast (&nz), 4)) + return false; + + if (swap) + { + swap_bytes<4> (&nr); + swap_bytes<4> (&nc); + swap_bytes<4> (&nz); + } + + SparseMatrix m (static_cast (nr), + static_cast (nc), + static_cast (nz)); + + for (int i = 0; i < nc+1; i++) + { + octave_quit (); + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + if (swap) + swap_bytes<4> (&tmp); + m.xcidx (i) = tmp; + } + + for (int i = 0; i < nz; i++) + { + octave_quit (); + if (! is.read (reinterpret_cast (&tmp), 4)) + return false; + if (swap) + swap_bytes<4> (&tmp); + m.xridx (i) = tmp; + } + + if (! is.read (reinterpret_cast (&ctmp), 1)) + return false; + + read_doubles (is, m.xdata (), static_cast (ctmp), nz, swap, fmt); + + if (error_state || ! is) + return false; + + if (! m.indices_ok ()) + return false; + + matrix = m; + + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_sparse_matrix::save_hdf5 (hid_t loc_id, const char *name, + bool save_as_floats) +{ + dim_vector dv = dims (); + int empty = save_hdf5_empty (loc_id, name, dv); + if (empty) + return (empty > 0); + + // Ensure that additional memory is deallocated + matrix.maybe_compress (); + +#if HAVE_HDF5_18 + hid_t group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + hid_t group_hid = H5Gcreate (loc_id, name, 0); +#endif + if (group_hid < 0) + return false; + + hid_t space_hid = -1, data_hid = -1; + bool retval = true; + SparseMatrix m = sparse_matrix_value (); + octave_idx_type tmp; + hsize_t hdims[2]; + + space_hid = H5Screate_simple (0, hdims, 0); + if (space_hid < 0) + { + H5Gclose (group_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + tmp = m.rows (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, + &tmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + tmp = m.cols (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, + &tmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + tmp = m.nnz (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, + &tmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + + hdims[0] = m.cols () + 1; + hdims[1] = 1; + + space_hid = H5Screate_simple (2, hdims, 0); + + if (space_hid < 0) + { + H5Gclose (group_hid); + return false; + } + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + octave_idx_type * itmp = m.xcidx (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, + itmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + + hdims[0] = m.nnz (); + hdims[1] = 1; + + space_hid = H5Screate_simple (2, hdims, 0); + + if (space_hid < 0) + { + H5Gclose (group_hid); + return false; + } +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + itmp = m.xridx (); + retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, + itmp) >= 0; + H5Dclose (data_hid); + if (!retval) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + hid_t save_type_hid = H5T_NATIVE_DOUBLE; + + if (save_as_floats) + { + if (m.too_large_for_float ()) + { + warning ("save: some values too large to save as floats --"); + warning ("save: saving as doubles instead"); + } + else + save_type_hid = H5T_NATIVE_FLOAT; + } +#if HAVE_HDF5_INT2FLOAT_CONVERSIONS + // hdf5 currently doesn't support float/integer conversions + else + { + double max_val, min_val; + + if (m.all_integers (max_val, min_val)) + save_type_hid + = save_type_to_hdf5 (get_save_type (max_val, min_val)); + } +#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (group_hid, "data", save_type_hid, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (group_hid, "data", save_type_hid, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + H5Gclose (group_hid); + return false; + } + + double * dtmp = m.xdata (); + retval = H5Dwrite (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, + H5P_DEFAULT, dtmp) >= 0; + H5Dclose (data_hid); + H5Sclose (space_hid); + H5Gclose (group_hid); + + return retval; +} + +bool +octave_sparse_matrix::load_hdf5 (hid_t loc_id, const char *name) +{ + octave_idx_type nr, nc, nz; + hid_t group_hid, data_hid, space_hid; + hsize_t rank; + + dim_vector dv; + int empty = load_hdf5_empty (loc_id, name, dv); + if (empty > 0) + matrix.resize (dv); + if (empty) + return (empty > 0); + +#if HAVE_HDF5_18 + group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); +#else + group_hid = H5Gopen (loc_id, name); +#endif + if (group_hid < 0) return false; + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "nr", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "nr"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &nr) < 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "nc", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "nc"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &nc) < 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "nz", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "nz"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &nz) < 0) + { + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Dclose (data_hid); + + SparseMatrix m (static_cast (nr), + static_cast (nc), + static_cast (nz)); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "cidx", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "cidx"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 2) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + if (static_cast (hdims[0]) != nc + 1 + || static_cast (hdims[1]) != 1) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + octave_idx_type *itmp = m.xcidx (); + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, itmp) < 0) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "ridx", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "ridx"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 2) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + if (static_cast (hdims[0]) != nz || static_cast (hdims[1]) != 1) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + itmp = m.xridx (); + if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, + H5P_DEFAULT, itmp) < 0) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sclose (space_hid); + H5Dclose (data_hid); + +#if HAVE_HDF5_18 + data_hid = H5Dopen (group_hid, "data", H5P_DEFAULT); +#else + data_hid = H5Dopen (group_hid, "data"); +#endif + space_hid = H5Dget_space (data_hid); + rank = H5Sget_simple_extent_ndims (space_hid); + + if (rank != 2) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + if (static_cast (hdims[0]) != nz || static_cast (hdims[1]) != 1) + { + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + return false; + } + + double *dtmp = m.xdata (); + bool retval = false; + if (H5Dread (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, + H5P_DEFAULT, dtmp) >= 0 + && m.indices_ok ()) + { + retval = true; + matrix = m; + } + + H5Sclose (space_hid); + H5Dclose (data_hid); + H5Gclose (group_hid); + + return retval; +} + +#endif + +mxArray * +octave_sparse_matrix::as_mxArray (void) const +{ + mwSize nz = nzmax (); + mwSize nr = rows (); + mwSize nc = columns (); + mxArray *retval = new mxArray (mxDOUBLE_CLASS, nr, nc, nz, mxREAL); + double *pr = static_cast (retval->get_data ()); + mwIndex *ir = retval->get_ir (); + mwIndex *jc = retval->get_jc (); + + for (mwIndex i = 0; i < nz; i++) + { + pr[i] = matrix.data (i); + ir[i] = matrix.ridx (i); + } + + for (mwIndex i = 0; i < nc + 1; i++) + jc[i] = matrix.cidx (i); + + return retval; +} + +octave_value +octave_sparse_matrix::map (unary_mapper_t umap) const +{ + switch (umap) + { + case umap_imag: + return SparseMatrix (matrix.rows (), matrix.cols (), 0.0); + + case umap_real: + case umap_conj: + return matrix; + + // Mappers handled specially. +#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.FCN ()) + + ARRAY_METHOD_MAPPER (abs, abs); + +#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ + case umap_ ## UMAP: \ + return octave_value (matrix.map (FCN)) + + ARRAY_MAPPER (acos, Complex, rc_acos); + ARRAY_MAPPER (acosh, Complex, rc_acosh); + ARRAY_MAPPER (angle, double, ::arg); + ARRAY_MAPPER (arg, double, ::arg); + ARRAY_MAPPER (asin, Complex, rc_asin); + ARRAY_MAPPER (asinh, double, ::asinh); + ARRAY_MAPPER (atan, double, ::atan); + ARRAY_MAPPER (atanh, Complex, rc_atanh); + ARRAY_MAPPER (erf, double, ::erf); + ARRAY_MAPPER (erfinv, double, ::erfinv); + ARRAY_MAPPER (erfcinv, double, ::erfcinv); + ARRAY_MAPPER (erfc, double, ::erfc); + ARRAY_MAPPER (gamma, double, xgamma); + ARRAY_MAPPER (lgamma, Complex, rc_lgamma); + ARRAY_MAPPER (cbrt, double, ::cbrt); + ARRAY_MAPPER (ceil, double, ::ceil); + ARRAY_MAPPER (cos, double, ::cos); + ARRAY_MAPPER (cosh, double, ::cosh); + ARRAY_MAPPER (exp, double, ::exp); + ARRAY_MAPPER (expm1, double, ::expm1); + ARRAY_MAPPER (fix, double, ::fix); + ARRAY_MAPPER (floor, double, ::floor); + ARRAY_MAPPER (log, Complex, rc_log); + ARRAY_MAPPER (log2, Complex, rc_log2); + ARRAY_MAPPER (log10, Complex, rc_log10); + ARRAY_MAPPER (log1p, Complex, rc_log1p); + ARRAY_MAPPER (round, double, xround); + ARRAY_MAPPER (roundb, double, xroundb); + ARRAY_MAPPER (signum, double, ::signum); + ARRAY_MAPPER (sin, double, ::sin); + ARRAY_MAPPER (sinh, double, ::sinh); + ARRAY_MAPPER (sqrt, Complex, rc_sqrt); + ARRAY_MAPPER (tan, double, ::tan); + ARRAY_MAPPER (tanh, double, ::tanh); + ARRAY_MAPPER (isnan, bool, xisnan); + ARRAY_MAPPER (isna, bool, octave_is_NA); + ARRAY_MAPPER (isinf, bool, xisinf); + ARRAY_MAPPER (finite, bool, xfinite); + + default: // Attempt to go via dense matrix. + return octave_base_sparse::map (umap); + } +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-re-sparse.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-re-sparse.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,164 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_sparse_matrix_h) +#define octave_sparse_matrix_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-stream.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +#include "dSparse.h" +#include "MatrixType.h" +#include "ov-base-sparse.h" +#include "ov-cx-sparse.h" + +class octave_value_list; + +class tree_walker; + +class +OCTINTERP_API +octave_sparse_matrix : public octave_base_sparse +{ +public: + + octave_sparse_matrix (void) + : octave_base_sparse () { } + + octave_sparse_matrix (const Matrix& m) + : octave_base_sparse (SparseMatrix (m)) { } + + octave_sparse_matrix (const NDArray& m) + : octave_base_sparse (SparseMatrix (m)) { } + + octave_sparse_matrix (const SparseMatrix& m) + : octave_base_sparse (m) { } + + octave_sparse_matrix (const SparseMatrix& m, const MatrixType& t) + : octave_base_sparse (m, t) { } + + octave_sparse_matrix (const MSparse& m) + : octave_base_sparse (m) { } + + octave_sparse_matrix (const MSparse& m, const MatrixType& t) + : octave_base_sparse (m, t) { } + + octave_sparse_matrix (const Sparse& m) + : octave_base_sparse (SparseMatrix (m)) { } + + octave_sparse_matrix (const Sparse& m, const MatrixType& t) + : octave_base_sparse (SparseMatrix (m), t) { } + + octave_sparse_matrix (const octave_sparse_matrix& m) + : octave_base_sparse (m) { } + + ~octave_sparse_matrix (void) { } + + octave_base_value *clone (void) const { return new octave_sparse_matrix (*this); } + octave_base_value *empty_clone (void) const { return new octave_sparse_matrix (); } + + octave_base_value *try_narrowing_conversion (void); + + idx_vector index_vector (void) const; + + builtin_type_t builtin_type (void) const { return btyp_double; } + + bool is_real_matrix (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + double double_value (bool = false) const; + + double scalar_value (bool frc_str_conv = false) const + { return double_value (frc_str_conv); } + + Matrix matrix_value (bool = false) const; + + Complex complex_value (bool = false) const; + + boolNDArray bool_array_value (bool warn = false) const; + + charNDArray char_array_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const; + + NDArray array_value (bool = false) const; + + SparseMatrix sparse_matrix_value (bool = false) const + { return matrix; } + + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const + { return SparseComplexMatrix (matrix); } + + SparseBoolMatrix sparse_bool_matrix_value (bool warn = false) const; + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + +#if 0 + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { return os.write (matrix, block_size, output_type, skip, flt_fmt); } +#endif + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const; + +private: + octave_value map (double (*fcn) (double)) const; + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-scalar.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-scalar.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,368 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "data-conv.h" +#include "mach-info.h" +#include "lo-specfun.h" +#include "lo-mappers.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-stream.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-base.h" +#include "ov-base-scalar.h" +#include "ov-base-scalar.cc" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "pr-output.h" +#include "xdiv.h" +#include "xpow.h" +#include "ops.h" + +#include "ls-oct-ascii.h" +#include "ls-hdf5.h" + +template class octave_base_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_scalar); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_scalar, "scalar", "double"); + +static octave_base_value * +default_numeric_demotion_function (const octave_base_value& a) +{ + CAST_CONV_ARG (const octave_scalar&); + + return new octave_float_scalar (v.float_value ()); +} + +octave_base_value::type_conv_info +octave_scalar::numeric_demotion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_demotion_function, + octave_float_scalar::static_type_id ()); +} + +octave_value +octave_scalar::do_index_op (const octave_value_list& idx, bool resize_ok) +{ + // FIXME -- this doesn't solve the problem of + // + // a = 1; a([1,1], [1,1], [1,1]) + // + // and similar constructions. Hmm... + + // FIXME -- using this constructor avoids narrowing the + // 1x1 matrix back to a scalar value. Need a better solution + // to this problem. + + octave_value tmp (new octave_matrix (matrix_value ())); + + return tmp.do_index_op (idx, resize_ok); +} + +octave_value +octave_scalar::resize (const dim_vector& dv, bool fill) const +{ + if (fill) + { + NDArray retval (dv, 0); + + if (dv.numel ()) + retval(0) = scalar; + + return retval; + } + else + { + NDArray retval (dv); + + if (dv.numel ()) + retval(0) = scalar; + + return retval; + } +} + +octave_value +octave_scalar::diag (octave_idx_type m, octave_idx_type n) const +{ + return DiagMatrix (Array (dim_vector (1, 1), scalar), m, n); +} + +octave_value +octave_scalar::convert_to_str_internal (bool, bool, char type) const +{ + octave_value retval; + + if (xisnan (scalar)) + gripe_nan_to_character_conversion (); + else + { + int ival = NINT (scalar); + + if (ival < 0 || ival > UCHAR_MAX) + { + // FIXME -- is there something better we could do? + + ival = 0; + + ::warning ("range error for conversion to character value"); + } + + retval = octave_value (std::string (1, static_cast (ival)), type); + } + + return retval; +} + +bool +octave_scalar::save_ascii (std::ostream& os) +{ + double d = double_value (); + + octave_write_double (os, d); + + os << "\n"; + + return true; +} + +bool +octave_scalar::load_ascii (std::istream& is) +{ + scalar = octave_read_value (is); + if (!is) + { + error ("load: failed to load scalar constant"); + return false; + } + + return true; +} + +bool +octave_scalar::save_binary (std::ostream& os, bool& /* save_as_floats */) +{ + char tmp = LS_DOUBLE; + os.write (reinterpret_cast (&tmp), 1); + double dtmp = double_value (); + os.write (reinterpret_cast (&dtmp), 8); + + return true; +} + +bool +octave_scalar::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + char tmp; + if (! is.read (reinterpret_cast (&tmp), 1)) + return false; + + double dtmp; + read_doubles (is, &dtmp, static_cast (tmp), 1, swap, fmt); + if (error_state || ! is) + return false; + + scalar = dtmp; + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_scalar::save_hdf5 (hid_t loc_id, const char *name, + bool /* save_as_floats */) +{ + hsize_t dimens[3]; + hid_t space_hid = -1, data_hid = -1; + bool retval = true; + + space_hid = H5Screate_simple (0, dimens, 0); + if (space_hid < 0) return false; + +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_DOUBLE, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_DOUBLE, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + return false; + } + + double tmp = double_value (); + retval = H5Dwrite (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &tmp) >= 0; + + H5Dclose (data_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_scalar::load_hdf5 (hid_t loc_id, const char *name) +{ +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t space_id = H5Dget_space (data_hid); + + hsize_t rank = H5Sget_simple_extent_ndims (space_id); + + if (rank != 0) + { + H5Dclose (data_hid); + return false; + } + + double dtmp; + if (H5Dread (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, + H5P_DEFAULT, &dtmp) < 0) + { + H5Dclose (data_hid); + return false; + } + + scalar = dtmp; + + H5Dclose (data_hid); + + return true; +} + +#endif + +mxArray * +octave_scalar::as_mxArray (void) const +{ + mxArray *retval = new mxArray (mxDOUBLE_CLASS, 1, 1, mxREAL); + + double *pr = static_cast (retval->get_data ()); + + pr[0] = scalar; + + return retval; +} + +octave_value +octave_scalar::map (unary_mapper_t umap) const +{ + switch (umap) + { + case umap_imag: + return 0.0; + + case umap_real: + case umap_conj: + return scalar; + +#define SCALAR_MAPPER(UMAP, FCN) \ + case umap_ ## UMAP: \ + return octave_value (FCN (scalar)) + + SCALAR_MAPPER (abs, ::fabs); + SCALAR_MAPPER (acos, rc_acos); + SCALAR_MAPPER (acosh, rc_acosh); + SCALAR_MAPPER (angle, ::arg); + SCALAR_MAPPER (arg, ::arg); + SCALAR_MAPPER (asin, rc_asin); + SCALAR_MAPPER (asinh, ::asinh); + SCALAR_MAPPER (atan, ::atan); + SCALAR_MAPPER (atanh, rc_atanh); + SCALAR_MAPPER (erf, ::erf); + SCALAR_MAPPER (erfinv, ::erfinv); + SCALAR_MAPPER (erfcinv, ::erfcinv); + SCALAR_MAPPER (erfc, ::erfc); + SCALAR_MAPPER (erfcx, ::erfcx); + SCALAR_MAPPER (gamma, xgamma); + SCALAR_MAPPER (lgamma, rc_lgamma); + SCALAR_MAPPER (cbrt, ::cbrt); + SCALAR_MAPPER (ceil, ::ceil); + SCALAR_MAPPER (cos, ::cos); + SCALAR_MAPPER (cosh, ::cosh); + SCALAR_MAPPER (exp, ::exp); + SCALAR_MAPPER (expm1, ::expm1); + SCALAR_MAPPER (fix, ::fix); + SCALAR_MAPPER (floor, gnulib::floor); + SCALAR_MAPPER (log, rc_log); + SCALAR_MAPPER (log2, rc_log2); + SCALAR_MAPPER (log10, rc_log10); + SCALAR_MAPPER (log1p, rc_log1p); + SCALAR_MAPPER (round, xround); + SCALAR_MAPPER (roundb, xroundb); + SCALAR_MAPPER (signum, ::signum); + SCALAR_MAPPER (sin, ::sin); + SCALAR_MAPPER (sinh, ::sinh); + SCALAR_MAPPER (sqrt, rc_sqrt); + SCALAR_MAPPER (tan, ::tan); + SCALAR_MAPPER (tanh, ::tanh); + SCALAR_MAPPER (finite, xfinite); + SCALAR_MAPPER (isinf, xisinf); + SCALAR_MAPPER (isna, octave_is_NA); + SCALAR_MAPPER (isnan, xisnan); + + default: + if (umap >= umap_xisalnum && umap <= umap_xtoupper) + { + octave_value str_conv = convert_to_str (true, true); + return error_state ? octave_value () : str_conv.map (umap); + } + else + return octave_base_value::map (umap); + } +} + +bool +octave_scalar::fast_elem_insert_self (void *where, builtin_type_t btyp) const +{ + + // Support inline real->complex conversion. + if (btyp == btyp_double) + { + *(reinterpret_cast(where)) = scalar; + return true; + } + else if (btyp == btyp_complex) + { + *(reinterpret_cast(where)) = scalar; + return true; + } + else + return false; +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-scalar.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-scalar.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,259 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_scalar_h) +#define octave_scalar_h 1 + +#include + +#include +#include + +#include "lo-ieee.h" +#include "lo-mappers.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "oct-alloc.h" +#include "str-vec.h" + +#include "gripes.h" +#include "ov-base.h" +#include "ov-re-mat.h" +#include "ov-base-scalar.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +OCTINTERP_API +octave_scalar : public octave_base_scalar +{ +public: + + octave_scalar (void) + : octave_base_scalar (0.0) { } + + octave_scalar (double d) + : octave_base_scalar (d) { } + + octave_scalar (const octave_scalar& s) + : octave_base_scalar (s) { } + + ~octave_scalar (void) { } + + octave_base_value *clone (void) const { return new octave_scalar (*this); } + + // We return an octave_matrix here instead of an octave_scalar so + // that in expressions like A(2,2,2) = 2 (for A previously + // undefined), A will be empty instead of a 1x1 object. + octave_base_value *empty_clone (void) const { return new octave_matrix (); } + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + type_conv_info numeric_demotion_function (void) const; + + idx_vector index_vector (void) const { return idx_vector (scalar); } + + octave_value any (int = 0) const + { return (scalar != 0 && ! lo_ieee_isnan (scalar)); } + + builtin_type_t builtin_type (void) const { return btyp_double; } + + bool is_real_scalar (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool is_double_type (void) const { return true; } + + bool is_float_type (void) const { return true; } + + int8NDArray + int8_array_value (void) const + { return int8NDArray (dim_vector (1, 1), scalar); } + + int16NDArray + int16_array_value (void) const + { return int16NDArray (dim_vector (1, 1), scalar); } + + int32NDArray + int32_array_value (void) const + { return int32NDArray (dim_vector (1, 1), scalar); } + + int64NDArray + int64_array_value (void) const + { return int64NDArray (dim_vector (1, 1), scalar); } + + uint8NDArray + uint8_array_value (void) const + { return uint8NDArray (dim_vector (1, 1), scalar); } + + uint16NDArray + uint16_array_value (void) const + { return uint16NDArray (dim_vector (1, 1), scalar); } + + uint32NDArray + uint32_array_value (void) const + { return uint32NDArray (dim_vector (1, 1), scalar); } + + uint64NDArray + uint64_array_value (void) const + { return uint64NDArray (dim_vector (1, 1), scalar); } + +#define DEFINE_INT_SCALAR_VALUE(TYPE) \ + octave_ ## TYPE \ + TYPE ## _scalar_value (void) const \ + { return octave_ ## TYPE (scalar); } + + DEFINE_INT_SCALAR_VALUE (int8) + DEFINE_INT_SCALAR_VALUE (int16) + DEFINE_INT_SCALAR_VALUE (int32) + DEFINE_INT_SCALAR_VALUE (int64) + DEFINE_INT_SCALAR_VALUE (uint8) + DEFINE_INT_SCALAR_VALUE (uint16) + DEFINE_INT_SCALAR_VALUE (uint32) + DEFINE_INT_SCALAR_VALUE (uint64) + +#undef DEFINE_INT_SCALAR_VALUE + + double double_value (bool = false) const { return scalar; } + + float float_value (bool = false) const { return static_cast (scalar); } + + double scalar_value (bool = false) const { return scalar; } + + float float_scalar_value (bool = false) const { return static_cast (scalar); } + + Matrix matrix_value (bool = false) const + { return Matrix (1, 1, scalar); } + + FloatMatrix float_matrix_value (bool = false) const + { return FloatMatrix (1, 1, scalar); } + + NDArray array_value (bool = false) const + { return NDArray (dim_vector (1, 1), scalar); } + + FloatNDArray float_array_value (bool = false) const + { return FloatNDArray (dim_vector (1, 1), scalar); } + + SparseMatrix sparse_matrix_value (bool = false) const + { return SparseMatrix (Matrix (1, 1, scalar)); } + + // FIXME Need SparseComplexMatrix (Matrix) constructor!!! + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const + { return SparseComplexMatrix (sparse_matrix_value ()); } + + octave_value resize (const dim_vector& dv, bool fill = false) const; + + Complex complex_value (bool = false) const { return scalar; } + + FloatComplex float_complex_value (bool = false) const { return scalar; } + + ComplexMatrix complex_matrix_value (bool = false) const + { return ComplexMatrix (1, 1, Complex (scalar)); } + + FloatComplexMatrix float_complex_matrix_value (bool = false) const + { return FloatComplexMatrix (1, 1, FloatComplex (scalar)); } + + ComplexNDArray complex_array_value (bool = false) const + { return ComplexNDArray (dim_vector (1, 1), Complex (scalar)); } + + FloatComplexNDArray float_complex_array_value (bool = false) const + { return FloatComplexNDArray (dim_vector (1, 1), FloatComplex (scalar)); } + + charNDArray + char_array_value (bool = false) const + { + charNDArray retval (dim_vector (1, 1)); + retval(0) = static_cast (scalar); + return retval; + } + + bool bool_value (bool warn = false) const + { + if (xisnan (scalar)) + gripe_nan_to_logical_conversion (); + else if (warn && scalar != 0 && scalar != 1) + gripe_logical_conversion (); + + return scalar; + } + + boolNDArray bool_array_value (bool warn = false) const + { + if (xisnan (scalar)) + gripe_nan_to_logical_conversion (); + else if (warn && scalar != 0 && scalar != 1) + gripe_logical_conversion (); + + return boolNDArray (dim_vector (1, 1), scalar); + } + + octave_value diag (octave_idx_type m, octave_idx_type n) const; + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + + void increment (void) { ++scalar; } + + void decrement (void) { --scalar; } + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { + return os.write (array_value (), block_size, output_type, + skip, flt_fmt); + } + + mxArray *as_mxArray (void) const; + + octave_value map (unary_mapper_t umap) const; + + bool fast_elem_insert_self (void *where, builtin_type_t btyp) const; + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-str-mat.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-str-mat.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,777 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "data-conv.h" +#include "lo-ieee.h" +#include "mach-info.h" +#include "mx-base.h" +#include "oct-locbuf.h" + +#include "byte-swap.h" +#include "defun.h" +#include "gripes.h" +#include "ls-ascii-helper.h" +#include "ls-hdf5.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "oct-obj.h" +#include "oct-stream.h" +#include "ops.h" +#include "ov-scalar.h" +#include "ov-re-mat.h" +#include "ov-str-mat.h" +#include "pr-output.h" +#include "pt-mat.h" +#include "utils.h" + +DEFINE_OCTAVE_ALLOCATOR (octave_char_matrix_str); +DEFINE_OCTAVE_ALLOCATOR (octave_char_matrix_sq_str); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_char_matrix_str, "string", "char"); +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_char_matrix_sq_str, "sq_string", "char"); + +static octave_base_value * +default_numeric_conversion_function (const octave_base_value& a) +{ + octave_base_value *retval = 0; + + CAST_CONV_ARG (const octave_char_matrix_str&); + + NDArray nda = v.array_value (true); + + if (! error_state) + { + if (nda.numel () == 1) + retval = new octave_scalar (nda(0)); + else + retval = new octave_matrix (nda); + } + + return retval; +} + +octave_base_value::type_conv_info +octave_char_matrix_str::numeric_conversion_function (void) const +{ + return octave_base_value::type_conv_info (default_numeric_conversion_function, + octave_matrix::static_type_id ()); +} + +octave_value +octave_char_matrix_str::do_index_op_internal (const octave_value_list& idx, + bool resize_ok, char type) +{ + octave_value retval; + + octave_idx_type len = idx.length (); + + switch (len) + { + case 0: + retval = octave_value (matrix, type); + break; + + case 1: + { + idx_vector i = idx (0).index_vector (); + + if (! error_state) + retval = octave_value (charNDArray (matrix.index (i, resize_ok)), + type); + } + break; + + case 2: + { + idx_vector i = idx (0).index_vector (); + idx_vector j = idx (1).index_vector (); + + if (! error_state) + retval = octave_value (charNDArray (matrix.index (i, j, resize_ok)), + type); + } + break; + + default: + { + Array idx_vec (dim_vector (len, 1)); + + for (octave_idx_type i = 0; i < len; i++) + idx_vec(i) = idx(i).index_vector (); + + if (! error_state) + retval = octave_value (charNDArray (matrix.index (idx_vec, resize_ok)), + type); + } + break; + } + + return retval; +} + +octave_value +octave_char_matrix_str::resize (const dim_vector& dv, bool fill) const +{ + charNDArray retval (matrix); + if (fill) + retval.resize (dv, 0); + else + retval.resize (dv); + return octave_value (retval, is_sq_string () ? '\'' : '"'); +} + +#define CHAR_MATRIX_CONV(T, INIT, TNAME, FCN) \ + T retval INIT; \ + \ + if (! force_string_conv) \ + gripe_invalid_conversion ("string", TNAME); \ + else \ + { \ + warning_with_id ("Octave:str-to-num", \ + "implicit conversion from %s to %s", \ + "string", TNAME); \ + \ + retval = octave_char_matrix::FCN (); \ + } \ + \ + return retval + +double +octave_char_matrix_str::double_value (bool force_string_conv) const +{ + CHAR_MATRIX_CONV (double, = 0, "real scalar", double_value); +} + +Complex +octave_char_matrix_str::complex_value (bool force_string_conv) const +{ + CHAR_MATRIX_CONV (Complex, = 0, "complex scalar", complex_value); +} + +Matrix +octave_char_matrix_str::matrix_value (bool force_string_conv) const +{ + CHAR_MATRIX_CONV (Matrix, , "real matrix", matrix_value); +} + +ComplexMatrix +octave_char_matrix_str::complex_matrix_value (bool force_string_conv) const +{ + CHAR_MATRIX_CONV (ComplexMatrix, , "complex matrix", complex_matrix_value); +} + +NDArray +octave_char_matrix_str::array_value (bool force_string_conv) const +{ + CHAR_MATRIX_CONV (NDArray, , "real N-d array", array_value); +} + +ComplexNDArray +octave_char_matrix_str::complex_array_value (bool force_string_conv) const +{ + CHAR_MATRIX_CONV (ComplexNDArray, , "complex N-d array", + complex_array_value); +} + +string_vector +octave_char_matrix_str::all_strings (bool) const +{ + string_vector retval; + + if (matrix.ndims () == 2) + { + charMatrix chm = matrix.matrix_value (); + + octave_idx_type n = chm.rows (); + + retval.resize (n); + + for (octave_idx_type i = 0; i < n; i++) + retval[i] = chm.row_as_string (i); + } + else + error ("invalid conversion of charNDArray to string_vector"); + + return retval; +} + +std::string +octave_char_matrix_str::string_value (bool) const +{ + std::string retval; + + if (matrix.ndims () == 2) + { + charMatrix chm = matrix.matrix_value (); + + retval = chm.row_as_string (0); // FIXME??? + } + else + error ("invalid conversion of charNDArray to string"); + + return retval; +} + +Array +octave_char_matrix_str::cellstr_value (void) const +{ + Array retval; + + if (matrix.ndims () == 2) + { + const charMatrix chm = matrix.matrix_value (); + octave_idx_type nr = chm.rows (); + retval.clear (nr, 1); + for (octave_idx_type i = 0; i < nr; i++) + retval.xelem (i) = chm.row_as_string (i); + } + else + error ("cellstr: cannot convert multidimensional arrays"); + + return retval; +} + +void +octave_char_matrix_str::print_raw (std::ostream& os, bool pr_as_read_syntax) const +{ + octave_print_internal (os, matrix, pr_as_read_syntax, + current_print_indent_level (), true); +} + +bool +octave_char_matrix_str::save_ascii (std::ostream& os) +{ + dim_vector d = dims (); + if (d.length () > 2) + { + charNDArray tmp = char_array_value (); + os << "# ndims: " << d.length () << "\n"; + for (int i=0; i < d.length (); i++) + os << " " << d (i); + os << "\n"; + os.write (tmp.fortran_vec (), d.numel ()); + os << "\n"; + } + else + { + // Keep this case, rather than use generic code above for + // backward compatiability. Makes load_ascii much more complex!! + charMatrix chm = char_matrix_value (); + octave_idx_type elements = chm.rows (); + os << "# elements: " << elements << "\n"; + for (octave_idx_type i = 0; i < elements; i++) + { + unsigned len = chm.cols (); + os << "# length: " << len << "\n"; + std::string tstr = chm.row_as_string (i); + const char *tmp = tstr.data (); + if (tstr.length () > len) + panic_impossible (); + os.write (tmp, len); + os << "\n"; + } + } + + return true; +} + +bool +octave_char_matrix_str::load_ascii (std::istream& is) +{ + bool success = true; + + string_vector keywords(3); + + keywords[0] = "ndims"; + keywords[1] = "elements"; + keywords[2] = "length"; + + std::string kw; + int val = 0; + + if (extract_keyword (is, keywords, kw, val, true)) + { + if (kw == "ndims") + { + int mdims = val; + + if (mdims >= 0) + { + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + is >> dv(i); + + if (is) + { + charNDArray tmp(dv); + + if (tmp.is_empty ()) + matrix = tmp; + else + { + char *ftmp = tmp.fortran_vec (); + + skip_preceeding_newline (is); + + if (! is.read (ftmp, dv.numel ()) || !is) + { + error ("load: failed to load string constant"); + success = false; + } + else + matrix = tmp; + } + } + else + { + error ("load: failed to read dimensions"); + success = false; + } + } + else + { + error ("load: failed to extract matrix size"); + success = false; + } + } + else if (kw == "elements") + { + int elements = val; + + if (elements >= 0) + { + // FIXME -- need to be able to get max length + // before doing anything. + + charMatrix chm (elements, 0); + int max_len = 0; + for (int i = 0; i < elements; i++) + { + int len; + if (extract_keyword (is, "length", len) && len >= 0) + { + // Use this instead of a C-style character + // buffer so that we can properly handle + // embedded NUL characters. + charMatrix tmp (1, len); + char *ptmp = tmp.fortran_vec (); + + if (len > 0 && ! is.read (ptmp, len)) + { + error ("load: failed to load string constant"); + success = false; + break; + } + else + { + if (len > max_len) + { + max_len = len; + chm.resize (elements, max_len, 0); + } + + chm.insert (tmp, i, 0); + } + } + else + { + error ("load: failed to extract string length for element %d", + i+1); + success = false; + } + } + + if (! error_state) + matrix = chm; + } + else + { + error ("load: failed to extract number of string elements"); + success = false; + } + } + else if (kw == "length") + { + int len = val; + + if (len >= 0) + { + // This is cruft for backward compatiability, + // but relatively harmless. + + // Use this instead of a C-style character buffer so + // that we can properly handle embedded NUL characters. + charMatrix tmp (1, len); + char *ptmp = tmp.fortran_vec (); + + if (len > 0 && ! is.read (ptmp, len)) + { + error ("load: failed to load string constant"); + } + else + { + if (is) + matrix = tmp; + else + error ("load: failed to load string constant"); + } + } + } + else + panic_impossible (); + } + else + { + error ("load: failed to extract number of rows and columns"); + success = false; + } + + return success; +} + +bool +octave_char_matrix_str::save_binary (std::ostream& os, + bool& /* save_as_floats */) +{ + dim_vector d = dims (); + if (d.length () < 1) + return false; + + // Use negative value for ndims to differentiate with old format!! + int32_t tmp = - d.length (); + os.write (reinterpret_cast (&tmp), 4); + for (int i=0; i < d.length (); i++) + { + tmp = d(i); + os.write (reinterpret_cast (&tmp), 4); + } + + charNDArray m = char_array_value (); + os.write (m.fortran_vec (), d.numel ()); + return true; +} + +bool +octave_char_matrix_str::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format /* fmt */) +{ + int32_t elements; + if (! is.read (reinterpret_cast (&elements), 4)) + return false; + if (swap) + swap_bytes<4> (&elements); + + if (elements < 0) + { + int32_t mdims = - elements; + int32_t di; + dim_vector dv; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + { + if (! is.read (reinterpret_cast (&di), 4)) + return false; + if (swap) + swap_bytes<4> (&di); + dv(i) = di; + } + + // Convert an array with a single dimension to be a row vector. + // Octave should never write files like this, other software + // might. + + if (mdims == 1) + { + mdims = 2; + dv.resize (mdims); + dv(1) = dv(0); + dv(0) = 1; + } + + charNDArray m(dv); + char *tmp = m.fortran_vec (); + is.read (tmp, dv.numel ()); + + if (error_state || ! is) + return false; + matrix = m; + } + else + { + charMatrix chm (elements, 0); + int max_len = 0; + for (int i = 0; i < elements; i++) + { + int32_t len; + if (! is.read (reinterpret_cast (&len), 4)) + return false; + if (swap) + swap_bytes<4> (&len); + charMatrix btmp (1, len); + char *pbtmp = btmp.fortran_vec (); + if (! is.read (pbtmp, len)) + return false; + if (len > max_len) + { + max_len = len; + chm.resize (elements, max_len, 0); + } + chm.insert (btmp, i, 0); + } + matrix = chm; + } + return true; +} + +#if defined (HAVE_HDF5) + +bool +octave_char_matrix_str::save_hdf5 (hid_t loc_id, const char *name, + bool /* save_as_floats */) +{ + dim_vector dv = dims (); + int empty = save_hdf5_empty (loc_id, name, dv); + if (empty) + return (empty > 0); + + int rank = dv.length (); + hid_t space_hid = -1, data_hid = -1; + bool retval = true; + charNDArray m = char_array_value (); + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + + // Octave uses column-major, while HDF5 uses row-major ordering + for (int i = 0; i < rank; i++) + hdims[i] = dv (rank-i-1); + + space_hid = H5Screate_simple (rank, hdims, 0); + if (space_hid < 0) + return false; +#if HAVE_HDF5_18 + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_CHAR, space_hid, + H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_CHAR, space_hid, + H5P_DEFAULT); +#endif + if (data_hid < 0) + { + H5Sclose (space_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (char, s, dv.numel ()); + + for (int i = 0; i < dv.numel (); ++i) + s[i] = m(i); + + retval = H5Dwrite (data_hid, H5T_NATIVE_CHAR, H5S_ALL, H5S_ALL, + H5P_DEFAULT, s) >= 0; + + H5Dclose (data_hid); + H5Sclose (space_hid); + + return retval; +} + +bool +octave_char_matrix_str::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; + + dim_vector dv; + int empty = load_hdf5_empty (loc_id, name, dv); + if (empty > 0) + matrix.resize (dv); + if (empty) + return (empty > 0); + +#if HAVE_HDF5_18 + hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); +#else + hid_t data_hid = H5Dopen (loc_id, name); +#endif + hid_t space_hid = H5Dget_space (data_hid); + hsize_t rank = H5Sget_simple_extent_ndims (space_hid); + hid_t type_hid = H5Dget_type (data_hid); + hid_t type_class_hid = H5Tget_class (type_hid); + + if (type_class_hid == H5T_INTEGER) + { + if (rank < 1) + { + H5Tclose (type_hid); + H5Sclose (space_hid); + H5Dclose (data_hid); + return false; + } + + OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); + OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); + + H5Sget_simple_extent_dims (space_hid, hdims, maxdims); + + // Octave uses column-major, while HDF5 uses row-major ordering + if (rank == 1) + { + dv.resize (2); + dv(0) = 1; + dv(1) = hdims[0]; + } + else + { + dv.resize (rank); + for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) + dv(j) = hdims[i]; + } + + charNDArray m (dv); + char *str = m.fortran_vec (); + if (H5Dread (data_hid, H5T_NATIVE_CHAR, H5S_ALL, H5S_ALL, + H5P_DEFAULT, str) >= 0) + { + retval = true; + matrix = m; + } + + H5Tclose (type_hid); + H5Sclose (space_hid); + H5Dclose (data_hid); + return true; + } + else + { + // This is cruft for backward compatiability and easy data + // importation + if (rank == 0) + { + // a single string: + int slen = H5Tget_size (type_hid); + if (slen < 0) + { + H5Tclose (type_hid); + H5Sclose (space_hid); + H5Dclose (data_hid); + return false; + } + else + { + OCTAVE_LOCAL_BUFFER (char, s, slen); + // create datatype for (null-terminated) string + // to read into: + hid_t st_id = H5Tcopy (H5T_C_S1); + H5Tset_size (st_id, slen); + if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, s) < 0) + { + H5Tclose (st_id); + H5Tclose (type_hid); + H5Sclose (space_hid); + H5Dclose (data_hid); + return false; + } + + matrix = charMatrix (s); + + H5Tclose (st_id); + H5Tclose (type_hid); + H5Sclose (space_hid); + H5Dclose (data_hid); + return true; + } + } + else if (rank == 1) + { + // string vector + hsize_t elements, maxdim; + H5Sget_simple_extent_dims (space_hid, &elements, &maxdim); + int slen = H5Tget_size (type_hid); + if (slen < 0) + { + H5Tclose (type_hid); + H5Sclose (space_hid); + H5Dclose (data_hid); + return false; + } + else + { + // hdf5 string arrays store strings of all the + // same physical length (I think), which is + // slightly wasteful, but oh well. + + OCTAVE_LOCAL_BUFFER (char, s, elements * slen); + + // create datatype for (null-terminated) string + // to read into: + hid_t st_id = H5Tcopy (H5T_C_S1); + H5Tset_size (st_id, slen); + + if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, s) < 0) + { + H5Tclose (st_id); + H5Tclose (type_hid); + H5Sclose (space_hid); + H5Dclose (data_hid); + return false; + } + + charMatrix chm (elements, slen - 1); + for (hsize_t i = 0; i < elements; ++i) + { + chm.insert (s + i*slen, i, 0); + } + + matrix = chm; + + H5Tclose (st_id); + H5Tclose (type_hid); + H5Sclose (space_hid); + H5Dclose (data_hid); + return true; + } + } + else + { + H5Tclose (type_hid); + H5Sclose (space_hid); + H5Dclose (data_hid); + return false; + } + } + + return retval; +} + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-str-mat.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-str-mat.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,257 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_char_matrix_str_h) +#define octave_char_matrix_str_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-stream.h" +#include "ov.h" +#include "ov-ch-mat.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// Character matrix values with special properties for use as +// strings. + +class +OCTINTERP_API +octave_char_matrix_str : public octave_char_matrix +{ +public: + + octave_char_matrix_str (void) + : octave_char_matrix () { } + + octave_char_matrix_str (const charMatrix& chm) + : octave_char_matrix (chm) { } + + octave_char_matrix_str (const charNDArray& chm) + : octave_char_matrix (chm) { } + + octave_char_matrix_str (const Array& chm) + : octave_char_matrix (chm) { } + + octave_char_matrix_str (char c) + : octave_char_matrix (c) { } + + octave_char_matrix_str (const char *s) + : octave_char_matrix (s) { } + + octave_char_matrix_str (const std::string& s) + : octave_char_matrix (s) { } + + octave_char_matrix_str (const string_vector& s) + : octave_char_matrix (s) { } + + octave_char_matrix_str (const octave_char_matrix& chm) + : octave_char_matrix (chm) { } + + octave_char_matrix_str (const octave_char_matrix_str& chms) + : octave_char_matrix (chms) { } + + ~octave_char_matrix_str (void) { } + + octave_base_value *clone (void) const { return new octave_char_matrix_str (*this); } + octave_base_value *empty_clone (void) const { return new octave_char_matrix_str (); } + + type_conv_info numeric_conversion_function (void) const; + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false) + { return do_index_op_internal (idx, resize_ok); } + + octave_value squeeze (void) const + { return octave_value (charNDArray (matrix.squeeze ())); } + + octave_value reshape (const dim_vector& new_dims) const + { return octave_value (charNDArray (matrix.reshape (new_dims))); } + + octave_value permute (const Array& vec, bool inv = false) const + { return octave_value (charNDArray (matrix.permute (vec, inv))); } + + octave_value resize (const dim_vector& dv, bool fill = false) const; + + octave_value diag (octave_idx_type k = 0) const + { return octave_value (matrix.diag (k)); } + + bool is_string (void) const { return true; } + + bool is_numeric_type (void) const { return false; } + + double double_value (bool = false) const; + + Matrix matrix_value (bool = false) const; + + NDArray array_value (bool = false) const; + + Complex complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + ComplexNDArray complex_array_value (bool = false) const; + + string_vector all_strings (bool pad = false) const; + + std::string string_value (bool force = false) const; + + Array cellstr_value (void) const; + + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const + { return octave_value (matrix.sort (dim, mode)); } + + octave_value sort (Array &sidx, octave_idx_type dim = 0, + sortmode mode = ASCENDING) const + { return octave_value (matrix.sort (sidx, dim, mode)); } + + bool print_as_scalar (void) const { return (rows () <= 1); } + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const + { return os.write (matrix, block_size, output_type, skip, flt_fmt); } + +protected: + + octave_value do_index_op_internal (const octave_value_list& idx, + bool resize_ok, char type = '"'); + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +typedef octave_char_matrix_str octave_char_matrix_dq_str; + +class +octave_char_matrix_sq_str : public octave_char_matrix_str +{ +public: + + octave_char_matrix_sq_str (void) + : octave_char_matrix_str () { } + + octave_char_matrix_sq_str (const charMatrix& chm) + : octave_char_matrix_str (chm) { } + + octave_char_matrix_sq_str (const charNDArray& chm) + : octave_char_matrix_str (chm) { } + + octave_char_matrix_sq_str (const Array& chm) + : octave_char_matrix_str (chm) { } + + octave_char_matrix_sq_str (char c) + : octave_char_matrix_str (c) { } + + octave_char_matrix_sq_str (const char *s) + : octave_char_matrix_str (s) { } + + octave_char_matrix_sq_str (const std::string& s) + : octave_char_matrix_str (s) { } + + octave_char_matrix_sq_str (const string_vector& s) + : octave_char_matrix_str (s) { } + + octave_char_matrix_sq_str (const octave_char_matrix_str& chm) + : octave_char_matrix_str (chm) { } + + octave_char_matrix_sq_str (const octave_char_matrix_sq_str& chms) + : octave_char_matrix_str (chms) { } + + ~octave_char_matrix_sq_str (void) { } + + octave_base_value *clone (void) const { return new octave_char_matrix_sq_str (*this); } + octave_base_value *empty_clone (void) const { return new octave_char_matrix_sq_str (); } + + octave_value squeeze (void) const + { return octave_value (charNDArray (matrix.squeeze ()), '\''); } + + octave_value reshape (const dim_vector& new_dims) const + { return octave_value (charNDArray (matrix.reshape (new_dims)), '\''); } + + octave_value permute (const Array& vec, bool inv = false) const + { return octave_value (charNDArray (matrix.permute (vec, inv)), '\''); } + + octave_value resize (const dim_vector& dv, bool = false) const + { + charNDArray retval (matrix); + retval.resize (dv); + return octave_value (retval, '\''); + } + + octave_value diag (octave_idx_type k = 0) const + { return octave_value (matrix.diag (k), '\''); } + + bool is_sq_string (void) const { return true; } + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false) + { return do_index_op_internal (idx, resize_ok, '\''); } + + + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const + { return octave_value (matrix.sort (dim, mode), '\''); } + + octave_value sort (Array &sidx, octave_idx_type dim = 0, + sortmode mode = ASCENDING) const + { return octave_value (matrix.sort (sidx, dim, mode), '\''); } + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-struct.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-struct.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,2235 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "oct-lvalue.h" +#include "ov-struct.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +#include "Array-util.h" +#include "oct-locbuf.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-oct-binary.h" +#include "ls-hdf5.h" +#include "ls-utils.h" +#include "pr-output.h" + +DEFINE_OCTAVE_ALLOCATOR(octave_struct); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA(octave_struct, "struct", "struct"); + +// How many levels of structure elements should we print? +static int Vstruct_levels_to_print = 2; + +// TRUE means print struct array contents, up to the number of levels +// specified by struct_levels_to_print. +static bool Vprint_struct_array_contents = false; + +octave_base_value * +octave_struct::try_narrowing_conversion (void) +{ + octave_base_value *retval = 0; + + if (numel () == 1) + retval = new octave_scalar_struct (map.checkelem (0)); + + return retval; +} + +Cell +octave_struct::dotref (const octave_value_list& idx, bool auto_add) +{ + Cell retval; + + assert (idx.length () == 1); + + std::string nm = idx(0).string_value (); + + octave_map::const_iterator p = map.seek (nm); + + if (p != map.end ()) + retval = map.contents (p); + else if (auto_add) + retval = (numel () == 0) ? Cell (dim_vector (1, 1)) : Cell (dims ()); + else + error ("structure has no member `%s'", nm.c_str ()); + + return retval; +} + +#if 0 +static void +gripe_invalid_index1 (void) +{ + error ("invalid index for structure array"); +} +#endif + +static void +gripe_invalid_index_for_assignment (void) +{ + error ("invalid index for structure array assignment"); +} + +static void +gripe_invalid_index_type (const std::string& nm, char t) +{ + error ("%s cannot be indexed with %c", nm.c_str (), t); +} + +static void +gripe_failed_assignment (void) +{ + error ("assignment to structure element failed"); +} + +octave_value_list +octave_struct::subsref (const std::string& type, + const std::list& idx, + int nargout) +{ + octave_value_list retval; + + int skip = 1; + + switch (type[0]) + { + case '(': + { + if (type.length () > 1 && type[1] == '.') + { + std::list::const_iterator p = idx.begin (); + octave_value_list key_idx = *++p; + + const Cell tmp = dotref (key_idx); + + if (! error_state) + { + const Cell t = tmp.index (idx.front ()); + + retval(0) = (t.length () == 1) ? t(0) : octave_value (t, true); + + // We handled two index elements, so tell + // next_subsref to skip both of them. + + skip++; + } + } + else + retval(0) = do_index_op (idx.front ()); + } + break; + + case '.': + { + if (map.numel () > 0) + { + const Cell t = dotref (idx.front ()); + + retval(0) = (t.length () == 1) ? t(0) : octave_value (t, true); + } + } + break; + + case '{': + gripe_invalid_index_type (type_name (), type[0]); + break; + + default: + panic_impossible (); + } + + // FIXME -- perhaps there should be an + // octave_value_list::next_subsref member function? See also + // octave_user_function::subsref. + + if (idx.size () > 1) + retval = retval(0).next_subsref (nargout, type, idx, skip); + + return retval; +} + +octave_value +octave_struct::subsref (const std::string& type, + const std::list& idx, + bool auto_add) +{ + octave_value retval; + + int skip = 1; + + switch (type[0]) + { + case '(': + { + if (type.length () > 1 && type[1] == '.') + { + std::list::const_iterator p = idx.begin (); + octave_value_list key_idx = *++p; + + const Cell tmp = dotref (key_idx, auto_add); + + if (! error_state) + { + const Cell t = tmp.index (idx.front (), auto_add); + + retval = (t.length () == 1) ? t(0) : octave_value (t, true); + + // We handled two index elements, so tell + // next_subsref to skip both of them. + + skip++; + } + } + else + retval = do_index_op (idx.front (), auto_add); + } + break; + + case '.': + { + if (map.numel () > 0) + { + const Cell t = dotref (idx.front (), auto_add); + + retval = (t.length () == 1) ? t(0) : octave_value (t, true); + } + } + break; + + case '{': + gripe_invalid_index_type (type_name (), type[0]); + break; + + default: + panic_impossible (); + } + + // FIXME -- perhaps there should be an + // octave_value_list::next_subsref member function? See also + // octave_user_function::subsref. + + if (idx.size () > 1) + retval = retval.next_subsref (auto_add, type, idx, skip); + + return retval; +} + +/* +%!test +%! x(1).a.a = 1; +%! x(2).a.a = 2; +%! assert (size (x), [1, 2]); +%! assert (x(1).a.a, 1); +%! assert (x(2).a.a, 2); +*/ + +octave_value +octave_struct::numeric_conv (const octave_value& val, + const std::string& type) +{ + octave_value retval; + + if (type.length () > 0 && type[0] == '.' && ! val.is_map ()) + retval = octave_map (); + else + retval = val; + + return retval; +} + +octave_value +octave_struct::subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + octave_value retval; + + int n = type.length (); + + octave_value t_rhs = rhs; + + if (idx.front ().empty ()) + { + error ("missing index in indexed assignment"); + return retval; + } + + if (n > 1 && ! (type.length () == 2 && type[0] == '(' && type[1] == '.')) + { + switch (type[0]) + { + case '(': + { + if (type.length () > 1 && type[1] == '.') + { + std::list::const_iterator p = idx.begin (); + octave_value_list t_idx = *p; + + octave_value_list key_idx = *++p; + + assert (key_idx.length () == 1); + + std::string key = key_idx(0).string_value (); + + std::list next_idx (idx); + + // We handled two index elements, so subsasgn to + // needs to skip both of them. + + next_idx.erase (next_idx.begin ()); + next_idx.erase (next_idx.begin ()); + + std::string next_type = type.substr (2); + + Cell tmpc (1, 1); + octave_map::iterator pkey = map.seek (key); + if (pkey != map.end ()) + { + map.contents (pkey).make_unique (); + tmpc = map.contents (pkey).index (idx.front (), true); + } + + // FIXME: better code reuse? cf. octave_cell::subsasgn and the case below. + if (! error_state) + { + if (tmpc.numel () == 1) + { + octave_value& tmp = tmpc(0); + + bool orig_undefined = tmp.is_undefined (); + + if (orig_undefined || tmp.is_zero_by_zero ()) + { + tmp = octave_value::empty_conv (next_type, rhs); + tmp.make_unique (); // probably a no-op. + } + else + // optimization: ignore the copy still stored inside our map. + tmp.make_unique (1); + + if (! error_state) + t_rhs = (orig_undefined + ? tmp.undef_subsasgn (next_type, next_idx, rhs) + : tmp.subsasgn (next_type, next_idx, rhs)); + } + else + gripe_indexed_cs_list (); + } + } + else + gripe_invalid_index_for_assignment (); + } + break; + + case '.': + { + octave_value_list key_idx = idx.front (); + + assert (key_idx.length () == 1); + + std::string key = key_idx(0).string_value (); + + std::list next_idx (idx); + + next_idx.erase (next_idx.begin ()); + + std::string next_type = type.substr (1); + + Cell tmpc (1, 1); + octave_map::iterator pkey = map.seek (key); + if (pkey != map.end ()) + { + map.contents (pkey).make_unique (); + tmpc = map.contents (pkey); + } + + // FIXME: better code reuse? + if (! error_state) + { + if (tmpc.numel () == 1) + { + octave_value& tmp = tmpc(0); + + bool orig_undefined = tmp.is_undefined (); + + if (orig_undefined || tmp.is_zero_by_zero ()) + { + tmp = octave_value::empty_conv (next_type, rhs); + tmp.make_unique (); // probably a no-op. + } + else + // optimization: ignore the copy still stored inside our map. + tmp.make_unique (1); + + if (! error_state) + t_rhs = (orig_undefined + ? tmp.undef_subsasgn (next_type, next_idx, rhs) + : tmp.subsasgn (next_type, next_idx, rhs)); + } + else + gripe_indexed_cs_list (); + } + } + break; + + case '{': + gripe_invalid_index_type (type_name (), type[0]); + break; + + default: + panic_impossible (); + } + } + + if (! error_state) + { + switch (type[0]) + { + case '(': + { + if (n > 1 && type[1] == '.') + { + std::list::const_iterator p = idx.begin (); + octave_value_list key_idx = *++p; + octave_value_list idxf = idx.front (); + + assert (key_idx.length () == 1); + + std::string key = key_idx(0).string_value (); + + if (! error_state) + { + if (t_rhs.is_cs_list ()) + { + Cell tmp_cell = Cell (t_rhs.list_value ()); + + // Inquire the proper shape of the RHS. + + dim_vector didx = dims ().redim (idxf.length ()); + for (octave_idx_type k = 0; k < idxf.length (); k++) + if (! idxf(k).is_magic_colon ()) didx(k) = idxf(k).numel (); + + if (didx.numel () == tmp_cell.numel ()) + tmp_cell = tmp_cell.reshape (didx); + + + map.assign (idxf, key, tmp_cell); + + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + else + { + const octave_map& cmap = const_cast (map); + // cast map to const reference to avoid forced key insertion. + if (idxf.all_scalars () + || cmap.contents (key).index (idxf, true).numel () == 1) + { + map.assign (idxf, key, Cell (t_rhs.storable_value ())); + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + else if (! error_state) + gripe_nonbraced_cs_list_assignment (); + } + } + else + gripe_failed_assignment (); + } + else + { + if (t_rhs.is_map () || t_rhs.is_object ()) + { + octave_map rhs_map = t_rhs.map_value (); + + if (! error_state) + { + map.assign (idx.front (), rhs_map); + + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + else + error ("invalid structure assignment"); + } + else + { + if (t_rhs.is_null_value ()) + { + map.delete_elements (idx.front ()); + + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + else + error ("invalid structure assignment"); + } + } + } + break; + + case '.': + { + octave_value_list key_idx = idx.front (); + + assert (key_idx.length () == 1); + + std::string key = key_idx(0).string_value (); + + if (t_rhs.is_cs_list ()) + { + Cell tmp_cell = Cell (t_rhs.list_value ()); + + // The shape of the RHS is irrelevant, we just want + // the number of elements to agree and to preserve the + // shape of the left hand side of the assignment. + + if (numel () == tmp_cell.numel ()) + tmp_cell = tmp_cell.reshape (dims ()); + + map.setfield (key, tmp_cell); + } + else + { + Cell tmp_cell(1, 1); + tmp_cell(0) = t_rhs.storable_value (); + map.setfield (key, tmp_cell); + } + + if (! error_state) + { + count++; + retval = octave_value (this); + } + else + gripe_failed_assignment (); + } + break; + + case '{': + gripe_invalid_index_type (type_name (), type[0]); + break; + + default: + panic_impossible (); + } + } + else + gripe_failed_assignment (); + + retval.maybe_mutate (); + + return retval; +} + +octave_value +octave_struct::do_index_op (const octave_value_list& idx, bool resize_ok) +{ + // octave_map handles indexing itself. + return map.index (idx, resize_ok); +} + +size_t +octave_struct::byte_size (void) const +{ + // Neglect the size of the fieldnames. + + size_t retval = 0; + + for (octave_map::const_iterator p = map.begin (); p != map.end (); p++) + { + std::string key = map.key (p); + + octave_value val = octave_value (map.contents (p)); + + retval += val.byte_size (); + } + + return retval; +} + +void +octave_struct::print (std::ostream& os, bool) const +{ + print_raw (os); +} + +void +octave_struct::print_raw (std::ostream& os, bool) const +{ + unwind_protect frame; + + frame.protect_var (Vstruct_levels_to_print); + + if (Vstruct_levels_to_print >= 0) + { + bool max_depth_reached = Vstruct_levels_to_print-- == 0; + + bool print_fieldnames_only + = (max_depth_reached || ! Vprint_struct_array_contents); + + increment_indent_level (); + + newline (os); + indent (os); + dim_vector dv = dims (); + os << dv.str () << " struct array containing the fields:"; + newline (os); + + increment_indent_level (); + + string_vector key_list = map.fieldnames (); + + for (octave_idx_type i = 0; i < key_list.length (); i++) + { + std::string key = key_list[i]; + + Cell val = map.contents (key); + + newline (os); + + if (print_fieldnames_only) + { + indent (os); + os << key; + } + else + { + octave_value tmp (val); + tmp.print_with_name (os, key); + } + } + + if (print_fieldnames_only) + newline (os); + + decrement_indent_level (); + decrement_indent_level (); + } + else + { + indent (os); + os << ""; + newline (os); + } +} + +bool +octave_struct::print_name_tag (std::ostream& os, const std::string& name) const +{ + bool retval = false; + + indent (os); + + if (Vstruct_levels_to_print < 0) + os << name << " = "; + else + { + os << name << " ="; + newline (os); + retval = true; + } + + return retval; +} + +static bool +scalar (const dim_vector& dims) +{ + return dims.length () == 2 && dims (0) == 1 && dims (1) == 1; +} + + +bool +octave_struct::save_ascii (std::ostream& os) +{ + octave_map m = map_value (); + + octave_idx_type nf = m.nfields (); + + const dim_vector dv = dims (); + + os << "# ndims: " << dv.length () << "\n"; + + for (int i = 0; i < dv.length (); i++) + os << " " << dv (i); + os << "\n"; + + os << "# length: " << nf << "\n"; + + // Iterating over the list of keys will preserve the order of the + // fields. + string_vector keys = m.fieldnames (); + + for (octave_idx_type i = 0; i < nf; i++) + { + std::string key = keys(i); + + octave_value val = map.contents (key); + + bool b = save_ascii_data (os, val, key, false, 0); + + if (! b) + return os; + } + + return true; +} + +bool +octave_struct::load_ascii (std::istream& is) +{ + octave_idx_type len = 0; + dim_vector dv (1, 1); + bool success = true; + + // KLUGE: earlier Octave versions did not save extra dimensions with struct, + // and as a result did not preserve dimensions for empty structs. + // The default dimensions were 1x1, which we want to preserve. + string_vector keywords(2); + + keywords[0] = "ndims"; + keywords[1] = "length"; + + std::string kw; + + if (extract_keyword (is, keywords, kw, len, true)) + { + if (kw == keywords[0]) + { + int mdims = std::max (static_cast (len), 2); + dv.resize (mdims); + for (int i = 0; i < mdims; i++) + is >> dv(i); + + success = extract_keyword (is, keywords[1], len); + } + } + else + success = false; + + if (success && len >= 0) + { + if (len > 0) + { + octave_map m (dv); + + for (octave_idx_type j = 0; j < len; j++) + { + octave_value t2; + bool dummy; + + // recurse to read cell elements + std::string nm + = read_ascii_data (is, std::string (), dummy, t2, j); + + if (!is) + break; + + Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); + + if (error_state) + { + error ("load: internal error loading struct elements"); + return false; + } + + m.setfield (nm, tcell); + } + + if (is) + map = m; + else + { + error ("load: failed to load structure"); + success = false; + } + } + else if (len == 0 ) + map = octave_map (dv); + else + panic_impossible (); + } + else { + error ("load: failed to extract number of elements in structure"); + success = false; + } + + return success; +} + +bool +octave_struct::save_binary (std::ostream& os, bool& save_as_floats) +{ + octave_map m = map_value (); + + octave_idx_type nf = m.nfields (); + + dim_vector d = dims (); + if (d.length () < 1) + return false; + + // Use negative value for ndims + int32_t di = - d.length (); + os.write (reinterpret_cast (&di), 4); + for (int i = 0; i < d.length (); i++) + { + di = d(i); + os.write (reinterpret_cast (&di), 4); + } + + int32_t len = nf; + os.write (reinterpret_cast (&len), 4); + + // Iterating over the list of keys will preserve the order of the + // fields. + string_vector keys = m.fieldnames (); + + for (octave_idx_type i = 0; i < nf; i++) + { + std::string key = keys(i); + + octave_value val = map.contents (key); + + bool b = save_binary_data (os, val, key, "", 0, save_as_floats); + + if (! b) + return os; + } + + return true; +} + +bool +octave_struct::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + bool success = true; + int32_t len; + if (! is.read (reinterpret_cast (&len), 4)) + return false; + if (swap) + swap_bytes<4> (&len); + + dim_vector dv (1, 1); + + if (len < 0) + { + // We have explicit dimensions. + int mdims = -len; + + int32_t di; + dv.resize (mdims); + + for (int i = 0; i < mdims; i++) + { + if (! is.read (reinterpret_cast (&di), 4)) + return false; + if (swap) + swap_bytes<4> (&di); + dv(i) = di; + } + + if (! is.read (reinterpret_cast (&len), 4)) + return false; + if (swap) + swap_bytes<4> (&len); + } + + if (len > 0) + { + octave_map m (dv); + + for (octave_idx_type j = 0; j < len; j++) + { + octave_value t2; + bool dummy; + std::string doc; + + // recurse to read cell elements + std::string nm = read_binary_data (is, swap, fmt, std::string (), + dummy, t2, doc); + + if (!is) + break; + + Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); + + if (error_state) + { + error ("load: internal error loading struct elements"); + return false; + } + + m.setfield (nm, tcell); + } + + if (is) + map = m; + else + { + error ("load: failed to load structure"); + success = false; + } + } + else if (len == 0) + map = octave_map (dv); + else + success = false; + + return success; +} + +#if defined (HAVE_HDF5) + +bool +octave_struct::save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) +{ + hid_t data_hid = -1; + +#if HAVE_HDF5_18 + data_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Gcreate (loc_id, name, 0); +#endif + if (data_hid < 0) return false; + + // recursively add each element of the structure to this group + octave_map m = map_value (); + + octave_idx_type nf = m.nfields (); + + // Iterating over the list of keys will preserve the order of the + // fields. + string_vector keys = m.fieldnames (); + + for (octave_idx_type i = 0; i < nf; i++) + { + std::string key = keys(i); + + octave_value val = map.contents (key); + + bool retval2 = add_hdf5_data (data_hid, val, key, "", false, + save_as_floats); + + if (! retval2) + break; + } + + H5Gclose (data_hid); + + return true; +} + +bool +octave_struct::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; + + hdf5_callback_data dsub; + + herr_t retval2 = 0; + octave_map m (dim_vector (1, 1)); + int current_item = 0; + hsize_t num_obj = 0; +#if HAVE_HDF5_18 + hid_t group_id = H5Gopen (loc_id, name, H5P_DEFAULT); +#else + hid_t group_id = H5Gopen (loc_id, name); +#endif + H5Gget_num_objs (group_id, &num_obj); + H5Gclose (group_id); + + // FIXME -- fields appear to be sorted alphabetically on loading. + // Why is that happening? + + while (current_item < static_cast (num_obj) + && (retval2 = H5Giterate (loc_id, name, ¤t_item, + hdf5_read_next_data, &dsub)) > 0) + { + octave_value t2 = dsub.tc; + + Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); + + if (error_state) + { + error ("load: internal error loading struct elements"); + return false; + } + + m.setfield (dsub.name, tcell); + + } + + if (retval2 >= 0) + { + map = m; + retval = true; + } + + return retval; +} + +#endif + +mxArray * +octave_struct::as_mxArray (void) const +{ + int nf = nfields (); + string_vector kv = map_keys (); + + OCTAVE_LOCAL_BUFFER (const char *, f, nf); + + for (int i = 0; i < nf; i++) + f[i] = kv[i].c_str (); + + mxArray *retval = new mxArray (dims (), nf, f); + + mxArray **elts = static_cast (retval->get_data ()); + + mwSize nel = numel (); + + mwSize ntot = nf * nel; + + for (int i = 0; i < nf; i++) + { + Cell c = map.contents (kv[i]); + + const octave_value *p = c.data (); + + mwIndex k = 0; + for (mwIndex j = i; j < ntot; j += nf) + elts[j] = new mxArray (p[k++]); + } + + return retval; +} + +octave_value +octave_struct::fast_elem_extract (octave_idx_type n) const +{ + if (n < map.numel ()) + return map.checkelem (n); + else + return octave_value (); +} + +bool +octave_struct::fast_elem_insert (octave_idx_type n, + const octave_value& x) +{ + bool retval = false; + + if (n < map.numel ()) + { + // To avoid copying the scalar struct, it just stores a pointer to + // itself. + const octave_scalar_map *sm_ptr; + void *here = reinterpret_cast(&sm_ptr); + return (x.get_rep ().fast_elem_insert_self (here, btyp_struct) + && map.fast_elem_insert (n, *sm_ptr)); + } + + return retval; +} +DEFINE_OCTAVE_ALLOCATOR(octave_scalar_struct); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA(octave_scalar_struct, "scalar struct", "struct"); + +octave_value +octave_scalar_struct::dotref (const octave_value_list& idx, bool auto_add) +{ + assert (idx.length () == 1); + + std::string nm = idx(0).string_value (); + + octave_value retval = map.getfield (nm); + + if (! auto_add && retval.is_undefined ()) + error ("structure has no member `%s'", nm.c_str ()); + + return retval; +} + +octave_value +octave_scalar_struct::subsref (const std::string& type, + const std::list& idx) +{ + octave_value retval; + + if (type[0] == '.') + { + int skip = 1; + + retval = dotref (idx.front ()); + + if (idx.size () > 1) + retval = retval.next_subsref (type, idx, skip); + } + else + retval = to_array ().subsref (type, idx); + + return retval; +} + +octave_value_list +octave_scalar_struct::subsref (const std::string& type, + const std::list& idx, + int nargout) +{ + octave_value_list retval; + + if (type[0] == '.') + { + int skip = 1; + + retval(0) = dotref (idx.front ()); + + if (idx.size () > 1) + retval = retval(0).next_subsref (nargout, type, idx, skip); + } + else + retval = to_array ().subsref (type, idx, nargout); + + return retval; +} + +octave_value +octave_scalar_struct::subsref (const std::string& type, + const std::list& idx, + bool auto_add) +{ + octave_value retval; + + if (type[0] == '.') + { + int skip = 1; + + retval = dotref (idx.front (), auto_add); + + if (idx.size () > 1) + retval = retval.next_subsref (auto_add, type, idx, skip); + } + else + retval = to_array ().subsref (type, idx, auto_add); + + return retval; +} + +/* +%!test +%! x(1).a.a = 1; +%! x(2).a.a = 2; +%! assert (size (x), [1, 2]); +%! assert (x(1).a.a, 1); +%! assert (x(2).a.a, 2); +*/ + +octave_value +octave_scalar_struct::numeric_conv (const octave_value& val, + const std::string& type) +{ + octave_value retval; + + if (type.length () > 0 && type[0] == '.' && ! val.is_map ()) + retval = octave_map (); + else + retval = val; + + return retval; +} + +octave_value +octave_scalar_struct::subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + octave_value retval; + + if (idx.front ().empty ()) + { + error ("missing index in indexed assignment"); + return retval; + } + + if (type[0] == '.') + { + int n = type.length (); + + octave_value t_rhs = rhs; + + octave_value_list key_idx = idx.front (); + + assert (key_idx.length () == 1); + + std::string key = key_idx(0).string_value (); + + if (n > 1) + { + std::list next_idx (idx); + + next_idx.erase (next_idx.begin ()); + + std::string next_type = type.substr (1); + + octave_value tmp; + octave_map::iterator pkey = map.seek (key); + if (pkey != map.end ()) + { + map.contents (pkey).make_unique (); + tmp = map.contents (pkey); + } + + if (! error_state) + { + bool orig_undefined = tmp.is_undefined (); + + if (orig_undefined || tmp.is_zero_by_zero ()) + { + tmp = octave_value::empty_conv (next_type, rhs); + tmp.make_unique (); // probably a no-op. + } + else + // optimization: ignore the copy still stored inside our map. + tmp.make_unique (1); + + if (! error_state) + t_rhs = (orig_undefined + ? tmp.undef_subsasgn (next_type, next_idx, rhs) + : tmp.subsasgn (next_type, next_idx, rhs)); + } + } + + if (! error_state) + map.setfield (key, t_rhs.storable_value ()); + else + gripe_failed_assignment (); + + count++; + retval = this; + } + else + { + // Forward this case to octave_struct. + octave_value tmp (new octave_struct (octave_map (map))); + retval = tmp.subsasgn (type, idx, rhs); + } + + return retval; +} + +octave_value +octave_scalar_struct::do_index_op (const octave_value_list& idx, bool resize_ok) +{ + // octave_map handles indexing itself. + return octave_map (map).index (idx, resize_ok); +} + +size_t +octave_scalar_struct::byte_size (void) const +{ + // Neglect the size of the fieldnames. + + size_t retval = 0; + + for (octave_map::const_iterator p = map.begin (); p != map.end (); p++) + { + std::string key = map.key (p); + + octave_value val = octave_value (map.contents (p)); + + retval += val.byte_size (); + } + + return retval; +} + +void +octave_scalar_struct::print (std::ostream& os, bool) const +{ + print_raw (os); +} + +void +octave_scalar_struct::print_raw (std::ostream& os, bool) const +{ + unwind_protect frame; + + frame.protect_var (Vstruct_levels_to_print); + + if (Vstruct_levels_to_print >= 0) + { + bool max_depth_reached = Vstruct_levels_to_print-- == 0; + + bool print_fieldnames_only = max_depth_reached; + + increment_indent_level (); + + if (! Vcompact_format) + newline (os); + + indent (os); + os << "scalar structure containing the fields:"; + newline (os); + if (! Vcompact_format) + newline (os); + + increment_indent_level (); + + string_vector key_list = map.fieldnames (); + + for (octave_idx_type i = 0; i < key_list.length (); i++) + { + std::string key = key_list[i]; + + octave_value val = map.contents (key); + + if (print_fieldnames_only) + { + indent (os); + os << key; + dim_vector dv = val.dims (); + os << ": " << dv.str () << " " << val.type_name (); + newline (os); + } + else + val.print_with_name (os, key); + } + + decrement_indent_level (); + decrement_indent_level (); + } + else + { + indent (os); + os << ""; + newline (os); + } +} + +bool +octave_scalar_struct::print_name_tag (std::ostream& os, const std::string& name) const +{ + bool retval = false; + + indent (os); + + if (Vstruct_levels_to_print < 0) + os << name << " = "; + else + { + os << name << " ="; + newline (os); + retval = true; + } + + return retval; +} + +bool +octave_scalar_struct::save_ascii (std::ostream& os) +{ + octave_map m = map_value (); + + octave_idx_type nf = m.nfields (); + + const dim_vector dv = dims (); + + os << "# ndims: " << dv.length () << "\n"; + + for (int i = 0; i < dv.length (); i++) + os << " " << dv (i); + os << "\n"; + + os << "# length: " << nf << "\n"; + + // Iterating over the list of keys will preserve the order of the + // fields. + string_vector keys = m.fieldnames (); + + for (octave_idx_type i = 0; i < nf; i++) + { + std::string key = keys(i); + + octave_value val = map.contents (key); + + bool b = save_ascii_data (os, val, key, false, 0); + + if (! b) + return os; + } + + return true; +} + +bool +octave_scalar_struct::load_ascii (std::istream& is) +{ + bool success = true; + octave_idx_type len = 0; + + if (extract_keyword (is, "length", len) && len >= 0) + { + if (len > 0) + { + octave_scalar_map m; + + for (octave_idx_type j = 0; j < len; j++) + { + octave_value t2; + bool dummy; + + // recurse to read cell elements + std::string nm + = read_ascii_data (is, std::string (), dummy, t2, j); + + if (!is) + break; + + if (error_state) + { + error ("load: internal error loading struct elements"); + return false; + } + + m.setfield (nm, t2); + } + + if (is) + map = m; + else + { + error ("load: failed to load structure"); + success = false; + } + } + else if (len == 0) + map = octave_scalar_map (); + else + panic_impossible (); + } + else { + error ("load: failed to extract number of elements in structure"); + success = false; + } + + return success; +} + +bool +octave_scalar_struct::save_binary (std::ostream& os, bool& save_as_floats) +{ + octave_map m = map_value (); + + octave_idx_type nf = m.nfields (); + + int32_t len = nf; + os.write (reinterpret_cast (&len), 4); + + // Iterating over the list of keys will preserve the order of the + // fields. + string_vector keys = m.fieldnames (); + + for (octave_idx_type i = 0; i < nf; i++) + { + std::string key = keys(i); + + octave_value val = map.contents (key); + + bool b = save_binary_data (os, val, key, "", 0, save_as_floats); + + if (! b) + return os; + } + + return true; +} + +bool +octave_scalar_struct::load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) +{ + bool success = true; + int32_t len; + if (! is.read (reinterpret_cast (&len), 4)) + return false; + if (swap) + swap_bytes<4> (&len); + + dim_vector dv (1, 1); + + if (len > 0) + { + octave_scalar_map m; + + for (octave_idx_type j = 0; j < len; j++) + { + octave_value t2; + bool dummy; + std::string doc; + + // recurse to read cell elements + std::string nm = read_binary_data (is, swap, fmt, std::string (), + dummy, t2, doc); + + if (!is) + break; + + if (error_state) + { + error ("load: internal error loading struct elements"); + return false; + } + + m.setfield (nm, t2); + } + + if (is) + map = m; + else + { + error ("load: failed to load structure"); + success = false; + } + } + else if (len == 0) + map = octave_scalar_map (); + else + success = false; + + return success; +} + +#if defined (HAVE_HDF5) + +bool +octave_scalar_struct::save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) +{ + hid_t data_hid = -1; + +#if HAVE_HDF5_18 + data_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); +#else + data_hid = H5Gcreate (loc_id, name, 0); +#endif + if (data_hid < 0) return false; + + // recursively add each element of the structure to this group + octave_scalar_map m = scalar_map_value (); + + octave_idx_type nf = m.nfields (); + + // Iterating over the list of keys will preserve the order of the + // fields. + string_vector keys = m.fieldnames (); + + for (octave_idx_type i = 0; i < nf; i++) + { + std::string key = keys(i); + + octave_value val = map.contents (key); + + bool retval2 = add_hdf5_data (data_hid, val, key, "", false, + save_as_floats); + + if (! retval2) + break; + } + + H5Gclose (data_hid); + + return true; +} + +bool +octave_scalar_struct::load_hdf5 (hid_t loc_id, const char *name) +{ + bool retval = false; + + hdf5_callback_data dsub; + + herr_t retval2 = 0; + octave_scalar_map m; + int current_item = 0; + hsize_t num_obj = 0; +#if HAVE_HDF5_18 + hid_t group_id = H5Gopen (loc_id, name, H5P_DEFAULT); +#else + hid_t group_id = H5Gopen (loc_id, name); +#endif + H5Gget_num_objs (group_id, &num_obj); + H5Gclose (group_id); + + // FIXME -- fields appear to be sorted alphabetically on loading. + // Why is that happening? + + while (current_item < static_cast (num_obj) + && (retval2 = H5Giterate (loc_id, name, ¤t_item, + hdf5_read_next_data, &dsub)) > 0) + { + octave_value t2 = dsub.tc; + + if (error_state) + { + error ("load: internal error loading struct elements"); + return false; + } + + m.setfield (dsub.name, t2); + + } + + if (retval2 >= 0) + { + map = m; + retval = true; + } + + return retval; +} + +#endif + +mxArray * +octave_scalar_struct::as_mxArray (void) const +{ + int nf = nfields (); + string_vector kv = map_keys (); + + OCTAVE_LOCAL_BUFFER (const char *, f, nf); + + for (int i = 0; i < nf; i++) + f[i] = kv[i].c_str (); + + mxArray *retval = new mxArray (dims (), nf, f); + + mxArray **elts = static_cast (retval->get_data ()); + + mwSize nel = numel (); + + mwSize ntot = nf * nel; + + for (int i = 0; i < nf; i++) + { + Cell c = map.contents (kv[i]); + + const octave_value *p = c.data (); + + mwIndex k = 0; + for (mwIndex j = i; j < ntot; j += nf) + elts[j] = new mxArray (p[k++]); + } + + return retval; +} + + +octave_value +octave_scalar_struct::to_array (void) +{ + return new octave_struct (octave_map (map)); +} + +bool +octave_scalar_struct::fast_elem_insert_self (void *where, builtin_type_t btyp) const +{ + + if (btyp == btyp_struct) + { + *(reinterpret_cast(where)) = ↦ + return true; + } + else + return false; +} + +DEFUN (struct, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} struct (\"field\", @var{value}, \"field\", @var{value}, @dots{})\n\ +\n\ +Create a structure and initialize its value.\n\ +\n\ +If the values are cell arrays, create a structure array and initialize\n\ +its values. The dimensions of each cell array of values must match.\n\ +Singleton cells and non-cell values are repeated so that they fill\n\ +the entire array. If the cells are empty, create an empty structure\n\ +array with the specified field names.\n\ +\n\ +If the argument is an object, return the underlying struct.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + // struct ([]) returns an empty struct. + + // struct (empty_matrix) returns an empty struct with the same + // dimensions as the empty matrix. + + // Note that struct () creates a 1x1 struct with no fields for + // compatibility with Matlab. + + if (nargin == 1 && args(0).is_map ()) + return args(0); + + if (nargin == 1 && args(0).is_object ()) + { + retval = args(0).map_value (); + + return retval; + } + + if ((nargin == 1 || nargin == 2) + && args(0).is_empty () && args(0).is_real_matrix ()) + { + Cell fields; + + if (nargin == 2) + { + if (args(1).is_cellstr ()) + retval = octave_map (args(0).dims (), args(1).cellstr_value ()); + else + error ("struct: expecting cell array of field names as second argument"); + } + else + retval = octave_map (args(0).dims ()); + + return retval; + } + + // Check for "field", VALUE pairs. + + for (int i = 0; i < nargin; i += 2) + { + if (! args(i).is_string () || i + 1 >= nargin) + { + error ("struct: expecting alternating \"field\", VALUE pairs"); + return retval; + } + } + + // Check that the dimensions of the values correspond. + + dim_vector dims (1, 1); + + int first_dimensioned_value = 0; + + for (int i = 1; i < nargin; i += 2) + { + if (args(i).is_cell ()) + { + dim_vector argdims (args(i).dims ()); + + if (! scalar (argdims)) + { + if (! first_dimensioned_value) + { + dims = argdims; + first_dimensioned_value = i + 1; + } + else if (dims != argdims) + { + error ("struct: dimensions of parameter %d do not match those of parameter %d", + first_dimensioned_value, i+1); + return retval; + } + } + } + } + + // Create the return value. + + octave_map map (dims); + + for (int i = 0; i < nargin; i+= 2) + { + // Get key. + + std::string key (args(i).string_value ()); + + if (error_state) + return retval; + + if (! valid_identifier (key)) + { + error ("struct: invalid structure field name `%s'", key.c_str ()); + return retval; + } + + // Value may be v, { v }, or { v1, v2, ... } + // In the first two cases, we need to create a cell array of + // the appropriate dimensions filled with v. In the last case, + // the cell array has already been determined to be of the + // correct dimensions. + + if (args(i+1).is_cell ()) + { + const Cell c (args(i+1).cell_value ()); + + if (error_state) + return retval; + + if (scalar (c.dims ())) + map.setfield (key, Cell (dims, c(0))); + else + map.setfield (key, c); + } + else + map.setfield (key, Cell (dims, args(i+1))); + + if (error_state) + return retval; + } + + return octave_value (map); +} + +/* +%!shared x +%! x(1).a=1; x(2).a=2; x(1).b=3; x(2).b=3; +%!assert (struct ("a",1, "b",3), x(1)) +%!assert (isempty (x([]))) +%!assert (isempty (struct ("a",{}, "b",{}))) +%!assert (struct ("a",{1,2}, "b",{3,3}), x) +%!assert (struct ("a",{1,2}, "b",3), x) +%!assert (struct ("a",{1,2}, "b",{3}), x) +%!assert (struct ("b",3, "a",{1,2}), x) +%!assert (struct ("b",{3}, "a",{1,2}), x) +%!test x = struct ([]); +%!assert (size (x), [0,0]) +%!assert (isstruct (x)) +%!assert (isempty (fieldnames (x))) +%!fail ('struct ("a",{1,2},"b",{1,2,3})', 'dimensions of parameter 2 do not match those of parameter 4') +%!fail ('struct (1,2,3,4)', 'struct: expecting alternating "field", VALUE pairs') +%!fail ('struct ("1",2,"3")', 'struct: expecting alternating "field", VALUE pairs') +*/ + +DEFUN (isstruct, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isstruct (@var{x})\n\ +Return true if @var{x} is a structure or a structure array.\n\ +@seealso{ismatrix, iscell, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_map (); + else + print_usage (); + + return retval; +} + +DEFUN (fieldnames, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fieldnames (@var{struct})\n\ +Return a cell array of strings naming the elements of the structure\n\ +@var{struct}. It is an error to call @code{fieldnames} with an\n\ +argument that is not a structure.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value arg = args(0); + + if (arg.is_map () || arg.is_object ()) + { + octave_map m = arg.map_value (); + + string_vector keys = m.fieldnames (); + + if (keys.length () == 0) + retval = Cell (0, 1); + else + retval = Cell (keys); + } + else + gripe_wrong_type_arg ("fieldnames", args(0)); + } + else + print_usage (); + + return retval; +} + +/* +## test preservation of fieldname order +%!test +%! x(3).d=1; x(2).a=2; x(1).b=3; x(2).c=3; +%! assert (fieldnames (x), {"d"; "a"; "b"; "c"}); +*/ + +DEFUN (isfield, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isfield (@var{x}, @var{name})\n\ +Return true if the @var{x} is a structure and it\n\ +includes an element named @var{name}. If @var{name} is a cell\n\ +array of strings then a logical array of equal dimension is returned.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + retval = false; + + if (args(0).is_map ()) + { + octave_map m = args(0).map_value (); + + // FIXME -- should this work for all types that can do + // structure reference operations? + + if (args(1).is_string ()) + { + std::string key = args(1).string_value (); + + retval = m.isfield (key); + } + else if (args(1).is_cell ()) + { + Cell c = args(1).cell_value (); + boolNDArray bm (c.dims ()); + octave_idx_type n = bm.numel (); + + for (octave_idx_type i = 0; i < n; i++) + { + if (c(i).is_string ()) + { + std::string key = c(i).string_value (); + + bm(i) = m.isfield (key); + } + else + bm(i) = false; + } + + retval = bm; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (nfields, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} nfields (@var{s})\n\ +Return the number of fields of the structure @var{s}.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 && args(0).is_map ()) + { + retval = static_cast (args(0).nfields ()); + } + else + print_usage (); + + return retval; +} + +/* +## test isfield +%!test +%! x(3).d=1; x(2).a=2; x(1).b=3; x(2).c=3; +%! assert (isfield (x, "b")); +%!assert (isfield (struct ("a", "1"), "a")) +%!assert (isfield ({1}, "c"), false) +%!assert (isfield (struct ("a", "1"), 10), false) +%!assert (isfield (struct ("a", "b"), "a "), false) +%!assert (isfield (struct ("a", 1, "b", 2), {"a", "c"}), [true, false]) +*/ + +DEFUN (cell2struct, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cell2struct (@var{cell}, @var{fields}, @var{dim})\n\ +Convert @var{cell} to a structure. The number of fields in @var{fields}\n\ +must match the number of elements in @var{cell} along dimension @var{dim},\n\ +that is @code{numel (@var{fields}) == size (@var{cell}, @var{dim})}.\n\ +If @var{dim} is omitted, a value of 1 is assumed.\n\ +\n\ +@example\n\ +@group\n\ +A = cell2struct (@{\"Peter\", \"Hannah\", \"Robert\";\n\ + 185, 170, 168@},\n\ + @{\"Name\",\"Height\"@}, 1);\n\ +A(1)\n\ + @result{}\n\ + @{\n\ + Name = Peter\n\ + Height = 185\n\ + @}\n\ +\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + if (! args(0).is_cell ()) + { + error ("cell2struct: argument CELL must be of type cell"); + return retval; + } + + if (! (args(1).is_cellstr () || args(1).is_char_matrix ())) + { + error ("cell2struct: FIELDS must be a cell array of strings or a character matrix"); + return retval; + } + + const Cell vals = args(0).cell_value (); + const Array fields = args(1).cellstr_value (); + + octave_idx_type ext = 0; + + int dim = 0; + + if (nargin == 3) + { + if (args(2).is_real_scalar ()) + { + dim = nargin == 2 ? 0 : args(2).int_value () - 1; + + if (error_state) + return retval; + } + else + { + error ("cell2struct: DIM must be a real scalar"); + return retval; + } + } + + if (dim < 0) + { + error ("cell2struct: DIM must be a valid dimension"); + return retval; + } + + ext = vals.ndims () > dim ? vals.dims ()(dim) : 1; + + if (ext != fields.numel ()) + { + error ("cell2struct: number of FIELDS does not match dimension"); + return retval; + } + + int nd = std::max (dim+1, vals.ndims ()); + // result dimensions. + dim_vector rdv = vals.dims ().redim (nd); + + assert (ext == rdv(dim)); + if (nd == 2) + { + rdv(0) = rdv(1-dim); + rdv(1) = 1; + } + else + { + for (int i = dim + 1; i < nd; i++) + rdv(i-1) = rdv(i); + + rdv.resize (nd-1); + } + + octave_map map (rdv); + Array ia (dim_vector (nd, 1), idx_vector::colon); + + for (octave_idx_type i = 0; i < ext; i++) + { + ia(dim) = i; + map.setfield (fields(i), vals.index (ia).reshape (rdv)); + } + + retval = map; + } + else + print_usage (); + + return retval; +} + +/* +## test cell2struct versus struct2cell +%!test +%! keys = cellstr (char (floor (rand (100,10)*24+65)))'; +%! vals = mat2cell (rand (100,1), ones (100,1), 1)'; +%! s = struct ([keys; vals]{:}); +%! t = cell2struct (vals, keys, 2); +%! assert (s, t); +%! assert (struct2cell (s), vals'); +%! assert (fieldnames (s), keys'); + +%!assert (cell2struct ({1; 2}, {"a"; "b"}), struct ("a", 1, "b", 2)); + +%!assert (cell2struct ({}, {"f"}, 3), struct ("f", {})); +*/ + + +// So we can call Fcellstr directly. +extern octave_value_list Fcellstr (const octave_value_list& args, int); + +DEFUN (rmfield, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rmfield (@var{s}, @var{f})\n\ +Return a copy of the structure (array) @var{s} with the field @var{f}\n\ +removed. If @var{f} is a cell array of strings or a character array, remove\n\ +the named fields.\n\ +@seealso{cellstr, iscellstr, setfield}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + octave_map m = args(0).map_value (); + + octave_value_list fval = Fcellstr (args(1), 1); + + if (! error_state) + { + Cell fcell = fval(0).cell_value (); + + for (int i = 0; i < fcell.numel (); i++) + { + std::string key = fcell(i).string_value (); + + if (m.isfield (key)) + m.rmfield (key); + else + { + error ("rmfield: structure does not contain field %s", + key.c_str ()); + + break; + } + } + + if (! error_state) + retval = m; + } + } + else + print_usage (); + + return retval; +} + +/* +## test rmfield +%!test +%! x(3).d=1; x(2).a=2; x(1).b=3; x(2).c=3; x(6).f="abc123"; +%! y = rmfield (x, {"a", "f"}); +%! assert (fieldnames (y), {"d"; "b"; "c"}); +%! assert (size (y), [1, 6]); +*/ + +DEFUN (struct_levels_to_print, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} struct_levels_to_print ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} struct_levels_to_print (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} struct_levels_to_print (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the number of\n\ +structure levels to display.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE_WITH_LIMITS (struct_levels_to_print, + -1, INT_MAX); +} + +DEFUN (print_struct_array_contents, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} print_struct_array_contents ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} print_struct_array_contents (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} print_struct_array_contents (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies whether to print struct\n\ +array contents. If true, values of struct array elements are printed.\n\ +This variable does not affect scalar structures. Their elements\n\ +are always printed. In both cases, however, printing will be limited to\n\ +the number of levels specified by @var{struct_levels_to_print}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (print_struct_array_contents); +} diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-struct.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-struct.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,289 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_struct_h) +#define octave_struct_h 1 + +#include + +#include +#include + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-alloc.h" +#include "oct-map.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class octave_value_list; + +class tree_walker; + +// Data structures. + +class +octave_struct : public octave_base_value +{ +public: + + octave_struct (void) + : octave_base_value (), map () { } + + octave_struct (const octave_map& m) + : octave_base_value (), map (m) { } + + octave_struct (const octave_struct& s) + : octave_base_value (), map (s.map) { } + + ~octave_struct (void) { } + + octave_base_value *clone (void) const { return new octave_struct (*this); } + octave_base_value *empty_clone (void) const { return new octave_struct (); } + + octave_base_value *try_narrowing_conversion (void); + + Cell dotref (const octave_value_list& idx, bool auto_add = false); + + octave_value subsref (const std::string& type, + const std::list& idx) + { + octave_value_list tmp = subsref (type, idx, 1); + return tmp.length () > 0 ? tmp(0) : octave_value (); + } + + octave_value_list subsref (const std::string&, + const std::list&, int); + + octave_value subsref (const std::string& type, + const std::list& idx, + bool auto_add); + + static octave_value numeric_conv (const octave_value& val, + const std::string& type); + + octave_value subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + octave_value squeeze (void) const { return map.squeeze (); } + + octave_value permute (const Array& vec, bool inv = false) const + { return map.permute (vec, inv); } + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + dim_vector dims (void) const { return map.dims (); } + + size_t byte_size (void) const; + + // This is the number of elements in each field. The total number + // of elements is numel () * nfields (). + octave_idx_type numel (void) const + { + return map.numel (); + } + + octave_idx_type nfields (void) const { return map.nfields (); } + + octave_value reshape (const dim_vector& new_dims) const + { return map.reshape (new_dims); } + + octave_value resize (const dim_vector& dv, bool fill = false) const + { octave_map tmap = map; tmap.resize (dv, fill); return tmap; } + + bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + + bool is_map (void) const { return true; } + + builtin_type_t builtin_type (void) const { return btyp_struct; } + + octave_map map_value (void) const { return map; } + + string_vector map_keys (void) const { return map.fieldnames (); } + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool print_name_tag (std::ostream& os, const std::string& name) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + mxArray *as_mxArray (void) const; + + octave_value + fast_elem_extract (octave_idx_type n) const; + + bool + fast_elem_insert (octave_idx_type n, const octave_value& x); + +protected: + + // The associative array used to manage the structure data. + octave_map map; + +private: + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +class +octave_scalar_struct : public octave_base_value +{ +public: + + octave_scalar_struct (void) + : octave_base_value (), map () { } + + octave_scalar_struct (const octave_scalar_map& m) + : octave_base_value (), map (m) { } + + octave_scalar_struct (const octave_scalar_struct& s) + : octave_base_value (), map (s.map) { } + + ~octave_scalar_struct (void) { } + + octave_base_value *clone (void) const { return new octave_scalar_struct (*this); } + octave_base_value *empty_clone (void) const { return new octave_scalar_struct (); } + + octave_value dotref (const octave_value_list& idx, bool auto_add = false); + + octave_value subsref (const std::string& type, + const std::list& idx); + + octave_value_list subsref (const std::string& type, + const std::list& idx, int); + + + octave_value subsref (const std::string& type, + const std::list& idx, + bool auto_add); + + static octave_value numeric_conv (const octave_value& val, + const std::string& type); + + octave_value subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + octave_value squeeze (void) const { return map; } + + octave_value permute (const Array& vec, bool inv = false) const + { return octave_map (map).permute (vec, inv); } + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false); + + dim_vector dims (void) const { static dim_vector dv (1, 1); return dv; } + + size_t byte_size (void) const; + + // This is the number of elements in each field. The total number + // of elements is numel () * nfields (). + octave_idx_type numel (void) const + { + return 1; + } + + octave_idx_type nfields (void) const { return map.nfields (); } + + octave_value reshape (const dim_vector& new_dims) const + { return octave_map (map).reshape (new_dims); } + + octave_value resize (const dim_vector& dv, bool fill = false) const + { octave_map tmap = map; tmap.resize (dv, fill); return tmap; } + + bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + + bool is_map (void) const { return true; } + + builtin_type_t builtin_type (void) const { return btyp_struct; } + + octave_map map_value (void) const { return map; } + + octave_scalar_map scalar_map_value (void) const { return map; } + + string_vector map_keys (void) const { return map.fieldnames (); } + + void print (std::ostream& os, bool pr_as_read_syntax = false) const; + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; + + bool print_name_tag (std::ostream& os, const std::string& name) const; + + bool save_ascii (std::ostream& os); + + bool load_ascii (std::istream& is); + + bool save_binary (std::ostream& os, bool& save_as_floats); + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt); + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); + + bool load_hdf5 (hid_t loc_id, const char *name); +#endif + + mxArray *as_mxArray (void) const; + + bool fast_elem_insert_self (void *where, builtin_type_t btyp) const; + +protected: + + // The associative array used to manage the structure data. + octave_scalar_map map; + +private: + + octave_value to_array (void); + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-type-conv.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-type-conv.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,109 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_ov_type_conv_h) +#define octave_ov_type_conv_h 1 + +static +octave_value +octave_type_conv_body (const octave_value &arg, const std::string& name, int t_result) +{ + int t_arg = arg.type_id (); + octave_value retval; + + if (t_arg == t_result || arg.class_name () == name) + { + retval = arg; + } + else + { + octave_base_value::type_conv_fcn cf1 + = octave_value_typeinfo::lookup_type_conv_op (t_arg, t_result); + + if (cf1) + { + octave_base_value *tmp (cf1 (*(arg.internal_rep ()))); + + if (tmp) + { + retval = octave_value (tmp); + + retval.maybe_mutate (); + } + } + else + { + octave_base_value::type_conv_fcn cf2 + = arg.numeric_conversion_function (); + + if (cf2) + { + octave_base_value *tmp (cf2 (*(arg.internal_rep ()))); + + if (tmp) + { + octave_value xarg (tmp); + + retval = octave_type_conv_body (xarg, name, t_result); + } + } + } + } + + return retval; +} + + +#define OCTAVE_TYPE_CONV_BODY3(NAME, MATRIX_RESULT_T, SCALAR_RESULT_T) \ + \ + octave_value retval; \ + \ + int nargin = args.length (); \ + \ + if (nargin == 1) \ + { \ + const octave_value arg = args(0); \ + \ + int t_result = MATRIX_RESULT_T::static_type_id (); \ + \ + retval = octave_type_conv_body (arg, #NAME, t_result); \ + if (retval.is_undefined ()) \ + { \ + std::string arg_tname = arg.type_name (); \ + \ + std::string result_tname = arg.numel () == 1 \ + ? SCALAR_RESULT_T::static_type_name () \ + : MATRIX_RESULT_T::static_type_name (); \ + \ + gripe_invalid_conversion (arg_tname, result_tname); \ + } \ + } \ + else \ + print_usage (); \ + \ + return retval + +#define OCTAVE_TYPE_CONV_BODY(NAME) \ + OCTAVE_TYPE_CONV_BODY3 (NAME, octave_ ## NAME ## _matrix, \ + octave_ ## NAME ## _scalar) + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-typeinfo.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-typeinfo.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,707 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "Array.h" +#include "singleton-cleanup.h" + +#include "defun.h" +#include "error.h" +#include "ov-typeinfo.h" + +const int +octave_value_typeinfo::init_tab_sz (16); + +octave_value_typeinfo * +octave_value_typeinfo::instance (0); + +bool +octave_value_typeinfo::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_value_typeinfo (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create value type info object!"); + + retval = false; + } + + return retval; +} + +int +octave_value_typeinfo::register_type (const std::string& t_name, + const std::string& c_name, + const octave_value& val) +{ + return (instance_ok ()) + ? instance->do_register_type (t_name, c_name, val) : -1; +} + +bool +octave_value_typeinfo::register_unary_class_op (octave_value::unary_op op, + octave_value_typeinfo::unary_class_op_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_unary_class_op (op, f) : false; +} + +bool +octave_value_typeinfo::register_unary_op (octave_value::unary_op op, + int t, octave_value_typeinfo::unary_op_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_unary_op (op, t, f) : false; +} + +bool +octave_value_typeinfo::register_non_const_unary_op (octave_value::unary_op op, + int t, + octave_value_typeinfo::non_const_unary_op_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_non_const_unary_op (op, t, f) : false; +} + +bool +octave_value_typeinfo::register_binary_class_op (octave_value::binary_op op, + octave_value_typeinfo::binary_class_op_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_binary_class_op (op, f) : false; +} + +bool +octave_value_typeinfo::register_binary_op (octave_value::binary_op op, + int t1, int t2, + octave_value_typeinfo::binary_op_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_binary_op (op, t1, t2, f) : false; +} + +bool +octave_value_typeinfo::register_binary_class_op (octave_value::compound_binary_op op, + octave_value_typeinfo::binary_class_op_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_binary_class_op (op, f) : false; +} + +bool +octave_value_typeinfo::register_binary_op (octave_value::compound_binary_op op, + int t1, int t2, + octave_value_typeinfo::binary_op_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_binary_op (op, t1, t2, f) : false; +} + +bool +octave_value_typeinfo::register_cat_op (int t1, int t2, octave_value_typeinfo::cat_op_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_cat_op (t1, t2, f) : false; +} + +bool +octave_value_typeinfo::register_assign_op (octave_value::assign_op op, + int t_lhs, int t_rhs, + octave_value_typeinfo::assign_op_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_assign_op (op, t_lhs, t_rhs, f) : -1; +} + +bool +octave_value_typeinfo::register_assignany_op (octave_value::assign_op op, + int t_lhs, octave_value_typeinfo::assignany_op_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_assignany_op (op, t_lhs, f) : -1; +} + +bool +octave_value_typeinfo::register_pref_assign_conv (int t_lhs, int t_rhs, + int t_result) +{ + return (instance_ok ()) + ? instance->do_register_pref_assign_conv (t_lhs, t_rhs, t_result) : false; +} + +bool +octave_value_typeinfo::register_type_conv_op (int t, int t_result, + octave_base_value::type_conv_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_type_conv_op (t, t_result, f) : false; +} + +bool +octave_value_typeinfo::register_widening_op (int t, int t_result, + octave_base_value::type_conv_fcn f) +{ + return (instance_ok ()) + ? instance->do_register_widening_op (t, t_result, f) : false; +} + +// FIXME -- we should also store all class names and provide a +// way to list them (calling class with nargin == 0?). + +int +octave_value_typeinfo::do_register_type (const std::string& t_name, + const std::string& /* c_name */, + const octave_value& val) +{ + int i = 0; + + for (i = 0; i < num_types; i++) + if (t_name == types (i)) + return i; + + int len = types.length (); + + if (i == len) + { + len *= 2; + + types.resize (dim_vector (len, 1), std::string ()); + + vals.resize (dim_vector (len, 1), octave_value ()); + + unary_ops.resize (dim_vector (octave_value::num_unary_ops, len), 0); + + non_const_unary_ops.resize + (dim_vector (octave_value::num_unary_ops, len), 0); + + binary_ops.resize + (dim_vector (octave_value::num_binary_ops, len, len), 0); + + compound_binary_ops.resize + (dim_vector (octave_value::num_compound_binary_ops, len, len), 0); + + cat_ops.resize (dim_vector (len, len), 0); + + assign_ops.resize + (dim_vector (octave_value::num_assign_ops, len, len), 0); + + assignany_ops.resize + (dim_vector (octave_value::num_assign_ops, len), 0); + + pref_assign_conv.resize (dim_vector (len, len), -1); + + type_conv_ops.resize (dim_vector (len, len), 0); + + widening_ops.resize (dim_vector (len, len), 0); + } + + types (i) = t_name; + + vals (i) = val; + + num_types++; + + return i; +} + +bool +octave_value_typeinfo::do_register_unary_class_op (octave_value::unary_op op, + octave_value_typeinfo::unary_class_op_fcn f) +{ + if (lookup_unary_class_op (op)) + { + std::string op_name = octave_value::unary_op_as_string (op); + + warning ("duplicate unary operator `%s' for class dispatch", + op_name.c_str ()); + } + + unary_class_ops.checkelem (static_cast (op)) = reinterpret_cast (f); + + return false; +} + +bool +octave_value_typeinfo::do_register_unary_op (octave_value::unary_op op, + int t, octave_value_typeinfo::unary_op_fcn f) +{ + if (lookup_unary_op (op, t)) + { + std::string op_name = octave_value::unary_op_as_string (op); + std::string type_name = types(t); + + warning ("duplicate unary operator `%s' for type `%s'", + op_name.c_str (), type_name.c_str ()); + } + + unary_ops.checkelem (static_cast (op), t) = reinterpret_cast (f); + + return false; +} + +bool +octave_value_typeinfo::do_register_non_const_unary_op + (octave_value::unary_op op, int t, octave_value_typeinfo::non_const_unary_op_fcn f) +{ + if (lookup_non_const_unary_op (op, t)) + { + std::string op_name = octave_value::unary_op_as_string (op); + std::string type_name = types(t); + + warning ("duplicate unary operator `%s' for type `%s'", + op_name.c_str (), type_name.c_str ()); + } + + non_const_unary_ops.checkelem (static_cast (op), t) = reinterpret_cast (f); + + return false; +} + +bool +octave_value_typeinfo::do_register_binary_class_op (octave_value::binary_op op, + octave_value_typeinfo::binary_class_op_fcn f) +{ + if (lookup_binary_class_op (op)) + { + std::string op_name = octave_value::binary_op_as_string (op); + + warning ("duplicate binary operator `%s' for class dispatch", + op_name.c_str ()); + } + + binary_class_ops.checkelem (static_cast (op)) = reinterpret_cast (f); + + return false; +} + +bool +octave_value_typeinfo::do_register_binary_op (octave_value::binary_op op, + int t1, int t2, + octave_value_typeinfo::binary_op_fcn f) +{ + if (lookup_binary_op (op, t1, t2)) + { + std::string op_name = octave_value::binary_op_as_string (op); + std::string t1_name = types(t1); + std::string t2_name = types(t2); + + warning ("duplicate binary operator `%s' for types `%s' and `%s'", + op_name.c_str (), t1_name.c_str (), t1_name.c_str ()); + } + + binary_ops.checkelem (static_cast (op), t1, t2) = reinterpret_cast (f); + + return false; +} + +bool +octave_value_typeinfo::do_register_binary_class_op (octave_value::compound_binary_op op, + octave_value_typeinfo::binary_class_op_fcn f) +{ + if (lookup_binary_class_op (op)) + { + std::string op_name = octave_value::binary_op_fcn_name (op); + + warning ("duplicate compound binary operator `%s' for class dispatch", + op_name.c_str ()); + } + + compound_binary_class_ops.checkelem (static_cast (op)) = reinterpret_cast (f); + + return false; +} + +bool +octave_value_typeinfo::do_register_binary_op (octave_value::compound_binary_op op, + int t1, int t2, + octave_value_typeinfo::binary_op_fcn f) +{ + if (lookup_binary_op (op, t1, t2)) + { + std::string op_name = octave_value::binary_op_fcn_name (op); + std::string t1_name = types(t1); + std::string t2_name = types(t2); + + warning ("duplicate compound binary operator `%s' for types `%s' and `%s'", + op_name.c_str (), t1_name.c_str (), t1_name.c_str ()); + } + + compound_binary_ops.checkelem (static_cast (op), t1, t2) = reinterpret_cast (f); + + return false; +} + +bool +octave_value_typeinfo::do_register_cat_op (int t1, int t2, octave_value_typeinfo::cat_op_fcn f) +{ + if (lookup_cat_op (t1, t2)) + { + std::string t1_name = types(t1); + std::string t2_name = types(t2); + + warning ("duplicate concatenation operator for types `%s' and `%s'", + t1_name.c_str (), t1_name.c_str ()); + } + + cat_ops.checkelem (t1, t2) = reinterpret_cast (f); + + return false; +} + +bool +octave_value_typeinfo::do_register_assign_op (octave_value::assign_op op, + int t_lhs, int t_rhs, + octave_value_typeinfo::assign_op_fcn f) +{ + if (lookup_assign_op (op, t_lhs, t_rhs)) + { + std::string op_name = octave_value::assign_op_as_string (op); + std::string t_lhs_name = types(t_lhs); + std::string t_rhs_name = types(t_rhs); + + warning ("duplicate assignment operator `%s' for types `%s' and `%s'", + op_name.c_str (), t_lhs_name.c_str (), t_rhs_name.c_str ()); + } + + assign_ops.checkelem (static_cast (op), t_lhs, t_rhs) = reinterpret_cast (f); + + return false; +} + +bool +octave_value_typeinfo::do_register_assignany_op (octave_value::assign_op op, + int t_lhs, octave_value_typeinfo::assignany_op_fcn f) +{ + if (lookup_assignany_op (op, t_lhs)) + { + std::string op_name = octave_value::assign_op_as_string (op); + std::string t_lhs_name = types(t_lhs); + + warning ("duplicate assignment operator `%s' for types `%s'", + op_name.c_str (), t_lhs_name.c_str ()); + } + + assignany_ops.checkelem (static_cast (op), t_lhs) = reinterpret_cast (f); + + return false; +} + +bool +octave_value_typeinfo::do_register_pref_assign_conv (int t_lhs, int t_rhs, + int t_result) +{ + if (lookup_pref_assign_conv (t_lhs, t_rhs) >= 0) + { + std::string t_lhs_name = types(t_lhs); + std::string t_rhs_name = types(t_rhs); + + warning ("overriding assignment conversion for types `%s' and `%s'", + t_lhs_name.c_str (), t_rhs_name.c_str ()); + } + + pref_assign_conv.checkelem (t_lhs, t_rhs) = t_result; + + return false; +} + +bool +octave_value_typeinfo::do_register_type_conv_op + (int t, int t_result, octave_base_value::type_conv_fcn f) +{ + if (lookup_type_conv_op (t, t_result)) + { + std::string t_name = types(t); + std::string t_result_name = types(t_result); + + warning ("overriding type conversion op for `%s' to `%s'", + t_name.c_str (), t_result_name.c_str ()); + } + + type_conv_ops.checkelem (t, t_result) = reinterpret_cast (f); + + return false; +} + +bool +octave_value_typeinfo::do_register_widening_op + (int t, int t_result, octave_base_value::type_conv_fcn f) +{ + if (lookup_widening_op (t, t_result)) + { + std::string t_name = types(t); + std::string t_result_name = types(t_result); + + warning ("overriding widening op for `%s' to `%s'", + t_name.c_str (), t_result_name.c_str ()); + } + + widening_ops.checkelem (t, t_result) = reinterpret_cast (f); + + return false; +} + +octave_value +octave_value_typeinfo::do_lookup_type (const std::string& nm) +{ + octave_value retval; + + for (int i = 0; i < num_types; i++) + { + if (nm == types(i)) + { + retval = vals(i); + retval.make_unique (); + break; + } + } + + return retval; +} + +octave_value_typeinfo::unary_class_op_fcn +octave_value_typeinfo::do_lookup_unary_class_op (octave_value::unary_op op) +{ + void *f = unary_class_ops.checkelem (static_cast (op)); + return reinterpret_cast (f); +} + +octave_value_typeinfo::unary_op_fcn +octave_value_typeinfo::do_lookup_unary_op (octave_value::unary_op op, int t) +{ + void *f = unary_ops.checkelem (static_cast (op), t); + return reinterpret_cast (f); +} + +octave_value_typeinfo::non_const_unary_op_fcn +octave_value_typeinfo::do_lookup_non_const_unary_op + (octave_value::unary_op op, int t) +{ + void *f = non_const_unary_ops.checkelem (static_cast (op), t); + return reinterpret_cast (f); +} + +octave_value_typeinfo::binary_class_op_fcn +octave_value_typeinfo::do_lookup_binary_class_op (octave_value::binary_op op) +{ + void *f = binary_class_ops.checkelem (static_cast (op)); + return reinterpret_cast (f); +} + +octave_value_typeinfo::binary_op_fcn +octave_value_typeinfo::do_lookup_binary_op (octave_value::binary_op op, + int t1, int t2) +{ + void *f = binary_ops.checkelem (static_cast (op), t1, t2); + return reinterpret_cast (f); +} + +octave_value_typeinfo::binary_class_op_fcn +octave_value_typeinfo::do_lookup_binary_class_op (octave_value::compound_binary_op op) +{ + void *f = compound_binary_class_ops.checkelem (static_cast (op)); + return reinterpret_cast (f); +} + +octave_value_typeinfo::binary_op_fcn +octave_value_typeinfo::do_lookup_binary_op (octave_value::compound_binary_op op, + int t1, int t2) +{ + void *f = compound_binary_ops.checkelem (static_cast (op), t1, t2); + return reinterpret_cast (f); +} + +octave_value_typeinfo::cat_op_fcn +octave_value_typeinfo::do_lookup_cat_op (int t1, int t2) +{ + void *f = cat_ops.checkelem (t1, t2); + return reinterpret_cast (f); +} + +octave_value_typeinfo::assign_op_fcn +octave_value_typeinfo::do_lookup_assign_op (octave_value::assign_op op, + int t_lhs, int t_rhs) +{ + void *f = assign_ops.checkelem (static_cast (op), t_lhs, t_rhs); + return reinterpret_cast (f); +} + +octave_value_typeinfo::assignany_op_fcn +octave_value_typeinfo::do_lookup_assignany_op (octave_value::assign_op op, + int t_lhs) +{ + void *f = assignany_ops.checkelem (static_cast (op), t_lhs); + return reinterpret_cast (f); +} + +int +octave_value_typeinfo::do_lookup_pref_assign_conv (int t_lhs, int t_rhs) +{ + return pref_assign_conv.checkelem (t_lhs, t_rhs); +} + +octave_base_value::type_conv_fcn +octave_value_typeinfo::do_lookup_type_conv_op (int t, int t_result) +{ + void *f = type_conv_ops.checkelem (t, t_result); + return reinterpret_cast (f); +} + +octave_base_value::type_conv_fcn +octave_value_typeinfo::do_lookup_widening_op (int t, int t_result) +{ + void *f = widening_ops.checkelem (t, t_result); + return reinterpret_cast (f); +} + +string_vector +octave_value_typeinfo::do_installed_type_names (void) +{ + string_vector retval (num_types); + + for (int i = 0; i < num_types; i++) + retval(i) = types(i); + + return retval; +} + +DEFUN (typeinfo, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} typeinfo ()\n\ +@deftypefnx {Built-in Function} {} typeinfo (@var{expr})\n\ +\n\ +Return the type of the expression @var{expr}, as a string. If\n\ +@var{expr} is omitted, return an cell array of strings containing all the\n\ +currently installed data types.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = Cell (octave_value_typeinfo::installed_type_names ()); + else if (nargin == 1) + retval = args(0).type_name (); + else + print_usage (); + + return retval; +} + +/* +%!assert (iscellstr (typeinfo ())) + +%!assert (typeinfo ({"cell"}), "cell") + +%!assert (typeinfo (1), "scalar") +%!assert (typeinfo (double (1)), "scalar") +%!assert (typeinfo (i), "complex scalar") + +%!assert (typeinfo ([1, 2]), "matrix") +%!assert (typeinfo (double ([1, 2])), "matrix") +%!assert (typeinfo (diag ([1, 2])), "diagonal matrix") +%!assert (typeinfo ([i, 2]), "complex matrix") +%!assert (typeinfo (diag ([i, 2])), "complex diagonal matrix") + +%!assert (typeinfo (1:2), "range") + +%!assert (typeinfo (false), "bool") +%!assert (typeinfo ([true, false]), "bool matrix") + +%!assert (typeinfo ("string"), "string") +%!assert (typeinfo ('string'), "sq_string") + +%!assert (typeinfo (int8 (1)), "int8 scalar") +%!assert (typeinfo (int16 (1)), "int16 scalar") +%!assert (typeinfo (int32 (1)), "int32 scalar") +%!assert (typeinfo (int64 (1)), "int64 scalar") +%!assert (typeinfo (uint8 (1)), "uint8 scalar") +%!assert (typeinfo (uint16 (1)), "uint16 scalar") +%!assert (typeinfo (uint32 (1)), "uint32 scalar") +%!assert (typeinfo (uint64 (1)), "uint64 scalar") + +%!assert (typeinfo (int8 ([1,2])), "int8 matrix") +%!assert (typeinfo (int16 ([1,2])), "int16 matrix") +%!assert (typeinfo (int32 ([1,2])), "int32 matrix") +%!assert (typeinfo (int64 ([1,2])), "int64 matrix") +%!assert (typeinfo (uint8 ([1,2])), "uint8 matrix") +%!assert (typeinfo (uint16 ([1,2])), "uint16 matrix") +%!assert (typeinfo (uint32 ([1,2])), "uint32 matrix") +%!assert (typeinfo (uint64 ([1,2])), "uint64 matrix") + +%!assert (typeinfo (sparse ([true, false])), "sparse bool matrix") +%!assert (typeinfo (logical (sparse (i * eye (10)))), "sparse bool matrix") +%!assert (typeinfo (sparse ([1,2])), "sparse matrix") +%!assert (typeinfo (sparse (eye (10))), "sparse matrix") +%!assert (typeinfo (sparse ([i,2])), "sparse complex matrix") +%!assert (typeinfo (sparse (i * eye (10))), "sparse complex matrix") + +%!test +%! s(2).a = 1; +%! assert (typeinfo (s), "struct"); + +%!test +%! s.a = 1; +%! assert (typeinfo (s), "scalar struct"); + +## FIXME: This doesn't work as a test for comma-separated list +%!#test +%! clist = {1, 2, 3}; +%! assert (typeinfo (clist{:}), "cs-list"); + +%!assert (typeinfo (@sin), "function handle") +%!assert (typeinfo (@(x) x), "function handle") + +%!assert (typeinfo (inline ("x^2")), "inline function") + +%!assert (typeinfo (single (1)), "float scalar") +%!assert (typeinfo (single (i)), "float complex scalar") +%!assert (typeinfo (single ([1, 2])), "float matrix") + +%!assert (typeinfo (single (diag ([1, 2]))), "float diagonal matrix") +%!assert (typeinfo (diag (single ([1, 2]))), "float diagonal matrix") +%!assert (typeinfo (single (diag ([i, 2]))), "float complex diagonal matrix") +%!assert (typeinfo (diag (single ([i, 2]))), "float complex diagonal matrix") + +%!assert (typeinfo (eye(3)(:,[1 3 2])), "permutation matrix") +%!test +%! [l, u, p] = lu (rand (3)); +%! assert (typeinfo (p), "permutation matrix"); + +%!assert (typeinfo ([]), "null_matrix") +%!assert (typeinfo (""), "null_string") +%!assert (typeinfo (''), "null_sq_string") + +%!error typeinfo ("foo", 1) +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-typeinfo.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-typeinfo.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,327 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_value_typeinfo_h) +#define octave_value_typeinfo_h 1 + +#include + +#include "Array.h" + +#include "ov.h" + +class string_vector; + +class +OCTINTERP_API +octave_value_typeinfo +{ +public: + + typedef octave_value (*unary_class_op_fcn) (const octave_value&); + + typedef octave_value (*unary_op_fcn) (const octave_base_value&); + + typedef void (*non_const_unary_op_fcn) (octave_base_value&); + + typedef octave_value (*binary_class_op_fcn) + (const octave_value&, const octave_value&); + + typedef octave_value (*binary_op_fcn) + (const octave_base_value&, const octave_base_value&); + + typedef octave_value (*cat_op_fcn) + (octave_base_value&, const octave_base_value&, + const Array& ra_idx); + + typedef octave_value (*assign_op_fcn) + (octave_base_value&, const octave_value_list&, const octave_base_value&); + + typedef octave_value (*assignany_op_fcn) + (octave_base_value&, const octave_value_list&, const octave_value&); + + static bool instance_ok (void); + + static int register_type (const std::string&, const std::string&, + const octave_value&); + + static bool register_unary_class_op (octave_value::unary_op, + unary_class_op_fcn); + + static bool register_unary_op (octave_value::unary_op, int, unary_op_fcn); + + static bool register_non_const_unary_op (octave_value::unary_op, int, + non_const_unary_op_fcn); + + static bool register_binary_class_op (octave_value::binary_op, + binary_class_op_fcn); + + static bool register_binary_op (octave_value::binary_op, int, int, + binary_op_fcn); + + static bool register_binary_class_op (octave_value::compound_binary_op, + binary_class_op_fcn); + + static bool register_binary_op (octave_value::compound_binary_op, int, int, + binary_op_fcn); + + static bool register_cat_op (int, int, cat_op_fcn); + + static bool register_assign_op (octave_value::assign_op, int, int, + assign_op_fcn); + + static bool register_assignany_op (octave_value::assign_op, int, + assignany_op_fcn); + + static bool register_pref_assign_conv (int, int, int); + + static bool + register_type_conv_op (int, int, octave_base_value::type_conv_fcn); + + static bool + register_widening_op (int, int, octave_base_value::type_conv_fcn); + + static octave_value + lookup_type (const std::string& nm) + { + return instance->do_lookup_type (nm); + } + + static unary_class_op_fcn + lookup_unary_class_op (octave_value::unary_op op) + { + return instance->do_lookup_unary_class_op (op); + } + + static unary_op_fcn + lookup_unary_op (octave_value::unary_op op, int t) + { + return instance->do_lookup_unary_op (op, t); + } + + static non_const_unary_op_fcn + lookup_non_const_unary_op (octave_value::unary_op op, int t) + { + return instance->do_lookup_non_const_unary_op (op, t); + } + + static binary_class_op_fcn + lookup_binary_class_op (octave_value::binary_op op) + { + return instance->do_lookup_binary_class_op (op); + } + + static binary_op_fcn + lookup_binary_op (octave_value::binary_op op, int t1, int t2) + { + return instance->do_lookup_binary_op (op, t1, t2); + } + + static binary_class_op_fcn + lookup_binary_class_op (octave_value::compound_binary_op op) + { + return instance->do_lookup_binary_class_op (op); + } + + static binary_op_fcn + lookup_binary_op (octave_value::compound_binary_op op, int t1, int t2) + { + return instance->do_lookup_binary_op (op, t1, t2); + } + + static cat_op_fcn + lookup_cat_op (int t1, int t2) + { + return instance->do_lookup_cat_op (t1, t2); + } + + static assign_op_fcn + lookup_assign_op (octave_value::assign_op op, int t_lhs, int t_rhs) + { + return instance->do_lookup_assign_op (op, t_lhs, t_rhs); + } + + static assignany_op_fcn + lookup_assignany_op (octave_value::assign_op op, int t_lhs) + { + return instance->do_lookup_assignany_op (op, t_lhs); + } + + static int + lookup_pref_assign_conv (int t_lhs, int t_rhs) + { + return instance->do_lookup_pref_assign_conv (t_lhs, t_rhs); + } + + static octave_base_value::type_conv_fcn + lookup_type_conv_op (int t, int t_result) + { + return instance->do_lookup_type_conv_op (t, t_result); + } + + static octave_base_value::type_conv_fcn + lookup_widening_op (int t, int t_result) + { + return instance->do_lookup_widening_op (t, t_result); + } + + static string_vector installed_type_names (void) + { + return instance->do_installed_type_names (); + } + +protected: + + octave_value_typeinfo (void) + : num_types (0), types (dim_vector (init_tab_sz, 1), std::string ()), + vals (dim_vector (init_tab_sz, 1)), + unary_class_ops (dim_vector (octave_value::num_unary_ops, 1), 0), + unary_ops (dim_vector (octave_value::num_unary_ops, init_tab_sz), 0), + non_const_unary_ops (dim_vector (octave_value::num_unary_ops, init_tab_sz), 0), + binary_class_ops (dim_vector (octave_value::num_binary_ops, 1), 0), + binary_ops (dim_vector (octave_value::num_binary_ops, init_tab_sz, init_tab_sz), 0), + compound_binary_class_ops (dim_vector (octave_value::num_compound_binary_ops, 1), 0), + compound_binary_ops (dim_vector (octave_value::num_compound_binary_ops, init_tab_sz, init_tab_sz), 0), + cat_ops (dim_vector (init_tab_sz, init_tab_sz), 0), + assign_ops (dim_vector (octave_value::num_assign_ops, init_tab_sz, init_tab_sz), 0), + assignany_ops (dim_vector (octave_value::num_assign_ops, init_tab_sz), 0), + pref_assign_conv (dim_vector (init_tab_sz, init_tab_sz), -1), + type_conv_ops (dim_vector (init_tab_sz, init_tab_sz), 0), + widening_ops (dim_vector (init_tab_sz, init_tab_sz), 0) { } + + ~octave_value_typeinfo (void) { } + +private: + + static const int init_tab_sz; + + static octave_value_typeinfo *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + int num_types; + + Array types; + + Array vals; + + Array unary_class_ops; + + Array unary_ops; + + Array non_const_unary_ops; + + Array binary_class_ops; + + Array binary_ops; + + Array compound_binary_class_ops; + + Array compound_binary_ops; + + Array cat_ops; + + Array assign_ops; + + Array assignany_ops; + + Array pref_assign_conv; + + Array type_conv_ops; + + Array widening_ops; + + int do_register_type (const std::string&, const std::string&, + const octave_value&); + + bool do_register_unary_class_op (octave_value::unary_op, unary_class_op_fcn); + + bool do_register_unary_op (octave_value::unary_op, int, unary_op_fcn); + + bool do_register_non_const_unary_op (octave_value::unary_op, int, + non_const_unary_op_fcn); + + bool do_register_binary_class_op (octave_value::binary_op, + binary_class_op_fcn); + + bool do_register_binary_op (octave_value::binary_op, int, int, + binary_op_fcn); + + bool do_register_binary_class_op (octave_value::compound_binary_op, + binary_class_op_fcn); + + bool do_register_binary_op (octave_value::compound_binary_op, int, int, + binary_op_fcn); + + bool do_register_cat_op (int, int, cat_op_fcn); + + bool do_register_assign_op (octave_value::assign_op, int, int, + assign_op_fcn); + + bool do_register_assignany_op (octave_value::assign_op, int, + assignany_op_fcn); + + bool do_register_pref_assign_conv (int, int, int); + + bool do_register_type_conv_op (int, int, octave_base_value::type_conv_fcn); + + bool do_register_widening_op (int, int, octave_base_value::type_conv_fcn); + + octave_value do_lookup_type (const std::string& nm); + + unary_class_op_fcn do_lookup_unary_class_op (octave_value::unary_op); + + unary_op_fcn do_lookup_unary_op (octave_value::unary_op, int); + + non_const_unary_op_fcn do_lookup_non_const_unary_op + (octave_value::unary_op, int); + + binary_class_op_fcn do_lookup_binary_class_op (octave_value::binary_op); + + binary_op_fcn do_lookup_binary_op (octave_value::binary_op, int, int); + + binary_class_op_fcn do_lookup_binary_class_op (octave_value::compound_binary_op); + + binary_op_fcn do_lookup_binary_op (octave_value::compound_binary_op, int, int); + + cat_op_fcn do_lookup_cat_op (int, int); + + assign_op_fcn do_lookup_assign_op (octave_value::assign_op, int, int); + + assignany_op_fcn do_lookup_assignany_op (octave_value::assign_op, int); + + int do_lookup_pref_assign_conv (int, int); + + octave_base_value::type_conv_fcn do_lookup_type_conv_op (int, int); + + octave_base_value::type_conv_fcn do_lookup_widening_op (int, int); + + string_vector do_installed_type_names (void); + + // No copying! + + octave_value_typeinfo (const octave_value_typeinfo&); + + octave_value_typeinfo& operator = (const octave_value_typeinfo&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-uint16.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-uint16.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,93 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "lo-ieee.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "quit.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "ops.h" +#include "ov-base.h" + +#ifdef HAVE_HDF5 +#define HDF5_SAVE_TYPE H5T_NATIVE_UINT16 +#endif + +#include "ov-base-int.h" +#include "ov-base-int.cc" +#include "ov-uint16.h" +#include "ov-type-conv.h" +#include "pr-output.h" +#include "variables.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +template class octave_base_matrix; + +template class octave_base_int_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_uint16_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint16_matrix, + "uint16 matrix", "uint16"); + +template class octave_base_scalar; + +template class octave_base_int_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_uint16_scalar); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint16_scalar, + "uint16 scalar", "uint16"); + +DEFUN (uint16, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} uint16 (@var{x})\n\ +Convert @var{x} to unsigned 16-bit integer type.\n\ +@end deftypefn") +{ + OCTAVE_TYPE_CONV_BODY (uint16); +} + +/* +%!assert (class (uint16 (1)), "uint16") +%!assert (uint16 (1.25), uint16 (1)) +%!assert (uint16 (1.5), uint16 (2)) +%!assert (uint16 (-1.5), uint16 (0)) +%!assert (uint16 (2^17), uint16 (2^16-1)) +%!assert (uint16 (-2^17), uint16 (0)) +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-uint16.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-uint16.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,56 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_uint16_h) +#define octave_uint16_h 1 + +#define OCTAVE_INT_T octave_uint16 + +#define OCTAVE_VALUE_INT_MATRIX_T octave_uint16_matrix +#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION uint16_array_value + +#define OCTAVE_VALUE_INT_SCALAR_T octave_uint16_scalar +#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION uint16_scalar_value + +#define OCTAVE_TYPE_PREDICATE_FUNCTION is_uint16_type + +#define OCTAVE_INT_MX_CLASS mxUINT16_CLASS + +#define OCTAVE_INT_BTYP btyp_uint16 + +#include "ov-intx.h" + +#undef OCTAVE_INT_T + +#undef OCTAVE_VALUE_INT_MATRIX_T +#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION + +#undef OCTAVE_VALUE_INT_SCALAR_T +#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION + +#undef OCTAVE_TYPE_PREDICATE_FUNCTION + +#undef OCTAVE_INT_MX_CLASS + +#undef OCTAVE_INT_BTYP + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-uint32.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-uint32.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,93 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "lo-ieee.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "quit.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "ops.h" +#include "ov-base.h" + +#ifdef HAVE_HDF5 +#define HDF5_SAVE_TYPE H5T_NATIVE_UINT32 +#endif + +#include "ov-base-int.h" +#include "ov-base-int.cc" +#include "ov-uint32.h" +#include "ov-type-conv.h" +#include "pr-output.h" +#include "variables.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +template class octave_base_matrix; + +template class octave_base_int_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_uint32_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint32_matrix, + "uint32 matrix", "uint32"); + +template class octave_base_scalar; + +template class octave_base_int_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_uint32_scalar); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint32_scalar, + "uint32 scalar", "uint32"); + +DEFUN (uint32, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} uint32 (@var{x})\n\ +Convert @var{x} to unsigned 32-bit integer type.\n\ +@end deftypefn") +{ + OCTAVE_TYPE_CONV_BODY (uint32); +} + +/* +%!assert (class (uint32 (1)), "uint32") +%!assert (uint32 (1.25), uint32 (1)) +%!assert (uint32 (1.5), uint32 (2)) +%!assert (uint32 (-1.5), uint32 (0)) +%!assert (uint32 (2^33), uint32 (2^32-1)) +%!assert (uint32 (-2^33), uint32 (0)) +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-uint32.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-uint32.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,56 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_uint32_h) +#define octave_uint32_h 1 + +#define OCTAVE_INT_T octave_uint32 + +#define OCTAVE_VALUE_INT_MATRIX_T octave_uint32_matrix +#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION uint32_array_value + +#define OCTAVE_VALUE_INT_SCALAR_T octave_uint32_scalar +#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION uint32_scalar_value + +#define OCTAVE_TYPE_PREDICATE_FUNCTION is_uint32_type + +#define OCTAVE_INT_MX_CLASS mxUINT32_CLASS + +#define OCTAVE_INT_BTYP btyp_uint32 + +#include "ov-intx.h" + +#undef OCTAVE_INT_T + +#undef OCTAVE_VALUE_INT_MATRIX_T +#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION + +#undef OCTAVE_VALUE_INT_SCALAR_T +#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION + +#undef OCTAVE_TYPE_PREDICATE_FUNCTION + +#undef OCTAVE_INT_MX_CLASS + +#undef OCTAVE_INT_BTYP + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-uint64.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-uint64.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,93 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "lo-ieee.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "quit.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "ops.h" +#include "ov-base.h" + +#ifdef HAVE_HDF5 +#define HDF5_SAVE_TYPE H5T_NATIVE_UINT64 +#endif + +#include "ov-base-int.h" +#include "ov-base-int.cc" +#include "ov-uint64.h" +#include "ov-type-conv.h" +#include "pr-output.h" +#include "variables.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +template class octave_base_matrix; + +template class octave_base_int_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_uint64_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint64_matrix, + "uint64 matrix", "uint64"); + +template class octave_base_scalar; + +template class octave_base_int_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_uint64_scalar); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint64_scalar, + "uint64 scalar", "uint64"); + +DEFUN (uint64, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} uint64 (@var{x})\n\ +Convert @var{x} to unsigned 64-bit integer type.\n\ +@end deftypefn") +{ + OCTAVE_TYPE_CONV_BODY (uint64); +} + +/* +%!assert (class (uint64 (1)), "uint64") +%!assert (uint64 (1.25), uint64 (1)) +%!assert (uint64 (1.5), uint64 (2)) +%!assert (uint64 (-1.5), uint64 (0)) +%!assert (uint64 (2^65), uint64 (2^64-1)) +%!assert (uint64 (-2^65), uint64 (0)) +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-uint64.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-uint64.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,56 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_uint64_h) +#define octave_uint64_h 1 + +#define OCTAVE_INT_T octave_uint64 + +#define OCTAVE_VALUE_INT_MATRIX_T octave_uint64_matrix +#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION uint64_array_value + +#define OCTAVE_VALUE_INT_SCALAR_T octave_uint64_scalar +#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION uint64_scalar_value + +#define OCTAVE_TYPE_PREDICATE_FUNCTION is_uint64_type + +#define OCTAVE_INT_MX_CLASS mxUINT64_CLASS + +#define OCTAVE_INT_BTYP btyp_uint64 + +#include "ov-intx.h" + +#undef OCTAVE_INT_T + +#undef OCTAVE_VALUE_INT_MATRIX_T +#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION + +#undef OCTAVE_VALUE_INT_SCALAR_T +#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION + +#undef OCTAVE_TYPE_PREDICATE_FUNCTION + +#undef OCTAVE_INT_MX_CLASS + +#undef OCTAVE_INT_BTYP + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-uint8.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-uint8.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,93 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "lo-ieee.h" +#include "lo-utils.h" +#include "mx-base.h" +#include "quit.h" + +#include "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "ops.h" +#include "ov-base.h" + +#ifdef HAVE_HDF5 +#define HDF5_SAVE_TYPE H5T_NATIVE_UINT8 +#endif + +#include "ov-base-int.h" +#include "ov-base-int.cc" +#include "ov-uint8.h" +#include "ov-type-conv.h" +#include "pr-output.h" +#include "variables.h" + +#include "byte-swap.h" +#include "ls-oct-ascii.h" +#include "ls-utils.h" +#include "ls-hdf5.h" + +template class octave_base_matrix; + +template class octave_base_int_matrix; + +DEFINE_OCTAVE_ALLOCATOR (octave_uint8_matrix); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint8_matrix, + "uint8 matrix", "uint8"); + +template class octave_base_scalar; + +template class octave_base_int_scalar; + +DEFINE_OCTAVE_ALLOCATOR (octave_uint8_scalar); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint8_scalar, + "uint8 scalar", "uint8"); + +DEFUN (uint8, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} uint8 (@var{x})\n\ +Convert @var{x} to unsigned 8-bit integer type.\n\ +@end deftypefn") +{ + OCTAVE_TYPE_CONV_BODY (uint8); +} + +/* +%!assert (class (uint8 (1)), "uint8") +%!assert (uint8 (1.25), uint8 (1)) +%!assert (uint8 (1.5), uint8 (2)) +%!assert (uint8 (-1.5), uint8 (0)) +%!assert (uint8 (2^9), uint8 (2^8-1)) +%!assert (uint8 (-2^9), uint8 (0)) +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-uint8.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-uint8.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,56 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_uint8_h) +#define octave_uint8_h 1 + +#define OCTAVE_INT_T octave_uint8 + +#define OCTAVE_VALUE_INT_MATRIX_T octave_uint8_matrix +#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION uint8_array_value + +#define OCTAVE_VALUE_INT_SCALAR_T octave_uint8_scalar +#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION uint8_scalar_value + +#define OCTAVE_TYPE_PREDICATE_FUNCTION is_uint8_type + +#define OCTAVE_INT_MX_CLASS mxUINT8_CLASS + +#define OCTAVE_INT_BTYP btyp_uint8 + +#include "ov-intx.h" + +#undef OCTAVE_INT_T + +#undef OCTAVE_VALUE_INT_MATRIX_T +#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION + +#undef OCTAVE_VALUE_INT_SCALAR_T +#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION + +#undef OCTAVE_TYPE_PREDICATE_FUNCTION + +#undef OCTAVE_INT_MX_CLASS + +#undef OCTAVE_INT_BTYP + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-usr-fcn.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-usr-fcn.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,966 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "str-vec.h" + +#include +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "oct-obj.h" +#include "ov-usr-fcn.h" +#include "ov.h" +#include "pager.h" +#include "pt-eval.h" +#include "pt-jump.h" +#include "pt-misc.h" +#include "pt-pr-code.h" +#include "pt-stmt.h" +#include "pt-walk.h" +#include "symtab.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "parse.h" +#include "profiler.h" +#include "variables.h" +#include "ov-fcn-handle.h" + +// Whether to optimize subsasgn method calls. +static bool Voptimize_subsasgn_calls = true; + +// User defined scripts. + +DEFINE_OCTAVE_ALLOCATOR (octave_user_script); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_user_script, + "user-defined script", + "user-defined script"); + +octave_user_script::octave_user_script (void) + : octave_user_code (), cmd_list (0), file_name (), + t_parsed (static_cast (0)), + t_checked (static_cast (0)), + call_depth (-1) +{ } + +octave_user_script::octave_user_script (const std::string& fnm, + const std::string& nm, + tree_statement_list *cmds, + const std::string& ds) + : octave_user_code (nm, ds), cmd_list (cmds), file_name (fnm), + t_parsed (static_cast (0)), + t_checked (static_cast (0)), + call_depth (-1) +{ + if (cmd_list) + cmd_list->mark_as_script_body (); +} + +octave_user_script::octave_user_script (const std::string& fnm, + const std::string& nm, + const std::string& ds) + : octave_user_code (nm, ds), cmd_list (0), file_name (fnm), + t_parsed (static_cast (0)), + t_checked (static_cast (0)), + call_depth (-1) +{ } + +octave_user_script::~octave_user_script (void) +{ + delete cmd_list; +} + +octave_value_list +octave_user_script::subsref (const std::string&, + const std::list&, int) +{ + octave_value_list retval; + + ::error ("invalid use of script %s in index expression", file_name.c_str ()); + + return retval; +} + +octave_value_list +octave_user_script::do_multi_index_op (int nargout, + const octave_value_list& args) +{ + octave_value_list retval; + + unwind_protect frame; + + if (! error_state) + { + if (args.length () == 0 && nargout == 0) + { + if (cmd_list) + { + frame.protect_var (call_depth); + call_depth++; + + if (call_depth < Vmax_recursion_depth) + { + octave_call_stack::push (this); + + frame.add_fcn (octave_call_stack::pop); + + frame.protect_var (tree_evaluator::statement_context); + tree_evaluator::statement_context = tree_evaluator::script; + + BEGIN_PROFILER_BLOCK (profiler_name ()) + cmd_list->accept (*current_evaluator); + END_PROFILER_BLOCK + + if (tree_return_command::returning) + tree_return_command::returning = 0; + + if (tree_break_command::breaking) + tree_break_command::breaking--; + + if (error_state) + octave_call_stack::backtrace_error_message (); + } + else + ::error ("max_recursion_depth exceeded"); + } + } + else + error ("invalid call to script %s", file_name.c_str ()); + } + + return retval; +} + +void +octave_user_script::accept (tree_walker& tw) +{ + tw.visit_octave_user_script (*this); +} + +// User defined functions. + +DEFINE_OCTAVE_ALLOCATOR (octave_user_function); + +DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_user_function, + "user-defined function", + "user-defined function"); + +// Ugh. This really needs to be simplified (code/data? +// extrinsic/intrinsic state?). + +octave_user_function::octave_user_function + (symbol_table::scope_id sid, tree_parameter_list *pl, + tree_parameter_list *rl, tree_statement_list *cl) + : octave_user_code (std::string (), std::string ()), + param_list (pl), ret_list (rl), cmd_list (cl), + lead_comm (), trail_comm (), file_name (), + location_line (0), location_column (0), + parent_name (), t_parsed (static_cast (0)), + t_checked (static_cast (0)), + system_fcn_file (false), call_depth (-1), + num_named_args (param_list ? param_list->length () : 0), + subfunction (false), inline_function (false), + anonymous_function (false), nested_function (false), + class_constructor (false), class_method (false), + parent_scope (-1), local_scope (sid), + curr_unwind_protect_frame (0) +{ + if (cmd_list) + cmd_list->mark_as_function_body (); + + if (local_scope >= 0) + symbol_table::set_curr_fcn (this, local_scope); +} + +octave_user_function::~octave_user_function (void) +{ + delete param_list; + delete ret_list; + delete cmd_list; + delete lead_comm; + delete trail_comm; + + symbol_table::erase_scope (local_scope); +} + +octave_user_function * +octave_user_function::define_ret_list (tree_parameter_list *t) +{ + ret_list = t; + + return this; +} + +void +octave_user_function::stash_fcn_file_name (const std::string& nm) +{ + file_name = nm; +} + +std::string +octave_user_function::profiler_name (void) const +{ + std::ostringstream result; + + if (is_inline_function ()) + result << "inline@" << fcn_file_name () + << ":" << location_line << ":" << location_column; + else if (is_anonymous_function ()) + result << "anonymous@" << fcn_file_name () + << ":" << location_line << ":" << location_column; + else if (is_subfunction ()) + result << parent_fcn_name () << ">" << name (); + else + result << name (); + + return result.str (); +} + +void +octave_user_function::mark_as_system_fcn_file (void) +{ + if (! file_name.empty ()) + { + // We really should stash the whole path to the file we found, + // when we looked it up, to avoid possible race conditions... + // FIXME + // + // We probably also don't need to get the library directory + // every time, but since this function is only called when the + // function file is parsed, it probably doesn't matter that + // much. + + std::string ff_name = fcn_file_in_path (file_name); + + if (Vfcn_file_dir == ff_name.substr (0, Vfcn_file_dir.length ())) + system_fcn_file = true; + } + else + system_fcn_file = false; +} + +bool +octave_user_function::takes_varargs (void) const +{ + return (param_list && param_list->takes_varargs ()); +} + +bool +octave_user_function::takes_var_return (void) const +{ + return (ret_list && ret_list->takes_varargs ()); +} + +void +octave_user_function::lock_subfunctions (void) +{ + symbol_table::lock_subfunctions (local_scope); +} + +void +octave_user_function::unlock_subfunctions (void) +{ + symbol_table::unlock_subfunctions (local_scope); +} + +octave_value_list +octave_user_function::all_va_args (const octave_value_list& args) +{ + octave_value_list retval; + + octave_idx_type n = args.length () - num_named_args; + + if (n > 0) + retval = args.slice (num_named_args, n); + + return retval; +} + +octave_value_list +octave_user_function::subsref (const std::string& type, + const std::list& idx, + int nargout) +{ + return octave_user_function::subsref (type, idx, nargout, 0); +} + +octave_value_list +octave_user_function::subsref (const std::string& type, + const std::list& idx, + int nargout, const std::list* lvalue_list) +{ + octave_value_list retval; + + switch (type[0]) + { + case '(': + { + int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout; + + retval = do_multi_index_op (tmp_nargout, idx.front (), + idx.size () == 1 ? lvalue_list : 0); + } + break; + + case '{': + case '.': + { + std::string nm = type_name (); + error ("%s cannot be indexed with %c", nm.c_str (), type[0]); + } + break; + + default: + panic_impossible (); + } + + // FIXME -- perhaps there should be an + // octave_value_list::next_subsref member function? See also + // octave_builtin::subsref. + + if (idx.size () > 1) + retval = retval(0).next_subsref (nargout, type, idx); + + return retval; +} + +octave_value_list +octave_user_function::do_multi_index_op (int nargout, + const octave_value_list& args) +{ + return do_multi_index_op (nargout, args, 0); +} + +octave_value_list +octave_user_function::do_multi_index_op (int nargout, + const octave_value_list& args, + const std::list* lvalue_list) +{ + octave_value_list retval; + + if (error_state) + return retval; + + if (! cmd_list) + return retval; + + int nargin = args.length (); + + unwind_protect frame; + + frame.protect_var (call_depth); + call_depth++; + + if (call_depth >= Vmax_recursion_depth) + { + ::error ("max_recursion_depth exceeded"); + return retval; + } + + // Save old and set current symbol table context, for + // eval_undefined_error(). + + int context = active_context (); + + octave_call_stack::push (this, local_scope, context); + frame.add_fcn (octave_call_stack::pop); + + if (call_depth > 0 && ! is_anonymous_function ()) + { + symbol_table::push_context (); + + frame.add_fcn (symbol_table::pop_context); + } + + string_vector arg_names = args.name_tags (); + + if (param_list && ! param_list->varargs_only ()) + { + param_list->define_from_arg_vector (args); + if (error_state) + return retval; + } + + // Force parameter list to be undefined when this function exits. + // Doing so decrements the reference counts on the values of local + // variables that are also named function parameters. + + if (param_list) + frame.add_method (param_list, &tree_parameter_list::undefine); + + // Force return list to be undefined when this function exits. + // Doing so decrements the reference counts on the values of local + // variables that are also named values returned by this function. + + if (ret_list) + frame.add_method (ret_list, &tree_parameter_list::undefine); + + if (call_depth == 0) + { + // Force symbols to be undefined again when this function + // exits. + // + // This cleanup function is added to the unwind_protect stack + // after the calls to clear the parameter lists so that local + // variables will be cleared before the parameter lists are + // cleared. That way, any function parameters that have been + // declared global will be unmarked as global before they are + // undefined by the clear_param_list cleanup function. + + frame.add_fcn (symbol_table::clear_variables); + } + + bind_automatic_vars (arg_names, nargin, nargout, all_va_args (args), + lvalue_list); + + bool echo_commands = (Vecho_executing_commands & ECHO_FUNCTIONS); + + if (echo_commands) + print_code_function_header (); + + // Set pointer to the current unwind_protect frame to allow + // certain builtins register simple cleanup in a very optimized manner. + // This is *not* intended as a general-purpose on-cleanup mechanism, + frame.protect_var (curr_unwind_protect_frame); + curr_unwind_protect_frame = &frame; + + // Evaluate the commands that make up the function. + + frame.protect_var (tree_evaluator::statement_context); + tree_evaluator::statement_context = tree_evaluator::function; + + bool special_expr = (is_inline_function () || is_anonymous_function ()); + + BEGIN_PROFILER_BLOCK (profiler_name ()) + + if (special_expr) + { + assert (cmd_list->length () == 1); + + tree_statement *stmt = 0; + + if ((stmt = cmd_list->front ()) + && stmt->is_expression ()) + { + tree_expression *expr = stmt->expression (); + + retval = expr->rvalue (nargout); + } + } + else + cmd_list->accept (*current_evaluator); + + END_PROFILER_BLOCK + + if (echo_commands) + print_code_function_trailer (); + + if (tree_return_command::returning) + tree_return_command::returning = 0; + + if (tree_break_command::breaking) + tree_break_command::breaking--; + + if (error_state) + { + octave_call_stack::backtrace_error_message (); + return retval; + } + + // Copy return values out. + + if (ret_list && ! special_expr) + { + ret_list->initialize_undefined_elements (my_name, nargout, Matrix ()); + + Cell varargout; + + if (ret_list->takes_varargs ()) + { + octave_value varargout_varval = symbol_table::varval ("varargout"); + + if (varargout_varval.is_defined ()) + { + varargout = varargout_varval.cell_value (); + + if (error_state) + error ("expecting varargout to be a cell array object"); + } + } + + if (! error_state) + retval = ret_list->convert_to_const_vector (nargout, varargout); + } + + return retval; +} + +void +octave_user_function::accept (tree_walker& tw) +{ + tw.visit_octave_user_function (*this); +} + +bool +octave_user_function::subsasgn_optimization_ok (void) +{ + bool retval = false; + if (Voptimize_subsasgn_calls + && param_list->length () > 0 && ! param_list->varargs_only () + && ret_list->length () == 1 && ! ret_list->takes_varargs ()) + { + tree_identifier *par1 = param_list->front ()->ident (); + tree_identifier *ret1 = ret_list->front ()->ident (); + retval = par1->name () == ret1->name (); + } + + return retval; +} + +#if 0 +void +octave_user_function::print_symtab_info (std::ostream& os) const +{ + symbol_table::print_info (os, local_scope); +} +#endif + +void +octave_user_function::print_code_function_header (void) +{ + tree_print_code tpc (octave_stdout, VPS4); + + tpc.visit_octave_user_function_header (*this); +} + +void +octave_user_function::print_code_function_trailer (void) +{ + tree_print_code tpc (octave_stdout, VPS4); + + tpc.visit_octave_user_function_trailer (*this); +} + +void +octave_user_function::bind_automatic_vars + (const string_vector& arg_names, int nargin, int nargout, + const octave_value_list& va_args, const std::list *lvalue_list) +{ + if (! arg_names.empty ()) + { + // It is better to save this in the hidden variable .argn. and + // then use that in the inputname function instead of using argn, + // which might be redefined in a function. Keep the old argn name + // for backward compatibility of functions that use it directly. + + symbol_table::varref ("argn") = arg_names; + symbol_table::varref (".argn.") = Cell (arg_names); + + symbol_table::mark_hidden (".argn."); + + symbol_table::mark_automatic ("argn"); + symbol_table::mark_automatic (".argn."); + } + + symbol_table::varref (".nargin.") = nargin; + symbol_table::varref (".nargout.") = nargout; + + symbol_table::mark_hidden (".nargin."); + symbol_table::mark_hidden (".nargout."); + + symbol_table::mark_automatic (".nargin."); + symbol_table::mark_automatic (".nargout."); + + if (takes_varargs ()) + symbol_table::varref ("varargin") = va_args.cell_value (); + + // Force .ignored. variable to be undefined by default. + symbol_table::varref (".ignored.") = octave_value (); + + if (lvalue_list) + { + octave_idx_type nbh = 0; + for (std::list::const_iterator p = lvalue_list->begin (); + p != lvalue_list->end (); p++) + nbh += p->is_black_hole (); + + if (nbh > 0) + { + // Only assign the hidden variable if black holes actually present. + Matrix bh (1, nbh); + octave_idx_type k = 0, l = 0; + for (std::list::const_iterator p = lvalue_list->begin (); + p != lvalue_list->end (); p++) + { + if (p->is_black_hole ()) + bh(l++) = k+1; + k += p->numel (); + } + + symbol_table::varref (".ignored.") = bh; + } + } + + symbol_table::mark_hidden (".ignored."); + symbol_table::mark_automatic (".ignored."); +} + +DEFUN (nargin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} nargin ()\n\ +@deftypefnx {Built-in Function} {} nargin (@var{fcn})\n\ +Within a function, return the number of arguments passed to the function.\n\ +At the top level, return the number of command line arguments passed to\n\ +Octave.\n\ +\n\ +If called with the optional argument @var{fcn}, a function name or handle,\n\ +return the declared number of arguments that the function can accept.\n\ +If the last argument is @var{varargin} the returned value is negative.\n\ +This feature does not work on builtin functions.\n\ +@seealso{nargout, varargin, isargout, varargout, nthargout}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value func = args(0); + + if (func.is_string ()) + { + std::string name = func.string_value (); + func = symbol_table::find_function (name); + if (func.is_undefined ()) + error ("nargout: invalid function name: %s", name.c_str ()); + } + + octave_function *fcn_val = func.function_value (); + if (fcn_val) + { + octave_user_function *fcn = fcn_val->user_function_value (true); + + if (fcn) + { + tree_parameter_list *param_list = fcn->parameter_list (); + + retval = param_list ? param_list->length () : 0; + if (fcn->takes_varargs ()) + retval = -1 - retval; + } + else + { + // Matlab gives up for histc, so maybe it's ok we give up somtimes too. + error ("nargin: nargin information not available for builtin functions"); + } + } + else + error ("nargin: FCN must be a string or function handle"); + } + else if (nargin == 0) + { + retval = symbol_table::varval (".nargin."); + + if (retval.is_undefined ()) + retval = 0; + } + else + print_usage (); + + return retval; +} + +DEFUN (nargout, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} nargout ()\n\ +@deftypefnx {Built-in Function} {} nargout (@var{fcn})\n\ +Within a function, return the number of values the caller expects to\n\ +receive. If called with the optional argument @var{fcn}, a function\n\ +name or handle, return the number of declared output values that the\n\ +function can produce. If the final output argument is @var{varargout}\n\ +the returned value is negative.\n\ +\n\ +For example,\n\ +\n\ +@example\n\ +f ()\n\ +@end example\n\ +\n\ +@noindent\n\ +will cause @code{nargout} to return 0 inside the function @code{f} and\n\ +\n\ +@example\n\ +[s, t] = f ()\n\ +@end example\n\ +\n\ +@noindent\n\ +will cause @code{nargout} to return 2 inside the function\n\ +@code{f}.\n\ +\n\ +In the second usage,\n\ +\n\ +@example\n\ +nargout (@@histc) \% or nargout ('histc')\n\ +@end example\n\ +\n\ +@noindent\n\ +will return 2, because @code{histc} has two outputs, whereas\n\ +\n\ +@example\n\ +nargout (@@deal)\n\ +@end example\n\ +\n\ +@noindent\n\ +will return -1, because @code{deal} has a variable number of outputs.\n\ +\n\ +At the top level, @code{nargout} with no argument is undefined.\n\ +@code{nargout} does not work on builtin functions.\n\ +@code{nargout} returns -1 for all anonymous functions.\n\ +@seealso{nargin, varargin, isargout, varargout, nthargout}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value func = args(0); + + if (func.is_string ()) + { + std::string name = func.string_value (); + func = symbol_table::find_function (name); + if (func.is_undefined ()) + error ("nargout: invalid function name: %s", name.c_str ()); + } + + if (func.is_inline_function ()) + { + retval = 1; + return retval; + } + + if (func.is_function_handle ()) + { + octave_fcn_handle *fh = func.fcn_handle_value (); + std::string fh_nm = fh->fcn_name (); + + if (fh_nm == octave_fcn_handle::anonymous) + { + retval = -1; + return retval; + } + } + + octave_function *fcn_val = func.function_value (); + if (fcn_val) + { + octave_user_function *fcn = fcn_val->user_function_value (true); + + if (fcn) + { + tree_parameter_list *ret_list = fcn->return_list (); + + retval = ret_list ? ret_list->length () : 0; + + if (fcn->takes_var_return ()) + retval = -1 - retval; + } + else + { + // JWE said this information is not available (currently, 2011-03-10) + // without making intrusive changes to Octave. + // Matlab gives up for histc, so maybe it's ok we give up somtimes too. + error ("nargout: nargout information not available for builtin functions."); + } + } + else + error ("nargout: FCN must be a string or function handle"); + } + else if (nargin == 0) + { + if (! symbol_table::at_top_level ()) + { + retval = symbol_table::varval (".nargout."); + + if (retval.is_undefined ()) + retval = 0; + } + else + error ("nargout: invalid call at top level"); + } + else + print_usage (); + + return retval; +} + +DEFUN (optimize_subsasgn_calls, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} optimize_subsasgn_calls ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} optimize_subsasgn_calls (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} optimize_subsasgn_calls (@var{new_val}, \"local\")\n\ +Query or set the internal flag for subsasgn method call optimizations.\n\ +If true, Octave will attempt to eliminate the redundant copying when calling\n\ +subsasgn method of a user-defined class.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (optimize_subsasgn_calls); +} + +static bool val_in_table (const Matrix& table, double val) +{ + if (table.is_empty ()) + return false; + + octave_idx_type i = table.lookup (val, ASCENDING); + return (i > 0 && table(i-1) == val); +} + +static bool isargout1 (int nargout, const Matrix& ignored, double k) +{ + if (k != xround (k) || k <= 0) + { + error ("isargout: K must be a positive integer"); + return false; + } + else + return (k == 1 || k <= nargout) && ! val_in_table (ignored, k); +} + +DEFUN (isargout, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isargout (@var{k})\n\ +Within a function, return a logical value indicating whether the argument\n\ +@var{k} will be assigned on output to a variable. If the result is false,\n\ +the argument has been ignored during the function call through the use of\n\ +the tilde (~) special output argument. Functions can use @code{isargout} to\n\ +avoid performing unnecessary calculations for outputs which are unwanted.\n\ +\n\ +If @var{k} is outside the range @code{1:max (nargout)}, the function returns\n\ +false. @var{k} can also be an array, in which case the function works\n\ +element-by-element and a logical array is returned. At the top level,\n\ +@code{isargout} returns an error.\n\ +@seealso{nargout, nargin, varargin, varargout, nthargout}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (! symbol_table::at_top_level ()) + { + int nargout1 = symbol_table::varval (".nargout.").int_value (); + if (error_state) + { + error ("isargout: internal error"); + return retval; + } + + Matrix ignored; + octave_value tmp = symbol_table::varval (".ignored."); + if (tmp.is_defined ()) + ignored = tmp.matrix_value (); + + if (args(0).is_scalar_type ()) + { + double k = args(0).double_value (); + if (! error_state) + retval = isargout1 (nargout1, ignored, k); + } + else if (args(0).is_numeric_type ()) + { + const NDArray ka = args(0).array_value (); + if (! error_state) + { + boolNDArray r (ka.dims ()); + for (octave_idx_type i = 0; i < ka.numel () && ! error_state; i++) + r(i) = isargout1 (nargout1, ignored, ka(i)); + + retval = r; + } + } + else + gripe_wrong_type_arg ("isargout", args(0)); + } + else + error ("isargout: invalid call at top level"); + } + else + print_usage (); + + return retval; +} + +/* +%!function [x, y] = try_isargout () +%! if (isargout (1)) +%! if (isargout (2)) +%! x = 1; y = 2; +%! else +%! x = -1; +%! endif +%! else +%! if (isargout (2)) +%! y = -2; +%! else +%! error ("no outputs requested"); +%! endif +%! endif +%!endfunction +%! +%!test +%! [x, y] = try_isargout (); +%! assert ([x, y], [1, 2]); +%! +%!test +%! [x, ~] = try_isargout (); +%! assert (x, -1); +%! +%!test +%! [~, y] = try_isargout (); +%! assert (y, -2); +%! +%!error [~, ~] = try_isargout (); +%! +%% Check to see that isargout isn't sticky: +%!test +%! [x, y] = try_isargout (); +%! assert ([x, y], [1, 2]); +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov-usr-fcn.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov-usr-fcn.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,463 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_user_function_h) +#define octave_user_function_h 1 + +#include + +#include +#include + +#include "comment-list.h" +#include "oct-obj.h" +#include "ov-fcn.h" +#include "ov-typeinfo.h" +#include "symtab.h" +#include "unwind-prot.h" + +class string_vector; + +class octave_value; +class tree_parameter_list; +class tree_statement_list; +class tree_va_return_list; +class tree_walker; + +class +octave_user_code : public octave_function +{ +public: + octave_user_code (void) + : octave_function () { } + + ~octave_user_code (void) { } + + bool is_user_code (void) const { return true; } + + virtual tree_statement_list *body (void) = 0; + +protected: + + octave_user_code (const std::string& nm, + const std::string& ds = std::string ()) + : octave_function (nm, ds) { } + +private: + + // No copying! + + octave_user_code (const octave_user_code& f); + + octave_user_code& operator = (const octave_user_code& f); +}; + +// Scripts. + +class +octave_user_script : public octave_user_code +{ +public: + + octave_user_script (void); + + octave_user_script (const std::string& fnm, const std::string& nm, + tree_statement_list *cmds, + const std::string& ds = std::string ()); + + octave_user_script (const std::string& fnm, const std::string& nm, + const std::string& ds = std::string ()); + + ~octave_user_script (void); + + octave_function *function_value (bool = false) { return this; } + + octave_user_script *user_script_value (bool = false) { return this; } + + octave_user_code *user_code_value (bool = false) { return this; } + + // Scripts and user functions are both considered "scripts" because + // they are written in Octave's scripting language. + + bool is_user_script (void) const { return true; } + + void stash_fcn_file_name (const std::string& nm) { file_name = nm; } + + void mark_fcn_file_up_to_date (const octave_time& t) { t_checked = t; } + + void stash_fcn_file_time (const octave_time& t) + { + t_parsed = t; + mark_fcn_file_up_to_date (t); + } + + std::string fcn_file_name (void) const { return file_name; } + + octave_time time_parsed (void) const { return t_parsed; } + + octave_time time_checked (void) const { return t_checked; } + + octave_value subsref (const std::string& type, + const std::list& idx) + { + octave_value_list tmp = subsref (type, idx, 1); + return tmp.length () > 0 ? tmp(0) : octave_value (); + } + + octave_value_list subsref (const std::string& type, + const std::list& idx, + int nargout); + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& args); + + tree_statement_list *body (void) { return cmd_list; } + + void accept (tree_walker& tw); + +private: + + // The list of commands that make up the body of this function. + tree_statement_list *cmd_list; + + // The name of the file we parsed. + std::string file_name; + + // The time the file was parsed. + octave_time t_parsed; + + // The time the file was last checked to see if it needs to be + // parsed again. + octave_time t_checked; + + // Used to keep track of recursion depth. + int call_depth; + + // No copying! + + octave_user_script (const octave_user_script& f); + + octave_user_script& operator = (const octave_user_script& f); + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +// User-defined functions. + +class +octave_user_function : public octave_user_code +{ +public: + + octave_user_function (symbol_table::scope_id sid = -1, + tree_parameter_list *pl = 0, + tree_parameter_list *rl = 0, + tree_statement_list *cl = 0); + + ~octave_user_function (void); + + symbol_table::context_id active_context () const + { + return is_anonymous_function () + ? 0 : static_cast(call_depth); + } + + octave_function *function_value (bool = false) { return this; } + + octave_user_function *user_function_value (bool = false) { return this; } + + octave_user_code *user_code_value (bool = false) { return this; } + + octave_user_function *define_param_list (tree_parameter_list *t); + + octave_user_function *define_ret_list (tree_parameter_list *t); + + void stash_fcn_file_name (const std::string& nm); + + void stash_fcn_location (int line, int col) + { + location_line = line; + location_column = col; + } + + void stash_parent_fcn_name (const std::string& p) { parent_name = p; } + + void stash_parent_fcn_scope (symbol_table::scope_id ps) { parent_scope = ps; } + + void stash_leading_comment (octave_comment_list *lc) { lead_comm = lc; } + + void stash_trailing_comment (octave_comment_list *tc) { trail_comm = tc; } + + void mark_fcn_file_up_to_date (const octave_time& t) { t_checked = t; } + + void stash_fcn_file_time (const octave_time& t) + { + t_parsed = t; + mark_fcn_file_up_to_date (t); + } + + std::string fcn_file_name (void) const { return file_name; } + + std::string profiler_name (void) const; + + std::string parent_fcn_name (void) const { return parent_name; } + + symbol_table::scope_id parent_fcn_scope (void) const { return parent_scope; } + + symbol_table::scope_id scope (void) { return local_scope; } + + octave_time time_parsed (void) const { return t_parsed; } + + octave_time time_checked (void) const { return t_checked; } + + void mark_as_system_fcn_file (void); + + bool is_system_fcn_file (void) const { return system_fcn_file; } + + bool is_user_function (void) const { return true; } + + void erase_subfunctions (void) + { + symbol_table::erase_subfunctions_in_scope (local_scope); + } + + bool takes_varargs (void) const; + + bool takes_var_return (void) const; + + void mark_as_private_function (const std::string& cname = std::string ()) + { + symbol_table::mark_subfunctions_in_scope_as_private (local_scope, cname); + + octave_function::mark_as_private_function (cname); + } + + void lock_subfunctions (void); + + void unlock_subfunctions (void); + + octave_value_list all_va_args (const octave_value_list& args); + + void stash_function_name (const std::string& s) { my_name = s; } + + void mark_as_subfunction (void) { subfunction = true; } + + bool is_subfunction (void) const { return subfunction; } + + void mark_as_inline_function (void) { inline_function = true; } + + bool is_inline_function (void) const { return inline_function; } + + void mark_as_anonymous_function (void) { anonymous_function = true; } + + bool is_anonymous_function (void) const { return anonymous_function; } + + bool is_anonymous_function_of_class + (const std::string& cname = std::string ()) const + { + return anonymous_function + ? (cname.empty () + ? (! dispatch_class ().empty ()) + : cname == dispatch_class ()) + : false; + } + + bool is_nested_function (void) const { return nested_function; } + + void mark_as_nested_function (void) { nested_function = true; } + + void mark_as_class_constructor (void) { class_constructor = true; } + + bool is_class_constructor (const std::string& cname = std::string ()) const + { + return class_constructor + ? (cname.empty () ? true : cname == dispatch_class ()) : false; + } + + void mark_as_class_method (void) { class_method = true; } + + bool is_class_method (const std::string& cname = std::string ()) const + { + return class_method + ? (cname.empty () ? true : cname == dispatch_class ()) : false; + } + + octave_value subsref (const std::string& type, + const std::list& idx) + { + octave_value_list tmp = subsref (type, idx, 1); + return tmp.length () > 0 ? tmp(0) : octave_value (); + } + + octave_value_list subsref (const std::string& type, + const std::list& idx, + int nargout); + + octave_value_list subsref (const std::string& type, + const std::list& idx, + int nargout, const std::list* lvalue_list); + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& args); + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& args, + const std::list* lvalue_list); + + tree_parameter_list *parameter_list (void) { return param_list; } + + tree_parameter_list *return_list (void) { return ret_list; } + + tree_statement_list *body (void) { return cmd_list; } + + octave_comment_list *leading_comment (void) { return lead_comm; } + + octave_comment_list *trailing_comment (void) { return trail_comm; } + + bool subsasgn_optimization_ok (void); + + void accept (tree_walker& tw); + + template + bool local_protect (T& variable) + { + if (curr_unwind_protect_frame) + { + curr_unwind_protect_frame->protect_var (variable); + return true; + } + else + return false; + } + +#if 0 + void print_symtab_info (std::ostream& os) const; +#endif + +private: + + // List of arguments for this function. These are local variables. + tree_parameter_list *param_list; + + // List of parameters we return. These are also local variables in + // this function. + tree_parameter_list *ret_list; + + // The list of commands that make up the body of this function. + tree_statement_list *cmd_list; + + // The comments preceding the FUNCTION token. + octave_comment_list *lead_comm; + + // The comments preceding the ENDFUNCTION token. + octave_comment_list *trail_comm; + + // The name of the file we parsed. + std::string file_name; + + // Location where this function was defined. + int location_line; + int location_column; + + // The name of the parent function, if any. + std::string parent_name; + + // The time the file was parsed. + octave_time t_parsed; + + // The time the file was last checked to see if it needs to be + // parsed again. + octave_time t_checked; + + // True if this function came from a file that is considered to be a + // system function. This affects whether we check the time stamp + // on the file to see if it has changed. + bool system_fcn_file; + + // Used to keep track of recursion depth. + int call_depth; + + // The number of arguments that have names. + int num_named_args; + + // TRUE means this subfunction of a primary function. + bool subfunction; + + // TRUE means this is an inline function. + bool inline_function; + + // TRUE means this is an anonymous function. + bool anonymous_function; + + // TRUE means this is a nested function. (either a child or parent) + bool nested_function; + + // TRUE means this function is the constructor for class object. + bool class_constructor; + + // TRUE means this function is a method for a class. + bool class_method; + + // The scope of the parent function, if any. + symbol_table::scope_id parent_scope; + + symbol_table::scope_id local_scope; + + // pointer to the current unwind_protect frame of this function. + unwind_protect *curr_unwind_protect_frame; + +#if 0 + // The symbol record for argn in the local symbol table. + octave_value& argn_varref; + + // The symbol record for nargin in the local symbol table. + octave_value& nargin_varref; + + // The symbol record for nargout in the local symbol table. + octave_value& nargout_varref; + + // The symbol record for varargin in the local symbol table. + octave_value& varargin_varref; +#endif + + void print_code_function_header (void); + + void print_code_function_trailer (void); + + void bind_automatic_vars (const string_vector& arg_names, int nargin, + int nargout, const octave_value_list& va_args, + const std::list *lvalue_list); + + // No copying! + + octave_user_function (const octave_user_function& fn); + + octave_user_function& operator = (const octave_user_function& fn); + + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,3046 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "data-conv.h" +#include "quit.h" +#include "str-vec.h" + +#include "oct-obj.h" +#include "oct-stream.h" +#include "ov.h" +#include "ov-base.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-cell.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-re-diag.h" +#include "ov-flt-re-diag.h" +#include "ov-perm.h" +#include "ov-bool-sparse.h" +#include "ov-cx-sparse.h" +#include "ov-re-sparse.h" +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-cx-diag.h" +#include "ov-flt-cx-diag.h" +#include "ov-ch-mat.h" +#include "ov-str-mat.h" +#include "ov-range.h" +#include "ov-struct.h" +#include "ov-class.h" +#include "ov-oncleanup.h" +#include "ov-cs-list.h" +#include "ov-colon.h" +#include "ov-builtin.h" +#include "ov-dld-fcn.h" +#include "ov-usr-fcn.h" +#include "ov-fcn-handle.h" +#include "ov-fcn-inline.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ov-lazy-idx.h" + +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "pager.h" +#include "parse.h" +#include "pr-output.h" +#include "symtab.h" +#include "utils.h" +#include "variables.h" + +// We are likely to have a lot of octave_value objects to allocate, so +// make the grow_size large. +DEFINE_OCTAVE_ALLOCATOR2(octave_value, 1024); + +// FIXME + +// Octave's value type. + +std::string +octave_value::unary_op_as_string (unary_op op) +{ + std::string retval; + + switch (op) + { + case op_not: + retval = "!"; + break; + + case op_uplus: + retval = "+"; + break; + + case op_uminus: + retval = "-"; + break; + + case op_transpose: + retval = ".'"; + break; + + case op_hermitian: + retval = "'"; + break; + + case op_incr: + retval = "++"; + break; + + case op_decr: + retval = "--"; + break; + + default: + retval = ""; + } + + return retval; +} + +std::string +octave_value::unary_op_fcn_name (unary_op op) +{ + std::string retval; + + switch (op) + { + case op_not: + retval = "not"; + break; + + case op_uplus: + retval = "uplus"; + break; + + case op_uminus: + retval = "uminus"; + break; + + case op_transpose: + retval = "transpose"; + break; + + case op_hermitian: + retval = "ctranspose"; + break; + + default: + break; + } + + return retval; +} + +std::string +octave_value::binary_op_as_string (binary_op op) +{ + std::string retval; + + switch (op) + { + case op_add: + retval = "+"; + break; + + case op_sub: + retval = "-"; + break; + + case op_mul: + retval = "*"; + break; + + case op_div: + retval = "/"; + break; + + case op_pow: + retval = "^"; + break; + + case op_ldiv: + retval = "\\"; + break; + + case op_lshift: + retval = "<<"; + break; + + case op_rshift: + retval = ">>"; + break; + + case op_lt: + retval = "<"; + break; + + case op_le: + retval = "<="; + break; + + case op_eq: + retval = "=="; + break; + + case op_ge: + retval = ">="; + break; + + case op_gt: + retval = ">"; + break; + + case op_ne: + retval = "!="; + break; + + case op_el_mul: + retval = ".*"; + break; + + case op_el_div: + retval = "./"; + break; + + case op_el_pow: + retval = ".^"; + break; + + case op_el_ldiv: + retval = ".\\"; + break; + + case op_el_and: + retval = "&"; + break; + + case op_el_or: + retval = "|"; + break; + + case op_struct_ref: + retval = "."; + break; + + default: + retval = ""; + } + + return retval; +} + +std::string +octave_value::binary_op_fcn_name (binary_op op) +{ + std::string retval; + + switch (op) + { + case op_add: + retval = "plus"; + break; + + case op_sub: + retval = "minus"; + break; + + case op_mul: + retval = "mtimes"; + break; + + case op_div: + retval = "mrdivide"; + break; + + case op_pow: + retval = "mpower"; + break; + + case op_ldiv: + retval = "mldivide"; + break; + + case op_lt: + retval = "lt"; + break; + + case op_le: + retval = "le"; + break; + + case op_eq: + retval = "eq"; + break; + + case op_ge: + retval = "ge"; + break; + + case op_gt: + retval = "gt"; + break; + + case op_ne: + retval = "ne"; + break; + + case op_el_mul: + retval = "times"; + break; + + case op_el_div: + retval = "rdivide"; + break; + + case op_el_pow: + retval = "power"; + break; + + case op_el_ldiv: + retval = "ldivide"; + break; + + case op_el_and: + retval = "and"; + break; + + case op_el_or: + retval = "or"; + break; + + default: + break; + } + + return retval; +} + +std::string +octave_value::binary_op_fcn_name (compound_binary_op op) +{ + std::string retval; + + switch (op) + { + case op_trans_mul: + retval = "transtimes"; + break; + + case op_mul_trans: + retval = "timestrans"; + break; + + case op_herm_mul: + retval = "hermtimes"; + break; + + case op_mul_herm: + retval = "timesherm"; + break; + + case op_trans_ldiv: + retval = "transldiv"; + break; + + case op_herm_ldiv: + retval = "hermldiv"; + break; + + case op_el_and_not: + retval = "andnot"; + break; + + case op_el_or_not: + retval = "ornot"; + break; + + case op_el_not_and: + retval = "notand"; + break; + + case op_el_not_or: + retval = "notor"; + break; + + default: + break; + } + + return retval; +} + +std::string +octave_value::assign_op_as_string (assign_op op) +{ + std::string retval; + + switch (op) + { + case op_asn_eq: + retval = "="; + break; + + case op_add_eq: + retval = "+="; + break; + + case op_sub_eq: + retval = "-="; + break; + + case op_mul_eq: + retval = "*="; + break; + + case op_div_eq: + retval = "/="; + break; + + case op_ldiv_eq: + retval = "\\="; + break; + + case op_pow_eq: + retval = "^="; + break; + + case op_lshift_eq: + retval = "<<="; + break; + + case op_rshift_eq: + retval = ">>="; + break; + + case op_el_mul_eq: + retval = ".*="; + break; + + case op_el_div_eq: + retval = "./="; + break; + + case op_el_ldiv_eq: + retval = ".\\="; + break; + + case op_el_pow_eq: + retval = ".^="; + break; + + case op_el_and_eq: + retval = "&="; + break; + + case op_el_or_eq: + retval = "|="; + break; + + default: + retval = ""; + } + + return retval; +} + +octave_value::assign_op +octave_value::binary_op_to_assign_op (binary_op op) +{ + assign_op retval; + + switch (op) + { + case op_add: + retval = op_add_eq; + break; + case op_sub: + retval = op_sub_eq; + break; + case op_mul: + retval = op_mul_eq; + break; + case op_div: + retval = op_div_eq; + break; + case op_el_mul: + retval = op_el_mul_eq; + break; + case op_el_div: + retval = op_el_div_eq; + break; + case op_el_and: + retval = op_el_and_eq; + break; + case op_el_or: + retval = op_el_or_eq; + break; + default: + retval = unknown_assign_op; + } + + return retval; +} + +octave_value::octave_value (short int i) + : rep (new octave_scalar (i)) +{ +} + +octave_value::octave_value (unsigned short int i) + : rep (new octave_scalar (i)) +{ +} + +octave_value::octave_value (int i) + : rep (new octave_scalar (i)) +{ +} + +octave_value::octave_value (unsigned int i) + : rep (new octave_scalar (i)) +{ +} + +octave_value::octave_value (long int i) + : rep (new octave_scalar (i)) +{ +} + +octave_value::octave_value (unsigned long int i) + : rep (new octave_scalar (i)) +{ +} + +#if defined (HAVE_LONG_LONG_INT) +octave_value::octave_value (long long int i) + : rep (new octave_scalar (i)) +{ +} +#endif + +#if defined (HAVE_UNSIGNED_LONG_LONG_INT) +octave_value::octave_value (unsigned long long int i) + : rep (new octave_scalar (i)) +{ +} +#endif + +octave_value::octave_value (octave_time t) + : rep (new octave_scalar (t.double_value ())) +{ +} + +octave_value::octave_value (double d) + : rep (new octave_scalar (d)) +{ +} + +octave_value::octave_value (float d) + : rep (new octave_float_scalar (d)) +{ +} + +octave_value::octave_value (const Cell& c, bool is_csl) + : rep (is_csl + ? dynamic_cast (new octave_cs_list (c)) + : dynamic_cast (new octave_cell (c))) +{ +} + +octave_value::octave_value (const Array& a, bool is_csl) + : rep (is_csl + ? dynamic_cast (new octave_cs_list (Cell (a))) + : dynamic_cast (new octave_cell (Cell (a)))) +{ +} + +octave_value::octave_value (const Matrix& m, const MatrixType& t) + : rep (new octave_matrix (m, t)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const FloatMatrix& m, const MatrixType& t) + : rep (new octave_float_matrix (m, t)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const NDArray& a) + : rep (new octave_matrix (a)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const FloatNDArray& a) + : rep (new octave_float_matrix (a)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& a) + : rep (new octave_matrix (a)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& a) + : rep (new octave_float_matrix (a)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const DiagMatrix& d) + : rep (new octave_diag_matrix (d)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const FloatDiagMatrix& d) + : rep (new octave_float_diag_matrix (d)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const RowVector& v) + : rep (new octave_matrix (v)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const FloatRowVector& v) + : rep (new octave_float_matrix (v)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const ColumnVector& v) + : rep (new octave_matrix (v)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const FloatColumnVector& v) + : rep (new octave_float_matrix (v)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Complex& C) + : rep (new octave_complex (C)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const FloatComplex& C) + : rep (new octave_float_complex (C)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const ComplexMatrix& m, const MatrixType& t) + : rep (new octave_complex_matrix (m, t)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const FloatComplexMatrix& m, const MatrixType& t) + : rep (new octave_float_complex_matrix (m, t)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const ComplexNDArray& a) + : rep (new octave_complex_matrix (a)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const FloatComplexNDArray& a) + : rep (new octave_float_complex_matrix (a)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& a) + : rep (new octave_complex_matrix (a)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& a) + : rep (new octave_float_complex_matrix (a)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const ComplexDiagMatrix& d) + : rep (new octave_complex_diag_matrix (d)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const FloatComplexDiagMatrix& d) + : rep (new octave_float_complex_diag_matrix (d)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const ComplexRowVector& v) + : rep (new octave_complex_matrix (v)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const FloatComplexRowVector& v) + : rep (new octave_float_complex_matrix (v)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const ComplexColumnVector& v) + : rep (new octave_complex_matrix (v)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const FloatComplexColumnVector& v) + : rep (new octave_float_complex_matrix (v)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const PermMatrix& p) + : rep (new octave_perm_matrix (p)) +{ + maybe_mutate (); +} + +octave_value::octave_value (bool b) + : rep (new octave_bool (b)) +{ +} + +octave_value::octave_value (const boolMatrix& bm, const MatrixType& t) + : rep (new octave_bool_matrix (bm, t)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const boolNDArray& bnda) + : rep (new octave_bool_matrix (bnda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& bnda) + : rep (new octave_bool_matrix (bnda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (char c, char type) + : rep (type == '"' + ? new octave_char_matrix_dq_str (c) + : new octave_char_matrix_sq_str (c)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const char *s, char type) + : rep (type == '"' + ? new octave_char_matrix_dq_str (s) + : new octave_char_matrix_sq_str (s)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const std::string& s, char type) + : rep (type == '"' + ? new octave_char_matrix_dq_str (s) + : new octave_char_matrix_sq_str (s)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const string_vector& s, char type) + : rep (type == '"' + ? new octave_char_matrix_dq_str (s) + : new octave_char_matrix_sq_str (s)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const charMatrix& chm, char type) + : rep (type == '"' + ? new octave_char_matrix_dq_str (chm) + : new octave_char_matrix_sq_str (chm)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const charNDArray& chm, char type) + : rep (type == '"' + ? new octave_char_matrix_dq_str (chm) + : new octave_char_matrix_sq_str (chm)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& chm, char type) + : rep (type == '"' + ? new octave_char_matrix_dq_str (chm) + : new octave_char_matrix_sq_str (chm)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const charMatrix& chm, bool, char type) + : rep (type == '"' + ? new octave_char_matrix_dq_str (chm) + : new octave_char_matrix_sq_str (chm)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const charNDArray& chm, bool, char type) + : rep (type == '"' + ? new octave_char_matrix_dq_str (chm) + : new octave_char_matrix_sq_str (chm)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& chm, bool, char type) + : rep (type == '"' + ? new octave_char_matrix_dq_str (chm) + : new octave_char_matrix_sq_str (chm)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const SparseMatrix& m, const MatrixType &t) + : rep (new octave_sparse_matrix (m, t)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Sparse& m, const MatrixType &t) + : rep (new octave_sparse_matrix (m, t)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const SparseComplexMatrix& m, const MatrixType &t) + : rep (new octave_sparse_complex_matrix (m, t)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Sparse& m, const MatrixType &t) + : rep (new octave_sparse_complex_matrix (m, t)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const SparseBoolMatrix& bm, const MatrixType &t) + : rep (new octave_sparse_bool_matrix (bm, t)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Sparse& bm, const MatrixType &t) + : rep (new octave_sparse_bool_matrix (bm, t)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const octave_int8& i) + : rep (new octave_int8_scalar (i)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const octave_uint8& i) + : rep (new octave_uint8_scalar (i)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const octave_int16& i) + : rep (new octave_int16_scalar (i)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const octave_uint16& i) + : rep (new octave_uint16_scalar (i)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const octave_int32& i) + : rep (new octave_int32_scalar (i)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const octave_uint32& i) + : rep (new octave_uint32_scalar (i)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const octave_int64& i) + : rep (new octave_int64_scalar (i)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const octave_uint64& i) + : rep (new octave_uint64_scalar (i)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const int8NDArray& inda) + : rep (new octave_int8_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& inda) + : rep (new octave_int8_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const uint8NDArray& inda) + : rep (new octave_uint8_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& inda) + : rep (new octave_uint8_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const int16NDArray& inda) + : rep (new octave_int16_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& inda) + : rep (new octave_int16_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const uint16NDArray& inda) + : rep (new octave_uint16_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& inda) + : rep (new octave_uint16_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const int32NDArray& inda) + : rep (new octave_int32_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& inda) + : rep (new octave_int32_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const uint32NDArray& inda) + : rep (new octave_uint32_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& inda) + : rep (new octave_uint32_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const int64NDArray& inda) + : rep (new octave_int64_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& inda) + : rep (new octave_int64_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const uint64NDArray& inda) + : rep (new octave_uint64_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& inda) + : rep (new octave_uint64_matrix (inda)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Array& inda, bool zero_based, + bool cache_index) + : rep (new octave_matrix (inda, zero_based, cache_index)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const idx_vector& idx, bool lazy) + : rep () +{ + double scalar; + Range range; + NDArray array; + boolNDArray mask; + idx_vector::idx_class_type idx_class; + + if (lazy) + { + // Only make lazy indices out of ranges and index vectors. + switch (idx.idx_class ()) + { + case idx_vector::class_range: + case idx_vector::class_vector: + rep = new octave_lazy_index (idx); + maybe_mutate (); + return; + default: + break; + } + } + + idx.unconvert (idx_class, scalar, range, array, mask); + + switch (idx_class) + { + case idx_vector::class_colon: + rep = new octave_magic_colon (); + break; + case idx_vector::class_range: + rep = new octave_range (range, idx); + break; + case idx_vector::class_scalar: + rep = new octave_scalar (scalar); + break; + case idx_vector::class_vector: + rep = new octave_matrix (array, idx); + break; + case idx_vector::class_mask: + rep = new octave_bool_matrix (mask, idx); + break; + default: + assert (false); + break; + } + + // FIXME: needed? + maybe_mutate (); +} + +octave_value::octave_value (const Array& cellstr) + : rep (new octave_cell (cellstr)) +{ + maybe_mutate (); +} + +octave_value::octave_value (double base, double limit, double inc) + : rep (new octave_range (base, limit, inc)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Range& r) + : rep (new octave_range (r)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const octave_map& m) + : rep (new octave_struct (m)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const octave_scalar_map& m) + : rep (new octave_scalar_struct (m)) +{ +} + +octave_value::octave_value (const Octave_map& m) + : rep (new octave_struct (m)) +{ + maybe_mutate (); +} + +octave_value::octave_value (const Octave_map& m, const std::string& id, + const std::list& plist) + : rep (new octave_class (m, id, plist)) +{ +} + +octave_value::octave_value (const octave_value_list& l, bool) + : rep (new octave_cs_list (l)) +{ +} + +octave_value::octave_value (octave_value::magic_colon) + : rep (new octave_magic_colon ()) +{ +} + +octave_value::octave_value (octave_base_value *new_rep, bool borrow) + : rep (new_rep) +{ + if (borrow) + rep->count++; +} + +octave_value::octave_value (octave_base_value *new_rep, int xcount) + : rep (new_rep) +{ + rep->count = xcount; +} + +octave_base_value * +octave_value::clone (void) const +{ + return rep->clone (); +} + +void +octave_value::maybe_mutate (void) +{ + octave_base_value *tmp = rep->try_narrowing_conversion (); + + if (tmp && tmp != rep) + { + if (--rep->count == 0) + delete rep; + + rep = tmp; + } +} + +octave_value +octave_value::single_subsref (const std::string& type, + const octave_value_list& idx) +{ + std::list i; + + i.push_back (idx); + + return rep->subsref (type, i); +} + +octave_value_list +octave_value::subsref (const std::string& type, + const std::list& idx, int nargout) +{ + if (nargout == 1) + return rep->subsref (type, idx); + else + return rep->subsref (type, idx, nargout); +} + +octave_value_list +octave_value::subsref (const std::string& type, + const std::list& idx, int nargout, + const std::list *lvalue_list) +{ + if (lvalue_list) + return rep->subsref (type, idx, nargout, lvalue_list); + else + return subsref (type, idx, nargout); +} + +octave_value +octave_value::next_subsref (const std::string& type, + const std::list& idx, + size_t skip) +{ + if (! error_state && idx.size () > skip) + { + std::list new_idx (idx); + for (size_t i = 0; i < skip; i++) + new_idx.erase (new_idx.begin ()); + return subsref (type.substr (skip), new_idx); + } + else + return *this; +} + +octave_value_list +octave_value::next_subsref (int nargout, const std::string& type, + const std::list& idx, + size_t skip) +{ + if (! error_state && idx.size () > skip) + { + std::list new_idx (idx); + for (size_t i = 0; i < skip; i++) + new_idx.erase (new_idx.begin ()); + return subsref (type.substr (skip), new_idx, nargout); + } + else + return *this; +} + +octave_value +octave_value::next_subsref (bool auto_add, const std::string& type, + const std::list& idx, + size_t skip) +{ + if (! error_state && idx.size () > skip) + { + std::list new_idx (idx); + for (size_t i = 0; i < skip; i++) + new_idx.erase (new_idx.begin ()); + return subsref (type.substr (skip), new_idx, auto_add); + } + else + return *this; +} + +octave_value_list +octave_value::do_multi_index_op (int nargout, const octave_value_list& idx) +{ + return rep->do_multi_index_op (nargout, idx); +} + +octave_value_list +octave_value::do_multi_index_op (int nargout, const octave_value_list& idx, + const std::list *lvalue_list) +{ + return rep->do_multi_index_op (nargout, idx, lvalue_list); +} + +#if 0 +static void +gripe_assign_failed (const std::string& on, const std::string& tn1, + const std::string& tn2) +{ + error ("assignment failed for `%s %s %s'", + tn1.c_str (), on.c_str (), tn2.c_str ()); +} +#endif + +static void +gripe_assign_failed_or_no_method (const std::string& on, + const std::string& tn1, + const std::string& tn2) +{ + error ("assignment failed, or no method for `%s %s %s'", + tn1.c_str (), on.c_str (), tn2.c_str ()); +} + +octave_value +octave_value::subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + return rep->subsasgn (type, idx, rhs); +} + +octave_value +octave_value::undef_subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + return rep->undef_subsasgn (type, idx, rhs); +} + +octave_value& +octave_value::assign (assign_op op, const std::string& type, + const std::list& idx, + const octave_value& rhs) +{ + octave_value retval; + + make_unique (); + + octave_value t_rhs = rhs; + + if (op != op_asn_eq) + { + if (is_defined ()) + { + octave_value t = subsref (type, idx); + + if (! error_state) + { + binary_op binop = op_eq_to_binary_op (op); + + if (! error_state) + t_rhs = do_binary_op (binop, t, rhs); + } + } + else + error ("in computed assignment A(index) OP= X, A must be defined first"); + } + + if (! error_state) + { + octave_value tmp = subsasgn (type, idx, t_rhs); + + if (error_state) + gripe_assign_failed_or_no_method (assign_op_as_string (op_asn_eq), + type_name (), rhs.type_name ()); + else + *this = tmp; + } + + return *this; +} + +octave_value& +octave_value::assign (assign_op op, const octave_value& rhs) +{ + if (op == op_asn_eq) + // Regularize a null matrix if stored into a variable. + operator = (rhs.storable_value ()); + else if (is_defined ()) + { + octave_value_typeinfo::assign_op_fcn f = 0; + + // Only attempt to operate in-place if this variable is unshared. + if (rep->count == 1) + { + int tthis = this->type_id (); + int trhs = rhs.type_id (); + + f = octave_value_typeinfo::lookup_assign_op (op, tthis, trhs); + } + + if (f) + { + try + { + f (*rep, octave_value_list (), *rhs.rep); + maybe_mutate (); // Usually unnecessary, but may be needed (complex arrays). + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + else + { + + binary_op binop = op_eq_to_binary_op (op); + + if (! error_state) + { + octave_value t = do_binary_op (binop, *this, rhs); + + if (! error_state) + operator = (t); + } + } + } + else + error ("in computed assignment A OP= X, A must be defined first"); + + return *this; +} + +octave_idx_type +octave_value::length (void) const +{ + octave_idx_type retval = 0; + + const dim_vector dv = dims (); + + for (int i = 0; i < dv.length (); i++) + { + if (dv(i) == 0) + { + retval = 0; + break; + } + + if (dv(i) > retval) + retval = dv(i); + } + + return retval; +} + +bool +octave_value::is_equal (const octave_value& test) const +{ + bool retval = false; + + // If there is no op_eq for these types, we can't compare values. + + if (rows () == test.rows () && columns () == test.columns ()) + { + octave_value tmp = do_binary_op (octave_value::op_eq, *this, test); + + // Empty array also means a match. + if (! error_state && tmp.is_defined ()) + retval = tmp.is_true () || tmp.is_empty (); + } + + return retval; +} + +Cell +octave_value::cell_value (void) const +{ + return rep->cell_value (); +} + +// Define the idx_type_value function here instead of in ov.h to avoid +// needing definitions for the SIZEOF_X macros in ov.h. + +octave_idx_type +octave_value::idx_type_value (bool req_int, bool frc_str_conv) const +{ +#if SIZEOF_OCTAVE_IDX_TYPE == SIZEOF_LONG + return long_value (req_int, frc_str_conv); +#elif SIZEOF_OCTAVE_IDX_TYPE == SIZEOF_INT + return int_value (req_int, frc_str_conv); +#else +#error "no octave_value extractor for octave_idx_type" +#endif +} + +octave_map +octave_value::map_value (void) const +{ + return rep->map_value (); +} + +octave_scalar_map +octave_value::scalar_map_value (void) const +{ + return rep->scalar_map_value (); +} + +octave_function * +octave_value::function_value (bool silent) const +{ + return rep->function_value (silent); +} + +octave_user_function * +octave_value::user_function_value (bool silent) const +{ + return rep->user_function_value (silent); +} + +octave_user_script * +octave_value::user_script_value (bool silent) const +{ + return rep->user_script_value (silent); +} + +octave_user_code * +octave_value::user_code_value (bool silent) const +{ + return rep->user_code_value (silent); +} + +octave_fcn_handle * +octave_value::fcn_handle_value (bool silent) const +{ + return rep->fcn_handle_value (silent); +} + +octave_fcn_inline * +octave_value::fcn_inline_value (bool silent) const +{ + return rep->fcn_inline_value (silent); +} + +octave_value_list +octave_value::list_value (void) const +{ + return rep->list_value (); +} + +static dim_vector +make_vector_dims (const dim_vector& dv, bool force_vector_conversion, + const std::string& my_type, const std::string& wanted_type) +{ + dim_vector retval (dv); + retval.chop_trailing_singletons (); + octave_idx_type nel = dv.numel (); + + if (retval.length () > 2 || (retval(0) != 1 && retval(1) != 1)) + { + if (!force_vector_conversion) + gripe_implicit_conversion ("Octave:array-to-vector", + my_type.c_str (), wanted_type.c_str ()); + retval = dim_vector (nel, 1); + } + + return retval; +} + +ColumnVector +octave_value::column_vector_value (bool force_string_conv, + bool frc_vec_conv) const +{ + return ColumnVector (vector_value (force_string_conv, + frc_vec_conv)); +} + +ComplexColumnVector +octave_value::complex_column_vector_value (bool force_string_conv, + bool frc_vec_conv) const +{ + return ComplexColumnVector (complex_vector_value (force_string_conv, + frc_vec_conv)); +} + +RowVector +octave_value::row_vector_value (bool force_string_conv, + bool frc_vec_conv) const +{ + return RowVector (vector_value (force_string_conv, + frc_vec_conv)); +} + +ComplexRowVector +octave_value::complex_row_vector_value (bool force_string_conv, + bool frc_vec_conv) const +{ + return ComplexRowVector (complex_vector_value (force_string_conv, + frc_vec_conv)); +} + +Array +octave_value::vector_value (bool force_string_conv, + bool force_vector_conversion) const +{ + Array retval = array_value (force_string_conv); + + if (error_state) + return retval; + else + return retval.reshape (make_vector_dims (retval.dims (), + force_vector_conversion, + type_name (), "real vector")); +} + +template +static Array +convert_to_int_array (const Array >& A) +{ + Array retval (A.dims ()); + octave_idx_type n = A.numel (); + + for (octave_idx_type i = 0; i < n; i++) + retval.xelem (i) = octave_int (A.xelem (i)); + + return retval; +} + +Array +octave_value::int_vector_value (bool force_string_conv, bool require_int, + bool force_vector_conversion) const +{ + Array retval; + + if (is_integer_type ()) + { + if (is_int32_type ()) + retval = convert_to_int_array (int32_array_value ()); + else if (is_int64_type ()) + retval = convert_to_int_array (int64_array_value ()); + else if (is_int16_type ()) + retval = convert_to_int_array (int16_array_value ()); + else if (is_int8_type ()) + retval = convert_to_int_array (int8_array_value ()); + else if (is_uint32_type ()) + retval = convert_to_int_array (uint32_array_value ()); + else if (is_uint64_type ()) + retval = convert_to_int_array (uint64_array_value ()); + else if (is_uint16_type ()) + retval = convert_to_int_array (uint16_array_value ()); + else if (is_uint8_type ()) + retval = convert_to_int_array (uint8_array_value ()); + else + retval = array_value (force_string_conv); + } + else + { + const NDArray a = array_value (force_string_conv); + if (! error_state) + { + if (require_int) + { + retval.resize (a.dims ()); + for (octave_idx_type i = 0; i < a.numel (); i++) + { + double ai = a.elem (i); + int v = static_cast (ai); + if (ai == v) + retval.xelem (i) = v; + else + { + error_with_cfn ("conversion to integer value failed"); + break; + } + } + } + else + retval = Array (a); + } + } + + + if (error_state) + return retval; + else + return retval.reshape (make_vector_dims (retval.dims (), + force_vector_conversion, + type_name (), "integer vector")); +} + +template +static Array +convert_to_octave_idx_type_array (const Array >& A) +{ + Array retval (A.dims ()); + octave_idx_type n = A.numel (); + + for (octave_idx_type i = 0; i < n; i++) + retval.xelem (i) = octave_int (A.xelem (i)); + + return retval; +} + +Array +octave_value::octave_idx_type_vector_value (bool require_int, + bool force_string_conv, + bool force_vector_conversion) const +{ + Array retval; + + if (is_integer_type ()) + { + if (is_int32_type ()) + retval = convert_to_octave_idx_type_array (int32_array_value ()); + else if (is_int64_type ()) + retval = convert_to_octave_idx_type_array (int64_array_value ()); + else if (is_int16_type ()) + retval = convert_to_octave_idx_type_array (int16_array_value ()); + else if (is_int8_type ()) + retval = convert_to_octave_idx_type_array (int8_array_value ()); + else if (is_uint32_type ()) + retval = convert_to_octave_idx_type_array (uint32_array_value ()); + else if (is_uint64_type ()) + retval = convert_to_octave_idx_type_array (uint64_array_value ()); + else if (is_uint16_type ()) + retval = convert_to_octave_idx_type_array (uint16_array_value ()); + else if (is_uint8_type ()) + retval = convert_to_octave_idx_type_array (uint8_array_value ()); + else + retval = array_value (force_string_conv); + } + else + { + const NDArray a = array_value (force_string_conv); + if (! error_state) + { + if (require_int) + { + retval.resize (a.dims ()); + for (octave_idx_type i = 0; i < a.numel (); i++) + { + double ai = a.elem (i); + octave_idx_type v = static_cast (ai); + if (ai == v) + retval.xelem (i) = v; + else + { + error_with_cfn ("conversion to integer value failed"); + break; + } + } + } + else + retval = Array (a); + } + } + + + if (error_state) + return retval; + else + return retval.reshape (make_vector_dims (retval.dims (), + force_vector_conversion, + type_name (), "integer vector")); +} + +Array +octave_value::complex_vector_value (bool force_string_conv, + bool force_vector_conversion) const +{ + Array retval = complex_array_value (force_string_conv); + + if (error_state) + return retval; + else + return retval.reshape (make_vector_dims (retval.dims (), + force_vector_conversion, + type_name (), "complex vector")); +} + +FloatColumnVector +octave_value::float_column_vector_value (bool force_string_conv, + bool frc_vec_conv) const +{ + return FloatColumnVector (float_vector_value (force_string_conv, + frc_vec_conv)); +} + +FloatComplexColumnVector +octave_value::float_complex_column_vector_value (bool force_string_conv, + bool frc_vec_conv) const +{ + return FloatComplexColumnVector (float_complex_vector_value (force_string_conv, + frc_vec_conv)); +} + +FloatRowVector +octave_value::float_row_vector_value (bool force_string_conv, + bool frc_vec_conv) const +{ + return FloatRowVector (float_vector_value (force_string_conv, + frc_vec_conv)); +} + +FloatComplexRowVector +octave_value::float_complex_row_vector_value (bool force_string_conv, + bool frc_vec_conv) const +{ + return FloatComplexRowVector (float_complex_vector_value (force_string_conv, + frc_vec_conv)); +} + +Array +octave_value::float_vector_value (bool force_string_conv, + bool force_vector_conversion) const +{ + Array retval = float_array_value (force_string_conv); + + if (error_state) + return retval; + else + return retval.reshape (make_vector_dims (retval.dims (), + force_vector_conversion, + type_name (), "real vector")); +} + +Array +octave_value::float_complex_vector_value (bool force_string_conv, + bool force_vector_conversion) const +{ + Array retval = float_complex_array_value (force_string_conv); + + if (error_state) + return retval; + else + return retval.reshape (make_vector_dims (retval.dims (), + force_vector_conversion, + type_name (), "complex vector")); +} + +octave_value +octave_value::storable_value (void) const +{ + octave_value retval = *this; + if (is_null_value ()) + retval = octave_value (rep->empty_clone ()); + else + retval.maybe_economize (); + + return retval; +} + +void +octave_value::make_storable_value (void) +{ + if (is_null_value ()) + { + octave_base_value *rc = rep->empty_clone (); + if (--rep->count == 0) + delete rep; + rep = rc; + } + else + maybe_economize (); +} + +int +octave_value::write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const +{ + return rep->write (os, block_size, output_type, skip, flt_fmt); +} + +static void +gripe_binary_op (const std::string& on, const std::string& tn1, + const std::string& tn2) +{ + error ("binary operator `%s' not implemented for `%s' by `%s' operations", + on.c_str (), tn1.c_str (), tn2.c_str ()); +} + +static void +gripe_binary_op_conv (const std::string& on) +{ + error ("type conversion failed for binary operator `%s'", on.c_str ()); +} + +octave_value +do_binary_op (octave_value::binary_op op, + const octave_value& v1, const octave_value& v2) +{ + octave_value retval; + + int t1 = v1.type_id (); + int t2 = v2.type_id (); + + if (t1 == octave_class::static_type_id () + || t2 == octave_class::static_type_id ()) + { + octave_value_typeinfo::binary_class_op_fcn f + = octave_value_typeinfo::lookup_binary_class_op (op); + + if (f) + { + try + { + retval = f (v1, v2); + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + else + gripe_binary_op (octave_value::binary_op_as_string (op), + v1.class_name (), v2.class_name ()); + } + else + { + // FIXME -- we need to handle overloading operators for built-in + // classes (double, char, int8, etc.) + + octave_value_typeinfo::binary_op_fcn f + = octave_value_typeinfo::lookup_binary_op (op, t1, t2); + + if (f) + { + try + { + retval = f (*v1.rep, *v2.rep); + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + else + { + octave_value tv1; + octave_base_value::type_conv_info cf1 = v1.numeric_conversion_function (); + + octave_value tv2; + octave_base_value::type_conv_info cf2 = v2.numeric_conversion_function (); + + // Try biased (one-sided) conversions first. + if (cf2.type_id () >= 0 && + octave_value_typeinfo::lookup_binary_op (op, t1, cf2.type_id ())) + cf1 = 0; + else if (cf1.type_id () >= 0 && + octave_value_typeinfo::lookup_binary_op (op, cf1.type_id (), t2)) + cf2 = 0; + + if (cf1) + { + octave_base_value *tmp = cf1 (*v1.rep); + + if (tmp) + { + tv1 = octave_value (tmp); + t1 = tv1.type_id (); + } + else + { + gripe_binary_op_conv (octave_value::binary_op_as_string (op)); + return retval; + } + } + else + tv1 = v1; + + if (cf2) + { + octave_base_value *tmp = cf2 (*v2.rep); + + if (tmp) + { + tv2 = octave_value (tmp); + t2 = tv2.type_id (); + } + else + { + gripe_binary_op_conv (octave_value::binary_op_as_string (op)); + return retval; + } + } + else + tv2 = v2; + + if (cf1 || cf2) + { + retval = do_binary_op (op, tv1, tv2); + } + else + { + //demote double -> single and try again + cf1 = tv1.numeric_demotion_function (); + + cf2 = tv2.numeric_demotion_function (); + + // Try biased (one-sided) conversions first. + if (cf2.type_id () >= 0 + && octave_value_typeinfo::lookup_binary_op (op, t1, cf2.type_id ())) + cf1 = 0; + else if (cf1.type_id () >= 0 + && octave_value_typeinfo::lookup_binary_op (op, cf1.type_id (), t2)) + cf2 = 0; + + if (cf1) + { + octave_base_value *tmp = cf1 (*tv1.rep); + + if (tmp) + { + tv1 = octave_value (tmp); + t1 = tv1.type_id (); + } + else + { + gripe_binary_op_conv (octave_value::binary_op_as_string (op)); + return retval; + } + } + + if (cf2) + { + octave_base_value *tmp = cf2 (*tv2.rep); + + if (tmp) + { + tv2 = octave_value (tmp); + t2 = tv2.type_id (); + } + else + { + gripe_binary_op_conv (octave_value::binary_op_as_string (op)); + return retval; + } + } + + if (cf1 || cf2) + { + f = octave_value_typeinfo::lookup_binary_op (op, t1, t2); + + if (f) + { + try + { + retval = f (*tv1.rep, *tv2.rep); + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + else + gripe_binary_op (octave_value::binary_op_as_string (op), + v1.type_name (), v2.type_name ()); + } + else + gripe_binary_op (octave_value::binary_op_as_string (op), + v1.type_name (), v2.type_name ()); + } + } + } + + return retval; +} + +static octave_value +decompose_binary_op (octave_value::compound_binary_op op, + const octave_value& v1, const octave_value& v2) +{ + octave_value retval; + + switch (op) + { + case octave_value::op_trans_mul: + retval = do_binary_op (octave_value::op_mul, + do_unary_op (octave_value::op_transpose, v1), + v2); + break; + case octave_value::op_mul_trans: + retval = do_binary_op (octave_value::op_mul, + v1, + do_unary_op (octave_value::op_transpose, v2)); + break; + case octave_value::op_herm_mul: + retval = do_binary_op (octave_value::op_mul, + do_unary_op (octave_value::op_hermitian, v1), + v2); + break; + case octave_value::op_mul_herm: + retval = do_binary_op (octave_value::op_mul, + v1, + do_unary_op (octave_value::op_hermitian, v2)); + break; + case octave_value::op_trans_ldiv: + retval = do_binary_op (octave_value::op_ldiv, + do_unary_op (octave_value::op_transpose, v1), + v2); + break; + case octave_value::op_herm_ldiv: + retval = do_binary_op (octave_value::op_ldiv, + do_unary_op (octave_value::op_hermitian, v1), + v2); + break; + case octave_value::op_el_not_and: + retval = do_binary_op (octave_value::op_el_and, + do_unary_op (octave_value::op_not, v1), + v2); + break; + case octave_value::op_el_not_or: + retval = do_binary_op (octave_value::op_el_or, + do_unary_op (octave_value::op_not, v1), + v2); + break; + case octave_value::op_el_and_not: + retval = do_binary_op (octave_value::op_el_and, + v1, + do_unary_op (octave_value::op_not, v2)); + break; + case octave_value::op_el_or_not: + retval = do_binary_op (octave_value::op_el_or, + v1, + do_unary_op (octave_value::op_not, v2)); + break; + default: + error ("invalid compound operator"); + break; + } + + return retval; +} + +octave_value +do_binary_op (octave_value::compound_binary_op op, + const octave_value& v1, const octave_value& v2) +{ + octave_value retval; + + int t1 = v1.type_id (); + int t2 = v2.type_id (); + + if (t1 == octave_class::static_type_id () + || t2 == octave_class::static_type_id ()) + { + octave_value_typeinfo::binary_class_op_fcn f + = octave_value_typeinfo::lookup_binary_class_op (op); + + if (f) + { + try + { + retval = f (v1, v2); + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + else + retval = decompose_binary_op (op, v1, v2); + } + else + { + octave_value_typeinfo::binary_op_fcn f + = octave_value_typeinfo::lookup_binary_op (op, t1, t2); + + if (f) + { + try + { + retval = f (*v1.rep, *v2.rep); + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + else + retval = decompose_binary_op (op, v1, v2); + } + + return retval; +} + +static void +gripe_cat_op (const std::string& tn1, const std::string& tn2) +{ + error ("concatenation operator not implemented for `%s' by `%s' operations", + tn1.c_str (), tn2.c_str ()); +} + +static void +gripe_cat_op_conv (void) +{ + error ("type conversion failed for concatenation operator"); +} + +octave_value +do_cat_op (const octave_value& v1, const octave_value& v2, + const Array& ra_idx) +{ + octave_value retval; + + // Can't rapid return for concatenation with an empty object here as + // something like cat(1,[],single([]) must return the correct type. + + int t1 = v1.type_id (); + int t2 = v2.type_id (); + + octave_value_typeinfo::cat_op_fcn f + = octave_value_typeinfo::lookup_cat_op (t1, t2); + + if (f) + { + try + { + retval = f (*v1.rep, *v2.rep, ra_idx); + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + else + { + octave_value tv1; + octave_base_value::type_conv_info cf1 = v1.numeric_conversion_function (); + + octave_value tv2; + octave_base_value::type_conv_info cf2 = v2.numeric_conversion_function (); + + // Try biased (one-sided) conversions first. + if (cf2.type_id () >= 0 + && octave_value_typeinfo::lookup_cat_op (t1, cf2.type_id ())) + cf1 = 0; + else if (cf1.type_id () >= 0 + && octave_value_typeinfo::lookup_cat_op (cf1.type_id (), t2)) + cf2 = 0; + + if (cf1) + { + octave_base_value *tmp = cf1 (*v1.rep); + + if (tmp) + { + tv1 = octave_value (tmp); + t1 = tv1.type_id (); + } + else + { + gripe_cat_op_conv (); + return retval; + } + } + else + tv1 = v1; + + if (cf2) + { + octave_base_value *tmp = cf2 (*v2.rep); + + if (tmp) + { + tv2 = octave_value (tmp); + t2 = tv2.type_id (); + } + else + { + gripe_cat_op_conv (); + return retval; + } + } + else + tv2 = v2; + + if (cf1 || cf2) + { + retval = do_cat_op (tv1, tv2, ra_idx); + } + else + gripe_cat_op (v1.type_name (), v2.type_name ()); + } + + return retval; +} + +void +octave_value::print_info (std::ostream& os, const std::string& prefix) const +{ + os << prefix << "type_name: " << type_name () << "\n" + << prefix << "count: " << get_count () << "\n" + << prefix << "rep info: "; + + rep->print_info (os, prefix + " "); +} + +static void +gripe_unary_op (const std::string& on, const std::string& tn) +{ + error ("unary operator `%s' not implemented for `%s' operands", + on.c_str (), tn.c_str ()); +} + +static void +gripe_unary_op_conv (const std::string& on) +{ + error ("type conversion failed for unary operator `%s'", on.c_str ()); +} + +octave_value +do_unary_op (octave_value::unary_op op, const octave_value& v) +{ + octave_value retval; + + int t = v.type_id (); + + if (t == octave_class::static_type_id ()) + { + octave_value_typeinfo::unary_class_op_fcn f + = octave_value_typeinfo::lookup_unary_class_op (op); + + if (f) + { + try + { + retval = f (v); + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + else + gripe_unary_op (octave_value::unary_op_as_string (op), + v.class_name ()); + } + else + { + // FIXME -- we need to handle overloading operators for built-in + // classes (double, char, int8, etc.) + + octave_value_typeinfo::unary_op_fcn f + = octave_value_typeinfo::lookup_unary_op (op, t); + + if (f) + { + try + { + retval = f (*v.rep); + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + else + { + octave_value tv; + octave_base_value::type_conv_fcn cf + = v.numeric_conversion_function (); + + if (cf) + { + octave_base_value *tmp = cf (*v.rep); + + if (tmp) + { + tv = octave_value (tmp); + retval = do_unary_op (op, tv); + } + else + gripe_unary_op_conv (octave_value::unary_op_as_string (op)); + } + else + gripe_unary_op (octave_value::unary_op_as_string (op), + v.type_name ()); + } + } + + return retval; +} + +static void +gripe_unary_op_conversion_failed (const std::string& op, + const std::string& tn) +{ + error ("operator %s: type conversion for `%s' failed", + op.c_str (), tn.c_str ()); +} + +octave_value& +octave_value::do_non_const_unary_op (unary_op op) +{ + if (op == op_incr || op == op_decr) + { + // We want the gripe just here, because in the other branch this should + // not happen, and if it did anyway (internal error), the message would + // be confusing. + if (is_undefined ()) + { + std::string op_str = unary_op_as_string (op); + error ("in x%s or %sx, x must be defined first", + op_str.c_str (), op_str.c_str ()); + return *this; + } + + // Genuine. + int t = type_id (); + + octave_value_typeinfo::non_const_unary_op_fcn f + = octave_value_typeinfo::lookup_non_const_unary_op (op, t); + + if (f) + { + make_unique (); + + try + { + f (*rep); + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + else + { + octave_base_value::type_conv_fcn cf = numeric_conversion_function (); + + if (cf) + { + octave_base_value *tmp = cf (*rep); + + if (tmp) + { + octave_base_value *old_rep = rep; + rep = tmp; + + t = type_id (); + + f = octave_value_typeinfo::lookup_non_const_unary_op (op, t); + + if (f) + { + try + { + f (*rep); + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + + if (old_rep && --old_rep->count == 0) + delete old_rep; + } + else + { + if (old_rep) + { + if (--rep->count == 0) + delete rep; + + rep = old_rep; + } + + gripe_unary_op (octave_value::unary_op_as_string (op), + type_name ()); + } + } + else + gripe_unary_op_conversion_failed + (octave_value::unary_op_as_string (op), type_name ()); + } + else + gripe_unary_op (octave_value::unary_op_as_string (op), type_name ()); + } + } + else + { + // Non-genuine. + int t = type_id (); + + octave_value_typeinfo::non_const_unary_op_fcn f = 0; + + // Only attempt to operate in-place if this variable is unshared. + if (rep->count == 1) + f = octave_value_typeinfo::lookup_non_const_unary_op (op, t); + + if (f) + { + try + { + f (*rep); + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } + else + *this = do_unary_op (op, *this); + } + + return *this; +} + +octave_value& +octave_value::do_non_const_unary_op (unary_op op, const std::string& type, + const std::list& idx) +{ + if (idx.empty ()) + do_non_const_unary_op (op); + else + { + // FIXME -- only do the following stuff if we can't find a + // specific function to call to handle the op= operation for the + // types we have. + + assign_op assop = unary_op_to_assign_op (op); + + assign (assop, type, idx, 1.0); + } + + return *this; +} + +octave_value::assign_op +octave_value::unary_op_to_assign_op (unary_op op) +{ + assign_op binop = unknown_assign_op; + + switch (op) + { + case op_incr: + binop = op_add_eq; + break; + + case op_decr: + binop = op_sub_eq; + break; + + default: + { + std::string on = unary_op_as_string (op); + error ("operator %s: no assign operator found", on.c_str ()); + } + } + + return binop; +} + +octave_value::binary_op +octave_value::op_eq_to_binary_op (assign_op op) +{ + binary_op binop = unknown_binary_op; + + switch (op) + { + case op_add_eq: + binop = op_add; + break; + + case op_sub_eq: + binop = op_sub; + break; + + case op_mul_eq: + binop = op_mul; + break; + + case op_div_eq: + binop = op_div; + break; + + case op_ldiv_eq: + binop = op_ldiv; + break; + + case op_pow_eq: + binop = op_pow; + break; + + case op_lshift_eq: + binop = op_lshift; + break; + + case op_rshift_eq: + binop = op_rshift; + break; + + case op_el_mul_eq: + binop = op_el_mul; + break; + + case op_el_div_eq: + binop = op_el_div; + break; + + case op_el_ldiv_eq: + binop = op_el_ldiv; + break; + + case op_el_pow_eq: + binop = op_el_pow; + break; + + case op_el_and_eq: + binop = op_el_and; + break; + + case op_el_or_eq: + binop = op_el_or; + break; + + default: + { + std::string on = assign_op_as_string (op); + error ("operator %s: no binary operator found", on.c_str ()); + } + } + + return binop; +} + +octave_value +octave_value::empty_conv (const std::string& type, const octave_value& rhs) +{ + octave_value retval; + + if (type.length () > 0) + { + switch (type[0]) + { + case '(': + { + if (type.length () > 1 && type[1] == '.') + retval = octave_map (); + else + retval = octave_value (rhs.empty_clone ()); + } + break; + + case '{': + retval = Cell (); + break; + + case '.': + retval = octave_scalar_map (); + break; + + default: + panic_impossible (); + } + } + else + retval = octave_value (rhs.empty_clone ()); + + return retval; +} + +void +install_types (void) +{ + octave_base_value::register_type (); + octave_cell::register_type (); + octave_scalar::register_type (); + octave_complex::register_type (); + octave_matrix::register_type (); + octave_diag_matrix::register_type (); + octave_complex_matrix::register_type (); + octave_complex_diag_matrix::register_type (); + octave_range::register_type (); + octave_bool::register_type (); + octave_bool_matrix::register_type (); + octave_char_matrix_str::register_type (); + octave_char_matrix_sq_str::register_type (); + octave_int8_scalar::register_type (); + octave_int16_scalar::register_type (); + octave_int32_scalar::register_type (); + octave_int64_scalar::register_type (); + octave_uint8_scalar::register_type (); + octave_uint16_scalar::register_type (); + octave_uint32_scalar::register_type (); + octave_uint64_scalar::register_type (); + octave_int8_matrix::register_type (); + octave_int16_matrix::register_type (); + octave_int32_matrix::register_type (); + octave_int64_matrix::register_type (); + octave_uint8_matrix::register_type (); + octave_uint16_matrix::register_type (); + octave_uint32_matrix::register_type (); + octave_uint64_matrix::register_type (); + octave_sparse_bool_matrix::register_type (); + octave_sparse_matrix::register_type (); + octave_sparse_complex_matrix::register_type (); + octave_struct::register_type (); + octave_scalar_struct::register_type (); + octave_class::register_type (); + octave_cs_list::register_type (); + octave_magic_colon::register_type (); + octave_builtin::register_type (); + octave_user_function::register_type (); + octave_dld_function::register_type (); + octave_fcn_handle::register_type (); + octave_fcn_inline::register_type (); + octave_float_scalar::register_type (); + octave_float_complex::register_type (); + octave_float_matrix::register_type (); + octave_float_diag_matrix::register_type (); + octave_float_complex_matrix::register_type (); + octave_float_complex_diag_matrix::register_type (); + octave_perm_matrix::register_type (); + octave_null_matrix::register_type (); + octave_null_str::register_type (); + octave_null_sq_str::register_type (); + octave_lazy_index::register_type (); + octave_oncleanup::register_type (); +} + +DEFUN (sizeof, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sizeof (@var{val})\n\ +Return the size of @var{val} in bytes.\n\ +@seealso{whos}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).byte_size (); + else + print_usage (); + + return retval; +} + +/* +%!assert (sizeof (uint64 (ones (3))), 72) +%!assert (sizeof (double (zeros (2,4))), 64) +%!assert (sizeof ({"foo", "bar", "baaz"}), 10) +*/ + +static void +decode_subscripts (const char* name, const octave_value& arg, + std::string& type_string, + std::list& idx) +{ + const octave_map m = arg.map_value (); + + if (! error_state + && m.nfields () == 2 && m.contains ("type") && m.contains ("subs")) + { + octave_idx_type nel = m.numel (); + + type_string = std::string (nel, '\0'); + idx = std::list (); + + if (nel == 0) + return; + + const Cell type = m.contents ("type"); + const Cell subs = m.contents ("subs"); + + for (int k = 0; k < nel; k++) + { + std::string item = type(k).string_value (); + + if (! error_state) + { + if (item == "{}") + type_string[k] = '{'; + else if (item == "()") + type_string[k] = '('; + else if (item == ".") + type_string[k] = '.'; + else + { + error ("%s: invalid indexing type `%s'", name, item.c_str ()); + return; + } + } + else + { + error ("%s: expecting type(%d) to be a character string", + name, k+1); + return; + } + + octave_value_list idx_item; + + if (subs(k).is_string ()) + idx_item(0) = subs(k); + else if (subs(k).is_cell ()) + { + Cell subs_cell = subs(k).cell_value (); + + for (int n = 0; n < subs_cell.length (); n++) + { + if (subs_cell(n).is_string () + && subs_cell(n).string_value () == ":") + idx_item(n) = octave_value(octave_value::magic_colon_t); + else + idx_item(n) = subs_cell(n); + } + } + else + { + error ("%s: expecting subs(%d) to be a character string or cell array", + name, k+1); + return; + } + + idx.push_back (idx_item); + } + } + else + error ("%s: second argument must be a structure with fields `type' and `subs'", name); +} + +DEFUN (subsref, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} subsref (@var{val}, @var{idx})\n\ +Perform the subscripted element selection operation according to\n\ +the subscript specified by @var{idx}.\n\ +\n\ +The subscript @var{idx} is expected to be a structure array with\n\ +fields @samp{type} and @samp{subs}. Valid values for @samp{type}\n\ +are @samp{\"()\"}, @samp{\"@{@}\"}, and @samp{\".\"}.\n\ +The @samp{subs} field may be either @samp{\":\"} or a cell array\n\ +of index values.\n\ +\n\ +The following example shows how to extract the two first columns of\n\ +a matrix\n\ +\n\ +@example\n\ +@group\n\ +val = magic (3)\n\ + @result{} val = [ 8 1 6\n\ + 3 5 7\n\ + 4 9 2 ]\n\ +idx.type = \"()\";\n\ +idx.subs = @{\":\", 1:2@};\n\ +subsref (val, idx)\n\ + @result{} [ 8 1\n\ + 3 5\n\ + 4 9 ]\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Note that this is the same as writing @code{val(:,1:2)}.\n\ +\n\ +If @var{idx} is an empty structure array with fields @samp{type}\n\ +and @samp{subs}, return @var{val}.\n\ +@seealso{subsasgn, substruct}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 2) + { + std::string type; + std::list idx; + + decode_subscripts ("subsref", args(1), type, idx); + + if (! error_state) + { + octave_value arg0 = args(0); + + if (type.empty ()) + retval = arg0; + else + retval = arg0.subsref (type, idx, nargout); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (subsasgn, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} subsasgn (@var{val}, @var{idx}, @var{rhs})\n\ +Perform the subscripted assignment operation according to\n\ +the subscript specified by @var{idx}.\n\ +\n\ +The subscript @var{idx} is expected to be a structure array with\n\ +fields @samp{type} and @samp{subs}. Valid values for @samp{type}\n\ +are @samp{\"()\"}, @samp{\"@{@}\"}, and @samp{\".\"}.\n\ +The @samp{subs} field may be either @samp{\":\"} or a cell array\n\ +of index values.\n\ +\n\ +The following example shows how to set the two first columns of a\n\ +3-by-3 matrix to zero.\n\ +\n\ +@example\n\ +@group\n\ +val = magic (3);\n\ +idx.type = \"()\";\n\ +idx.subs = @{\":\", 1:2@};\n\ +subsasgn (val, idx, 0)\n\ + @result{} [ 0 0 6\n\ + 0 0 7\n\ + 0 0 2 ]\n\ +@end group\n\ +@end example\n\ +\n\ +Note that this is the same as writing @code{val(:,1:2) = 0}.\n\ +\n\ +If @var{idx} is an empty structure array with fields @samp{type}\n\ +and @samp{subs}, return @var{rhs}.\n\ +@seealso{subsref, substruct}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 3) + { + std::string type; + std::list idx; + + decode_subscripts ("subsasgn", args(1), type, idx); + + if (! error_state) + { + if (type.empty ()) + { + // Regularize a null matrix if stored into a variable. + + retval = args(2).storable_value (); + } + else + { + octave_value arg0 = args(0); + + arg0.make_unique (); + + if (! error_state) + retval= arg0.subsasgn (type, idx, args(2)); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = reshape ([1:25], 5,5); +%! idx1 = substruct ("()", {3, 3}); +%! idx2 = substruct ("()", {2:2:5, 2:2:5}); +%! idx3 = substruct ("()", {":", [1,5]}); +%! idx4 = struct ("type", {}, "subs", {}); +%! assert (subsref (a, idx1), 13); +%! assert (subsref (a, idx2), [7 17; 9 19]); +%! assert (subsref (a, idx3), [1:5; 21:25]'); +%! assert (subsref (a, idx4), a); +%! a = subsasgn (a, idx1, 0); +%! a = subsasgn (a, idx2, 0); +%! a = subsasgn (a, idx3, 0); +%!# a = subsasgn (a, idx4, 0); +%! b = [0 6 11 16 0 +%! 0 0 12 0 0 +%! 0 8 0 18 0 +%! 0 0 14 0 0 +%! 0 10 15 20 0]; +%! assert (a, b); + +%!test +%! c = num2cell (reshape ([1:25],5,5)); +%! idx1 = substruct ("{}", {3, 3}); +%! idx2 = substruct ("()", {2:2:5, 2:2:5}); +%! idx3 = substruct ("()", {":", [1,5]}); +%! idx2p = substruct ("{}", {2:2:5, 2:2:5}); +%! idx3p = substruct ("{}", {":", [1,5]}); +%! idx4 = struct ("type", {}, "subs", {}); +%! assert ({ subsref(c, idx1) }, {13}); +%! assert ({ subsref(c, idx2p) }, {7 9 17 19}); +%! assert ({ subsref(c, idx3p) }, num2cell ([1:5, 21:25])); +%! assert (subsref (c, idx4), c); +%! c = subsasgn (c, idx1, 0); +%! c = subsasgn (c, idx2, 0); +%! c = subsasgn (c, idx3, 0); +%!# c = subsasgn (c, idx4, 0); +%! d = {0 6 11 16 0 +%! 0 0 12 0 0 +%! 0 8 0 18 0 +%! 0 0 14 0 0 +%! 0 10 15 20 0}; +%! assert (c, d); + +%!test +%! s.a = "ohai"; +%! s.b = "dere"; +%! s.c = 42; +%! idx1 = substruct (".", "a"); +%! idx2 = substruct (".", "b"); +%! idx3 = substruct (".", "c"); +%! idx4 = struct ("type", {}, "subs", {}); +%! assert (subsref (s, idx1), "ohai"); +%! assert (subsref (s, idx2), "dere"); +%! assert (subsref (s, idx3), 42); +%! assert (subsref (s, idx4), s); +%! s = subsasgn (s, idx1, "Hello"); +%! s = subsasgn (s, idx2, "There"); +%! s = subsasgn (s, idx3, 163); +%!# s = subsasgn (s, idx4, 163); +%! t.a = "Hello"; +%! t.b = "There"; +%! t.c = 163; +%! assert (s, t); +*/ + +DEFUN (is_sq_string, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_sq_string (@var{x})\n\ +Return true if @var{x} is a single-quoted character string.\n\ +@seealso{is_dq_string, ischar}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_sq_string (); + else + print_usage (); + + return retval; +} + +/* +%!assert (is_sq_string ('foo'), true) +%!assert (is_sq_string ("foo"), false) +%!assert (is_sq_string (1.0), false) +%!assert (is_sq_string ({2.0}), false) + +%!error is_sq_string () +%!error is_sq_string ('foo', 2) +*/ + +DEFUN (is_dq_string, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_dq_string (@var{x})\n\ +Return true if @var{x} is a double-quoted character string.\n\ +@seealso{is_sq_string, ischar}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_dq_string (); + else + print_usage (); + + return retval; +} + +/* +%!assert (is_dq_string ("foo"), true) +%!assert (is_dq_string ('foo'), false) +%!assert (is_dq_string (1.0), false) +%!assert (is_dq_string ({2.0}), false) + +%!error is_dq_string () +%!error is_dq_string ("foo", 2) +*/ diff -r d02b229ce693 -r a132d206a36a src/octave-value/ov.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/octave-value/ov.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1394 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_value_h) +#define octave_value_h 1 + +#include + +#include +#include +#include + +#include "Range.h" +#include "data-conv.h" +#include "idx-vector.h" +#include "mach-info.h" +#include "mxarray.h" +#include "mx-base.h" +#include "oct-alloc.h" +#include "oct-time.h" +#include "str-vec.h" + +#include "oct-hdf5.h" +#include "oct-sort.h" + +class Cell; +class octave_map; +class octave_scalar_map; +class Octave_map; +class octave_stream; +class octave_function; +class octave_user_function; +class octave_fcn_handle; +class octave_fcn_inline; +class octave_value_list; +class octave_lvalue; + +#include "ov-base.h" + +// Constants. + +class octave_value; + +class +OCTINTERP_API +octave_value +{ +public: + + enum unary_op + { + op_not, // not + op_uplus, // uplus + op_uminus, // uminus + op_transpose, // transpose + op_hermitian, // ctranspose + op_incr, + op_decr, + num_unary_ops, + unknown_unary_op + }; + + enum binary_op + { + op_add, // plus + op_sub, // minus + op_mul, // mtimes + op_div, // mrdivide + op_pow, // mpower + op_ldiv, // mldivide + op_lshift, + op_rshift, + op_lt, // lt + op_le, // le + op_eq, // eq + op_ge, // ge + op_gt, // gt + op_ne, // ne + op_el_mul, // times + op_el_div, // rdivide + op_el_pow, // power + op_el_ldiv, // ldivide + op_el_and, // and + op_el_or, // or + op_struct_ref, + num_binary_ops, + unknown_binary_op + }; + + enum compound_binary_op + { + // ** compound operations ** + op_trans_mul, + op_mul_trans, + op_herm_mul, + op_mul_herm, + op_trans_ldiv, + op_herm_ldiv, + op_el_not_and, + op_el_not_or, + op_el_and_not, + op_el_or_not, + num_compound_binary_ops, + unknown_compound_binary_op + }; + + enum assign_op + { + op_asn_eq, + op_add_eq, + op_sub_eq, + op_mul_eq, + op_div_eq, + op_ldiv_eq, + op_pow_eq, + op_lshift_eq, + op_rshift_eq, + op_el_mul_eq, + op_el_div_eq, + op_el_ldiv_eq, + op_el_pow_eq, + op_el_and_eq, + op_el_or_eq, + num_assign_ops, + unknown_assign_op + }; + + static assign_op binary_op_to_assign_op (binary_op); + + static std::string unary_op_as_string (unary_op); + static std::string unary_op_fcn_name (unary_op); + + static std::string binary_op_as_string (binary_op); + static std::string binary_op_fcn_name (binary_op); + + static std::string binary_op_fcn_name (compound_binary_op); + + static std::string assign_op_as_string (assign_op); + + static octave_value empty_conv (const std::string& type, + const octave_value& rhs = octave_value ()); + + enum magic_colon { magic_colon_t }; + + octave_value (void) + { + static octave_base_value nil_rep; + rep = &nil_rep; + rep->count++; + } + + octave_value (short int i); + octave_value (unsigned short int i); + octave_value (int i); + octave_value (unsigned int i); + octave_value (long int i); + octave_value (unsigned long int i); + + // FIXME -- these are kluges. They turn into doubles + // internally, which will break for very large values. We just use + // them to store things like 64-bit ino_t, etc, and hope that those + // values are never actually larger than can be represented exactly + // in a double. + +#if defined (HAVE_LONG_LONG_INT) + octave_value (long long int i); +#endif +#if defined (HAVE_UNSIGNED_LONG_LONG_INT) + octave_value (unsigned long long int i); +#endif + + octave_value (octave_time t); + octave_value (double d); + octave_value (float d); + octave_value (const Array& a, bool is_cs_list = false); + octave_value (const Cell& c, bool is_cs_list = false); + octave_value (const Matrix& m, const MatrixType& t = MatrixType ()); + octave_value (const FloatMatrix& m, const MatrixType& t = MatrixType ()); + octave_value (const NDArray& nda); + octave_value (const FloatNDArray& nda); + octave_value (const Array& m); + octave_value (const Array& m); + octave_value (const DiagMatrix& d); + octave_value (const FloatDiagMatrix& d); + octave_value (const RowVector& v); + octave_value (const FloatRowVector& v); + octave_value (const ColumnVector& v); + octave_value (const FloatColumnVector& v); + octave_value (const Complex& C); + octave_value (const FloatComplex& C); + octave_value (const ComplexMatrix& m, const MatrixType& t = MatrixType ()); + octave_value (const FloatComplexMatrix& m, const MatrixType& t = MatrixType ()); + octave_value (const ComplexNDArray& cnda); + octave_value (const FloatComplexNDArray& cnda); + octave_value (const Array& m); + octave_value (const Array& m); + octave_value (const ComplexDiagMatrix& d); + octave_value (const FloatComplexDiagMatrix& d); + octave_value (const ComplexRowVector& v); + octave_value (const FloatComplexRowVector& v); + octave_value (const ComplexColumnVector& v); + octave_value (const FloatComplexColumnVector& v); + octave_value (const PermMatrix& p); + octave_value (bool b); + octave_value (const boolMatrix& bm, const MatrixType& t = MatrixType ()); + octave_value (const boolNDArray& bnda); + octave_value (const Array& bnda); + octave_value (char c, char type = '\''); + octave_value (const char *s, char type = '\''); + octave_value (const std::string& s, char type = '\''); + octave_value (const string_vector& s, char type = '\''); + octave_value (const charMatrix& chm, char type = '\''); + octave_value (const charNDArray& chnda, char type = '\''); + octave_value (const Array& chnda, char type = '\''); + octave_value (const charMatrix& chm, bool is_string, + char type = '\'') GCC_ATTR_DEPRECATED; + octave_value (const charNDArray& chnda, bool is_string, + char type = '\'') GCC_ATTR_DEPRECATED; + octave_value (const Array& chnda, bool is_string, + char type = '\'') GCC_ATTR_DEPRECATED; + octave_value (const SparseMatrix& m, const MatrixType& t = MatrixType ()); + octave_value (const Sparse& m, const MatrixType& t = MatrixType ()); + octave_value (const SparseComplexMatrix& m, + const MatrixType& t = MatrixType ()); + octave_value (const Sparse& m, const MatrixType& t = MatrixType ()); + octave_value (const SparseBoolMatrix& bm, + const MatrixType& t = MatrixType ()); + octave_value (const Sparse& m, const MatrixType& t = MatrixType ()); + octave_value (const octave_int8& i); + octave_value (const octave_int16& i); + octave_value (const octave_int32& i); + octave_value (const octave_int64& i); + octave_value (const octave_uint8& i); + octave_value (const octave_uint16& i); + octave_value (const octave_uint32& i); + octave_value (const octave_uint64& i); + octave_value (const int8NDArray& inda); + octave_value (const Array& inda); + octave_value (const int16NDArray& inda); + octave_value (const Array& inda); + octave_value (const int32NDArray& inda); + octave_value (const Array& inda); + octave_value (const int64NDArray& inda); + octave_value (const Array& inda); + octave_value (const uint8NDArray& inda); + octave_value (const Array& inda); + octave_value (const uint16NDArray& inda); + octave_value (const Array& inda); + octave_value (const uint32NDArray& inda); + octave_value (const Array& inda); + octave_value (const uint64NDArray& inda); + octave_value (const Array& inda); + octave_value (const Array& inda, + bool zero_based = false, bool cache_index = false); + octave_value (const Array& cellstr); + octave_value (const idx_vector& idx, bool lazy = true); + octave_value (double base, double limit, double inc); + octave_value (const Range& r); + octave_value (const octave_map& m); + octave_value (const octave_scalar_map& m); + octave_value (const Octave_map& m); + octave_value (const Octave_map& m, const std::string& id, + const std::list& plist); + octave_value (const octave_value_list& m, bool = false); + octave_value (octave_value::magic_colon); + + octave_value (octave_base_value *new_rep, bool borrow = false); + octave_value (octave_base_value *new_rep, int xcount) GCC_ATTR_DEPRECATED; + + // Copy constructor. + + octave_value (const octave_value& a) + { + rep = a.rep; + rep->count++; + } + + // This should only be called for derived types. + + octave_base_value *clone (void) const; + + octave_base_value *empty_clone (void) const + { return rep->empty_clone (); } + + // Delete the representation of this constant if the count drops to + // zero. + + ~octave_value (void) + { + if (--rep->count == 0) + delete rep; + } + + void make_unique (void) + { + if (rep->count > 1) + { + octave_base_value *r = rep->unique_clone (); + + if (--rep->count == 0) + delete rep; + + rep = r; + } + } + + // This uniquifies the value if it is referenced by more than a certain + // number of shallow copies. This is useful for optimizations where we + // know a certain copy, typically within a cell array, to be obsolete. + void make_unique (int obsolete_copies) + { + if (rep->count > obsolete_copies + 1) + { + octave_base_value *r = rep->unique_clone (); + + if (--rep->count == 0) + delete rep; + + rep = r; + } + } + + // Simple assignment. + + octave_value& operator = (const octave_value& a) + { + if (rep != a.rep) + { + if (--rep->count == 0) + delete rep; + + rep = a.rep; + rep->count++; + } + + return *this; + } + + octave_idx_type get_count (void) const { return rep->count; } + + octave_base_value::type_conv_info numeric_conversion_function (void) const + { return rep->numeric_conversion_function (); } + + octave_base_value::type_conv_info numeric_demotion_function (void) const + { return rep->numeric_demotion_function (); } + + void maybe_mutate (void); + + octave_value squeeze (void) const + { return rep->squeeze (); } + + // The result of full(). + octave_value full_value (void) const + { return rep->full_value (); } + + octave_base_value *try_narrowing_conversion (void) + { return rep->try_narrowing_conversion (); } + + // Close to dims (), but can be overloaded for classes. + Matrix size (void) + { return rep->size (); } + + octave_idx_type numel (const octave_value_list& idx) + { return rep->numel (idx); } + + octave_value single_subsref (const std::string& type, + const octave_value_list& idx); + + octave_value subsref (const std::string& type, + const std::list& idx) + { return rep->subsref (type, idx); } + + octave_value subsref (const std::string& type, + const std::list& idx, + bool auto_add) + { return rep->subsref (type, idx, auto_add); } + + octave_value_list subsref (const std::string& type, + const std::list& idx, + int nargout); + + octave_value_list subsref (const std::string& type, + const std::list& idx, + int nargout, + const std::list *lvalue_list); + + octave_value next_subsref (const std::string& type, const + std::list& idx, + size_t skip = 1); + + octave_value_list next_subsref (int nargout, + const std::string& type, const + std::list& idx, + size_t skip = 1); + + octave_value next_subsref (bool auto_add, const std::string& type, const + std::list& idx, + size_t skip = 1); + + octave_value do_index_op (const octave_value_list& idx, + bool resize_ok = false) + { return rep->do_index_op (idx, resize_ok); } + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& idx); + + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& idx, + const std::list *lvalue_list); + + octave_value subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + octave_value undef_subsasgn (const std::string& type, + const std::list& idx, + const octave_value& rhs); + + octave_value& assign (assign_op op, const std::string& type, + const std::list& idx, + const octave_value& rhs); + + octave_value& assign (assign_op, const octave_value& rhs); + + idx_vector index_vector (void) const + { return rep->index_vector (); } + + // Size. + + dim_vector dims (void) const + { return rep->dims (); } + + octave_idx_type rows (void) const { return rep->rows (); } + + octave_idx_type columns (void) const { return rep->columns (); } + + octave_idx_type length (void) const; + + int ndims (void) const { return rep->ndims (); } + + bool all_zero_dims (void) const { return dims ().all_zero (); } + + octave_idx_type numel (void) const + { return rep->numel (); } + + octave_idx_type capacity (void) const + { return rep->capacity (); } + + size_t byte_size (void) const + { return rep->byte_size (); } + + octave_idx_type nnz (void) const { return rep->nnz (); } + + octave_idx_type nzmax (void) const { return rep->nzmax (); } + + octave_idx_type nfields (void) const { return rep->nfields (); } + + octave_value reshape (const dim_vector& dv) const + { return rep->reshape (dv); } + + octave_value permute (const Array& vec, bool inv = false) const + { return rep->permute (vec, inv); } + + octave_value ipermute (const Array& vec) const + { return rep->permute (vec, true); } + + octave_value resize (const dim_vector& dv, bool fill = false) const + { return rep->resize (dv, fill);} + + MatrixType matrix_type (void) const + { return rep->matrix_type (); } + + MatrixType matrix_type (const MatrixType& typ) const + { return rep->matrix_type (typ); } + + // 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(). + + bool is_defined (void) const + { return rep->is_defined (); } + + bool is_undefined (void) const + { return ! is_defined (); } + + bool is_empty (void) const + { return rep->is_empty (); } + + bool is_cell (void) const + { return rep->is_cell (); } + + bool is_cellstr (void) const + { return rep->is_cellstr (); } + + bool is_real_scalar (void) const + { return rep->is_real_scalar (); } + + bool is_real_matrix (void) const + { return rep->is_real_matrix (); } + + bool is_real_nd_array (void) const + { return rep->is_real_nd_array (); } + + bool is_complex_scalar (void) const + { return rep->is_complex_scalar (); } + + bool is_complex_matrix (void) const + { return rep->is_complex_matrix (); } + + bool is_bool_scalar (void) const + { return rep->is_bool_scalar (); } + + bool is_bool_matrix (void) const + { return rep->is_bool_matrix (); } + + bool is_char_matrix (void) const + { return rep->is_char_matrix (); } + + bool is_diag_matrix (void) const + { return rep->is_diag_matrix (); } + + bool is_perm_matrix (void) const + { return rep->is_perm_matrix (); } + + bool is_string (void) const + { return rep->is_string (); } + + bool is_sq_string (void) const + { return rep->is_sq_string (); } + + bool is_dq_string (void) const + { return rep->is_string () && ! rep->is_sq_string (); } + + bool is_range (void) const + { return rep->is_range (); } + + bool is_map (void) const + { return rep->is_map (); } + + bool is_object (void) const + { return rep->is_object (); } + + bool is_cs_list (void) const + { return rep->is_cs_list (); } + + bool is_magic_colon (void) const + { return rep->is_magic_colon (); } + + bool is_null_value (void) const + { return rep->is_null_value (); } + + // Are any or all of the elements in this constant nonzero? + + octave_value all (int dim = 0) const + { return rep->all (dim); } + + octave_value any (int dim = 0) const + { return rep->any (dim); } + + builtin_type_t builtin_type (void) const + { return rep->builtin_type (); } + + // Floating point types. + + bool is_double_type (void) const + { return rep->is_double_type (); } + + bool is_single_type (void) const + { return rep->is_single_type (); } + + bool is_float_type (void) const + { return rep->is_float_type (); } + + // Integer types. + + bool is_int8_type (void) const + { return rep->is_int8_type (); } + + bool is_int16_type (void) const + { return rep->is_int16_type (); } + + bool is_int32_type (void) const + { return rep->is_int32_type (); } + + bool is_int64_type (void) const + { return rep->is_int64_type (); } + + bool is_uint8_type (void) const + { return rep->is_uint8_type (); } + + bool is_uint16_type (void) const + { return rep->is_uint16_type (); } + + bool is_uint32_type (void) const + { return rep->is_uint32_type (); } + + bool is_uint64_type (void) const + { return rep->is_uint64_type (); } + + // Other type stuff. + + bool is_bool_type (void) const + { return rep->is_bool_type (); } + + bool is_integer_type (void) const + { return rep->is_integer_type (); } + + bool is_real_type (void) const + { return rep->is_real_type (); } + + bool is_complex_type (void) const + { return rep->is_complex_type (); } + + bool is_scalar_type (void) const + { return rep->is_scalar_type (); } + + bool is_matrix_type (void) const + { return rep->is_matrix_type (); } + + bool is_numeric_type (void) const + { return rep->is_numeric_type (); } + + bool is_sparse_type (void) const + { return rep->is_sparse_type (); } + + // Does this constant correspond to a truth value? + + bool is_true (void) const + { return rep->is_true (); } + + // Do two constants match (in a switch statement)? + + bool is_equal (const octave_value&) const; + + // Are the dimensions of this constant zero by zero? + + bool is_zero_by_zero (void) const + { return (rows () == 0 && columns () == 0); } + + bool is_constant (void) const + { return rep->is_constant (); } + + bool is_function_handle (void) const + { return rep->is_function_handle (); } + + bool is_anonymous_function (void) const + { return rep->is_anonymous_function (); } + + bool is_inline_function (void) const + { return rep->is_inline_function (); } + + bool is_function (void) const + { return rep->is_function (); } + + bool is_user_script (void) const + { return rep->is_user_script (); } + + bool is_user_function (void) const + { return rep->is_user_function (); } + + bool is_user_code (void) const + { return rep->is_user_code (); } + + bool is_builtin_function (void) const + { return rep->is_builtin_function (); } + + bool is_dld_function (void) const + { return rep->is_dld_function (); } + + bool is_mex_function (void) const + { return rep->is_mex_function (); } + + void erase_subfunctions (void) { rep->erase_subfunctions (); } + + // Values. + + octave_value eval (void) { return *this; } + + short int + short_value (bool req_int = false, bool frc_str_conv = false) const + { return rep->short_value (req_int, frc_str_conv); } + + unsigned short int + ushort_value (bool req_int = false, bool frc_str_conv = false) const + { return rep->ushort_value (req_int, frc_str_conv); } + + int int_value (bool req_int = false, bool frc_str_conv = false) const + { return rep->int_value (req_int, frc_str_conv); } + + unsigned int + uint_value (bool req_int = false, bool frc_str_conv = false) const + { return rep->uint_value (req_int, frc_str_conv); } + + int nint_value (bool frc_str_conv = false) const + { return rep->nint_value (frc_str_conv); } + + long int + long_value (bool req_int = false, bool frc_str_conv = false) const + { return rep->long_value (req_int, frc_str_conv); } + + unsigned long int + ulong_value (bool req_int = false, bool frc_str_conv = false) const + { return rep->ulong_value (req_int, frc_str_conv); } + + octave_idx_type + idx_type_value (bool req_int = false, bool frc_str_conv = false) const; + + double double_value (bool frc_str_conv = false) const + { return rep->double_value (frc_str_conv); } + + float float_value (bool frc_str_conv = false) const + { return rep->float_value (frc_str_conv); } + + double scalar_value (bool frc_str_conv = false) const + { return rep->scalar_value (frc_str_conv); } + + float float_scalar_value (bool frc_str_conv = false) const + { return rep->float_scalar_value (frc_str_conv); } + + Cell cell_value (void) const; + + Matrix matrix_value (bool frc_str_conv = false) const + { return rep->matrix_value (frc_str_conv); } + + FloatMatrix float_matrix_value (bool frc_str_conv = false) const + { return rep->float_matrix_value (frc_str_conv); } + + NDArray array_value (bool frc_str_conv = false) const + { return rep->array_value (frc_str_conv); } + + FloatNDArray float_array_value (bool frc_str_conv = false) const + { return rep->float_array_value (frc_str_conv); } + + Complex complex_value (bool frc_str_conv = false) const + { return rep->complex_value (frc_str_conv); } + + FloatComplex float_complex_value (bool frc_str_conv = false) const + { return rep->float_complex_value (frc_str_conv); } + + ComplexMatrix complex_matrix_value (bool frc_str_conv = false) const + { return rep->complex_matrix_value (frc_str_conv); } + + FloatComplexMatrix float_complex_matrix_value (bool frc_str_conv = false) const + { return rep->float_complex_matrix_value (frc_str_conv); } + + ComplexNDArray complex_array_value (bool frc_str_conv = false) const + { return rep->complex_array_value (frc_str_conv); } + + FloatComplexNDArray float_complex_array_value (bool frc_str_conv = false) const + { return rep->float_complex_array_value (frc_str_conv); } + + bool bool_value (bool warn = false) const + { return rep->bool_value (warn); } + + boolMatrix bool_matrix_value (bool warn = false) const + { return rep->bool_matrix_value (warn); } + + boolNDArray bool_array_value (bool warn = false) const + { return rep->bool_array_value (warn); } + + charMatrix char_matrix_value (bool frc_str_conv = false) const + { return rep->char_matrix_value (frc_str_conv); } + + charNDArray char_array_value (bool frc_str_conv = false) const + { return rep->char_array_value (frc_str_conv); } + + SparseMatrix sparse_matrix_value (bool frc_str_conv = false) const + { return rep->sparse_matrix_value (frc_str_conv); } + + SparseComplexMatrix sparse_complex_matrix_value (bool frc_str_conv = false) const + { return rep->sparse_complex_matrix_value (frc_str_conv); } + + SparseBoolMatrix sparse_bool_matrix_value (bool warn = false) const + { return rep->sparse_bool_matrix_value (warn); } + + DiagMatrix diag_matrix_value (bool force = false) const + { return rep->diag_matrix_value (force); } + + FloatDiagMatrix float_diag_matrix_value (bool force = false) const + { return rep->float_diag_matrix_value (force); } + + ComplexDiagMatrix complex_diag_matrix_value (bool force = false) const + { return rep->complex_diag_matrix_value (force); } + + FloatComplexDiagMatrix float_complex_diag_matrix_value (bool force = false) const + { return rep->float_complex_diag_matrix_value (force); } + + PermMatrix perm_matrix_value (void) const + { return rep->perm_matrix_value (); } + + octave_int8 int8_scalar_value (void) const + { return rep->int8_scalar_value (); } + + octave_int16 int16_scalar_value (void) const + { return rep->int16_scalar_value (); } + + octave_int32 int32_scalar_value (void) const + { return rep->int32_scalar_value (); } + + octave_int64 int64_scalar_value (void) const + { return rep->int64_scalar_value (); } + + octave_uint8 uint8_scalar_value (void) const + { return rep->uint8_scalar_value (); } + + octave_uint16 uint16_scalar_value (void) const + { return rep->uint16_scalar_value (); } + + octave_uint32 uint32_scalar_value (void) const + { return rep->uint32_scalar_value (); } + + octave_uint64 uint64_scalar_value (void) const + { return rep->uint64_scalar_value (); } + + int8NDArray int8_array_value (void) const + { return rep->int8_array_value (); } + + int16NDArray int16_array_value (void) const + { return rep->int16_array_value (); } + + int32NDArray int32_array_value (void) const + { return rep->int32_array_value (); } + + int64NDArray int64_array_value (void) const + { return rep->int64_array_value (); } + + uint8NDArray uint8_array_value (void) const + { return rep->uint8_array_value (); } + + uint16NDArray uint16_array_value (void) const + { return rep->uint16_array_value (); } + + uint32NDArray uint32_array_value (void) const + { return rep->uint32_array_value (); } + + uint64NDArray uint64_array_value (void) const + { return rep->uint64_array_value (); } + + string_vector all_strings (bool pad = false) const + { return rep->all_strings (pad); } + + std::string string_value (bool force = false) const + { return rep->string_value (force); } + + Array cellstr_value (void) const + { return rep->cellstr_value (); } + + Range range_value (void) const + { return rep->range_value (); } + + octave_map map_value (void) const; + + octave_scalar_map scalar_map_value (void) const; + + string_vector map_keys (void) const + { return rep->map_keys (); } + + size_t nparents (void) const + { return rep->nparents (); } + + std::list parent_class_name_list (void) const + { return rep->parent_class_name_list (); } + + string_vector parent_class_names (void) const + { return rep->parent_class_names (); } + + octave_base_value * + find_parent_class (const std::string& parent_class_name) + { return rep->find_parent_class (parent_class_name); } + + octave_function *function_value (bool silent = false) const; + + octave_user_function *user_function_value (bool silent = false) const; + + octave_user_script *user_script_value (bool silent = false) const; + + octave_user_code *user_code_value (bool silent = false) const; + + octave_fcn_handle *fcn_handle_value (bool silent = false) const; + + octave_fcn_inline *fcn_inline_value (bool silent = false) const; + + octave_value_list list_value (void) const; + + ColumnVector column_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + ComplexColumnVector + complex_column_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + RowVector row_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + ComplexRowVector + complex_row_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + + FloatColumnVector float_column_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + FloatComplexColumnVector + float_complex_column_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + FloatRowVector float_row_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + FloatComplexRowVector + float_complex_row_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + + + + Array int_vector_value (bool req_int = false, + bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + Array + octave_idx_type_vector_value (bool req_int = false, + bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + Array vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + Array complex_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + Array float_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + Array float_complex_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + // Possibly economize a lazy-indexed value. + + void maybe_economize (void) + { rep->maybe_economize (); } + + // The following two hook conversions are called on any octave_value prior to + // storing it to a "permanent" location, like a named variable, a cell or a + // struct component, or a return value of a function. + + octave_value storable_value (void) const; + + // Ditto, but in place, i.e. equivalent to *this = this->storable_value (), + // but possibly more efficient. + + void make_storable_value (void); + + // 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. + + octave_value convert_to_str (bool pad = false, bool force = false, + char type = '\'') const + { return rep->convert_to_str (pad, force, type); } + + octave_value + convert_to_str_internal (bool pad, bool force, char type) const + { return rep->convert_to_str_internal (pad, force, type); } + + void convert_to_row_or_column_vector (void) + { rep->convert_to_row_or_column_vector (); } + + bool print_as_scalar (void) const + { return rep->print_as_scalar (); } + + void print (std::ostream& os, bool pr_as_read_syntax = false) const + { rep->print (os, pr_as_read_syntax); } + + void print_raw (std::ostream& os, + bool pr_as_read_syntax = false) const + { rep->print_raw (os, pr_as_read_syntax); } + + bool print_name_tag (std::ostream& os, const std::string& name) const + { return rep->print_name_tag (os, name); } + + void print_with_name (std::ostream& os, const std::string& name) const + { rep->print_with_name (os, name, true); } + + int type_id (void) const { return rep->type_id (); } + + std::string type_name (void) const { return rep->type_name (); } + + std::string class_name (void) const { return rep->class_name (); } + + // Unary and binary operations. + + friend OCTINTERP_API octave_value do_unary_op (unary_op op, + const octave_value& a); + + octave_value& do_non_const_unary_op (unary_op op); + + octave_value& do_non_const_unary_op (unary_op op, const std::string& type, + const std::list& idx); + + friend OCTINTERP_API octave_value do_binary_op (binary_op op, + const octave_value& a, + const octave_value& b); + + friend OCTINTERP_API octave_value do_binary_op (compound_binary_op op, + const octave_value& a, + const octave_value& b); + + friend OCTINTERP_API octave_value do_cat_op (const octave_value& a, + const octave_value& b, + const Array& ra_idx); + + const octave_base_value& get_rep (void) const { return *rep; } + + bool is_copy_of (const octave_value &val) const { return rep == val.rep; } + + void print_info (std::ostream& os, + const std::string& prefix = std::string ()) const; + + bool save_ascii (std::ostream& os) { return rep->save_ascii (os); } + + bool load_ascii (std::istream& is) { return rep->load_ascii (is); } + + bool save_binary (std::ostream& os, bool& save_as_floats) + { return rep->save_binary (os, save_as_floats); } + + bool load_binary (std::istream& is, bool swap, + oct_mach_info::float_format fmt) + { return rep->load_binary (is, swap, fmt); } + +#if defined (HAVE_HDF5) + bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) + { return rep->save_hdf5 (loc_id, name, save_as_floats); } + + bool load_hdf5 (hid_t loc_id, const char *name) + { return rep->load_hdf5 (loc_id, name); } +#endif + + int write (octave_stream& os, int block_size, + oct_data_conv::data_type output_type, int skip, + oct_mach_info::float_format flt_fmt) const; + + octave_base_value *internal_rep (void) const { return rep; } + + // Unsafe. These functions exist to support the MEX interface. + // You should not use them anywhere else. + void *mex_get_data (void) const { return rep->mex_get_data (); } + + octave_idx_type *mex_get_ir (void) const { return rep->mex_get_ir (); } + + octave_idx_type *mex_get_jc (void) const { return rep->mex_get_jc (); } + + mxArray *as_mxArray (void) const { return rep->as_mxArray (); } + + octave_value diag (octave_idx_type k = 0) const + { return rep->diag (k); } + + octave_value diag (octave_idx_type m, octave_idx_type n) const + { return rep->diag (m, n); } + + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const + { return rep->sort (dim, mode); } + octave_value sort (Array &sidx, octave_idx_type dim = 0, + sortmode mode = ASCENDING) const + { return rep->sort (sidx, dim, mode); } + + sortmode is_sorted (sortmode mode = UNSORTED) const + { return rep->is_sorted (mode); } + + Array sort_rows_idx (sortmode mode = ASCENDING) const + { return rep->sort_rows_idx (mode); } + + sortmode is_sorted_rows (sortmode mode = UNSORTED) const + { return rep->is_sorted_rows (mode); } + + void lock (void) { rep->lock (); } + + void unlock (void) { rep->unlock (); } + + bool islocked (void) const { return rep->islocked (); } + + void dump (std::ostream& os) const { rep->dump (os); } + +#define MAPPER_FORWARD(F) \ + octave_value F (void) const { return rep->map (octave_base_value::umap_ ## F); } + + MAPPER_FORWARD (abs) + MAPPER_FORWARD (acos) + MAPPER_FORWARD (acosh) + MAPPER_FORWARD (angle) + MAPPER_FORWARD (arg) + MAPPER_FORWARD (asin) + MAPPER_FORWARD (asinh) + MAPPER_FORWARD (atan) + MAPPER_FORWARD (atanh) + MAPPER_FORWARD (cbrt) + MAPPER_FORWARD (ceil) + MAPPER_FORWARD (conj) + MAPPER_FORWARD (cos) + MAPPER_FORWARD (cosh) + MAPPER_FORWARD (erf) + MAPPER_FORWARD (erfinv) + MAPPER_FORWARD (erfcinv) + MAPPER_FORWARD (erfc) + MAPPER_FORWARD (erfcx) + MAPPER_FORWARD (exp) + MAPPER_FORWARD (expm1) + MAPPER_FORWARD (finite) + MAPPER_FORWARD (fix) + MAPPER_FORWARD (floor) + MAPPER_FORWARD (gamma) + MAPPER_FORWARD (imag) + MAPPER_FORWARD (isinf) + MAPPER_FORWARD (isna) + MAPPER_FORWARD (isnan) + MAPPER_FORWARD (lgamma) + MAPPER_FORWARD (log) + MAPPER_FORWARD (log2) + MAPPER_FORWARD (log10) + MAPPER_FORWARD (log1p) + MAPPER_FORWARD (real) + MAPPER_FORWARD (round) + MAPPER_FORWARD (roundb) + MAPPER_FORWARD (signum) + MAPPER_FORWARD (sin) + MAPPER_FORWARD (sinh) + MAPPER_FORWARD (sqrt) + MAPPER_FORWARD (tan) + MAPPER_FORWARD (tanh) + + // These functions are prefixed with X to avoid potential macro + // conflicts. + + MAPPER_FORWARD (xisalnum) + MAPPER_FORWARD (xisalpha) + MAPPER_FORWARD (xisascii) + MAPPER_FORWARD (xiscntrl) + MAPPER_FORWARD (xisdigit) + MAPPER_FORWARD (xisgraph) + MAPPER_FORWARD (xislower) + MAPPER_FORWARD (xisprint) + MAPPER_FORWARD (xispunct) + MAPPER_FORWARD (xisspace) + MAPPER_FORWARD (xisupper) + MAPPER_FORWARD (xisxdigit) + MAPPER_FORWARD (xtoascii) + MAPPER_FORWARD (xtolower) + MAPPER_FORWARD (xtoupper) + +#undef MAPPER_FORWARD + + octave_value map (octave_base_value::unary_mapper_t umap) const + { return rep->map (umap); } + + // Extract the n-th element, aka val(n). Result is undefined if val is not an + // array type or n is out of range. Never error. + octave_value + fast_elem_extract (octave_idx_type n) const + { return rep->fast_elem_extract (n); } + + // Assign the n-th element, aka val(n) = x. Returns false if val is not an + // array type, x is not a matching scalar type, or n is out of range. + // Never error. + virtual bool + fast_elem_insert (octave_idx_type n, const octave_value& x) + { + make_unique (); + return rep->fast_elem_insert (n, x); + } + +protected: + + // The real representation. + octave_base_value *rep; + +private: + + assign_op unary_op_to_assign_op (unary_op op); + + binary_op op_eq_to_binary_op (assign_op op); + + // This declaration protects against constructing octave_value from + // const octave_base_value* which actually silently calls octave_value (bool). + octave_value (const octave_base_value *); + + DECLARE_OCTAVE_ALLOCATOR +}; + +// Publish externally used friend functions. + +extern OCTINTERP_API octave_value +do_unary_op (octave_value::unary_op op, const octave_value& a); + +extern OCTINTERP_API octave_value +do_binary_op (octave_value::binary_op op, + const octave_value& a, const octave_value& b); + +extern OCTINTERP_API octave_value +do_binary_op (octave_value::compound_binary_op op, + const octave_value& a, const octave_value& b); + +#define OV_UNOP_FN(name) \ + inline octave_value \ + name (const octave_value& a) \ + { \ + return do_unary_op (octave_value::name, a); \ + } + +#define OV_UNOP_OP(name, op) \ + inline octave_value \ + operator op (const octave_value& a) \ + { \ + return name (a); \ + } + +#define OV_UNOP_FN_OP(name, op) \ + OV_UNOP_FN (name) \ + OV_UNOP_OP (name, op) + +OV_UNOP_FN_OP (op_not, !) +OV_UNOP_FN_OP (op_uplus, +) +OV_UNOP_FN_OP (op_uminus, -) + +OV_UNOP_FN (op_transpose) +OV_UNOP_FN (op_hermitian) + +// No simple way to define these for prefix and suffix ops? +// +// incr +// decr + +#define OV_BINOP_FN(name) \ + inline octave_value \ + name (const octave_value& a1, const octave_value& a2) \ + { \ + return do_binary_op (octave_value::name, a1, a2); \ + } + +#define OV_BINOP_OP(name, op) \ + inline octave_value \ + operator op (const octave_value& a1, const octave_value& a2) \ + { \ + return name (a1, a2); \ + } + +#define OV_BINOP_FN_OP(name, op) \ + OV_BINOP_FN (name) \ + OV_BINOP_OP (name, op) + +OV_BINOP_FN_OP (op_add, +) +OV_BINOP_FN_OP (op_sub, -) +OV_BINOP_FN_OP (op_mul, *) +OV_BINOP_FN_OP (op_div, /) + +OV_BINOP_FN (op_pow) +OV_BINOP_FN (op_ldiv) +OV_BINOP_FN (op_lshift) +OV_BINOP_FN (op_rshift) + +OV_BINOP_FN_OP (op_lt, <) +OV_BINOP_FN_OP (op_le, <=) +OV_BINOP_FN_OP (op_eq, ==) +OV_BINOP_FN_OP (op_ge, >=) +OV_BINOP_FN_OP (op_gt, >) +OV_BINOP_FN_OP (op_ne, !=) + +OV_BINOP_FN (op_el_mul) +OV_BINOP_FN (op_el_div) +OV_BINOP_FN (op_el_pow) +OV_BINOP_FN (op_el_ldiv) +OV_BINOP_FN (op_el_and) +OV_BINOP_FN (op_el_or) + +OV_BINOP_FN (op_struct_ref) + +#define OV_COMP_BINOP_FN(name) \ + inline octave_value \ + name (const octave_value& a1, const octave_value& a2) \ + { \ + return do_binary_op (octave_value::name, a1, a2); \ + } + +OV_COMP_BINOP_FN (op_trans_mul) +OV_COMP_BINOP_FN (op_mul_trans) +OV_COMP_BINOP_FN (op_herm_mul) +OV_COMP_BINOP_FN (op_mul_herm) + +extern OCTINTERP_API void install_types (void); + +// This will eventually go away, but for now it can be used to +// simplify the transition to the new octave_value class hierarchy, +// which uses octave_base_value instead of octave_value for the type +// of octave_value::rep. +#define OV_REP_TYPE octave_base_value + +// Templated value extractors. +template +inline Value octave_value_extract (const octave_value&) + { assert (false); } + +#define DEF_VALUE_EXTRACTOR(VALUE,MPREFIX) \ +template<> \ +inline VALUE octave_value_extract (const octave_value& v) \ + { return v.MPREFIX ## _value (); } + +DEF_VALUE_EXTRACTOR (double, scalar) +DEF_VALUE_EXTRACTOR (float, float_scalar) +DEF_VALUE_EXTRACTOR (Complex, complex) +DEF_VALUE_EXTRACTOR (FloatComplex, float_complex) +DEF_VALUE_EXTRACTOR (bool, bool) + +DEF_VALUE_EXTRACTOR (octave_int8, int8_scalar) +DEF_VALUE_EXTRACTOR (octave_int16, int16_scalar) +DEF_VALUE_EXTRACTOR (octave_int32, int32_scalar) +DEF_VALUE_EXTRACTOR (octave_int64, int64_scalar) +DEF_VALUE_EXTRACTOR (octave_uint8, uint8_scalar) +DEF_VALUE_EXTRACTOR (octave_uint16, uint16_scalar) +DEF_VALUE_EXTRACTOR (octave_uint32, uint32_scalar) +DEF_VALUE_EXTRACTOR (octave_uint64, uint64_scalar) + + +DEF_VALUE_EXTRACTOR (NDArray, array) +DEF_VALUE_EXTRACTOR (FloatNDArray, float_array) +DEF_VALUE_EXTRACTOR (ComplexNDArray, complex_array) +DEF_VALUE_EXTRACTOR (FloatComplexNDArray, float_complex_array) +DEF_VALUE_EXTRACTOR (boolNDArray, bool_array) + +DEF_VALUE_EXTRACTOR (charNDArray, char_array) +DEF_VALUE_EXTRACTOR (int8NDArray, int8_array) +DEF_VALUE_EXTRACTOR (int16NDArray, int16_array) +DEF_VALUE_EXTRACTOR (int32NDArray, int32_array) +DEF_VALUE_EXTRACTOR (int64NDArray, int64_array) +DEF_VALUE_EXTRACTOR (uint8NDArray, uint8_array) +DEF_VALUE_EXTRACTOR (uint16NDArray, uint16_array) +DEF_VALUE_EXTRACTOR (uint32NDArray, uint32_array) +DEF_VALUE_EXTRACTOR (uint64NDArray, uint64_array) + +DEF_VALUE_EXTRACTOR (Matrix, matrix) +DEF_VALUE_EXTRACTOR (FloatMatrix, float_matrix) +DEF_VALUE_EXTRACTOR (ComplexMatrix, complex_matrix) +DEF_VALUE_EXTRACTOR (FloatComplexMatrix, float_complex_matrix) +DEF_VALUE_EXTRACTOR (boolMatrix, bool_matrix) + +DEF_VALUE_EXTRACTOR (ColumnVector, column_vector) +DEF_VALUE_EXTRACTOR (FloatColumnVector, float_column_vector) +DEF_VALUE_EXTRACTOR (ComplexColumnVector, complex_column_vector) +DEF_VALUE_EXTRACTOR (FloatComplexColumnVector, float_complex_column_vector) + +DEF_VALUE_EXTRACTOR (RowVector, row_vector) +DEF_VALUE_EXTRACTOR (FloatRowVector, float_row_vector) +DEF_VALUE_EXTRACTOR (ComplexRowVector, complex_row_vector) +DEF_VALUE_EXTRACTOR (FloatComplexRowVector, float_complex_row_vector) + +DEF_VALUE_EXTRACTOR (DiagMatrix, diag_matrix) +DEF_VALUE_EXTRACTOR (FloatDiagMatrix, float_diag_matrix) +DEF_VALUE_EXTRACTOR (ComplexDiagMatrix, complex_diag_matrix) +DEF_VALUE_EXTRACTOR (FloatComplexDiagMatrix, float_complex_diag_matrix) +DEF_VALUE_EXTRACTOR (PermMatrix, perm_matrix) + +DEF_VALUE_EXTRACTOR (SparseMatrix, sparse_matrix) +DEF_VALUE_EXTRACTOR (SparseComplexMatrix, sparse_complex_matrix) +DEF_VALUE_EXTRACTOR (SparseBoolMatrix, sparse_bool_matrix) +#undef DEF_VALUE_EXTRACTOR + +#define DEF_DUMMY_VALUE_EXTRACTOR(VALUE,DEFVAL) \ +template<> \ +inline VALUE octave_value_extract (const octave_value&) \ + { assert (false); return DEFVAL; } + +DEF_DUMMY_VALUE_EXTRACTOR (char, 0) +DEF_DUMMY_VALUE_EXTRACTOR (octave_value, octave_value ()) +#undef DEF_DUMMY_VALUE_EXTRACTOR + +#endif diff -r d02b229ce693 -r a132d206a36a src/operators/module.mk --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/module.mk Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,136 @@ +EXTRA_DIST += operators/module.mk + +OPERATORS_SRC = \ + operators/op-b-b.cc \ + operators/op-b-bm.cc \ + operators/op-b-sbm.cc \ + operators/op-bm-b.cc \ + operators/op-bm-bm.cc \ + operators/op-bm-sbm.cc \ + operators/op-cdm-cdm.cc \ + operators/op-cdm-cm.cc \ + operators/op-cdm-cs.cc \ + operators/op-cdm-dm.cc \ + operators/op-cdm-m.cc \ + operators/op-cdm-s.cc \ + operators/op-cell.cc \ + operators/op-chm.cc \ + operators/op-class.cc \ + operators/op-cm-cdm.cc \ + operators/op-cm-cm.cc \ + operators/op-cm-cs.cc \ + operators/op-cm-dm.cc \ + operators/op-cm-m.cc \ + operators/op-cm-pm.cc \ + operators/op-cm-s.cc \ + operators/op-cm-scm.cc \ + operators/op-cm-sm.cc \ + operators/op-cs-cm.cc \ + operators/op-cs-cs.cc \ + operators/op-cs-m.cc \ + operators/op-cs-s.cc \ + operators/op-cs-scm.cc \ + operators/op-cs-sm.cc \ + operators/op-dm-cdm.cc \ + operators/op-dm-cm.cc \ + operators/op-dm-cs.cc \ + operators/op-dm-dm.cc \ + operators/op-dm-m.cc \ + operators/op-dm-s.cc \ + operators/op-dm-scm.cc \ + operators/op-dm-sm.cc \ + operators/op-double-conv.cc \ + operators/op-fcdm-fcdm.cc \ + operators/op-fcdm-fcm.cc \ + operators/op-fcdm-fcs.cc \ + operators/op-fcdm-fdm.cc \ + operators/op-fcdm-fm.cc \ + operators/op-fcdm-fs.cc \ + operators/op-fcm-fcdm.cc \ + operators/op-fcm-fcm.cc \ + operators/op-fcm-fcs.cc \ + operators/op-fcm-fdm.cc \ + operators/op-fcm-fm.cc \ + operators/op-fcm-fs.cc \ + operators/op-fcm-pm.cc \ + operators/op-fcn.cc \ + operators/op-fcs-fcm.cc \ + operators/op-fcs-fcs.cc \ + operators/op-fcs-fm.cc \ + operators/op-fcs-fs.cc \ + operators/op-fdm-fcdm.cc \ + operators/op-fdm-fcm.cc \ + operators/op-fdm-fcs.cc \ + operators/op-fdm-fdm.cc \ + operators/op-fdm-fm.cc \ + operators/op-fdm-fs.cc \ + operators/op-float-conv.cc \ + operators/op-fm-fcdm.cc \ + operators/op-fm-fcm.cc \ + operators/op-fm-fcs.cc \ + operators/op-fm-fdm.cc \ + operators/op-fm-fm.cc \ + operators/op-fm-fs.cc \ + operators/op-fm-pm.cc \ + operators/op-fs-fcm.cc \ + operators/op-fs-fcs.cc \ + operators/op-fs-fm.cc \ + operators/op-fs-fs.cc \ + operators/op-i16-i16.cc \ + operators/op-i32-i32.cc \ + operators/op-i64-i64.cc \ + operators/op-i8-i8.cc \ + operators/op-int-concat.cc \ + operators/op-int-conv.cc \ + operators/op-m-cdm.cc \ + operators/op-m-cm.cc \ + operators/op-m-cs.cc \ + operators/op-m-dm.cc \ + operators/op-m-m.cc \ + operators/op-m-pm.cc \ + operators/op-m-s.cc \ + operators/op-m-scm.cc \ + operators/op-m-sm.cc \ + operators/op-pm-cm.cc \ + operators/op-pm-fcm.cc \ + operators/op-pm-fm.cc \ + operators/op-pm-m.cc \ + operators/op-pm-pm.cc \ + operators/op-pm-scm.cc \ + operators/op-pm-sm.cc \ + operators/op-range.cc \ + operators/op-s-cm.cc \ + operators/op-s-cs.cc \ + operators/op-s-m.cc \ + operators/op-s-s.cc \ + operators/op-s-scm.cc \ + operators/op-s-sm.cc \ + operators/op-sbm-b.cc \ + operators/op-sbm-bm.cc \ + operators/op-sbm-sbm.cc \ + operators/op-scm-cm.cc \ + operators/op-scm-cs.cc \ + operators/op-scm-m.cc \ + operators/op-scm-s.cc \ + operators/op-scm-scm.cc \ + operators/op-scm-sm.cc \ + operators/op-sm-cm.cc \ + operators/op-sm-cs.cc \ + operators/op-sm-m.cc \ + operators/op-sm-s.cc \ + operators/op-sm-scm.cc \ + operators/op-sm-sm.cc \ + operators/op-str-m.cc \ + operators/op-str-s.cc \ + operators/op-str-str.cc \ + operators/op-struct.cc \ + operators/op-ui16-ui16.cc \ + operators/op-ui32-ui32.cc \ + operators/op-ui64-ui64.cc \ + operators/op-ui8-ui8.cc + +octinclude_HEADERS += \ + operators/op-dm-template.cc \ + operators/op-dms-template.cc \ + operators/op-int.h \ + operators/op-pm-template.cc diff -r d02b229ce693 -r a132d206a36a src/operators/op-b-b.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-b-b.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,95 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// bool unary ops. + +// scalar unary ops. + +DEFUNOP_OP (not, bool, !) + +UNOPDECL (uplus, a) +{ + CAST_UNOP_ARG (const octave_bool&); + return octave_value (v.double_value ()); +} + +UNOPDECL (uminus, a) +{ + CAST_UNOP_ARG (const octave_bool&); + return octave_value (- v.double_value ()); +} + +DEFUNOP_OP (transpose, bool, /* no-op */) +DEFUNOP_OP (hermitian, bool, /* no-op */) + +// bool by bool ops. + +DEFBINOP_OP (eq, bool, bool, ==) +DEFBINOP_OP (ne, bool, bool, !=) +DEFBINOP_OP (el_and, bool, bool, &&) +DEFBINOP_OP (el_or, bool, bool, ||) + +DEFNDCATOP_FN (b_b, bool, bool, bool_array, bool_array, concat) +DEFNDCATOP_FN (b_s, bool, scalar, array, array, concat) +DEFNDCATOP_FN (s_b, scalar, bool, array, array, concat) +DEFNDCATOP_FN (b_f, bool, float_scalar, float_array, float_array, concat) +DEFNDCATOP_FN (f_b, float_scalar, bool, float_array, float_array, concat) + +void +install_b_b_ops (void) +{ + INSTALL_UNOP (op_not, octave_bool, not); + INSTALL_UNOP (op_uplus, octave_bool, uplus); + INSTALL_UNOP (op_uminus, octave_bool, uminus); + INSTALL_UNOP (op_transpose, octave_bool, transpose); + INSTALL_UNOP (op_hermitian, octave_bool, hermitian); + + INSTALL_BINOP (op_eq, octave_bool, octave_bool, eq); + INSTALL_BINOP (op_ne, octave_bool, octave_bool, ne); + INSTALL_BINOP (op_el_and, octave_bool, octave_bool, el_and); + INSTALL_BINOP (op_el_or, octave_bool, octave_bool, el_or); + + INSTALL_CATOP (octave_bool, octave_bool, b_b); + INSTALL_CATOP (octave_bool, octave_scalar, b_s); + INSTALL_CATOP (octave_scalar, octave_bool, s_b); + INSTALL_CATOP (octave_bool, octave_float_scalar, b_f); + INSTALL_CATOP (octave_float_scalar, octave_bool, f_b); + + INSTALL_ASSIGNCONV (octave_bool, octave_bool, octave_bool_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-b-bm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-b-bm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,80 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// bool matrix by bool ops. + +DEFNDBINOP_FN (el_and, bool, bool_matrix, bool, bool_array, mx_el_and) +DEFNDBINOP_FN (el_or, bool, bool_matrix, bool, bool_array, mx_el_or) + +DEFNDBINOP_FN (el_and_not, bool, bool_matrix, bool, bool_array, mx_el_and_not) +DEFNDBINOP_FN (el_or_not, bool, bool_matrix, bool, bool_array, mx_el_or_not) + +DEFNDCATOP_FN (b_bm, bool, bool_matrix, bool_array, bool_array, concat) +DEFNDCATOP_FN (b_m, bool, matrix, array, array, concat) +DEFNDCATOP_FN (s_bm, scalar, bool_matrix, array, array, concat) + +DEFNDCATOP_FN (b_fm, bool, float_matrix, float_array, float_array, concat) +DEFNDCATOP_FN (f_bm, float_scalar, bool_matrix, float_array, float_array, concat) + +DEFCONV (bool_matrix_conv, bool, bool_matrix) +{ + CAST_CONV_ARG (const octave_bool&); + + return new octave_bool_matrix (v.bool_matrix_value ()); +} + +void +install_b_bm_ops (void) +{ + INSTALL_BINOP (op_el_and, octave_bool, octave_bool_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_bool, octave_bool_matrix, el_or); + INSTALL_BINOP (op_el_and_not, octave_bool, octave_bool_matrix, el_and_not); + INSTALL_BINOP (op_el_or_not, octave_bool, octave_bool_matrix, el_or_not); + + INSTALL_CATOP (octave_bool, octave_bool_matrix, b_bm); + INSTALL_CATOP (octave_bool, octave_matrix, b_m); + INSTALL_CATOP (octave_scalar, octave_bool_matrix, s_bm); + INSTALL_CATOP (octave_bool, octave_float_matrix, b_fm); + INSTALL_CATOP (octave_float_scalar, octave_bool_matrix, f_bm); + + INSTALL_ASSIGNCONV (octave_bool, octave_bool_matrix, octave_bool_matrix); + + INSTALL_WIDENOP (octave_bool, octave_bool_matrix, bool_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-b-sbm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-b-sbm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,95 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-scalar.h" +#include "ops.h" + +#include "ov-re-sparse.h" +#include "ov-bool-sparse.h" + +// bool by sparse bool matrix ops. + +DEFBINOP_FN (ne, bool, sparse_bool_matrix, mx_el_ne) +DEFBINOP_FN (eq, bool, sparse_bool_matrix, mx_el_eq) + +DEFBINOP_FN (el_and, bool, sparse_bool_matrix, mx_el_and) +DEFBINOP_FN (el_or, bool, sparse_bool_matrix, mx_el_or) + +DEFCATOP (b_sbm, bool, sparse_bool_matrix) +{ + CAST_BINOP_ARGS (octave_bool&, const octave_sparse_bool_matrix&); + SparseBoolMatrix tmp (1, 1, v1.bool_value ()); + return octave_value (tmp. concat (v2.sparse_bool_matrix_value (), + ra_idx)); +} + +DEFCATOP (b_sm, bool, sparse_matrix) +{ + CAST_BINOP_ARGS (octave_bool&, const octave_sparse_matrix&); + SparseMatrix tmp (1, 1, v1.scalar_value ()); + return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); +} + +DEFCATOP (s_sbm, scalar, sparse_bool_matrix) +{ + CAST_BINOP_ARGS (octave_scalar&, const octave_sparse_bool_matrix&); + SparseMatrix tmp (1, 1, v1.scalar_value ()); + return octave_value(tmp. concat (v2.sparse_matrix_value (), ra_idx)); +} + +DEFCONV (sparse_bool_matrix_conv, bool, sparse_bool_matrix) +{ + CAST_CONV_ARG (const octave_bool&); + + return new octave_sparse_bool_matrix + (SparseBoolMatrix (1, 1, v.bool_value ())); +} + +void +install_b_sbm_ops (void) +{ + INSTALL_BINOP (op_eq, octave_bool, octave_sparse_bool_matrix, eq); + INSTALL_BINOP (op_ne, octave_bool, octave_sparse_bool_matrix, ne); + + INSTALL_BINOP (op_el_and, octave_bool, octave_sparse_bool_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_bool, octave_sparse_bool_matrix, el_or); + + INSTALL_CATOP (octave_bool, octave_sparse_bool_matrix, b_sbm); + INSTALL_CATOP (octave_bool, octave_sparse_matrix, b_sm); + INSTALL_CATOP (octave_scalar, octave_sparse_bool_matrix, s_sbm); + + INSTALL_ASSIGNCONV (octave_bool, octave_sparse_bool_matrix, + octave_bool_matrix); + + INSTALL_WIDENOP (octave_bool, octave_sparse_bool_matrix, sparse_bool_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-bm-b.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-bm-b.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,111 @@ +/* + +Copyright (C) 2001-2012 Cai Jianming + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-str-mat.h" +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// bool matrix by bool ops. + +DEFNDBINOP_FN (el_and, bool_matrix, bool, bool_array, bool, mx_el_and) +DEFNDBINOP_FN (el_or, bool_matrix, bool, bool_array, bool, mx_el_or) + +DEFNDBINOP_FN (el_not_and, bool_matrix, bool, bool_array, bool, mx_el_not_and) +DEFNDBINOP_FN (el_not_or, bool_matrix, bool, bool_array, bool, mx_el_not_or) + +DEFNDCATOP_FN (bm_b, bool_matrix, bool, bool_array, bool_array, concat) +DEFNDCATOP_FN (bm_s, bool_matrix, scalar, array, array, concat) +DEFNDCATOP_FN (m_b, matrix, bool, array, array, concat) +DEFNDCATOP_FN (bm_f, bool_matrix, float_scalar, float_array, float_array, concat) +DEFNDCATOP_FN (fm_b, float_matrix, bool, float_array, float_array, concat) + +DEFNDASSIGNOP_FN (assign, bool_matrix, bool, bool_array, assign) + +static octave_value +oct_assignop_conv_and_assign (octave_base_value& a1, + const octave_value_list& idx, + const octave_base_value& a2) +{ + octave_bool_matrix& v1 = dynamic_cast (a1); + + // FIXME -- perhaps add a warning for this conversion if the values + // are not all 0 or 1? + + boolNDArray v2 = a2.bool_array_value (true); + + if (! error_state) + v1.assign (idx, v2); + + return octave_value (); +} + +void +install_bm_b_ops (void) +{ + INSTALL_BINOP (op_el_and, octave_bool_matrix, octave_bool, el_and); + INSTALL_BINOP (op_el_or, octave_bool_matrix, octave_bool, el_or); + INSTALL_BINOP (op_el_not_and, octave_bool_matrix, octave_bool, el_not_and); + INSTALL_BINOP (op_el_not_or, octave_bool_matrix, octave_bool, el_not_or); + + INSTALL_CATOP (octave_bool_matrix, octave_bool, bm_b); + INSTALL_CATOP (octave_bool_matrix, octave_scalar, bm_s); + INSTALL_CATOP (octave_matrix, octave_bool, m_b); + INSTALL_CATOP (octave_bool_matrix, octave_float_scalar, bm_f); + INSTALL_CATOP (octave_float_matrix, octave_bool, fm_b); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_bool, assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_scalar, conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int8_scalar, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int16_scalar, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int32_scalar, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int64_scalar, conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint8_scalar, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint16_scalar, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint32_scalar, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint64_scalar, conv_and_assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-bm-bm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-bm-bm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,184 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-bool-mat.h" +#include "ov-scalar.h" +#include "ov-range.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-re-sparse.h" +#include "ov-str-mat.h" +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// unary bool matrix ops. + +DEFNDUNOP_OP (not, bool_matrix, bool_array, !) +DEFNDUNOP_OP (uplus, bool_matrix, array, +) +DEFNDUNOP_OP (uminus, bool_matrix, array, -) + +DEFNCUNOP_METHOD (invert, bool_matrix, invert) + +DEFUNOP (transpose, bool_matrix) +{ + CAST_UNOP_ARG (const octave_bool_matrix&); + + if (v.ndims () > 2) + { + error ("transpose not defined for N-d objects"); + return octave_value (); + } + else + return octave_value (v.bool_matrix_value ().transpose ()); +} + +// bool matrix by bool matrix ops. + +DEFNDBINOP_FN (eq, bool_matrix, bool_matrix, bool_array, bool_array, mx_el_eq) +DEFNDBINOP_FN (ne, bool_matrix, bool_matrix, bool_array, bool_array, mx_el_ne) + +DEFNDBINOP_FN (el_and, bool_matrix, bool_matrix, bool_array, bool_array, + mx_el_and) + +DEFNDBINOP_FN (el_or, bool_matrix, bool_matrix, bool_array, bool_array, + mx_el_or) + +DEFNDBINOP_FN (el_not_and, bool_matrix, bool_matrix, bool_array, bool_array, + mx_el_not_and) + +DEFNDBINOP_FN (el_not_or, bool_matrix, bool_matrix, bool_array, bool_array, + mx_el_not_or) + +DEFNDBINOP_FN (el_and_not, bool_matrix, bool_matrix, bool_array, bool_array, + mx_el_and_not) + +DEFNDBINOP_FN (el_or_not, bool_matrix, bool_matrix, bool_array, bool_array, + mx_el_or_not) + +DEFNDCATOP_FN (bm_bm, bool_matrix, bool_matrix, bool_array, bool_array, concat) +DEFNDCATOP_FN (bm_m, bool_matrix, matrix, array, array, concat) +DEFNDCATOP_FN (m_bm, matrix, bool_matrix, array, array, concat) +DEFNDCATOP_FN (bm_fm, bool_matrix, float_matrix, float_array, float_array, concat) +DEFNDCATOP_FN (fm_bm, float_matrix, bool_matrix, float_array, float_array, concat) + +DEFNDASSIGNOP_FN (assign, bool_matrix, bool_matrix, bool_array, assign) +DEFNDASSIGNOP_FNOP (assign_and, bool_matrix, bool_matrix, bool_array, mx_el_and_assign) +DEFNDASSIGNOP_FNOP (assign_or, bool_matrix, bool_matrix, bool_array, mx_el_or_assign) + +DEFNULLASSIGNOP_FN (null_assign, bool_matrix, delete_elements) + +static octave_value +oct_assignop_conv_and_assign (octave_base_value& a1, + const octave_value_list& idx, + const octave_base_value& a2) +{ + octave_bool_matrix& v1 = dynamic_cast (a1); + + // FIXME -- perhaps add a warning for this conversion if the values + // are not all 0 or 1? + + boolNDArray v2 = a2.bool_array_value (true); + + if (! error_state) + v1.assign (idx, v2); + + return octave_value (); +} + +DEFCONVFN (matrix_to_bool_matrix, matrix, bool) +DEFCONVFN (scalar_to_bool_matrix, scalar, bool) + +void +install_bm_bm_ops (void) +{ + INSTALL_UNOP (op_not, octave_bool_matrix, not); + INSTALL_UNOP (op_uplus, octave_bool_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_bool_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_bool_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_bool_matrix, transpose); + + INSTALL_NCUNOP (op_not, octave_bool_matrix, invert); + + INSTALL_BINOP (op_eq, octave_bool_matrix, octave_bool_matrix, eq); + INSTALL_BINOP (op_ne, octave_bool_matrix, octave_bool_matrix, ne); + + INSTALL_BINOP (op_el_and, octave_bool_matrix, octave_bool_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_bool_matrix, octave_bool_matrix, el_or); + INSTALL_BINOP (op_el_not_and, octave_bool_matrix, octave_bool_matrix, el_not_and); + INSTALL_BINOP (op_el_not_or, octave_bool_matrix, octave_bool_matrix, el_not_or); + INSTALL_BINOP (op_el_and_not, octave_bool_matrix, octave_bool_matrix, el_and_not); + INSTALL_BINOP (op_el_or_not, octave_bool_matrix, octave_bool_matrix, el_or_not); + + INSTALL_CATOP (octave_bool_matrix, octave_bool_matrix, bm_bm); + INSTALL_CATOP (octave_bool_matrix, octave_matrix, bm_m); + INSTALL_CATOP (octave_matrix, octave_bool_matrix, m_bm); + INSTALL_CATOP (octave_bool_matrix, octave_float_matrix, bm_fm); + INSTALL_CATOP (octave_float_matrix, octave_bool_matrix, fm_bm); + + INSTALL_CONVOP (octave_matrix, octave_bool_matrix, matrix_to_bool_matrix); + INSTALL_CONVOP (octave_scalar, octave_bool_matrix, scalar_to_bool_matrix); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_bool_matrix, assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_matrix, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_char_matrix_str, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_char_matrix_sq_str, conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_range, conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_sparse_matrix, conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int8_matrix, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int16_matrix, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int32_matrix, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_int64_matrix, conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint8_matrix, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint16_matrix, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint32_matrix, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_uint64_matrix, conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_null_matrix, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_null_str, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_null_sq_str, null_assign); + + INSTALL_ASSIGNOP (op_el_and_eq, octave_bool_matrix, octave_bool_matrix, assign_and); + INSTALL_ASSIGNOP (op_el_or_eq, octave_bool_matrix, octave_bool_matrix, assign_or); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-bm-sbm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-bm-sbm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,103 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-bool-mat.h" +#include "boolMatrix.h" +#include "ov-scalar.h" +#include "ops.h" + +#include "ov-re-sparse.h" +#include "ov-bool-sparse.h" +#include "smx-bm-sbm.h" +#include "smx-sbm-bm.h" + +// bool matrix by sparse bool matrix ops. + +DEFBINOP_FN (eq, bool_matrix, sparse_bool_matrix, mx_el_eq) +DEFBINOP_FN (ne, bool_matrix, sparse_bool_matrix, mx_el_ne) + +DEFBINOP_FN (el_and, bool_matrix, sparse_bool_matrix, mx_el_and) +DEFBINOP_FN (el_or, bool_matrix, sparse_bool_matrix, mx_el_or) + +DEFCATOP (bm_sbm, bool_matrix, sparse_bool_matrix) +{ + CAST_BINOP_ARGS (octave_bool_matrix&, const octave_sparse_bool_matrix&); + SparseBoolMatrix tmp (v1.bool_matrix_value ()); + return octave_value (tmp. concat (v2.sparse_bool_matrix_value (), + ra_idx)); +} + +DEFCATOP (m_sbm, matrix, sparse_bool_matrix) +{ + CAST_BINOP_ARGS (octave_matrix&, const octave_sparse_bool_matrix&); + SparseMatrix tmp (v1.matrix_value ()); + return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); +} + +DEFCATOP (bm_sm, bool_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (octave_bool_matrix&, const octave_sparse_matrix&); + SparseMatrix tmp (v1.matrix_value ()); + return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); +} + +DEFCONV (sparse_bool_matrix_conv, bool_matrix, sparse_bool_matrix) +{ + CAST_CONV_ARG (const octave_bool_matrix&); + return new octave_sparse_bool_matrix + (SparseBoolMatrix (v.bool_matrix_value ())); +} + +DEFNDASSIGNOP_FN (assign, bool_matrix, sparse_bool_matrix, bool_array, assign) + +void +install_bm_sbm_ops (void) +{ + INSTALL_BINOP (op_eq, octave_bool_matrix, octave_sparse_bool_matrix, eq); + INSTALL_BINOP (op_ne, octave_bool_matrix, octave_sparse_bool_matrix, ne); + + INSTALL_BINOP (op_el_and, octave_bool_matrix, octave_sparse_bool_matrix, + el_and); + INSTALL_BINOP (op_el_or, octave_bool_matrix, octave_sparse_bool_matrix, + el_or); + + INSTALL_CATOP (octave_bool_matrix, octave_sparse_bool_matrix, bm_sbm); + INSTALL_CATOP (octave_bool_matrix, octave_sparse_matrix, bm_sm); + INSTALL_CATOP (octave_matrix, octave_sparse_bool_matrix, m_sbm); + + INSTALL_ASSIGNOP (op_asn_eq, octave_bool_matrix, octave_sparse_bool_matrix, + assign) + INSTALL_ASSIGNCONV (octave_bool_matrix, octave_sparse_bool_matrix, + octave_bool_matrix); + + INSTALL_WIDENOP (octave_bool_matrix, octave_sparse_bool_matrix, + sparse_bool_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cdm-cdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cdm-cdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,110 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-cx-diag.h" +#include "ov-flt-cx-diag.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix unary ops. + +DEFUNOP_OP (uplus, complex_diag_matrix, /* no-op */) +DEFUNOP_OP (uminus, complex_diag_matrix, -) + +DEFUNOP (transpose, complex_diag_matrix) +{ + CAST_UNOP_ARG (const octave_complex_diag_matrix&); + return octave_value (v.complex_diag_matrix_value ().transpose ()); +} + +DEFUNOP (hermitian, complex_diag_matrix) +{ + CAST_UNOP_ARG (const octave_complex_diag_matrix&); + return octave_value (v.complex_diag_matrix_value ().hermitian ()); +} + +// matrix by matrix ops. + +DEFBINOP_OP (add, complex_diag_matrix, complex_diag_matrix, +) +DEFBINOP_OP (sub, complex_diag_matrix, complex_diag_matrix, -) +DEFBINOP_OP (mul, complex_diag_matrix, complex_diag_matrix, *) + +DEFBINOP (div, complex_diag_matrix, complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_complex_diag_matrix&); + + return xdiv (v1.complex_diag_matrix_value (), + v2.complex_diag_matrix_value ()); +} + +DEFBINOP (ldiv, complex_diag_matrix, complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_complex_diag_matrix&); + + return xleftdiv (v1.complex_diag_matrix_value (), + v2.complex_diag_matrix_value ()); +} + +CONVDECL (complex_diag_matrix_to_complex_matrix) +{ + CAST_CONV_ARG (const octave_complex_diag_matrix&); + + return new octave_complex_matrix (v.complex_matrix_value ()); +} + +CONVDECL (complex_diag_matrix_to_float_complex_diag_matrix) +{ + CAST_CONV_ARG (const octave_complex_diag_matrix&); + + return new octave_float_complex_diag_matrix (v.float_complex_diag_matrix_value ()); +} + +void +install_cdm_cdm_ops (void) +{ + INSTALL_UNOP (op_uplus, octave_complex_diag_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_complex_diag_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_complex_diag_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_complex_diag_matrix, hermitian); + + INSTALL_BINOP (op_add, octave_complex_diag_matrix, octave_complex_diag_matrix, add); + INSTALL_BINOP (op_sub, octave_complex_diag_matrix, octave_complex_diag_matrix, sub); + INSTALL_BINOP (op_mul, octave_complex_diag_matrix, octave_complex_diag_matrix, mul); + INSTALL_BINOP (op_div, octave_complex_diag_matrix, octave_complex_diag_matrix, div); + INSTALL_BINOP (op_ldiv, octave_complex_diag_matrix, octave_complex_diag_matrix, ldiv); + + INSTALL_CONVOP (octave_complex_diag_matrix, octave_complex_matrix, complex_diag_matrix_to_complex_matrix); + INSTALL_CONVOP (octave_complex_diag_matrix, octave_float_complex_diag_matrix, + complex_diag_matrix_to_float_complex_diag_matrix); + INSTALL_ASSIGNCONV (octave_complex_diag_matrix, octave_complex_matrix, octave_complex_matrix); + INSTALL_WIDENOP (octave_complex_diag_matrix, octave_complex_matrix, complex_diag_matrix_to_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cdm-cm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cdm-cm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-cx-diag.h" +#define RINCLUDE "ov-cx-mat.h" + +#define LMATRIX complex_diag_matrix +#define RMATRIX complex_matrix + +#define LSHORT cdm +#define RSHORT cm + +#define DEFINELDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-cdm-cs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cdm-cs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,33 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define SINCLUDE "ov-complex.h" +#define MINCLUDE "ov-cx-diag.h" + +#define SCALAR complex +#define MATRIX complex_diag_matrix + +#define SSHORT cs +#define MSHORT cdm + +#include "op-dms-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-cdm-dm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cdm-dm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,37 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-cx-diag.h" +#define RINCLUDE "ov-re-diag.h" + +#define LMATRIX complex_diag_matrix +#define RMATRIX diag_matrix +#define RDMATRIX LMATRIX + +#define LSHORT cdm +#define RSHORT dm + +#define DEFINEDIV +#define DEFINELDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-cdm-m.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cdm-m.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,38 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-cx-diag.h" +#define RINCLUDE "ov-re-mat.h" + +#define LMATRIX complex_diag_matrix +#define LDMATRIX complex_matrix +#define RMATRIX matrix +#define RDMATRIX complex_matrix + +#define LSHORT cdm +#define RSHORT m + +#define DEFINELDIV +#define DEFINENULLASSIGNCONV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-cdm-s.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cdm-s.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,34 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define SINCLUDE "ov-scalar.h" +#define MINCLUDE "ov-cx-diag.h" + +#define SCALAR scalar +#define SCALARV complex +#define MATRIX complex_diag_matrix + +#define SSHORT s +#define MSHORT cdm + +#include "op-dms-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-cell.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cell.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,71 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-cell.h" +#include "ov-scalar.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" + +// cell ops. + +DEFUNOP (transpose, cell) +{ + CAST_UNOP_ARG (const octave_cell&); + + if (v.ndims () > 2) + { + error ("transpose not defined for N-d objects"); + return octave_value (); + } + else + return octave_value (Cell (v.cell_value ().transpose ())); +} + +DEFCATOP_FN (c_c, cell, cell, concat) + +DEFASSIGNANYOP_FN (assign, cell, assign); + +DEFNULLASSIGNOP_FN (null_assign, cell, delete_elements) + +void +install_cell_ops (void) +{ + INSTALL_UNOP (op_transpose, octave_cell, transpose); + INSTALL_UNOP (op_hermitian, octave_cell, transpose); + + INSTALL_CATOP (octave_cell, octave_cell, c_c); + + INSTALL_ASSIGNANYOP (op_asn_eq, octave_cell, assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_cell, octave_null_matrix, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_cell, octave_null_str, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_cell, octave_null_sq_str, null_assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-chm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-chm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,105 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-ch-mat.h" +#include "ov-scalar.h" +#include "ov-re-mat.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" + +// char matrix unary ops. + +DEFUNOP (transpose, char_matrix) +{ + CAST_UNOP_ARG (const octave_char_matrix&); + + return octave_value (v.matrix_value ().transpose ()); +} + +DEFNDCATOP_FN (chm_chm, char_matrix, char_matrix, char_array, char_array, + concat) + +DEFCATOP (chm_s, char_matrix, scalar) +{ + CAST_BINOP_ARGS (octave_char_matrix&, const octave_scalar&); + + gripe_implicit_conversion ("Octave:num-to-str", + v2.type_name (), v1.type_name ()); + + return octave_value (v1.char_array_value (). concat(v2.array_value (), + ra_idx)); +} + +DEFCATOP (chm_m, char_matrix, matrix) +{ + CAST_BINOP_ARGS (octave_char_matrix&, const octave_matrix&); + + gripe_implicit_conversion ("Octave:num-to-str", + v2.type_name (), v1.type_name ()); + + return octave_value (v1.char_array_value (). concat (v2.array_value (), + ra_idx)); +} + +DEFCATOP (s_chm, scalar, char_matrix) +{ + CAST_BINOP_ARGS (octave_scalar&, const octave_char_matrix&); + + gripe_implicit_conversion ("Octave:num-to-str", + v1.type_name (), v2.type_name ()); + + return octave_value (v1.array_value (). concat (v2.char_array_value (), + ra_idx)); +} + +DEFCATOP (m_chm, matrix, char_matrix) +{ + CAST_BINOP_ARGS (octave_matrix&, const octave_char_matrix&); + + gripe_implicit_conversion ("Octave:num-to-str", + v1.type_name (), v2.type_name ()); + + return octave_value (v1.array_value (). concat (v2.char_array_value (), + ra_idx)); +} + +void +install_chm_ops (void) +{ + INSTALL_UNOP (op_transpose, octave_char_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_char_matrix, transpose); + + INSTALL_CATOP (octave_char_matrix, octave_char_matrix, chm_chm); + INSTALL_CATOP (octave_char_matrix, octave_scalar, chm_s); + INSTALL_CATOP (octave_char_matrix, octave_matrix, chm_m); + INSTALL_CATOP (octave_scalar, octave_char_matrix, s_chm); + INSTALL_CATOP (octave_matrix, octave_char_matrix, m_chm); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-class.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-class.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,161 @@ +/* + +Copyright (C) 2007-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "oct-time.h" + +#include "gripes.h" +#include "load-path.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-class.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "symtab.h" +#include "parse.h" + +// class ops. + +#define DEF_CLASS_UNOP(name) \ + static octave_value \ + oct_unop_ ## name (const octave_value& a) \ + { \ + octave_value retval; \ + \ + std::string class_name = a.class_name (); \ + \ + octave_value meth = symbol_table::find_method (#name, class_name); \ + \ + if (meth.is_defined ()) \ + { \ + octave_value_list args; \ + \ + args(0) = a; \ + \ + octave_value_list tmp = feval (meth.function_value (), args, 1); \ + \ + if (tmp.length () > 0) \ + retval = tmp(0); \ + } \ + else \ + error ("%s method not defined for %s class", \ + #name, class_name.c_str ()); \ + \ + return retval; \ + } + +DEF_CLASS_UNOP (not) +DEF_CLASS_UNOP (uplus) +DEF_CLASS_UNOP (uminus) +DEF_CLASS_UNOP (transpose) +DEF_CLASS_UNOP (ctranspose) + +// FIXME -- we need to handle precedence in the binop function. + +#define DEF_CLASS_BINOP(name) \ + static octave_value \ + oct_binop_ ## name (const octave_value& a1, const octave_value& a2) \ + { \ + octave_value retval; \ + \ + std::string dispatch_type \ + = a1.is_object () ? a1.class_name () : a2.class_name (); \ + \ + octave_value meth = symbol_table::find_method (#name, dispatch_type); \ + \ + if (meth.is_defined ()) \ + { \ + octave_value_list args; \ + \ + args(1) = a2; \ + args(0) = a1; \ + \ + octave_value_list tmp = feval (meth.function_value (), args, 1); \ + \ + if (tmp.length () > 0) \ + retval = tmp(0); \ + } \ + else \ + error ("%s method not defined for %s class", \ + #name, dispatch_type.c_str ()); \ + \ + return retval; \ + } + +DEF_CLASS_BINOP (plus) +DEF_CLASS_BINOP (minus) +DEF_CLASS_BINOP (mtimes) +DEF_CLASS_BINOP (mrdivide) +DEF_CLASS_BINOP (mpower) +DEF_CLASS_BINOP (mldivide) +DEF_CLASS_BINOP (lt) +DEF_CLASS_BINOP (le) +DEF_CLASS_BINOP (eq) +DEF_CLASS_BINOP (ge) +DEF_CLASS_BINOP (gt) +DEF_CLASS_BINOP (ne) +DEF_CLASS_BINOP (times) +DEF_CLASS_BINOP (rdivide) +DEF_CLASS_BINOP (power) +DEF_CLASS_BINOP (ldivide) +DEF_CLASS_BINOP (and) +DEF_CLASS_BINOP (or) + +#define INSTALL_CLASS_UNOP(op, f) \ + octave_value_typeinfo::register_unary_class_op \ + (octave_value::op, oct_unop_ ## f) + +#define INSTALL_CLASS_BINOP(op, f) \ + octave_value_typeinfo::register_binary_class_op \ + (octave_value::op, oct_binop_ ## f) + +void +install_class_ops (void) +{ + INSTALL_CLASS_UNOP (op_not, not); + INSTALL_CLASS_UNOP (op_uplus, uplus); + INSTALL_CLASS_UNOP (op_uminus, uminus); + INSTALL_CLASS_UNOP (op_transpose, transpose); + INSTALL_CLASS_UNOP (op_hermitian, ctranspose); + + INSTALL_CLASS_BINOP (op_add, plus); + INSTALL_CLASS_BINOP (op_sub, minus); + INSTALL_CLASS_BINOP (op_mul, mtimes); + INSTALL_CLASS_BINOP (op_div, mrdivide); + INSTALL_CLASS_BINOP (op_pow, mpower); + INSTALL_CLASS_BINOP (op_ldiv, mldivide); + INSTALL_CLASS_BINOP (op_lt, lt); + INSTALL_CLASS_BINOP (op_le, le); + INSTALL_CLASS_BINOP (op_eq, eq); + INSTALL_CLASS_BINOP (op_ge, ge); + INSTALL_CLASS_BINOP (op_gt, gt); + INSTALL_CLASS_BINOP (op_ne, ne); + INSTALL_CLASS_BINOP (op_el_mul, times); + INSTALL_CLASS_BINOP (op_el_div, rdivide); + INSTALL_CLASS_BINOP (op_el_pow, power); + INSTALL_CLASS_BINOP (op_el_ldiv, ldivide); + INSTALL_CLASS_BINOP (op_el_and, and); + INSTALL_CLASS_BINOP (op_el_or, or); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cm-cdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cm-cdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-cx-mat.h" +#define RINCLUDE "ov-cx-diag.h" + +#define LMATRIX complex_matrix +#define RMATRIX complex_diag_matrix + +#define LSHORT cm +#define RSHORT cdm + +#define DEFINEDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-cm-cm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cm-cm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,260 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// unary complex matrix ops. + +DEFNDUNOP_OP (not, complex_matrix, complex_array, !) +DEFNDUNOP_OP (uplus, complex_matrix, complex_array, /* no-op */) +DEFNDUNOP_OP (uminus, complex_matrix, complex_array, -) + +DEFUNOP (transpose, complex_matrix) +{ + CAST_UNOP_ARG (const octave_complex_matrix&); + + if (v.ndims () > 2) + { + error ("transpose not defined for N-d objects"); + return octave_value (); + } + else + return octave_value (v.complex_matrix_value ().transpose ()); +} + +DEFUNOP (hermitian, complex_matrix) +{ + CAST_UNOP_ARG (const octave_complex_matrix&); + + if (v.ndims () > 2) + { + error ("complex-conjugate transpose not defined for N-d objects"); + return octave_value (); + } + else + return octave_value (v.complex_matrix_value ().hermitian ()); +} + +DEFNCUNOP_METHOD (incr, complex_matrix, increment) +DEFNCUNOP_METHOD (decr, complex_matrix, decrement) +DEFNCUNOP_METHOD (changesign, complex_matrix, changesign) + +// complex matrix by complex matrix ops. + +DEFNDBINOP_OP (add, complex_matrix, complex_matrix, complex_array, complex_array, +) +DEFNDBINOP_OP (sub, complex_matrix, complex_matrix, complex_array, complex_array, -) + +DEFBINOP_OP (mul, complex_matrix, complex_matrix, *) + +DEFBINOP (div, complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.complex_matrix_value (), + v2.complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOPX (pow, complex_matrix, complex_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), + v2.complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP (trans_mul, complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + return octave_value(xgemm (v1.complex_matrix_value (), + v2.complex_matrix_value (), + blas_trans, blas_no_trans)); +} + +DEFBINOP (mul_trans, complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + return octave_value(xgemm (v1.complex_matrix_value (), + v2.complex_matrix_value (), + blas_no_trans, blas_trans)); +} + +DEFBINOP (herm_mul, complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + return octave_value(xgemm (v1.complex_matrix_value (), + v2.complex_matrix_value (), + blas_conj_trans, blas_no_trans)); +} + +DEFBINOP (mul_herm, complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + return octave_value(xgemm (v1.complex_matrix_value (), + v2.complex_matrix_value (), + blas_no_trans, blas_conj_trans)); +} + +DEFBINOP (trans_ldiv, complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), + v2.complex_matrix_value (), typ, blas_trans); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP (herm_ldiv, complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), + v2.complex_matrix_value (), typ, blas_conj_trans); + + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_ne) + +DEFNDBINOP_FN (el_mul, complex_matrix, complex_matrix, complex_array, complex_array, product) +DEFNDBINOP_FN (el_div, complex_matrix, complex_matrix, complex_array, complex_array, quotient) +DEFNDBINOP_FN (el_pow, complex_matrix, complex_matrix, complex_array, complex_array, elem_xpow) + +DEFBINOP (el_ldiv, complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + return octave_value (quotient (v2.complex_array_value (), v1.complex_array_value ())); +} + +DEFNDBINOP_FN (el_and, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_and) +DEFNDBINOP_FN (el_or, complex_matrix, complex_matrix, complex_array, complex_array, mx_el_or) + +DEFNDCATOP_FN (cm_cm, complex_matrix, complex_matrix, complex_array, complex_array, concat) + +DEFNDASSIGNOP_FN (assign, complex_matrix, complex_matrix, complex_array, assign) + +DEFNULLASSIGNOP_FN (null_assign, complex_matrix, delete_elements) + +DEFNDASSIGNOP_OP (assign_add, complex_matrix, complex_matrix, complex_array, +=) +DEFNDASSIGNOP_OP (assign_sub, complex_matrix, complex_matrix, complex_array, -=) +DEFNDASSIGNOP_FNOP (assign_el_mul, complex_matrix, complex_matrix, complex_array, product_eq) +DEFNDASSIGNOP_FNOP (assign_el_div, complex_matrix, complex_matrix, complex_array, quotient_eq) + +CONVDECL (complex_matrix_to_float_complex_matrix) +{ + CAST_CONV_ARG (const octave_complex_matrix&); + + return new octave_float_complex_matrix (FloatComplexNDArray (v.complex_array_value ())); +} + +void +install_cm_cm_ops (void) +{ + INSTALL_UNOP (op_not, octave_complex_matrix, not); + INSTALL_UNOP (op_uplus, octave_complex_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_complex_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_complex_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_complex_matrix, hermitian); + + INSTALL_NCUNOP (op_incr, octave_complex_matrix, incr); + INSTALL_NCUNOP (op_decr, octave_complex_matrix, decr); + INSTALL_NCUNOP (op_uminus, octave_complex_matrix, changesign); + + INSTALL_BINOP (op_add, octave_complex_matrix, octave_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_complex_matrix, octave_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_complex_matrix, octave_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_complex_matrix, octave_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_complex_matrix, octave_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_complex_matrix, octave_complex_matrix, ldiv); + INSTALL_BINOP (op_trans_mul, octave_complex_matrix, octave_complex_matrix, trans_mul); + INSTALL_BINOP (op_mul_trans, octave_complex_matrix, octave_complex_matrix, mul_trans); + INSTALL_BINOP (op_herm_mul, octave_complex_matrix, octave_complex_matrix, herm_mul); + INSTALL_BINOP (op_mul_herm, octave_complex_matrix, octave_complex_matrix, mul_herm); + INSTALL_BINOP (op_trans_ldiv, octave_complex_matrix, octave_complex_matrix, trans_ldiv); + INSTALL_BINOP (op_herm_ldiv, octave_complex_matrix, octave_complex_matrix, herm_ldiv); + + INSTALL_BINOP (op_lt, octave_complex_matrix, octave_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_complex_matrix, octave_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_complex_matrix, octave_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_complex_matrix, octave_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_complex_matrix, octave_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_complex_matrix, octave_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_complex_matrix, octave_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_complex_matrix, octave_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_complex_matrix, octave_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, octave_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex_matrix, octave_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_complex_matrix, octave_complex_matrix, el_or); + + INSTALL_CATOP (octave_complex_matrix, octave_complex_matrix, cm_cm); + + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_complex_matrix, assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_null_matrix, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_null_str, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_null_sq_str, null_assign); + + INSTALL_ASSIGNOP (op_add_eq, octave_complex_matrix, octave_complex_matrix, assign_add); + INSTALL_ASSIGNOP (op_sub_eq, octave_complex_matrix, octave_complex_matrix, assign_sub); + INSTALL_ASSIGNOP (op_el_mul_eq, octave_complex_matrix, octave_complex_matrix, assign_el_mul); + INSTALL_ASSIGNOP (op_el_div_eq, octave_complex_matrix, octave_complex_matrix, assign_el_div); + + INSTALL_CONVOP (octave_complex_matrix, octave_float_complex_matrix, + complex_matrix_to_float_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cm-cs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cm-cs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,145 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-complex.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex matrix by complex scalar ops. + +DEFNDBINOP_OP (add, complex_matrix, complex, complex_array, complex, +) +DEFNDBINOP_OP (sub, complex_matrix, complex, complex_array, complex, -) +DEFNDBINOP_OP (mul, complex_matrix, complex, complex_array, complex, *) + +DEFBINOP (div, complex_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_array_value () / d); +} + +DEFBINOP_FN (pow, complex_matrix, complex, xpow) + +DEFBINOP (ldiv, complex_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + ComplexMatrix m1 = v1.complex_matrix_value (); + ComplexMatrix m2 = v2.complex_matrix_value (); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (m1, m2, typ); + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, complex_matrix, complex, complex_array, complex, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, complex_matrix, complex, complex_array, complex, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, complex_matrix, complex, complex_array, complex, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, complex_matrix, complex, complex_array, complex, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, complex_matrix, complex, complex_array, complex, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, complex_matrix, complex, complex_array, complex, mx_el_ne) + +DEFNDBINOP_OP (el_mul, complex_matrix, complex, complex_array, complex, *) + +DEFBINOP (el_div, complex_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_array_value () / d); +} + +DEFNDBINOP_FN (el_pow, complex_matrix, complex, complex_array, complex, elem_xpow) + +DEFBINOP (el_ldiv, complex_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + return x_el_div (v2.complex_value (), v1.complex_array_value ()); +} + +DEFNDBINOP_FN (el_and, complex_matrix, complex, complex_array, complex, mx_el_and) +DEFNDBINOP_FN (el_or, complex_matrix, complex, complex_array, complex, mx_el_or) + +DEFNDCATOP_FN (cm_cs, complex_matrix, complex, complex_array, complex_array, concat) + +DEFNDASSIGNOP_FN (assign, complex_matrix, complex, complex, assign) +DEFNDASSIGNOP_FN (sgl_assign, float_complex_matrix, complex, float_complex, assign) + +DEFNDASSIGNOP_OP (assign_add, complex_matrix, complex_scalar, complex, +=) +DEFNDASSIGNOP_OP (assign_sub, complex_matrix, complex_scalar, complex, -=) +DEFNDASSIGNOP_OP (assign_mul, complex_matrix, complex_scalar, complex, *=) +DEFNDASSIGNOP_OP (assign_div, complex_matrix, complex_scalar, complex, /=) + +void +install_cm_cs_ops (void) +{ + INSTALL_BINOP (op_add, octave_complex_matrix, octave_complex, add); + INSTALL_BINOP (op_sub, octave_complex_matrix, octave_complex, sub); + INSTALL_BINOP (op_mul, octave_complex_matrix, octave_complex, mul); + INSTALL_BINOP (op_div, octave_complex_matrix, octave_complex, div); + INSTALL_BINOP (op_pow, octave_complex_matrix, octave_complex, pow); + INSTALL_BINOP (op_ldiv, octave_complex_matrix, octave_complex, ldiv); + INSTALL_BINOP (op_lt, octave_complex_matrix, octave_complex, lt); + INSTALL_BINOP (op_le, octave_complex_matrix, octave_complex, le); + INSTALL_BINOP (op_eq, octave_complex_matrix, octave_complex, eq); + INSTALL_BINOP (op_ge, octave_complex_matrix, octave_complex, ge); + INSTALL_BINOP (op_gt, octave_complex_matrix, octave_complex, gt); + INSTALL_BINOP (op_ne, octave_complex_matrix, octave_complex, ne); + INSTALL_BINOP (op_el_mul, octave_complex_matrix, octave_complex, el_mul); + INSTALL_BINOP (op_el_div, octave_complex_matrix, octave_complex, el_div); + INSTALL_BINOP (op_el_pow, octave_complex_matrix, octave_complex, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, octave_complex, el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex_matrix, octave_complex, el_and); + INSTALL_BINOP (op_el_or, octave_complex_matrix, octave_complex, el_or); + + INSTALL_CATOP (octave_complex_matrix, octave_complex, cm_cs); + + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_complex, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_complex, sgl_assign); + + INSTALL_ASSIGNOP (op_add_eq, octave_complex_matrix, octave_complex_scalar, assign_add); + INSTALL_ASSIGNOP (op_sub_eq, octave_complex_matrix, octave_complex_scalar, assign_sub); + INSTALL_ASSIGNOP (op_mul_eq, octave_complex_matrix, octave_complex_scalar, assign_mul); + INSTALL_ASSIGNOP (op_div_eq, octave_complex_matrix, octave_complex_scalar, assign_div); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cm-dm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cm-dm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-cx-mat.h" +#define RINCLUDE "ov-re-diag.h" + +#define LMATRIX complex_matrix +#define RMATRIX diag_matrix + +#define LSHORT cm +#define RSHORT dm + +#define DEFINEDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-cm-m.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cm-m.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,143 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-cm-m.h" +#include "mx-m-cm.h" +#include "mx-cnda-nda.h" +#include "mx-nda-cnda.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex matrix by matrix ops. + +DEFNDBINOP_OP (add, complex_matrix, matrix, complex_array, array, +) +DEFNDBINOP_OP (sub, complex_matrix, matrix, complex_array, array, -) + +DEFBINOP_OP (mul, complex_matrix, matrix, *) + +DEFBINOP (mul_trans, complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + ComplexMatrix m1 = v1.complex_matrix_value (); + Matrix m2 = v2.matrix_value (); + + return ComplexMatrix (xgemm (real (m1), m2, blas_no_trans, blas_trans), + xgemm (imag (m1), m2, blas_no_trans, blas_trans)); +} + +DEFBINOP (div, complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.complex_matrix_value (), + v2.matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + + +DEFBINOPX (pow, complex_matrix, matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), + v2.matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, complex_matrix, matrix, complex_array, array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, complex_matrix, matrix, complex_array, array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, complex_matrix, matrix, complex_array, array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, complex_matrix, matrix, complex_array, array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, complex_matrix, matrix, complex_array, array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, complex_matrix, matrix, complex_array, array, mx_el_ne) + +DEFNDBINOP_FN (el_mul, complex_matrix, matrix, complex_array, array, product) +DEFNDBINOP_FN (el_div, complex_matrix, matrix, complex_array, array, quotient) +DEFNDBINOP_FN (el_pow, complex_matrix, matrix, complex_array, array, elem_xpow) + +DEFBINOP (el_ldiv, complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + return quotient (v2.array_value (), v1.complex_array_value ()); +} + +DEFNDBINOP_FN (el_and, complex_matrix, matrix, complex_array, array, mx_el_and) +DEFNDBINOP_FN (el_or, complex_matrix, matrix, complex_array, array, mx_el_or) + +DEFNDCATOP_FN (cm_m, complex_matrix, matrix, complex_array, array, concat) + +DEFNDASSIGNOP_FN (assign, complex_matrix, matrix, complex_array, assign) + +void +install_cm_m_ops (void) +{ + INSTALL_BINOP (op_add, octave_complex_matrix, octave_matrix, add); + INSTALL_BINOP (op_sub, octave_complex_matrix, octave_matrix, sub); + INSTALL_BINOP (op_mul, octave_complex_matrix, octave_matrix, mul); + INSTALL_BINOP (op_div, octave_complex_matrix, octave_matrix, div); + INSTALL_BINOP (op_pow, octave_complex_matrix, octave_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_complex_matrix, octave_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_complex_matrix, octave_matrix, lt); + INSTALL_BINOP (op_le, octave_complex_matrix, octave_matrix, le); + INSTALL_BINOP (op_eq, octave_complex_matrix, octave_matrix, eq); + INSTALL_BINOP (op_ge, octave_complex_matrix, octave_matrix, ge); + INSTALL_BINOP (op_gt, octave_complex_matrix, octave_matrix, gt); + INSTALL_BINOP (op_ne, octave_complex_matrix, octave_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_complex_matrix, octave_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_complex_matrix, octave_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_complex_matrix, octave_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, octave_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex_matrix, octave_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_complex_matrix, octave_matrix, el_or); + INSTALL_BINOP (op_mul_trans, octave_complex_matrix, octave_matrix, mul_trans); + INSTALL_BINOP (op_mul_herm, octave_complex_matrix, octave_matrix, mul_trans); + + INSTALL_CATOP (octave_complex_matrix, octave_matrix, cm_m); + + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_matrix, assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cm-pm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cm-pm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,33 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define MINCLUDE "ov-cx-mat.h" + +#define LMATRIX complex_matrix +#define RMATRIX perm_matrix + +#define LSHORT cm +#define RSHORT pm + +#define RIGHT + +#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/operators/op-cm-s.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cm-s.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,143 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-cm-s.h" +#include "mx-cnda-s.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-re-mat.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex matrix by scalar ops. + +DEFNDBINOP_OP (add, complex_matrix, scalar, complex_array, scalar, +) +DEFNDBINOP_OP (sub, complex_matrix, scalar, complex_array, scalar, -) +DEFNDBINOP_OP (mul, complex_matrix, scalar, complex_array, scalar, *) + +DEFBINOP (div, complex_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_array_value () / d); +} + +DEFBINOP_FN (pow, complex_matrix, scalar, xpow) + +DEFBINOP (ldiv, complex_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + ComplexMatrix m1 = v1.complex_matrix_value (); + Matrix m2 = v2.matrix_value (); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (m1, m2, typ); + + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, complex_matrix, scalar, complex_array, scalar, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, complex_matrix, scalar, complex_array, scalar, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, complex_matrix, scalar, complex_array, scalar, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, complex_matrix, scalar, complex_array, scalar, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, complex_matrix, scalar, complex_array, scalar, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, complex_matrix, scalar, complex_array, scalar, mx_el_ne) + +DEFNDBINOP_OP (el_mul, complex_matrix, scalar, complex_array, scalar, *) + +DEFBINOP (el_div, complex_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_array_value () / d); +} + +DEFNDBINOP_FN (el_pow, complex_matrix, scalar, complex_array, scalar, elem_xpow) + +DEFBINOP (el_ldiv, complex_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + return x_el_div (v2.double_value (), v1.complex_array_value ()); +} + +DEFNDBINOP_FN (el_and, complex_matrix, scalar, complex_array, scalar, mx_el_and) +DEFNDBINOP_FN (el_or, complex_matrix, scalar, complex_array, scalar, mx_el_or) + +DEFNDCATOP_FN (cm_s, complex_matrix, scalar, complex_array, array, concat) + +DEFNDASSIGNOP_FN (assign, complex_matrix, scalar, complex_array, assign) + +DEFNDASSIGNOP_OP (assign_mul, complex_matrix, scalar, scalar, *=) +DEFNDASSIGNOP_OP (assign_div, complex_matrix, scalar, scalar, /=) + +void +install_cm_s_ops (void) +{ + INSTALL_BINOP (op_add, octave_complex_matrix, octave_scalar, add); + INSTALL_BINOP (op_sub, octave_complex_matrix, octave_scalar, sub); + INSTALL_BINOP (op_mul, octave_complex_matrix, octave_scalar, mul); + INSTALL_BINOP (op_div, octave_complex_matrix, octave_scalar, div); + INSTALL_BINOP (op_pow, octave_complex_matrix, octave_scalar, pow); + INSTALL_BINOP (op_ldiv, octave_complex_matrix, octave_scalar, ldiv); + INSTALL_BINOP (op_lt, octave_complex_matrix, octave_scalar, lt); + INSTALL_BINOP (op_le, octave_complex_matrix, octave_scalar, le); + INSTALL_BINOP (op_eq, octave_complex_matrix, octave_scalar, eq); + INSTALL_BINOP (op_ge, octave_complex_matrix, octave_scalar, ge); + INSTALL_BINOP (op_gt, octave_complex_matrix, octave_scalar, gt); + INSTALL_BINOP (op_ne, octave_complex_matrix, octave_scalar, ne); + INSTALL_BINOP (op_el_mul, octave_complex_matrix, octave_scalar, el_mul); + INSTALL_BINOP (op_el_div, octave_complex_matrix, octave_scalar, el_div); + INSTALL_BINOP (op_el_pow, octave_complex_matrix, octave_scalar, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, octave_scalar, el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex_matrix, octave_scalar, el_and); + INSTALL_BINOP (op_el_or, octave_complex_matrix, octave_scalar, el_or); + + INSTALL_CATOP (octave_complex_matrix, octave_scalar, cm_s); + + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_scalar, assign); + + INSTALL_ASSIGNOP (op_mul_eq, octave_complex_matrix, octave_scalar, assign_mul); + INSTALL_ASSIGNOP (op_div_eq, octave_complex_matrix, octave_scalar, assign_div); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cm-scm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cm-scm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,203 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-cx-mat.h" +#include "ops.h" +#include "xdiv.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "smx-scm-cm.h" +#include "smx-cm-scm.h" +#include "ov-cx-sparse.h" + +// complex matrix by sparse complex matrix ops. + +DEFBINOP_OP (add, complex_matrix, sparse_complex_matrix, +) +DEFBINOP_OP (sub, complex_matrix, sparse_complex_matrix, -) + +DEFBINOP_OP (mul, complex_matrix, sparse_complex_matrix, *) + +DEFBINOP (div, complex_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, + const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_array_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.complex_matrix_value (), + v2.sparse_complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOPX (pow, complex_matrix, sparse_complex_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, complex_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, + const octave_sparse_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), + v2.complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (mul_trans, complex_matrix, sparse_complex_matrix, mul_trans); +DEFBINOP_FN (mul_herm, complex_matrix, sparse_complex_matrix, mul_herm); + +DEFBINOP_FN (lt, complex_matrix, sparse_complex_matrix, mx_el_lt) +DEFBINOP_FN (le, complex_matrix, sparse_complex_matrix, mx_el_le) +DEFBINOP_FN (eq, complex_matrix, sparse_complex_matrix, mx_el_eq) +DEFBINOP_FN (ge, complex_matrix, sparse_complex_matrix, mx_el_ge) +DEFBINOP_FN (gt, complex_matrix, sparse_complex_matrix, mx_el_gt) +DEFBINOP_FN (ne, complex_matrix, sparse_complex_matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, complex_matrix, sparse_complex_matrix, product) +DEFBINOP_FN (el_div, complex_matrix, sparse_complex_matrix, quotient) + +DEFBINOP (el_pow, complex_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, + const octave_sparse_complex_matrix&); + + return octave_value + (elem_xpow (SparseComplexMatrix (v1.complex_matrix_value ()), + v2.sparse_complex_matrix_value ())); +} + +DEFBINOP (el_ldiv, sparse_complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, + const octave_sparse_complex_matrix&); + + return octave_value (quotient (v2.sparse_complex_matrix_value (), + v1.complex_matrix_value ())); +} + +DEFBINOP_FN (el_and, complex_matrix, sparse_complex_matrix, mx_el_and) +DEFBINOP_FN (el_or, complex_matrix, sparse_complex_matrix, mx_el_or) + +DEFCATOP (cm_scm, complex_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (octave_complex_matrix&, + const octave_sparse_complex_matrix&); + SparseComplexMatrix tmp (v1.complex_matrix_value ()); + return octave_value (tmp. concat (v2.sparse_complex_matrix_value (), + ra_idx)); +} + +DEFCONV (sparse_complex_matrix_conv, complex_matrix, + sparse_complex_matrix) +{ + CAST_CONV_ARG (const octave_complex_matrix&); + return new octave_sparse_complex_matrix + (SparseComplexMatrix (v.complex_matrix_value ())); +} + +DEFNDASSIGNOP_FN (assign, complex_matrix, sparse_complex_matrix, + complex_array, assign) + +void +install_cm_scm_ops (void) +{ + INSTALL_BINOP (op_add, octave_complex_matrix, + octave_sparse_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_complex_matrix, + octave_sparse_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_complex_matrix, + octave_sparse_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_complex_matrix, + octave_sparse_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_complex_matrix, + octave_sparse_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_complex_matrix, + octave_sparse_complex_matrix, ldiv); + INSTALL_BINOP (op_mul_trans, octave_complex_matrix, + octave_sparse_complex_matrix, mul_trans); + INSTALL_BINOP (op_mul_herm, octave_complex_matrix, + octave_sparse_complex_matrix, mul_herm); + INSTALL_BINOP (op_lt, octave_complex_matrix, + octave_sparse_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_complex_matrix, + octave_sparse_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_complex_matrix, + octave_sparse_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_complex_matrix, + octave_sparse_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_complex_matrix, + octave_sparse_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_complex_matrix, + octave_sparse_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_complex_matrix, + octave_sparse_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_complex_matrix, + octave_sparse_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_complex_matrix, + octave_sparse_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, + octave_sparse_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex_matrix, + octave_sparse_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_complex_matrix, + octave_sparse_complex_matrix, el_or); + + INSTALL_CATOP (octave_complex_matrix, + octave_sparse_complex_matrix, cm_scm); + + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, + octave_sparse_complex_matrix, assign) + INSTALL_ASSIGNCONV (octave_complex_matrix, octave_sparse_complex_matrix, + octave_complex_matrix); + + INSTALL_WIDENOP (octave_complex_matrix, octave_sparse_complex_matrix, + sparse_complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cm-sm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cm-sm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,168 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-cx-mat.h" +#include "ops.h" +#include "xdiv.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "smx-sm-cm.h" +#include "smx-cm-sm.h" +#include "ov-re-sparse.h" + +// complex matrix by sparse matrix ops. + +DEFBINOP_OP (add, complex_matrix, sparse_matrix, +) +DEFBINOP_OP (sub, complex_matrix, sparse_matrix, -) + +DEFBINOP_OP (mul, complex_matrix, sparse_matrix, *) + +DEFBINOP (div, complex_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + double d = v2.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_array_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.complex_matrix_value (), + v2.sparse_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOPX (pow, complex_matrix, sparse_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, complex_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, + const octave_sparse_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.complex_matrix_value (), + v2.matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (lt, complex_matrix, sparse_matrix, mx_el_lt) +DEFBINOP_FN (le, complex_matrix, sparse_matrix, mx_el_le) +DEFBINOP_FN (eq, complex_matrix, sparse_matrix, mx_el_eq) +DEFBINOP_FN (ge, complex_matrix, sparse_matrix, mx_el_ge) +DEFBINOP_FN (gt, complex_matrix, sparse_matrix, mx_el_gt) +DEFBINOP_FN (ne, complex_matrix, sparse_matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, complex_matrix, sparse_matrix, product) +DEFBINOP_FN (el_div, complex_matrix, sparse_matrix, quotient) + +DEFBINOP (el_pow, complex_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, + const octave_sparse_matrix&); + + return octave_value + (elem_xpow ( SparseComplexMatrix (v1.complex_matrix_value ()), + v2.sparse_matrix_value ())); +} + +DEFBINOP (el_ldiv, complex_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, + const octave_sparse_matrix&); + return octave_value + (quotient (v2.sparse_matrix_value (), v1.complex_matrix_value ())); +} + +DEFBINOP_FN (el_and, complex_matrix, sparse_matrix, mx_el_and) +DEFBINOP_FN (el_or, complex_matrix, sparse_matrix, mx_el_or) + +DEFCATOP (cm_sm, complex_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (octave_complex_matrix&, const octave_sparse_matrix&); + SparseComplexMatrix tmp (v1.complex_matrix_value ()); + return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); +} + +DEFNDASSIGNOP_FN (assign, complex_matrix, sparse_matrix, complex_array, assign) + +void +install_cm_sm_ops (void) +{ + INSTALL_BINOP (op_add, octave_complex_matrix, octave_sparse_matrix, add); + INSTALL_BINOP (op_sub, octave_complex_matrix, octave_sparse_matrix, sub); + INSTALL_BINOP (op_mul, octave_complex_matrix, octave_sparse_matrix, mul); + INSTALL_BINOP (op_div, octave_complex_matrix, octave_sparse_matrix, div); + INSTALL_BINOP (op_pow, octave_complex_matrix, octave_sparse_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_complex_matrix, octave_sparse_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_complex_matrix, octave_sparse_matrix, lt); + INSTALL_BINOP (op_le, octave_complex_matrix, octave_sparse_matrix, le); + INSTALL_BINOP (op_eq, octave_complex_matrix, octave_sparse_matrix, eq); + INSTALL_BINOP (op_ge, octave_complex_matrix, octave_sparse_matrix, ge); + INSTALL_BINOP (op_gt, octave_complex_matrix, octave_sparse_matrix, gt); + INSTALL_BINOP (op_ne, octave_complex_matrix, octave_sparse_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_complex_matrix, octave_sparse_matrix, + el_mul); + INSTALL_BINOP (op_el_div, octave_complex_matrix, octave_sparse_matrix, + el_div); + INSTALL_BINOP (op_el_pow, octave_complex_matrix, octave_sparse_matrix, + el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex_matrix, octave_sparse_matrix, + el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex_matrix, octave_sparse_matrix, + el_and); + INSTALL_BINOP (op_el_or, octave_complex_matrix, octave_sparse_matrix, + el_or); + + INSTALL_CATOP (octave_complex_matrix, octave_sparse_matrix, cm_sm); + + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_sparse_matrix, + assign); + INSTALL_ASSIGNCONV (octave_complex_matrix, octave_sparse_matrix, + octave_complex_matrix) + +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cs-cm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cs-cm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,133 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex scalar by complex matrix ops. + +DEFNDBINOP_OP (add, complex, complex_matrix, complex, complex_array, +) +DEFNDBINOP_OP (sub, complex, complex_matrix, complex, complex_array, -) +DEFNDBINOP_OP (mul, complex, complex_matrix, complex, complex_array, *) + +DEFBINOP (div, complex, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + ComplexMatrix m1 = v1.complex_matrix_value (); + ComplexMatrix m2 = v2.complex_matrix_value (); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (pow, complex, complex_matrix, xpow) + +DEFBINOP (ldiv, complex, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_array_value () / d); +} + +DEFNDCMPLXCMPOP_FN (lt, complex, complex_matrix, complex, complex_array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, complex, complex_matrix, complex, complex_array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, complex, complex_matrix, complex, complex_array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, complex, complex_matrix, complex, complex_array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, complex, complex_matrix, complex, complex_array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, complex, complex_matrix, complex, complex_array, mx_el_ne) + +DEFNDBINOP_OP (el_mul, complex, complex_matrix, complex, complex_array, *) +DEFNDBINOP_FN (el_div, complex, complex_matrix, complex, complex_array, x_el_div) +DEFNDBINOP_FN (el_pow, complex, complex_matrix, complex, complex_array, elem_xpow) + +DEFBINOP (el_ldiv, complex, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_array_value () / d); +} + +DEFNDBINOP_FN (el_and, complex, complex_matrix, complex, complex_array, mx_el_and) +DEFNDBINOP_FN (el_or, complex, complex_matrix, complex, complex_array, mx_el_or) + +DEFNDCATOP_FN (cs_cm, complex, complex_matrix, complex_array, complex_array, concat) + +DEFCONV (complex_matrix_conv, complex, complex_matrix) +{ + CAST_CONV_ARG (const octave_complex&); + + return new octave_complex_matrix (v.complex_matrix_value ()); +} + +void +install_cs_cm_ops (void) +{ + INSTALL_BINOP (op_add, octave_complex, octave_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_complex, octave_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_complex, octave_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_complex, octave_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_complex, octave_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_complex, octave_complex_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_complex, octave_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_complex, octave_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_complex, octave_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_complex, octave_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_complex, octave_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_complex, octave_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_complex, octave_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_complex, octave_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_complex, octave_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex, octave_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex, octave_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_complex, octave_complex_matrix, el_or); + + INSTALL_CATOP (octave_complex, octave_complex_matrix, cs_cm); + + INSTALL_ASSIGNCONV (octave_complex, octave_complex_matrix, octave_complex_matrix); + + INSTALL_WIDENOP (octave_complex, octave_complex_matrix, complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cs-cs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cs-cs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,197 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "Array-util.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// unary complex scalar ops. + +DEFUNOP (not, complex) +{ + CAST_UNOP_ARG (const octave_complex&); + Complex x = v.complex_value (); + if (xisnan (x)) + gripe_nan_to_logical_conversion (); + return octave_value (x == 0.0); +} + +DEFUNOP_OP (uplus, complex, /* no-op */) +DEFUNOP_OP (uminus, complex, -) +DEFUNOP_OP (transpose, complex, /* no-op */) + +DEFUNOP (hermitian, complex) +{ + CAST_UNOP_ARG (const octave_complex&); + + return octave_value (conj (v.complex_value ())); +} + +DEFNCUNOP_METHOD (incr, complex, increment) +DEFNCUNOP_METHOD (decr, complex, decrement) + +// complex scalar by complex scalar ops. + +DEFBINOP_OP (add, complex, complex, +) +DEFBINOP_OP (sub, complex, complex, -) +DEFBINOP_OP (mul, complex, complex, *) + +DEFBINOP (div, complex, complex) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_value () / d); +} + +DEFBINOP_FN (pow, complex, complex, xpow) + +DEFBINOP (ldiv, complex, complex) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_value () / d); +} + +DEFCMPLXCMPOP_OP (lt, complex, complex, <) +DEFCMPLXCMPOP_OP (le, complex, complex, <=) +DEFCMPLXCMPOP_OP (eq, complex, complex, ==) +DEFCMPLXCMPOP_OP (ge, complex, complex, >=) +DEFCMPLXCMPOP_OP (gt, complex, complex, >) +DEFCMPLXCMPOP_OP (ne, complex, complex, !=) + +DEFBINOP_OP (el_mul, complex, complex, *) + +DEFBINOP (el_div, complex, complex) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_value () / d); +} + +DEFBINOP_FN (el_pow, complex, complex, xpow) + +DEFBINOP (el_ldiv, complex, complex) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_value () / d); +} + +DEFBINOP (el_and, complex, complex) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return v1.complex_value () != 0.0 && v2.complex_value () != 0.0; +} + +DEFBINOP (el_or, complex, complex) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return v1.complex_value () != 0.0 || v2.complex_value () != 0.0; +} + +DEFNDCATOP_FN (cs_cs, complex, complex, complex_array, complex_array, concat) + +CONVDECL (complex_to_float_complex) +{ + CAST_CONV_ARG (const octave_complex&); + + return new octave_float_complex_matrix (FloatComplexMatrix (1, 1, static_cast(v.complex_value ()))); +} + +void +install_cs_cs_ops (void) +{ + INSTALL_UNOP (op_not, octave_complex, not); + INSTALL_UNOP (op_uplus, octave_complex, uplus); + INSTALL_UNOP (op_uminus, octave_complex, uminus); + INSTALL_UNOP (op_transpose, octave_complex, transpose); + INSTALL_UNOP (op_hermitian, octave_complex, hermitian); + + INSTALL_NCUNOP (op_incr, octave_complex, incr); + INSTALL_NCUNOP (op_decr, octave_complex, decr); + + INSTALL_BINOP (op_add, octave_complex, octave_complex, add); + INSTALL_BINOP (op_sub, octave_complex, octave_complex, sub); + INSTALL_BINOP (op_mul, octave_complex, octave_complex, mul); + INSTALL_BINOP (op_div, octave_complex, octave_complex, div); + INSTALL_BINOP (op_pow, octave_complex, octave_complex, pow); + INSTALL_BINOP (op_ldiv, octave_complex, octave_complex, ldiv); + INSTALL_BINOP (op_lt, octave_complex, octave_complex, lt); + INSTALL_BINOP (op_le, octave_complex, octave_complex, le); + INSTALL_BINOP (op_eq, octave_complex, octave_complex, eq); + INSTALL_BINOP (op_ge, octave_complex, octave_complex, ge); + INSTALL_BINOP (op_gt, octave_complex, octave_complex, gt); + INSTALL_BINOP (op_ne, octave_complex, octave_complex, ne); + INSTALL_BINOP (op_el_mul, octave_complex, octave_complex, el_mul); + INSTALL_BINOP (op_el_div, octave_complex, octave_complex, el_div); + INSTALL_BINOP (op_el_pow, octave_complex, octave_complex, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex, octave_complex, el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex, octave_complex, el_and); + INSTALL_BINOP (op_el_or, octave_complex, octave_complex, el_or); + + INSTALL_CATOP (octave_complex, octave_complex, cs_cs); + + INSTALL_ASSIGNCONV (octave_complex, octave_complex, octave_complex_matrix); + + INSTALL_ASSIGNCONV (octave_complex, octave_null_matrix, octave_complex_matrix); + INSTALL_ASSIGNCONV (octave_complex, octave_null_str, octave_complex_matrix); + INSTALL_ASSIGNCONV (octave_complex, octave_null_sq_str, octave_complex_matrix); + + INSTALL_CONVOP (octave_complex, octave_float_complex_matrix, + complex_to_float_complex); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cs-m.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cs-m.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,130 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-cs-nda.h" +#include "mx-nda-cs.h" +#include "mx-cs-nda.h" +#include "mx-nda-cs.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex scalar by matrix ops. + +DEFNDBINOP_OP (add, complex, matrix, complex, array, +) +DEFNDBINOP_OP (sub, complex, matrix, complex, array, -) +DEFNDBINOP_OP (mul, complex, matrix, complex, array, *) + +DEFBINOP (div, complex, matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + ComplexMatrix m1 = v1.complex_matrix_value (); + Matrix m2 = v2.matrix_value (); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (pow, complex, matrix, xpow) + +DEFBINOP (ldiv, complex, matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.array_value () / d); +} + +DEFNDCMPLXCMPOP_FN (lt, complex, matrix, complex, array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, complex, matrix, complex, array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, complex, matrix, complex, array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, complex, matrix, complex, array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, complex, matrix, complex, array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, complex, matrix, complex, array, mx_el_ne) + +DEFNDBINOP_OP (el_mul, complex, matrix, complex, array, *) +DEFNDBINOP_FN (el_div, complex, matrix, complex, array, x_el_div) +DEFNDBINOP_FN (el_pow, complex, matrix, complex, array, elem_xpow) + +DEFBINOP (el_ldiv, complex, matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.array_value () / d); +} + +DEFNDBINOP_FN (el_and, complex, matrix, complex, array, mx_el_and) +DEFNDBINOP_FN (el_or, complex, matrix, complex, array, mx_el_or) + +DEFNDCATOP_FN (cs_m, complex, matrix, complex_array, array, concat) + +void +install_cs_m_ops (void) +{ + INSTALL_BINOP (op_add, octave_complex, octave_matrix, add); + INSTALL_BINOP (op_sub, octave_complex, octave_matrix, sub); + INSTALL_BINOP (op_mul, octave_complex, octave_matrix, mul); + INSTALL_BINOP (op_div, octave_complex, octave_matrix, div); + INSTALL_BINOP (op_pow, octave_complex, octave_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_complex, octave_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_complex, octave_matrix, lt); + INSTALL_BINOP (op_le, octave_complex, octave_matrix, le); + INSTALL_BINOP (op_eq, octave_complex, octave_matrix, eq); + INSTALL_BINOP (op_ge, octave_complex, octave_matrix, ge); + INSTALL_BINOP (op_gt, octave_complex, octave_matrix, gt); + INSTALL_BINOP (op_ne, octave_complex, octave_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_complex, octave_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_complex, octave_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_complex, octave_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex, octave_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex, octave_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_complex, octave_matrix, el_or); + + INSTALL_CATOP (octave_complex, octave_matrix, cs_m); + + INSTALL_ASSIGNCONV (octave_complex, octave_matrix, octave_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cs-s.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cs-s.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,146 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex scalar by scalar ops. + +DEFBINOP_OP (add, complex, scalar, +) +DEFBINOP_OP (sub, complex, scalar, -) +DEFBINOP_OP (mul, complex, scalar, *) + +DEFBINOP (div, complex, scalar) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_value () / d); +} + +DEFBINOP_FN (pow, complex, scalar, xpow) + +DEFBINOP (ldiv, complex, scalar) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.double_value () / d); +} + +DEFCMPLXCMPOP_OP (lt, complex, scalar, <) +DEFCMPLXCMPOP_OP (le, complex, scalar, <=) +DEFCMPLXCMPOP_OP (eq, complex, scalar, ==) +DEFCMPLXCMPOP_OP (ge, complex, scalar, >=) +DEFCMPLXCMPOP_OP (gt, complex, scalar, >) +DEFCMPLXCMPOP_OP (ne, complex, scalar, !=) + +DEFBINOP_OP (el_mul, complex, scalar, *) + +DEFBINOP (el_div, complex, scalar) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_value () / d); +} + +DEFBINOP_FN (el_pow, complex, scalar, xpow) + +DEFBINOP (el_ldiv, complex, scalar) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.double_value () / d); +} + +DEFBINOP (el_and, complex, scalar) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return v1.complex_value () != 0.0 && v2.double_value (); +} + +DEFBINOP (el_or, complex, scalar) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return v1.complex_value () != 0.0 || v2.double_value (); +} + +DEFNDCATOP_FN (cs_s, complex, scalar, complex_array, array, concat) + +void +install_cs_s_ops (void) +{ + INSTALL_BINOP (op_add, octave_complex, octave_scalar, add); + INSTALL_BINOP (op_sub, octave_complex, octave_scalar, sub); + INSTALL_BINOP (op_mul, octave_complex, octave_scalar, mul); + INSTALL_BINOP (op_div, octave_complex, octave_scalar, div); + INSTALL_BINOP (op_pow, octave_complex, octave_scalar, pow); + INSTALL_BINOP (op_ldiv, octave_complex, octave_scalar, ldiv); + INSTALL_BINOP (op_lt, octave_complex, octave_scalar, lt); + INSTALL_BINOP (op_le, octave_complex, octave_scalar, le); + INSTALL_BINOP (op_eq, octave_complex, octave_scalar, eq); + INSTALL_BINOP (op_ge, octave_complex, octave_scalar, ge); + INSTALL_BINOP (op_gt, octave_complex, octave_scalar, gt); + INSTALL_BINOP (op_ne, octave_complex, octave_scalar, ne); + INSTALL_BINOP (op_el_mul, octave_complex, octave_scalar, el_mul); + INSTALL_BINOP (op_el_div, octave_complex, octave_scalar, el_div); + INSTALL_BINOP (op_el_pow, octave_complex, octave_scalar, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex, octave_scalar, el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex, octave_scalar, el_and); + INSTALL_BINOP (op_el_or, octave_complex, octave_scalar, el_or); + + INSTALL_CATOP (octave_complex, octave_scalar, cs_s); + + INSTALL_ASSIGNCONV (octave_complex, octave_scalar, octave_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cs-scm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cs-scm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,172 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-cx-mat.h" +#include "ov-complex.h" +#include "ops.h" +#include "xpow.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "ov-cx-sparse.h" + +// complex scalar by sparse complex matrix ops. + +DEFBINOP_OP (add, complex, sparse_complex_matrix, +) +DEFBINOP_OP (sub, complex, sparse_complex_matrix, -) +DEFBINOP_OP (mul, complex, sparse_complex_matrix, *) + +DEFBINOP (div, complex, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (SparseComplexMatrix (1, 1, v1.complex_value () / d)); + } + else + { + MatrixType typ = v2.matrix_type (); + ComplexMatrix m1 = ComplexMatrix (1, 1, v1.complex_value ()); + SparseComplexMatrix m2 = v2.sparse_complex_matrix_value (); + ComplexMatrix ret = xdiv (m1, m2, typ); + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOP (pow, complex, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, + const octave_sparse_complex_matrix&); + return xpow (v1.complex_value (), v2.complex_matrix_value ()); +} + +DEFBINOP (ldiv, complex, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_complex_matrix&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.sparse_complex_matrix_value () / d); +} + +DEFBINOP_FN (lt, complex, sparse_complex_matrix, mx_el_lt) +DEFBINOP_FN (le, complex, sparse_complex_matrix, mx_el_le) +DEFBINOP_FN (eq, complex, sparse_complex_matrix, mx_el_eq) +DEFBINOP_FN (ge, complex, sparse_complex_matrix, mx_el_ge) +DEFBINOP_FN (gt, complex, sparse_complex_matrix, mx_el_gt) +DEFBINOP_FN (ne, complex, sparse_complex_matrix, mx_el_ne) + +DEFBINOP_OP (el_mul, complex, sparse_complex_matrix, *) +DEFBINOP_FN (el_div, complex, sparse_complex_matrix, x_el_div) + +DEFBINOP_FN (el_pow, complex, sparse_complex_matrix, elem_xpow) + +DEFBINOP (el_ldiv, complex, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_complex_matrix&); + + Complex d = v1.complex_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v2.sparse_complex_matrix_value () / d); + + return retval; +} + +DEFBINOP_FN (el_and, complex, sparse_complex_matrix, mx_el_and) +DEFBINOP_FN (el_or, complex, sparse_complex_matrix, mx_el_or) + +DEFCATOP (cs_scm, complex, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (octave_complex&, const octave_sparse_complex_matrix&); + SparseComplexMatrix tmp (1, 1, v1.complex_value ()); + return octave_value (tmp. concat (v2.sparse_complex_matrix_value (), + ra_idx)); +} + +DEFCONV (sparse_complex_matrix_conv, complex, sparse_complex_matrix) +{ + CAST_CONV_ARG (const octave_complex&); + + return new octave_sparse_complex_matrix + (SparseComplexMatrix (v.complex_matrix_value ())); +} + +void +install_cs_scm_ops (void) +{ + INSTALL_BINOP (op_add, octave_complex, octave_sparse_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_complex, octave_sparse_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_complex, octave_sparse_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_complex, octave_sparse_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_complex, octave_sparse_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_complex, octave_sparse_complex_matrix, + ldiv); + INSTALL_BINOP (op_lt, octave_complex, octave_sparse_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_complex, octave_sparse_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_complex, octave_sparse_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_complex, octave_sparse_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_complex, octave_sparse_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_complex, octave_sparse_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_complex, octave_sparse_complex_matrix, + el_mul); + INSTALL_BINOP (op_el_div, octave_complex, octave_sparse_complex_matrix, + el_div); + INSTALL_BINOP (op_el_pow, octave_complex, octave_sparse_complex_matrix, + el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex, octave_sparse_complex_matrix, + el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex, octave_sparse_complex_matrix, + el_and); + INSTALL_BINOP (op_el_or, octave_complex, octave_sparse_complex_matrix, + el_or); + + INSTALL_CATOP (octave_complex, octave_sparse_complex_matrix, cs_scm); + + INSTALL_ASSIGNCONV (octave_complex, octave_sparse_complex_matrix, + octave_complex_matrix); + + INSTALL_WIDENOP (octave_complex, octave_sparse_complex_matrix, + sparse_complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-cs-sm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-cs-sm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,166 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-complex.h" +#include "ops.h" +#include "xpow.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "smx-cs-sm.h" +#include "smx-sm-cs.h" + +// complex by sparse matrix ops. + +DEFBINOP_OP (add, complex, sparse_matrix, +) +DEFBINOP_OP (sub, complex, sparse_matrix, -) +DEFBINOP_OP (mul, complex, sparse_matrix, *) + +DEFBINOP (div, complex, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + double d = v2.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (SparseComplexMatrix (1, 1, v1.complex_value () / d)); + } + else + { + MatrixType typ = v2.matrix_type (); + ComplexMatrix m1 = ComplexMatrix (1, 1, v1.complex_value ()); + SparseMatrix m2 = v2.sparse_matrix_value (); + ComplexMatrix ret = xdiv (m1, m2, typ); + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOP (pow, complex, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_matrix&); + return xpow (v1.complex_value (), v2.matrix_value ()); +} + +DEFBINOP (ldiv, complex, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_matrix&); + + Complex d = v1.complex_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v2.sparse_matrix_value () / d); + + return retval; +} + +DEFBINOP_FN (lt, complex, sparse_matrix, mx_el_lt) +DEFBINOP_FN (le, complex, sparse_matrix, mx_el_le) +DEFBINOP_FN (eq, complex, sparse_matrix, mx_el_eq) +DEFBINOP_FN (ge, complex, sparse_matrix, mx_el_ge) +DEFBINOP_FN (gt, complex, sparse_matrix, mx_el_gt) +DEFBINOP_FN (ne, complex, sparse_matrix, mx_el_ne) + +DEFBINOP_OP (el_mul, complex, sparse_matrix, *) +DEFBINOP_FN (el_div, complex, sparse_matrix, x_el_div) +DEFBINOP_FN (el_pow, complex, sparse_matrix, elem_xpow) + +DEFBINOP (el_ldiv, complex, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_sparse_matrix&); + + Complex d = v1.complex_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v2.sparse_matrix_value () / d); + + return retval; +} + +DEFBINOP_FN (el_and, complex, sparse_matrix, mx_el_and) +DEFBINOP_FN (el_or, complex, sparse_matrix, mx_el_or) + +DEFCATOP (cs_sm, sparse_matrix, complex) +{ + CAST_BINOP_ARGS (octave_complex&, const octave_sparse_matrix&); + SparseComplexMatrix tmp (1, 1, v1.complex_value ()); + return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); +} + +DEFCONV (sparse_matrix_conv, complex, sparse_matrix) +{ + CAST_CONV_ARG (const octave_complex&); + + return new octave_sparse_matrix + (SparseMatrix (v.matrix_value ())); +} + +void +install_cs_sm_ops (void) +{ + INSTALL_BINOP (op_add, octave_complex, octave_sparse_matrix, add); + INSTALL_BINOP (op_sub, octave_complex, octave_sparse_matrix, sub); + INSTALL_BINOP (op_mul, octave_complex, octave_sparse_matrix, mul); + INSTALL_BINOP (op_div, octave_complex, octave_sparse_matrix, div); + INSTALL_BINOP (op_pow, octave_complex, octave_sparse_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_complex, octave_sparse_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_complex, octave_sparse_matrix, lt); + INSTALL_BINOP (op_le, octave_complex, octave_sparse_matrix, le); + INSTALL_BINOP (op_eq, octave_complex, octave_sparse_matrix, eq); + INSTALL_BINOP (op_ge, octave_complex, octave_sparse_matrix, ge); + INSTALL_BINOP (op_gt, octave_complex, octave_sparse_matrix, gt); + INSTALL_BINOP (op_ne, octave_complex, octave_sparse_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_complex, octave_sparse_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_complex, octave_sparse_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_complex, octave_sparse_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_complex, octave_sparse_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_complex, octave_sparse_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_complex, octave_sparse_matrix, el_or); + + INSTALL_CATOP (octave_complex, octave_sparse_matrix, cs_sm); + + INSTALL_ASSIGNCONV (octave_complex, octave_sparse_matrix, + octave_complex_matrix); + + INSTALL_WIDENOP (octave_complex, octave_sparse_matrix, sparse_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-dm-cdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-dm-cdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,37 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-re-diag.h" +#define RINCLUDE "ov-cx-diag.h" + +#define LMATRIX diag_matrix +#define RMATRIX complex_diag_matrix +#define LDMATRIX RMATRIX + +#define LSHORT dm +#define RSHORT cdm + +#define DEFINEDIV +#define DEFINELDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-dm-cm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-dm-cm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-re-diag.h" +#define RINCLUDE "ov-cx-mat.h" + +#define LMATRIX diag_matrix +#define RMATRIX complex_matrix + +#define LSHORT dm +#define RSHORT cm + +#define DEFINELDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-dm-cs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-dm-cs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,34 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define SINCLUDE "ov-complex.h" +#define MINCLUDE "ov-re-diag.h" + +#define SCALAR complex +#define MATRIX diag_matrix +#define MATRIXV complex_diag_matrix + +#define SSHORT cs +#define MSHORT dm + +#include "op-dms-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-dm-dm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-dm-dm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,103 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-re-diag.h" +#include "ov-flt-re-diag.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix unary ops. + +DEFUNOP_OP (uplus, diag_matrix, /* no-op */) +DEFUNOP_OP (uminus, diag_matrix, -) + +DEFUNOP (transpose, diag_matrix) +{ + CAST_UNOP_ARG (const octave_diag_matrix&); + return octave_value (v.diag_matrix_value ().transpose ()); +} + +// matrix by matrix ops. + +DEFBINOP_OP (add, diag_matrix, diag_matrix, +) +DEFBINOP_OP (sub, diag_matrix, diag_matrix, -) +DEFBINOP_OP (mul, diag_matrix, diag_matrix, *) + +DEFBINOP (div, diag_matrix, diag_matrix) +{ + CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_diag_matrix&); + + return xdiv (v1.diag_matrix_value (), + v2.diag_matrix_value ()); +} + +DEFBINOP (ldiv, diag_matrix, diag_matrix) +{ + CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_diag_matrix&); + + return xleftdiv (v1.diag_matrix_value (), + v2.diag_matrix_value ()); +} + +CONVDECL (diag_matrix_to_matrix) +{ + CAST_CONV_ARG (const octave_diag_matrix&); + + return new octave_matrix (v.matrix_value ()); +} + +CONVDECL (diag_matrix_to_float_diag_matrix) +{ + CAST_CONV_ARG (const octave_diag_matrix&); + + return new octave_float_diag_matrix (v.float_diag_matrix_value ()); +} + +void +install_dm_dm_ops (void) +{ + INSTALL_UNOP (op_uplus, octave_diag_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_diag_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_diag_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_diag_matrix, transpose); + + INSTALL_BINOP (op_add, octave_diag_matrix, octave_diag_matrix, add); + INSTALL_BINOP (op_sub, octave_diag_matrix, octave_diag_matrix, sub); + INSTALL_BINOP (op_mul, octave_diag_matrix, octave_diag_matrix, mul); + INSTALL_BINOP (op_div, octave_diag_matrix, octave_diag_matrix, div); + INSTALL_BINOP (op_ldiv, octave_diag_matrix, octave_diag_matrix, ldiv); + + INSTALL_CONVOP (octave_diag_matrix, octave_matrix, diag_matrix_to_matrix); + INSTALL_CONVOP (octave_diag_matrix, octave_float_diag_matrix, diag_matrix_to_float_diag_matrix); + INSTALL_ASSIGNCONV (octave_diag_matrix, octave_matrix, octave_matrix); + INSTALL_WIDENOP (octave_diag_matrix, octave_matrix, diag_matrix_to_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-dm-m.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-dm-m.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,37 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-re-diag.h" +#define RINCLUDE "ov-re-mat.h" + +#define LMATRIX diag_matrix +#define LDMATRIX matrix +#define RMATRIX matrix + +#define LSHORT dm +#define RSHORT m + +#define DEFINELDIV +#define DEFINENULLASSIGNCONV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-dm-s.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-dm-s.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,33 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define SINCLUDE "ov-scalar.h" +#define MINCLUDE "ov-re-diag.h" + +#define SCALAR scalar +#define MATRIX diag_matrix + +#define SSHORT s +#define MSHORT dm + +#include "op-dms-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-dm-scm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-dm-scm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,511 @@ +/* + +Copyright (C) 2009-2012 Jason Riedy, Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ops.h" + +#include "ov-re-diag.h" +#include "ov-cx-diag.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +#include "sparse-xdiv.h" + +// diagonal matrix by sparse matrix ops + +DEFBINOP (mul_dm_scm, diag_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v2.complex_value (); + + return octave_value (v1.diag_matrix_value () * d); + } + else + { + MatrixType typ = v2.matrix_type (); + SparseComplexMatrix ret = v1.diag_matrix_value () * v2.sparse_complex_matrix_value (); + octave_value out = octave_value (ret); + typ.mark_as_unsymmetric (); + out.matrix_type (typ); + return out; + } +} + +DEFBINOP (mul_cdm_sm, complex_diag_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v2.scalar_value (); + + return octave_value (v1.complex_diag_matrix_value () * d); + } + else + { + MatrixType typ = v2.matrix_type (); + SparseComplexMatrix ret = v1.complex_diag_matrix_value () * v2.sparse_matrix_value (); + octave_value out = octave_value (ret); + typ.mark_as_unsymmetric (); + out.matrix_type (typ); + return out; + } +} + +DEFBINOP (mul_cdm_scm, complex_diag_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v2.complex_value (); + + return octave_value (v1.complex_diag_matrix_value () * d); + } + else + { + MatrixType typ = v2.matrix_type (); + SparseComplexMatrix ret = v1.complex_diag_matrix_value () * v2.sparse_complex_matrix_value (); + octave_value out = octave_value (ret); + typ.mark_as_unsymmetric (); + out.matrix_type (typ); + return out; + } +} + +DEFBINOP (ldiv_dm_scm, diag_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_diag_matrix&, + const octave_sparse_complex_matrix&); + + MatrixType typ = v2.matrix_type (); + return xleftdiv (v1.diag_matrix_value (), v2.sparse_complex_matrix_value (), + typ); +} + +DEFBINOP (ldiv_cdm_sm, complex_diag_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_diag_matrix&, + const octave_sparse_matrix&); + + MatrixType typ = v2.matrix_type (); + return xleftdiv (v1.complex_diag_matrix_value (), v2.sparse_matrix_value (), + typ); +} + +DEFBINOP (ldiv_cdm_scm, complex_diag_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_diag_matrix&, + const octave_sparse_complex_matrix&); + + MatrixType typ = v2.matrix_type (); + return xleftdiv (v1.complex_diag_matrix_value (), v2.sparse_complex_matrix_value (), + typ); +} + +DEFBINOP (add_dm_scm, diag_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v2.complex_value (); + + return octave_value (v1.matrix_value () + d); + } + else + return v1.diag_matrix_value () + v2.sparse_complex_matrix_value (); +} + +DEFBINOP (add_cdm_sm, complex_diag_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + double d = v2.scalar_value (); + + return octave_value (v1.complex_matrix_value () + d); + } + else + return v1.complex_diag_matrix_value () + v2.sparse_matrix_value (); +} + +DEFBINOP (add_cdm_scm, complex_diag_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v2.complex_value (); + + return octave_value (v1.complex_matrix_value () + d); + } + else + return v1.complex_diag_matrix_value () + v2.sparse_complex_matrix_value (); +} + +DEFBINOP (sub_dm_scm, diag_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v2.complex_value (); + + return octave_value (v1.matrix_value () + (-d)); + } + else + return v1.diag_matrix_value () - v2.sparse_complex_matrix_value (); +} + +DEFBINOP (sub_cdm_sm, complex_diag_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + double d = v2.scalar_value (); + + return octave_value (v1.complex_matrix_value () + (-d)); + } + else + return v1.complex_diag_matrix_value () - v2.sparse_matrix_value (); +} + +DEFBINOP (sub_cdm_scm, complex_diag_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_complex_diag_matrix&, const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v2.complex_value (); + + return octave_value (v1.complex_matrix_value () + (-d)); + } + else + return v1.complex_diag_matrix_value () - v2.sparse_complex_matrix_value (); +} + +// sparse matrix by diagonal matrix ops + +DEFBINOP (mul_scm_dm, sparse_complex_matrix, diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_diag_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + // If v1 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v1.complex_value (); + + return octave_value (d * v2.diag_matrix_value ()); + } + else + { + MatrixType typ = v1.matrix_type (); + SparseComplexMatrix ret = v1.sparse_complex_matrix_value () * v2.diag_matrix_value (); + octave_value out = octave_value (ret); + typ.mark_as_unsymmetric (); + out.matrix_type (typ); + return out; + } +} + +DEFBINOP (mul_sm_cdm, sparse_matrix, complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_diag_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + // If v1 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v1.complex_value (); + + return octave_value (d * v2.complex_diag_matrix_value ()); + } + else + { + MatrixType typ = v1.matrix_type (); + SparseComplexMatrix ret = v1.sparse_matrix_value () * v2.complex_diag_matrix_value (); + octave_value out = octave_value (ret); + typ.mark_as_unsymmetric (); + out.matrix_type (typ); + return out; + } +} + +DEFBINOP (mul_scm_cdm, sparse_complex_matrix, complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_diag_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + // If v1 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v1.complex_value (); + + return octave_value (d * v2.complex_diag_matrix_value ()); + } + else if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, don't bother with further dispatching. + { + std::complex d = v2.complex_value (); + + return octave_value (v1.sparse_complex_matrix_value () * d); + } + else + { + MatrixType typ = v1.matrix_type (); + SparseComplexMatrix ret = v1.sparse_complex_matrix_value () * v2.complex_diag_matrix_value (); + octave_value out = octave_value (ret); + typ.mark_as_unsymmetric (); + out.matrix_type (typ); + return out; + } +} + +DEFBINOP (div_scm_dm, sparse_complex_matrix, diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_diag_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + double d = v2.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.sparse_complex_matrix_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + return xdiv (v1.sparse_complex_matrix_value (), v2.diag_matrix_value (), typ); + } +} + +DEFBINOP (div_sm_cdm, sparse_matrix, complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_diag_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + std::complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.sparse_matrix_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + return xdiv (v1.sparse_matrix_value (), v2.complex_diag_matrix_value (), typ); + } +} + +DEFBINOP (div_scm_cdm, sparse_complex_matrix, complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_diag_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + std::complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.sparse_complex_matrix_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + return xdiv (v1.sparse_complex_matrix_value (), v2.complex_diag_matrix_value (), typ); + } +} + +DEFBINOP (add_sm_cdm, sparse_matrix, complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_diag_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v2.complex_value (); + + return octave_value (v1.sparse_matrix_value () + d); + } + else + return v1.sparse_matrix_value () + v2.complex_diag_matrix_value (); +} + +DEFBINOP (add_scm_dm, sparse_complex_matrix, diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_diag_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + double d = v2.scalar_value (); + + return octave_value (v1.sparse_complex_matrix_value () + d); + } + else + return v1.sparse_complex_matrix_value () + v2.diag_matrix_value (); +} + +DEFBINOP (add_scm_cdm, sparse_complex_matrix, complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_diag_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v2.complex_value (); + + return octave_value (v1.sparse_complex_matrix_value () + d); + } + else + return v1.sparse_complex_matrix_value () + v2.complex_diag_matrix_value (); +} + +DEFBINOP (sub_sm_cdm, sparse_matrix, complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_diag_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v2.complex_value (); + + return octave_value (v1.sparse_matrix_value () + (-d)); + } + else + return v1.sparse_matrix_value () - v2.complex_diag_matrix_value (); +} + +DEFBINOP (sub_scm_dm, sparse_complex_matrix, diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_diag_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + double d = v2.scalar_value (); + + return octave_value (v1.sparse_complex_matrix_value () + (-d)); + } + else + return v1.sparse_complex_matrix_value () - v2.diag_matrix_value (); +} + +DEFBINOP (sub_scm_cdm, sparse_complex_matrix, complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_diag_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + std::complex d = v2.complex_value (); + + return octave_value (v1.sparse_complex_matrix_value () + (-d)); + } + else + return v1.sparse_complex_matrix_value () - v2.complex_diag_matrix_value (); +} + +void +install_dm_scm_ops (void) +{ + INSTALL_BINOP (op_mul, octave_diag_matrix, octave_sparse_complex_matrix, + mul_dm_scm); + INSTALL_BINOP (op_mul, octave_complex_diag_matrix, octave_sparse_matrix, + mul_cdm_sm); + INSTALL_BINOP (op_mul, octave_complex_diag_matrix, octave_sparse_complex_matrix, + mul_cdm_scm); + INSTALL_BINOP (op_ldiv, octave_diag_matrix, octave_sparse_complex_matrix, ldiv_dm_scm); + INSTALL_BINOP (op_ldiv, octave_complex_diag_matrix, octave_sparse_matrix, ldiv_cdm_sm); + INSTALL_BINOP (op_ldiv, octave_complex_diag_matrix, octave_sparse_complex_matrix, + ldiv_cdm_scm); + + INSTALL_BINOP (op_add, octave_diag_matrix, octave_sparse_complex_matrix, add_dm_scm); + INSTALL_BINOP (op_add, octave_complex_diag_matrix, octave_sparse_matrix, add_cdm_sm); + INSTALL_BINOP (op_add, octave_complex_diag_matrix, octave_sparse_complex_matrix, + add_cdm_scm); + INSTALL_BINOP (op_sub, octave_diag_matrix, octave_sparse_complex_matrix, sub_dm_scm); + INSTALL_BINOP (op_sub, octave_complex_diag_matrix, octave_sparse_matrix, sub_cdm_sm); + INSTALL_BINOP (op_sub, octave_complex_diag_matrix, octave_sparse_complex_matrix, + sub_cdm_scm); + + INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_diag_matrix, + mul_scm_dm); + INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_complex_diag_matrix, + mul_sm_cdm); + INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_complex_diag_matrix, + mul_scm_cdm); + + INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_diag_matrix, div_scm_dm); + INSTALL_BINOP (op_div, octave_sparse_matrix, octave_complex_diag_matrix, div_sm_cdm); + INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_complex_diag_matrix, div_scm_cdm); + + INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_diag_matrix, add_scm_dm); + INSTALL_BINOP (op_add, octave_sparse_matrix, octave_complex_diag_matrix, add_sm_cdm); + INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_complex_diag_matrix, add_scm_cdm); + INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_diag_matrix, sub_scm_dm); + INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_complex_diag_matrix, sub_sm_cdm); + INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_complex_diag_matrix, sub_scm_cdm); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-dm-sm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-dm-sm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,196 @@ +/* + +Copyright (C) 2009-2012 Jason Riedy, Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ops.h" + +#include "ov-re-diag.h" +#include "ov-re-sparse.h" + +#include "sparse-xdiv.h" + +// diagonal matrix by sparse matrix ops + +DEFBINOP (mul_dm_sm, diag_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + double d = v2.scalar_value (); + + return octave_value (v1.diag_matrix_value () * d); + } + else + { + MatrixType typ = v2.matrix_type (); + SparseMatrix ret = v1.diag_matrix_value () * v2.sparse_matrix_value (); + octave_value out = octave_value (ret); + typ.mark_as_unsymmetric (); + out.matrix_type (typ); + return out; + } +} + +DEFBINOP (ldiv_dm_sm, diag_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_matrix&); + + MatrixType typ = v2.matrix_type (); + return xleftdiv (v1.diag_matrix_value (), v2.sparse_matrix_value (), typ); +} + +DEFBINOP (add_dm_sm, diag_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + double d = v2.scalar_value (); + + return octave_value (v1.matrix_value () + d); + } + else + return v1.diag_matrix_value () + v2.sparse_matrix_value (); +} + +DEFBINOP (sub_dm_sm, diag_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_diag_matrix&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + // If v2 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + double d = v2.scalar_value (); + + return octave_value (v1.matrix_value () - d); + } + else + return v1.diag_matrix_value () - v2.sparse_matrix_value (); +} + +// sparse matrix by diagonal matrix ops + +DEFBINOP (mul_sm_dm, sparse_matrix, diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_diag_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + // If v1 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + double d = v1.scalar_value (); + + return octave_value (d * v2.diag_matrix_value ()); + } + else + { + MatrixType typ = v1.matrix_type (); + SparseMatrix ret = v1.sparse_matrix_value () * v2.diag_matrix_value (); + octave_value out = octave_value (ret); + typ.mark_as_unsymmetric (); + out.matrix_type (typ); + return out; + } +} + +DEFBINOP (div_sm_dm, sparse_matrix, diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_diag_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + double d = v2.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.sparse_matrix_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + return xdiv (v1.sparse_matrix_value (), v2.diag_matrix_value (), typ); + } +} + +DEFBINOP (add_sm_dm, sparse_matrix, diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_diag_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + // If v1 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + double d = v1.scalar_value (); + + return octave_value (d + v2.matrix_value ()); + } + else + return v1.sparse_matrix_value () + v2.diag_matrix_value (); +} + +DEFBINOP (sub_sm_dm, sparse_matrix, diag_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_diag_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + // If v1 is a scalar in disguise, return a diagonal matrix rather than + // a sparse matrix. + { + double d = v1.scalar_value (); + + return octave_value (d - v2.matrix_value ()); + } + else + return v1.sparse_matrix_value () - v2.diag_matrix_value (); +} + +void +install_dm_sm_ops (void) +{ + INSTALL_BINOP (op_mul, octave_diag_matrix, octave_sparse_matrix, + mul_dm_sm); + + INSTALL_BINOP (op_add, octave_diag_matrix, octave_sparse_matrix, add_dm_sm); + INSTALL_BINOP (op_sub, octave_diag_matrix, octave_sparse_matrix, sub_dm_sm); + INSTALL_BINOP (op_ldiv, octave_diag_matrix, octave_sparse_matrix, ldiv_dm_sm); + + INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_diag_matrix, + mul_sm_dm); + + INSTALL_BINOP (op_add, octave_sparse_matrix, octave_diag_matrix, add_sm_dm); + INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_diag_matrix, sub_sm_dm); + INSTALL_BINOP (op_div, octave_sparse_matrix, octave_diag_matrix, div_sm_dm); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-dm-template.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-dm-template.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,95 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "ops.h" +#include "xdiv.h" +#include LINCLUDE +#include RINCLUDE +#ifdef DEFINENULLASSIGNCONV +#include "ov-null-mat.h" +#endif + +// matrix by diag matrix ops. + +DEFBINOP_OP (add, LMATRIX, RMATRIX, +) +DEFBINOP_OP (sub, LMATRIX, RMATRIX, -) +DEFBINOP_OP (mul, LMATRIX, RMATRIX, *) + +#ifndef LDMATRIX +#define LDMATRIX LMATRIX +#endif + +#ifndef RDMATRIX +#define RDMATRIX RMATRIX +#endif + +#define OCTAVE_LMATRIX CONCAT2(octave_, LMATRIX) +#define OCTAVE_LDMATRIX CONCAT2(octave_, LDMATRIX) +#define OCTAVE_RMATRIX CONCAT2(octave_, RMATRIX) +#define LMATRIX_VALUE CONCAT2(LMATRIX, _value) +#define RMATRIX_VALUE CONCAT2(RMATRIX, _value) +#define LDMATRIX_VALUE CONCAT2(LDMATRIX, _value) +#define RDMATRIX_VALUE CONCAT2(RDMATRIX, _value) + +#ifdef DEFINEDIV +DEFBINOP (div, LMATRIX, RMATRIX) +{ + CAST_BINOP_ARGS (const OCTAVE_LMATRIX&, const OCTAVE_RMATRIX&); + + return xdiv (v1.LDMATRIX_VALUE (), v2.RMATRIX_VALUE ()); +} +#endif + +#ifdef DEFINELDIV +DEFBINOP (ldiv, LMATRIX, RMATRIX) +{ + CAST_BINOP_ARGS (const OCTAVE_LMATRIX&, const OCTAVE_RMATRIX&); + + return xleftdiv (v1.LMATRIX_VALUE (), v2.RDMATRIX_VALUE ()); +} +#endif + +#define SHORT_NAME CONCAT3(LSHORT, _, RSHORT) +#define INST_NAME CONCAT3(install_, SHORT_NAME, _ops) + +void +INST_NAME (void) +{ + INSTALL_BINOP (op_add, OCTAVE_LMATRIX, OCTAVE_RMATRIX, add); + INSTALL_BINOP (op_sub, OCTAVE_LMATRIX, OCTAVE_RMATRIX, sub); + INSTALL_BINOP (op_mul, OCTAVE_LMATRIX, OCTAVE_RMATRIX, mul); +#ifdef DEFINEDIV + INSTALL_BINOP (op_div, OCTAVE_LMATRIX, OCTAVE_RMATRIX, div); +#endif +#ifdef DEFINELDIV + INSTALL_BINOP (op_ldiv, OCTAVE_LMATRIX, OCTAVE_RMATRIX, ldiv); +#endif +#ifdef DEFINENULLASSIGNCONV + INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_matrix, OCTAVE_LDMATRIX); + INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_str, OCTAVE_LDMATRIX); + INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_sq_str, OCTAVE_LDMATRIX); +#endif +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-dms-template.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-dms-template.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,92 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "ops.h" +#include "gripes.h" +#include "xpow.h" +#include SINCLUDE +#include MINCLUDE + +// matrix by diag matrix ops. + +#ifndef SCALARV +#define SCALARV SCALAR +#endif + +#ifndef MATRIXV +#define MATRIXV MATRIX +#endif + +DEFNDBINOP_OP (sdmmul, SCALAR, MATRIX, SCALARV, MATRIXV, *) +DEFNDBINOP_OP (dmsmul, MATRIX, SCALAR, MATRIXV, SCALARV, *) + +#define OCTAVE_MATRIX CONCAT2(octave_, MATRIX) +#define OCTAVE_SCALAR CONCAT2(octave_, SCALAR) +#define MATRIX_VALUE CONCAT2(MATRIXV, _value) +#define SCALAR_VALUE CONCAT2(SCALARV, _value) + +template +static T +gripe_if_zero (T x) +{ + if (x == T ()) + gripe_divide_by_zero (); + return x; +} + +DEFBINOP (dmsdiv, MATRIX, SCALAR) +{ + CAST_BINOP_ARGS (const OCTAVE_MATRIX&, const OCTAVE_SCALAR&); + + return v1.MATRIX_VALUE () / gripe_if_zero (v2.SCALAR_VALUE ()); +} + +DEFBINOP (sdmldiv, SCALAR, MATRIX) +{ + CAST_BINOP_ARGS (const OCTAVE_SCALAR&, const OCTAVE_MATRIX&); + + return v2.MATRIX_VALUE () / gripe_if_zero (v1.SCALAR_VALUE ()); +} + +DEFBINOP (dmspow, MATRIX, SCALAR) +{ + CAST_BINOP_ARGS (const OCTAVE_MATRIX&, const OCTAVE_SCALAR&); + + return xpow (v1.MATRIX_VALUE (), v2.SCALAR_VALUE ()); +} + +#define SHORT_NAME CONCAT3(MSHORT, _, SSHORT) +#define INST_NAME CONCAT3(install_, SHORT_NAME, _ops) + +void +INST_NAME (void) +{ + INSTALL_BINOP (op_mul, OCTAVE_MATRIX, OCTAVE_SCALAR, dmsmul); + INSTALL_BINOP (op_div, OCTAVE_MATRIX, OCTAVE_SCALAR, dmsdiv); + INSTALL_BINOP (op_mul, OCTAVE_SCALAR, OCTAVE_MATRIX, sdmmul); + INSTALL_BINOP (op_ldiv, OCTAVE_SCALAR, OCTAVE_MATRIX, sdmldiv); + INSTALL_BINOP (op_pow, OCTAVE_MATRIX, OCTAVE_SCALAR, dmspow); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-double-conv.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-double-conv.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,119 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-re-sparse.h" +#include "ov-bool-sparse.h" +#include "ov-range.h" +#include "ov-scalar.h" +#include "ov-re-mat.h" +#include "ov-str-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" + +// conversion ops + +DEFDBLCONVFN (int8_matrix_to_double_matrix, int8_matrix, int8_array) +DEFDBLCONVFN (int16_matrix_to_double_matrix, int16_matrix, int16_array) +DEFDBLCONVFN (int32_matrix_to_double_matrix, int32_matrix, int32_array) +DEFDBLCONVFN (int64_matrix_to_double_matrix, int64_matrix, int64_array) + +DEFDBLCONVFN (uint8_matrix_to_double_matrix, uint8_matrix, uint8_array) +DEFDBLCONVFN (uint16_matrix_to_double_matrix, uint16_matrix, uint16_array) +DEFDBLCONVFN (uint32_matrix_to_double_matrix, uint32_matrix, uint32_array) +DEFDBLCONVFN (uint64_matrix_to_double_matrix, uint64_matrix, uint64_array) + +DEFDBLCONVFN (int8_scalar_to_double_matrix, int8_scalar, int8_array) +DEFDBLCONVFN (int16_scalar_to_double_matrix, int16_scalar, int16_array) +DEFDBLCONVFN (int32_scalar_to_double_matrix, int32_scalar, int32_array) +DEFDBLCONVFN (int64_scalar_to_double_matrix, int64_scalar, int64_array) + +DEFDBLCONVFN (uint8_scalar_to_double_matrix, uint8_scalar, uint8_array) +DEFDBLCONVFN (uint16_scalar_to_double_matrix, uint16_scalar, uint16_array) +DEFDBLCONVFN (uint32_scalar_to_double_matrix, uint32_scalar, uint32_array) +DEFDBLCONVFN (uint64_scalar_to_double_matrix, uint64_scalar, uint64_array) + +DEFDBLCONVFN (bool_matrix_to_double_matrix, bool_matrix, bool_array) +DEFDBLCONVFN (bool_scalar_to_double_matrix, bool, bool_array) + +DEFDBLCONVFN (sparse_matrix_to_double_matrix, sparse_matrix, array) +DEFDBLCONVFN (sparse_bool_matrix_to_double_matrix, sparse_bool_matrix, array) + +DEFDBLCONVFN (range_to_double_matrix, range, array) + +DEFSTRDBLCONVFN(char_matrix_str_to_double_matrix, char_matrix_str) +DEFSTRDBLCONVFN(char_matrix_sq_str_to_double_matrix, char_matrix_sq_str) + +DEFDBLCONVFN (double_scalar_to_double_matrix, scalar, array) + +void +install_double_conv_ops (void) +{ + INSTALL_CONVOP (octave_int8_matrix, octave_matrix, int8_matrix_to_double_matrix); + INSTALL_CONVOP (octave_int16_matrix, octave_matrix, int16_matrix_to_double_matrix); + INSTALL_CONVOP (octave_int32_matrix, octave_matrix, int32_matrix_to_double_matrix); + INSTALL_CONVOP (octave_int64_matrix, octave_matrix, int64_matrix_to_double_matrix); + + INSTALL_CONVOP (octave_uint8_matrix, octave_matrix, uint8_matrix_to_double_matrix); + INSTALL_CONVOP (octave_uint16_matrix, octave_matrix, uint16_matrix_to_double_matrix); + INSTALL_CONVOP (octave_uint32_matrix, octave_matrix, uint32_matrix_to_double_matrix); + INSTALL_CONVOP (octave_uint64_matrix, octave_matrix, uint64_matrix_to_double_matrix); + + INSTALL_CONVOP (octave_int8_scalar, octave_matrix, int8_scalar_to_double_matrix); + INSTALL_CONVOP (octave_int16_scalar, octave_matrix, int16_scalar_to_double_matrix); + INSTALL_CONVOP (octave_int32_scalar, octave_matrix, int32_scalar_to_double_matrix); + INSTALL_CONVOP (octave_int64_scalar, octave_matrix, int64_scalar_to_double_matrix); + + INSTALL_CONVOP (octave_uint8_scalar, octave_matrix, uint8_scalar_to_double_matrix); + INSTALL_CONVOP (octave_uint16_scalar, octave_matrix, uint16_scalar_to_double_matrix); + INSTALL_CONVOP (octave_uint32_scalar, octave_matrix, uint32_scalar_to_double_matrix); + INSTALL_CONVOP (octave_uint64_scalar, octave_matrix, uint64_scalar_to_double_matrix); + + INSTALL_CONVOP (octave_bool_matrix, octave_matrix, bool_matrix_to_double_matrix); + INSTALL_CONVOP (octave_bool, octave_matrix, bool_scalar_to_double_matrix); + + INSTALL_CONVOP (octave_sparse_matrix, octave_matrix, sparse_matrix_to_double_matrix); + INSTALL_CONVOP (octave_sparse_bool_matrix, octave_matrix, sparse_bool_matrix_to_double_matrix); + + INSTALL_CONVOP (octave_range, octave_matrix, range_to_double_matrix); + + INSTALL_CONVOP (octave_char_matrix_str, octave_matrix, char_matrix_str_to_double_matrix); + INSTALL_CONVOP (octave_char_matrix_sq_str, octave_matrix, char_matrix_sq_str_to_double_matrix); + + INSTALL_CONVOP (octave_scalar, octave_matrix, double_scalar_to_double_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcdm-fcdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcdm-fcdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,112 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-flt-cx-mat.h" +#include "ov-flt-cx-diag.h" +#include "ov-cx-diag.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix unary ops. + +DEFUNOP_OP (uplus, float_complex_diag_matrix, /* no-op */) +DEFUNOP_OP (uminus, float_complex_diag_matrix, -) + +DEFUNOP (transpose, float_complex_diag_matrix) +{ + CAST_UNOP_ARG (const octave_float_complex_diag_matrix&); + return octave_value (v.float_complex_diag_matrix_value ().transpose ()); +} + +DEFUNOP (hermitian, float_complex_diag_matrix) +{ + CAST_UNOP_ARG (const octave_float_complex_diag_matrix&); + return octave_value (v.float_complex_diag_matrix_value ().hermitian ()); +} + +// matrix by matrix ops. + +DEFBINOP_OP (add, float_complex_diag_matrix, float_complex_diag_matrix, +) +DEFBINOP_OP (sub, float_complex_diag_matrix, float_complex_diag_matrix, -) +DEFBINOP_OP (mul, float_complex_diag_matrix, float_complex_diag_matrix, *) + +DEFBINOP (div, float_complex_diag_matrix, float_complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_diag_matrix&, const octave_float_complex_diag_matrix&); + + return xdiv (v1.float_complex_diag_matrix_value (), + v2.float_complex_diag_matrix_value ()); +} + +DEFBINOP (ldiv, float_complex_diag_matrix, float_complex_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_diag_matrix&, const octave_float_complex_diag_matrix&); + + return xleftdiv (v1.float_complex_diag_matrix_value (), + v2.float_complex_diag_matrix_value ()); +} + +CONVDECL (float_complex_diag_matrix_to_float_complex_matrix) +{ + CAST_CONV_ARG (const octave_float_complex_diag_matrix&); + + return new octave_float_complex_matrix (v.float_complex_matrix_value ()); +} + +CONVDECL (float_complex_diag_matrix_to_complex_diag_matrix) +{ + CAST_CONV_ARG (const octave_float_complex_diag_matrix&); + + return new octave_complex_diag_matrix (v.complex_diag_matrix_value ()); +} + +void +install_fcdm_fcdm_ops (void) +{ + INSTALL_UNOP (op_uplus, octave_float_complex_diag_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_float_complex_diag_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_float_complex_diag_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_float_complex_diag_matrix, hermitian); + + INSTALL_BINOP (op_add, octave_float_complex_diag_matrix, octave_float_complex_diag_matrix, add); + INSTALL_BINOP (op_sub, octave_float_complex_diag_matrix, octave_float_complex_diag_matrix, sub); + INSTALL_BINOP (op_mul, octave_float_complex_diag_matrix, octave_float_complex_diag_matrix, mul); + INSTALL_BINOP (op_div, octave_float_complex_diag_matrix, octave_float_complex_diag_matrix, div); + INSTALL_BINOP (op_ldiv, octave_float_complex_diag_matrix, octave_float_complex_diag_matrix, ldiv); + + INSTALL_CONVOP (octave_float_complex_diag_matrix, octave_complex_diag_matrix, + float_complex_diag_matrix_to_complex_diag_matrix); + INSTALL_CONVOP (octave_float_complex_diag_matrix, octave_float_complex_matrix, + float_complex_diag_matrix_to_float_complex_matrix); + INSTALL_ASSIGNCONV (octave_float_complex_diag_matrix, octave_float_complex_matrix, octave_float_complex_matrix); + INSTALL_WIDENOP (octave_float_complex_diag_matrix, octave_complex_diag_matrix, + float_complex_diag_matrix_to_complex_diag_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcdm-fcm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcdm-fcm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-flt-cx-diag.h" +#define RINCLUDE "ov-flt-cx-mat.h" + +#define LMATRIX float_complex_diag_matrix +#define RMATRIX float_complex_matrix + +#define LSHORT fcdm +#define RSHORT fcm + +#define DEFINELDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcdm-fcs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcdm-fcs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,33 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define SINCLUDE "ov-flt-complex.h" +#define MINCLUDE "ov-flt-cx-diag.h" + +#define SCALAR float_complex +#define MATRIX float_complex_diag_matrix + +#define SSHORT fcs +#define MSHORT fcdm + +#include "op-dms-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcdm-fdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcdm-fdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,51 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-flt-cx-diag.h" +#include "ov-flt-re-diag.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +#define LINCLUDE "ov-flt-cx-diag.h" +#define RINCLUDE "ov-flt-re-diag.h" + +#define LMATRIX float_complex_diag_matrix +#define RMATRIX float_diag_matrix +#define RDMATRIX LMATRIX + +#define LSHORT fcdm +#define RSHORT fdm + +#define DEFINEDIV +#define DEFINELDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcdm-fm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcdm-fm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,36 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-flt-cx-diag.h" +#define RINCLUDE "ov-flt-re-mat.h" + +#define LMATRIX float_complex_diag_matrix +#define RMATRIX float_matrix +#define RDMATRIX float_complex_matrix + +#define LSHORT fcdm +#define RSHORT fm + +#define DEFINELDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcdm-fs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcdm-fs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,34 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define SINCLUDE "ov-float.h" +#define MINCLUDE "ov-flt-cx-diag.h" + +#define SCALAR float_scalar +#define SCALARV float_complex +#define MATRIX float_complex_diag_matrix + +#define SSHORT fs +#define MSHORT fcdm + +#include "op-dms-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcm-fcdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcm-fcdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-flt-cx-mat.h" +#define RINCLUDE "ov-flt-cx-diag.h" + +#define LMATRIX float_complex_matrix +#define RMATRIX float_complex_diag_matrix + +#define LSHORT fcm +#define RSHORT fcdm + +#define DEFINEDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcm-fcm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcm-fcm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,335 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// unary complex matrix ops. + +DEFNDUNOP_OP (not, float_complex_matrix, float_complex_array, !) +DEFNDUNOP_OP (uplus, float_complex_matrix, float_complex_array, /* no-op */) +DEFNDUNOP_OP (uminus, float_complex_matrix, float_complex_array, -) + +DEFUNOP (transpose, float_complex_matrix) +{ + CAST_UNOP_ARG (const octave_float_complex_matrix&); + + if (v.ndims () > 2) + { + error ("transpose not defined for N-d objects"); + return octave_value (); + } + else + return octave_value (v.float_complex_matrix_value ().transpose ()); +} + +DEFUNOP (hermitian, float_complex_matrix) +{ + CAST_UNOP_ARG (const octave_float_complex_matrix&); + + if (v.ndims () > 2) + { + error ("complex-conjugate transpose not defined for N-d objects"); + return octave_value (); + } + else + return octave_value (v.float_complex_matrix_value ().hermitian ()); +} + +DEFNCUNOP_METHOD (incr, float_complex_matrix, increment) +DEFNCUNOP_METHOD (decr, float_complex_matrix, decrement) +DEFNCUNOP_METHOD (changesign, float_complex_matrix, changesign) + +// complex matrix by complex matrix ops. + +DEFNDBINOP_OP (add, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, +) +DEFNDBINOP_OP (sub, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, -) + +DEFBINOP_OP (mul, float_complex_matrix, float_complex_matrix, *) + +DEFBINOP (div, float_complex_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_complex_matrix&); + MatrixType typ = v2.matrix_type (); + + FloatComplexMatrix ret = xdiv (v1.float_complex_matrix_value (), + v2.float_complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOPX (pow, float_complex_matrix, float_complex_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, float_complex_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + FloatComplexMatrix ret = xleftdiv (v1.float_complex_matrix_value (), + v2.float_complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP (trans_mul, float_complex_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_complex_matrix&); + return octave_value(xgemm (v1.float_complex_matrix_value (), + v2.float_complex_matrix_value (), + blas_trans, blas_no_trans)); +} + +DEFBINOP (mul_trans, float_complex_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_complex_matrix&); + return octave_value(xgemm (v1.float_complex_matrix_value (), + v2.float_complex_matrix_value (), + blas_no_trans, blas_trans)); +} + +DEFBINOP (herm_mul, float_complex_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_complex_matrix&); + return octave_value(xgemm (v1.float_complex_matrix_value (), + v2.float_complex_matrix_value (), + blas_conj_trans, blas_no_trans)); +} + +DEFBINOP (mul_herm, float_complex_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_complex_matrix&); + return octave_value(xgemm (v1.float_complex_matrix_value (), + v2.float_complex_matrix_value (), + blas_no_trans, blas_conj_trans)); +} + +DEFBINOP (trans_ldiv, float_complex_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + FloatComplexMatrix ret = xleftdiv (v1.float_complex_matrix_value (), + v2.float_complex_matrix_value (), typ, blas_trans); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP (herm_ldiv, float_complex_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + FloatComplexMatrix ret = xleftdiv (v1.float_complex_matrix_value (), + v2.float_complex_matrix_value (), typ, blas_conj_trans); + + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, mx_el_ne) + +DEFNDBINOP_FN (el_mul, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, product) +DEFNDBINOP_FN (el_div, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, quotient) +DEFNDBINOP_FN (el_pow, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, elem_xpow) + +DEFBINOP (el_ldiv, float_complex_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_complex_matrix&); + + return octave_value (quotient (v2.float_complex_array_value (), v1.float_complex_array_value ())); +} + +DEFNDBINOP_FN (el_and, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, mx_el_and) +DEFNDBINOP_FN (el_or, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, mx_el_or) + +DEFNDCATOP_FN (fcm_fcm, float_complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, concat) + +DEFNDCATOP_FN (cm_fcm, complex_matrix, float_complex_matrix, + float_complex_array, float_complex_array, concat) + +DEFNDCATOP_FN (fcm_cm, float_complex_matrix, complex_matrix, + float_complex_array, float_complex_array, concat) + +DEFNDASSIGNOP_FN (assign, float_complex_matrix, float_complex_matrix, + float_complex_array, assign) +DEFNDASSIGNOP_FN (dbl_clx_assign, float_complex_matrix, complex_matrix, + float_complex_array, assign) +DEFNDASSIGNOP_FN (dbl_assign, float_complex_matrix, matrix, + float_complex_array, assign) + +DEFNULLASSIGNOP_FN (null_assign, float_complex_matrix, delete_elements) + +DEFNDASSIGNOP_OP (assign_add, float_complex_matrix, + float_complex_matrix, float_complex_array, +=) +DEFNDASSIGNOP_OP (assign_sub, float_complex_matrix, + float_complex_matrix, float_complex_array, -=) +DEFNDASSIGNOP_FNOP (assign_el_mul, float_complex_matrix, float_complex_matrix, + float_complex_array, product_eq) +DEFNDASSIGNOP_FNOP (assign_el_div, float_complex_matrix, float_complex_matrix, + float_complex_array, quotient_eq) + +CONVDECL (float_complex_matrix_to_complex_matrix) +{ + CAST_CONV_ARG (const octave_float_complex_matrix&); + + return new octave_complex_matrix (ComplexNDArray (v.float_complex_array_value ())); +} + +void +install_fcm_fcm_ops (void) +{ + INSTALL_UNOP (op_not, octave_float_complex_matrix, not); + INSTALL_UNOP (op_uplus, octave_float_complex_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_float_complex_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_float_complex_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_float_complex_matrix, hermitian); + + INSTALL_NCUNOP (op_incr, octave_float_complex_matrix, incr); + INSTALL_NCUNOP (op_decr, octave_float_complex_matrix, decr); + INSTALL_NCUNOP (op_uminus, octave_float_complex_matrix, changesign); + + INSTALL_BINOP (op_add, octave_float_complex_matrix, + octave_float_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_float_complex_matrix, + octave_float_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_float_complex_matrix, + octave_float_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_float_complex_matrix, + octave_float_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_float_complex_matrix, + octave_float_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_float_complex_matrix, + octave_float_complex_matrix, ldiv); + INSTALL_BINOP (op_trans_mul, octave_float_complex_matrix, + octave_float_complex_matrix, trans_mul); + INSTALL_BINOP (op_mul_trans, octave_float_complex_matrix, + octave_float_complex_matrix, mul_trans); + INSTALL_BINOP (op_herm_mul, octave_float_complex_matrix, + octave_float_complex_matrix, herm_mul); + INSTALL_BINOP (op_mul_herm, octave_float_complex_matrix, + octave_float_complex_matrix, mul_herm); + INSTALL_BINOP (op_trans_ldiv, octave_float_complex_matrix, + octave_float_complex_matrix, trans_ldiv); + INSTALL_BINOP (op_herm_ldiv, octave_float_complex_matrix, + octave_float_complex_matrix, herm_ldiv); + + INSTALL_BINOP (op_lt, octave_float_complex_matrix, + octave_float_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_float_complex_matrix, + octave_float_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_float_complex_matrix, + octave_float_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_float_complex_matrix, + octave_float_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_float_complex_matrix, + octave_float_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_float_complex_matrix, + octave_float_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_float_complex_matrix, + octave_float_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_float_complex_matrix, + octave_float_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_float_complex_matrix, + octave_float_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_complex_matrix, + octave_float_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_complex_matrix, + octave_float_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_float_complex_matrix, + octave_float_complex_matrix, el_or); + + INSTALL_CATOP (octave_float_complex_matrix, + octave_float_complex_matrix, fcm_fcm); + INSTALL_CATOP (octave_complex_matrix, + octave_float_complex_matrix, cm_fcm); + INSTALL_CATOP (octave_float_complex_matrix, + octave_complex_matrix, fcm_cm); + + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, + octave_float_complex_matrix, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, + octave_complex_matrix, dbl_clx_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, + octave_matrix, dbl_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, + octave_null_matrix, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, + octave_null_str, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, + octave_null_sq_str, null_assign); + + INSTALL_ASSIGNOP (op_add_eq, octave_float_complex_matrix, + octave_float_complex_matrix, assign_add); + INSTALL_ASSIGNOP (op_sub_eq, octave_float_complex_matrix, + octave_float_complex_matrix, assign_sub); + INSTALL_ASSIGNOP (op_el_mul_eq, octave_float_complex_matrix, + octave_float_complex_matrix, assign_el_mul); + INSTALL_ASSIGNOP (op_el_div_eq, octave_float_complex_matrix, + octave_float_complex_matrix, assign_el_div); + + INSTALL_CONVOP (octave_float_complex_matrix, octave_complex_matrix, + float_complex_matrix_to_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcm-fcs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcm-fcs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,196 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-flt-complex.h" +#include "ov-complex.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex matrix by complex scalar ops. + +DEFNDBINOP_OP (add, float_complex_matrix, float_complex, + float_complex_array, float_complex, +) +DEFNDBINOP_OP (sub, float_complex_matrix, float_complex, + float_complex_array, float_complex, -) +DEFNDBINOP_OP (mul, float_complex_matrix, float_complex, + float_complex_array, float_complex, *) + +DEFBINOP (div, float_complex_matrix, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_complex&); + + FloatComplex d = v2.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v1.float_complex_array_value () / d); +} + +DEFBINOP_FN (pow, float_complex_matrix, float_complex, xpow) + +DEFBINOP (ldiv, float_complex_matrix, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_complex&); + + FloatComplexMatrix m1 = v1.float_complex_matrix_value (); + FloatComplexMatrix m2 = v2.float_complex_matrix_value (); + MatrixType typ = v1.matrix_type (); + + FloatComplexMatrix ret = xleftdiv (m1, m2, typ); + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, float_complex_matrix, float_complex, + float_complex_array, float_complex, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, float_complex_matrix, float_complex, + float_complex_array, float_complex, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, float_complex_matrix, float_complex, + float_complex_array, float_complex, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, float_complex_matrix, float_complex, + float_complex_array, float_complex, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, float_complex_matrix, float_complex, + float_complex_array, float_complex, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, float_complex_matrix, float_complex, + float_complex_array, float_complex, mx_el_ne) + +DEFNDBINOP_OP (el_mul, float_complex_matrix, float_complex, + float_complex_array, float_complex, *) + +DEFBINOP (el_div, float_complex_matrix, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_complex&); + + FloatComplex d = v2.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v1.float_complex_array_value () / d); +} + +DEFNDBINOP_FN (el_pow, float_complex_matrix, float_complex, + float_complex_array, float_complex, elem_xpow) + +DEFBINOP (el_ldiv, float_complex_matrix, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_complex&); + + return x_el_div (v2.float_complex_value (), v1.float_complex_array_value ()); +} + +DEFNDBINOP_FN (el_and, float_complex_matrix, float_complex, + float_complex_array, float_complex, mx_el_and) +DEFNDBINOP_FN (el_or, float_complex_matrix, float_complex, + float_complex_array, float_complex, mx_el_or) + +DEFNDCATOP_FN (fcm_fcs, float_complex_matrix, float_complex, + float_complex_array, float_complex_array, concat) + +DEFNDCATOP_FN (cm_fcs, complex_matrix, float_complex, + float_complex_array, float_complex_array, concat) + +DEFNDCATOP_FN (fcm_cs, float_complex_matrix, complex, + float_complex_array, float_complex_array, concat) + +DEFNDASSIGNOP_FN (assign, float_complex_matrix, float_complex, + float_complex, assign) +DEFNDASSIGNOP_FN (dbl_assign, complex_matrix, float_complex, + complex, assign) + +DEFNDASSIGNOP_OP (assign_add, float_complex_matrix, float_complex_scalar, + float_complex, +=) +DEFNDASSIGNOP_OP (assign_sub, float_complex_matrix, float_complex_scalar, + float_complex, -=) +DEFNDASSIGNOP_OP (assign_mul, float_complex_matrix, float_complex_scalar, + float_complex, *=) +DEFNDASSIGNOP_OP (assign_div, float_complex_matrix, float_complex_scalar, + float_complex, /=) + +void +install_fcm_fcs_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_complex_matrix, + octave_float_complex, add); + INSTALL_BINOP (op_sub, octave_float_complex_matrix, + octave_float_complex, sub); + INSTALL_BINOP (op_mul, octave_float_complex_matrix, + octave_float_complex, mul); + INSTALL_BINOP (op_div, octave_float_complex_matrix, + octave_float_complex, div); + INSTALL_BINOP (op_pow, octave_float_complex_matrix, + octave_float_complex, pow); + INSTALL_BINOP (op_ldiv, octave_float_complex_matrix, + octave_float_complex, ldiv); + INSTALL_BINOP (op_lt, octave_float_complex_matrix, octave_float_complex, lt); + INSTALL_BINOP (op_le, octave_float_complex_matrix, octave_float_complex, le); + INSTALL_BINOP (op_eq, octave_float_complex_matrix, octave_float_complex, eq); + INSTALL_BINOP (op_ge, octave_float_complex_matrix, octave_float_complex, ge); + INSTALL_BINOP (op_gt, octave_float_complex_matrix, octave_float_complex, gt); + INSTALL_BINOP (op_ne, octave_float_complex_matrix, octave_float_complex, ne); + INSTALL_BINOP (op_el_mul, octave_float_complex_matrix, + octave_float_complex, el_mul); + INSTALL_BINOP (op_el_div, octave_float_complex_matrix, + octave_float_complex, el_div); + INSTALL_BINOP (op_el_pow, octave_float_complex_matrix, + octave_float_complex, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_complex_matrix, + octave_float_complex, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_complex_matrix, + octave_float_complex, el_and); + INSTALL_BINOP (op_el_or, octave_float_complex_matrix, + octave_float_complex, el_or); + + INSTALL_CATOP (octave_float_complex_matrix, octave_float_complex, fcm_fcs); + INSTALL_CATOP (octave_complex_matrix, octave_float_complex, cm_fcs); + INSTALL_CATOP (octave_float_complex_matrix, octave_complex, fcm_cs); + + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, + octave_float_complex, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, + octave_float_complex, dbl_assign); + + INSTALL_ASSIGNOP (op_add_eq, octave_float_complex_matrix, + octave_float_complex_scalar, assign_add); + INSTALL_ASSIGNOP (op_sub_eq, octave_float_complex_matrix, + octave_float_complex_scalar, assign_sub); + INSTALL_ASSIGNOP (op_mul_eq, octave_float_complex_matrix, + octave_float_complex_scalar, assign_mul); + INSTALL_ASSIGNOP (op_div_eq, octave_float_complex_matrix, + octave_float_complex_scalar, assign_div); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcm-fdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcm-fdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-flt-cx-mat.h" +#define RINCLUDE "ov-flt-re-diag.h" + +#define LMATRIX float_complex_matrix +#define RMATRIX float_diag_matrix + +#define LSHORT fcm +#define RSHORT fdm + +#define DEFINEDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcm-fm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcm-fm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,183 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-fcm-fm.h" +#include "mx-fm-fcm.h" +#include "mx-fcnda-fnda.h" +#include "mx-fnda-fcnda.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex matrix by matrix ops. + +DEFNDBINOP_OP (add, float_complex_matrix, float_matrix, float_complex_array, float_array, +) +DEFNDBINOP_OP (sub, float_complex_matrix, float_matrix, float_complex_array, float_array, -) + +DEFBINOP_OP (mul, float_complex_matrix, float_matrix, *) + +DEFBINOP (mul_trans, float_complex_matrix, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_matrix&); + + FloatComplexMatrix m1 = v1.float_complex_matrix_value (); + FloatMatrix m2 = v2.float_matrix_value (); + + return FloatComplexMatrix (xgemm (real (m1), m2, blas_no_trans, blas_trans), + xgemm (imag (m1), m2, blas_no_trans, blas_trans)); +} + +DEFBINOP (div, float_complex_matrix, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_matrix&); + MatrixType typ = v2.matrix_type (); + + FloatComplexMatrix ret = xdiv (v1.float_complex_matrix_value (), + v2.float_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + + +DEFBINOPX (pow, float_complex_matrix, float_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, float_complex_matrix, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_matrix&); + MatrixType typ = v1.matrix_type (); + + FloatComplexMatrix ret = xleftdiv (v1.float_complex_matrix_value (), + v2.float_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, float_complex_matrix, float_matrix, + float_complex_array, float_array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, float_complex_matrix, float_matrix, + float_complex_array, float_array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, float_complex_matrix, float_matrix, + float_complex_array, float_array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, float_complex_matrix, float_matrix, + float_complex_array, float_array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, float_complex_matrix, float_matrix, + float_complex_array, float_array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, float_complex_matrix, float_matrix, + float_complex_array, float_array, mx_el_ne) + +DEFNDBINOP_FN (el_mul, float_complex_matrix, float_matrix, + float_complex_array, float_array, product) +DEFNDBINOP_FN (el_div, float_complex_matrix, float_matrix, + float_complex_array, float_array, quotient) +DEFNDBINOP_FN (el_pow, float_complex_matrix, float_matrix, + float_complex_array, float_array, elem_xpow) + +DEFBINOP (el_ldiv, float_complex_matrix, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, + const octave_float_matrix&); + + return quotient (v2.float_array_value (), v1.float_complex_array_value ()); +} + +DEFNDBINOP_FN (el_and, float_complex_matrix, float_matrix, + float_complex_array, float_array, mx_el_and) +DEFNDBINOP_FN (el_or, float_complex_matrix, float_matrix, + float_complex_array, float_array, mx_el_or) + +DEFNDCATOP_FN (fcm_fm, float_complex_matrix, float_matrix, + float_complex_array, float_array, concat) + +DEFNDCATOP_FN (cm_fm, complex_matrix, float_matrix, + float_complex_array, float_array, concat) + +DEFNDCATOP_FN (fcm_m, float_complex_matrix, matrix, + float_complex_array, float_array, concat) + +DEFNDASSIGNOP_FN (assign, float_complex_matrix, float_matrix, + float_complex_array, assign) +DEFNDASSIGNOP_FN (dbl_assign, complex_matrix, float_matrix, + complex_array, assign) + +void +install_fcm_fm_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_complex_matrix, octave_float_matrix, add); + INSTALL_BINOP (op_sub, octave_float_complex_matrix, octave_float_matrix, sub); + INSTALL_BINOP (op_mul, octave_float_complex_matrix, octave_float_matrix, mul); + INSTALL_BINOP (op_div, octave_float_complex_matrix, octave_float_matrix, div); + INSTALL_BINOP (op_pow, octave_float_complex_matrix, octave_float_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_float_complex_matrix, + octave_float_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_float_complex_matrix, octave_float_matrix, lt); + INSTALL_BINOP (op_le, octave_float_complex_matrix, octave_float_matrix, le); + INSTALL_BINOP (op_eq, octave_float_complex_matrix, octave_float_matrix, eq); + INSTALL_BINOP (op_ge, octave_float_complex_matrix, octave_float_matrix, ge); + INSTALL_BINOP (op_gt, octave_float_complex_matrix, octave_float_matrix, gt); + INSTALL_BINOP (op_ne, octave_float_complex_matrix, octave_float_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_float_complex_matrix, + octave_float_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_float_complex_matrix, + octave_float_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_float_complex_matrix, + octave_float_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_complex_matrix, + octave_float_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_complex_matrix, + octave_float_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_float_complex_matrix, + octave_float_matrix, el_or); + INSTALL_BINOP (op_mul_trans, octave_float_complex_matrix, + octave_float_matrix, mul_trans); + INSTALL_BINOP (op_mul_herm, octave_float_complex_matrix, + octave_float_matrix, mul_trans); + + INSTALL_CATOP (octave_float_complex_matrix, octave_float_matrix, fcm_fm); + INSTALL_CATOP (octave_complex_matrix, octave_float_matrix, cm_fm); + INSTALL_CATOP (octave_float_complex_matrix, octave_matrix, fcm_m); + + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, + octave_float_matrix, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, + octave_float_matrix, dbl_assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcm-fs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcm-fs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,172 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-cm-s.h" +#include "mx-cnda-s.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-float.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex matrix by scalar ops. + +DEFNDBINOP_OP (add, float_complex_matrix, float_scalar, float_complex_array, float_scalar, +) +DEFNDBINOP_OP (sub, float_complex_matrix, float_scalar, float_complex_array, float_scalar, -) +DEFNDBINOP_OP (mul, float_complex_matrix, float_scalar, float_complex_array, float_scalar, *) + +DEFBINOP (div, float_complex_matrix, float) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_scalar&); + + float d = v2.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.float_complex_array_value () / d); +} + +DEFBINOP_FN (pow, float_complex_matrix, float_scalar, xpow) + +DEFBINOP (ldiv, float_complex_matrix, float) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_scalar&); + + FloatComplexMatrix m1 = v1.float_complex_matrix_value (); + FloatMatrix m2 = v2.float_matrix_value (); + MatrixType typ = v1.matrix_type (); + + FloatComplexMatrix ret = xleftdiv (m1, m2, typ); + + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, float_complex_matrix, float_scalar, float_complex_array, + float_scalar, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, float_complex_matrix, float_scalar, float_complex_array, + float_scalar, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, float_complex_matrix, float_scalar, float_complex_array, + float_scalar, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, float_complex_matrix, float_scalar, float_complex_array, + float_scalar, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, float_complex_matrix, float_scalar, float_complex_array, + float_scalar, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, float_complex_matrix, float_scalar, float_complex_array, + float_scalar, mx_el_ne) + +DEFNDBINOP_OP (el_mul, float_complex_matrix, float_scalar, float_complex_array, + float_scalar, *) + +DEFBINOP (el_div, float_complex_matrix, float) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_scalar&); + + float d = v2.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.float_complex_array_value () / d); +} + +DEFNDBINOP_FN (el_pow, float_complex_matrix, float_scalar, float_complex_array, + float_scalar, elem_xpow) + +DEFBINOP (el_ldiv, float_complex_matrix, float) +{ + CAST_BINOP_ARGS (const octave_float_complex_matrix&, const octave_float_scalar&); + + return x_el_div (v2.float_value (), v1.float_complex_array_value ()); +} + +DEFNDBINOP_FN (el_and, float_complex_matrix, float_scalar, float_complex_array, + float_scalar, mx_el_and) +DEFNDBINOP_FN (el_or, float_complex_matrix, float_scalar, float_complex_array, + float_scalar, mx_el_or) + +DEFNDCATOP_FN (fcm_fs, float_complex_matrix, float_scalar, float_complex_array, + float_array, concat) + +DEFNDCATOP_FN (cm_fs, complex_matrix, float_scalar, float_complex_array, + float_array, concat) + +DEFNDCATOP_FN (fcm_s, float_complex_matrix, scalar, float_complex_array, + float_array, concat) + +DEFNDASSIGNOP_FN (assign, float_complex_matrix, float_scalar, float_complex_array, assign) +DEFNDASSIGNOP_FN (dbl_assign, complex_matrix, float_scalar, complex_array, assign) + +DEFNDASSIGNOP_OP (assign_mul, float_complex_matrix, float_scalar, + float_scalar, *=) +DEFNDASSIGNOP_OP (assign_div, float_complex_matrix, float_scalar, + float_scalar, /=) + +void +install_fcm_fs_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_complex_matrix, octave_float_scalar, add); + INSTALL_BINOP (op_sub, octave_float_complex_matrix, octave_float_scalar, sub); + INSTALL_BINOP (op_mul, octave_float_complex_matrix, octave_float_scalar, mul); + INSTALL_BINOP (op_div, octave_float_complex_matrix, octave_float_scalar, div); + INSTALL_BINOP (op_pow, octave_float_complex_matrix, octave_float_scalar, pow); + INSTALL_BINOP (op_ldiv, octave_float_complex_matrix, octave_float_scalar, ldiv); + INSTALL_BINOP (op_lt, octave_float_complex_matrix, octave_float_scalar, lt); + INSTALL_BINOP (op_le, octave_float_complex_matrix, octave_float_scalar, le); + INSTALL_BINOP (op_eq, octave_float_complex_matrix, octave_float_scalar, eq); + INSTALL_BINOP (op_ge, octave_float_complex_matrix, octave_float_scalar, ge); + INSTALL_BINOP (op_gt, octave_float_complex_matrix, octave_float_scalar, gt); + INSTALL_BINOP (op_ne, octave_float_complex_matrix, octave_float_scalar, ne); + INSTALL_BINOP (op_el_mul, octave_float_complex_matrix, octave_float_scalar, el_mul); + INSTALL_BINOP (op_el_div, octave_float_complex_matrix, octave_float_scalar, el_div); + INSTALL_BINOP (op_el_pow, octave_float_complex_matrix, octave_float_scalar, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_complex_matrix, octave_float_scalar, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_complex_matrix, octave_float_scalar, el_and); + INSTALL_BINOP (op_el_or, octave_float_complex_matrix, octave_float_scalar, el_or); + + INSTALL_CATOP (octave_float_complex_matrix, octave_float_scalar, fcm_fs); + INSTALL_CATOP (octave_complex_matrix, octave_float_scalar, cm_fs); + INSTALL_CATOP (octave_float_complex_matrix, octave_scalar, fcm_s); + + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, + octave_float_scalar, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, + octave_float_scalar, dbl_assign); + + INSTALL_ASSIGNOP (op_mul_eq, octave_float_complex_matrix, + octave_float_scalar, assign_mul); + INSTALL_ASSIGNOP (op_div_eq, octave_float_complex_matrix, + octave_float_scalar, assign_div); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcm-pm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcm-pm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,33 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define MINCLUDE "ov-flt-cx-mat.h" + +#define LMATRIX float_complex_matrix +#define RMATRIX perm_matrix + +#define LSHORT fcm +#define RSHORT pm + +#define RIGHT + +#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcn.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcn.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,54 @@ +/* + +Copyright (C) 2010-2012 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-fcn-handle.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "ops.h" + +DEFBINOP (eq, fcn_handle, fcn_handle) +{ + CAST_BINOP_ARGS (const octave_fcn_handle&, const octave_fcn_handle&); + + return v1.is_equal_to (v2); +} + +DEFBINOP (ne, fcn_handle, fcn_handle) +{ + CAST_BINOP_ARGS (const octave_fcn_handle&, const octave_fcn_handle&); + + return ! v1.is_equal_to (v2); +} + +void +install_fcn_ops (void) +{ + INSTALL_BINOP (op_eq, octave_fcn_handle, octave_fcn_handle, eq); + INSTALL_BINOP (op_ne, octave_fcn_handle, octave_fcn_handle, ne); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcs-fcm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcs-fcm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,152 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex scalar by complex matrix ops. + +DEFNDBINOP_OP (add, float_complex, float_complex_matrix, float_complex, float_complex_array, +) +DEFNDBINOP_OP (sub, float_complex, float_complex_matrix, float_complex, float_complex_array, -) +DEFNDBINOP_OP (mul, float_complex, float_complex_matrix, float_complex, float_complex_array, *) + +DEFBINOP (div, float_complex, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex_matrix&); + + FloatComplexMatrix m1 = v1.float_complex_matrix_value (); + FloatComplexMatrix m2 = v2.float_complex_matrix_value (); + MatrixType typ = v2.matrix_type (); + + FloatComplexMatrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (pow, float_complex, float_complex_matrix, xpow) + +DEFBINOP (ldiv, float_complex, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex_matrix&); + + FloatComplex d = v1.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v2.float_complex_array_value () / d); +} + +DEFNDCMPLXCMPOP_FN (lt, float_complex, float_complex_matrix, float_complex, + float_complex_array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, float_complex, float_complex_matrix, float_complex, + float_complex_array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, float_complex, float_complex_matrix, float_complex, + float_complex_array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, float_complex, float_complex_matrix, float_complex, + float_complex_array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, float_complex, float_complex_matrix, float_complex, + float_complex_array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, float_complex, float_complex_matrix, float_complex, + float_complex_array, mx_el_ne) + +DEFNDBINOP_OP (el_mul, float_complex, float_complex_matrix, float_complex, + float_complex_array, *) +DEFNDBINOP_FN (el_div, float_complex, float_complex_matrix, float_complex, + float_complex_array, x_el_div) +DEFNDBINOP_FN (el_pow, float_complex, float_complex_matrix, float_complex, + float_complex_array, elem_xpow) + +DEFBINOP (el_ldiv, float_complex, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex_matrix&); + + FloatComplex d = v1.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v2.float_complex_array_value () / d); +} + +DEFNDBINOP_FN (el_and, float_complex, float_complex_matrix, float_complex, float_complex_array, mx_el_and) +DEFNDBINOP_FN (el_or, float_complex, float_complex_matrix, float_complex, float_complex_array, mx_el_or) + +DEFNDCATOP_FN (fcs_fcm, float_complex, float_complex_matrix, float_complex_array, float_complex_array, concat) + +DEFNDCATOP_FN (cs_fcm, complex, float_complex_matrix, float_complex_array, float_complex_array, concat) + +DEFNDCATOP_FN (fcs_cm, float_complex, complex_matrix, float_complex_array, float_complex_array, concat) + +DEFCONV (float_complex_matrix_conv, float_complex, float_complex_matrix) +{ + CAST_CONV_ARG (const octave_float_complex&); + + return new octave_float_complex_matrix (v.float_complex_matrix_value ()); +} + +void +install_fcs_fcm_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_complex, octave_float_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_float_complex, octave_float_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_float_complex, octave_float_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_float_complex, octave_float_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_float_complex, octave_float_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_float_complex, octave_float_complex_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_float_complex, octave_float_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_float_complex, octave_float_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_float_complex, octave_float_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_float_complex, octave_float_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_float_complex, octave_float_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_float_complex, octave_float_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_float_complex, octave_float_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_float_complex, octave_float_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_float_complex, octave_float_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_complex, octave_float_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_complex, octave_float_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_float_complex, octave_float_complex_matrix, el_or); + + INSTALL_CATOP (octave_float_complex, octave_float_complex_matrix, fcs_fcm); + INSTALL_CATOP (octave_complex, octave_float_complex_matrix, cs_fcm); + INSTALL_CATOP (octave_float_complex, octave_complex_matrix, fcs_cm); + + INSTALL_ASSIGNCONV (octave_float_complex, octave_float_complex_matrix, octave_float_complex_matrix); + + INSTALL_ASSIGNCONV (octave_complex, octave_float_complex_matrix, octave_complex_matrix); + + INSTALL_WIDENOP (octave_float_complex, octave_float_complex_matrix, float_complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcs-fcs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcs-fcs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,208 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// unary complex scalar ops. + +DEFUNOP (not, float_complex) +{ + CAST_UNOP_ARG (const octave_float_complex&); + FloatComplex x = v.float_complex_value (); + if (xisnan (x)) + gripe_nan_to_logical_conversion (); + return octave_value (x == 0.0f); +} + +DEFUNOP_OP (uplus, float_complex, /* no-op */) +DEFUNOP_OP (uminus, float_complex, -) +DEFUNOP_OP (transpose, float_complex, /* no-op */) + +DEFUNOP (hermitian, float_complex) +{ + CAST_UNOP_ARG (const octave_float_complex&); + + return octave_value (conj (v.float_complex_value ())); +} + +DEFNCUNOP_METHOD (incr, float_complex, increment) +DEFNCUNOP_METHOD (decr, float_complex, decrement) + +// complex scalar by complex scalar ops. + +DEFBINOP_OP (add, float_complex, float_complex, +) +DEFBINOP_OP (sub, float_complex, float_complex, -) +DEFBINOP_OP (mul, float_complex, float_complex, *) + +DEFBINOP (div, float_complex, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); + + FloatComplex d = v2.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v1.float_complex_value () / d); +} + +DEFBINOP_FN (pow, float_complex, float_complex, xpow) + +DEFBINOP (ldiv, float_complex, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); + + FloatComplex d = v1.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v2.float_complex_value () / d); +} + +DEFCMPLXCMPOP_OP (lt, float_complex, float_complex, <) +DEFCMPLXCMPOP_OP (le, float_complex, float_complex, <=) +DEFCMPLXCMPOP_OP (eq, float_complex, float_complex, ==) +DEFCMPLXCMPOP_OP (ge, float_complex, float_complex, >=) +DEFCMPLXCMPOP_OP (gt, float_complex, float_complex, >) +DEFCMPLXCMPOP_OP (ne, float_complex, float_complex, !=) + +DEFBINOP_OP (el_mul, float_complex, float_complex, *) + +DEFBINOP (el_div, float_complex, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); + + FloatComplex d = v2.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v1.float_complex_value () / d); +} + +DEFBINOP_FN (el_pow, float_complex, float_complex, xpow) + +DEFBINOP (el_ldiv, float_complex, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); + + FloatComplex d = v1.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v2.float_complex_value () / d); +} + +DEFBINOP (el_and, float_complex, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); + + return (v1.float_complex_value () != static_cast(0.0) && + v2.float_complex_value () != static_cast(0.0)); +} + +DEFBINOP (el_or, float_complex, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_complex&); + + return (v1.float_complex_value () != static_cast(0.0) || + v2.float_complex_value () != static_cast(0.0)); +} + +DEFNDCATOP_FN (fcs_fcs, float_complex, float_complex, float_complex_array, + float_complex_array, concat) + +DEFNDCATOP_FN (cs_fcs, complex, float_complex, float_complex_array, + float_complex_array, concat) + +DEFNDCATOP_FN (fcs_cs, float_complex, complex, float_complex_array, + float_complex_array, concat) + +CONVDECL (float_complex_to_complex) +{ + CAST_CONV_ARG (const octave_float_complex&); + + return new octave_complex_matrix (ComplexMatrix (1, 1, static_cast(v.float_complex_value ()))); +} + +void +install_fcs_fcs_ops (void) +{ + INSTALL_UNOP (op_not, octave_float_complex, not); + INSTALL_UNOP (op_uplus, octave_float_complex, uplus); + INSTALL_UNOP (op_uminus, octave_float_complex, uminus); + INSTALL_UNOP (op_transpose, octave_float_complex, transpose); + INSTALL_UNOP (op_hermitian, octave_float_complex, hermitian); + + INSTALL_NCUNOP (op_incr, octave_float_complex, incr); + INSTALL_NCUNOP (op_decr, octave_float_complex, decr); + + INSTALL_BINOP (op_add, octave_float_complex, octave_float_complex, add); + INSTALL_BINOP (op_sub, octave_float_complex, octave_float_complex, sub); + INSTALL_BINOP (op_mul, octave_float_complex, octave_float_complex, mul); + INSTALL_BINOP (op_div, octave_float_complex, octave_float_complex, div); + INSTALL_BINOP (op_pow, octave_float_complex, octave_float_complex, pow); + INSTALL_BINOP (op_ldiv, octave_float_complex, octave_float_complex, ldiv); + INSTALL_BINOP (op_lt, octave_float_complex, octave_float_complex, lt); + INSTALL_BINOP (op_le, octave_float_complex, octave_float_complex, le); + INSTALL_BINOP (op_eq, octave_float_complex, octave_float_complex, eq); + INSTALL_BINOP (op_ge, octave_float_complex, octave_float_complex, ge); + INSTALL_BINOP (op_gt, octave_float_complex, octave_float_complex, gt); + INSTALL_BINOP (op_ne, octave_float_complex, octave_float_complex, ne); + INSTALL_BINOP (op_el_mul, octave_float_complex, octave_float_complex, el_mul); + INSTALL_BINOP (op_el_div, octave_float_complex, octave_float_complex, el_div); + INSTALL_BINOP (op_el_pow, octave_float_complex, octave_float_complex, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_complex, octave_float_complex, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_complex, octave_float_complex, el_and); + INSTALL_BINOP (op_el_or, octave_float_complex, octave_float_complex, el_or); + + INSTALL_CATOP (octave_float_complex, octave_float_complex, fcs_fcs); + INSTALL_CATOP (octave_complex, octave_float_complex, cs_fcs); + INSTALL_CATOP (octave_float_complex, octave_complex, fcs_cs); + + INSTALL_ASSIGNCONV (octave_float_complex, octave_float_complex, octave_float_complex_matrix); + + INSTALL_ASSIGNCONV (octave_complex, octave_float_complex, octave_complex_matrix); + + INSTALL_ASSIGNCONV (octave_float_complex, octave_null_matrix, octave_float_complex_matrix); + INSTALL_ASSIGNCONV (octave_float_complex, octave_null_str, octave_float_complex_matrix); + INSTALL_ASSIGNCONV (octave_float_complex, octave_null_sq_str, octave_float_complex_matrix); + + INSTALL_CONVOP (octave_float_complex, octave_complex_matrix, + float_complex_to_complex); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcs-fm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcs-fm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,156 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-cs-nda.h" +#include "mx-nda-cs.h" +#include "mx-cs-nda.h" +#include "mx-nda-cs.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex scalar by matrix ops. + +DEFNDBINOP_OP (add, float_complex, float_matrix, float_complex, float_array, +) +DEFNDBINOP_OP (sub, float_complex, float_matrix, float_complex, float_array, -) +DEFNDBINOP_OP (mul, float_complex, float_matrix, float_complex, float_array, *) + +DEFBINOP (div, float_complex, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_matrix&); + + FloatComplexMatrix m1 = v1.float_complex_matrix_value (); + FloatMatrix m2 = v2.float_matrix_value (); + MatrixType typ = v2.matrix_type (); + + FloatComplexMatrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (pow, float_complex, float_matrix, xpow) + +DEFBINOP (ldiv, float_complex, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_matrix&); + + FloatComplex d = v1.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v2.float_array_value () / d); +} + +DEFNDCMPLXCMPOP_FN (lt, float_complex, float_matrix, float_complex, + float_array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, float_complex, float_matrix, float_complex, + float_array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, float_complex, float_matrix, float_complex, + float_array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, float_complex, float_matrix, float_complex, + float_array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, float_complex, float_matrix, float_complex, + float_array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, float_complex, float_matrix, float_complex, + float_array, mx_el_ne) + +DEFNDBINOP_OP (el_mul, float_complex, float_matrix, float_complex, + float_array, *) +DEFNDBINOP_FN (el_div, float_complex, float_matrix, float_complex, + float_array, x_el_div) +DEFNDBINOP_FN (el_pow, float_complex, float_matrix, float_complex, + float_array, elem_xpow) + +DEFBINOP (el_ldiv, float_complex, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_matrix&); + + FloatComplex d = v1.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v2.float_array_value () / d); +} + +DEFNDBINOP_FN (el_and, float_complex, float_matrix, float_complex, + float_array, mx_el_and) +DEFNDBINOP_FN (el_or, float_complex, float_matrix, float_complex, + float_array, mx_el_or) + +DEFNDCATOP_FN (fcs_fm, float_complex, float_matrix, float_complex_array, + float_array, concat) + +DEFNDCATOP_FN (cs_fm, complex, float_matrix, float_complex_array, + float_array, concat) + +DEFNDCATOP_FN (fcs_m, float_complex, matrix, float_complex_array, + float_array, concat) + +void +install_fcs_fm_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_complex, octave_float_matrix, add); + INSTALL_BINOP (op_sub, octave_float_complex, octave_float_matrix, sub); + INSTALL_BINOP (op_mul, octave_float_complex, octave_float_matrix, mul); + INSTALL_BINOP (op_div, octave_float_complex, octave_float_matrix, div); + INSTALL_BINOP (op_pow, octave_float_complex, octave_float_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_float_complex, octave_float_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_float_complex, octave_float_matrix, lt); + INSTALL_BINOP (op_le, octave_float_complex, octave_float_matrix, le); + INSTALL_BINOP (op_eq, octave_float_complex, octave_float_matrix, eq); + INSTALL_BINOP (op_ge, octave_float_complex, octave_float_matrix, ge); + INSTALL_BINOP (op_gt, octave_float_complex, octave_float_matrix, gt); + INSTALL_BINOP (op_ne, octave_float_complex, octave_float_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_float_complex, octave_float_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_float_complex, octave_float_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_float_complex, octave_float_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_complex, octave_float_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_complex, octave_float_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_float_complex, octave_float_matrix, el_or); + + INSTALL_CATOP (octave_float_complex, octave_float_matrix, fcs_fm); + INSTALL_CATOP (octave_complex, octave_float_matrix, cs_fm); + INSTALL_CATOP (octave_float_complex, octave_matrix, fcs_m); + + INSTALL_ASSIGNCONV (octave_float_complex, octave_float_matrix, + octave_float_complex_matrix); + INSTALL_ASSIGNCONV (octave_complex, octave_float_matrix, + octave_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fcs-fs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fcs-fs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,163 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-float.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex scalar by scalar ops. + +DEFBINOP_OP (add, float_complex, float_scalar, +) +DEFBINOP_OP (sub, float_complex, float_scalar, -) +DEFBINOP_OP (mul, float_complex, float_scalar, *) + +DEFBINOP (div, float_complex, float) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); + + float d = v2.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.float_complex_value () / d); +} + +DEFBINOP_FN (pow, float_complex, float_scalar, xpow) + +DEFBINOP (ldiv, float_complex, float) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); + + FloatComplex d = v1.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v2.float_value () / d); +} + +DEFCMPLXCMPOP_OP (lt, float_complex, float_scalar, <) +DEFCMPLXCMPOP_OP (le, float_complex, float_scalar, <=) +DEFCMPLXCMPOP_OP (eq, float_complex, float_scalar, ==) +DEFCMPLXCMPOP_OP (ge, float_complex, float_scalar, >=) +DEFCMPLXCMPOP_OP (gt, float_complex, float_scalar, >) +DEFCMPLXCMPOP_OP (ne, float_complex, float_scalar, !=) + +DEFBINOP_OP (el_mul, float_complex, float_scalar, *) + +DEFBINOP (el_div, float_complex, float) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); + + float d = v2.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.float_complex_value () / d); +} + +DEFBINOP_FN (el_pow, float_complex, float_scalar, xpow) + +DEFBINOP (el_ldiv, float_complex, float) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); + + FloatComplex d = v1.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v2.float_value () / d); +} + +DEFBINOP (el_and, float_complex, float) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); + + return (v1.float_complex_value () != static_cast(0.0) && + v2.float_value ()); +} + +DEFBINOP (el_or, float_complex, float) +{ + CAST_BINOP_ARGS (const octave_float_complex&, const octave_float_scalar&); + + return (v1.float_complex_value () != static_cast(0.0) || + v2.float_value ()); +} + +DEFNDCATOP_FN (fcs_fs, float_complex, float_scalar, float_complex_array, + float_array, concat) + +DEFNDCATOP_FN (cs_fs, complex, float_scalar, float_complex_array, + float_array, concat) + +DEFNDCATOP_FN (fcs_s, float_complex, scalar, float_complex_array, + float_array, concat) + +void +install_fcs_fs_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_complex, octave_float_scalar, add); + INSTALL_BINOP (op_sub, octave_float_complex, octave_float_scalar, sub); + INSTALL_BINOP (op_mul, octave_float_complex, octave_float_scalar, mul); + INSTALL_BINOP (op_div, octave_float_complex, octave_float_scalar, div); + INSTALL_BINOP (op_pow, octave_float_complex, octave_float_scalar, pow); + INSTALL_BINOP (op_ldiv, octave_float_complex, octave_float_scalar, ldiv); + INSTALL_BINOP (op_lt, octave_float_complex, octave_float_scalar, lt); + INSTALL_BINOP (op_le, octave_float_complex, octave_float_scalar, le); + INSTALL_BINOP (op_eq, octave_float_complex, octave_float_scalar, eq); + INSTALL_BINOP (op_ge, octave_float_complex, octave_float_scalar, ge); + INSTALL_BINOP (op_gt, octave_float_complex, octave_float_scalar, gt); + INSTALL_BINOP (op_ne, octave_float_complex, octave_float_scalar, ne); + INSTALL_BINOP (op_el_mul, octave_float_complex, octave_float_scalar, el_mul); + INSTALL_BINOP (op_el_div, octave_float_complex, octave_float_scalar, el_div); + INSTALL_BINOP (op_el_pow, octave_float_complex, octave_float_scalar, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_complex, octave_float_scalar, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_complex, octave_float_scalar, el_and); + INSTALL_BINOP (op_el_or, octave_float_complex, octave_float_scalar, el_or); + + INSTALL_CATOP (octave_float_complex, octave_float_scalar, fcs_fs); + INSTALL_CATOP (octave_complex, octave_float_scalar, cs_fs); + INSTALL_CATOP (octave_float_complex, octave_scalar, fcs_s); + + INSTALL_ASSIGNCONV (octave_float_complex, octave_float_scalar, + octave_float_complex_matrix); + INSTALL_ASSIGNCONV (octave_complex, octave_float_scalar, + octave_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fdm-fcdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fdm-fcdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,37 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-flt-re-diag.h" +#define RINCLUDE "ov-flt-cx-diag.h" + +#define LMATRIX float_diag_matrix +#define RMATRIX float_complex_diag_matrix +#define LDMATRIX RMATRIX + +#define LSHORT fdm +#define RSHORT fcdm + +#define DEFINEDIV +#define DEFINELDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fdm-fcm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fdm-fcm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-flt-re-diag.h" +#define RINCLUDE "ov-flt-cx-mat.h" + +#define LMATRIX float_diag_matrix +#define RMATRIX float_complex_matrix + +#define LSHORT fdm +#define RSHORT fcm + +#define DEFINELDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fdm-fcs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fdm-fcs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,34 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define SINCLUDE "ov-flt-complex.h" +#define MINCLUDE "ov-flt-re-diag.h" + +#define SCALAR float_complex +#define MATRIX float_diag_matrix +#define MATRIXV float_complex_diag_matrix + +#define SSHORT fcs +#define MSHORT fdm + +#include "op-dms-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fdm-fdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fdm-fdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,103 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-flt-re-mat.h" +#include "ov-flt-re-diag.h" +#include "ov-re-diag.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix unary ops. + +DEFUNOP_OP (uplus, float_diag_matrix, /* no-op */) +DEFUNOP_OP (uminus, float_diag_matrix, -) + +DEFUNOP (transpose, float_diag_matrix) +{ + CAST_UNOP_ARG (const octave_float_diag_matrix&); + return octave_value (v.float_diag_matrix_value ().transpose ()); +} + +// matrix by matrix ops. + +DEFBINOP_OP (add, float_diag_matrix, float_diag_matrix, +) +DEFBINOP_OP (sub, float_diag_matrix, float_diag_matrix, -) +DEFBINOP_OP (mul, float_diag_matrix, float_diag_matrix, *) + +DEFBINOP (div, float_diag_matrix, float_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_float_diag_matrix&, const octave_float_diag_matrix&); + + return xdiv (v1.float_diag_matrix_value (), + v2.float_diag_matrix_value ()); +} + +DEFBINOP (ldiv, float_diag_matrix, float_diag_matrix) +{ + CAST_BINOP_ARGS (const octave_float_diag_matrix&, const octave_float_diag_matrix&); + + return xleftdiv (v1.float_diag_matrix_value (), + v2.float_diag_matrix_value ()); +} + +CONVDECL (float_diag_matrix_to_diag_matrix) +{ + CAST_CONV_ARG (const octave_float_diag_matrix&); + + return new octave_diag_matrix (v.diag_matrix_value ()); +} + +CONVDECL (float_diag_matrix_to_float_matrix) +{ + CAST_CONV_ARG (const octave_float_diag_matrix&); + + return new octave_float_matrix (v.float_matrix_value ()); +} + +void +install_fdm_fdm_ops (void) +{ + INSTALL_UNOP (op_uplus, octave_float_diag_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_float_diag_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_float_diag_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_float_diag_matrix, transpose); + + INSTALL_BINOP (op_add, octave_float_diag_matrix, octave_float_diag_matrix, add); + INSTALL_BINOP (op_sub, octave_float_diag_matrix, octave_float_diag_matrix, sub); + INSTALL_BINOP (op_mul, octave_float_diag_matrix, octave_float_diag_matrix, mul); + INSTALL_BINOP (op_div, octave_float_diag_matrix, octave_float_diag_matrix, div); + INSTALL_BINOP (op_ldiv, octave_float_diag_matrix, octave_float_diag_matrix, ldiv); + + INSTALL_CONVOP (octave_float_diag_matrix, octave_float_matrix, float_diag_matrix_to_float_matrix); + INSTALL_CONVOP (octave_float_diag_matrix, octave_diag_matrix, float_diag_matrix_to_diag_matrix); + INSTALL_ASSIGNCONV (octave_float_diag_matrix, octave_float_matrix, octave_float_matrix); + INSTALL_WIDENOP (octave_float_diag_matrix, octave_float_matrix, float_diag_matrix_to_float_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fdm-fm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fdm-fm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-flt-re-diag.h" +#define RINCLUDE "ov-flt-re-mat.h" + +#define LMATRIX float_diag_matrix +#define RMATRIX float_matrix + +#define LSHORT fdm +#define RSHORT fm + +#define DEFINELDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fdm-fs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fdm-fs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,33 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define SINCLUDE "ov-float.h" +#define MINCLUDE "ov-flt-re-diag.h" + +#define SCALAR float_scalar +#define MATRIX float_diag_matrix + +#define SSHORT fs +#define MSHORT fdm + +#include "op-dms-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-float-conv.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-float-conv.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,111 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-range.h" +#include "ov-float.h" +#include "ov-flt-re-mat.h" +#include "ov-str-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" + +// conversion ops + +DEFFLTCONVFN (int8_matrix_to_float_matrix, int8_matrix, int8_array) +DEFFLTCONVFN (int16_matrix_to_float_matrix, int16_matrix, int16_array) +DEFFLTCONVFN (int32_matrix_to_float_matrix, int32_matrix, int32_array) +DEFFLTCONVFN (int64_matrix_to_float_matrix, int64_matrix, int64_array) + +DEFFLTCONVFN (uint8_matrix_to_float_matrix, uint8_matrix, uint8_array) +DEFFLTCONVFN (uint16_matrix_to_float_matrix, uint16_matrix, uint16_array) +DEFFLTCONVFN (uint32_matrix_to_float_matrix, uint32_matrix, uint32_array) +DEFFLTCONVFN (uint64_matrix_to_float_matrix, uint64_matrix, uint64_array) + +DEFFLTCONVFN (int8_scalar_to_float_matrix, int8_scalar, int8_array) +DEFFLTCONVFN (int16_scalar_to_float_matrix, int16_scalar, int16_array) +DEFFLTCONVFN (int32_scalar_to_float_matrix, int32_scalar, int32_array) +DEFFLTCONVFN (int64_scalar_to_float_matrix, int64_scalar, int64_array) + +DEFFLTCONVFN (uint8_scalar_to_float_matrix, uint8_scalar, uint8_array) +DEFFLTCONVFN (uint16_scalar_to_float_matrix, uint16_scalar, uint16_array) +DEFFLTCONVFN (uint32_scalar_to_float_matrix, uint32_scalar, uint32_array) +DEFFLTCONVFN (uint64_scalar_to_float_matrix, uint64_scalar, uint64_array) + +DEFFLTCONVFN (bool_matrix_to_float_matrix, bool_matrix, bool_array) +DEFFLTCONVFN (bool_scalar_to_float_matrix, bool, bool_array) + +DEFFLTCONVFN (range_to_float_matrix, range, array) + +DEFSTRFLTCONVFN(char_matrix_str_to_float_matrix, char_matrix_str) +DEFSTRFLTCONVFN(char_matrix_sq_str_to_float_matrix, char_matrix_sq_str) + +DEFFLTCONVFN (float_scalar_to_float_matrix, scalar, array) + +void +install_float_conv_ops (void) +{ + INSTALL_CONVOP (octave_int8_matrix, octave_float_matrix, int8_matrix_to_float_matrix); + INSTALL_CONVOP (octave_int16_matrix, octave_float_matrix, int16_matrix_to_float_matrix); + INSTALL_CONVOP (octave_int32_matrix, octave_float_matrix, int32_matrix_to_float_matrix); + INSTALL_CONVOP (octave_int64_matrix, octave_float_matrix, int64_matrix_to_float_matrix); + + INSTALL_CONVOP (octave_uint8_matrix, octave_float_matrix, uint8_matrix_to_float_matrix); + INSTALL_CONVOP (octave_uint16_matrix, octave_float_matrix, uint16_matrix_to_float_matrix); + INSTALL_CONVOP (octave_uint32_matrix, octave_float_matrix, uint32_matrix_to_float_matrix); + INSTALL_CONVOP (octave_uint64_matrix, octave_float_matrix, uint64_matrix_to_float_matrix); + + INSTALL_CONVOP (octave_int8_scalar, octave_float_matrix, int8_scalar_to_float_matrix); + INSTALL_CONVOP (octave_int16_scalar, octave_float_matrix, int16_scalar_to_float_matrix); + INSTALL_CONVOP (octave_int32_scalar, octave_float_matrix, int32_scalar_to_float_matrix); + INSTALL_CONVOP (octave_int64_scalar, octave_float_matrix, int64_scalar_to_float_matrix); + + INSTALL_CONVOP (octave_uint8_scalar, octave_float_matrix, uint8_scalar_to_float_matrix); + INSTALL_CONVOP (octave_uint16_scalar, octave_float_matrix, uint16_scalar_to_float_matrix); + INSTALL_CONVOP (octave_uint32_scalar, octave_float_matrix, uint32_scalar_to_float_matrix); + INSTALL_CONVOP (octave_uint64_scalar, octave_float_matrix, uint64_scalar_to_float_matrix); + + INSTALL_CONVOP (octave_bool_matrix, octave_float_matrix, bool_matrix_to_float_matrix); + INSTALL_CONVOP (octave_bool, octave_float_matrix, bool_scalar_to_float_matrix); + + INSTALL_CONVOP (octave_range, octave_float_matrix, range_to_float_matrix); + + INSTALL_CONVOP (octave_char_matrix_str, octave_float_matrix, char_matrix_str_to_float_matrix); + INSTALL_CONVOP (octave_char_matrix_sq_str, octave_float_matrix, char_matrix_sq_str_to_float_matrix); + + INSTALL_CONVOP (octave_scalar, octave_float_matrix, float_scalar_to_float_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fm-fcdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fm-fcdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,36 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-flt-re-mat.h" +#define RINCLUDE "ov-flt-cx-diag.h" + +#define LMATRIX float_matrix +#define RMATRIX float_complex_diag_matrix +#define LDMATRIX float_complex_matrix + +#define LSHORT fm +#define RSHORT fcdm + +#define DEFINEDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fm-fcm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fm-fcm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,206 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-fm-fcm.h" +#include "mx-fcm-fm.h" +#include "mx-fnda-fcnda.h" +#include "mx-fcnda-fnda.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix by complex matrix ops. + +DEFNDBINOP_OP (add, float_matrix, float_complex_matrix, float_array, + float_complex_array, +) +DEFNDBINOP_OP (sub, float_matrix, float_complex_matrix, float_array, + float_complex_array, -) + +DEFBINOP_OP (mul, float_matrix, float_complex_matrix, *) + +DEFBINOP (trans_mul, float_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_complex_matrix&); + + FloatMatrix m1 = v1.float_matrix_value (); + FloatComplexMatrix m2 = v2.float_complex_matrix_value (); + + return FloatComplexMatrix (xgemm (m1, real (m2), blas_trans, blas_no_trans), + xgemm (m1, imag (m2), blas_trans, blas_no_trans)); +} + +DEFBINOP (div, float_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, + const octave_float_complex_matrix&); + MatrixType typ = v2.matrix_type (); + + FloatComplexMatrix ret = xdiv (v1.float_matrix_value (), + v2.float_complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOPX (pow, float_matrix, float_complex_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, float_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, + const octave_float_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + FloatComplexMatrix ret = xleftdiv (v1.float_matrix_value (), + v2.float_complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP (trans_ldiv, float_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, + const octave_float_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + FloatComplexMatrix ret = xleftdiv (v1.float_matrix_value (), + v2.float_complex_matrix_value (), typ, blas_trans); + + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, float_matrix, float_complex_matrix, float_array, + float_complex_array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, float_matrix, float_complex_matrix, float_array, + float_complex_array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, float_matrix, float_complex_matrix, float_array, + float_complex_array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, float_matrix, float_complex_matrix, float_array, + float_complex_array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, float_matrix, float_complex_matrix, float_array, + float_complex_array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, float_matrix, float_complex_matrix, float_array, + float_complex_array, mx_el_ne) + +DEFNDBINOP_FN (el_mul, float_matrix, float_complex_matrix, float_array, + float_complex_array, product) +DEFNDBINOP_FN (el_div, float_matrix, float_complex_matrix, float_array, + float_complex_array, quotient) +DEFNDBINOP_FN (el_pow, float_matrix, float_complex_matrix, float_array, + float_complex_array, elem_xpow) + +DEFBINOP (el_ldiv, float_matrix, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, + const octave_float_complex_matrix&); + + return quotient (v2.float_complex_array_value (), v1.float_array_value ()); +} + +DEFNDBINOP_FN (el_and, float_matrix, float_complex_matrix, float_array, + float_complex_array, mx_el_and) +DEFNDBINOP_FN (el_or, float_matrix, float_complex_matrix, float_array, + float_complex_array, mx_el_or) + +DEFNDCATOP_FN (fm_fcm, float_matrix, float_complex_matrix, float_array, + float_complex_array, concat) + +DEFNDCATOP_FN (m_fcm, matrix, float_complex_matrix, float_array, + float_complex_array, concat) + +DEFNDCATOP_FN (fm_cm, float_matrix, complex_matrix, float_array, + float_complex_array, concat) + +DEFCONV (float_complex_matrix_conv, float_matrix, float_complex_matrix) +{ + CAST_CONV_ARG (const octave_float_matrix&); + + return new octave_float_complex_matrix (FloatComplexNDArray (v.float_array_value ())); +} + +void +install_fm_fcm_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_matrix, octave_float_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_float_matrix, octave_float_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_float_matrix, octave_float_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_float_matrix, octave_float_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_float_matrix, octave_float_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_float_matrix, + octave_float_complex_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_float_matrix, octave_float_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_float_matrix, octave_float_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_float_matrix, octave_float_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_float_matrix, octave_float_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_float_matrix, octave_float_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_float_matrix, octave_float_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_float_matrix, + octave_float_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_float_matrix, + octave_float_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_float_matrix, + octave_float_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_matrix, + octave_float_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_matrix, + octave_float_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_float_matrix, + octave_float_complex_matrix, el_or); + INSTALL_BINOP (op_trans_mul, octave_float_matrix, + octave_float_complex_matrix, trans_mul); + INSTALL_BINOP (op_herm_mul, octave_float_matrix, + octave_float_complex_matrix, trans_mul); + INSTALL_BINOP (op_trans_ldiv, octave_float_matrix, + octave_float_complex_matrix, trans_ldiv); + INSTALL_BINOP (op_herm_ldiv, octave_float_matrix, + octave_float_complex_matrix, trans_ldiv); + + INSTALL_CATOP (octave_float_matrix, octave_float_complex_matrix, fm_fcm); + INSTALL_CATOP (octave_matrix, octave_float_complex_matrix, m_fcm); + INSTALL_CATOP (octave_float_matrix, octave_complex_matrix, fm_cm); + + INSTALL_ASSIGNCONV (octave_float_matrix, octave_float_complex_matrix, + octave_float_complex_matrix); + INSTALL_ASSIGNCONV (octave_matrix, octave_float_complex_matrix, + octave_complex_matrix); + + INSTALL_WIDENOP (octave_float_matrix, octave_float_complex_matrix, + float_complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fm-fcs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fm-fcs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,162 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-fm-fcs.h" +#include "mx-fcs-fm.h" +#include "mx-fnda-fcs.h" +#include "mx-fcs-fnda.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-flt-complex.h" +#include "ov-complex.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix by complex scalar ops. + +DEFNDBINOP_OP (add, float_matrix, float_complex, float_array, float_complex, +) +DEFNDBINOP_OP (sub, float_matrix, float_complex, float_array, float_complex, -) +DEFNDBINOP_OP (mul, float_matrix, float_complex, float_array, float_complex, *) + +DEFBINOP (div, float_matrix, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_complex&); + + FloatComplex d = v2.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v1.float_array_value () / d); +} + +DEFBINOP_FN (pow, float_matrix, float_complex, xpow) + +DEFBINOP (ldiv, float_matrix, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_complex&); + + FloatMatrix m1 = v1.float_matrix_value (); + FloatComplexMatrix m2 = v2.float_complex_matrix_value (); + MatrixType typ = v1.matrix_type (); + + FloatComplexMatrix ret = xleftdiv (m1, m2, typ); + + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, float_matrix, float_complex, float_array, + float_complex, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, float_matrix, float_complex, float_array, + float_complex, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, float_matrix, float_complex, float_array, + float_complex, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, float_matrix, float_complex, float_array, + float_complex, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, float_matrix, float_complex, float_array, + float_complex, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, float_matrix, float_complex, float_array, + float_complex, mx_el_ne) + +DEFNDBINOP_OP (el_mul, float_matrix, float_complex, float_array, + float_complex, *) + +DEFBINOP (el_div, float_matrix, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_complex&); + + FloatComplex d = v2.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v1.float_array_value () / d); +} + +DEFNDBINOP_FN (el_pow, float_matrix, float_complex, float_array, + float_complex, elem_xpow) + +DEFBINOP (el_ldiv, float_matrix, flaot_complex) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_complex&); + + return x_el_div (v2.float_complex_value (), v1.float_array_value ()); +} + +DEFNDBINOP_FN (el_and, float_matrix, float_complex, float_array, + float_complex, mx_el_and) +DEFNDBINOP_FN (el_or, float_matrix, float_complex, float_array, + float_complex, mx_el_or) + +DEFNDCATOP_FN (fm_fcs, float_matrix, float_complex, float_array, + float_complex_array, concat) + +DEFNDCATOP_FN (m_fcs, matrix, float_complex, float_array, + float_complex_array, concat) + +DEFNDCATOP_FN (fm_cs, float_matrix, complex, float_array, + float_complex_array, concat) + +void +install_fm_fcs_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_matrix, octave_float_complex, add); + INSTALL_BINOP (op_sub, octave_float_matrix, octave_float_complex, sub); + INSTALL_BINOP (op_mul, octave_float_matrix, octave_float_complex, mul); + INSTALL_BINOP (op_div, octave_float_matrix, octave_float_complex, div); + INSTALL_BINOP (op_pow, octave_float_matrix, octave_float_complex, pow); + INSTALL_BINOP (op_ldiv, octave_float_matrix, octave_float_complex, ldiv); + INSTALL_BINOP (op_lt, octave_float_matrix, octave_float_complex, lt); + INSTALL_BINOP (op_le, octave_float_matrix, octave_float_complex, le); + INSTALL_BINOP (op_eq, octave_float_matrix, octave_float_complex, eq); + INSTALL_BINOP (op_ge, octave_float_matrix, octave_float_complex, ge); + INSTALL_BINOP (op_gt, octave_float_matrix, octave_float_complex, gt); + INSTALL_BINOP (op_ne, octave_float_matrix, octave_float_complex, ne); + INSTALL_BINOP (op_el_mul, octave_float_matrix, octave_float_complex, el_mul); + INSTALL_BINOP (op_el_div, octave_float_matrix, octave_float_complex, el_div); + INSTALL_BINOP (op_el_pow, octave_float_matrix, octave_float_complex, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_matrix, octave_float_complex, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_matrix, octave_float_complex, el_and); + INSTALL_BINOP (op_el_or, octave_float_matrix, octave_float_complex, el_or); + + INSTALL_CATOP (octave_float_matrix, octave_float_complex, fm_fcs); + INSTALL_CATOP (octave_matrix, octave_float_complex, m_fcs); + INSTALL_CATOP (octave_float_matrix, octave_complex, fm_cs); + + INSTALL_ASSIGNCONV (octave_float_matrix, octave_float_complex, + octave_float_complex_matrix); + INSTALL_ASSIGNCONV (octave_matrix, octave_float_complex, + octave_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fm-fdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fm-fdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-flt-re-mat.h" +#define RINCLUDE "ov-flt-re-diag.h" + +#define LMATRIX float_matrix +#define RMATRIX float_diag_matrix + +#define LSHORT fm +#define RSHORT fdm + +#define DEFINEDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-fm-fm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fm-fm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,255 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix unary ops. + +DEFNDUNOP_OP (not, float_matrix, float_array, !) +DEFNDUNOP_OP (uplus, float_matrix, float_array, /* no-op */) +DEFNDUNOP_OP (uminus, float_matrix, float_array, -) + +DEFUNOP (transpose, float_matrix) +{ + CAST_UNOP_ARG (const octave_float_matrix&); + + if (v.ndims () > 2) + { + error ("transpose not defined for N-d objects"); + return octave_value (); + } + else + return octave_value (v.float_matrix_value ().transpose ()); +} + +DEFNCUNOP_METHOD (incr, float_matrix, increment) +DEFNCUNOP_METHOD (decr, float_matrix, decrement) +DEFNCUNOP_METHOD (changesign, float_matrix, changesign) + +// matrix by matrix ops. + +DEFNDBINOP_OP (add, float_matrix, float_matrix, float_array, float_array, +) +DEFNDBINOP_OP (sub, float_matrix, float_matrix, float_array, float_array, -) + +DEFBINOP_OP (mul, float_matrix, float_matrix, *) + +DEFBINOP (div, float_matrix, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); + MatrixType typ = v2.matrix_type (); + + FloatMatrix ret = xdiv (v1.float_matrix_value (), + v2.float_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOPX (pow, float_matrix, float_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, float_matrix, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); + MatrixType typ = v1.matrix_type (); + + FloatMatrix ret = xleftdiv (v1.float_matrix_value (), + v2.float_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP (trans_mul, float_matrix, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); + return octave_value(xgemm (v1.float_matrix_value (), + v2.float_matrix_value (), + blas_trans, blas_no_trans)); +} + +DEFBINOP (mul_trans, float_matrix, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); + return octave_value(xgemm (v1.float_matrix_value (), + v2.float_matrix_value (), + blas_no_trans, blas_trans)); +} + +DEFBINOP (trans_ldiv, float_matrix, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); + MatrixType typ = v1.matrix_type (); + + FloatMatrix ret = xleftdiv (v1.float_matrix_value (), + v2.float_matrix_value (), typ, blas_trans); + + v1.matrix_type (typ); + return ret; +} + +DEFNDBINOP_FN (lt, float_matrix, float_matrix, float_array, + float_array, mx_el_lt) +DEFNDBINOP_FN (le, float_matrix, float_matrix, float_array, + float_array, mx_el_le) +DEFNDBINOP_FN (eq, float_matrix, float_matrix, float_array, + float_array, mx_el_eq) +DEFNDBINOP_FN (ge, float_matrix, float_matrix, float_array, + float_array, mx_el_ge) +DEFNDBINOP_FN (gt, float_matrix, float_matrix, float_array, + float_array, mx_el_gt) +DEFNDBINOP_FN (ne, float_matrix, float_matrix, float_array, + float_array, mx_el_ne) + +DEFNDBINOP_FN (el_mul, float_matrix, float_matrix, float_array, + float_array, product) +DEFNDBINOP_FN (el_div, float_matrix, float_matrix, float_array, + float_array, quotient) +DEFNDBINOP_FN (el_pow, float_matrix, float_matrix, float_array, + float_array, elem_xpow) + +DEFBINOP (el_ldiv, float_matrix, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_matrix&); + + return octave_value (quotient (v2.float_array_value (), + v1.float_array_value ())); +} + +DEFNDBINOP_FN (el_and, float_matrix, float_matrix, float_array, + float_array, mx_el_and) +DEFNDBINOP_FN (el_or, float_matrix, float_matrix, float_array, + float_array, mx_el_or) +DEFNDBINOP_FN (el_not_and, float_matrix, float_matrix, float_array, + float_array, mx_el_not_and) +DEFNDBINOP_FN (el_not_or, float_matrix, float_matrix, float_array, + float_array, mx_el_not_or) +DEFNDBINOP_FN (el_and_not, float_matrix, float_matrix, float_array, + float_array, mx_el_and_not) +DEFNDBINOP_FN (el_or_not, float_matrix, float_matrix, float_array, + float_array, mx_el_or_not) + + + +DEFNDCATOP_FN (fm_fm, float_matrix, float_matrix, float_array, + float_array, concat) + +DEFNDCATOP_FN (m_fm, matrix, float_matrix, float_array, float_array, concat) + +DEFNDCATOP_FN (fm_m, float_matrix, matrix, float_array, float_array, concat) + +DEFNDASSIGNOP_FN (assign, float_matrix, float_matrix, float_array, assign) + +DEFNDASSIGNOP_FN (dbl_assign, matrix, float_matrix, array, assign) + +DEFNULLASSIGNOP_FN (null_assign, float_matrix, delete_elements) + +DEFNDASSIGNOP_OP (assign_add, float_matrix, float_matrix, float_array, +=) +DEFNDASSIGNOP_OP (assign_sub, float_matrix, float_matrix, float_array, -=) +DEFNDASSIGNOP_FNOP (assign_el_mul, float_matrix, float_matrix, float_array, product_eq) +DEFNDASSIGNOP_FNOP (assign_el_div, float_matrix, float_matrix, float_array, quotient_eq) + +CONVDECL (float_matrix_to_matrix) +{ + CAST_CONV_ARG (const octave_float_matrix&); + + return new octave_matrix (v.array_value ()); +} + +void +install_fm_fm_ops (void) +{ + INSTALL_UNOP (op_not, octave_float_matrix, not); + INSTALL_UNOP (op_uplus, octave_float_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_float_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_float_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_float_matrix, transpose); + + INSTALL_NCUNOP (op_incr, octave_float_matrix, incr); + INSTALL_NCUNOP (op_decr, octave_float_matrix, decr); + INSTALL_NCUNOP (op_uminus, octave_float_matrix, changesign); + + INSTALL_BINOP (op_add, octave_float_matrix, octave_float_matrix, add); + INSTALL_BINOP (op_sub, octave_float_matrix, octave_float_matrix, sub); + INSTALL_BINOP (op_mul, octave_float_matrix, octave_float_matrix, mul); + INSTALL_BINOP (op_div, octave_float_matrix, octave_float_matrix, div); + INSTALL_BINOP (op_pow, octave_float_matrix, octave_float_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_float_matrix, octave_float_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_float_matrix, octave_float_matrix, lt); + INSTALL_BINOP (op_le, octave_float_matrix, octave_float_matrix, le); + INSTALL_BINOP (op_eq, octave_float_matrix, octave_float_matrix, eq); + INSTALL_BINOP (op_ge, octave_float_matrix, octave_float_matrix, ge); + INSTALL_BINOP (op_gt, octave_float_matrix, octave_float_matrix, gt); + INSTALL_BINOP (op_ne, octave_float_matrix, octave_float_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_float_matrix, octave_float_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_float_matrix, octave_float_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_float_matrix, octave_float_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_matrix, octave_float_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_matrix, octave_float_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_float_matrix, octave_float_matrix, el_or); + INSTALL_BINOP (op_el_and_not, octave_float_matrix, octave_float_matrix, el_and_not); + INSTALL_BINOP (op_el_or_not, octave_float_matrix, octave_float_matrix, el_or_not); + INSTALL_BINOP (op_el_not_and, octave_float_matrix, octave_float_matrix, el_not_and); + INSTALL_BINOP (op_el_not_or, octave_float_matrix, octave_float_matrix, el_not_or); + INSTALL_BINOP (op_trans_mul, octave_float_matrix, octave_float_matrix, trans_mul); + INSTALL_BINOP (op_mul_trans, octave_float_matrix, octave_float_matrix, mul_trans); + INSTALL_BINOP (op_herm_mul, octave_float_matrix, octave_float_matrix, trans_mul); + INSTALL_BINOP (op_mul_herm, octave_float_matrix, octave_float_matrix, mul_trans); + INSTALL_BINOP (op_trans_ldiv, octave_float_matrix, octave_float_matrix, trans_ldiv); + INSTALL_BINOP (op_herm_ldiv, octave_float_matrix, octave_float_matrix, trans_ldiv); + + INSTALL_CATOP (octave_float_matrix, octave_float_matrix, fm_fm); + INSTALL_CATOP (octave_matrix, octave_float_matrix, m_fm); + INSTALL_CATOP (octave_float_matrix, octave_matrix, fm_m); + + INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, + octave_float_matrix, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, + octave_float_matrix, dbl_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_null_matrix, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_null_str, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_null_sq_str, null_assign); + + INSTALL_ASSIGNOP (op_add_eq, octave_float_matrix, octave_float_matrix, assign_add); + INSTALL_ASSIGNOP (op_sub_eq, octave_float_matrix, octave_float_matrix, assign_sub); + INSTALL_ASSIGNOP (op_el_mul_eq, octave_float_matrix, octave_float_matrix, assign_el_mul); + INSTALL_ASSIGNOP (op_el_div_eq, octave_float_matrix, octave_float_matrix, assign_el_div); + + INSTALL_CONVOP (octave_float_matrix, octave_matrix, float_matrix_to_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fm-fs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fm-fs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,162 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-flt-re-mat.h" +#include "ov-float.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix by scalar ops. + +DEFNDBINOP_OP (add, float_matrix, float_scalar, float_array, float_scalar, +) +DEFNDBINOP_OP (sub, float_matrix, float_scalar, float_array, float_scalar, -) +DEFNDBINOP_OP (mul, float_matrix, float_scalar, float_array, float_scalar, *) + +DEFBINOP (div, float_matrix, float) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_scalar&); + + float d = v2.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.float_array_value () / d); +} + +DEFBINOP_FN (pow, float_matrix, float_scalar, xpow) + +DEFBINOP (ldiv, float_matrix, float) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_scalar&); + + FloatMatrix m1 = v1.float_matrix_value (); + FloatMatrix m2 = v2.float_matrix_value (); + MatrixType typ = v1.matrix_type (); + + FloatMatrix ret = xleftdiv (m1, m2, typ); + + v1.matrix_type (typ); + return ret; +} + +DEFNDBINOP_FN (lt, float_matrix, float_scalar, float_array, + float_scalar, mx_el_lt) +DEFNDBINOP_FN (le, float_matrix, float_scalar, float_array, + float_scalar, mx_el_le) +DEFNDBINOP_FN (eq, float_matrix, float_scalar, float_array, + float_scalar, mx_el_eq) +DEFNDBINOP_FN (ge, float_matrix, float_scalar, float_array, + float_scalar, mx_el_ge) +DEFNDBINOP_FN (gt, float_matrix, float_scalar, float_array, + float_scalar, mx_el_gt) +DEFNDBINOP_FN (ne, float_matrix, float_scalar, float_array, + float_scalar, mx_el_ne) + +DEFNDBINOP_OP (el_mul, float_matrix, float_scalar, float_array, float_scalar, *) + +DEFBINOP (el_div, float_matrix, float) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_scalar&); + + float d = v2.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.float_array_value () / d); +} + +DEFNDBINOP_FN (el_pow, float_matrix, float_scalar, float_array, + float_scalar, elem_xpow) + +DEFBINOP (el_ldiv, float_matrix, float) +{ + CAST_BINOP_ARGS (const octave_float_matrix&, const octave_float_scalar&); + + return x_el_div (v2.float_value (), v1.float_array_value ()); +} + +DEFNDBINOP_FN (el_and, float_matrix, float_scalar, float_array, + float_scalar, mx_el_and) +DEFNDBINOP_FN (el_or, float_matrix, float_scalar, float_array, + float_scalar, mx_el_or) + +DEFNDCATOP_FN (fm_fs, float_matrix, float_scalar, float_array, + float_array, concat) + +DEFNDCATOP_FN (m_fs, matrix, float_scalar, float_array, float_array, concat) + +DEFNDCATOP_FN (fm_s, float_matrix, scalar, float_array, float_array, concat) + +DEFNDASSIGNOP_FN (assign, float_matrix, float_scalar, float_scalar, assign) +DEFNDASSIGNOP_FN (dbl_assign, matrix, float_scalar, scalar, assign) + +DEFNDASSIGNOP_OP (assign_add, float_matrix, float_scalar, float_scalar, +=) +DEFNDASSIGNOP_OP (assign_sub, float_matrix, float_scalar, float_scalar, -=) +DEFNDASSIGNOP_OP (assign_mul, float_matrix, float_scalar, float_scalar, *=) +DEFNDASSIGNOP_OP (assign_div, float_matrix, float_scalar, float_scalar, /=) + +void +install_fm_fs_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_matrix, octave_float_scalar, add); + INSTALL_BINOP (op_sub, octave_float_matrix, octave_float_scalar, sub); + INSTALL_BINOP (op_mul, octave_float_matrix, octave_float_scalar, mul); + INSTALL_BINOP (op_div, octave_float_matrix, octave_float_scalar, div); + INSTALL_BINOP (op_pow, octave_float_matrix, octave_float_scalar, pow); + INSTALL_BINOP (op_ldiv, octave_float_matrix, octave_float_scalar, ldiv); + INSTALL_BINOP (op_lt, octave_float_matrix, octave_float_scalar, lt); + INSTALL_BINOP (op_le, octave_float_matrix, octave_float_scalar, le); + INSTALL_BINOP (op_eq, octave_float_matrix, octave_float_scalar, eq); + INSTALL_BINOP (op_ge, octave_float_matrix, octave_float_scalar, ge); + INSTALL_BINOP (op_gt, octave_float_matrix, octave_float_scalar, gt); + INSTALL_BINOP (op_ne, octave_float_matrix, octave_float_scalar, ne); + INSTALL_BINOP (op_el_mul, octave_float_matrix, octave_float_scalar, el_mul); + INSTALL_BINOP (op_el_div, octave_float_matrix, octave_float_scalar, el_div); + INSTALL_BINOP (op_el_pow, octave_float_matrix, octave_float_scalar, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_matrix, octave_float_scalar, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_matrix, octave_float_scalar, el_and); + INSTALL_BINOP (op_el_or, octave_float_matrix, octave_float_scalar, el_or); + + INSTALL_CATOP (octave_float_matrix, octave_float_scalar, fm_fs); + INSTALL_CATOP (octave_matrix, octave_float_scalar, m_fs); + INSTALL_CATOP (octave_float_matrix, octave_scalar, fm_s); + + INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_float_scalar, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_float_scalar, dbl_assign); + + INSTALL_ASSIGNOP (op_add_eq, octave_float_matrix, octave_float_scalar, assign_add); + INSTALL_ASSIGNOP (op_sub_eq, octave_float_matrix, octave_float_scalar, assign_sub); + INSTALL_ASSIGNOP (op_mul_eq, octave_float_matrix, octave_float_scalar, assign_mul); + INSTALL_ASSIGNOP (op_div_eq, octave_float_matrix, octave_float_scalar, assign_div); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fm-pm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fm-pm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,33 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define MINCLUDE "ov-flt-re-mat.h" + +#define LMATRIX float_matrix +#define RMATRIX perm_matrix + +#define LSHORT fm +#define RSHORT pm + +#define RIGHT + +#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/operators/op-fs-fcm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fs-fcm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,178 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-fs-fcm.h" +#include "mx-fcm-fs.h" +#include "mx-fs-fcnda.h" +#include "mx-fcnda-fs.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar by complex matrix ops. + +DEFNDBINOP_OP (add, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, +) +DEFNDBINOP_OP (sub, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, -) +DEFNDBINOP_OP (mul, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, *) + +DEFBINOP (div, float_scalar, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, + const octave_float_complex_matrix&); + + FloatMatrix m1 = v1.float_matrix_value (); + FloatComplexMatrix m2 = v2.float_complex_matrix_value (); + MatrixType typ = v2.matrix_type (); + + FloatComplexMatrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (pow, float_scalar, float_complex_matrix, xpow) + +DEFBINOP (ldiv, float_scalar, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, + const octave_float_complex_matrix&); + + float d = v1.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.float_complex_array_value () / d); +} + +DEFNDCMPLXCMPOP_FN (lt, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, mx_el_ne) + +DEFNDBINOP_OP (el_mul, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, *) +DEFNDBINOP_FN (el_div, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, x_el_div) +DEFNDBINOP_FN (el_pow, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, elem_xpow) + +DEFBINOP (el_ldiv, float_scalar, float_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, + const octave_float_complex_matrix&); + + float d = v1.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.float_complex_array_value () / d); +} + +DEFNDBINOP_FN (el_and, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, mx_el_and) +DEFNDBINOP_FN (el_or, float_scalar, float_complex_matrix, float_scalar, + float_complex_array, mx_el_or) + +DEFNDCATOP_FN (fs_fcm, float_scalar, float_complex_matrix, float_array, + float_complex_array, concat) + +DEFNDCATOP_FN (s_fcm, scalar, float_complex_matrix, float_array, + float_complex_array, concat) + +DEFNDCATOP_FN (fs_cm, float_scalar, complex_matrix, float_array, + float_complex_array, concat) + +DEFCONV (float_complex_matrix_conv, float_scalar, float_complex_matrix) +{ + CAST_CONV_ARG (const octave_float_scalar&); + + return new octave_float_complex_matrix (FloatComplexMatrix (v.float_matrix_value ())); +} + +void +install_fs_fcm_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_scalar, octave_float_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_float_scalar, octave_float_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_float_scalar, octave_float_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_float_scalar, octave_float_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_float_scalar, octave_float_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_float_scalar, + octave_float_complex_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_float_scalar, octave_float_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_float_scalar, octave_float_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_float_scalar, octave_float_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_float_scalar, octave_float_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_float_scalar, octave_float_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_float_scalar, octave_float_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_float_scalar, + octave_float_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_float_scalar, + octave_float_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_float_scalar, + octave_float_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_scalar, + octave_float_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_scalar, + octave_float_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_float_scalar, + octave_float_complex_matrix, el_or); + + INSTALL_CATOP (octave_float_scalar, octave_float_complex_matrix, fs_fcm); + INSTALL_CATOP (octave_scalar, octave_float_complex_matrix, s_fcm); + INSTALL_CATOP (octave_float_scalar, octave_complex_matrix, fs_cm); + + INSTALL_ASSIGNCONV (octave_float_scalar, octave_float_complex_matrix, + octave_float_complex_matrix); + INSTALL_ASSIGNCONV (octave_scalar, octave_float_complex_matrix, + octave_complex_matrix); + + INSTALL_WIDENOP (octave_float_scalar, octave_float_complex_matrix, + float_complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fs-fcs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fs-fcs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,161 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-flt-complex.h" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar by complex scalar ops. + +DEFBINOP_OP (add, float_scalar, float_complex, +) +DEFBINOP_OP (sub, float_scalar, float_complex, -) +DEFBINOP_OP (mul, float_scalar, float_complex, *) + +DEFBINOP (div, float_scalar, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); + + FloatComplex d = v2.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v1.float_value () / d); +} + +DEFBINOP_FN (pow, float_scalar, float_complex, xpow) + +DEFBINOP (ldiv, float_scalar, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); + + float d = v1.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.float_complex_value () / d); +} + +DEFCMPLXCMPOP_OP (lt, float_scalar, float_complex, <) +DEFCMPLXCMPOP_OP (le, float_scalar, float_complex, <=) +DEFCMPLXCMPOP_OP (eq, float_scalar, float_complex, ==) +DEFCMPLXCMPOP_OP (ge, float_scalar, float_complex, >=) +DEFCMPLXCMPOP_OP (gt, float_scalar, float_complex, >) +DEFCMPLXCMPOP_OP (ne, float_scalar, float_complex, !=) + +DEFBINOP_OP (el_mul, float_scalar, float_complex, *) + +DEFBINOP (el_div, float_scalar, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); + + FloatComplex d = v2.float_complex_value (); + + if (d == static_cast(0.0)) + gripe_divide_by_zero (); + + return octave_value (v1.float_value () / d); +} + +DEFBINOP_FN (el_pow, float_scalar, float_complex, xpow) + +DEFBINOP (el_ldiv, float_scalar, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); + + float d = v1.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.float_complex_value () / d); +} + +DEFBINOP (el_and, float_scalar, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); + + return octave_value (v1.float_scalar_value () && (v2.float_complex_value () != static_cast(0.0))); +} + +DEFBINOP (el_or, float_scalar, float_complex) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_complex&); + + return octave_value (v1.float_scalar_value () || (v2.float_complex_value () != static_cast(0.0))); +} + +DEFNDCATOP_FN (fs_fcs, float_scalar, float_complex, float_array, + float_complex_array, concat) + +DEFNDCATOP_FN (s_fcs, scalar, float_complex, float_array, + float_complex_array, concat) + +DEFNDCATOP_FN (fs_cs, float_scalar, complex, float_array, + float_complex_array, concat) + +void +install_fs_fcs_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_scalar, octave_float_complex, add); + INSTALL_BINOP (op_sub, octave_float_scalar, octave_float_complex, sub); + INSTALL_BINOP (op_mul, octave_float_scalar, octave_float_complex, mul); + INSTALL_BINOP (op_div, octave_float_scalar, octave_float_complex, div); + INSTALL_BINOP (op_pow, octave_float_scalar, octave_float_complex, pow); + INSTALL_BINOP (op_ldiv, octave_float_scalar, octave_float_complex, ldiv); + INSTALL_BINOP (op_lt, octave_float_scalar, octave_float_complex, lt); + INSTALL_BINOP (op_le, octave_float_scalar, octave_float_complex, le); + INSTALL_BINOP (op_eq, octave_float_scalar, octave_float_complex, eq); + INSTALL_BINOP (op_ge, octave_float_scalar, octave_float_complex, ge); + INSTALL_BINOP (op_gt, octave_float_scalar, octave_float_complex, gt); + INSTALL_BINOP (op_ne, octave_float_scalar, octave_float_complex, ne); + INSTALL_BINOP (op_el_mul, octave_float_scalar, octave_float_complex, el_mul); + INSTALL_BINOP (op_el_div, octave_float_scalar, octave_float_complex, el_div); + INSTALL_BINOP (op_el_pow, octave_float_scalar, octave_float_complex, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_scalar, octave_float_complex, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_scalar, octave_float_complex, el_and); + INSTALL_BINOP (op_el_or, octave_float_scalar, octave_float_complex, el_or); + + INSTALL_CATOP (octave_float_scalar, octave_float_complex, fs_fcs); + INSTALL_CATOP (octave_scalar, octave_float_complex, s_fcs); + INSTALL_CATOP (octave_float_scalar, octave_complex, fs_cs); + + INSTALL_ASSIGNCONV (octave_float_scalar, octave_float_complex, + octave_float_complex_matrix); + INSTALL_ASSIGNCONV (octave_scalar, octave_float_complex, + octave_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fs-fm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fs-fm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,154 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar by matrix ops. + +DEFNDBINOP_OP (add, float_scalar, float_matrix, float_scalar, float_array, +) +DEFNDBINOP_OP (sub, float_scalar, float_matrix, float_scalar, float_array, -) +DEFNDBINOP_OP (mul, float_scalar, float_matrix, float_scalar, float_array, *) + +DEFBINOP (div, float_scalar, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_matrix&); + + FloatMatrix m1 = v1.float_matrix_value (); + FloatMatrix m2 = v2.float_matrix_value (); + MatrixType typ = v2.matrix_type (); + + FloatMatrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (pow, float_scalar, float_matrix, xpow) + +DEFBINOP (ldiv, float_scalar, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_matrix&); + + float d = v1.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.float_array_value () / d); +} + +DEFNDBINOP_FN (lt, float_scalar, float_matrix, float_scalar, + float_array, mx_el_lt) +DEFNDBINOP_FN (le, float_scalar, float_matrix, float_scalar, + float_array, mx_el_le) +DEFNDBINOP_FN (eq, float_scalar, float_matrix, float_scalar, + float_array, mx_el_eq) +DEFNDBINOP_FN (ge, float_scalar, float_matrix, float_scalar, + float_array, mx_el_ge) +DEFNDBINOP_FN (gt, float_scalar, float_matrix, float_scalar, +float_array, mx_el_gt) +DEFNDBINOP_FN (ne, float_scalar, float_matrix, float_scalar, + float_array, mx_el_ne) + +DEFNDBINOP_OP (el_mul, float_scalar, float_matrix, float_scalar, + float_array, *) +DEFNDBINOP_FN (el_div, float_scalar, float_matrix, float_scalar, + float_array, x_el_div) +DEFNDBINOP_FN (el_pow, float_scalar, float_matrix, float_scalar, + float_array, elem_xpow) + +DEFBINOP (el_ldiv, float_scalar, float_matrix) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_matrix&); + + float d = v1.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.float_array_value () / d); +} + +DEFNDBINOP_FN (el_and, float_scalar, float_matrix, float_scalar, + float_array, mx_el_and) +DEFNDBINOP_FN (el_or, float_scalar, float_matrix, float_scalar, + float_array, mx_el_or) + +DEFNDCATOP_FN (fs_fm, float_scalar, float_matrix, float_array, + float_array, concat) + +DEFNDCATOP_FN (s_fm, scalar, float_matrix, float_array, float_array, concat) + +DEFNDCATOP_FN (fs_m, float_scalar, matrix, float_array, float_array, concat) + +DEFCONV (matrix_conv, float_scalar, float_matrix) +{ + CAST_CONV_ARG (const octave_float_scalar&); + + return new octave_float_matrix (v.float_matrix_value ()); +} + +void +install_fs_fm_ops (void) +{ + INSTALL_BINOP (op_add, octave_float_scalar, octave_float_matrix, add); + INSTALL_BINOP (op_sub, octave_float_scalar, octave_float_matrix, sub); + INSTALL_BINOP (op_mul, octave_float_scalar, octave_float_matrix, mul); + INSTALL_BINOP (op_div, octave_float_scalar, octave_float_matrix, div); + INSTALL_BINOP (op_pow, octave_float_scalar, octave_float_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_float_scalar, octave_float_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_float_scalar, octave_float_matrix, lt); + INSTALL_BINOP (op_le, octave_float_scalar, octave_float_matrix, le); + INSTALL_BINOP (op_eq, octave_float_scalar, octave_float_matrix, eq); + INSTALL_BINOP (op_ge, octave_float_scalar, octave_float_matrix, ge); + INSTALL_BINOP (op_gt, octave_float_scalar, octave_float_matrix, gt); + INSTALL_BINOP (op_ne, octave_float_scalar, octave_float_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_float_scalar, octave_float_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_float_scalar, octave_float_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_float_scalar, octave_float_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_scalar, octave_float_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_scalar, octave_float_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_float_scalar, octave_float_matrix, el_or); + + INSTALL_CATOP (octave_float_scalar, octave_float_matrix, fs_fm); + INSTALL_CATOP (octave_scalar, octave_float_matrix, s_fm); + INSTALL_CATOP (octave_float_scalar, octave_matrix, fs_m); + + INSTALL_ASSIGNCONV (octave_float_scalar, octave_float_matrix, octave_float_matrix); + INSTALL_ASSIGNCONV (octave_scalar, octave_float_matrix, octave_matrix); + + INSTALL_WIDENOP (octave_float_scalar, octave_float_matrix, matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-fs-fs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-fs-fs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,184 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "Array-util.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-flt-re-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar unary ops. + +DEFUNOP (not, float_scalar) +{ + CAST_UNOP_ARG (const octave_float_scalar&); + float x = v.float_value (); + if (xisnan (x)) + gripe_nan_to_logical_conversion (); + return octave_value (x == 0.0f); +} + +DEFUNOP_OP (uplus, float_scalar, /* no-op */) +DEFUNOP_OP (uminus, float_scalar, -) +DEFUNOP_OP (transpose, float_scalar, /* no-op */) +DEFUNOP_OP (hermitian, float_scalar, /* no-op */) + +DEFNCUNOP_METHOD (incr, float_scalar, increment) +DEFNCUNOP_METHOD (decr, float_scalar, decrement) + +// float by float ops. + +DEFBINOP_OP (add, float_scalar, float_scalar, +) +DEFBINOP_OP (sub, float_scalar, float_scalar, -) +DEFBINOP_OP (mul, float_scalar, float_scalar, *) + +DEFBINOP (div, float_scalar, float_scalar) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_scalar&); + + float d = v2.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.float_value () / d); +} + +DEFBINOP_FN (pow, float_scalar, float_scalar, xpow) + +DEFBINOP (ldiv, float_scalar, float_scalar) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_scalar&); + + float d = v1.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.float_value () / d); +} + +DEFBINOP_OP (lt, float_scalar, float_scalar, <) +DEFBINOP_OP (le, float_scalar, float_scalar, <=) +DEFBINOP_OP (eq, float_scalar, float_scalar, ==) +DEFBINOP_OP (ge, float_scalar, float_scalar, >=) +DEFBINOP_OP (gt, float_scalar, float_scalar, >) +DEFBINOP_OP (ne, float_scalar, float_scalar, !=) + +DEFBINOP_OP (el_mul, float_scalar, float_scalar, *) + +DEFBINOP (el_div, float_scalar, float_scalar) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_scalar&); + + float d = v2.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.float_value () / d); +} + +DEFBINOP_FN (el_pow, float_scalar, float_scalar, xpow) + +DEFBINOP (el_ldiv, float_scalar, float_scalar) +{ + CAST_BINOP_ARGS (const octave_float_scalar&, const octave_float_scalar&); + + float d = v1.float_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.float_value () / d); +} + +DEFSCALARBOOLOP_OP (el_and, float_scalar, float_scalar, &&) +DEFSCALARBOOLOP_OP (el_or, float_scalar, float_scalar, ||) + +DEFNDCATOP_FN (fs_fs, float_scalar, float_scalar, float_array, float_array, concat) +DEFNDCATOP_FN (s_fs, scalar, float_scalar, float_array, float_array, concat) +DEFNDCATOP_FN (fs_s, float_scalar, scalar, float_array, float_array, concat) + +CONVDECL (float_to_scalar) +{ + CAST_CONV_ARG (const octave_float_scalar&); + + return new octave_matrix (Matrix (1, 1, static_cast(v.float_value ()))); +} + +void +install_fs_fs_ops (void) +{ + INSTALL_UNOP (op_not, octave_float_scalar, not); + INSTALL_UNOP (op_uplus, octave_float_scalar, uplus); + INSTALL_UNOP (op_uminus, octave_float_scalar, uminus); + INSTALL_UNOP (op_transpose, octave_float_scalar, transpose); + INSTALL_UNOP (op_hermitian, octave_float_scalar, hermitian); + + INSTALL_NCUNOP (op_incr, octave_float_scalar, incr); + INSTALL_NCUNOP (op_decr, octave_float_scalar, decr); + + INSTALL_BINOP (op_add, octave_float_scalar, octave_float_scalar, add); + INSTALL_BINOP (op_sub, octave_float_scalar, octave_float_scalar, sub); + INSTALL_BINOP (op_mul, octave_float_scalar, octave_float_scalar, mul); + INSTALL_BINOP (op_div, octave_float_scalar, octave_float_scalar, div); + INSTALL_BINOP (op_pow, octave_float_scalar, octave_float_scalar, pow); + INSTALL_BINOP (op_ldiv, octave_float_scalar, octave_float_scalar, ldiv); + INSTALL_BINOP (op_lt, octave_float_scalar, octave_float_scalar, lt); + INSTALL_BINOP (op_le, octave_float_scalar, octave_float_scalar, le); + INSTALL_BINOP (op_eq, octave_float_scalar, octave_float_scalar, eq); + INSTALL_BINOP (op_ge, octave_float_scalar, octave_float_scalar, ge); + INSTALL_BINOP (op_gt, octave_float_scalar, octave_float_scalar, gt); + INSTALL_BINOP (op_ne, octave_float_scalar, octave_float_scalar, ne); + INSTALL_BINOP (op_el_mul, octave_float_scalar, octave_float_scalar, el_mul); + INSTALL_BINOP (op_el_div, octave_float_scalar, octave_float_scalar, el_div); + INSTALL_BINOP (op_el_pow, octave_float_scalar, octave_float_scalar, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_float_scalar, octave_float_scalar, el_ldiv); + INSTALL_BINOP (op_el_and, octave_float_scalar, octave_float_scalar, el_and); + INSTALL_BINOP (op_el_or, octave_float_scalar, octave_float_scalar, el_or); + + INSTALL_CATOP (octave_float_scalar, octave_float_scalar, fs_fs); + INSTALL_CATOP (octave_scalar, octave_float_scalar, s_fs); + INSTALL_CATOP (octave_float_scalar, octave_scalar, fs_s); + + INSTALL_ASSIGNCONV (octave_float_scalar, octave_float_scalar, octave_float_matrix); + INSTALL_ASSIGNCONV (octave_scalar, octave_float_scalar, octave_matrix); + + INSTALL_ASSIGNCONV (octave_float_scalar, octave_null_matrix, octave_float_matrix); + INSTALL_ASSIGNCONV (octave_float_scalar, octave_null_str, octave_float_matrix); + INSTALL_ASSIGNCONV (octave_float_scalar, octave_null_sq_str, octave_float_matrix); + + INSTALL_CONVOP (octave_float_scalar, octave_matrix, float_to_scalar); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-i16-i16.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-i16-i16.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,149 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-i16nda-i8.h" +#include "mx-i16nda-ui8.h" +#include "mx-i16nda-ui16.h" +#include "mx-i16nda-i32.h" +#include "mx-i16nda-ui32.h" +#include "mx-i16nda-i64.h" +#include "mx-i16nda-ui64.h" + +#include "mx-i16nda-i8nda.h" +#include "mx-i16nda-ui8nda.h" +#include "mx-i16nda-ui16nda.h" +#include "mx-i16nda-i32nda.h" +#include "mx-i16nda-ui32nda.h" +#include "mx-i16nda-i64nda.h" +#include "mx-i16nda-ui64nda.h" + +#include "mx-i16-i8nda.h" +#include "mx-i16-ui8nda.h" +#include "mx-i16-ui16nda.h" +#include "mx-i16-i32nda.h" +#include "mx-i16-ui32nda.h" +#include "mx-i16-i64nda.h" +#include "mx-i16-ui64nda.h" + +#include "mx-i16nda-s.h" +#include "mx-s-i16nda.h" + +#include "mx-i16nda-nda.h" +#include "mx-nda-i16nda.h" + +#include "mx-i16-nda.h" +#include "mx-nda-i16.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-int8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-uint8.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +#include "op-int.h" + +OCTAVE_INT_OPS (int16) + +OCTAVE_MS_INT_ASSIGN_OPS (mi8, int16_, int8_, int8_) +OCTAVE_MS_INT_ASSIGN_OPS (mui8, int16_, uint8_, uint8_) +OCTAVE_MS_INT_ASSIGN_OPS (mui16, int16_, uint16_, uint16_) +OCTAVE_MS_INT_ASSIGN_OPS (mi32, int16_, int32_, int32_) +OCTAVE_MS_INT_ASSIGN_OPS (mui32, int16_, uint32_, uint32_) +OCTAVE_MS_INT_ASSIGN_OPS (mi64, int16_, int64_, int64_) +OCTAVE_MS_INT_ASSIGN_OPS (mui64, int16_, uint64_, uint64_) + +OCTAVE_MM_INT_ASSIGN_OPS (mmi8, int16_, int8_, int8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui8, int16_, uint8_, uint8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui16, int16_, uint16_, uint16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi32, int16_, int32_, int32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui32, int16_, uint32_, uint32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi64, int16_, int64_, int64_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui64, int16_, uint64_, uint64_) + +OCTAVE_MIXED_INT_CMP_OPS (int16, int8) +OCTAVE_MIXED_INT_CMP_OPS (int16, uint8) +OCTAVE_MIXED_INT_CMP_OPS (int16, uint16) +OCTAVE_MIXED_INT_CMP_OPS (int16, int32) +OCTAVE_MIXED_INT_CMP_OPS (int16, uint32) +OCTAVE_MIXED_INT_CMP_OPS (int16, int64) +OCTAVE_MIXED_INT_CMP_OPS (int16, uint64) + +void +install_i16_i16_ops (void) +{ + OCTAVE_INSTALL_INT_OPS (int16); + + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, int16_, int8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, int16_, uint8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, int16_, uint16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, int16_, int32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, int16_, uint32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, int16_, int64_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, int16_, uint64_); + + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, int16_, int8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, int16_, uint8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, int16_, uint16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, int16_, int32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, int16_, uint32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, int16_, int64_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, int16_, uint64_); + + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, int8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, uint8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, uint16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, int32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, uint32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, int64); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int16, uint64); + + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, int8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, uint8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, uint16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, int32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, uint32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, int64); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int16, uint64); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-i32-i32.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-i32-i32.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,149 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-i32nda-i8.h" +#include "mx-i32nda-ui8.h" +#include "mx-i32nda-i16.h" +#include "mx-i32nda-ui16.h" +#include "mx-i32nda-ui32.h" +#include "mx-i32nda-i64.h" +#include "mx-i32nda-ui64.h" + +#include "mx-i32nda-i8nda.h" +#include "mx-i32nda-ui8nda.h" +#include "mx-i32nda-i16nda.h" +#include "mx-i32nda-ui16nda.h" +#include "mx-i32nda-ui32nda.h" +#include "mx-i32nda-i64nda.h" +#include "mx-i32nda-ui64nda.h" + +#include "mx-i32-i8nda.h" +#include "mx-i32-ui8nda.h" +#include "mx-i32-i16nda.h" +#include "mx-i32-ui16nda.h" +#include "mx-i32-ui32nda.h" +#include "mx-i32-i64nda.h" +#include "mx-i32-ui64nda.h" + +#include "mx-i32nda-s.h" +#include "mx-s-i32nda.h" + +#include "mx-i32nda-nda.h" +#include "mx-nda-i32nda.h" + +#include "mx-i32-nda.h" +#include "mx-nda-i32.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-int8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-uint8.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +#include "op-int.h" + +OCTAVE_INT_OPS (int32) + +OCTAVE_MS_INT_ASSIGN_OPS (mi8, int32_, int8_, int8_) +OCTAVE_MS_INT_ASSIGN_OPS (mui8, int32_, uint8_, uint8_) +OCTAVE_MS_INT_ASSIGN_OPS (mi16, int32_, int16_, int16_) +OCTAVE_MS_INT_ASSIGN_OPS (mui16, int32_, uint16_, uint16_) +OCTAVE_MS_INT_ASSIGN_OPS (mui32, int32_, uint32_, uint32_) +OCTAVE_MS_INT_ASSIGN_OPS (mi64, int32_, int64_, int64_) +OCTAVE_MS_INT_ASSIGN_OPS (mui64, int32_, uint64_, uint64_) + +OCTAVE_MM_INT_ASSIGN_OPS (mmi8, int32_, int8_, int8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui8, int32_, uint8_, uint8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi16, int32_, int16_, int16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui16, int32_, uint16_, uint16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui32, int32_, uint32_, uint32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi64, int32_, int64_, int64_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui64, int32_, uint64_, uint64_) + +OCTAVE_MIXED_INT_CMP_OPS (int32, int8) +OCTAVE_MIXED_INT_CMP_OPS (int32, uint8) +OCTAVE_MIXED_INT_CMP_OPS (int32, int16) +OCTAVE_MIXED_INT_CMP_OPS (int32, uint16) +OCTAVE_MIXED_INT_CMP_OPS (int32, uint32) +OCTAVE_MIXED_INT_CMP_OPS (int32, int64) +OCTAVE_MIXED_INT_CMP_OPS (int32, uint64) + +void +install_i32_i32_ops (void) +{ + OCTAVE_INSTALL_INT_OPS (int32); + + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, int32_, int8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, int32_, uint8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, int32_, int16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, int32_, uint16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, int32_, uint32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, int32_, int64_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, int32_, uint64_); + + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, int32_, int8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, int32_, uint8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, int32_, int16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, int32_, uint16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, int32_, uint32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, int32_, int64_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, int32_, uint64_); + + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, int8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, uint8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, int16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, uint16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, uint32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, int64); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int32, uint64); + + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, int8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, uint8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, int16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, uint16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, uint32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, int64); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int32, uint64); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-i64-i64.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-i64-i64.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,149 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-i64nda-i8.h" +#include "mx-i64nda-ui8.h" +#include "mx-i64nda-i16.h" +#include "mx-i64nda-ui16.h" +#include "mx-i64nda-i32.h" +#include "mx-i64nda-ui32.h" +#include "mx-i64nda-ui64.h" + +#include "mx-i64nda-i8nda.h" +#include "mx-i64nda-ui8nda.h" +#include "mx-i64nda-i16nda.h" +#include "mx-i64nda-ui16nda.h" +#include "mx-i64nda-i32nda.h" +#include "mx-i64nda-ui32nda.h" +#include "mx-i64nda-ui64nda.h" + +#include "mx-i64-i8nda.h" +#include "mx-i64-ui8nda.h" +#include "mx-i64-i16nda.h" +#include "mx-i64-ui16nda.h" +#include "mx-i64-i32nda.h" +#include "mx-i64-ui32nda.h" +#include "mx-i64-ui64nda.h" + +#include "mx-i64nda-s.h" +#include "mx-s-i64nda.h" + +#include "mx-i64nda-nda.h" +#include "mx-nda-i64nda.h" + +#include "mx-i64-nda.h" +#include "mx-nda-i64.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-int8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-uint8.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +#include "op-int.h" + +OCTAVE_INT_OPS (int64) + +OCTAVE_MS_INT_ASSIGN_OPS (mi8, int64_, int8_, int8_) +OCTAVE_MS_INT_ASSIGN_OPS (mui8, int64_, uint8_, uint8_) +OCTAVE_MS_INT_ASSIGN_OPS (mi16, int64_, int16_, int16_) +OCTAVE_MS_INT_ASSIGN_OPS (mui16, int64_, uint16_, uint16_) +OCTAVE_MS_INT_ASSIGN_OPS (mi32, int64_, int32_, int32_) +OCTAVE_MS_INT_ASSIGN_OPS (mui32, int64_, uint32_, uint32_) +OCTAVE_MS_INT_ASSIGN_OPS (mui64, int64_, uint64_, uint64_) + +OCTAVE_MM_INT_ASSIGN_OPS (mmi8, int64_, int8_, int8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui8, int64_, uint8_, uint8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi16, int64_, int16_, int16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui16, int64_, uint16_, uint16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi32, int64_, int32_, int32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui32, int64_, uint32_, uint32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui64, int64_, uint64_, uint64_) + +OCTAVE_MIXED_INT_CMP_OPS (int64, int8) +OCTAVE_MIXED_INT_CMP_OPS (int64, uint8) +OCTAVE_MIXED_INT_CMP_OPS (int64, int16) +OCTAVE_MIXED_INT_CMP_OPS (int64, uint16) +OCTAVE_MIXED_INT_CMP_OPS (int64, int32) +OCTAVE_MIXED_INT_CMP_OPS (int64, uint32) +OCTAVE_MIXED_INT_CMP_OPS (int64, uint64) + +void +install_i64_i64_ops (void) +{ + OCTAVE_INSTALL_INT_OPS (int64); + + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, int64_, int8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, int64_, uint8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, int64_, int16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, int64_, uint16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, int64_, int32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, int64_, uint32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, int64_, uint64_); + + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, int64_, int8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, int64_, uint8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, int64_, int16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, int64_, uint16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, int64_, int32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, int64_, uint32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, int64_, uint64_); + + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, int8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, uint8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, int16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, uint16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, int32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, uint32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int64, uint64); + + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, int8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, uint8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, int16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, uint16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, int32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, uint32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int64, uint64); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-i8-i8.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-i8-i8.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,149 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-i8nda-ui8.h" +#include "mx-i8nda-i16.h" +#include "mx-i8nda-ui16.h" +#include "mx-i8nda-i32.h" +#include "mx-i8nda-ui32.h" +#include "mx-i8nda-i64.h" +#include "mx-i8nda-ui64.h" + +#include "mx-i8nda-ui8nda.h" +#include "mx-i8nda-i16nda.h" +#include "mx-i8nda-ui16nda.h" +#include "mx-i8nda-i32nda.h" +#include "mx-i8nda-ui32nda.h" +#include "mx-i8nda-i64nda.h" +#include "mx-i8nda-ui64nda.h" + +#include "mx-i8-ui8nda.h" +#include "mx-i8-i16nda.h" +#include "mx-i8-ui16nda.h" +#include "mx-i8-i32nda.h" +#include "mx-i8-ui32nda.h" +#include "mx-i8-i64nda.h" +#include "mx-i8-ui64nda.h" + +#include "mx-i8nda-s.h" +#include "mx-s-i8nda.h" + +#include "mx-i8nda-nda.h" +#include "mx-nda-i8nda.h" + +#include "mx-i8-nda.h" +#include "mx-nda-i8.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-int8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-uint8.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +#include "op-int.h" + +OCTAVE_INT_OPS (int8) + +OCTAVE_MS_INT_ASSIGN_OPS (mui8, int8_, uint8_, uint8_) +OCTAVE_MS_INT_ASSIGN_OPS (mi16, int8_, int16_, int16_) +OCTAVE_MS_INT_ASSIGN_OPS (mui16, int8_, uint16_, uint16_) +OCTAVE_MS_INT_ASSIGN_OPS (mi32, int8_, int32_, int32_) +OCTAVE_MS_INT_ASSIGN_OPS (mui32, int8_, uint32_, uint32_) +OCTAVE_MS_INT_ASSIGN_OPS (mi64, int8_, int64_, int64_) +OCTAVE_MS_INT_ASSIGN_OPS (mui64, int8_, uint64_, uint64_) + +OCTAVE_MM_INT_ASSIGN_OPS (mmui8, int8_, uint8_, uint8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi16, int8_, int16_, int16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui16, int8_, uint16_, uint16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi32, int8_, int32_, int32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui32, int8_, uint32_, uint32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi64, int8_, int64_, int64_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui64, int8_, uint64_, uint64_) + +OCTAVE_MIXED_INT_CMP_OPS (int8, uint8) +OCTAVE_MIXED_INT_CMP_OPS (int8, int16) +OCTAVE_MIXED_INT_CMP_OPS (int8, uint16) +OCTAVE_MIXED_INT_CMP_OPS (int8, int32) +OCTAVE_MIXED_INT_CMP_OPS (int8, uint32) +OCTAVE_MIXED_INT_CMP_OPS (int8, int64) +OCTAVE_MIXED_INT_CMP_OPS (int8, uint64) + +void +install_i8_i8_ops (void) +{ + OCTAVE_INSTALL_INT_OPS (int8); + + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, int8_, uint8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, int8_, int16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, int8_, uint16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, int8_, int32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, int8_, uint32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, int8_, int64_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, int8_, uint64_); + + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, int8_, uint8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, int8_, int16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, int8_, uint16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, int8_, int32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, int8_, uint32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, int8_, int64_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, int8_, uint64_); + + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, uint8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, int16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, uint16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, int32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, uint32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, int64); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (int8, uint64); + + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, uint8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, int16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, uint16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, int32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, uint32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, int64); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (int8, uint64); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-int-concat.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-int-concat.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,318 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-range.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-str-mat.h" +#include "ov-typeinfo.h" +#include "op-int.h" +#include "ops.h" + +// Concatentation of mixed integer types: + +OCTAVE_CONCAT_FN2 (int8, int16) +OCTAVE_CONCAT_FN2 (int8, int32) +OCTAVE_CONCAT_FN2 (int8, int64) + +OCTAVE_CONCAT_FN2 (int8, uint8) +OCTAVE_CONCAT_FN2 (int8, uint16) +OCTAVE_CONCAT_FN2 (int8, uint32) +OCTAVE_CONCAT_FN2 (int8, uint64) + +OCTAVE_CONCAT_FN2 (int16, int8) +OCTAVE_CONCAT_FN2 (int16, int32) +OCTAVE_CONCAT_FN2 (int16, int64) + +OCTAVE_CONCAT_FN2 (int16, uint8) +OCTAVE_CONCAT_FN2 (int16, uint16) +OCTAVE_CONCAT_FN2 (int16, uint32) +OCTAVE_CONCAT_FN2 (int16, uint64) + +OCTAVE_CONCAT_FN2 (int32, int8) +OCTAVE_CONCAT_FN2 (int32, int16) +OCTAVE_CONCAT_FN2 (int32, int64) + +OCTAVE_CONCAT_FN2 (int32, uint8) +OCTAVE_CONCAT_FN2 (int32, uint16) +OCTAVE_CONCAT_FN2 (int32, uint32) +OCTAVE_CONCAT_FN2 (int32, uint64) + +OCTAVE_CONCAT_FN2 (int64, int8) +OCTAVE_CONCAT_FN2 (int64, int16) +OCTAVE_CONCAT_FN2 (int64, int32) + +OCTAVE_CONCAT_FN2 (int64, uint8) +OCTAVE_CONCAT_FN2 (int64, uint16) +OCTAVE_CONCAT_FN2 (int64, uint32) +OCTAVE_CONCAT_FN2 (int64, uint64) + +OCTAVE_CONCAT_FN2 (uint8, int8) +OCTAVE_CONCAT_FN2 (uint8, int16) +OCTAVE_CONCAT_FN2 (uint8, int32) +OCTAVE_CONCAT_FN2 (uint8, int64) + +OCTAVE_CONCAT_FN2 (uint8, uint16) +OCTAVE_CONCAT_FN2 (uint8, uint32) +OCTAVE_CONCAT_FN2 (uint8, uint64) + +OCTAVE_CONCAT_FN2 (uint16, int8) +OCTAVE_CONCAT_FN2 (uint16, int16) +OCTAVE_CONCAT_FN2 (uint16, int32) +OCTAVE_CONCAT_FN2 (uint16, int64) + +OCTAVE_CONCAT_FN2 (uint16, uint8) +OCTAVE_CONCAT_FN2 (uint16, uint32) +OCTAVE_CONCAT_FN2 (uint16, uint64) + +OCTAVE_CONCAT_FN2 (uint32, int8) +OCTAVE_CONCAT_FN2 (uint32, int16) +OCTAVE_CONCAT_FN2 (uint32, int32) +OCTAVE_CONCAT_FN2 (uint32, int64) + +OCTAVE_CONCAT_FN2 (uint32, uint8) +OCTAVE_CONCAT_FN2 (uint32, uint16) +OCTAVE_CONCAT_FN2 (uint32, uint64) + +OCTAVE_CONCAT_FN2 (uint64, int8) +OCTAVE_CONCAT_FN2 (uint64, int16) +OCTAVE_CONCAT_FN2 (uint64, int32) +OCTAVE_CONCAT_FN2 (uint64, int64) + +OCTAVE_CONCAT_FN2 (uint64, uint8) +OCTAVE_CONCAT_FN2 (uint64, uint16) +OCTAVE_CONCAT_FN2 (uint64, uint32) + +OCTAVE_INT_DOUBLE_CONCAT_FN (int8) +OCTAVE_INT_DOUBLE_CONCAT_FN (int16) +OCTAVE_INT_DOUBLE_CONCAT_FN (int32) +OCTAVE_INT_DOUBLE_CONCAT_FN (int64) + +OCTAVE_INT_DOUBLE_CONCAT_FN (uint8) +OCTAVE_INT_DOUBLE_CONCAT_FN (uint16) +OCTAVE_INT_DOUBLE_CONCAT_FN (uint32) +OCTAVE_INT_DOUBLE_CONCAT_FN (uint64) + +OCTAVE_DOUBLE_INT_CONCAT_FN (int8) +OCTAVE_DOUBLE_INT_CONCAT_FN (int16) +OCTAVE_DOUBLE_INT_CONCAT_FN (int32) +OCTAVE_DOUBLE_INT_CONCAT_FN (int64) + +OCTAVE_DOUBLE_INT_CONCAT_FN (uint8) +OCTAVE_DOUBLE_INT_CONCAT_FN (uint16) +OCTAVE_DOUBLE_INT_CONCAT_FN (uint32) +OCTAVE_DOUBLE_INT_CONCAT_FN (uint64) + +OCTAVE_INT_FLOAT_CONCAT_FN (int8) +OCTAVE_INT_FLOAT_CONCAT_FN (int16) +OCTAVE_INT_FLOAT_CONCAT_FN (int32) +OCTAVE_INT_FLOAT_CONCAT_FN (int64) + +OCTAVE_INT_FLOAT_CONCAT_FN (uint8) +OCTAVE_INT_FLOAT_CONCAT_FN (uint16) +OCTAVE_INT_FLOAT_CONCAT_FN (uint32) +OCTAVE_INT_FLOAT_CONCAT_FN (uint64) + +OCTAVE_FLOAT_INT_CONCAT_FN (int8) +OCTAVE_FLOAT_INT_CONCAT_FN (int16) +OCTAVE_FLOAT_INT_CONCAT_FN (int32) +OCTAVE_FLOAT_INT_CONCAT_FN (int64) + +OCTAVE_FLOAT_INT_CONCAT_FN (uint8) +OCTAVE_FLOAT_INT_CONCAT_FN (uint16) +OCTAVE_FLOAT_INT_CONCAT_FN (uint32) +OCTAVE_FLOAT_INT_CONCAT_FN (uint64) + +OCTAVE_INT_CHAR_CONCAT_FN (int8) +OCTAVE_INT_CHAR_CONCAT_FN (int16) +OCTAVE_INT_CHAR_CONCAT_FN (int32) +OCTAVE_INT_CHAR_CONCAT_FN (int64) + +OCTAVE_INT_CHAR_CONCAT_FN (uint8) +OCTAVE_INT_CHAR_CONCAT_FN (uint16) +OCTAVE_INT_CHAR_CONCAT_FN (uint32) +OCTAVE_INT_CHAR_CONCAT_FN (uint64) + +OCTAVE_CHAR_INT_CONCAT_FN (int8) +OCTAVE_CHAR_INT_CONCAT_FN (int16) +OCTAVE_CHAR_INT_CONCAT_FN (int32) +OCTAVE_CHAR_INT_CONCAT_FN (int64) + +OCTAVE_CHAR_INT_CONCAT_FN (uint8) +OCTAVE_CHAR_INT_CONCAT_FN (uint16) +OCTAVE_CHAR_INT_CONCAT_FN (uint32) +OCTAVE_CHAR_INT_CONCAT_FN (uint64) + +void +install_int_concat_ops (void) +{ + OCTAVE_INSTALL_CONCAT_FN2 (int8, int16); + OCTAVE_INSTALL_CONCAT_FN2 (int8, int32); + OCTAVE_INSTALL_CONCAT_FN2 (int8, int64); + + OCTAVE_INSTALL_CONCAT_FN2 (int8, uint8); + OCTAVE_INSTALL_CONCAT_FN2 (int8, uint16); + OCTAVE_INSTALL_CONCAT_FN2 (int8, uint32); + OCTAVE_INSTALL_CONCAT_FN2 (int8, uint64); + + OCTAVE_INSTALL_CONCAT_FN2 (int16, int8); + OCTAVE_INSTALL_CONCAT_FN2 (int16, int32); + OCTAVE_INSTALL_CONCAT_FN2 (int16, int64); + + OCTAVE_INSTALL_CONCAT_FN2 (int16, uint8); + OCTAVE_INSTALL_CONCAT_FN2 (int16, uint16); + OCTAVE_INSTALL_CONCAT_FN2 (int16, uint32); + OCTAVE_INSTALL_CONCAT_FN2 (int16, uint64); + + OCTAVE_INSTALL_CONCAT_FN2 (int32, int8); + OCTAVE_INSTALL_CONCAT_FN2 (int32, int16); + OCTAVE_INSTALL_CONCAT_FN2 (int32, int64); + + OCTAVE_INSTALL_CONCAT_FN2 (int32, uint8); + OCTAVE_INSTALL_CONCAT_FN2 (int32, uint16); + OCTAVE_INSTALL_CONCAT_FN2 (int32, uint32); + OCTAVE_INSTALL_CONCAT_FN2 (int32, uint64); + + OCTAVE_INSTALL_CONCAT_FN2 (int64, int8); + OCTAVE_INSTALL_CONCAT_FN2 (int64, int16); + OCTAVE_INSTALL_CONCAT_FN2 (int64, int32); + + OCTAVE_INSTALL_CONCAT_FN2 (int64, uint8); + OCTAVE_INSTALL_CONCAT_FN2 (int64, uint16); + OCTAVE_INSTALL_CONCAT_FN2 (int64, uint32); + OCTAVE_INSTALL_CONCAT_FN2 (int64, uint64); + + OCTAVE_INSTALL_CONCAT_FN2 (uint8, int8); + OCTAVE_INSTALL_CONCAT_FN2 (uint8, int16); + OCTAVE_INSTALL_CONCAT_FN2 (uint8, int32); + OCTAVE_INSTALL_CONCAT_FN2 (uint8, int64); + + OCTAVE_INSTALL_CONCAT_FN2 (uint8, uint16); + OCTAVE_INSTALL_CONCAT_FN2 (uint8, uint32); + OCTAVE_INSTALL_CONCAT_FN2 (uint8, uint64); + + OCTAVE_INSTALL_CONCAT_FN2 (uint16, int8); + OCTAVE_INSTALL_CONCAT_FN2 (uint16, int16); + OCTAVE_INSTALL_CONCAT_FN2 (uint16, int32); + OCTAVE_INSTALL_CONCAT_FN2 (uint16, int64); + + OCTAVE_INSTALL_CONCAT_FN2 (uint16, uint8); + OCTAVE_INSTALL_CONCAT_FN2 (uint16, uint32); + OCTAVE_INSTALL_CONCAT_FN2 (uint16, uint64); + + OCTAVE_INSTALL_CONCAT_FN2 (uint32, int8); + OCTAVE_INSTALL_CONCAT_FN2 (uint32, int16); + OCTAVE_INSTALL_CONCAT_FN2 (uint32, int32); + OCTAVE_INSTALL_CONCAT_FN2 (uint32, int64); + + OCTAVE_INSTALL_CONCAT_FN2 (uint32, uint8); + OCTAVE_INSTALL_CONCAT_FN2 (uint32, uint16); + OCTAVE_INSTALL_CONCAT_FN2 (uint32, uint64); + + OCTAVE_INSTALL_CONCAT_FN2 (uint64, int8); + OCTAVE_INSTALL_CONCAT_FN2 (uint64, int16); + OCTAVE_INSTALL_CONCAT_FN2 (uint64, int32); + OCTAVE_INSTALL_CONCAT_FN2 (uint64, int64); + + OCTAVE_INSTALL_CONCAT_FN2 (uint64, uint8); + OCTAVE_INSTALL_CONCAT_FN2 (uint64, uint16); + OCTAVE_INSTALL_CONCAT_FN2 (uint64, uint32); + + OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (int8); + OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (int16); + OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (int32); + OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (int64); + + OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (uint8); + OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (uint16); + OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (uint32); + OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN (uint64); + + OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (int8); + OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (int16); + OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (int32); + OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (int64); + + OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (uint8); + OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (uint16); + OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (uint32); + OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN (uint64); + + OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (int8); + OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (int16); + OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (int32); + OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (int64); + + OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (uint8); + OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (uint16); + OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (uint32); + OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN (uint64); + + OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (int8); + OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (int16); + OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (int32); + OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (int64); + + OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (uint8); + OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (uint16); + OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (uint32); + OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN (uint64); + + OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (int8); + OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (int16); + OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (int32); + OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (int64); + + OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (uint8); + OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (uint16); + OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (uint32); + OCTAVE_INSTALL_INT_CHAR_CONCAT_FN (uint64); + + OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (int8); + OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (int16); + OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (int32); + OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (int64); + + OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (uint8); + OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (uint16); + OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (uint32); + OCTAVE_INSTALL_CHAR_INT_CONCAT_FN (uint64); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-int-conv.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-int-conv.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,235 @@ +/* + +Copyright (C) 2004-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-range.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-str-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" + +#define DEFINTCONVFN(name, tfrom, tto) \ + CONVDECL (name) \ + { \ + CAST_CONV_ARG (const octave_ ## tfrom&); \ + \ + octave_ ## tto ## _matrix v2 = v.tto ## _array_value (); \ + return new octave_ ## tto ## _matrix (v2); \ + } + +// conversion ops + +DEFINTCONVFN (scalar_to_int8, scalar, int8) +DEFINTCONVFN (scalar_to_int16, scalar, int16) +DEFINTCONVFN (scalar_to_int32, scalar, int32) +DEFINTCONVFN (scalar_to_int64, scalar, int64) + +DEFINTCONVFN (scalar_to_uint8, scalar, uint8) +DEFINTCONVFN (scalar_to_uint16, scalar, uint16) +DEFINTCONVFN (scalar_to_uint32, scalar, uint32) +DEFINTCONVFN (scalar_to_uint64, scalar, uint64) + +DEFINTCONVFN (matrix_to_int8, matrix, int8) +DEFINTCONVFN (matrix_to_int16, matrix, int16) +DEFINTCONVFN (matrix_to_int32, matrix, int32) +DEFINTCONVFN (matrix_to_int64, matrix, int64) + +DEFINTCONVFN (matrix_to_uint8, matrix, uint8) +DEFINTCONVFN (matrix_to_uint16, matrix, uint16) +DEFINTCONVFN (matrix_to_uint32, matrix, uint32) +DEFINTCONVFN (matrix_to_uint64, matrix, uint64) + +DEFINTCONVFN (float_scalar_to_int8, float_scalar, int8) +DEFINTCONVFN (float_scalar_to_int16, float_scalar, int16) +DEFINTCONVFN (float_scalar_to_int32, float_scalar, int32) +DEFINTCONVFN (float_scalar_to_int64, float_scalar, int64) + +DEFINTCONVFN (float_scalar_to_uint8, float_scalar, uint8) +DEFINTCONVFN (float_scalar_to_uint16, float_scalar, uint16) +DEFINTCONVFN (float_scalar_to_uint32, float_scalar, uint32) +DEFINTCONVFN (float_scalar_to_uint64, float_scalar, uint64) + +DEFINTCONVFN (float_matrix_to_int8, float_matrix, int8) +DEFINTCONVFN (float_matrix_to_int16, float_matrix, int16) +DEFINTCONVFN (float_matrix_to_int32, float_matrix, int32) +DEFINTCONVFN (float_matrix_to_int64, float_matrix, int64) + +DEFINTCONVFN (float_matrix_to_uint8, float_matrix, uint8) +DEFINTCONVFN (float_matrix_to_uint16, float_matrix, uint16) +DEFINTCONVFN (float_matrix_to_uint32, float_matrix, uint32) +DEFINTCONVFN (float_matrix_to_uint64, float_matrix, uint64) + +DEFCONVFN (bool_to_int8, bool, int8) +DEFCONVFN (bool_to_int16, bool, int16) +DEFCONVFN (bool_to_int32, bool, int32) +DEFCONVFN (bool_to_int64, bool, int64) + +DEFCONVFN (bool_to_uint8, bool, uint8) +DEFCONVFN (bool_to_uint16, bool, uint16) +DEFCONVFN (bool_to_uint32, bool, uint32) +DEFCONVFN (bool_to_uint64, bool, uint64) + +DEFCONVFN (bool_matrix_to_int8, bool_matrix, int8) +DEFCONVFN (bool_matrix_to_int16, bool_matrix, int16) +DEFCONVFN (bool_matrix_to_int32, bool_matrix, int32) +DEFCONVFN (bool_matrix_to_int64, bool_matrix, int64) + +DEFCONVFN (bool_matrix_to_uint8, bool_matrix, uint8) +DEFCONVFN (bool_matrix_to_uint16, bool_matrix, uint16) +DEFCONVFN (bool_matrix_to_uint32, bool_matrix, uint32) +DEFCONVFN (bool_matrix_to_uint64, bool_matrix, uint64) + +DEFSTRINTCONVFN (char_matrix_sq_str_to_int8, int8) +DEFSTRINTCONVFN (char_matrix_sq_str_to_int16, int16) +DEFSTRINTCONVFN (char_matrix_sq_str_to_int32, int32) +DEFSTRINTCONVFN (char_matrix_sq_str_to_int64, int64) + +DEFSTRINTCONVFN (char_matrix_sq_str_to_uint8, uint8) +DEFSTRINTCONVFN (char_matrix_sq_str_to_uint16, uint16) +DEFSTRINTCONVFN (char_matrix_sq_str_to_uint32, uint32) +DEFSTRINTCONVFN (char_matrix_sq_str_to_uint64, uint64) + +DEFSTRINTCONVFN (char_matrix_dq_str_to_int8, int8) +DEFSTRINTCONVFN (char_matrix_dq_str_to_int16, int16) +DEFSTRINTCONVFN (char_matrix_dq_str_to_int32, int32) +DEFSTRINTCONVFN (char_matrix_dq_str_to_int64, int64) + +DEFSTRINTCONVFN (char_matrix_dq_str_to_uint8, uint8) +DEFSTRINTCONVFN (char_matrix_dq_str_to_uint16, uint16) +DEFSTRINTCONVFN (char_matrix_dq_str_to_uint32, uint32) +DEFSTRINTCONVFN (char_matrix_dq_str_to_uint64, uint64) + +DEFINTCONVFN (range_to_int8, range, int8) +DEFINTCONVFN (range_to_int16, range, int16) +DEFINTCONVFN (range_to_int32, range, int32) +DEFINTCONVFN (range_to_int64, range, int64) + +DEFINTCONVFN (range_to_uint8, range, uint8) +DEFINTCONVFN (range_to_uint16, range, uint16) +DEFINTCONVFN (range_to_uint32, range, uint32) +DEFINTCONVFN (range_to_uint64, range, uint64) + +#define INT_CONV_FUNCTIONS(tfrom) \ + DEFCONVFN2 (tfrom ## _scalar_to_int8, tfrom, scalar, int8) \ + DEFCONVFN2 (tfrom ## _scalar_to_int16, tfrom, scalar, int16) \ + DEFCONVFN2 (tfrom ## _scalar_to_int32, tfrom, scalar, int32) \ + DEFCONVFN2 (tfrom ## _scalar_to_int64, tfrom, scalar, int64) \ + \ + DEFCONVFN2 (tfrom ## _scalar_to_uint8, tfrom, scalar, uint8) \ + DEFCONVFN2 (tfrom ## _scalar_to_uint16, tfrom, scalar, uint16) \ + DEFCONVFN2 (tfrom ## _scalar_to_uint32, tfrom, scalar, uint32) \ + DEFCONVFN2 (tfrom ## _scalar_to_uint64, tfrom, scalar, uint64) \ + \ + DEFCONVFN2 (tfrom ## _matrix_to_int8, tfrom, matrix, int8) \ + DEFCONVFN2 (tfrom ## _matrix_to_int16, tfrom, matrix, int16) \ + DEFCONVFN2 (tfrom ## _matrix_to_int32, tfrom, matrix, int32) \ + DEFCONVFN2 (tfrom ## _matrix_to_int64, tfrom, matrix, int64) \ + \ + DEFCONVFN2 (tfrom ## _matrix_to_uint8, tfrom, matrix, uint8) \ + DEFCONVFN2 (tfrom ## _matrix_to_uint16, tfrom, matrix, uint16) \ + DEFCONVFN2 (tfrom ## _matrix_to_uint32, tfrom, matrix, uint32) \ + DEFCONVFN2 (tfrom ## _matrix_to_uint64, tfrom, matrix, uint64) + +INT_CONV_FUNCTIONS (int8) +INT_CONV_FUNCTIONS (int16) +INT_CONV_FUNCTIONS (int32) +INT_CONV_FUNCTIONS (int64) + +INT_CONV_FUNCTIONS (uint8) +INT_CONV_FUNCTIONS (uint16) +INT_CONV_FUNCTIONS (uint32) +INT_CONV_FUNCTIONS (uint64) + +#define INSTALL_INT_CONV_FUNCTIONS(tfrom) \ + INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_int8_matrix, tfrom ## _scalar_to_int8) \ + INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_int16_matrix, tfrom ## _scalar_to_int16) \ + INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_int32_matrix, tfrom ## _scalar_to_int32) \ + INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_int64_matrix, tfrom ## _scalar_to_int64) \ + \ + INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_uint8_matrix, tfrom ## _scalar_to_uint8) \ + INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_uint16_matrix, tfrom ## _scalar_to_uint16) \ + INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_uint32_matrix, tfrom ## _scalar_to_uint32) \ + INSTALL_CONVOP (octave_ ## tfrom ## _scalar, octave_uint64_matrix, tfrom ## _scalar_to_uint64) \ + \ + INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_int8_matrix, tfrom ## _matrix_to_int8) \ + INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_int16_matrix, tfrom ## _matrix_to_int16) \ + INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_int32_matrix, tfrom ## _matrix_to_int32) \ + INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_int64_matrix, tfrom ## _matrix_to_int64) \ + \ + INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_uint8_matrix, tfrom ## _matrix_to_uint8) \ + INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_uint16_matrix, tfrom ## _matrix_to_uint16) \ + INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_uint32_matrix, tfrom ## _matrix_to_uint32) \ + INSTALL_CONVOP (octave_ ## tfrom ## _matrix, octave_uint64_matrix, tfrom ## _matrix_to_uint64) + +#define INSTALL_CONVOPS(tfrom) \ + INSTALL_CONVOP (octave_ ## tfrom, octave_int8_matrix, tfrom ## _to_int8) \ + INSTALL_CONVOP (octave_ ## tfrom, octave_int16_matrix, tfrom ## _to_int16) \ + INSTALL_CONVOP (octave_ ## tfrom, octave_int32_matrix, tfrom ## _to_int32) \ + INSTALL_CONVOP (octave_ ## tfrom, octave_int64_matrix, tfrom ## _to_int64) \ + \ + INSTALL_CONVOP (octave_ ## tfrom, octave_uint8_matrix, tfrom ## _to_uint8) \ + INSTALL_CONVOP (octave_ ## tfrom, octave_uint16_matrix, tfrom ## _to_uint16) \ + INSTALL_CONVOP (octave_ ## tfrom, octave_uint32_matrix, tfrom ## _to_uint32) \ + INSTALL_CONVOP (octave_ ## tfrom, octave_uint64_matrix, tfrom ## _to_uint64) + +void +install_int_conv_ops (void) +{ + INSTALL_CONVOPS (scalar) + INSTALL_CONVOPS (matrix) + INSTALL_CONVOPS (float_scalar) + INSTALL_CONVOPS (float_matrix) + INSTALL_CONVOPS (bool) + INSTALL_CONVOPS (bool_matrix) + INSTALL_CONVOPS (range) + INSTALL_CONVOPS (char_matrix_sq_str) + INSTALL_CONVOPS (char_matrix_dq_str) + + INSTALL_INT_CONV_FUNCTIONS (int8) + INSTALL_INT_CONV_FUNCTIONS (int16) + INSTALL_INT_CONV_FUNCTIONS (int32) + INSTALL_INT_CONV_FUNCTIONS (int64) + + INSTALL_INT_CONV_FUNCTIONS (uint8) + INSTALL_INT_CONV_FUNCTIONS (uint16) + INSTALL_INT_CONV_FUNCTIONS (uint32) + INSTALL_INT_CONV_FUNCTIONS (uint64) +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-int.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-int.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1191 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#include "quit.h" +#include "bsxfun.h" + +#define DEFINTBINOP_OP(name, t1, t2, op, t3) \ + BINOPDECL (name, a1, a2) \ + { \ + CAST_BINOP_ARGS (const octave_ ## t1&, const octave_ ## t2&); \ + octave_value retval = octave_value \ + (v1.t1 ## _value () op v2.t2 ## _value ()); \ + return retval; \ + } + +#define DEFINTNDBINOP_OP(name, t1, t2, e1, e2, op, t3) \ + BINOPDECL (name, a1, a2) \ + { \ + CAST_BINOP_ARGS (const octave_ ## t1&, const octave_ ## t2&); \ + octave_value retval = octave_value \ + (v1.e1 ## _value () op v2.e2 ## _value ()); \ + return retval; \ + } + +#define DEFINTBINOP_FN(name, t1, t2, f, t3, op) \ + BINOPDECL (name, a1, a2) \ + { \ + CAST_BINOP_ARGS (const octave_ ## t1&, const octave_ ## t2&); \ + octave_value retval = octave_value (f (v1.t1 ## _value (), v2.t2 ## _value ())); \ + return retval; \ + } + +#define DEFINTNDBINOP_FN(name, t1, t2, e1, e2, f, t3, op) \ + BINOPDECL (name, a1, a2) \ + { \ + CAST_BINOP_ARGS (const octave_ ## t1&, const octave_ ## t2&); \ + octave_value retval = octave_value (f (v1.e1 ## _value (), v2.e2 ## _value ())); \ + return retval; \ + } + +#define OCTAVE_CONCAT_FN2(T1, T2) \ + DEFNDCATOP_FN2 (T1 ## _ ## T2 ## _s_s, T1 ## _scalar, T2 ## _scalar, , T1 ## NDArray, T1 ## _array, T2 ## _array, concat) \ + DEFNDCATOP_FN2 (T1 ## _ ## T2 ## _s_m, T1 ## _scalar, T2 ## _matrix, , T1 ## NDArray, T1 ## _array, T2 ## _array, concat) \ + DEFNDCATOP_FN2 (T1 ## _ ## T2 ## _m_s, T1 ## _matrix, T2 ## _scalar, , T1 ## NDArray, T1 ## _array, T2 ## _array, concat) \ + DEFNDCATOP_FN2 (T1 ## _ ## T2 ## _m_m, T1 ## _matrix, T2 ## _matrix, , T1 ## NDArray, T1 ## _array, T2 ## _array, concat) + +#define OCTAVE_INSTALL_CONCAT_FN2(T1, T2) \ + INSTALL_CATOP (octave_ ## T1 ## _scalar, octave_ ## T2 ## _scalar, T1 ## _ ## T2 ## _s_s) \ + INSTALL_CATOP (octave_ ## T1 ## _scalar, octave_ ## T2 ## _matrix, T1 ## _ ## T2 ## _s_m) \ + INSTALL_CATOP (octave_ ## T1 ## _matrix, octave_ ## T2 ## _scalar, T1 ## _ ## T2 ## _m_s) \ + INSTALL_CATOP (octave_ ## T1 ## _matrix, octave_ ## T2 ## _matrix, T1 ## _ ## T2 ## _m_m) + +#define OCTAVE_DOUBLE_INT_CONCAT_FN(TYPE) \ + DEFNDCATOP_FN2 (double ## _ ## TYPE ## _s_s, scalar, TYPE ## _scalar, TYPE ## NDArray, , array, TYPE ## _array, concat) \ + DEFNDCATOP_FN2 (double ## _ ## TYPE ## _s_m, scalar, TYPE ## _matrix, TYPE ## NDArray, , array, TYPE ## _array, concat) \ + DEFNDCATOP_FN2 (double ## _ ## TYPE ## _m_s, matrix, TYPE ## _scalar, TYPE ## NDArray, , array, TYPE ## _array, concat) \ + DEFNDCATOP_FN2 (double ## _ ## TYPE ## _m_m, matrix, TYPE ## _matrix, TYPE ## NDArray, , array, TYPE ## _array, concat) + +#define OCTAVE_INSTALL_DOUBLE_INT_CONCAT_FN(TYPE) \ + INSTALL_CATOP (octave_scalar, octave_ ## TYPE ## _scalar, double ## _ ## TYPE ## _s_s) \ + INSTALL_CATOP (octave_scalar, octave_ ## TYPE ## _matrix, double ## _ ## TYPE ## _s_m) \ + INSTALL_CATOP (octave_matrix, octave_ ## TYPE ## _scalar, double ## _ ## TYPE ## _m_s) \ + INSTALL_CATOP (octave_matrix, octave_ ## TYPE ## _matrix, double ## _ ## TYPE ## _m_m) + +#define OCTAVE_INT_DOUBLE_CONCAT_FN(TYPE) \ + DEFNDCATOP_FN2 (TYPE ## _ ## double ## _s_s, TYPE ## _scalar, scalar, , TYPE ## NDArray, TYPE ## _array, array, concat) \ + DEFNDCATOP_FN2 (TYPE ## _ ## double ## _s_m, TYPE ## _scalar, matrix, , TYPE ## NDArray, TYPE ## _array, array, concat) \ + DEFNDCATOP_FN2 (TYPE ## _ ## double ## _m_s, TYPE ## _matrix, scalar, , TYPE ## NDArray, TYPE ## _array, array, concat) \ + DEFNDCATOP_FN2 (TYPE ## _ ## double ## _m_m, TYPE ## _matrix, matrix, , TYPE ## NDArray, TYPE ## _array, array, concat) + +#define OCTAVE_INSTALL_INT_DOUBLE_CONCAT_FN(TYPE) \ + INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_scalar, TYPE ## _ ## double ## _s_s) \ + INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_matrix, TYPE ## _ ## double ## _s_m) \ + INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_scalar, TYPE ## _ ## double ## _m_s) \ + INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_matrix, TYPE ## _ ## double ## _m_m) + +#define OCTAVE_FLOAT_INT_CONCAT_FN(TYPE) \ + DEFNDCATOP_FN2 (float ## _ ## TYPE ## _s_s, float_scalar, TYPE ## _scalar, TYPE ## NDArray, , float_array, TYPE ## _array, concat) \ + DEFNDCATOP_FN2 (float ## _ ## TYPE ## _s_m, float_scalar, TYPE ## _matrix, TYPE ## NDArray, , float_array, TYPE ## _array, concat) \ + DEFNDCATOP_FN2 (float ## _ ## TYPE ## _m_s, float_matrix, TYPE ## _scalar, TYPE ## NDArray, , float_array, TYPE ## _array, concat) \ + DEFNDCATOP_FN2 (float ## _ ## TYPE ## _m_m, float_matrix, TYPE ## _matrix, TYPE ## NDArray, , float_array, TYPE ## _array, concat) + +#define OCTAVE_INSTALL_FLOAT_INT_CONCAT_FN(TYPE) \ + INSTALL_CATOP (octave_float_scalar, octave_ ## TYPE ## _scalar, float ## _ ## TYPE ## _s_s) \ + INSTALL_CATOP (octave_float_scalar, octave_ ## TYPE ## _matrix, float ## _ ## TYPE ## _s_m) \ + INSTALL_CATOP (octave_float_matrix, octave_ ## TYPE ## _scalar, float ## _ ## TYPE ## _m_s) \ + INSTALL_CATOP (octave_float_matrix, octave_ ## TYPE ## _matrix, float ## _ ## TYPE ## _m_m) + +#define OCTAVE_INT_FLOAT_CONCAT_FN(TYPE) \ + DEFNDCATOP_FN2 (TYPE ## _ ## float ## _s_s, TYPE ## _scalar, float_scalar, , TYPE ## NDArray, TYPE ## _array, float_array, concat) \ + DEFNDCATOP_FN2 (TYPE ## _ ## float ## _s_m, TYPE ## _scalar, float_matrix, , TYPE ## NDArray, TYPE ## _array, float_array, concat) \ + DEFNDCATOP_FN2 (TYPE ## _ ## float ## _m_s, TYPE ## _matrix, float_scalar, , TYPE ## NDArray, TYPE ## _array, float_array, concat) \ + DEFNDCATOP_FN2 (TYPE ## _ ## float ## _m_m, TYPE ## _matrix, float_matrix, , TYPE ## NDArray, TYPE ## _array, float_array, concat) + +#define OCTAVE_INSTALL_INT_FLOAT_CONCAT_FN(TYPE) \ + INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_float_scalar, TYPE ## _ ## float ## _s_s) \ + INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_float_matrix, TYPE ## _ ## float ## _s_m) \ + INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_float_scalar, TYPE ## _ ## float ## _m_s) \ + INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_float_matrix, TYPE ## _ ## float ## _m_m) + +// For compatibility, concatenation with a character always returns a +// character. + +#define OCTAVE_CHAR_INT_CONCAT_FN(TYPE) \ + DEFNDCHARCATOP_FN (char ## _ ## TYPE ## _m_s, char_matrix, TYPE ## _scalar, concat) \ + DEFNDCHARCATOP_FN (char ## _ ## TYPE ## _m_m, char_matrix, TYPE ## _matrix, concat) + +#define OCTAVE_INSTALL_CHAR_INT_CONCAT_FN(TYPE) \ + INSTALL_CATOP (octave_char_matrix_str, octave_ ## TYPE ## _scalar, char ## _ ## TYPE ## _m_s) \ + INSTALL_CATOP (octave_char_matrix_str, octave_ ## TYPE ## _matrix, char ## _ ## TYPE ## _m_m) \ + INSTALL_CATOP (octave_char_matrix_sq_str, octave_ ## TYPE ## _scalar, char ## _ ## TYPE ## _m_s) \ + INSTALL_CATOP (octave_char_matrix_sq_str, octave_ ## TYPE ## _matrix, char ## _ ## TYPE ## _m_m) + +#define OCTAVE_INT_CHAR_CONCAT_FN(TYPE) \ + DEFNDCHARCATOP_FN (TYPE ## _ ## char ## _s_m, TYPE ## _scalar, char_matrix, concat) \ + DEFNDCHARCATOP_FN (TYPE ## _ ## char ## _m_m, TYPE ## _matrix, char_matrix, concat) + +#define OCTAVE_INSTALL_INT_CHAR_CONCAT_FN(TYPE) \ + INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_char_matrix_str, TYPE ## _ ## char ## _s_m) \ + INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_char_matrix_str, TYPE ## _ ## char ## _m_m) \ + INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_char_matrix_sq_str, TYPE ## _ ## char ## _s_m) \ + INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_char_matrix_sq_str, TYPE ## _ ## char ## _m_m) + +#define OCTAVE_CONCAT_FN(TYPE) \ + DEFNDCATOP_FN (TYPE ## _s_s, TYPE ## _scalar, TYPE ## _scalar, TYPE ## _array, TYPE ## _array, concat) \ + DEFNDCATOP_FN (TYPE ## _s_m, TYPE ## _scalar, TYPE ## _matrix, TYPE ## _array, TYPE ## _array, concat) \ + DEFNDCATOP_FN (TYPE ## _m_s, TYPE ## _matrix, TYPE ## _scalar, TYPE ## _array, TYPE ## _array, concat) \ + DEFNDCATOP_FN (TYPE ## _m_m, TYPE ## _matrix, TYPE ## _matrix, TYPE ## _array, TYPE ## _array, concat) + +#define OCTAVE_INSTALL_CONCAT_FN(TYPE) \ + INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _scalar, TYPE ## _s_s) \ + INSTALL_CATOP (octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _matrix, TYPE ## _s_m) \ + INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_ ## TYPE ## _scalar, TYPE ## _m_s) \ + INSTALL_CATOP (octave_ ## TYPE ## _matrix, octave_ ## TYPE ## _matrix, TYPE ## _m_m) + +#define OCTAVE_S_INT_UNOPS(TYPE) \ + /* scalar unary ops. */ \ + \ + DEFUNOP_OP (s_not, TYPE ## _scalar, !) \ + DEFUNOP_OP (s_uplus, TYPE ## _scalar, /* no-op */) \ + DEFUNOP (s_uminus, TYPE ## _scalar) \ + { \ + CAST_UNOP_ARG (const octave_ ## TYPE ## _scalar &); \ + octave_value retval = octave_value (- v. TYPE ## _scalar_value ()); \ + return retval; \ + } \ + DEFUNOP_OP (s_transpose, TYPE ## _scalar, /* no-op */) \ + DEFUNOP_OP (s_hermitian, TYPE ## _scalar, /* no-op */) \ + \ + DEFNCUNOP_METHOD (s_incr, TYPE ## _scalar, increment) \ + DEFNCUNOP_METHOD (s_decr, TYPE ## _scalar, decrement) + +#define OCTAVE_SS_INT_ARITH_OPS(PFX, T1, T2, T3) \ + /* scalar by scalar ops. */ \ + \ + DEFINTBINOP_OP (PFX ## _add, T1 ## scalar, T2 ## scalar, +, T3) \ + DEFINTBINOP_OP (PFX ## _sub, T1 ## scalar, T2 ## scalar, -, T3) \ + DEFINTBINOP_OP (PFX ## _mul, T1 ## scalar, T2 ## scalar, *, T3) \ + \ + DEFBINOP (PFX ## _div, T1 ## scalar, T2 ## scalar) \ + { \ + CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ + \ + if (! v2.T2 ## scalar_value ()) \ + gripe_divide_by_zero (); \ + \ + octave_value retval = octave_value (v1.T1 ## scalar_value () / v2.T2 ## scalar_value ()); \ + return retval; \ + } \ + \ + DEFINTBINOP_FN (PFX ## _pow, T1 ## scalar, T2 ## scalar, xpow, T3, ^) \ + \ + DEFBINOP (PFX ## _ldiv, T1 ## scalar, T2 ## scalar) \ + { \ + CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ + \ + if (! v1.T1 ## scalar_value ()) \ + gripe_divide_by_zero (); \ + \ + octave_value retval = octave_value (v2.T2 ## scalar_value () / v1.T1 ## scalar_value ()); \ + return retval; \ + } \ + \ + DEFINTBINOP_OP (PFX ## _el_mul, T1 ## scalar, T2 ## scalar, *, T3) \ + \ + DEFBINOP (PFX ## _el_div, T1 ## scalar, T2 ## scalar) \ + { \ + CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ + \ + if (! v2.T2 ## scalar_value ()) \ + gripe_divide_by_zero (); \ + \ + octave_value retval = octave_value (v1.T1 ## scalar_value () / v2.T2 ## scalar_value ()); \ + return retval; \ + } \ + \ + DEFINTBINOP_FN (PFX ## _el_pow, T1 ## scalar, T2 ## scalar, xpow, T3, .^) \ + \ + DEFBINOP (PFX ## _el_ldiv, T1 ## scalar, T2 ## scalar) \ + { \ + CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ + \ + if (! v1.T1 ## scalar_value ()) \ + gripe_divide_by_zero (); \ + \ + octave_value retval = octave_value (v2.T2 ## scalar_value () / v1.T1 ## scalar_value ()); \ + return retval; \ + } \ + +#define OCTAVE_SS_INT_BOOL_OPS(PFX, T1, T2, Z1, Z2) \ + DEFBINOP (PFX ## _el_and, T2, T2) \ + { \ + CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ + \ + return v1.T1 ## scalar_value () != Z1 && v2.T2 ## scalar_value () != Z2; \ + } \ + \ + DEFBINOP (PFX ## _el_or, T1, T2) \ + { \ + CAST_BINOP_ARGS (const octave_ ## T1 ## scalar&, const octave_ ## T2 ## scalar&); \ + \ + return v1.T1 ## scalar_value () != Z1 || v2.T2 ## scalar_value () != Z2; \ + } + +#define OCTAVE_SS_INT_CMP_OPS(PFX, T1, T2) \ + DEFBINOP_OP (PFX ## _lt, T1 ## scalar, T2 ## scalar, <) \ + DEFBINOP_OP (PFX ## _le, T1 ## scalar, T2 ## scalar, <=) \ + DEFBINOP_OP (PFX ## _eq, T1 ## scalar, T2 ## scalar, ==) \ + DEFBINOP_OP (PFX ## _ge, T1 ## scalar, T2 ## scalar, >=) \ + DEFBINOP_OP (PFX ## _gt, T1 ## scalar, T2 ## scalar, >) \ + DEFBINOP_OP (PFX ## _ne, T1 ## scalar, T2 ## scalar, !=) + +#define OCTAVE_SS_POW_OPS(T1, T2) \ + octave_value \ + xpow (const octave_ ## T1& a, const octave_ ## T2& b) \ + { \ + return pow (a, b); \ + } \ + \ + octave_value \ + xpow (const octave_ ## T1& a, double b) \ + { \ + return pow (a, b); \ + } \ + \ + octave_value \ + xpow (double a, const octave_ ## T1& b) \ + { \ + return pow (a, b); \ + } \ + \ + octave_value \ + xpow (const octave_ ## T1& a, float b) \ + { \ + return powf (a, b); \ + } \ + \ + octave_value \ + xpow (float a, const octave_ ## T1& b) \ + { \ + return powf (a, b); \ + } + +#define OCTAVE_SS_INT_OPS(TYPE) \ + OCTAVE_S_INT_UNOPS (TYPE) \ + OCTAVE_SS_POW_OPS (TYPE, TYPE) \ + OCTAVE_SS_INT_ARITH_OPS (ss, TYPE ## _, TYPE ## _, TYPE) \ + OCTAVE_SS_INT_ARITH_OPS (ssx, TYPE ## _, , TYPE) \ + OCTAVE_SS_INT_ARITH_OPS (sxs, , TYPE ## _, TYPE) \ + OCTAVE_SS_INT_ARITH_OPS (ssfx, TYPE ## _, float_, TYPE) \ + OCTAVE_SS_INT_ARITH_OPS (sfxs, float_, TYPE ## _, TYPE) \ + OCTAVE_SS_INT_CMP_OPS (ss, TYPE ## _, TYPE ## _) \ + OCTAVE_SS_INT_CMP_OPS (sx, TYPE ## _, ) \ + OCTAVE_SS_INT_CMP_OPS (xs, , TYPE ## _) \ + OCTAVE_SS_INT_CMP_OPS (sfx, TYPE ## _, float_) \ + OCTAVE_SS_INT_CMP_OPS (fxs, float_, TYPE ## _) \ + OCTAVE_SS_INT_BOOL_OPS (ss, TYPE ## _, TYPE ## _, octave_ ## TYPE (0), octave_ ## TYPE (0)) \ + OCTAVE_SS_INT_BOOL_OPS (sx, TYPE ## _, , octave_ ## TYPE (0), 0) \ + OCTAVE_SS_INT_BOOL_OPS (xs, , TYPE ## _, 0, octave_ ## TYPE (0)) \ + OCTAVE_SS_INT_BOOL_OPS (sfx, TYPE ## _, float_, octave_ ## TYPE (0), 0) \ + OCTAVE_SS_INT_BOOL_OPS (fxs, float_, TYPE ## _, 0, octave_ ## TYPE (0)) + +#define OCTAVE_SM_INT_ARITH_OPS(PFX, TS, TM, TI) \ + /* scalar by matrix ops. */ \ + \ + DEFINTNDBINOP_OP (PFX ## _add, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, +, TI) \ + DEFINTNDBINOP_OP (PFX ## _sub, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, -, TI) \ + DEFINTNDBINOP_OP (PFX ## _mul, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, *, TI) \ + \ + /* DEFBINOP (PFX ## _div, TS ## scalar, TM ## matrix) */ \ + /* { */ \ + /* CAST_BINOP_ARGS (const octave_ ## TS ## scalar&, const octave_ ## TM ## matrix&); */ \ + /* */ \ + /* Matrix m1 = v1.TM ## matrix_value (); */ \ + /* Matrix m2 = v2.TM ## matrix_value (); */ \ + /* */ \ + /* return octave_value (xdiv (m1, m2)); */ \ + /* } */ \ + \ + /* DEFBINOP_FN (PFX ## _pow, TS ## scalar, TM ## matrix, xpow) */ \ + \ + DEFBINOP (PFX ## _ldiv, TS ## scalar, TM ## matrix) \ + { \ + CAST_BINOP_ARGS (const octave_ ## TS ## scalar&, const octave_ ## TM ## matrix&); \ + \ + if (! v1.TS ## scalar_value ()) \ + gripe_divide_by_zero (); \ + \ + octave_value retval = octave_value (v2.TS ## scalar_value () / v1.TS ## scalar_value ()); \ + return retval; \ + } \ + \ + DEFINTNDBINOP_OP (PFX ## _el_mul, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, *, TI) \ + DEFBINOP (PFX ## _el_div, TS ## scalar, TM ## matrix) \ + { \ + CAST_BINOP_ARGS (const octave_ ## TS ## scalar&, const octave_ ## TM ## matrix&); \ + \ + octave_value retval = octave_value (v1.TS ## scalar_value () / v2.TM ## array_value ()); \ + return retval; \ + } \ + \ + DEFINTNDBINOP_FN (PFX ## _el_pow, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, elem_xpow, TI, .^) \ + \ + DEFBINOP (PFX ## _el_ldiv, TS ## scalar, TM ## matrix) \ + { \ + CAST_BINOP_ARGS (const octave_ ## TS ## scalar&, const octave_ ## TM ## matrix&); \ + \ + if (! v1.TS ## scalar_value ()) \ + gripe_divide_by_zero (); \ + \ + octave_value retval = octave_value (v2.TM ## array_value () / v1.TS ## scalar_value ()); \ + return retval; \ + } + +#define OCTAVE_SM_INT_CMP_OPS(PFX, TS, TM) \ + DEFNDBINOP_FN (PFX ## _lt, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_lt) \ + DEFNDBINOP_FN (PFX ## _le, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_le) \ + DEFNDBINOP_FN (PFX ## _eq, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_eq) \ + DEFNDBINOP_FN (PFX ## _ge, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_ge) \ + DEFNDBINOP_FN (PFX ## _gt, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_gt) \ + DEFNDBINOP_FN (PFX ## _ne, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_ne) + +#define OCTAVE_SM_INT_BOOL_OPS(PFX, TS, TM) \ + DEFNDBINOP_FN (PFX ## _el_and, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_and) \ + DEFNDBINOP_FN (PFX ## _el_or, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_or) \ + DEFNDBINOP_FN (PFX ## _el_and_not, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_and_not) \ + DEFNDBINOP_FN (PFX ## _el_or_not, TS ## scalar, TM ## matrix, TS ## scalar, TM ## array, mx_el_or_not) + +#define OCTAVE_SM_POW_OPS(T1, T2) \ + octave_value \ + elem_xpow (const octave_ ## T1& a, const T2 ## NDArray& b) \ + { \ + T2 ## NDArray result (b.dims ()); \ + for (int i = 0; i < b.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = pow (a, b(i)); \ + } \ + return octave_value (result); \ + } \ +\ + octave_value \ + elem_xpow (const octave_ ## T1& a, const NDArray& b) \ + { \ + T1 ## NDArray result (b.dims ()); \ + for (int i = 0; i < b.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = pow (a, b(i)); \ + } \ + return octave_value (result); \ + } \ + \ + octave_value \ + elem_xpow (double a, const T2 ## NDArray& b) \ + { \ + T2 ## NDArray result (b.dims ()); \ + for (int i = 0; i < b.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = pow (a, b(i)); \ + } \ + return octave_value (result); \ + } \ +\ + octave_value \ + elem_xpow (const octave_ ## T1& a, const FloatNDArray& b) \ + { \ + T1 ## NDArray result (b.dims ()); \ + for (int i = 0; i < b.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = powf (a, b(i)); \ + } \ + return octave_value (result); \ + } \ + \ + octave_value \ + elem_xpow (float a, const T2 ## NDArray& b) \ + { \ + T2 ## NDArray result (b.dims ()); \ + for (int i = 0; i < b.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = powf (a, b(i)); \ + } \ + return octave_value (result); \ + } + + +#define OCTAVE_SM_CONV(TS, TM) \ + DEFCONV (TS ## s_ ## TM ## m_conv, TM ## scalar, TM ## matrix) \ + { \ + CAST_CONV_ARG (const octave_ ## TS ## scalar&); \ + \ + return new octave_ ## TM ## matrix (v.TM ## array_value ()); \ + } + +#define OCTAVE_SM_INT_OPS(TYPE) \ + OCTAVE_SM_POW_OPS (TYPE, TYPE) \ + OCTAVE_SM_INT_ARITH_OPS (sm, TYPE ## _, TYPE ## _, TYPE) \ + OCTAVE_SM_INT_ARITH_OPS (smx, TYPE ## _, , TYPE) \ + OCTAVE_SM_INT_ARITH_OPS (sxm, , TYPE ## _, TYPE) \ + OCTAVE_SM_INT_ARITH_OPS (smfx, TYPE ## _, float_, TYPE) \ + OCTAVE_SM_INT_ARITH_OPS (sfxm, float_, TYPE ## _, TYPE) \ + OCTAVE_SM_INT_CMP_OPS (sm, TYPE ## _, TYPE ## _) \ + OCTAVE_SM_INT_CMP_OPS (xm, , TYPE ## _) \ + OCTAVE_SM_INT_CMP_OPS (smx, TYPE ## _, ) \ + OCTAVE_SM_INT_CMP_OPS (fxm, float_, TYPE ## _) \ + OCTAVE_SM_INT_CMP_OPS (smfx, TYPE ## _, float_) \ + OCTAVE_SM_INT_BOOL_OPS (sm, TYPE ## _, TYPE ## _) \ + OCTAVE_SM_INT_BOOL_OPS (xm, , TYPE ## _) \ + OCTAVE_SM_INT_BOOL_OPS (smx, TYPE ## _, ) \ + OCTAVE_SM_INT_BOOL_OPS (fxm, float_, TYPE ## _) \ + OCTAVE_SM_INT_BOOL_OPS (smfx, TYPE ## _, float_) \ + OCTAVE_SM_CONV (TYPE ## _, TYPE ## _) \ + OCTAVE_SM_CONV (TYPE ## _, complex_) \ + OCTAVE_SM_CONV (TYPE ## _, float_complex_) + +#define OCTAVE_MS_INT_ARITH_OPS(PFX, TM, TS, TI) \ + /* matrix by scalar ops. */ \ + \ + DEFINTNDBINOP_OP (PFX ## _add, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, +, TI) \ + DEFINTNDBINOP_OP (PFX ## _sub, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, -, TI) \ + DEFINTNDBINOP_OP (PFX ## _mul, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, *, TI) \ + \ + DEFBINOP (PFX ## _div, TM ## matrix, TS ## scalar) \ + { \ + CAST_BINOP_ARGS (const octave_ ## TM ## matrix&, const octave_ ## TS ## scalar&); \ + \ + if (! v2.TS ## scalar_value ()) \ + gripe_divide_by_zero (); \ + \ + octave_value retval = octave_value (v1.TM ## array_value () / v2.TS ## scalar_value ()); \ + return retval; \ + } \ + \ + /* DEFBINOP_FN (PFX ## _pow, TM ## matrix, TS ## scalar, xpow) */ \ + \ + /* DEFBINOP (PFX ## _ldiv, TM ## matrix, TS ## scalar) */ \ + /* { */ \ + /* CAST_BINOP_ARGS (const octave_ ## TM ## matrix&, const octave_ ## TS ## scalar&); */ \ + /* */ \ + /* Matrix m1 = v1.TM ## matrix_value (); */ \ + /* Matrix m2 = v2.TM ## matrix_value (); */ \ + /* */ \ + /* return octave_value (xleftdiv (m1, m2)); */ \ + /* } */ \ + \ + DEFINTNDBINOP_OP (PFX ## _el_mul, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, *, TI) \ + \ + DEFBINOP (PFX ## _el_div, TM ## matrix, TS ## scalar) \ + { \ + CAST_BINOP_ARGS (const octave_ ## TM ## matrix&, const octave_ ## TS ## scalar&); \ + \ + if (! v2.TS ## scalar_value ()) \ + gripe_divide_by_zero (); \ + \ + octave_value retval = octave_value (v1.TM ## array_value () / v2.TS ## scalar_value ()); \ + return retval; \ + } \ + \ + DEFINTNDBINOP_FN (PFX ## _el_pow, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, elem_xpow, TI, .^) \ + \ + DEFBINOP (PFX ## _el_ldiv, TM ## matrix, TS ## scalar) \ + { \ + CAST_BINOP_ARGS (const octave_ ## TM ## matrix&, const octave_ ## TS ## scalar&); \ + \ + octave_value retval = v2.TS ## scalar_value () / v1.TM ## array_value (); \ + return retval; \ + } + +#define OCTAVE_MS_INT_CMP_OPS(PFX, TM, TS) \ + DEFNDBINOP_FN (PFX ## _lt, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_lt) \ + DEFNDBINOP_FN (PFX ## _le, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_le) \ + DEFNDBINOP_FN (PFX ## _eq, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_eq) \ + DEFNDBINOP_FN (PFX ## _ge, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_ge) \ + DEFNDBINOP_FN (PFX ## _gt, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_gt) \ + DEFNDBINOP_FN (PFX ## _ne, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_ne) + +#define OCTAVE_MS_INT_BOOL_OPS(PFX, TM, TS) \ + DEFNDBINOP_FN (PFX ## _el_and, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_and) \ + DEFNDBINOP_FN (PFX ## _el_or, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_or) \ + DEFNDBINOP_FN (PFX ## _el_not_and, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_not_and) \ + DEFNDBINOP_FN (PFX ## _el_not_or, TM ## matrix, TS ## scalar, TM ## array, TS ## scalar, mx_el_not_or) + +#define OCTAVE_MS_INT_ASSIGN_OPS(PFX, TM, TS, TE) \ + DEFNDASSIGNOP_FN (PFX ## _assign, TM ## matrix, TS ## scalar, TM ## scalar, assign) + +#define OCTAVE_MS_INT_ASSIGNEQ_OPS(PFX, TM) \ + DEFNDASSIGNOP_OP (PFX ## _assign_add, TM ## matrix, TM ## scalar, TM ## scalar, +=) \ + DEFNDASSIGNOP_OP (PFX ## _assign_sub, TM ## matrix, TM ## scalar, TM ## scalar, -=) \ + DEFNDASSIGNOP_OP (PFX ## _assign_mul, TM ## matrix, TM ## scalar, TM ## scalar, *=) \ + DEFNDASSIGNOP_OP (PFX ## _assign_div, TM ## matrix, TM ## scalar, TM ## scalar, /=) + +#define OCTAVE_MS_POW_OPS(T1, T2) \ +octave_value elem_xpow (T1 ## NDArray a, octave_ ## T2 b) \ +{ \ + T1 ## NDArray result (a.dims ()); \ + for (int i = 0; i < a.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = pow (a(i), b); \ + } \ + return octave_value (result); \ +} \ +\ +octave_value elem_xpow (T1 ## NDArray a, double b) \ +{ \ + T1 ## NDArray result (a.dims ()); \ + for (int i = 0; i < a.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = pow (a(i), b); \ + } \ + return octave_value (result); \ +} \ +\ +octave_value elem_xpow (NDArray a, octave_ ## T2 b) \ +{ \ + T2 ## NDArray result (a.dims ()); \ + for (int i = 0; i < a.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = pow (a(i), b); \ + } \ + return octave_value (result); \ +} \ +\ +octave_value elem_xpow (T1 ## NDArray a, float b) \ +{ \ + T1 ## NDArray result (a.dims ()); \ + for (int i = 0; i < a.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = powf (a(i), b); \ + } \ + return octave_value (result); \ +} \ +\ +octave_value elem_xpow (FloatNDArray a, octave_ ## T2 b) \ +{ \ + T2 ## NDArray result (a.dims ()); \ + for (int i = 0; i < a.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = powf (a(i), b); \ + } \ + return octave_value (result); \ +} + + +#define OCTAVE_MS_INT_OPS(TYPE) \ + OCTAVE_MS_POW_OPS (TYPE, TYPE) \ + OCTAVE_MS_INT_ARITH_OPS (ms, TYPE ## _, TYPE ## _, TYPE) \ + OCTAVE_MS_INT_ARITH_OPS (msx, TYPE ## _, , TYPE) \ + OCTAVE_MS_INT_ARITH_OPS (mxs, , TYPE ## _, TYPE) \ + OCTAVE_MS_INT_ARITH_OPS (msfx, TYPE ## _, float_, TYPE) \ + OCTAVE_MS_INT_ARITH_OPS (mfxs, float_, TYPE ## _, TYPE) \ + OCTAVE_MS_INT_CMP_OPS (ms, TYPE ## _, TYPE ## _) \ + OCTAVE_MS_INT_CMP_OPS (mx, TYPE ## _, ) \ + OCTAVE_MS_INT_CMP_OPS (mxs, , TYPE ## _) \ + OCTAVE_MS_INT_CMP_OPS (mfx, TYPE ## _, float_) \ + OCTAVE_MS_INT_CMP_OPS (mfxs, float_, TYPE ## _) \ + OCTAVE_MS_INT_BOOL_OPS (ms, TYPE ## _, TYPE ## _) \ + OCTAVE_MS_INT_BOOL_OPS (mx, TYPE ## _, ) \ + OCTAVE_MS_INT_BOOL_OPS (mxs, , TYPE ## _) \ + OCTAVE_MS_INT_BOOL_OPS (mfx, TYPE ## _, float_) \ + OCTAVE_MS_INT_BOOL_OPS (mfxs, float_, TYPE ## _) \ + OCTAVE_MS_INT_ASSIGN_OPS (ms, TYPE ## _, TYPE ## _, TYPE ## _) \ + OCTAVE_MS_INT_ASSIGNEQ_OPS (mse, TYPE ## _) \ + OCTAVE_MS_INT_ASSIGN_OPS (mx, TYPE ## _, , ) \ + OCTAVE_MS_INT_ASSIGN_OPS (mfx, TYPE ## _, float_, float_) + +#define OCTAVE_M_INT_UNOPS(TYPE) \ + /* matrix unary ops. */ \ + \ + DEFNDUNOP_OP (m_not, TYPE ## _matrix, TYPE ## _array, !) \ + DEFNDUNOP_OP (m_uplus, TYPE ## _matrix, TYPE ## _array, /* no-op */) \ + DEFUNOP (m_uminus, TYPE ## _matrix) \ + { \ + CAST_UNOP_ARG (const octave_ ## TYPE ## _matrix &); \ + octave_value retval = octave_value (- v. TYPE ## _array_value ()); \ + return retval; \ + } \ + \ + DEFUNOP (m_transpose, TYPE ## _matrix) \ + { \ + CAST_UNOP_ARG (const octave_ ## TYPE ## _matrix&); \ + \ + if (v.ndims () > 2) \ + { \ + error ("transpose not defined for N-d objects"); \ + return octave_value (); \ + } \ + else \ + return octave_value (v.TYPE ## _array_value ().transpose ()); \ + } \ + \ + DEFNCUNOP_METHOD (m_incr, TYPE ## _matrix, increment) \ + DEFNCUNOP_METHOD (m_decr, TYPE ## _matrix, decrement) \ + DEFNCUNOP_METHOD (m_changesign, TYPE ## _matrix, changesign) + +#define OCTAVE_MM_INT_ARITH_OPS(PFX, T1, T2, T3) \ + /* matrix by matrix ops. */ \ + \ + DEFINTNDBINOP_OP (PFX ## _add, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, +, T3) \ + DEFINTNDBINOP_OP (PFX ## _sub, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, -, T3) \ + \ + /* DEFBINOP_OP (PFX ## _mul, T1 ## matrix, T2 ## matrix, *) */ \ + /* DEFBINOP_FN (PFX ## _div, T1 ## matrix, T2 ## matrix, xdiv) */ \ + \ + DEFBINOPX (PFX ## _pow, T1 ## matrix, T2 ## matrix) \ + { \ + error ("can't do A ^ B for A and B both matrices"); \ + return octave_value (); \ + } \ + \ + /* DEFBINOP_FN (PFX ## _ldiv, T1 ## matrix, T2 ## matrix, xleftdiv) */ \ + \ + DEFINTNDBINOP_FN (PFX ## _el_mul, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, product, T3, .*) \ + \ + DEFINTNDBINOP_FN (PFX ## _el_div, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, quotient, T3, ./) \ + \ + DEFINTNDBINOP_FN (PFX ## _el_pow, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, elem_xpow, T3, .^) \ + \ + DEFBINOP (PFX ## _el_ldiv, T1 ## matrix, T2 ## matrix) \ + { \ + CAST_BINOP_ARGS (const octave_ ## T1 ## matrix&, const octave_ ## T2 ## matrix&); \ + \ + octave_value retval = octave_value (quotient (v2.T2 ## array_value (), v1.T1 ## array_value ())); \ + return retval; \ + } + +#define OCTAVE_MM_INT_CMP_OPS(PFX, T1, T2) \ + DEFNDBINOP_FN (PFX ## _lt, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_lt) \ + DEFNDBINOP_FN (PFX ## _le, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_le) \ + DEFNDBINOP_FN (PFX ## _eq, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_eq) \ + DEFNDBINOP_FN (PFX ## _ge, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_ge) \ + DEFNDBINOP_FN (PFX ## _gt, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_gt) \ + DEFNDBINOP_FN (PFX ## _ne, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_ne) + +#define OCTAVE_MM_INT_BOOL_OPS(PFX, T1, T2) \ + DEFNDBINOP_FN (PFX ## _el_and, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_and) \ + DEFNDBINOP_FN (PFX ## _el_or, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_or) \ + DEFNDBINOP_FN (PFX ## _el_not_and, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_not_and) \ + DEFNDBINOP_FN (PFX ## _el_not_or, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_not_or) \ + DEFNDBINOP_FN (PFX ## _el_and_not, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_and_not) \ + DEFNDBINOP_FN (PFX ## _el_or_not, T1 ## matrix, T2 ## matrix, T1 ## array, T2 ## array, mx_el_or_not) + +#define OCTAVE_MM_INT_ASSIGN_OPS(PFX, TLHS, TRHS, TE) \ + DEFNDASSIGNOP_FN (PFX ## _assign, TLHS ## matrix, TRHS ## matrix, TLHS ## array, assign) + +#define OCTAVE_MM_INT_ASSIGNEQ_OPS(PFX, TM) \ + DEFNDASSIGNOP_OP (PFX ## _assign_add, TM ## matrix, TM ## matrix, TM ## array, +=) \ + DEFNDASSIGNOP_OP (PFX ## _assign_sub, TM ## matrix, TM ## matrix, TM ## array, -=) \ + DEFNDASSIGNOP_FNOP (PFX ## _assign_el_mul, TM ## matrix, TM ## matrix, TM ## array, product_eq) \ + DEFNDASSIGNOP_FNOP (PFX ## _assign_el_div, TM ## matrix, TM ## matrix, TM ## array, quotient_eq) + +#define OCTAVE_MM_POW_OPS(T1, T2) \ + octave_value \ + elem_xpow (const T1 ## NDArray& a, const T2 ## NDArray& b) \ + { \ + dim_vector a_dims = a.dims (); \ + dim_vector b_dims = b.dims (); \ + if (a_dims != b_dims) \ + { \ + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ + } \ + T1 ## NDArray result (a_dims); \ + for (int i = 0; i < a.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = pow (a(i), b(i)); \ + } \ + return octave_value (result); \ + } \ +\ + octave_value \ + elem_xpow (const T1 ## NDArray& a, const NDArray& b) \ + { \ + dim_vector a_dims = a.dims (); \ + dim_vector b_dims = b.dims (); \ + if (a_dims != b_dims) \ + { \ + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ + } \ + T1 ## NDArray result (a_dims); \ + for (int i = 0; i < a.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = pow (a(i), b(i)); \ + } \ + return octave_value (result); \ + } \ +\ + octave_value \ + elem_xpow (const NDArray& a, const T2 ## NDArray& b) \ + { \ + dim_vector a_dims = a.dims (); \ + dim_vector b_dims = b.dims (); \ + if (a_dims != b_dims) \ + { \ + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ + } \ + T2 ## NDArray result (a_dims); \ + for (int i = 0; i < a.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = pow (a(i), b(i)); \ + } \ + return octave_value (result); \ + } \ +\ + octave_value \ + elem_xpow (const T1 ## NDArray& a, const FloatNDArray& b) \ + { \ + dim_vector a_dims = a.dims (); \ + dim_vector b_dims = b.dims (); \ + if (a_dims != b_dims) \ + { \ + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ + } \ + T1 ## NDArray result (a_dims); \ + for (int i = 0; i < a.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = powf (a(i), b(i)); \ + } \ + return octave_value (result); \ + } \ +\ + octave_value \ + elem_xpow (const FloatNDArray& a, const T2 ## NDArray& b) \ + { \ + dim_vector a_dims = a.dims (); \ + dim_vector b_dims = b.dims (); \ + if (a_dims != b_dims) \ + { \ + if (is_valid_bsxfun ("operator .^", a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ + } \ + T2 ## NDArray result (a_dims); \ + for (int i = 0; i < a.length (); i++) \ + { \ + OCTAVE_QUIT; \ + result (i) = powf (a(i), b(i)); \ + } \ + return octave_value (result); \ + } + + +#define OCTAVE_MM_CONV(T1, T2) \ + DEFCONV (T1 ## m_ ## T2 ## m_conv, T1 ## matrix, T2 ## matrix) \ + { \ + CAST_CONV_ARG (const octave_ ## T1 ## matrix&); \ + \ + return new octave_ ## T2 ## matrix (v.T2 ## array_value ()); \ + } + +#define OCTAVE_MM_INT_OPS(TYPE) \ + OCTAVE_M_INT_UNOPS (TYPE) \ + OCTAVE_MM_POW_OPS (TYPE, TYPE) \ + OCTAVE_MM_INT_ARITH_OPS (mm, TYPE ## _, TYPE ## _, TYPE) \ + OCTAVE_MM_INT_ARITH_OPS (mmx, TYPE ## _, , TYPE) \ + OCTAVE_MM_INT_ARITH_OPS (mxm, , TYPE ## _, TYPE) \ + OCTAVE_MM_INT_ARITH_OPS (mmfx, TYPE ## _, float_, TYPE) \ + OCTAVE_MM_INT_ARITH_OPS (mfxm, float_, TYPE ## _, TYPE) \ + OCTAVE_MM_INT_CMP_OPS (mm, TYPE ## _, TYPE ## _) \ + OCTAVE_MM_INT_CMP_OPS (mmx, TYPE ## _, ) \ + OCTAVE_MM_INT_CMP_OPS (mfxm, float_, TYPE ## _) \ + OCTAVE_MM_INT_CMP_OPS (mmfx, TYPE ## _, float_) \ + OCTAVE_MM_INT_CMP_OPS (mxm, , TYPE ## _) \ + OCTAVE_MM_INT_BOOL_OPS (mm, TYPE ## _, TYPE ## _) \ + OCTAVE_MM_INT_BOOL_OPS (mmx, TYPE ## _, ) \ + OCTAVE_MM_INT_BOOL_OPS (mxm, , TYPE ## _) \ + OCTAVE_MM_INT_BOOL_OPS (mmfx, TYPE ## _, float_) \ + OCTAVE_MM_INT_BOOL_OPS (mfxm, float_, TYPE ## _) \ + OCTAVE_MM_INT_ASSIGN_OPS (mm, TYPE ## _, TYPE ## _, TYPE ## _) \ + OCTAVE_MM_INT_ASSIGNEQ_OPS (mme, TYPE ## _) \ + OCTAVE_MM_INT_ASSIGN_OPS (mmx, TYPE ## _, , ) \ + OCTAVE_MM_INT_ASSIGN_OPS (mmfx, TYPE ## _, float_, float_) \ + OCTAVE_MM_CONV(TYPE ## _, complex_) \ + OCTAVE_MM_CONV(TYPE ## _, float_complex_) + +#define OCTAVE_RE_INT_ASSIGN_OPS(TYPE) \ + DEFNDASSIGNOP_FN (TYPE ## ms_assign, matrix, TYPE ## _scalar, array, assign) \ + DEFNDASSIGNOP_FN (TYPE ## mm_assign, matrix, TYPE ## _matrix, array, assign) + +#define OCTAVE_FLT_RE_INT_ASSIGN_OPS(TYPE) \ + DEFNDASSIGNOP_FN (TYPE ## fms_assign, float_matrix, TYPE ## _scalar, float_array, assign) \ + DEFNDASSIGNOP_FN (TYPE ## fmm_assign, float_matrix, TYPE ## _matrix, float_array, assign) + +#define OCTAVE_CX_INT_ASSIGN_OPS(TYPE) \ + DEFNDASSIGNOP_FN (TYPE ## cms_assign, complex_matrix, TYPE ## _scalar, complex_array, assign) \ + DEFNDASSIGNOP_FN (TYPE ## cmm_assign, complex_matrix, TYPE ## _matrix, complex_array, assign) + +#define OCTAVE_FLT_CX_INT_ASSIGN_OPS(TYPE) \ + DEFNDASSIGNOP_FN (TYPE ## fcms_assign, float_complex_matrix, TYPE ## _scalar, float_complex_array, assign) \ + DEFNDASSIGNOP_FN (TYPE ## fcmm_assign, float_complex_matrix, TYPE ## _matrix, float_complex_array, assign) + +#define OCTAVE_INT_NULL_ASSIGN_OPS(TYPE) \ + DEFNULLASSIGNOP_FN (TYPE ## null_assign, TYPE ## _matrix, delete_elements) + +#define OCTAVE_INT_OPS(TYPE) \ + OCTAVE_SS_INT_OPS (TYPE) \ + OCTAVE_SM_INT_OPS (TYPE) \ + OCTAVE_MS_INT_OPS (TYPE) \ + OCTAVE_MM_INT_OPS (TYPE) \ + OCTAVE_CONCAT_FN (TYPE) \ + OCTAVE_RE_INT_ASSIGN_OPS (TYPE) \ + OCTAVE_FLT_RE_INT_ASSIGN_OPS (TYPE) \ + OCTAVE_CX_INT_ASSIGN_OPS (TYPE) \ + OCTAVE_FLT_CX_INT_ASSIGN_OPS (TYPE) \ + OCTAVE_INT_NULL_ASSIGN_OPS(TYPE) + +#define OCTAVE_INSTALL_S_INT_UNOPS(TYPE) \ + INSTALL_UNOP (op_not, octave_ ## TYPE ## _scalar, s_not); \ + INSTALL_UNOP (op_uplus, octave_ ## TYPE ## _scalar, s_uplus); \ + INSTALL_UNOP (op_uminus, octave_ ## TYPE ## _scalar, s_uminus); \ + INSTALL_UNOP (op_transpose, octave_ ## TYPE ## _scalar, s_transpose); \ + INSTALL_UNOP (op_hermitian, octave_ ## TYPE ## _scalar, s_hermitian); \ + \ + INSTALL_NCUNOP (op_incr, octave_ ## TYPE ## _scalar, s_incr); \ + INSTALL_NCUNOP (op_decr, octave_ ## TYPE ## _scalar, s_decr); + +#define OCTAVE_INSTALL_SS_INT_ARITH_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_add, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _add); \ + INSTALL_BINOP (op_sub, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _sub); \ + INSTALL_BINOP (op_mul, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _mul); \ + INSTALL_BINOP (op_div, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _div); \ + INSTALL_BINOP (op_pow, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _pow); \ + INSTALL_BINOP (op_ldiv, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _ldiv); \ + INSTALL_BINOP (op_el_mul, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_mul); \ + INSTALL_BINOP (op_el_div, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_div); \ + INSTALL_BINOP (op_el_pow, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_pow); \ + INSTALL_BINOP (op_el_ldiv, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_ldiv); + +#define OCTAVE_INSTALL_SS_INT_CMP_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_lt, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _lt); \ + INSTALL_BINOP (op_le, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _le); \ + INSTALL_BINOP (op_eq, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _eq); \ + INSTALL_BINOP (op_ge, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _ge); \ + INSTALL_BINOP (op_gt, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _gt); \ + INSTALL_BINOP (op_ne, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _ne); + +#define OCTAVE_INSTALL_SS_INT_BOOL_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_el_and, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_and); \ + INSTALL_BINOP (op_el_or, octave_ ## T1 ## scalar, octave_ ## T2 ## scalar, PFX ## _el_or); + +#define OCTAVE_INSTALL_SS_INT_OPS(TYPE) \ + OCTAVE_INSTALL_S_INT_UNOPS (TYPE) \ + OCTAVE_INSTALL_SS_INT_ARITH_OPS (ss, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_SS_INT_ARITH_OPS (ssx, TYPE ## _, ) \ + OCTAVE_INSTALL_SS_INT_ARITH_OPS (sxs, , TYPE ## _) \ + OCTAVE_INSTALL_SS_INT_ARITH_OPS (ssfx, TYPE ## _, float_) \ + OCTAVE_INSTALL_SS_INT_ARITH_OPS (sfxs, float_, TYPE ## _) \ + OCTAVE_INSTALL_SS_INT_CMP_OPS (ss, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_SS_INT_CMP_OPS (sx, TYPE ## _, ) \ + OCTAVE_INSTALL_SS_INT_CMP_OPS (xs, , TYPE ## _) \ + OCTAVE_INSTALL_SS_INT_CMP_OPS (sfx, TYPE ## _, float_) \ + OCTAVE_INSTALL_SS_INT_CMP_OPS (fxs, float_, TYPE ## _) \ + OCTAVE_INSTALL_SS_INT_BOOL_OPS (ss, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_SS_INT_BOOL_OPS (sx, TYPE ## _, ) \ + OCTAVE_INSTALL_SS_INT_BOOL_OPS (xs, , TYPE ## _) \ + OCTAVE_INSTALL_SS_INT_BOOL_OPS (sfx, TYPE ## _, float_) \ + OCTAVE_INSTALL_SS_INT_BOOL_OPS (fxs, float_, TYPE ## _) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _matrix) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_scalar, octave_ ## TYPE ## _matrix) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_float_scalar, octave_ ## TYPE ## _matrix) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_complex_scalar, octave_complex_matrix) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_float_complex_scalar, octave_float_complex_matrix) + +#define OCTAVE_INSTALL_SM_INT_ARITH_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_add, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _add); \ + INSTALL_BINOP (op_sub, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _sub); \ + INSTALL_BINOP (op_mul, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _mul); \ + /* INSTALL_BINOP (op_div, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _div); */ \ + /* INSTALL_BINOP (op_pow, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _pow); */ \ + INSTALL_BINOP (op_ldiv, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _ldiv); \ + INSTALL_BINOP (op_el_mul, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_mul); \ + INSTALL_BINOP (op_el_div, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_div); \ + INSTALL_BINOP (op_el_pow, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_pow); \ + INSTALL_BINOP (op_el_ldiv, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_ldiv); + +#define OCTAVE_INSTALL_SM_INT_CMP_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_lt, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _lt); \ + INSTALL_BINOP (op_le, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _le); \ + INSTALL_BINOP (op_eq, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _eq); \ + INSTALL_BINOP (op_ge, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _ge); \ + INSTALL_BINOP (op_gt, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _gt); \ + INSTALL_BINOP (op_ne, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _ne); + +#define OCTAVE_INSTALL_SM_INT_BOOL_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_el_and, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_and); \ + INSTALL_BINOP (op_el_or, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_or); \ + INSTALL_BINOP (op_el_and_not, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_and_not); \ + INSTALL_BINOP (op_el_or_not, octave_ ## T1 ## scalar, octave_ ## T2 ## matrix, PFX ## _el_or_not); + +#define OCTAVE_INSTALL_SM_INT_OPS(TYPE) \ + OCTAVE_INSTALL_SM_INT_ARITH_OPS (sm, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_SM_INT_ARITH_OPS (smx, TYPE ## _, ) \ + OCTAVE_INSTALL_SM_INT_ARITH_OPS (sxm, , TYPE ## _) \ + OCTAVE_INSTALL_SM_INT_ARITH_OPS (smfx, TYPE ## _, float_) \ + OCTAVE_INSTALL_SM_INT_ARITH_OPS (sfxm, float_, TYPE ## _) \ + OCTAVE_INSTALL_SM_INT_CMP_OPS (sm, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_SM_INT_CMP_OPS (xm, , TYPE ## _) \ + OCTAVE_INSTALL_SM_INT_CMP_OPS (smx, TYPE ## _, ) \ + OCTAVE_INSTALL_SM_INT_CMP_OPS (fxm, float_, TYPE ## _) \ + OCTAVE_INSTALL_SM_INT_CMP_OPS (smfx, TYPE ## _, float_) \ + OCTAVE_INSTALL_SM_INT_BOOL_OPS (sm, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_SM_INT_BOOL_OPS (xm, , TYPE ## _) \ + OCTAVE_INSTALL_SM_INT_BOOL_OPS (smx, TYPE ## _, ) \ + OCTAVE_INSTALL_SM_INT_BOOL_OPS (fxm, float_, TYPE ## _) \ + OCTAVE_INSTALL_SM_INT_BOOL_OPS (smfx, TYPE ## _, float_) \ + INSTALL_WIDENOP (octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _matrix, TYPE ## _s_ ## TYPE ## _m_conv) \ + INSTALL_WIDENOP (octave_ ## TYPE ## _scalar, octave_complex_matrix, TYPE ## _s_complex_m_conv) \ + INSTALL_WIDENOP (octave_ ## TYPE ## _scalar, octave_float_complex_matrix, TYPE ## _s_float_complex_m_conv) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_ ## TYPE ## _matrix, octave_ ## TYPE ## _matrix) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_matrix, octave_ ## TYPE ## _matrix) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_float_matrix, octave_ ## TYPE ## _matrix) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_complex_matrix, octave_complex_matrix) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _scalar, octave_float_complex_matrix, octave_float_complex_matrix) + +#define OCTAVE_INSTALL_MS_INT_ARITH_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_add, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _add); \ + INSTALL_BINOP (op_sub, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _sub); \ + INSTALL_BINOP (op_mul, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _mul); \ + INSTALL_BINOP (op_div, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _div); \ + /* INSTALL_BINOP (op_pow, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _pow); */ \ + /* INSTALL_BINOP (op_ldiv, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _ldiv); */ \ + \ + INSTALL_BINOP (op_el_mul, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_mul); \ + INSTALL_BINOP (op_el_div, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_div); \ + INSTALL_BINOP (op_el_pow, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_pow); \ + INSTALL_BINOP (op_el_ldiv, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_ldiv); + +#define OCTAVE_INSTALL_MS_INT_CMP_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_lt, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _lt); \ + INSTALL_BINOP (op_le, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _le); \ + INSTALL_BINOP (op_eq, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _eq); \ + INSTALL_BINOP (op_ge, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _ge); \ + INSTALL_BINOP (op_gt, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _gt); \ + INSTALL_BINOP (op_ne, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _ne); + +#define OCTAVE_INSTALL_MS_INT_BOOL_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_el_and, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_and); \ + INSTALL_BINOP (op_el_or, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_or); \ + INSTALL_BINOP (op_el_not_and, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_not_and); \ + INSTALL_BINOP (op_el_not_or, octave_ ## T1 ## matrix, octave_ ## T2 ## scalar, PFX ## _el_not_or); + +#define OCTAVE_INSTALL_MS_INT_ASSIGN_OPS(PFX, TLHS, TRHS) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## scalar, PFX ## _assign) + +#define OCTAVE_INSTALL_MS_INT_ASSIGNEQ_OPS(PFX, TLHS, TRHS) \ + INSTALL_ASSIGNOP (op_add_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## scalar, PFX ## _assign_add) \ + INSTALL_ASSIGNOP (op_sub_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## scalar, PFX ## _assign_sub) \ + INSTALL_ASSIGNOP (op_mul_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## scalar, PFX ## _assign_mul) \ + INSTALL_ASSIGNOP (op_div_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## scalar, PFX ## _assign_div) + +#define OCTAVE_INSTALL_MS_INT_OPS(TYPE) \ + OCTAVE_INSTALL_MS_INT_ARITH_OPS (ms, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_MS_INT_ARITH_OPS (msx, TYPE ## _, ) \ + OCTAVE_INSTALL_MS_INT_ARITH_OPS (mxs, , TYPE ## _) \ + OCTAVE_INSTALL_MS_INT_ARITH_OPS (msfx, TYPE ## _, float_) \ + OCTAVE_INSTALL_MS_INT_ARITH_OPS (mfxs, float_, TYPE ## _) \ + OCTAVE_INSTALL_MS_INT_CMP_OPS (ms, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_MS_INT_CMP_OPS (mx, TYPE ## _, ) \ + OCTAVE_INSTALL_MS_INT_CMP_OPS (mxs, , TYPE ## _) \ + OCTAVE_INSTALL_MS_INT_CMP_OPS (mfx, TYPE ## _, float_) \ + OCTAVE_INSTALL_MS_INT_CMP_OPS (mfxs, float_, TYPE ## _) \ + OCTAVE_INSTALL_MS_INT_BOOL_OPS (ms, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_MS_INT_BOOL_OPS (mx, TYPE ## _, ) \ + OCTAVE_INSTALL_MS_INT_BOOL_OPS (mxs, , TYPE ## _) \ + OCTAVE_INSTALL_MS_INT_BOOL_OPS (mfx, TYPE ## _, float_) \ + OCTAVE_INSTALL_MS_INT_BOOL_OPS (mfxs, float_, TYPE ## _) \ + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (ms, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_MS_INT_ASSIGNEQ_OPS (mse, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mx, TYPE ## _, ) \ + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mfx, TYPE ## _, float_) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _matrix, octave_complex_scalar, octave_complex_matrix) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _matrix, octave_float_complex_scalar, octave_float_complex_matrix) + +#define OCTAVE_INSTALL_M_INT_UNOPS(TYPE) \ + INSTALL_UNOP (op_not, octave_ ## TYPE ## _matrix, m_not); \ + INSTALL_UNOP (op_uplus, octave_ ## TYPE ## _matrix, m_uplus); \ + INSTALL_UNOP (op_uminus, octave_ ## TYPE ## _matrix, m_uminus); \ + INSTALL_UNOP (op_transpose, octave_ ## TYPE ## _matrix, m_transpose); \ + INSTALL_UNOP (op_hermitian, octave_ ## TYPE ## _matrix, m_transpose); \ + \ + INSTALL_NCUNOP (op_incr, octave_ ## TYPE ## _matrix, m_incr); \ + INSTALL_NCUNOP (op_decr, octave_ ## TYPE ## _matrix, m_decr); \ + INSTALL_NCUNOP (op_uminus, octave_ ## TYPE ## _matrix, m_changesign); + +#define OCTAVE_INSTALL_MM_INT_ARITH_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_add, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _add); \ + INSTALL_BINOP (op_sub, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _sub); \ + /* INSTALL_BINOP (op_mul, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _mul); */ \ + /* INSTALL_BINOP (op_div, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _div); */ \ + INSTALL_BINOP (op_pow, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _pow); \ + /* INSTALL_BINOP (op_ldiv, octave_ ## T1 ## _matrix, octave_ ## T2 ## _matrix, mm_ldiv); */ \ + INSTALL_BINOP (op_el_mul, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_mul); \ + INSTALL_BINOP (op_el_div, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_div); \ + INSTALL_BINOP (op_el_pow, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_pow); \ + INSTALL_BINOP (op_el_ldiv, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_ldiv); + +#define OCTAVE_INSTALL_MM_INT_CMP_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_lt, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _lt); \ + INSTALL_BINOP (op_le, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _le); \ + INSTALL_BINOP (op_eq, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _eq); \ + INSTALL_BINOP (op_ge, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _ge); \ + INSTALL_BINOP (op_gt, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _gt); \ + INSTALL_BINOP (op_ne, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _ne); + +#define OCTAVE_INSTALL_MM_INT_BOOL_OPS(PFX, T1, T2) \ + INSTALL_BINOP (op_el_and, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_and); \ + INSTALL_BINOP (op_el_or, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_or); \ + INSTALL_BINOP (op_el_not_and, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_not_and); \ + INSTALL_BINOP (op_el_not_or, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_not_or); \ + INSTALL_BINOP (op_el_and_not, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_and_not); \ + INSTALL_BINOP (op_el_or_not, octave_ ## T1 ## matrix, octave_ ## T2 ## matrix, PFX ## _el_or_not); + +#define OCTAVE_INSTALL_MM_INT_ASSIGN_OPS(PFX, TLHS, TRHS) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## matrix, PFX ## _assign) + +#define OCTAVE_INSTALL_MM_INT_ASSIGNEQ_OPS(PFX, TLHS, TRHS) \ + INSTALL_ASSIGNOP (op_add_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## matrix, PFX ## _assign_add) \ + INSTALL_ASSIGNOP (op_sub_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## matrix, PFX ## _assign_sub) \ + INSTALL_ASSIGNOP (op_el_mul_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## matrix, PFX ## _assign_el_mul) \ + INSTALL_ASSIGNOP (op_el_div_eq, octave_ ## TLHS ## matrix, octave_ ## TRHS ## matrix, PFX ## _assign_el_div) + +#define OCTAVE_INSTALL_MM_INT_OPS(TYPE) \ + OCTAVE_INSTALL_M_INT_UNOPS (TYPE) \ + OCTAVE_INSTALL_MM_INT_ARITH_OPS (mm, TYPE ##_, TYPE ## _) \ + OCTAVE_INSTALL_MM_INT_ARITH_OPS (mmx, TYPE ##_, ) \ + OCTAVE_INSTALL_MM_INT_ARITH_OPS (mxm, , TYPE ##_) \ + OCTAVE_INSTALL_MM_INT_ARITH_OPS (mmfx, TYPE ##_, float_) \ + OCTAVE_INSTALL_MM_INT_ARITH_OPS (mfxm, float_, TYPE ##_) \ + OCTAVE_INSTALL_MM_INT_CMP_OPS (mm, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_MM_INT_CMP_OPS (mmx, TYPE ## _, ) \ + OCTAVE_INSTALL_MM_INT_CMP_OPS (mxm, , TYPE ## _) \ + OCTAVE_INSTALL_MM_INT_CMP_OPS (mmfx, TYPE ## _, float_) \ + OCTAVE_INSTALL_MM_INT_CMP_OPS (mfxm, float_, TYPE ## _) \ + OCTAVE_INSTALL_MM_INT_BOOL_OPS (mm, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_MM_INT_BOOL_OPS (mmx, TYPE ## _, ) \ + OCTAVE_INSTALL_MM_INT_BOOL_OPS (mxm, , TYPE ## _) \ + OCTAVE_INSTALL_MM_INT_BOOL_OPS (mmfx, TYPE ## _, float_) \ + OCTAVE_INSTALL_MM_INT_BOOL_OPS (mfxm, float_, TYPE ## _) \ + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mm, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_MM_INT_ASSIGNEQ_OPS (mme, TYPE ## _, TYPE ## _) \ + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmx, TYPE ## _, ) \ + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmfx, TYPE ## _, float_) \ + INSTALL_WIDENOP (octave_ ## TYPE ## _matrix, octave_complex_matrix, TYPE ## _m_complex_m_conv) \ + INSTALL_WIDENOP (octave_ ## TYPE ## _matrix, octave_float_complex_matrix, TYPE ## _m_float_complex_m_conv) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _matrix, octave_complex_matrix, octave_complex_matrix) \ + INSTALL_ASSIGNCONV (octave_ ## TYPE ## _matrix, octave_float_complex_matrix, octave_float_complex_matrix) + +#define OCTAVE_INSTALL_RE_INT_ASSIGN_OPS(TYPE) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_ ## TYPE ## _scalar, TYPE ## ms_assign) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_ ## TYPE ## _matrix, TYPE ## mm_assign) \ + INSTALL_ASSIGNCONV (octave_scalar, octave_ ## TYPE ## _scalar, octave_matrix) \ + INSTALL_ASSIGNCONV (octave_matrix, octave_ ## TYPE ## _matrix, octave_matrix) + +#define OCTAVE_INSTALL_FLT_RE_INT_ASSIGN_OPS(TYPE) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_ ## TYPE ## _scalar, TYPE ## fms_assign) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_ ## TYPE ## _matrix, TYPE ## fmm_assign) \ + INSTALL_ASSIGNCONV (octave_float_scalar, octave_ ## TYPE ## _scalar, octave_float_matrix) \ + INSTALL_ASSIGNCONV (octave_float_matrix, octave_ ## TYPE ## _matrix, octave_float_matrix) + +#define OCTAVE_INSTALL_CX_INT_ASSIGN_OPS(TYPE) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_ ## TYPE ## _scalar, TYPE ## cms_assign) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_complex_matrix, octave_ ## TYPE ## _matrix, TYPE ## cmm_assign) \ + INSTALL_ASSIGNCONV (octave_complex_scalar, octave_ ## TYPE ## _scalar, octave_complex_matrix) \ + INSTALL_ASSIGNCONV (octave_complex_matrix, octave_ ## TYPE ## _matrix, octave_complex_matrix) + +#define OCTAVE_INSTALL_FLT_CX_INT_ASSIGN_OPS(TYPE) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_ ## TYPE ## _scalar, TYPE ## fcms_assign) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_ ## TYPE ## _matrix, TYPE ## fcmm_assign) \ + INSTALL_ASSIGNCONV (octave_float_complex_scalar, octave_ ## TYPE ## _scalar, octave_complex_matrix) \ + INSTALL_ASSIGNCONV (octave_float_complex_matrix, octave_ ## TYPE ## _matrix, octave_complex_matrix) + +#define OCTAVE_INSTALL_INT_NULL_ASSIGN_OPS(TYPE) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_ ## TYPE ## _matrix, octave_null_matrix, TYPE ## null_assign) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_ ## TYPE ## _matrix, octave_null_str, TYPE ## null_assign) \ + INSTALL_ASSIGNOP (op_asn_eq, octave_ ## TYPE ## _matrix, octave_null_sq_str, TYPE ## null_assign) + +#define OCTAVE_INSTALL_INT_OPS(TYPE) \ + OCTAVE_INSTALL_SS_INT_OPS (TYPE) \ + OCTAVE_INSTALL_SM_INT_OPS (TYPE) \ + OCTAVE_INSTALL_MS_INT_OPS (TYPE) \ + OCTAVE_INSTALL_MM_INT_OPS (TYPE) \ + OCTAVE_INSTALL_CONCAT_FN (TYPE) \ + OCTAVE_INSTALL_RE_INT_ASSIGN_OPS (TYPE) \ + OCTAVE_INSTALL_FLT_RE_INT_ASSIGN_OPS (TYPE) \ + OCTAVE_INSTALL_CX_INT_ASSIGN_OPS (TYPE) \ + OCTAVE_INSTALL_FLT_CX_INT_ASSIGN_OPS (TYPE) \ + OCTAVE_INSTALL_INT_NULL_ASSIGN_OPS(TYPE) + +#define OCTAVE_INSTALL_SM_INT_ASSIGNCONV(TLHS, TRHS) \ + INSTALL_ASSIGNCONV (octave_ ## TLHS ## _scalar, octave_ ## TRHS ## _scalar, octave_ ## TLHS ## _matrix) \ + INSTALL_ASSIGNCONV (octave_ ## TLHS ## _scalar, octave_ ## TRHS ## _matrix, octave_ ## TLHS ## _matrix) + +#define OCTAVE_MIXED_INT_CMP_OPS(T1, T2) \ + OCTAVE_SS_INT_CMP_OPS (T1 ## _ ## T2 ## _ss, T1 ## _, T2 ## _) \ + OCTAVE_SM_INT_CMP_OPS (T1 ## _ ## T2 ## _sm, T1 ## _, T2 ## _) \ + OCTAVE_MS_INT_CMP_OPS (T1 ## _ ## T2 ## _ms, T1 ## _, T2 ## _) \ + OCTAVE_MM_INT_CMP_OPS (T1 ## _ ## T2 ## _mm, T1 ## _, T2 ## _) + +#define OCTAVE_INSTALL_MIXED_INT_CMP_OPS(T1, T2) \ + OCTAVE_INSTALL_SS_INT_CMP_OPS (T1 ## _ ## T2 ## _ss, T1 ## _, T2 ## _) \ + OCTAVE_INSTALL_SM_INT_CMP_OPS (T1 ## _ ## T2 ## _sm, T1 ## _, T2 ## _) \ + OCTAVE_INSTALL_MS_INT_CMP_OPS (T1 ## _ ## T2 ## _ms, T1 ## _, T2 ## _) \ + OCTAVE_INSTALL_MM_INT_CMP_OPS (T1 ## _ ## T2 ## _mm, T1 ## _, T2 ## _) diff -r d02b229ce693 -r a132d206a36a src/operators/op-m-cdm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-m-cdm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,36 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-re-mat.h" +#define RINCLUDE "ov-cx-diag.h" + +#define LMATRIX matrix +#define RMATRIX complex_diag_matrix +#define LDMATRIX complex_matrix + +#define LSHORT m +#define RSHORT cdm + +#define DEFINEDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-m-cm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-m-cm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,166 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-m-cm.h" +#include "mx-cm-m.h" +#include "mx-nda-cnda.h" +#include "mx-cnda-nda.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix by complex matrix ops. + +DEFNDBINOP_OP (add, matrix, complex_matrix, array, complex_array, +) +DEFNDBINOP_OP (sub, matrix, complex_matrix, array, complex_array, -) + +DEFBINOP_OP (mul, matrix, complex_matrix, *) + +DEFBINOP (trans_mul, matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + Matrix m1 = v1.matrix_value (); + ComplexMatrix m2 = v2.complex_matrix_value (); + + return ComplexMatrix (xgemm (m1, real (m2), blas_trans, blas_no_trans), + xgemm (m1, imag (m2), blas_trans, blas_no_trans)); +} + +DEFBINOP (div, matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.matrix_value (), + v2.complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOPX (pow, matrix, complex_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.matrix_value (), + v2.complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP (trans_ldiv, matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.matrix_value (), + v2.complex_matrix_value (), typ, blas_trans); + + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, matrix, complex_matrix, array, complex_array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, matrix, complex_matrix, array, complex_array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, matrix, complex_matrix, array, complex_array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, matrix, complex_matrix, array, complex_array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, matrix, complex_matrix, array, complex_array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, matrix, complex_matrix, array, complex_array, mx_el_ne) + +DEFNDBINOP_FN (el_mul, matrix, complex_matrix, array, complex_array, product) +DEFNDBINOP_FN (el_div, matrix, complex_matrix, array, complex_array, quotient) +DEFNDBINOP_FN (el_pow, matrix, complex_matrix, array, complex_array, elem_xpow) + +DEFBINOP (el_ldiv, matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + return quotient (v2.complex_array_value (), v1.array_value ()); +} + +DEFNDBINOP_FN (el_and, matrix, complex_matrix, array, complex_array, mx_el_and) +DEFNDBINOP_FN (el_or, matrix, complex_matrix, array, complex_array, mx_el_or) + +DEFNDCATOP_FN (m_cm, matrix, complex_matrix, array, complex_array, concat) + +DEFCONV (complex_matrix_conv, matrix, complex_matrix) +{ + CAST_CONV_ARG (const octave_matrix&); + + return new octave_complex_matrix (ComplexNDArray (v.array_value ())); +} + +void +install_m_cm_ops (void) +{ + INSTALL_BINOP (op_add, octave_matrix, octave_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_matrix, octave_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_matrix, octave_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_matrix, octave_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_matrix, octave_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_matrix, octave_complex_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_matrix, octave_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_matrix, octave_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_matrix, octave_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_matrix, octave_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_matrix, octave_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_matrix, octave_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_matrix, octave_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_matrix, octave_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_matrix, octave_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_matrix, octave_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_matrix, octave_complex_matrix, el_or); + INSTALL_BINOP (op_trans_mul, octave_matrix, octave_complex_matrix, trans_mul); + INSTALL_BINOP (op_herm_mul, octave_matrix, octave_complex_matrix, trans_mul); + INSTALL_BINOP (op_trans_ldiv, octave_matrix, octave_complex_matrix, trans_ldiv); + INSTALL_BINOP (op_herm_ldiv, octave_matrix, octave_complex_matrix, trans_ldiv); + + INSTALL_CATOP (octave_matrix, octave_complex_matrix, m_cm); + + INSTALL_ASSIGNCONV (octave_matrix, octave_complex_matrix, octave_complex_matrix); + INSTALL_ASSIGNCONV (octave_float_matrix, octave_complex_matrix, octave_float_complex_matrix); + + INSTALL_WIDENOP (octave_matrix, octave_complex_matrix, complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-m-cs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-m-cs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,140 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-m-cs.h" +#include "mx-cs-m.h" +#include "mx-nda-cs.h" +#include "mx-cs-nda.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-complex.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix by complex scalar ops. + +DEFNDBINOP_OP (add, matrix, complex, array, complex, +) +DEFNDBINOP_OP (sub, matrix, complex, array, complex, -) +DEFNDBINOP_OP (mul, matrix, complex, array, complex, *) + +DEFBINOP (div, matrix, complex) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.array_value () / d); +} + +DEFBINOP_FN (pow, matrix, complex, xpow) + +DEFBINOP (ldiv, matrix, complex) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + Matrix m1 = v1.matrix_value (); + ComplexMatrix m2 = v2.complex_matrix_value (); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (m1, m2, typ); + + v1.matrix_type (typ); + return ret; +} + +DEFNDCMPLXCMPOP_FN (lt, matrix, complex, array, complex, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, matrix, complex, array, complex, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, matrix, complex, array, complex, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, matrix, complex, array, complex, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, matrix, complex, array, complex, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, matrix, complex, array, complex, mx_el_ne) + +DEFNDBINOP_OP (el_mul, matrix, complex, array, complex, *) + +DEFBINOP (el_div, matrix, complex) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.array_value () / d); +} + +DEFNDBINOP_FN (el_pow, matrix, complex, array, complex, elem_xpow) + +DEFBINOP (el_ldiv, matrix, complex) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + return x_el_div (v2.complex_value (), v1.array_value ()); +} + +DEFNDBINOP_FN (el_and, matrix, complex, array, complex, mx_el_and) +DEFNDBINOP_FN (el_or, matrix, complex, array, complex, mx_el_or) + +DEFNDCATOP_FN (m_cs, matrix, complex, array, complex_array, concat) + +void +install_m_cs_ops (void) +{ + INSTALL_BINOP (op_add, octave_matrix, octave_complex, add); + INSTALL_BINOP (op_sub, octave_matrix, octave_complex, sub); + INSTALL_BINOP (op_mul, octave_matrix, octave_complex, mul); + INSTALL_BINOP (op_div, octave_matrix, octave_complex, div); + INSTALL_BINOP (op_pow, octave_matrix, octave_complex, pow); + INSTALL_BINOP (op_ldiv, octave_matrix, octave_complex, ldiv); + INSTALL_BINOP (op_lt, octave_matrix, octave_complex, lt); + INSTALL_BINOP (op_le, octave_matrix, octave_complex, le); + INSTALL_BINOP (op_eq, octave_matrix, octave_complex, eq); + INSTALL_BINOP (op_ge, octave_matrix, octave_complex, ge); + INSTALL_BINOP (op_gt, octave_matrix, octave_complex, gt); + INSTALL_BINOP (op_ne, octave_matrix, octave_complex, ne); + INSTALL_BINOP (op_el_mul, octave_matrix, octave_complex, el_mul); + INSTALL_BINOP (op_el_div, octave_matrix, octave_complex, el_div); + INSTALL_BINOP (op_el_pow, octave_matrix, octave_complex, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_complex, el_ldiv); + INSTALL_BINOP (op_el_and, octave_matrix, octave_complex, el_and); + INSTALL_BINOP (op_el_or, octave_matrix, octave_complex, el_or); + + INSTALL_CATOP (octave_matrix, octave_complex, m_cs); + + INSTALL_ASSIGNCONV (octave_matrix, octave_complex, octave_complex_matrix); + INSTALL_ASSIGNCONV (octave_float_matrix, octave_complex, octave_float_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-m-dm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-m-dm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define LINCLUDE "ov-re-mat.h" +#define RINCLUDE "ov-re-diag.h" + +#define LMATRIX matrix +#define RMATRIX diag_matrix + +#define LSHORT m +#define RSHORT dm + +#define DEFINEDIV + +#include "op-dm-template.cc" + diff -r d02b229ce693 -r a132d206a36a src/operators/op-m-m.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-m-m.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,223 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix unary ops. + +DEFNDUNOP_OP (not, matrix, array, !) +DEFNDUNOP_OP (uplus, matrix, array, /* no-op */) +DEFNDUNOP_OP (uminus, matrix, array, -) + +DEFUNOP (transpose, matrix) +{ + CAST_UNOP_ARG (const octave_matrix&); + + if (v.ndims () > 2) + { + error ("transpose not defined for N-d objects"); + return octave_value (); + } + else + return octave_value (v.matrix_value ().transpose ()); +} + +DEFNCUNOP_METHOD (incr, matrix, increment) +DEFNCUNOP_METHOD (decr, matrix, decrement) +DEFNCUNOP_METHOD (changesign, matrix, changesign) + +// matrix by matrix ops. + +DEFNDBINOP_OP (add, matrix, matrix, array, array, +) +DEFNDBINOP_OP (sub, matrix, matrix, array, array, -) + +DEFBINOP_OP (mul, matrix, matrix, *) + +DEFBINOP (div, matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + MatrixType typ = v2.matrix_type (); + + Matrix ret = xdiv (v1.matrix_value (), v2.matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOPX (pow, matrix, matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + MatrixType typ = v1.matrix_type (); + + Matrix ret = xleftdiv (v1.matrix_value (), v2.matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP (trans_mul, matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + return octave_value(xgemm (v1.matrix_value (), v2.matrix_value (), + blas_trans, blas_no_trans)); +} + +DEFBINOP (mul_trans, matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + return octave_value(xgemm (v1.matrix_value (), v2.matrix_value (), + blas_no_trans, blas_trans)); +} + +DEFBINOP (trans_ldiv, matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + MatrixType typ = v1.matrix_type (); + + Matrix ret = xleftdiv (v1.matrix_value (), v2.matrix_value (), typ, blas_trans); + + v1.matrix_type (typ); + return ret; +} + +DEFNDBINOP_FN (lt, matrix, matrix, array, array, mx_el_lt) +DEFNDBINOP_FN (le, matrix, matrix, array, array, mx_el_le) +DEFNDBINOP_FN (eq, matrix, matrix, array, array, mx_el_eq) +DEFNDBINOP_FN (ge, matrix, matrix, array, array, mx_el_ge) +DEFNDBINOP_FN (gt, matrix, matrix, array, array, mx_el_gt) +DEFNDBINOP_FN (ne, matrix, matrix, array, array, mx_el_ne) + +DEFNDBINOP_FN (el_mul, matrix, matrix, array, array, product) +DEFNDBINOP_FN (el_div, matrix, matrix, array, array, quotient) +DEFNDBINOP_FN (el_pow, matrix, matrix, array, array, elem_xpow) + +DEFBINOP (el_ldiv, matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + return octave_value (quotient (v2.array_value (), v1.array_value ())); +} + +DEFNDBINOP_FN (el_and, matrix, matrix, array, array, mx_el_and) +DEFNDBINOP_FN (el_or, matrix, matrix, array, array, mx_el_or) +DEFNDBINOP_FN (el_not_and, matrix, matrix, array, array, mx_el_not_and) +DEFNDBINOP_FN (el_not_or, matrix, matrix, array, array, mx_el_not_or) +DEFNDBINOP_FN (el_and_not, matrix, matrix, array, array, mx_el_and_not) +DEFNDBINOP_FN (el_or_not, matrix, matrix, array, array, mx_el_or_not) + + +DEFNDCATOP_FN (m_m, matrix, matrix, array, array, concat) + +DEFNDASSIGNOP_FN (assign, matrix, matrix, array, assign) +DEFNDASSIGNOP_FN (sgl_assign, float_matrix, matrix, float_array, assign) + +DEFNULLASSIGNOP_FN (null_assign, matrix, delete_elements) + +DEFNDASSIGNOP_OP (assign_add, matrix, matrix, array, +=) +DEFNDASSIGNOP_OP (assign_sub, matrix, matrix, array, -=) +DEFNDASSIGNOP_FNOP (assign_el_mul, matrix, matrix, array, product_eq) +DEFNDASSIGNOP_FNOP (assign_el_div, matrix, matrix, array, quotient_eq) + +CONVDECL (matrix_to_float_matrix) +{ + CAST_CONV_ARG (const octave_matrix&); + + return new octave_float_matrix (FloatNDArray (v.array_value ())); +} + +void +install_m_m_ops (void) +{ + INSTALL_UNOP (op_not, octave_matrix, not); + INSTALL_UNOP (op_uplus, octave_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_matrix, transpose); + + INSTALL_NCUNOP (op_incr, octave_matrix, incr); + INSTALL_NCUNOP (op_decr, octave_matrix, decr); + INSTALL_NCUNOP (op_uminus, octave_matrix, changesign); + + INSTALL_BINOP (op_add, octave_matrix, octave_matrix, add); + INSTALL_BINOP (op_sub, octave_matrix, octave_matrix, sub); + INSTALL_BINOP (op_mul, octave_matrix, octave_matrix, mul); + INSTALL_BINOP (op_div, octave_matrix, octave_matrix, div); + INSTALL_BINOP (op_pow, octave_matrix, octave_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_matrix, octave_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_matrix, octave_matrix, lt); + INSTALL_BINOP (op_le, octave_matrix, octave_matrix, le); + INSTALL_BINOP (op_eq, octave_matrix, octave_matrix, eq); + INSTALL_BINOP (op_ge, octave_matrix, octave_matrix, ge); + INSTALL_BINOP (op_gt, octave_matrix, octave_matrix, gt); + INSTALL_BINOP (op_ne, octave_matrix, octave_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_matrix, octave_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_matrix, octave_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_matrix, octave_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_matrix, octave_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_matrix, octave_matrix, el_or); + INSTALL_BINOP (op_el_and_not, octave_matrix, octave_matrix, el_and_not); + INSTALL_BINOP (op_el_or_not, octave_matrix, octave_matrix, el_or_not); + INSTALL_BINOP (op_el_not_and, octave_matrix, octave_matrix, el_not_and); + INSTALL_BINOP (op_el_not_or, octave_matrix, octave_matrix, el_not_or); + INSTALL_BINOP (op_trans_mul, octave_matrix, octave_matrix, trans_mul); + INSTALL_BINOP (op_mul_trans, octave_matrix, octave_matrix, mul_trans); + INSTALL_BINOP (op_herm_mul, octave_matrix, octave_matrix, trans_mul); + INSTALL_BINOP (op_mul_herm, octave_matrix, octave_matrix, mul_trans); + INSTALL_BINOP (op_trans_ldiv, octave_matrix, octave_matrix, trans_ldiv); + INSTALL_BINOP (op_herm_ldiv, octave_matrix, octave_matrix, trans_ldiv); + + INSTALL_CATOP (octave_matrix, octave_matrix, m_m); + + INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_matrix, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_matrix, sgl_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_null_matrix, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_null_str, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_null_sq_str, null_assign); + + INSTALL_ASSIGNOP (op_add_eq, octave_matrix, octave_matrix, assign_add); + INSTALL_ASSIGNOP (op_sub_eq, octave_matrix, octave_matrix, assign_sub); + INSTALL_ASSIGNOP (op_el_mul_eq, octave_matrix, octave_matrix, assign_el_mul); + INSTALL_ASSIGNOP (op_el_div_eq, octave_matrix, octave_matrix, assign_el_div); + + INSTALL_CONVOP (octave_matrix, octave_float_matrix, matrix_to_float_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-m-pm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-m-pm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,33 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define MINCLUDE "ov-re-mat.h" + +#define LMATRIX matrix +#define RMATRIX perm_matrix + +#define LSHORT m +#define RSHORT pm + +#define RIGHT + +#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/operators/op-m-s.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-m-s.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,155 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix by scalar ops. + +DEFNDBINOP_OP (add, matrix, scalar, array, scalar, +) +DEFNDBINOP_OP (sub, matrix, scalar, array, scalar, -) +DEFNDBINOP_OP (mul, matrix, scalar, array, scalar, *) + +DEFBINOP (div, matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.array_value () / d); +} + +DEFBINOP_FN (pow, matrix, scalar, xpow) + +DEFBINOP (ldiv, matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + Matrix m1 = v1.matrix_value (); + Matrix m2 = v2.matrix_value (); + MatrixType typ = v1.matrix_type (); + + Matrix ret = xleftdiv (m1, m2, typ); + + v1.matrix_type (typ); + return ret; +} + +DEFNDBINOP_FN (lt, matrix, scalar, array, scalar, mx_el_lt) +DEFNDBINOP_FN (le, matrix, scalar, array, scalar, mx_el_le) +DEFNDBINOP_FN (eq, matrix, scalar, array, scalar, mx_el_eq) +DEFNDBINOP_FN (ge, matrix, scalar, array, scalar, mx_el_ge) +DEFNDBINOP_FN (gt, matrix, scalar, array, scalar, mx_el_gt) +DEFNDBINOP_FN (ne, matrix, scalar, array, scalar, mx_el_ne) + +DEFNDBINOP_OP (el_mul, matrix, scalar, array, scalar, *) + +DEFBINOP (el_div, matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.array_value () / d); +} + +DEFNDBINOP_FN (el_pow, matrix, scalar, array, scalar, elem_xpow) + +DEFBINOP (el_ldiv, matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + return x_el_div (v2.double_value (), v1.array_value ()); +} + +DEFNDBINOP_FN (el_and, matrix, scalar, array, scalar, mx_el_and) +DEFNDBINOP_FN (el_or, matrix, scalar, array, scalar, mx_el_or) + +DEFNDCATOP_FN (m_s, matrix, scalar, array, array, concat) + +DEFNDASSIGNOP_FN (assign, matrix, scalar, scalar, assign) +DEFNDASSIGNOP_FN (sgl_assign, float_matrix, scalar, float_scalar, assign) +DEFNDASSIGNOP_FN (clx_sgl_assign, float_complex_matrix, scalar, float_complex, assign) + +DEFNDASSIGNOP_OP (assign_add, matrix, scalar, scalar, +=) +DEFNDASSIGNOP_OP (assign_sub, matrix, scalar, scalar, -=) +DEFNDASSIGNOP_OP (assign_mul, matrix, scalar, scalar, *=) +DEFNDASSIGNOP_OP (assign_div, matrix, scalar, scalar, /=) + +void +install_m_s_ops (void) +{ + INSTALL_BINOP (op_add, octave_matrix, octave_scalar, add); + INSTALL_BINOP (op_sub, octave_matrix, octave_scalar, sub); + INSTALL_BINOP (op_mul, octave_matrix, octave_scalar, mul); + INSTALL_BINOP (op_div, octave_matrix, octave_scalar, div); + INSTALL_BINOP (op_pow, octave_matrix, octave_scalar, pow); + INSTALL_BINOP (op_ldiv, octave_matrix, octave_scalar, ldiv); + + // INSTALL_BINOP (op_lt, octave_matrix, octave_scalar, lt); + + octave_value_typeinfo::register_binary_op + (octave_value::op_lt, octave_matrix::static_type_id (), + octave_scalar::static_type_id (), oct_binop_lt); + + INSTALL_BINOP (op_le, octave_matrix, octave_scalar, le); + INSTALL_BINOP (op_eq, octave_matrix, octave_scalar, eq); + INSTALL_BINOP (op_ge, octave_matrix, octave_scalar, ge); + INSTALL_BINOP (op_gt, octave_matrix, octave_scalar, gt); + INSTALL_BINOP (op_ne, octave_matrix, octave_scalar, ne); + INSTALL_BINOP (op_el_mul, octave_matrix, octave_scalar, el_mul); + INSTALL_BINOP (op_el_div, octave_matrix, octave_scalar, el_div); + INSTALL_BINOP (op_el_pow, octave_matrix, octave_scalar, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_scalar, el_ldiv); + INSTALL_BINOP (op_el_and, octave_matrix, octave_scalar, el_and); + INSTALL_BINOP (op_el_or, octave_matrix, octave_scalar, el_or); + + INSTALL_CATOP (octave_matrix, octave_scalar, m_s); + + INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_scalar, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_scalar, sgl_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_scalar, clx_sgl_assign); + + INSTALL_ASSIGNOP (op_add_eq, octave_matrix, octave_scalar, assign_add); + INSTALL_ASSIGNOP (op_sub_eq, octave_matrix, octave_scalar, assign_sub); + INSTALL_ASSIGNOP (op_mul_eq, octave_matrix, octave_scalar, assign_mul); + INSTALL_ASSIGNOP (op_div_eq, octave_matrix, octave_scalar, assign_div); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-m-scm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-m-scm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,175 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-re-mat.h" +#include "ov-cx-mat.h" +#include "ops.h" +#include "xdiv.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "smx-scm-m.h" +#include "smx-m-scm.h" +#include "ov-cx-sparse.h" + +// matrix by sparse complex matrix ops. + +DEFBINOP_OP (add, matrix, sparse_complex_matrix, +) +DEFBINOP_OP (sub, matrix, sparse_complex_matrix, -) + +DEFBINOP_OP (mul, matrix, sparse_complex_matrix, *) + +DEFBINOP (div, matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.array_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.matrix_value (), + v2.sparse_complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOPX (pow, matrix, sparse_complex_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, + const octave_sparse_complex_matrix&); + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.matrix_value (), + v2.complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (lt, matrix, sparse_complex_matrix, mx_el_lt) +DEFBINOP_FN (le, matrix, sparse_complex_matrix, mx_el_le) +DEFBINOP_FN (eq, matrix, sparse_complex_matrix, mx_el_eq) +DEFBINOP_FN (ge, matrix, sparse_complex_matrix, mx_el_ge) +DEFBINOP_FN (gt, matrix, sparse_complex_matrix, mx_el_gt) +DEFBINOP_FN (ne, matrix, sparse_complex_matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, matrix, sparse_complex_matrix, product) +DEFBINOP_FN (el_div, matrix, sparse_complex_matrix, quotient) + +DEFBINOP (el_pow, matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, + const octave_sparse_complex_matrix&); + + return octave_value + (elem_xpow (SparseMatrix (v1.matrix_value ()), + v2.sparse_complex_matrix_value ())); +} + +DEFBINOP (el_ldiv, matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, + const octave_sparse_complex_matrix&); + return octave_value + (quotient (v2.sparse_complex_matrix_value (), v1.matrix_value ())); +} + +DEFBINOP_FN (el_and, matrix, sparse_complex_matrix, mx_el_and) +DEFBINOP_FN (el_or, matrix, sparse_complex_matrix, mx_el_or) + +DEFCATOP (m_scm, matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (octave_matrix&, const octave_sparse_complex_matrix&); + SparseMatrix tmp (v1.matrix_value ()); + return octave_value (tmp. concat (v2.sparse_complex_matrix_value (), + ra_idx)); +} + +DEFCONV (sparse_complex_matrix_conv, matrix, sparse_complex_matrix) +{ + CAST_CONV_ARG (const octave_matrix&); + return new octave_sparse_complex_matrix + (SparseComplexMatrix (v.complex_matrix_value ())); +} + +void +install_m_scm_ops (void) +{ + INSTALL_BINOP (op_add, octave_matrix, octave_sparse_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_matrix, octave_sparse_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_matrix, octave_sparse_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_matrix, octave_sparse_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_matrix, octave_sparse_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_matrix, octave_sparse_complex_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_matrix, octave_sparse_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_matrix, octave_sparse_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_matrix, octave_sparse_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_matrix, octave_sparse_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_matrix, octave_sparse_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_matrix, octave_sparse_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_matrix, octave_sparse_complex_matrix, + el_mul); + INSTALL_BINOP (op_el_div, octave_matrix, octave_sparse_complex_matrix, + el_div); + INSTALL_BINOP (op_el_pow, octave_matrix, octave_sparse_complex_matrix, + el_pow); + INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_sparse_complex_matrix, + el_ldiv); + INSTALL_BINOP (op_el_and, octave_matrix, octave_sparse_complex_matrix, + el_and); + INSTALL_BINOP (op_el_or, octave_matrix, octave_sparse_complex_matrix, + el_or); + + INSTALL_CATOP (octave_matrix, octave_sparse_complex_matrix, m_scm); + + INSTALL_ASSIGNCONV (octave_matrix, octave_sparse_complex_matrix, + octave_complex_matrix); + + INSTALL_WIDENOP (octave_matrix, octave_sparse_complex_matrix, + sparse_complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-m-sm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-m-sm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,167 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-re-mat.h" +#include "ops.h" +#include "xdiv.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "smx-sm-m.h" +#include "smx-m-sm.h" +#include "ov-re-sparse.h" + +// matrix by sparse matrix ops. + +DEFBINOP_OP (add, matrix, sparse_matrix, +) +DEFBINOP_OP (sub, matrix, sparse_matrix, -) + +DEFBINOP_OP (mul, matrix, sparse_matrix, *) + +DEFBINOP (div, matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + double d = v2.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.array_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + + Matrix ret = xdiv (v1.matrix_value (), v2.sparse_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOPX (pow, matrix, sparse_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_matrix&); + MatrixType typ = v1.matrix_type (); + + Matrix ret = xleftdiv (v1.matrix_value (), v2.matrix_value (), typ); + + v1.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (mul_trans, matrix, sparse_matrix, mul_trans); + +DEFBINOP_FN (lt, matrix, sparse_matrix, mx_el_lt) +DEFBINOP_FN (le, matrix, sparse_matrix, mx_el_le) +DEFBINOP_FN (eq, matrix, sparse_matrix, mx_el_eq) +DEFBINOP_FN (ge, matrix, sparse_matrix, mx_el_ge) +DEFBINOP_FN (gt, matrix, sparse_matrix, mx_el_gt) +DEFBINOP_FN (ne, matrix, sparse_matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, matrix, sparse_matrix, product) +DEFBINOP_FN (el_div, matrix, sparse_matrix, quotient) + +DEFBINOP (el_pow, matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_matrix&); + + return octave_value (elem_xpow (SparseMatrix (v1.matrix_value ()), + v2.sparse_matrix_value ())); +} + +DEFBINOP (el_ldiv, matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_sparse_matrix&); + + return octave_value + (quotient (v2.sparse_matrix_value (), v1.matrix_value ())); +} + +DEFBINOP_FN (el_and, matrix, sparse_matrix, mx_el_and) +DEFBINOP_FN (el_or, matrix, sparse_matrix, mx_el_or) + +DEFCATOP (m_sm, matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (octave_matrix&, const octave_sparse_matrix&); + SparseMatrix tmp (v1.matrix_value ()); + return octave_value (tmp. concat (v2.sparse_matrix_value (), ra_idx)); +} + +DEFCONV (sparse_matrix_conv, matrix, sparse_matrix) +{ + CAST_CONV_ARG (const octave_matrix&); + return new octave_sparse_matrix (SparseMatrix (v.matrix_value ())); +} + +DEFNDASSIGNOP_FN (assign, matrix, sparse_matrix, array, assign) + +void +install_m_sm_ops (void) +{ + INSTALL_BINOP (op_add, octave_matrix, octave_sparse_matrix, add); + INSTALL_BINOP (op_sub, octave_matrix, octave_sparse_matrix, sub); + INSTALL_BINOP (op_mul, octave_matrix, octave_sparse_matrix, mul); + INSTALL_BINOP (op_div, octave_matrix, octave_sparse_matrix, div); + INSTALL_BINOP (op_pow, octave_matrix, octave_sparse_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_matrix, octave_sparse_matrix, ldiv); + INSTALL_BINOP (op_mul_trans, octave_matrix, octave_sparse_matrix, mul_trans); + INSTALL_BINOP (op_mul_herm, octave_matrix, octave_sparse_matrix, mul_trans); + INSTALL_BINOP (op_lt, octave_matrix, octave_sparse_matrix, lt); + INSTALL_BINOP (op_le, octave_matrix, octave_sparse_matrix, le); + INSTALL_BINOP (op_eq, octave_matrix, octave_sparse_matrix, eq); + INSTALL_BINOP (op_ge, octave_matrix, octave_sparse_matrix, ge); + INSTALL_BINOP (op_gt, octave_matrix, octave_sparse_matrix, gt); + INSTALL_BINOP (op_ne, octave_matrix, octave_sparse_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_matrix, octave_sparse_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_matrix, octave_sparse_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_matrix, octave_sparse_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_matrix, octave_sparse_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_matrix, octave_sparse_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_matrix, octave_sparse_matrix, el_or); + + INSTALL_CATOP (octave_matrix, octave_sparse_matrix, m_sm); + + INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_sparse_matrix, assign) + INSTALL_ASSIGNCONV (octave_matrix, octave_sparse_matrix, octave_matrix) + + INSTALL_WIDENOP (octave_matrix, octave_sparse_matrix, + sparse_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-pm-cm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-pm-cm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,33 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define MINCLUDE "ov-cx-mat.h" + +#define LMATRIX perm_matrix +#define RMATRIX complex_matrix + +#define LSHORT pm +#define RSHORT cm + +#define LEFT + +#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/operators/op-pm-fcm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-pm-fcm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,33 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define MINCLUDE "ov-flt-cx-mat.h" + +#define LMATRIX perm_matrix +#define RMATRIX float_complex_matrix + +#define LSHORT pm +#define RSHORT fcm + +#define LEFT + +#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/operators/op-pm-fm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-pm-fm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,33 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define MINCLUDE "ov-flt-re-mat.h" + +#define LMATRIX perm_matrix +#define RMATRIX float_matrix + +#define LSHORT pm +#define RSHORT fm + +#define LEFT + +#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/operators/op-pm-m.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-pm-m.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#define MINCLUDE "ov-re-mat.h" + +#define LMATRIX perm_matrix +#define LDMATRIX matrix +#define RMATRIX matrix + +#define LSHORT pm +#define RSHORT m + +#define LEFT +#define DEFINENULLASSIGNCONV + +#include "op-pm-template.cc" diff -r d02b229ce693 -r a132d206a36a src/operators/op-pm-pm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-pm-pm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,87 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-perm.h" +#include "ov-re-mat.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xpow.h" + +DEFUNOP (transpose, perm_matrix) +{ + CAST_UNOP_ARG (const octave_perm_matrix&); + return octave_value (v.perm_matrix_value ().transpose ()); +} + +DEFBINOP_OP (mul, perm_matrix, perm_matrix, *) + +DEFBINOP (div, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + + return (v1.perm_matrix_value () * v2.perm_matrix_value ().inverse ()); +} + +DEFBINOP (ldiv, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + + return (v1.perm_matrix_value ().inverse () * v2.perm_matrix_value ()); +} + +DEFBINOP (pow, perm_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_scalar&); + + return xpow (v1.perm_matrix_value (), v2.scalar_value ()); +} + +CONVDECL (perm_matrix_to_matrix) +{ + CAST_CONV_ARG (const octave_perm_matrix&); + + return new octave_matrix (v.matrix_value ()); +} + +void +install_pm_pm_ops (void) +{ + INSTALL_UNOP (op_transpose, octave_perm_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_perm_matrix, transpose); + + INSTALL_BINOP (op_mul, octave_perm_matrix, octave_perm_matrix, mul); + INSTALL_BINOP (op_div, octave_perm_matrix, octave_perm_matrix, div); + INSTALL_BINOP (op_ldiv, octave_perm_matrix, octave_perm_matrix, ldiv); + INSTALL_BINOP (op_pow, octave_perm_matrix, octave_scalar, pow); + + INSTALL_CONVOP (octave_perm_matrix, octave_matrix, perm_matrix_to_matrix); + INSTALL_ASSIGNCONV (octave_perm_matrix, octave_matrix, octave_matrix); + INSTALL_WIDENOP (octave_perm_matrix, octave_matrix, perm_matrix_to_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-pm-scm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-pm-scm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,97 @@ +/* + +Copyright (C) 2009-2012 Jason Riedy + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ops.h" + +#include "ov-perm.h" +#include "ov-cx-sparse.h" + +// permutation matrix by sparse matrix ops + +DEFBINOP (mul_pm_scm, perm_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + std::complex d = v2.complex_value (); + + return octave_value (v1.sparse_matrix_value () * d); + } + else if (v1.rows () == 1 && v1.columns () == 1) + return octave_value (v2.sparse_complex_matrix_value ()); + else + return v1.perm_matrix_value () * v2.sparse_complex_matrix_value (); +} + +DEFBINOP (ldiv_pm_scm, perm_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_sparse_complex_matrix&); + + return v1.perm_matrix_value ().inverse () * v2.sparse_complex_matrix_value (); +} + +// sparse matrix by diagonal matrix ops + +DEFBINOP (mul_scm_pm, sparse_complex_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_perm_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + std::complex d = v1.scalar_value (); + + return octave_value (d * v2.sparse_matrix_value ()); + } + else if (v2.rows () == 1 && v2.columns () == 1) + return octave_value (v1.sparse_complex_matrix_value ()); + else + return v1.sparse_complex_matrix_value () * v2.perm_matrix_value (); +} + +DEFBINOP (div_scm_pm, sparse_complex_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_perm_matrix&); + + return v1.sparse_complex_matrix_value () * v2.perm_matrix_value ().inverse (); +} + +void +install_pm_scm_ops (void) +{ + INSTALL_BINOP (op_mul, octave_perm_matrix, octave_sparse_complex_matrix, + mul_pm_scm); + INSTALL_BINOP (op_ldiv, octave_perm_matrix, octave_sparse_complex_matrix, + ldiv_pm_scm); + INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_perm_matrix, + mul_scm_pm); + INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_perm_matrix, + div_scm_pm); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-pm-sm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-pm-sm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,150 @@ +/* + +Copyright (C) 2009-2012 Jason Riedy + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ops.h" + +#include "ov-perm.h" +#include "ov-re-sparse.h" +#include "ov-bool-sparse.h" + +// Unary permutation ops, some cast to sparse + +//Avoid casting to a full matrix +DEFUNOP_OP (uplus, perm_matrix, /* no-op */) + +// Not calling standard CAST_UNOP_ARG for these next two because a +// dynamic_cast would fail. +DEFUNOP (not, perm_matrix) +{ + // Obviously negation of a permutation matrix destroys sparsity + return octave_value ( ! a.bool_array_value ()); +} + +DEFUNOP (uminus, perm_matrix) +{ + return octave_value ( - a.sparse_matrix_value ()); +} + +// Most other logical operations cast to SparseBoolMatrix +DEFBINOP (eq_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return v1.sparse_bool_matrix_value () == v2.sparse_bool_matrix_value (); +} +DEFBINOP (ne_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return v1.sparse_bool_matrix_value () != v2.sparse_bool_matrix_value (); +} +DEFBINOP (el_and_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return mx_el_and(v1.sparse_bool_matrix_value (), + v2.sparse_bool_matrix_value ()); +} +DEFBINOP (el_or_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return mx_el_or(v1.sparse_bool_matrix_value (), + v2.sparse_bool_matrix_value ()); +} + +// permutation matrix by sparse matrix ops + +DEFBINOP (mul_pm_sm, perm_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + double d = v2.scalar_value (); + + return octave_value (v1.sparse_matrix_value () * d); + } + else if (v1.rows () == 1 && v1.columns () == 1) + return octave_value (v2.sparse_matrix_value ()); + else + return v1.perm_matrix_value () * v2.sparse_matrix_value (); +} + +DEFBINOP (ldiv_pm_sm, perm_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_sparse_matrix&); + + return v1.perm_matrix_value ().inverse () * v2.sparse_matrix_value (); +} + +// sparse matrix by diagonal matrix ops + +DEFBINOP (mul_sm_pm, sparse_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_perm_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + double d = v1.scalar_value (); + + return octave_value (d * v2.sparse_matrix_value ()); + } + else if (v2.rows () == 1 && v2.columns () == 1) + return octave_value (v1.sparse_matrix_value ()); + else + return v1.sparse_matrix_value () * v2.perm_matrix_value (); +} + +DEFBINOP (div_sm_pm, sparse_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_perm_matrix&); + + return v1.sparse_matrix_value () * v2.perm_matrix_value ().inverse (); +} + +void +install_pm_sm_ops (void) +{ + INSTALL_UNOP (op_not, octave_perm_matrix, not); + INSTALL_UNOP (op_uplus, octave_perm_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_perm_matrix, uminus); + + + INSTALL_BINOP (op_mul, octave_perm_matrix, octave_sparse_matrix, + mul_pm_sm); + INSTALL_BINOP (op_ldiv, octave_perm_matrix, octave_sparse_matrix, + ldiv_pm_sm); + INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_perm_matrix, + mul_sm_pm); + INSTALL_BINOP (op_div, octave_sparse_matrix, octave_perm_matrix, + div_sm_pm); + + INSTALL_BINOP (op_eq, octave_perm_matrix, octave_perm_matrix, eq_pm); + INSTALL_BINOP (op_ne, octave_perm_matrix, octave_perm_matrix, ne_pm); + INSTALL_BINOP (op_el_and, octave_perm_matrix, octave_perm_matrix, el_and_pm); + INSTALL_BINOP (op_el_or, octave_perm_matrix, octave_perm_matrix, el_or_pm); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-pm-template.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-pm-template.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,90 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "ov-perm.h" +#include MINCLUDE +#include "ops.h" +#ifdef DEFINENULLASSIGNCONV +#include "ov-null-mat.h" +#endif + +#ifndef LDMATRIX +#define LDMATRIX LMATRIX +#endif + +#define OCTAVE_LMATRIX CONCAT2(octave_, LMATRIX) +#define OCTAVE_LDMATRIX CONCAT2(octave_, LDMATRIX) +#define OCTAVE_RMATRIX CONCAT2(octave_, RMATRIX) +#ifdef LEFT +#define LMATRIX_VALUE perm_matrix_value +#define RMATRIX_VALUE CONCAT2(RMATRIX, _value) +#else +#define LMATRIX_VALUE CONCAT2(LMATRIX, _value) +#define RMATRIX_VALUE perm_matrix_value +#endif + +DEFBINOP (mul, LMATRIX, RMATRIX) +{ + CAST_BINOP_ARGS (const OCTAVE_LMATRIX&, const OCTAVE_RMATRIX&); + + return v1.LMATRIX_VALUE () * v2.RMATRIX_VALUE (); +} + +#ifdef LEFT +DEFBINOP (ldiv, LMATRIX, RMATRIX) +{ + CAST_BINOP_ARGS (const OCTAVE_LMATRIX&, const OCTAVE_RMATRIX&); + + return v1.perm_matrix_value ().inverse () * v2.RMATRIX_VALUE (); +} +#else +DEFBINOP (div, LMATRIX, RMATRIX) +{ + CAST_BINOP_ARGS (const OCTAVE_LMATRIX&, const OCTAVE_RMATRIX&); + + return v1.LMATRIX_VALUE () * v2.perm_matrix_value ().inverse (); +} +#endif + + +#define SHORT_NAME CONCAT3(LSHORT, _, RSHORT) +#define INST_NAME CONCAT3(install_, SHORT_NAME, _ops) + +void +INST_NAME (void) +{ + INSTALL_BINOP (op_mul, OCTAVE_LMATRIX, OCTAVE_RMATRIX, mul); +#ifdef LEFT + INSTALL_BINOP (op_ldiv, OCTAVE_LMATRIX, OCTAVE_RMATRIX, ldiv); +#else + INSTALL_BINOP (op_div, OCTAVE_LMATRIX, OCTAVE_RMATRIX, div); +#endif +#ifdef DEFINENULLASSIGNCONV + INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_matrix, OCTAVE_LDMATRIX); + INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_str, OCTAVE_LDMATRIX); + INSTALL_ASSIGNCONV (OCTAVE_LMATRIX, octave_null_sq_str, OCTAVE_LDMATRIX); +#endif +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-range.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-range.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,142 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-range.h" +#include "ov-ch-mat.h" +#include "ov-scalar.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ov-bool.h" +#include "ov-bool-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xpow.h" + +// range unary ops. + +DEFUNOP (not, range) +{ + CAST_UNOP_ARG (const octave_range&); + + return octave_value (! v.matrix_value ()); +} + +DEFUNOP_OP (uplus, range, /* no-op */) +DEFUNOP_OP (uminus, range, -) + +DEFUNOP (transpose, range) +{ + CAST_UNOP_ARG (const octave_range&); + + return octave_value (v.matrix_value ().transpose ()); +} + +DEFBINOP_OP (addrs, range, scalar, +) +DEFBINOP_OP (addsr, scalar, range, +) +DEFBINOP_OP (subrs, range, scalar, -) +DEFBINOP_OP (subsr, scalar, range, -) +DEFBINOP_OP (mulrs, range, scalar, *) +DEFBINOP_OP (mulsr, scalar, range, *) + +DEFBINOP_FN (el_powsr, scalar, range, elem_xpow) +DEFBINOP_FN (el_powcsr, complex, range, elem_xpow) + +DEFNDCATOP_FN (r_r, range, range, array, array, concat) +DEFNDCATOP_FN (r_s, range, scalar, array, array, concat) +DEFNDCATOP_FN (r_m, range, matrix, array, array, concat) +DEFNDCATOP_FN (r_cs, range, complex, array, complex_array, concat) +DEFNDCATOP_FN (r_cm, range, complex_matrix, array, complex_array, concat) +DEFNDCATOP_FN (r_b, range, bool, array, array, concat) +DEFNDCATOP_FN (r_bm, range, bool_matrix, array, array, concat) +DEFNDCATOP_FN (r_chm, range, char_matrix, array, char_array, concat) +DEFNDCATOP_FN (s_r, scalar, range, array, array, concat) +DEFNDCATOP_FN (m_r, matrix, range, array, array, concat) +DEFNDCATOP_FN (cs_r, complex, range, complex_array, array, concat) +DEFNDCATOP_FN (cm_r, complex_matrix, range, complex_array, array, concat) +DEFNDCATOP_FN (b_r, bool, range, array, array, concat) +DEFNDCATOP_FN (bm_r, bool_matrix, range, array, array, concat) +DEFNDCATOP_FN (chm_r, char_matrix, range, char_array, array, concat) + +CONVDECL (range_to_matrix) +{ + CAST_CONV_ARG (const octave_range&); + + return new octave_matrix (v.array_value ()); +} + +void +install_range_ops (void) +{ + INSTALL_UNOP (op_not, octave_range, not); + INSTALL_UNOP (op_uplus, octave_range, uplus); + INSTALL_UNOP (op_uminus, octave_range, uminus); + INSTALL_UNOP (op_transpose, octave_range, transpose); + INSTALL_UNOP (op_hermitian, octave_range, transpose); + + INSTALL_BINOP (op_add, octave_range, octave_scalar, addrs); + INSTALL_BINOP (op_add, octave_scalar, octave_range, addsr); + INSTALL_BINOP (op_sub, octave_range, octave_scalar, subrs); + INSTALL_BINOP (op_sub, octave_scalar, octave_range, subsr); + INSTALL_BINOP (op_mul, octave_range, octave_scalar, mulrs); + INSTALL_BINOP (op_mul, octave_scalar, octave_range, mulsr); + + INSTALL_BINOP (op_el_pow, octave_scalar, octave_range, el_powsr); + INSTALL_BINOP (op_el_pow, octave_complex, octave_range, el_powcsr); + + INSTALL_CATOP (octave_range, octave_range, r_r); + INSTALL_CATOP (octave_range, octave_scalar, r_s); + INSTALL_CATOP (octave_range, octave_matrix, r_m); + INSTALL_CATOP (octave_range, octave_complex, r_cs); + INSTALL_CATOP (octave_range, octave_complex_matrix, r_cm); + INSTALL_CATOP (octave_range, octave_bool, r_b); + INSTALL_CATOP (octave_range, octave_bool_matrix, r_bm); + INSTALL_CATOP (octave_range, octave_char_matrix, r_chm); + INSTALL_CATOP (octave_scalar, octave_range, s_r); + INSTALL_CATOP (octave_matrix, octave_range, m_r); + INSTALL_CATOP (octave_complex, octave_range, cs_r); + INSTALL_CATOP (octave_complex_matrix, octave_range, cm_r); + INSTALL_CATOP (octave_bool, octave_range, b_r); + INSTALL_CATOP (octave_bool_matrix, octave_range, bm_r); + INSTALL_CATOP (octave_char_matrix, octave_range, chm_r); + + // FIXME -- this would be unneccessary if + // octave_base_value::numeric_assign always tried converting lhs + // before rhs. + + INSTALL_ASSIGNCONV (octave_range, octave_null_matrix, octave_matrix); + INSTALL_ASSIGNCONV (octave_range, octave_null_str, octave_matrix); + INSTALL_ASSIGNCONV (octave_range, octave_null_sq_str, octave_matrix); + + // However, this should probably be here just in case we need it. + + INSTALL_WIDENOP (octave_range, octave_matrix, range_to_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-s-cm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-s-cm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,142 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-s-cm.h" +#include "mx-cm-s.h" +#include "mx-s-cnda.h" +#include "mx-cnda-s.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar by complex matrix ops. + +DEFNDBINOP_OP (add, scalar, complex_matrix, scalar, complex_array, +) +DEFNDBINOP_OP (sub, scalar, complex_matrix, scalar, complex_array, -) +DEFNDBINOP_OP (mul, scalar, complex_matrix, scalar, complex_array, *) + +DEFBINOP (div, scalar, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + Matrix m1 = v1.matrix_value (); + ComplexMatrix m2 = v2.complex_matrix_value (); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (pow, scalar, complex_matrix, xpow) + +DEFBINOP (ldiv, scalar, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_array_value () / d); +} + +DEFNDCMPLXCMPOP_FN (lt, scalar, complex_matrix, scalar, complex_array, mx_el_lt) +DEFNDCMPLXCMPOP_FN (le, scalar, complex_matrix, scalar, complex_array, mx_el_le) +DEFNDCMPLXCMPOP_FN (eq, scalar, complex_matrix, scalar, complex_array, mx_el_eq) +DEFNDCMPLXCMPOP_FN (ge, scalar, complex_matrix, scalar, complex_array, mx_el_ge) +DEFNDCMPLXCMPOP_FN (gt, scalar, complex_matrix, scalar, complex_array, mx_el_gt) +DEFNDCMPLXCMPOP_FN (ne, scalar, complex_matrix, scalar, complex_array, mx_el_ne) + +DEFNDBINOP_OP (el_mul, scalar, complex_matrix, scalar, complex_array, *) +DEFNDBINOP_FN (el_div, scalar, complex_matrix, scalar, complex_array, x_el_div) +DEFNDBINOP_FN (el_pow, scalar, complex_matrix, scalar, complex_array, elem_xpow) + +DEFBINOP (el_ldiv, scalar, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_array_value () / d); +} + +DEFNDBINOP_FN (el_and, scalar, complex_matrix, scalar, complex_array, mx_el_and) +DEFNDBINOP_FN (el_or, scalar, complex_matrix, scalar, complex_array, mx_el_or) + +DEFNDCATOP_FN (s_cm, scalar, complex_matrix, array, complex_array, concat) + +DEFCONV (complex_matrix_conv, scalar, complex_matrix) +{ + CAST_CONV_ARG (const octave_scalar&); + + return new octave_complex_matrix (ComplexMatrix (v.matrix_value ())); +} + +void +install_s_cm_ops (void) +{ + INSTALL_BINOP (op_add, octave_scalar, octave_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_scalar, octave_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_scalar, octave_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_scalar, octave_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_scalar, octave_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_scalar, octave_complex_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_scalar, octave_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_scalar, octave_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_scalar, octave_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_scalar, octave_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_scalar, octave_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_scalar, octave_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_scalar, octave_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_scalar, octave_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_scalar, octave_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_scalar, octave_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_scalar, octave_complex_matrix, el_or); + + INSTALL_CATOP (octave_scalar, octave_complex_matrix, s_cm); + + INSTALL_ASSIGNCONV (octave_scalar, octave_complex_matrix, octave_complex_matrix); + INSTALL_ASSIGNCONV (octave_float_scalar, octave_complex_matrix, octave_float_complex_matrix); + + INSTALL_WIDENOP (octave_scalar, octave_complex_matrix, complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-s-cs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-s-cs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,149 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar by complex scalar ops. + +DEFBINOP_OP (add, scalar, complex, +) +DEFBINOP_OP (sub, scalar, complex, -) +DEFBINOP_OP (mul, scalar, complex, *) + +DEFBINOP (div, scalar, complex) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.double_value () / d); +} + +DEFBINOP_FN (pow, scalar, complex, xpow) + +DEFBINOP (ldiv, scalar, complex) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_value () / d); +} + +DEFCMPLXCMPOP_OP (lt, scalar, complex, <) +DEFCMPLXCMPOP_OP (le, scalar, complex, <=) +DEFCMPLXCMPOP_OP (eq, scalar, complex, ==) +DEFCMPLXCMPOP_OP (ge, scalar, complex, >=) +DEFCMPLXCMPOP_OP (gt, scalar, complex, >) +DEFCMPLXCMPOP_OP (ne, scalar, complex, !=) + +DEFBINOP_OP (el_mul, scalar, complex, *) + +DEFBINOP (el_div, scalar, complex) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.double_value () / d); +} + +DEFBINOP_FN (el_pow, scalar, complex, xpow) + +DEFBINOP (el_ldiv, scalar, complex) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_value () / d); +} + +DEFBINOP (el_and, scalar, complex) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () && (v2.complex_value () != 0.0)); +} + +DEFBINOP (el_or, scalar, complex) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () || (v2.complex_value () != 0.0)); +} + +DEFNDCATOP_FN (s_cs, scalar, complex, array, complex_array, concat) + +void +install_s_cs_ops (void) +{ + INSTALL_BINOP (op_add, octave_scalar, octave_complex, add); + INSTALL_BINOP (op_sub, octave_scalar, octave_complex, sub); + INSTALL_BINOP (op_mul, octave_scalar, octave_complex, mul); + INSTALL_BINOP (op_div, octave_scalar, octave_complex, div); + INSTALL_BINOP (op_pow, octave_scalar, octave_complex, pow); + INSTALL_BINOP (op_ldiv, octave_scalar, octave_complex, ldiv); + INSTALL_BINOP (op_lt, octave_scalar, octave_complex, lt); + INSTALL_BINOP (op_le, octave_scalar, octave_complex, le); + INSTALL_BINOP (op_eq, octave_scalar, octave_complex, eq); + INSTALL_BINOP (op_ge, octave_scalar, octave_complex, ge); + INSTALL_BINOP (op_gt, octave_scalar, octave_complex, gt); + INSTALL_BINOP (op_ne, octave_scalar, octave_complex, ne); + INSTALL_BINOP (op_el_mul, octave_scalar, octave_complex, el_mul); + INSTALL_BINOP (op_el_div, octave_scalar, octave_complex, el_div); + INSTALL_BINOP (op_el_pow, octave_scalar, octave_complex, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_complex, el_ldiv); + INSTALL_BINOP (op_el_and, octave_scalar, octave_complex, el_and); + INSTALL_BINOP (op_el_or, octave_scalar, octave_complex, el_or); + + INSTALL_CATOP (octave_scalar, octave_complex, s_cs); + + INSTALL_ASSIGNCONV (octave_scalar, octave_complex, octave_complex_matrix); + INSTALL_ASSIGNCONV (octave_float_scalar, octave_complex, octave_float_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-s-m.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-s-m.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,136 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar by matrix ops. + +DEFNDBINOP_OP (add, scalar, matrix, scalar, array, +) +DEFNDBINOP_OP (sub, scalar, matrix, scalar, array, -) +DEFNDBINOP_OP (mul, scalar, matrix, scalar, array, *) + +DEFBINOP (div, scalar, matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + Matrix m1 = v1.matrix_value (); + Matrix m2 = v2.matrix_value (); + MatrixType typ = v2.matrix_type (); + + Matrix ret = xdiv (m1, m2, typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOP_FN (pow, scalar, matrix, xpow) + +DEFBINOP (ldiv, scalar, matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.array_value () / d); +} + +DEFNDBINOP_FN (lt, scalar, matrix, scalar, array, mx_el_lt) +DEFNDBINOP_FN (le, scalar, matrix, scalar, array, mx_el_le) +DEFNDBINOP_FN (eq, scalar, matrix, scalar, array, mx_el_eq) +DEFNDBINOP_FN (ge, scalar, matrix, scalar, array, mx_el_ge) +DEFNDBINOP_FN (gt, scalar, matrix, scalar, array, mx_el_gt) +DEFNDBINOP_FN (ne, scalar, matrix, scalar, array, mx_el_ne) + +DEFNDBINOP_OP (el_mul, scalar, matrix, scalar, array, *) +DEFNDBINOP_FN (el_div, scalar, matrix, scalar, array, x_el_div) +DEFNDBINOP_FN (el_pow, scalar, matrix, scalar, array, elem_xpow) + +DEFBINOP (el_ldiv, scalar, matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.array_value () / d); +} + +DEFNDBINOP_FN (el_and, scalar, matrix, scalar, array, mx_el_and) +DEFNDBINOP_FN (el_or, scalar, matrix, scalar, array, mx_el_or) + +DEFNDCATOP_FN (s_m, scalar, matrix, array, array, concat) + +DEFCONV (matrix_conv, scalar, matrix) +{ + CAST_CONV_ARG (const octave_scalar&); + + return new octave_matrix (v.matrix_value ()); +} + +void +install_s_m_ops (void) +{ + INSTALL_BINOP (op_add, octave_scalar, octave_matrix, add); + INSTALL_BINOP (op_sub, octave_scalar, octave_matrix, sub); + INSTALL_BINOP (op_mul, octave_scalar, octave_matrix, mul); + INSTALL_BINOP (op_div, octave_scalar, octave_matrix, div); + INSTALL_BINOP (op_pow, octave_scalar, octave_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_scalar, octave_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_scalar, octave_matrix, lt); + INSTALL_BINOP (op_le, octave_scalar, octave_matrix, le); + INSTALL_BINOP (op_eq, octave_scalar, octave_matrix, eq); + INSTALL_BINOP (op_ge, octave_scalar, octave_matrix, ge); + INSTALL_BINOP (op_gt, octave_scalar, octave_matrix, gt); + INSTALL_BINOP (op_ne, octave_scalar, octave_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_scalar, octave_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_scalar, octave_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_scalar, octave_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_scalar, octave_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_scalar, octave_matrix, el_or); + + INSTALL_CATOP (octave_scalar, octave_matrix, s_m); + + INSTALL_ASSIGNCONV (octave_scalar, octave_matrix, octave_matrix); + INSTALL_ASSIGNCONV (octave_float_scalar, octave_matrix, octave_float_matrix); + + INSTALL_WIDENOP (octave_scalar, octave_matrix, matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-s-s.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-s-s.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,172 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "Array-util.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar unary ops. + +DEFUNOP (not, scalar) +{ + CAST_UNOP_ARG (const octave_scalar&); + double x = v.scalar_value (); + if (xisnan (x)) + gripe_nan_to_logical_conversion (); + return octave_value (x == 0.0); +} + +DEFUNOP_OP (uplus, scalar, /* no-op */) +DEFUNOP_OP (uminus, scalar, -) +DEFUNOP_OP (transpose, scalar, /* no-op */) +DEFUNOP_OP (hermitian, scalar, /* no-op */) + +DEFNCUNOP_METHOD (incr, scalar, increment) +DEFNCUNOP_METHOD (decr, scalar, decrement) + +// scalar by scalar ops. + +DEFBINOP_OP (add, scalar, scalar, +) +DEFBINOP_OP (sub, scalar, scalar, -) +DEFBINOP_OP (mul, scalar, scalar, *) + +DEFBINOP (div, scalar, scalar) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.double_value () / d); +} + +DEFBINOP_FN (pow, scalar, scalar, xpow) + +DEFBINOP (ldiv, scalar, scalar) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.double_value () / d); +} + +DEFBINOP_OP (lt, scalar, scalar, <) +DEFBINOP_OP (le, scalar, scalar, <=) +DEFBINOP_OP (eq, scalar, scalar, ==) +DEFBINOP_OP (ge, scalar, scalar, >=) +DEFBINOP_OP (gt, scalar, scalar, >) +DEFBINOP_OP (ne, scalar, scalar, !=) + +DEFBINOP_OP (el_mul, scalar, scalar, *) + +DEFBINOP (el_div, scalar, scalar) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.double_value () / d); +} + +DEFBINOP_FN (el_pow, scalar, scalar, xpow) + +DEFBINOP (el_ldiv, scalar, scalar) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.double_value () / d); +} + +DEFSCALARBOOLOP_OP (el_and, scalar, scalar, &&) +DEFSCALARBOOLOP_OP (el_or, scalar, scalar, ||) + +DEFNDCATOP_FN (s_s, scalar, scalar, array, array, concat) + +void +install_s_s_ops (void) +{ + INSTALL_UNOP (op_not, octave_scalar, not); + INSTALL_UNOP (op_uplus, octave_scalar, uplus); + INSTALL_UNOP (op_uminus, octave_scalar, uminus); + INSTALL_UNOP (op_transpose, octave_scalar, transpose); + INSTALL_UNOP (op_hermitian, octave_scalar, hermitian); + + INSTALL_NCUNOP (op_incr, octave_scalar, incr); + INSTALL_NCUNOP (op_decr, octave_scalar, decr); + + INSTALL_BINOP (op_add, octave_scalar, octave_scalar, add); + INSTALL_BINOP (op_sub, octave_scalar, octave_scalar, sub); + INSTALL_BINOP (op_mul, octave_scalar, octave_scalar, mul); + INSTALL_BINOP (op_div, octave_scalar, octave_scalar, div); + INSTALL_BINOP (op_pow, octave_scalar, octave_scalar, pow); + INSTALL_BINOP (op_ldiv, octave_scalar, octave_scalar, ldiv); + INSTALL_BINOP (op_lt, octave_scalar, octave_scalar, lt); + INSTALL_BINOP (op_le, octave_scalar, octave_scalar, le); + INSTALL_BINOP (op_eq, octave_scalar, octave_scalar, eq); + INSTALL_BINOP (op_ge, octave_scalar, octave_scalar, ge); + INSTALL_BINOP (op_gt, octave_scalar, octave_scalar, gt); + INSTALL_BINOP (op_ne, octave_scalar, octave_scalar, ne); + INSTALL_BINOP (op_el_mul, octave_scalar, octave_scalar, el_mul); + INSTALL_BINOP (op_el_div, octave_scalar, octave_scalar, el_div); + INSTALL_BINOP (op_el_pow, octave_scalar, octave_scalar, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_scalar, el_ldiv); + INSTALL_BINOP (op_el_and, octave_scalar, octave_scalar, el_and); + INSTALL_BINOP (op_el_or, octave_scalar, octave_scalar, el_or); + + INSTALL_CATOP (octave_scalar, octave_scalar, s_s); + + INSTALL_ASSIGNCONV (octave_scalar, octave_scalar, octave_matrix); + INSTALL_ASSIGNCONV (octave_float_scalar, octave_scalar, octave_float_matrix); + + INSTALL_ASSIGNCONV (octave_scalar, octave_null_matrix, octave_matrix); + INSTALL_ASSIGNCONV (octave_scalar, octave_null_str, octave_matrix); + INSTALL_ASSIGNCONV (octave_scalar, octave_null_sq_str, octave_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-s-scm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-s-scm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,178 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-cx-mat.h" +#include "ov-scalar.h" +#include "ops.h" +#include "xpow.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "smx-s-scm.h" +#include "smx-scm-s.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +// scalar by sparse complex matrix ops. + +DEFBINOP_OP (add, scalar, sparse_complex_matrix, +) +DEFBINOP_OP (sub, scalar, sparse_complex_matrix, -) +DEFBINOP_OP (mul, scalar, sparse_complex_matrix, *) + +DEFBINOP (div, scalar, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (SparseComplexMatrix (1, 1, v1.scalar_value () / d)); + } + else + { + MatrixType typ = v2.matrix_type (); + Matrix m1 = Matrix (1, 1, v1.scalar_value ()); + SparseComplexMatrix m2 = v2.sparse_complex_matrix_value (); + ComplexMatrix ret = xdiv (m1, m2, typ); + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOP (pow, scalar, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, + const octave_sparse_complex_matrix&); + return xpow (v1.scalar_value (), v2.complex_matrix_value ()); +} + +DEFBINOP (ldiv, scalar, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, + const octave_sparse_complex_matrix&); + + double d = v1.double_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v2.sparse_complex_matrix_value () / d); + + return retval; +} + +DEFBINOP_FN (lt, scalar, sparse_complex_matrix, mx_el_lt) +DEFBINOP_FN (le, scalar, sparse_complex_matrix, mx_el_le) +DEFBINOP_FN (eq, scalar, sparse_complex_matrix, mx_el_eq) +DEFBINOP_FN (ge, scalar, sparse_complex_matrix, mx_el_ge) +DEFBINOP_FN (gt, scalar, sparse_complex_matrix, mx_el_gt) +DEFBINOP_FN (ne, scalar, sparse_complex_matrix, mx_el_ne) + +DEFBINOP_OP (el_mul, scalar, sparse_complex_matrix, *) +DEFBINOP_FN (el_div, scalar, sparse_complex_matrix, x_el_div) +DEFBINOP_FN (el_pow, scalar, sparse_complex_matrix, elem_xpow) + +DEFBINOP (el_ldiv, scalar, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, + const octave_sparse_complex_matrix&); + + double d = v1.double_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v2.sparse_complex_matrix_value () / d); + + return retval; +} + +DEFBINOP_FN (el_and, scalar, sparse_complex_matrix, mx_el_and) +DEFBINOP_FN (el_or, scalar, sparse_complex_matrix, mx_el_or) + +DEFCATOP (s_scm, scalar, sparse_compelx_matrix) +{ + CAST_BINOP_ARGS (octave_scalar&, const octave_sparse_complex_matrix&); + SparseMatrix tmp (1, 1, v1.scalar_value ()); + return octave_value + (tmp.concat (v2.sparse_complex_matrix_value (), ra_idx)); +} + +DEFCONV (sparse_complex_matrix_conv, scalar, sparse_complex_matrix) +{ + CAST_CONV_ARG (const octave_scalar&); + + return new octave_sparse_complex_matrix + (SparseComplexMatrix (v.complex_matrix_value ())); +} + +void +install_s_scm_ops (void) +{ + INSTALL_BINOP (op_add, octave_scalar, octave_sparse_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_scalar, octave_sparse_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_scalar, octave_sparse_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_scalar, octave_sparse_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_scalar, octave_sparse_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_scalar, octave_sparse_complex_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_scalar, octave_sparse_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_scalar, octave_sparse_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_scalar, octave_sparse_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_scalar, octave_sparse_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_scalar, octave_sparse_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_scalar, octave_sparse_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_scalar, octave_sparse_complex_matrix, + el_mul); + INSTALL_BINOP (op_el_div, octave_scalar, octave_sparse_complex_matrix, + el_div); + INSTALL_BINOP (op_el_pow, octave_scalar, octave_sparse_complex_matrix, + el_pow); + INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_sparse_complex_matrix, + el_ldiv); + INSTALL_BINOP (op_el_and, octave_scalar, octave_sparse_complex_matrix, + el_and); + INSTALL_BINOP (op_el_or, octave_scalar, octave_sparse_complex_matrix, + el_or); + + INSTALL_CATOP (octave_scalar, octave_sparse_complex_matrix, s_scm); + + INSTALL_ASSIGNCONV (octave_scalar, octave_sparse_complex_matrix, + octave_complex_matrix); + + INSTALL_WIDENOP (octave_scalar, octave_sparse_complex_matrix, + sparse_complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-s-sm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-s-sm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,161 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-scalar.h" +#include "ops.h" +#include "xpow.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "ov-re-sparse.h" + +// scalar by sparse matrix ops. + +DEFBINOP_OP (add, scalar, sparse_matrix, +) +DEFBINOP_OP (sub, scalar, sparse_matrix, -) +DEFBINOP_OP (mul, scalar, sparse_matrix, *) + +DEFBINOP (div, scalar, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + double d = v2.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (SparseMatrix (1, 1, v1.scalar_value () / d)); + } + else + { + MatrixType typ = v2.matrix_type (); + Matrix m1 = Matrix (1, 1, v1.double_value ()); + SparseMatrix m2 = v2.sparse_matrix_value (); + Matrix ret = xdiv (m1, m2, typ); + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOP (pow, scalar, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_matrix&); + return xpow (v1.scalar_value (), v2.matrix_value ()); +} + +DEFBINOP (ldiv, scalar, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_matrix&); + + double d = v1.double_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v2.sparse_matrix_value () / d); + + return retval; +} + +DEFBINOP_FN (lt, scalar, sparse_matrix, mx_el_lt) +DEFBINOP_FN (le, scalar, sparse_matrix, mx_el_le) +DEFBINOP_FN (eq, scalar, sparse_matrix, mx_el_eq) +DEFBINOP_FN (ge, scalar, sparse_matrix, mx_el_ge) +DEFBINOP_FN (gt, scalar, sparse_matrix, mx_el_gt) +DEFBINOP_FN (ne, scalar, sparse_matrix, mx_el_ne) + +DEFBINOP_OP (el_mul, scalar, sparse_matrix, *) +DEFBINOP_FN (el_div, scalar, sparse_matrix, x_el_div) +DEFBINOP_FN (el_pow, scalar, sparse_matrix, elem_xpow) + +DEFBINOP (el_ldiv, scalar, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_sparse_matrix&); + + double d = v1.double_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v2.sparse_matrix_value () / d); + + return retval; +} + +DEFBINOP_FN (el_and, scalar, sparse_matrix, mx_el_and) +DEFBINOP_FN (el_or, scalar, sparse_matrix, mx_el_or) + +DEFCATOP (s_sm, scalar, sparse_matrix) +{ + CAST_BINOP_ARGS (octave_scalar&, const octave_sparse_matrix&); + SparseMatrix tmp (1, 1, v1.scalar_value ()); + return octave_value (tmp.concat (v2.sparse_matrix_value (), ra_idx)); +} + +DEFCONV (sparse_matrix_conv, scalar, sparse_matrix) +{ + CAST_CONV_ARG (const octave_scalar&); + + return new octave_sparse_matrix (SparseMatrix (v.matrix_value ())); +} + +void +install_s_sm_ops (void) +{ + INSTALL_BINOP (op_add, octave_scalar, octave_sparse_matrix, add); + INSTALL_BINOP (op_sub, octave_scalar, octave_sparse_matrix, sub); + INSTALL_BINOP (op_mul, octave_scalar, octave_sparse_matrix, mul); + INSTALL_BINOP (op_div, octave_scalar, octave_sparse_matrix, div); + INSTALL_BINOP (op_pow, octave_scalar, octave_sparse_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_scalar, octave_sparse_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_scalar, octave_sparse_matrix, lt); + INSTALL_BINOP (op_le, octave_scalar, octave_sparse_matrix, le); + INSTALL_BINOP (op_eq, octave_scalar, octave_sparse_matrix, eq); + INSTALL_BINOP (op_ge, octave_scalar, octave_sparse_matrix, ge); + INSTALL_BINOP (op_gt, octave_scalar, octave_sparse_matrix, gt); + INSTALL_BINOP (op_ne, octave_scalar, octave_sparse_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_scalar, octave_sparse_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_scalar, octave_sparse_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_scalar, octave_sparse_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_scalar, octave_sparse_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_scalar, octave_sparse_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_scalar, octave_sparse_matrix, el_or); + + INSTALL_CATOP (octave_scalar, octave_sparse_matrix, s_sm); + + INSTALL_ASSIGNCONV (octave_scalar, octave_sparse_matrix, octave_matrix); + + INSTALL_WIDENOP (octave_scalar, octave_sparse_matrix, sparse_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-sbm-b.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-sbm-b.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,141 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-bool.h" +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-scalar.h" +#include "ops.h" + +#include "ov-re-sparse.h" +#include "ov-bool-sparse.h" + +// sparse bool matrix by bool ops. + +DEFBINOP_FN (ne, sparse_bool_matrix, bool, mx_el_ne) +DEFBINOP_FN (eq, sparse_bool_matrix, bool, mx_el_eq) + +DEFBINOP_FN (el_and, sparse_bool_matrix, bool, mx_el_and) +DEFBINOP_FN (el_or, sparse_bool_matrix, bool, mx_el_or) + +DEFCATOP (sbm_b, sparse_bool_matrix, bool) +{ + CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_bool&); + + SparseBoolMatrix tmp (1, 1, v2.bool_value ()); + return octave_value (v1.sparse_bool_matrix_value (). concat (tmp, ra_idx)); +} + +DEFCATOP (sm_b, sparse_matrix, bool) +{ + CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_bool&); + + SparseMatrix tmp (1, 1, v2.scalar_value ()); + return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); +} + +DEFCATOP (sbm_s, sparse_bool_matrix, scalar) +{ + CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_scalar&); + + SparseMatrix tmp (1, 1, v2.scalar_value ()); + return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); +} + +DEFASSIGNOP (assign, sparse_bool_matrix, bool) +{ + CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_bool&); + + SparseBoolMatrix tmp (1, 1, v2.bool_value ()); + v1.assign (idx, tmp); + return octave_value (); +} + +static octave_value +oct_assignop_conv_and_assign (octave_base_value& a1, + const octave_value_list& idx, + const octave_base_value& a2) +{ + octave_sparse_bool_matrix& v1 = dynamic_cast (a1); + + // FIXME -- perhaps add a warning for this conversion if the values + // are not all 0 or 1? + + SparseBoolMatrix v2 (1, 1, a2.bool_value ()); + + if (! error_state) + v1.assign (idx, v2); + + return octave_value (); +} + +void +install_sbm_b_ops (void) +{ + INSTALL_BINOP (op_eq, octave_sparse_bool_matrix, octave_bool, eq); + INSTALL_BINOP (op_ne, octave_sparse_bool_matrix, octave_bool, ne); + + INSTALL_BINOP (op_el_and, octave_sparse_bool_matrix, octave_bool, el_and); + INSTALL_BINOP (op_el_or, octave_sparse_bool_matrix, octave_bool, el_or); + + INSTALL_CATOP (octave_sparse_bool_matrix, octave_bool, sbm_b); + INSTALL_CATOP (octave_sparse_bool_matrix, octave_scalar, sbm_s); + INSTALL_CATOP (octave_sparse_matrix, octave_bool, sm_b); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_bool, assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_scalar, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int8_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int16_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int32_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int64_scalar, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint8_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint16_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint32_scalar, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint64_scalar, + conv_and_assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-sbm-bm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-sbm-bm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,167 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-bool-mat.h" +#include "boolMatrix.h" +#include "ov-int8.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-uint8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-range.h" +#include "ov-scalar.h" +#include "ov-str-mat.h" +#include "ops.h" +#include "ov-null-mat.h" +#include "ov-re-sparse.h" +#include "ov-bool-sparse.h" +#include "smx-bm-sbm.h" +#include "smx-sbm-bm.h" + +// sparse bool matrix by bool matrix ops. + +DEFBINOP_FN (eq, sparse_bool_matrix, bool_matrix, mx_el_eq) +DEFBINOP_FN (ne, sparse_bool_matrix, bool_matrix, mx_el_ne) + +DEFBINOP_FN (el_and, sparse_bool_matrix, bool_matrix, mx_el_and) +DEFBINOP_FN (el_or, sparse_bool_matrix, bool_matrix, mx_el_or) + +DEFCATOP (sbm_bm, sparse_bool_matrix, bool_matrix) +{ + CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_bool_matrix&); + + SparseBoolMatrix tmp (v2.bool_matrix_value ()); + return octave_value (v1.sparse_bool_matrix_value (). concat (tmp, ra_idx)); +} + +DEFCATOP (sbm_m, sparse_bool_matrix, matrix) +{ + CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_matrix&); + + SparseMatrix tmp (v2.matrix_value ()); + return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); +} + +DEFCATOP (sm_bm, sparse_matrix, bool_matrix) +{ + CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_bool_matrix&); + + SparseMatrix tmp (v2.matrix_value ()); + return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); +} + +DEFASSIGNOP (assign, sparse_bool_matrix, bool_matrix) +{ + CAST_BINOP_ARGS (octave_sparse_bool_matrix&, const octave_bool_matrix&); + + v1.assign (idx, SparseBoolMatrix (v2.bool_matrix_value ())); + return octave_value (); +} + +DEFNULLASSIGNOP_FN (null_assign, sparse_bool_matrix, delete_elements) + +static octave_value +oct_assignop_conv_and_assign (octave_base_value& a1, + const octave_value_list& idx, + const octave_base_value& a2) +{ + octave_sparse_bool_matrix& v1 = dynamic_cast (a1); + + // FIXME -- perhaps add a warning for this conversion if the values + // are not all 0 or 1? + + SparseBoolMatrix v2 (a2.bool_array_value ()); + + if (! error_state) + v1.assign (idx, v2); + + return octave_value (); +} + +void +install_sbm_bm_ops (void) +{ + INSTALL_BINOP (op_eq, octave_sparse_bool_matrix, octave_bool_matrix, eq); + INSTALL_BINOP (op_ne, octave_sparse_bool_matrix, octave_bool_matrix, ne); + + INSTALL_BINOP (op_el_and, octave_sparse_bool_matrix, octave_bool_matrix, + el_and); + INSTALL_BINOP (op_el_or, octave_sparse_bool_matrix, octave_bool_matrix, + el_or); + + INSTALL_CATOP (octave_sparse_bool_matrix, octave_bool_matrix, sbm_bm); + INSTALL_CATOP (octave_sparse_matrix, octave_bool_matrix, sm_bm); + INSTALL_CATOP (octave_sparse_bool_matrix, octave_matrix, sbm_m); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, + octave_bool_matrix, assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, + octave_char_matrix_str, conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, + octave_char_matrix_sq_str, conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_range, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_sparse_matrix, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int8_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int16_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int32_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_int64_matrix, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint8_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint16_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint32_matrix, + conv_and_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_uint64_matrix, + conv_and_assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_null_matrix, + null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_null_str, + null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, octave_null_sq_str, + null_assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-sbm-sbm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-sbm-sbm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,114 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-bool-mat.h" +#include "ov-scalar.h" +#include "ops.h" + +#include "ov-re-sparse.h" +#include "ov-bool-sparse.h" + +// unary sparse bool matrix ops. + +DEFUNOP_OP (not, sparse_bool_matrix, !) + +DEFUNOP (uplus, sparse_bool_matrix) +{ + CAST_UNOP_ARG (const octave_sparse_bool_matrix&); + return octave_value (v.sparse_matrix_value ()); +} + +DEFUNOP (uminus, sparse_bool_matrix) +{ + CAST_UNOP_ARG (const octave_sparse_bool_matrix&); + return octave_value ( - v.sparse_matrix_value ()); +} + +DEFUNOP (transpose, sparse_bool_matrix) +{ + CAST_UNOP_ARG (const octave_sparse_bool_matrix&); + return octave_value (v.sparse_bool_matrix_value ().transpose ()); +} + +// sparse bool matrix by sparse bool matrix ops. + +DEFBINOP_FN (eq, sparse_bool_matrix, sparse_bool_matrix, mx_el_eq) +DEFBINOP_FN (ne, sparse_bool_matrix, sparse_bool_matrix, mx_el_ne) +DEFBINOP_FN (el_and, sparse_bool_matrix, sparse_bool_matrix, mx_el_and) +DEFBINOP_FN (el_or, sparse_bool_matrix, sparse_bool_matrix, mx_el_or) + +DEFNDCATOP_FN (sbm_sbm, sparse_bool_matrix, sparse_bool_matrix, + sparse_bool_matrix, sparse_bool_matrix, concat) +DEFNDCATOP_FN (sbm_sm, sparse_bool_matrix, sparse_matrix, sparse_matrix, + sparse_matrix, concat) +DEFNDCATOP_FN (sm_sbm, sparse_matrix, sparse_bool_matrix, sparse_matrix, + sparse_matrix, concat) + +DEFASSIGNOP_FN (assign, sparse_bool_matrix, sparse_bool_matrix, + assign) + +CONVDECL (bool_matrix_to_double_matrix) +{ + CAST_CONV_ARG (const octave_sparse_bool_matrix&); + + return new octave_sparse_matrix (SparseMatrix (v.sparse_bool_matrix_value ())); +} + +void +install_sbm_sbm_ops (void) +{ + INSTALL_UNOP (op_not, octave_sparse_bool_matrix, not); + INSTALL_UNOP (op_uplus, octave_sparse_bool_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_sparse_bool_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_sparse_bool_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_sparse_bool_matrix, transpose); + + INSTALL_BINOP (op_eq, octave_sparse_bool_matrix, + octave_sparse_bool_matrix, eq); + INSTALL_BINOP (op_ne, octave_sparse_bool_matrix, + octave_sparse_bool_matrix, ne); + + INSTALL_BINOP (op_el_and, octave_sparse_bool_matrix, + octave_sparse_bool_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_sparse_bool_matrix, + octave_sparse_bool_matrix, el_or); + + INSTALL_CATOP (octave_sparse_bool_matrix, octave_sparse_bool_matrix, + sbm_sbm); + INSTALL_CATOP (octave_sparse_bool_matrix, octave_sparse_matrix, sbm_sm); + INSTALL_CATOP (octave_sparse_matrix, octave_sparse_bool_matrix, sm_sbm); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_bool_matrix, + octave_sparse_bool_matrix, assign); + + INSTALL_CONVOP (octave_sparse_bool_matrix, octave_sparse_matrix, + bool_matrix_to_double_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-scm-cm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-scm-cm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,196 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-cx-mat.h" +#include "ops.h" +#include "xdiv.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "smx-scm-cm.h" +#include "smx-cm-scm.h" +#include "ov-cx-sparse.h" + +// sparse complex matrix by complex matrix ops. + +DEFBINOP_OP (add, sparse_complex_matrix, complex_matrix, +) +DEFBINOP_OP (sub, sparse_complex_matrix, complex_matrix, -) + +DEFBINOP_OP (mul, sparse_complex_matrix, complex_matrix, *) + +DEFBINOP (div, sparse_complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_complex_matrix&); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.complex_matrix_value (), + v2.complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOPX (pow, sparse_complex_matrix, complex_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, sparse_complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_array_value () / d); + } + else + { + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.sparse_complex_matrix_value (), + v2.complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (trans_mul, sparse_complex_matrix, complex_matrix, trans_mul); +DEFBINOP_FN (herm_mul, sparse_complex_matrix, complex_matrix, herm_mul); + +DEFBINOP_FN (lt, sparse_complex_matrix, complex_matrix, mx_el_lt) +DEFBINOP_FN (le, sparse_complex_matrix, complex_matrix, mx_el_le) +DEFBINOP_FN (eq, sparse_complex_matrix, complex_matrix, mx_el_eq) +DEFBINOP_FN (ge, sparse_complex_matrix, complex_matrix, mx_el_ge) +DEFBINOP_FN (gt, sparse_complex_matrix, complex_matrix, mx_el_gt) +DEFBINOP_FN (ne, sparse_complex_matrix, complex_matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, sparse_complex_matrix, complex_matrix, product) +DEFBINOP_FN (el_div, sparse_complex_matrix, complex_matrix, quotient) + +DEFBINOP (el_pow, sparse_complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_complex_matrix&); + + return octave_value + (elem_xpow (v1.sparse_complex_matrix_value (), SparseComplexMatrix + (v2.complex_matrix_value ()))); +} + +DEFBINOP (el_ldiv, sparse_complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_complex_matrix&); + + return octave_value (quotient (v2.complex_matrix_value (), + v1.sparse_complex_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_complex_matrix, complex_matrix, mx_el_and) +DEFBINOP_FN (el_or, sparse_complex_matrix, complex_matrix, mx_el_or) + +DEFCATOP (scm_cm, sparse_complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (octave_sparse_complex_matrix&, + const octave_complex_matrix&); + SparseComplexMatrix tmp (v2.complex_matrix_value ()); + return octave_value + (v1.sparse_complex_matrix_value (). concat (tmp, ra_idx)); +} + +DEFASSIGNOP (assign, sparse_complex_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (octave_sparse_complex_matrix&, + const octave_complex_matrix&); + + SparseComplexMatrix tmp (v2.complex_matrix_value ()); + v1.assign (idx, tmp); + return octave_value (); +} + +void +install_scm_cm_ops (void) +{ + INSTALL_BINOP (op_add, octave_sparse_complex_matrix, + octave_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, + octave_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, + octave_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_sparse_complex_matrix, + octave_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, + octave_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, + octave_complex_matrix, ldiv); + INSTALL_BINOP (op_trans_mul, octave_sparse_complex_matrix, + octave_complex_matrix, trans_mul); + INSTALL_BINOP (op_herm_mul, octave_sparse_complex_matrix, + octave_complex_matrix, herm_mul); + INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, + octave_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_sparse_complex_matrix, + octave_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, + octave_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, + octave_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, + octave_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, + octave_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, + octave_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, + octave_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, + octave_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, + octave_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, + octave_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, + octave_complex_matrix, el_or); + + INSTALL_CATOP (octave_sparse_complex_matrix, + octave_complex_matrix, scm_cm); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, + octave_complex_matrix, assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-scm-cs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-scm-cs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,184 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-cx-mat.h" +#include "ov-complex.h" +#include "ops.h" +#include "xpow.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "ov-cx-sparse.h" + +// sparse complex matrix by complex scalar ops. + +DEFBINOP_OP (add, sparse_complex_matrix, complex, +) +DEFBINOP_OP (sub, sparse_complex_matrix, complex, -) +DEFBINOP_OP (mul, sparse_complex_matrix, complex, *) + +DEFBINOP (div, sparse_complex_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_complex&); + + Complex d = v2.complex_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v1.sparse_complex_matrix_value () / d); + + return retval; +} + +DEFBINOP (pow, sparse_complex_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_complex&); + return xpow (v1.complex_matrix_value (), v2.complex_value ()); +} + +DEFBINOP (ldiv, sparse_complex_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_complex&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (SparseComplexMatrix (1, 1, v2.complex_value () / d)); + } + else + { + MatrixType typ = v1.matrix_type (); + SparseComplexMatrix m1 = v1.sparse_complex_matrix_value (); + ComplexMatrix m2 = ComplexMatrix (1, 1, v2.complex_value ()); + ComplexMatrix ret = xleftdiv (m1, m2, typ); + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (lt, sparse_complex_matrix, complex, mx_el_lt) +DEFBINOP_FN (le, sparse_complex_matrix, complex, mx_el_le) +DEFBINOP_FN (eq, sparse_complex_matrix, complex, mx_el_eq) +DEFBINOP_FN (ge, sparse_complex_matrix, complex, mx_el_ge) +DEFBINOP_FN (gt, sparse_complex_matrix, complex, mx_el_gt) +DEFBINOP_FN (ne, sparse_complex_matrix, complex, mx_el_ne) + +DEFBINOP_OP (el_mul, sparse_complex_matrix, complex, *) + +DEFBINOP (el_div, sparse_complex_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_complex&); + + octave_value retval; + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v1.sparse_complex_matrix_value () / d); + + return retval; +} + +DEFBINOP_FN (el_pow, sparse_complex_matrix, complex, elem_xpow) + +DEFBINOP (el_ldiv, sparse_complex_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_complex&); + + return octave_value + (x_el_div (v2.complex_value (), v1.sparse_complex_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_complex_matrix, complex, mx_el_and) +DEFBINOP_FN (el_or, sparse_complex_matrix, complex, mx_el_or) + +DEFCATOP (scm_cs, sparse_complex_matrix, complex) +{ + CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_complex&); + SparseComplexMatrix tmp (1, 1, v2.complex_value ()); + return octave_value + (v1.sparse_complex_matrix_value (). concat (tmp, ra_idx)); +} + +DEFASSIGNOP (assign, sparse_complex_matrix, complex) +{ + CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_complex&); + + SparseComplexMatrix tmp (1, 1, v2.complex_value ()); + v1.assign (idx, tmp); + return octave_value (); +} + +void +install_scm_cs_ops (void) +{ + INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_complex, add); + INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_complex, sub); + INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_complex, mul); + INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_complex, div); + INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, octave_complex, pow); + INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, octave_complex, + ldiv); + INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, octave_complex, lt); + INSTALL_BINOP (op_le, octave_sparse_complex_matrix, octave_complex, le); + INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, octave_complex, eq); + INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, octave_complex, ge); + INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, octave_complex, gt); + INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, octave_complex, ne); + INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, octave_complex, + el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, octave_complex, + el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, octave_complex, + el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, octave_complex, + el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, octave_complex, + el_and); + INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, octave_complex, + el_or); + + INSTALL_CATOP (octave_sparse_complex_matrix, octave_complex, scm_cs); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, octave_complex, + assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-scm-m.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-scm-m.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,175 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-re-mat.h" +#include "ov-cx-mat.h" +#include "ops.h" +#include "xdiv.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "smx-scm-m.h" +#include "smx-m-scm.h" +#include "ov-cx-sparse.h" + +// sparse complex matrix by matrix ops. + +DEFBINOP_OP (add, sparse_complex_matrix, matrix, +) +DEFBINOP_OP (sub, sparse_complex_matrix, matrix, -) + +DEFBINOP_OP (mul, sparse_complex_matrix, matrix, *) + +DEFBINOP (div, sparse_complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_matrix&); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.complex_matrix_value (), + v2.matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOPX (pow, sparse_complex_matrix, matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, sparse_complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.array_value () / d); + } + else + { + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.sparse_complex_matrix_value (), + v2.matrix_value (), typ); + + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (lt, sparse_complex_matrix, matrix, mx_el_lt) +DEFBINOP_FN (le, sparse_complex_matrix, matrix, mx_el_le) +DEFBINOP_FN (eq, sparse_complex_matrix, matrix, mx_el_eq) +DEFBINOP_FN (ge, sparse_complex_matrix, matrix, mx_el_ge) +DEFBINOP_FN (gt, sparse_complex_matrix, matrix, mx_el_gt) +DEFBINOP_FN (ne, sparse_complex_matrix, matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, sparse_complex_matrix, matrix, product) +DEFBINOP_FN (el_div, sparse_complex_matrix, matrix, quotient) + +DEFBINOP (el_pow, sparse_complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_matrix&); + + return octave_value + (elem_xpow (v1.sparse_complex_matrix_value (), SparseMatrix + (v2.matrix_value ()))); +} + +DEFBINOP (el_ldiv, sparse_complex_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_matrix&); + + return octave_value + (quotient (v2.matrix_value (), v1.sparse_complex_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_complex_matrix, matrix, mx_el_and) +DEFBINOP_FN (el_or, sparse_complex_matrix, matrix, mx_el_or) + +DEFCATOP (scm_m, sparse_complex_matrix, matrix) +{ + CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_matrix&); + SparseMatrix tmp (v2.matrix_value ()); + return octave_value + (v1.sparse_complex_matrix_value (). concat (tmp, ra_idx)); +} + +DEFASSIGNOP (assign, sparse_complex_matrix, matrix) +{ + CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_matrix&); + + SparseComplexMatrix tmp (v2.complex_matrix_value ()); + v1.assign (idx, tmp); + return octave_value (); +} + +void +install_scm_m_ops (void) +{ + INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_matrix, add); + INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_matrix, sub); + INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_matrix, mul); + INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_matrix, div); + INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, octave_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, octave_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, octave_matrix, lt); + INSTALL_BINOP (op_le, octave_sparse_complex_matrix, octave_matrix, le); + INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, octave_matrix, eq); + INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, octave_matrix, ge); + INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, octave_matrix, gt); + INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, octave_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, octave_matrix, + el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, octave_matrix, + el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, octave_matrix, + el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, octave_matrix, + el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, octave_matrix, + el_and); + INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, octave_matrix, + el_or); + + INSTALL_CATOP (octave_sparse_complex_matrix, octave_matrix, scm_m); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, octave_matrix, + assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-scm-s.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-scm-s.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,189 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-cx-mat.h" +#include "ov-scalar.h" +#include "ops.h" +#include "xpow.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "smx-scm-s.h" +#include "smx-s-scm.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +// sparse complex matrix by scalar ops. + +DEFBINOP_OP (add, sparse_complex_matrix, scalar, +) +DEFBINOP_OP (sub, sparse_complex_matrix, scalar, -) +DEFBINOP_OP (mul, sparse_complex_matrix, scalar, *) + +DEFBINOP (div, sparse_complex_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_scalar&); + + double d = v2.double_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v1.sparse_complex_matrix_value () / d); + + return retval; +} + +DEFBINOP (pow, sparse_complex_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_scalar&); + + double tmp = v2.scalar_value (); + if (static_cast (tmp) == tmp) + return xpow (v1.sparse_complex_matrix_value (), tmp); + else + return xpow (v1.complex_matrix_value (), tmp); +} + +DEFBINOP (ldiv, sparse_complex_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_scalar&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (SparseComplexMatrix (1, 1, v2.scalar_value () / d)); + } + else + { + MatrixType typ = v1.matrix_type (); + SparseComplexMatrix m1 = v1.sparse_complex_matrix_value (); + Matrix m2 = Matrix (1, 1, v2.scalar_value ()); + ComplexMatrix ret = xleftdiv (m1, m2, typ); + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (lt, sparse_complex_matrix, scalar, mx_el_lt) +DEFBINOP_FN (le, sparse_complex_matrix, scalar, mx_el_le) +DEFBINOP_FN (eq, sparse_complex_matrix, scalar, mx_el_eq) +DEFBINOP_FN (ge, sparse_complex_matrix, scalar, mx_el_ge) +DEFBINOP_FN (gt, sparse_complex_matrix, scalar, mx_el_gt) +DEFBINOP_FN (ne, sparse_complex_matrix, scalar, mx_el_ne) + +DEFBINOP_OP (el_mul, sparse_complex_matrix, scalar, *) + +DEFBINOP (el_div, sparse_complex_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_scalar&); + + double d = v2.double_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v1.sparse_complex_matrix_value () / d); + + return retval; +} + +DEFBINOP_FN (el_pow, sparse_complex_matrix, scalar, elem_xpow) + +DEFBINOP (el_ldiv, sparse_complex_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_scalar&); + + return octave_value + (x_el_div (v2.double_value (), v1.sparse_complex_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_complex_matrix, scalar, mx_el_and) +DEFBINOP_FN (el_or, sparse_complex_matrix, scalar, mx_el_or) + +DEFCATOP (scm_s, sparse_complex_matrix, scalar) +{ + CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_scalar&); + SparseComplexMatrix tmp (1, 1, v2.complex_value ()); + return octave_value + (v1.sparse_complex_matrix_value (). concat (tmp, ra_idx)); +} + +DEFASSIGNOP (assign, sparse_complex_matrix, scalar) +{ + CAST_BINOP_ARGS (octave_sparse_complex_matrix&, const octave_scalar&); + + SparseComplexMatrix tmp (1, 1, v2.complex_value ()); + v1.assign (idx, tmp); + return octave_value (); +} + +void +install_scm_s_ops (void) +{ + INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_scalar, add); + INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_scalar, sub); + INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_scalar, mul); + INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_scalar, div); + INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, octave_scalar, pow); + INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, octave_scalar, ldiv); + INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, octave_scalar, lt); + INSTALL_BINOP (op_le, octave_sparse_complex_matrix, octave_scalar, le); + INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, octave_scalar, eq); + INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, octave_scalar, ge); + INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, octave_scalar, gt); + INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, octave_scalar, ne); + INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, octave_scalar, + el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, octave_scalar, + el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, octave_scalar, + el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, octave_scalar, + el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, octave_scalar, + el_and); + INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, octave_scalar, + el_or); + + INSTALL_CATOP (octave_sparse_complex_matrix, octave_scalar, scm_s); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, octave_scalar, + assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-scm-scm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-scm-scm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,248 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" + +#include "sparse-xdiv.h" +#include "sparse-xpow.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// unary sparse complex matrix ops. + +DEFUNOP_OP (not, sparse_complex_matrix, !) +DEFUNOP_OP (uplus, sparse_complex_matrix, /* no-op */) +DEFUNOP_OP (uminus, sparse_complex_matrix, -) + +DEFUNOP (transpose, sparse_complex_matrix) +{ + CAST_UNOP_ARG (const octave_sparse_complex_matrix&); + return octave_value + (v.sparse_complex_matrix_value ().transpose (), + v.matrix_type ().transpose ()); +} + +DEFUNOP (hermitian, sparse_complex_matrix) +{ + CAST_UNOP_ARG (const octave_sparse_complex_matrix&); + return octave_value + (v.sparse_complex_matrix_value ().hermitian (), + v.matrix_type ().transpose ()); +} + +#if 0 +DEFUNOP (incr, sparse_complex_matrix) +{ + CAST_UNOP_ARG (const octave_sparse_complex_matrix&); + + return octave_value (v.complex_matrix_value () .increment ()); +} + +DEFUNOP (decr, sparse_complex_matrix) +{ + CAST_UNOP_ARG (const octave_sparse_complex_matrix&); + + return octave_value (v.complex_matrix_value () .decrement ()); +} +#endif + +// complex matrix by complex matrix ops. + +DEFBINOP_OP (add, sparse_complex_matrix, sparse_complex_matrix, +) +DEFBINOP_OP (sub, sparse_complex_matrix, sparse_complex_matrix, -) + +DEFBINOP_OP (mul, sparse_complex_matrix, sparse_complex_matrix, *) + +DEFBINOP (div, sparse_complex_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.sparse_complex_matrix_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + SparseComplexMatrix ret = xdiv (v1.sparse_complex_matrix_value (), + v2.sparse_complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOPX (pow, sparse_complex_matrix, sparse_complex_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, sparse_complex_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_sparse_complex_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.sparse_complex_matrix_value () / d); + } + else + { + MatrixType typ = v1.matrix_type (); + + SparseComplexMatrix ret = + xleftdiv (v1.sparse_complex_matrix_value (), + v2.sparse_complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (lt, sparse_complex_matrix, sparse_complex_matrix, mx_el_lt) +DEFBINOP_FN (le, sparse_complex_matrix, sparse_complex_matrix, mx_el_le) +DEFBINOP_FN (eq, sparse_complex_matrix, sparse_complex_matrix, mx_el_eq) +DEFBINOP_FN (ge, sparse_complex_matrix, sparse_complex_matrix, mx_el_ge) +DEFBINOP_FN (gt, sparse_complex_matrix, sparse_complex_matrix, mx_el_gt) +DEFBINOP_FN (ne, sparse_complex_matrix, sparse_complex_matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, sparse_complex_matrix, sparse_complex_matrix, product) +DEFBINOP_FN (el_div, sparse_complex_matrix, sparse_complex_matrix, quotient) +DEFBINOP_FN (el_pow, sparse_complex_matrix, sparse_complex_matrix, elem_xpow) + +DEFBINOP (el_ldiv, sparse_complex_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_sparse_complex_matrix&); + + return octave_value (quotient (v2.sparse_complex_matrix_value (), + v1.sparse_complex_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_complex_matrix, sparse_complex_matrix, mx_el_and) +DEFBINOP_FN (el_or, sparse_complex_matrix, sparse_complex_matrix, mx_el_or) + +DEFCATOP_FN (scm_scm, sparse_complex_matrix, sparse_complex_matrix, concat) + +DEFASSIGNOP_FN (assign, sparse_complex_matrix, sparse_complex_matrix, assign) + +DEFNULLASSIGNOP_FN (null_assign, sparse_complex_matrix, delete_elements) + +void +install_scm_scm_ops (void) +{ + INSTALL_UNOP (op_not, octave_sparse_complex_matrix, not); + INSTALL_UNOP (op_uplus, octave_sparse_complex_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_sparse_complex_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_sparse_complex_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_sparse_complex_matrix, hermitian); + +#if 0 + INSTALL_NCUNOP (op_incr, octave_sparse_complex_matrix, incr); + INSTALL_NCUNOP (op_decr, octave_sparse_complex_matrix, decr); +#endif + + INSTALL_BINOP (op_add, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, el_or); + + INSTALL_CATOP (octave_sparse_complex_matrix, + octave_sparse_complex_matrix, scm_scm); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, + octave_sparse_complex_matrix, assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, + octave_null_matrix, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, + octave_null_str, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, + octave_null_sq_str, null_assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-scm-sm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-scm-sm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,174 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ops.h" + +#include "sparse-xdiv.h" +#include "sparse-xpow.h" +#include "smx-sm-scm.h" +#include "smx-scm-sm.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +// sparse complex matrix by sparse matrix ops. + +DEFBINOP_OP (add, sparse_complex_matrix, sparse_matrix, +) +DEFBINOP_OP (sub, sparse_complex_matrix, sparse_matrix, -) + +DEFBINOP_OP (mul, sparse_complex_matrix, sparse_matrix, *) + +DEFBINOP (div, sparse_complex_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + double d = v2.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.sparse_complex_matrix_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + SparseComplexMatrix ret = xdiv (v1.sparse_complex_matrix_value (), + v2.sparse_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOPX (pow, sparse_complex_matrix, sparse_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, sparse_complex_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, const octave_sparse_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.sparse_matrix_value () / d); + } + else + { + MatrixType typ = v1.matrix_type (); + + SparseComplexMatrix ret = xleftdiv (v1.sparse_complex_matrix_value (), + v2.sparse_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (lt, sparse_complex_matrix, sparse_matrix, mx_el_lt) +DEFBINOP_FN (le, sparse_complex_matrix, sparse_matrix, mx_el_le) +DEFBINOP_FN (eq, sparse_complex_matrix, sparse_matrix, mx_el_eq) +DEFBINOP_FN (ge, sparse_complex_matrix, sparse_matrix, mx_el_ge) +DEFBINOP_FN (gt, sparse_complex_matrix, sparse_matrix, mx_el_gt) +DEFBINOP_FN (ne, sparse_complex_matrix, sparse_matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, sparse_complex_matrix, sparse_matrix, product) +DEFBINOP_FN (el_div, sparse_complex_matrix, sparse_matrix, quotient) +DEFBINOP_FN (el_pow, sparse_complex_matrix, sparse_matrix, elem_xpow) + +DEFBINOP (el_ldiv, sparse_complex_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_complex_matrix&, + const octave_sparse_matrix&); + + return octave_value + (quotient (v2.sparse_matrix_value (), v1.sparse_complex_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_complex_matrix, sparse_matrix, mx_el_and) +DEFBINOP_FN (el_or, sparse_complex_matrix, sparse_matrix, mx_el_or) + +DEFCATOP_FN (scm_sm, sparse_complex_matrix, sparse_matrix, concat) + +DEFASSIGNOP_FN (assign, sparse_complex_matrix, sparse_matrix, assign) + +void +install_scm_sm_ops (void) +{ + INSTALL_BINOP (op_add, octave_sparse_complex_matrix, octave_sparse_matrix, + add); + INSTALL_BINOP (op_sub, octave_sparse_complex_matrix, octave_sparse_matrix, + sub); + INSTALL_BINOP (op_mul, octave_sparse_complex_matrix, octave_sparse_matrix, + mul); + INSTALL_BINOP (op_div, octave_sparse_complex_matrix, octave_sparse_matrix, + div); + INSTALL_BINOP (op_pow, octave_sparse_complex_matrix, octave_sparse_matrix, + pow); + INSTALL_BINOP (op_ldiv, octave_sparse_complex_matrix, octave_sparse_matrix, + ldiv); + INSTALL_BINOP (op_lt, octave_sparse_complex_matrix, octave_sparse_matrix, + lt); + INSTALL_BINOP (op_le, octave_sparse_complex_matrix, octave_sparse_matrix, + le); + INSTALL_BINOP (op_eq, octave_sparse_complex_matrix, octave_sparse_matrix, + eq); + INSTALL_BINOP (op_ge, octave_sparse_complex_matrix, octave_sparse_matrix, + ge); + INSTALL_BINOP (op_gt, octave_sparse_complex_matrix, octave_sparse_matrix, + gt); + INSTALL_BINOP (op_ne, octave_sparse_complex_matrix, octave_sparse_matrix, + ne); + INSTALL_BINOP (op_el_mul, octave_sparse_complex_matrix, + octave_sparse_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_complex_matrix, + octave_sparse_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_complex_matrix, + octave_sparse_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_complex_matrix, + octave_sparse_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_complex_matrix, + octave_sparse_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_sparse_complex_matrix, + octave_sparse_matrix, el_or); + + INSTALL_CATOP (octave_sparse_complex_matrix, octave_sparse_matrix, scm_sm); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_complex_matrix, + octave_sparse_matrix, assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-sm-cm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-sm-cm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,173 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-cx-mat.h" +#include "ops.h" +#include "xdiv.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "smx-sm-cm.h" +#include "smx-cm-sm.h" +#include "ov-re-sparse.h" + +// sparse matrix by complex matrix ops. + +DEFBINOP_OP (add, sparse_matrix, complex_matrix, +) +DEFBINOP_OP (sub, sparse_matrix, complex_matrix, -) + +DEFBINOP_OP (mul, sparse_matrix, complex_matrix, *) + +DEFBINOP (div, sparse_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, + const octave_complex_matrix&); + MatrixType typ = v2.matrix_type (); + + ComplexMatrix ret = xdiv (v1.matrix_value (), + v2.complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOPX (pow, sparse_matrix, complex_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, sparse_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + double d = v1.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_array_value () / d); + } + else + { + MatrixType typ = v1.matrix_type (); + + ComplexMatrix ret = xleftdiv (v1.sparse_matrix_value (), + v2.complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (lt, sparse_matrix, complex_matrix, mx_el_lt) +DEFBINOP_FN (le, sparse_matrix, complex_matrix, mx_el_le) +DEFBINOP_FN (eq, sparse_matrix, complex_matrix, mx_el_eq) +DEFBINOP_FN (ge, sparse_matrix, complex_matrix, mx_el_ge) +DEFBINOP_FN (gt, sparse_matrix, complex_matrix, mx_el_gt) +DEFBINOP_FN (ne, sparse_matrix, complex_matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, sparse_matrix, complex_matrix, product) +DEFBINOP_FN (el_div, sparse_matrix, complex_matrix, quotient) + +DEFBINOP (el_pow, sparse_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, + const octave_complex_matrix&); + + return octave_value + (elem_xpow (v1.sparse_matrix_value (), SparseComplexMatrix + (v2.complex_matrix_value ()))); +} + +DEFBINOP (el_ldiv, sparse_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, + const octave_complex_matrix&); + + return octave_value + (quotient (v2.complex_matrix_value (), v1.sparse_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_matrix, complex_matrix, mx_el_and) +DEFBINOP_FN (el_or, sparse_matrix, complex_matrix, mx_el_or) + +DEFCATOP (sm_cm, sparse_matrix, complex_matrix) +{ + CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_complex_matrix&); + SparseComplexMatrix tmp (v2.complex_matrix_value ()); + return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); +} + +DEFCONV (sparse_complex_matrix_conv, sparse_matrix, sparse_complex_matrix) +{ + CAST_CONV_ARG (const octave_sparse_matrix&); + return new octave_complex_matrix (v.complex_matrix_value ()); +} + +void +install_sm_cm_ops (void) +{ + INSTALL_BINOP (op_add, octave_sparse_matrix, octave_complex_matrix, add); + INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_complex_matrix, sub); + INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_complex_matrix, mul); + INSTALL_BINOP (op_div, octave_sparse_matrix, octave_complex_matrix, div); + INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_complex_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_complex_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_complex_matrix, lt); + INSTALL_BINOP (op_le, octave_sparse_matrix, octave_complex_matrix, le); + INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_complex_matrix, eq); + INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_complex_matrix, ge); + INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_complex_matrix, gt); + INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_complex_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_sparse_matrix, octave_complex_matrix, + el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_matrix, octave_complex_matrix, + el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_matrix, octave_complex_matrix, + el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, octave_complex_matrix, + el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_matrix, octave_complex_matrix, + el_and); + INSTALL_BINOP (op_el_or, octave_sparse_matrix, octave_complex_matrix, + el_or); + + INSTALL_CATOP (octave_sparse_matrix, octave_complex_matrix, sm_cm); + + INSTALL_ASSIGNCONV (octave_sparse_matrix, octave_complex_matrix, + octave_sparse_complex_matrix); + + INSTALL_WIDENOP (octave_sparse_matrix, octave_complex_matrix, + sparse_complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-sm-cs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-sm-cs.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,165 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-complex.h" +#include "ops.h" +#include "xpow.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "smx-sm-cs.h" +#include "smx-cs-sm.h" + +// sparse matrix by scalar ops. + +DEFBINOP_OP (add, sparse_matrix, complex, +) +DEFBINOP_OP (sub, sparse_matrix, complex, -) +DEFBINOP_OP (mul, sparse_matrix, complex, *) + +DEFBINOP (div, sparse_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex&); + + Complex d = v2.complex_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v1.sparse_matrix_value () / d); + + return retval; +} + +DEFBINOP (pow, sparse_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex&); + return xpow (v1.matrix_value (), v2.complex_value ()); +} + +DEFBINOP (ldiv, sparse_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + double d = v1.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (SparseComplexMatrix (1, 1, v2.complex_value () / d)); + } + else + { + MatrixType typ = v1.matrix_type (); + SparseMatrix m1 = v1.sparse_matrix_value (); + ComplexMatrix m2 = ComplexMatrix (1, 1, v2.complex_value ()); + ComplexMatrix ret = xleftdiv (m1, m2, typ); + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (lt, sparse_matrix, complex, mx_el_lt) +DEFBINOP_FN (le, sparse_matrix, complex, mx_el_le) +DEFBINOP_FN (eq, sparse_matrix, complex, mx_el_eq) +DEFBINOP_FN (ge, sparse_matrix, complex, mx_el_ge) +DEFBINOP_FN (gt, sparse_matrix, complex, mx_el_gt) +DEFBINOP_FN (ne, sparse_matrix, complex, mx_el_ne) + +DEFBINOP_OP (el_mul, sparse_matrix, complex, *) + +DEFBINOP (el_div, sparse_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex&); + + Complex d = v2.complex_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v1.sparse_matrix_value () / d); + + return retval; +} + +DEFBINOP_FN (el_pow, sparse_matrix, complex, elem_xpow) + +DEFBINOP (el_ldiv, sparse_matrix, complex) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_complex&); + + return octave_value (x_el_div (v2.complex_value (), + v1.sparse_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_matrix, complex, mx_el_and) +DEFBINOP_FN (el_or, sparse_matrix, complex, mx_el_or) + +DEFCATOP (sm_cs, sparse_matrix, complex) +{ + CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_complex&); + SparseComplexMatrix tmp (1, 1, v2.complex_value ()); + return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); +} + +void +install_sm_cs_ops (void) +{ + INSTALL_BINOP (op_add, octave_sparse_matrix, octave_complex, add); + INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_complex, sub); + INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_complex, mul); + INSTALL_BINOP (op_div, octave_sparse_matrix, octave_complex, div); + INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_complex, pow); + INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_complex, ldiv); + + INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_complex, lt); + INSTALL_BINOP (op_le, octave_sparse_matrix, octave_complex, le); + INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_complex, eq); + INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_complex, ge); + INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_complex, gt); + INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_complex, ne); + INSTALL_BINOP (op_el_mul, octave_sparse_matrix, octave_complex, el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_matrix, octave_complex, el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_matrix, octave_complex, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, octave_complex, el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_matrix, octave_complex, el_and); + INSTALL_BINOP (op_el_or, octave_sparse_matrix, octave_complex, el_or); + + INSTALL_CATOP (octave_sparse_matrix, octave_complex, sm_cs); + + INSTALL_ASSIGNCONV (octave_sparse_matrix, octave_complex, + octave_sparse_complex_matrix); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-sm-m.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-sm-m.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,165 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-re-mat.h" +#include "ops.h" +#include "xdiv.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "smx-sm-m.h" +#include "smx-m-sm.h" +#include "ov-re-sparse.h" + +// sparse matrix by matrix ops. + +DEFBINOP_OP (add, sparse_matrix, matrix, +) +DEFBINOP_OP (sub, sparse_matrix, matrix, -) + +DEFBINOP_OP (mul, sparse_matrix, matrix, *) + +DEFBINOP (div, sparse_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_matrix&); + MatrixType typ = v2.matrix_type (); + + Matrix ret = xdiv (v1.matrix_value (), v2.matrix_value (), typ); + + v2.matrix_type (typ); + return ret; +} + +DEFBINOPX (pow, sparse_matrix, matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, sparse_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + double d = v1.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.array_value () / d); + } + else + { + MatrixType typ = v1.matrix_type (); + + Matrix ret = xleftdiv (v1.sparse_matrix_value (), + v2.matrix_value (), typ); + + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (trans_mul, sparse_matrix, matrix, trans_mul); + +DEFBINOP_FN (lt, sparse_matrix, matrix, mx_el_lt) +DEFBINOP_FN (le, sparse_matrix, matrix, mx_el_le) +DEFBINOP_FN (eq, sparse_matrix, matrix, mx_el_eq) +DEFBINOP_FN (ge, sparse_matrix, matrix, mx_el_ge) +DEFBINOP_FN (gt, sparse_matrix, matrix, mx_el_gt) +DEFBINOP_FN (ne, sparse_matrix, matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, sparse_matrix, matrix, product) +DEFBINOP_FN (el_div, sparse_matrix, matrix, quotient) + +DEFBINOP (el_pow, sparse_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_matrix&); + + return octave_value (elem_xpow (v1.sparse_matrix_value (), + SparseMatrix (v2.matrix_value ()))); +} + +DEFBINOP (el_ldiv, sparse_matrix, matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_matrix&); + + return octave_value + (quotient (v2.matrix_value (), v1.sparse_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_matrix, matrix, mx_el_and) +DEFBINOP_FN (el_or, sparse_matrix, matrix, mx_el_or) + +DEFCATOP (sm_m, sparse_matrix, matrix) +{ + CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_matrix&); + SparseMatrix tmp (v2.matrix_value ()); + return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); +} + +DEFASSIGNOP (assign, sparse_matrix, matrix) +{ + CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_matrix&); + + SparseMatrix tmp (v2.matrix_value ()); + v1.assign (idx, tmp); + return octave_value (); +} + +void +install_sm_m_ops (void) +{ + INSTALL_BINOP (op_add, octave_sparse_matrix, octave_matrix, add); + INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_matrix, sub); + INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_matrix, mul); + INSTALL_BINOP (op_div, octave_sparse_matrix, octave_matrix, div); + INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_matrix, ldiv); + INSTALL_BINOP (op_trans_mul, octave_sparse_matrix, octave_matrix, trans_mul); + INSTALL_BINOP (op_herm_mul, octave_sparse_matrix, octave_matrix, trans_mul); + INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_matrix, lt); + INSTALL_BINOP (op_le, octave_sparse_matrix, octave_matrix, le); + INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_matrix, eq); + INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_matrix, ge); + INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_matrix, gt); + INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_sparse_matrix, octave_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_matrix, octave_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_matrix, octave_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, octave_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_matrix, octave_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_sparse_matrix, octave_matrix, el_or); + + INSTALL_CATOP (octave_sparse_matrix, octave_matrix, sm_m); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_matrix, assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-sm-s.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-sm-s.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,175 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-scalar.h" +#include "ops.h" +#include "xpow.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "ov-re-sparse.h" + +// sparse matrix by scalar ops. + +DEFBINOP_OP (add, sparse_matrix, scalar, +) +DEFBINOP_OP (sub, sparse_matrix, scalar, -) +DEFBINOP_OP (mul, sparse_matrix, scalar, *) + +DEFBINOP (div, sparse_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_scalar&); + + double d = v2.double_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v1.sparse_matrix_value () / d); + + return retval; +} + +DEFBINOP (pow, sparse_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_scalar&); + + double tmp = v2.scalar_value (); + if (static_cast (tmp) == tmp) + return xpow (v1.sparse_matrix_value (), tmp); + else + return xpow (v1.matrix_value (), tmp); +} + +DEFBINOP (ldiv, sparse_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_scalar&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + double d = v1.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (SparseMatrix(1, 1, v2.scalar_value () / d)); + } + else + { + MatrixType typ = v1.matrix_type (); + SparseMatrix m1 = v1.sparse_matrix_value (); + Matrix m2 = Matrix (1, 1, v2.scalar_value ()); + Matrix ret = xleftdiv (m1, m2, typ); + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (lt, sparse_matrix, scalar, mx_el_lt) +DEFBINOP_FN (le, sparse_matrix, scalar, mx_el_le) +DEFBINOP_FN (eq, sparse_matrix, scalar, mx_el_eq) +DEFBINOP_FN (ge, sparse_matrix, scalar, mx_el_ge) +DEFBINOP_FN (gt, sparse_matrix, scalar, mx_el_gt) +DEFBINOP_FN (ne, sparse_matrix, scalar, mx_el_ne) + +DEFBINOP_OP (el_mul, sparse_matrix, scalar, *) + +DEFBINOP (el_div, sparse_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_scalar&); + + double d = v2.double_value (); + octave_value retval; + + if (d == 0.0) + gripe_divide_by_zero (); + + retval = octave_value (v1.sparse_matrix_value () / d); + + return retval; +} + +DEFBINOP_FN (el_pow, sparse_matrix, scalar, elem_xpow) + +DEFBINOP (el_ldiv, sparse_matrix, scalar) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_scalar&); + + return octave_value + (x_el_div (v2.complex_value (), v1.sparse_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_matrix, scalar, mx_el_and) +DEFBINOP_FN (el_or, sparse_matrix, scalar, mx_el_or) + +DEFCATOP (sm_s, sparse_matrix, scalar) +{ + CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_scalar&); + SparseMatrix tmp (1, 1, v2.scalar_value ()); + return octave_value (v1.sparse_matrix_value (). concat (tmp, ra_idx)); +} + +DEFASSIGNOP (assign, sparse_matrix, scalar) +{ + CAST_BINOP_ARGS (octave_sparse_matrix&, const octave_scalar&); + + SparseMatrix tmp (1, 1, v2.scalar_value ()); + v1.assign (idx, tmp); + return octave_value (); +} + +void +install_sm_s_ops (void) +{ + INSTALL_BINOP (op_add, octave_sparse_matrix, octave_scalar, add); + INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_scalar, sub); + INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_scalar, mul); + INSTALL_BINOP (op_div, octave_sparse_matrix, octave_scalar, div); + INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_scalar, pow); + INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_scalar, ldiv); + + INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_scalar, lt); + INSTALL_BINOP (op_le, octave_sparse_matrix, octave_scalar, le); + INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_scalar, eq); + INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_scalar, ge); + INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_scalar, gt); + INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_scalar, ne); + INSTALL_BINOP (op_el_mul, octave_sparse_matrix, octave_scalar, el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_matrix, octave_scalar, el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_matrix, octave_scalar, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, octave_scalar, el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_matrix, octave_scalar, el_and); + INSTALL_BINOP (op_el_or, octave_sparse_matrix, octave_scalar, el_or); + + INSTALL_CATOP (octave_sparse_matrix, octave_scalar, sm_s); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_scalar, assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-sm-scm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-sm-scm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,182 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ops.h" + +#include "sparse-xdiv.h" +#include "sparse-xpow.h" +#include "smx-sm-scm.h" +#include "smx-scm-sm.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +// sparse matrix by sparse complex matrix ops. + +DEFBINOP_OP (add, sparse_matrix, sparse_complex_matrix, +) +DEFBINOP_OP (sub, sparse_matrix, sparse_complex_matrix, -) + +DEFBINOP_OP (mul, sparse_matrix, sparse_complex_matrix, *) + +DEFBINOP (div, sparse_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_complex_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.sparse_matrix_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + SparseComplexMatrix ret = xdiv (v1.sparse_matrix_value (), + v2.sparse_complex_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOPX (pow, sparse_matrix, sparse_complex_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, sparse_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_complex_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + double d = v1.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.sparse_complex_matrix_value () / d); + } + else + { + MatrixType typ = v1.matrix_type (); + + SparseComplexMatrix ret = + xleftdiv (v1.sparse_matrix_value (), + v2.sparse_complex_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (lt, sparse_matrix, sparse_complex_matrix, mx_el_lt) +DEFBINOP_FN (le, sparse_matrix, sparse_complex_matrix, mx_el_le) +DEFBINOP_FN (eq, sparse_matrix, sparse_complex_matrix, mx_el_eq) +DEFBINOP_FN (ge, sparse_matrix, sparse_complex_matrix, mx_el_ge) +DEFBINOP_FN (gt, sparse_matrix, sparse_complex_matrix, mx_el_gt) +DEFBINOP_FN (ne, sparse_matrix, sparse_complex_matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, sparse_matrix, sparse_complex_matrix, product) +DEFBINOP_FN (el_div, sparse_matrix, sparse_complex_matrix, quotient) +DEFBINOP_FN (el_pow, sparse_matrix, sparse_complex_matrix, elem_xpow) + +DEFBINOP (el_ldiv, sparse_matrix, sparse_complex_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, + const octave_sparse_complex_matrix&); + + return octave_value + (quotient (v2.sparse_complex_matrix_value (), v1.sparse_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_matrix, sparse_complex_matrix, mx_el_and) +DEFBINOP_FN (el_or, sparse_matrix, sparse_complex_matrix, mx_el_or) + +DEFCATOP_FN (sm_scm, sparse_matrix, sparse_complex_matrix, concat) + +DEFCONV (sparse_complex_matrix_conv, sparse_matrix, sparse_complex_matrix) +{ + CAST_CONV_ARG (const octave_sparse_matrix&); + return new octave_sparse_complex_matrix (v.sparse_complex_matrix_value ()); +} + +void +install_sm_scm_ops (void) +{ + INSTALL_BINOP (op_add, octave_sparse_matrix, octave_sparse_complex_matrix, + add); + INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_sparse_complex_matrix, + sub); + INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_sparse_complex_matrix, + mul); + INSTALL_BINOP (op_div, octave_sparse_matrix, octave_sparse_complex_matrix, + div); + INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_sparse_complex_matrix, + pow); + INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_sparse_complex_matrix, + ldiv); + INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_sparse_complex_matrix, + lt); + INSTALL_BINOP (op_le, octave_sparse_matrix, octave_sparse_complex_matrix, + le); + INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_sparse_complex_matrix, + eq); + INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_sparse_complex_matrix, + ge); + INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_sparse_complex_matrix, + gt); + INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_sparse_complex_matrix, + ne); + INSTALL_BINOP (op_el_mul, octave_sparse_matrix, + octave_sparse_complex_matrix, el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_matrix, + octave_sparse_complex_matrix, el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_matrix, + octave_sparse_complex_matrix, el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, + octave_sparse_complex_matrix, el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_matrix, + octave_sparse_complex_matrix, el_and); + INSTALL_BINOP (op_el_or, octave_sparse_matrix, + octave_sparse_complex_matrix, el_or); + + INSTALL_CATOP (octave_sparse_matrix, octave_sparse_complex_matrix, sm_scm); + + INSTALL_ASSIGNCONV (octave_sparse_matrix, octave_sparse_complex_matrix, + octave_sparse_complex_matrix); + + INSTALL_WIDENOP (octave_sparse_matrix, octave_sparse_complex_matrix, + sparse_complex_matrix_conv); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-sm-sm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-sm-sm.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,196 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-typeinfo.h" +#include "ov-re-mat.h" +#include "ov-null-mat.h" +#include "ops.h" + +#include "sparse-xpow.h" +#include "sparse-xdiv.h" +#include "ov-re-sparse.h" + +// sparse matrix unary ops. + +DEFUNOP_OP (not, sparse_matrix, !) +DEFUNOP_OP (uplus, sparse_matrix, /* no-op */) +DEFUNOP_OP (uminus, sparse_matrix, -) + +DEFUNOP (transpose, sparse_matrix) +{ + CAST_UNOP_ARG (const octave_sparse_matrix&); + return octave_value (v.sparse_matrix_value ().transpose (), + v.matrix_type ().transpose ()); +} + +// sparse matrix by sparse matrix ops. + +DEFBINOP_OP (add, sparse_matrix, sparse_matrix, +) + +// DEFBINOP_OP (sub, sparse_matrix, sparse_matrix, -) + + static octave_value + oct_binop_sub (const octave_base_value& a1, const octave_base_value& a2) + { + const octave_sparse_matrix& v1 = dynamic_cast (a1); + const octave_sparse_matrix& v2 = dynamic_cast (a2); + SparseMatrix m = v1.sparse_matrix_value () - v2.sparse_matrix_value (); + + return octave_value (m); + } + +DEFBINOP_OP (mul, sparse_matrix, sparse_matrix, *) + +DEFBINOP (div, sparse_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_matrix&); + + if (v2.rows () == 1 && v2.columns () == 1) + { + double d = v2.scalar_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.sparse_matrix_value () / d); + } + else + { + MatrixType typ = v2.matrix_type (); + SparseMatrix ret = xdiv (v1.sparse_matrix_value (), + v2.sparse_matrix_value (), typ); + + v2.matrix_type (typ); + return ret; + } +} + +DEFBINOPX (pow, sparse_matrix, sparse_matrix) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +DEFBINOP (ldiv, sparse_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_matrix&); + + if (v1.rows () == 1 && v1.columns () == 1) + { + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.sparse_matrix_value () / d); + } + else + { + MatrixType typ = v1.matrix_type (); + + SparseMatrix ret = xleftdiv (v1.sparse_matrix_value (), + v2.sparse_matrix_value (), typ); + + v1.matrix_type (typ); + return ret; + } +} + +DEFBINOP_FN (lt, sparse_matrix, sparse_matrix, mx_el_lt) +DEFBINOP_FN (le, sparse_matrix, sparse_matrix, mx_el_le) +DEFBINOP_FN (eq, sparse_matrix, sparse_matrix, mx_el_eq) +DEFBINOP_FN (ge, sparse_matrix, sparse_matrix, mx_el_ge) +DEFBINOP_FN (gt, sparse_matrix, sparse_matrix, mx_el_gt) +DEFBINOP_FN (ne, sparse_matrix, sparse_matrix, mx_el_ne) + +DEFBINOP_FN (el_mul, sparse_matrix, sparse_matrix, product) +DEFBINOP_FN (el_div, sparse_matrix, sparse_matrix, quotient) + +DEFBINOP_FN (el_pow, sparse_matrix, sparse_matrix, elem_xpow) + +DEFBINOP (el_ldiv, sparse_matrix, sparse_matrix) +{ + CAST_BINOP_ARGS (const octave_sparse_matrix&, const octave_sparse_matrix&); + return octave_value + (quotient (v2.sparse_matrix_value (), v1.sparse_matrix_value ())); +} + +DEFBINOP_FN (el_and, sparse_matrix, sparse_matrix, mx_el_and) +DEFBINOP_FN (el_or, sparse_matrix, sparse_matrix, mx_el_or) + +DEFCATOP_FN (sm_sm, sparse_matrix, sparse_matrix, concat) + +DEFASSIGNOP_FN (assign, sparse_matrix, sparse_matrix, assign) + +DEFNULLASSIGNOP_FN (null_assign, sparse_matrix, delete_elements) + +void +install_sm_sm_ops (void) +{ + INSTALL_UNOP (op_not, octave_sparse_matrix, not); + INSTALL_UNOP (op_uplus, octave_sparse_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_sparse_matrix, uminus); + INSTALL_UNOP (op_transpose, octave_sparse_matrix, transpose); + INSTALL_UNOP (op_hermitian, octave_sparse_matrix, transpose); + + INSTALL_BINOP (op_add, octave_sparse_matrix, octave_sparse_matrix, add); + INSTALL_BINOP (op_sub, octave_sparse_matrix, octave_sparse_matrix, sub); + INSTALL_BINOP (op_mul, octave_sparse_matrix, octave_sparse_matrix, mul); + INSTALL_BINOP (op_div, octave_sparse_matrix, octave_sparse_matrix, div); + INSTALL_BINOP (op_pow, octave_sparse_matrix, octave_sparse_matrix, pow); + INSTALL_BINOP (op_ldiv, octave_sparse_matrix, octave_sparse_matrix, ldiv); + INSTALL_BINOP (op_lt, octave_sparse_matrix, octave_sparse_matrix, lt); + INSTALL_BINOP (op_le, octave_sparse_matrix, octave_sparse_matrix, le); + INSTALL_BINOP (op_eq, octave_sparse_matrix, octave_sparse_matrix, eq); + INSTALL_BINOP (op_ge, octave_sparse_matrix, octave_sparse_matrix, ge); + INSTALL_BINOP (op_gt, octave_sparse_matrix, octave_sparse_matrix, gt); + INSTALL_BINOP (op_ne, octave_sparse_matrix, octave_sparse_matrix, ne); + INSTALL_BINOP (op_el_mul, octave_sparse_matrix, octave_sparse_matrix, + el_mul); + INSTALL_BINOP (op_el_div, octave_sparse_matrix, octave_sparse_matrix, + el_div); + INSTALL_BINOP (op_el_pow, octave_sparse_matrix, octave_sparse_matrix, + el_pow); + INSTALL_BINOP (op_el_ldiv, octave_sparse_matrix, octave_sparse_matrix, + el_ldiv); + INSTALL_BINOP (op_el_and, octave_sparse_matrix, octave_sparse_matrix, + el_and); + INSTALL_BINOP (op_el_or, octave_sparse_matrix, octave_sparse_matrix, + el_or); + + INSTALL_CATOP (octave_sparse_matrix, octave_sparse_matrix, sm_sm); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_sparse_matrix, + assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_null_matrix, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_null_str, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_sparse_matrix, octave_null_sq_str, null_assign); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-str-m.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-str-m.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,64 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-str-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" + +DEFASSIGNOP (assign, char_matrix_str, octave_matrix) +{ + CAST_BINOP_ARGS (octave_char_matrix_str&, const octave_matrix&); + + octave_value tmp + = v2.convert_to_str_internal (false, false, + a1.is_sq_string () ? '\'' : '"'); + + if (! error_state) + v1.assign (idx, tmp.char_array_value ()); + + return octave_value (); +} + +DEFNDCHARCATOP_FN (str_m, char_matrix_str, matrix, concat) + +DEFNDCHARCATOP_FN (m_str, matrix, char_matrix_str, concat) + +void +install_str_m_ops (void) +{ + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_matrix, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_matrix, assign); + + INSTALL_CATOP (octave_char_matrix_str, octave_matrix, str_m); + INSTALL_CATOP (octave_char_matrix_sq_str, octave_matrix, str_m); + + INSTALL_CATOP (octave_matrix, octave_char_matrix_str, m_str); + INSTALL_CATOP (octave_matrix, octave_char_matrix_sq_str, m_str); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-str-s.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-str-s.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,64 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-str-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" + +DEFASSIGNOP (assign, char_matrix_str, octave_scalar) +{ + CAST_BINOP_ARGS (octave_char_matrix_str&, const octave_scalar&); + + octave_value tmp + = v2.convert_to_str_internal (false, false, + a1.is_sq_string () ? '\'' : '"'); + + if (! error_state) + v1.assign (idx, tmp.char_array_value ()); + + return octave_value (); +} + +DEFNDCHARCATOP_FN (str_s, char_matrix_str, scalar, concat) + +DEFNDCHARCATOP_FN (s_str, scalar, char_matrix_str, concat) + +void +install_str_s_ops (void) +{ + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_scalar, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_scalar, assign); + + INSTALL_CATOP (octave_char_matrix_str, octave_scalar, str_s); + INSTALL_CATOP (octave_char_matrix_sq_str, octave_scalar, str_s); + + INSTALL_CATOP (octave_scalar, octave_char_matrix_str, s_str); + INSTALL_CATOP (octave_scalar, octave_char_matrix_sq_str, s_str); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-str-str.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-str-str.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,155 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-str-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" + +// string unary ops. + +DEFUNOP (transpose, char_matrix_str) +{ + CAST_UNOP_ARG (const octave_char_matrix_str&); + + if (v.ndims () > 2) + { + error ("transpose not defined for N-d objects"); + return octave_value (); + } + else + return octave_value (v.char_matrix_value ().transpose (), + a.is_sq_string () ? '\'' : '"'); +} + +// string by string ops. + +#define DEFCHARNDBINOP_FN(name, op, t1, t2, e1, e2, f) \ + BINOPDECL (name, a1, a2) \ + { \ + dim_vector a1_dims = a1.dims (); \ + dim_vector a2_dims = a2.dims (); \ + \ + bool a1_is_scalar = a1_dims.all_ones (); \ + bool a2_is_scalar = a2_dims.all_ones (); \ + \ + CAST_BINOP_ARGS (const octave_ ## t1&, const octave_ ## t2&); \ + \ + if (a1_is_scalar) \ + { \ + if (a2_is_scalar) \ + return octave_value ((v1.e1 ## _value ())(0) op (v2.e2 ## _value ())(0)); \ + else \ + return octave_value (f ((v1.e1 ## _value ())(0), v2.e2 ## _value ())); \ + } \ + else \ + { \ + if (a2_is_scalar) \ + return octave_value (f (v1.e1 ## _value (), (v2.e2 ## _value ())(0))); \ + else \ + return octave_value (f (v1.e1 ## _value (), v2.e2 ## _value ())); \ + } \ + } + +DEFCHARNDBINOP_FN (lt, <, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_lt) +DEFCHARNDBINOP_FN (le, <=, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_le) +DEFCHARNDBINOP_FN (eq, ==, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_eq) +DEFCHARNDBINOP_FN (ge, >=, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_ge) +DEFCHARNDBINOP_FN (gt, >, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_gt) +DEFCHARNDBINOP_FN (ne, !=, char_matrix_str, char_matrix_str, char_array, char_array, mx_el_ne) + +DEFASSIGNOP (assign, char_matrix_str, char_matrix_str) +{ + CAST_BINOP_ARGS (octave_char_matrix_str&, const octave_char_matrix_str&); + + v1.assign (idx, v2.char_array_value ()); + return octave_value (); +} + +DEFNULLASSIGNOP_FN (null_assign, char_matrix_str, delete_elements) + +DEFNDCHARCATOP_FN (str_str, char_matrix_str, char_matrix_str, concat) + +void +install_str_str_ops (void) +{ + INSTALL_UNOP (op_transpose, octave_char_matrix_str, transpose); + INSTALL_UNOP (op_transpose, octave_char_matrix_sq_str, transpose); + + INSTALL_UNOP (op_hermitian, octave_char_matrix_str, transpose); + INSTALL_UNOP (op_hermitian, octave_char_matrix_sq_str, transpose); + + INSTALL_BINOP (op_lt, octave_char_matrix_str, octave_char_matrix_str, lt); + INSTALL_BINOP (op_lt, octave_char_matrix_str, octave_char_matrix_sq_str, lt); + INSTALL_BINOP (op_lt, octave_char_matrix_sq_str, octave_char_matrix_str, lt); + INSTALL_BINOP (op_lt, octave_char_matrix_sq_str, octave_char_matrix_sq_str, lt); + + INSTALL_BINOP (op_le, octave_char_matrix_str, octave_char_matrix_str, le); + INSTALL_BINOP (op_le, octave_char_matrix_str, octave_char_matrix_sq_str, le); + INSTALL_BINOP (op_le, octave_char_matrix_sq_str, octave_char_matrix_str, le); + INSTALL_BINOP (op_le, octave_char_matrix_sq_str, octave_char_matrix_sq_str, le); + + INSTALL_BINOP (op_eq, octave_char_matrix_str, octave_char_matrix_str, eq); + INSTALL_BINOP (op_eq, octave_char_matrix_str, octave_char_matrix_sq_str, eq); + INSTALL_BINOP (op_eq, octave_char_matrix_sq_str, octave_char_matrix_str, eq); + INSTALL_BINOP (op_eq, octave_char_matrix_sq_str, octave_char_matrix_sq_str, eq); + + INSTALL_BINOP (op_ge, octave_char_matrix_str, octave_char_matrix_str, ge); + INSTALL_BINOP (op_ge, octave_char_matrix_str, octave_char_matrix_sq_str, ge); + INSTALL_BINOP (op_ge, octave_char_matrix_sq_str, octave_char_matrix_str, ge); + INSTALL_BINOP (op_ge, octave_char_matrix_sq_str, octave_char_matrix_sq_str, ge); + + INSTALL_BINOP (op_gt, octave_char_matrix_str, octave_char_matrix_str, gt); + INSTALL_BINOP (op_gt, octave_char_matrix_str, octave_char_matrix_sq_str, gt); + INSTALL_BINOP (op_gt, octave_char_matrix_sq_str, octave_char_matrix_str, gt); + INSTALL_BINOP (op_gt, octave_char_matrix_sq_str, octave_char_matrix_sq_str, gt); + + INSTALL_BINOP (op_ne, octave_char_matrix_str, octave_char_matrix_str, ne); + INSTALL_BINOP (op_ne, octave_char_matrix_str, octave_char_matrix_sq_str, ne); + INSTALL_BINOP (op_ne, octave_char_matrix_sq_str, octave_char_matrix_str, ne); + INSTALL_BINOP (op_ne, octave_char_matrix_sq_str, octave_char_matrix_sq_str, ne); + + INSTALL_CATOP (octave_char_matrix_str, octave_char_matrix_str, str_str); + INSTALL_CATOP (octave_char_matrix_str, octave_char_matrix_sq_str, str_str); + INSTALL_CATOP (octave_char_matrix_sq_str, octave_char_matrix_str, str_str); + INSTALL_CATOP (octave_char_matrix_sq_str, octave_char_matrix_sq_str, str_str); + + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_char_matrix_str, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_char_matrix_sq_str, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_char_matrix_str, assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_char_matrix_sq_str, assign); + + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_null_matrix, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_null_str, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_str, octave_null_sq_str, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_null_matrix, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_null_str, null_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_char_matrix_sq_str, octave_null_sq_str, null_assign); + +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-struct.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-struct.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,108 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-struct.h" +#include "ov-typeinfo.h" +#include "ops.h" + +// struct ops. + +DEFUNOP (transpose, struct) +{ + CAST_UNOP_ARG (const octave_struct&); + + if (v.ndims () > 2) + { + error ("transpose not defined for N-d objects"); + return octave_value (); + } + else + return octave_value (v.map_value ().transpose ()); +} + +DEFUNOP (scalar_transpose, scalar_struct) +{ + CAST_UNOP_ARG (const octave_scalar_struct&); + + return octave_value (v.scalar_map_value ()); +} + +DEFNDCATOP_FN (s_s_concat, struct, struct, map, map, concat) +DEFNDCATOP_FN (s_ss_concat, struct, scalar_struct, map, map, concat) +DEFNDCATOP_FN (ss_s_concat, scalar_struct, struct, map, map, concat) +DEFNDCATOP_FN (ss_ss_concat, scalar_struct, scalar_struct, map, map, concat) + +static octave_value +oct_catop_struct_matrix (octave_base_value& a1, const octave_base_value& a2, + const Array&) +{ + octave_value retval; + CAST_BINOP_ARGS (const octave_struct&, const octave_matrix&); + NDArray tmp = v2.array_value (); + dim_vector dv = tmp.dims (); + if (dv.all_zero ()) + retval = octave_value (v1.map_value ()); + else + error ("invalid concatenation of structure with matrix"); + return retval; +} + +static octave_value +oct_catop_matrix_struct (octave_base_value& a1, const octave_base_value& a2, + const Array&) +{ + octave_value retval; + CAST_BINOP_ARGS (const octave_matrix&, const octave_struct&); + NDArray tmp = v1.array_value (); + dim_vector dv = tmp.dims (); + if (dv.all_zero ()) + retval = octave_value (v2.map_value ()); + else + error ("invalid concatenation of structure with matrix"); + return retval; +} + +void +install_struct_ops (void) +{ + INSTALL_UNOP (op_transpose, octave_struct, transpose); + INSTALL_UNOP (op_hermitian, octave_struct, transpose); + + INSTALL_UNOP (op_transpose, octave_scalar_struct, scalar_transpose); + INSTALL_UNOP (op_hermitian, octave_scalar_struct, scalar_transpose); + + INSTALL_CATOP (octave_struct, octave_struct, s_s_concat); + INSTALL_CATOP (octave_struct, octave_scalar_struct, s_ss_concat) + INSTALL_CATOP (octave_scalar_struct, octave_struct, ss_s_concat) + INSTALL_CATOP (octave_scalar_struct, octave_scalar_struct, ss_ss_concat) + + INSTALL_CATOP (octave_struct, octave_matrix, struct_matrix); + INSTALL_CATOP (octave_matrix, octave_struct, matrix_struct); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-ui16-ui16.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-ui16-ui16.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,149 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-ui16nda-i8.h" +#include "mx-ui16nda-ui8.h" +#include "mx-ui16nda-i16.h" +#include "mx-ui16nda-i32.h" +#include "mx-ui16nda-ui32.h" +#include "mx-ui16nda-i64.h" +#include "mx-ui16nda-ui64.h" + +#include "mx-ui16nda-i8nda.h" +#include "mx-ui16nda-ui8nda.h" +#include "mx-ui16nda-i16nda.h" +#include "mx-ui16nda-i32nda.h" +#include "mx-ui16nda-ui32nda.h" +#include "mx-ui16nda-i64nda.h" +#include "mx-ui16nda-ui64nda.h" + +#include "mx-ui16-i8nda.h" +#include "mx-ui16-ui8nda.h" +#include "mx-ui16-i16nda.h" +#include "mx-ui16-i32nda.h" +#include "mx-ui16-ui32nda.h" +#include "mx-ui16-i64nda.h" +#include "mx-ui16-ui64nda.h" + +#include "mx-ui16nda-s.h" +#include "mx-s-ui16nda.h" + +#include "mx-ui16nda-nda.h" +#include "mx-nda-ui16nda.h" + +#include "mx-ui16-nda.h" +#include "mx-nda-ui16.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-int8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-uint8.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +#include "op-int.h" + +OCTAVE_INT_OPS (uint16) + +OCTAVE_MS_INT_ASSIGN_OPS (mi8, uint16_, int8_, int8_) +OCTAVE_MS_INT_ASSIGN_OPS (mui8, uint16_, uint8_, uint8_) +OCTAVE_MS_INT_ASSIGN_OPS (mi16, uint16_, int16_, int16_) +OCTAVE_MS_INT_ASSIGN_OPS (mi32, uint16_, int32_, int32_) +OCTAVE_MS_INT_ASSIGN_OPS (mui32, uint16_, uint32_, uint32_) +OCTAVE_MS_INT_ASSIGN_OPS (mi64, uint16_, int64_, int64_) +OCTAVE_MS_INT_ASSIGN_OPS (mui64, uint16_, uint64_, uint64_) + +OCTAVE_MM_INT_ASSIGN_OPS (mmi8, uint16_, int8_, int8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui8, uint16_, uint8_, uint8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi16, uint16_, int16_, int16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi32, uint16_, int32_, int32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui32, uint16_, uint32_, uint32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi64, uint16_, int64_, int64_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui64, uint16_, uint64_, uint64_) + +OCTAVE_MIXED_INT_CMP_OPS (uint16, int8) +OCTAVE_MIXED_INT_CMP_OPS (uint16, uint8) +OCTAVE_MIXED_INT_CMP_OPS (uint16, int16) +OCTAVE_MIXED_INT_CMP_OPS (uint16, int32) +OCTAVE_MIXED_INT_CMP_OPS (uint16, uint32) +OCTAVE_MIXED_INT_CMP_OPS (uint16, int64) +OCTAVE_MIXED_INT_CMP_OPS (uint16, uint64) + +void +install_ui16_ui16_ops (void) +{ + OCTAVE_INSTALL_INT_OPS (uint16); + + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, uint16_, int8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, uint16_, uint8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, uint16_, int16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, uint16_, int32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, uint16_, uint32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, uint16_, int64_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, uint16_, uint64_); + + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, uint16_, int8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, uint16_, uint8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, uint16_, int16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, uint16_, int32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, uint16_, uint32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, uint16_, int64_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, uint16_, uint64_); + + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, int8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, uint8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, int16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, int32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, uint32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, int64); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint16, uint64); + + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, int8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, uint8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, int16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, int32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, uint32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, int64); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint16, uint64); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-ui32-ui32.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-ui32-ui32.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,148 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-ui32nda-i8.h" +#include "mx-ui32nda-ui8.h" +#include "mx-ui32nda-i16.h" +#include "mx-ui32nda-ui16.h" +#include "mx-ui32nda-i32.h" +#include "mx-ui32nda-i64.h" +#include "mx-ui32nda-ui64.h" + +#include "mx-ui32nda-i8nda.h" +#include "mx-ui32nda-ui8nda.h" +#include "mx-ui32nda-i16nda.h" +#include "mx-ui32nda-ui16nda.h" +#include "mx-ui32nda-i32nda.h" +#include "mx-ui32nda-i64nda.h" +#include "mx-ui32nda-ui64nda.h" + +#include "mx-ui32-i8nda.h" +#include "mx-ui32-ui8nda.h" +#include "mx-ui32-i16nda.h" +#include "mx-ui32-ui16nda.h" +#include "mx-ui32-i32nda.h" +#include "mx-ui32-i64nda.h" +#include "mx-ui32-ui64nda.h" + +#include "mx-ui32nda-s.h" +#include "mx-s-ui32nda.h" + +#include "mx-ui32nda-nda.h" +#include "mx-nda-ui32nda.h" + +#include "mx-ui32-nda.h" +#include "mx-nda-ui32.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-int8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-uint8.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +#include "op-int.h" + +OCTAVE_INT_OPS (uint32) + +OCTAVE_MS_INT_ASSIGN_OPS (mi8, uint32_, int8_, int8_) +OCTAVE_MS_INT_ASSIGN_OPS (mui8, uint32_, uint8_, uint8_) +OCTAVE_MS_INT_ASSIGN_OPS (mi16, uint32_, int16_, int16_) +OCTAVE_MS_INT_ASSIGN_OPS (mui16, uint32_, uint16_, uint16_) +OCTAVE_MS_INT_ASSIGN_OPS (mi32, uint32_, int32_, int32_) +OCTAVE_MS_INT_ASSIGN_OPS (mi64, uint32_, int64_, int64_) +OCTAVE_MS_INT_ASSIGN_OPS (mui64, uint32_, uint64_, uint64_) + +OCTAVE_MM_INT_ASSIGN_OPS (mmi8, uint32_, int8_, int8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui8, uint32_, uint8_, uint8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi16, uint32_, int16_, int16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui16, uint32_, uint16_, uint16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi32, uint32_, int32_, int32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi64, uint32_, int64_, int64_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui64, uint32_, uint64_, uint64_) + +OCTAVE_MIXED_INT_CMP_OPS (uint32, int8) +OCTAVE_MIXED_INT_CMP_OPS (uint32, uint8) +OCTAVE_MIXED_INT_CMP_OPS (uint32, int16) +OCTAVE_MIXED_INT_CMP_OPS (uint32, uint16) +OCTAVE_MIXED_INT_CMP_OPS (uint32, int32) +OCTAVE_MIXED_INT_CMP_OPS (uint32, int64) +OCTAVE_MIXED_INT_CMP_OPS (uint32, uint64) +void +install_ui32_ui32_ops (void) +{ + OCTAVE_INSTALL_INT_OPS (uint32); + + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, uint32_, int8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, uint32_, uint8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, uint32_, int16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, uint32_, uint16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, uint32_, int32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, uint32_, int64_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, uint32_, uint64_); + + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, uint32_, int8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, uint32_, uint8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, uint32_, int16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, uint32_, uint16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, uint32_, int32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, uint32_, int64_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, uint32_, uint64_); + + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, int8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, uint8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, int16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, uint16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, int32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, int64); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint32, uint64); + + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, int8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, uint8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, int16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, uint16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, int32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, int64); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint32, uint64); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-ui64-ui64.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-ui64-ui64.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,149 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-ui64nda-i8.h" +#include "mx-ui64nda-ui8.h" +#include "mx-ui64nda-i16.h" +#include "mx-ui64nda-ui16.h" +#include "mx-ui64nda-i32.h" +#include "mx-ui64nda-ui32.h" +#include "mx-ui64nda-i64.h" + +#include "mx-ui64nda-i8nda.h" +#include "mx-ui64nda-ui8nda.h" +#include "mx-ui64nda-i16nda.h" +#include "mx-ui64nda-ui16nda.h" +#include "mx-ui64nda-i32nda.h" +#include "mx-ui64nda-ui32nda.h" +#include "mx-ui64nda-i64nda.h" + +#include "mx-ui64-i8nda.h" +#include "mx-ui64-ui8nda.h" +#include "mx-ui64-i16nda.h" +#include "mx-ui64-ui16nda.h" +#include "mx-ui64-i32nda.h" +#include "mx-ui64-ui32nda.h" +#include "mx-ui64-i64nda.h" + +#include "mx-ui64nda-s.h" +#include "mx-s-ui64nda.h" + +#include "mx-ui64nda-nda.h" +#include "mx-nda-ui64nda.h" + +#include "mx-ui64-nda.h" +#include "mx-nda-ui64.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-int8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-uint8.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +#include "op-int.h" + +OCTAVE_INT_OPS (uint64) + +OCTAVE_MS_INT_ASSIGN_OPS (mi8, uint64_, int8_, int8_) +OCTAVE_MS_INT_ASSIGN_OPS (mui8, uint64_, uint8_, uint8_) +OCTAVE_MS_INT_ASSIGN_OPS (mi16, uint64_, int16_, int16_) +OCTAVE_MS_INT_ASSIGN_OPS (mui16, uint64_, uint16_, uint16_) +OCTAVE_MS_INT_ASSIGN_OPS (mi32, uint64_, int32_, int32_) +OCTAVE_MS_INT_ASSIGN_OPS (mui32, uint64_, uint32_, uint32_) +OCTAVE_MS_INT_ASSIGN_OPS (mi64, uint64_, int64_, int64_) + +OCTAVE_MM_INT_ASSIGN_OPS (mmi8, uint64_, int8_, int8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui8, uint64_, uint8_, uint8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi16, uint64_, int16_, int16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui16, uint64_, uint16_, uint16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi32, uint64_, int32_, int32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui32, uint64_, uint32_, uint32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi64, uint64_, int64_, int64_) + +OCTAVE_MIXED_INT_CMP_OPS (uint64, int8) +OCTAVE_MIXED_INT_CMP_OPS (uint64, uint8) +OCTAVE_MIXED_INT_CMP_OPS (uint64, int16) +OCTAVE_MIXED_INT_CMP_OPS (uint64, uint16) +OCTAVE_MIXED_INT_CMP_OPS (uint64, int32) +OCTAVE_MIXED_INT_CMP_OPS (uint64, uint32) +OCTAVE_MIXED_INT_CMP_OPS (uint64, int64) + +void +install_ui64_ui64_ops (void) +{ + OCTAVE_INSTALL_INT_OPS (uint64); + + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, uint64_, int8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui8, uint64_, uint8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, uint64_, int16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, uint64_, uint16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, uint64_, int32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, uint64_, uint32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, uint64_, int64_); + + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, uint64_, int8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui8, uint64_, uint8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, uint64_, int16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, uint64_, uint16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, uint64_, int32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, uint64_, uint32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, uint64_, int64_); + + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, int8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, uint8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, int16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, uint16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, int32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, uint32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint64, int64); + + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, int8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, uint8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, int16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, uint16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, int32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, uint32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint64, int64); +} diff -r d02b229ce693 -r a132d206a36a src/operators/op-ui8-ui8.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/operators/op-ui8-ui8.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,149 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "mx-ui8nda-i8.h" +#include "mx-ui8nda-i16.h" +#include "mx-ui8nda-ui16.h" +#include "mx-ui8nda-i32.h" +#include "mx-ui8nda-ui32.h" +#include "mx-ui8nda-i64.h" +#include "mx-ui8nda-ui64.h" + +#include "mx-ui8nda-i8nda.h" +#include "mx-ui8nda-i16nda.h" +#include "mx-ui8nda-ui16nda.h" +#include "mx-ui8nda-i32nda.h" +#include "mx-ui8nda-ui32nda.h" +#include "mx-ui8nda-i64nda.h" +#include "mx-ui8nda-ui64nda.h" + +#include "mx-ui8-i8nda.h" +#include "mx-ui8-i16nda.h" +#include "mx-ui8-ui16nda.h" +#include "mx-ui8-i32nda.h" +#include "mx-ui8-ui32nda.h" +#include "mx-ui8-i64nda.h" +#include "mx-ui8-ui64nda.h" + +#include "mx-ui8nda-s.h" +#include "mx-s-ui8nda.h" + +#include "mx-ui8nda-nda.h" +#include "mx-nda-ui8nda.h" + +#include "mx-ui8-nda.h" +#include "mx-nda-ui8.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-int16.h" +#include "ov-int32.h" +#include "ov-int64.h" +#include "ov-int8.h" +#include "ov-uint16.h" +#include "ov-uint32.h" +#include "ov-uint64.h" +#include "ov-uint8.h" +#include "ov-scalar.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-re-mat.h" +#include "ov-flt-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-typeinfo.h" +#include "ov-null-mat.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +#include "op-int.h" + +OCTAVE_INT_OPS (uint8) + +OCTAVE_MS_INT_ASSIGN_OPS (mi8, uint8_, int8_, int8_) +OCTAVE_MS_INT_ASSIGN_OPS (mi16, uint8_, int16_, int16_) +OCTAVE_MS_INT_ASSIGN_OPS (mui16, uint8_, uint16_, uint16_) +OCTAVE_MS_INT_ASSIGN_OPS (mi32, uint8_, int32_, int32_) +OCTAVE_MS_INT_ASSIGN_OPS (mui32, uint8_, uint32_, uint32_) +OCTAVE_MS_INT_ASSIGN_OPS (mi64, uint8_, int64_, int64_) +OCTAVE_MS_INT_ASSIGN_OPS (mui64, uint8_, uint64_, uint64_) + +OCTAVE_MM_INT_ASSIGN_OPS (mmi8, uint8_, int8_, int8_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi16, uint8_, int16_, int16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui16, uint8_, uint16_, uint16_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi32, uint8_, int32_, int32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui32, uint8_, uint32_, uint32_) +OCTAVE_MM_INT_ASSIGN_OPS (mmi64, uint8_, int64_, int64_) +OCTAVE_MM_INT_ASSIGN_OPS (mmui64, uint8_, uint64_, uint64_) + +OCTAVE_MIXED_INT_CMP_OPS (uint8, int8) +OCTAVE_MIXED_INT_CMP_OPS (uint8, int16) +OCTAVE_MIXED_INT_CMP_OPS (uint8, uint16) +OCTAVE_MIXED_INT_CMP_OPS (uint8, int32) +OCTAVE_MIXED_INT_CMP_OPS (uint8, uint32) +OCTAVE_MIXED_INT_CMP_OPS (uint8, int64) +OCTAVE_MIXED_INT_CMP_OPS (uint8, uint64) + +void +install_ui8_ui8_ops (void) +{ + OCTAVE_INSTALL_INT_OPS (uint8) + + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi8, uint8_, int8_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi16, uint8_, int16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui16, uint8_, uint16_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi32, uint8_, int32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui32, uint8_, uint32_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mi64, uint8_, int64_); + OCTAVE_INSTALL_MS_INT_ASSIGN_OPS (mui64, uint8_, uint64_); + + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi8, uint8_, int8_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi16, uint8_, int16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui16, uint8_, uint16_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi32, uint8_, int32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui32, uint8_, uint32_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmi64, uint8_, int64_); + OCTAVE_INSTALL_MM_INT_ASSIGN_OPS (mmui64, uint8_, uint64_); + + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, int8); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, int16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, uint16); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, int32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, uint32); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, int64); + OCTAVE_INSTALL_SM_INT_ASSIGNCONV (uint8, uint64); + + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, int8); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, int16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, uint16); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, int32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, uint32); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, int64); + OCTAVE_INSTALL_MIXED_INT_CMP_OPS (uint8, uint64); +} diff -r d02b229ce693 -r a132d206a36a src/ov-base-diag.cc --- a/src/ov-base-diag.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,506 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "mach-info.h" -#include "lo-ieee.h" - -#include "ov-base.h" -#include "ov-base-mat.h" -#include "pr-output.h" -#include "error.h" -#include "gripes.h" -#include "oct-stream.h" -#include "ops.h" - -#include "ls-oct-ascii.h" - -template -octave_value -octave_base_diag::subsref (const std::string& type, - const std::list& idx) -{ - octave_value retval; - - switch (type[0]) - { - case '(': - retval = do_index_op (idx.front ()); - break; - - case '{': - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - return retval.next_subsref (type, idx); -} - -template -octave_value -octave_base_diag::do_index_op (const octave_value_list& idx, - bool resize_ok) -{ - octave_value retval; - typedef typename DMT::element_type el_type; - - if (idx.length () == 2 && ! resize_ok) - { - idx_vector idx0 = idx(0).index_vector (); - idx_vector idx1 = idx(1).index_vector (); - - if (idx0.is_scalar () && idx1.is_scalar ()) - { - retval = matrix.elem (idx0(0), idx1(0)); - } - else - { - octave_idx_type m = idx0.length (matrix.rows ()); - octave_idx_type n = idx1.length (matrix.columns ()); - if (idx0.is_colon_equiv (m) && idx1.is_colon_equiv (n) - && m <= matrix.rows () && n <= matrix.rows ()) - { - DMT rm (matrix); - rm.resize (m, n); - retval = rm; - } - else - retval = to_dense ().do_index_op (idx, resize_ok); - } - } - else - retval = to_dense ().do_index_op (idx, resize_ok); - - return retval; -} - -template -octave_value -octave_base_diag::subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - octave_value retval; - - switch (type[0]) - { - case '(': - { - if (type.length () == 1) - { - octave_value_list jdx = idx.front (); - // Check for a simple element assignment. That means, if D is a diagonal matrix, - // `D(i,i) = x' will not destroy its diagonality (provided i is a valid index). - if (jdx.length () == 2 && jdx(0).is_scalar_type () && jdx(1).is_scalar_type ()) - { - typename DMT::element_type val; - idx_vector i0 = jdx(0).index_vector (), i1 = jdx(1).index_vector (); - if (! error_state && i0(0) == i1(0) - && i0(0) < matrix.rows () && i1(0) < matrix.cols () - && chk_valid_scalar (rhs, val)) - { - matrix.dgelem (i0(0)) = val; - retval = this; - this->count++; - // invalidate cache - dense_cache = octave_value (); - } - } - - if (! error_state && ! retval.is_defined ()) - retval = numeric_assign (type, idx, rhs); - } - else - { - std::string nm = type_name (); - error ("in indexed assignment of %s, last lhs index must be ()", - nm.c_str ()); - } - } - break; - - case '{': - case '.': - { - if (is_empty ()) - { - octave_value tmp = octave_value::empty_conv (type, rhs); - - retval = tmp.subsasgn (type, idx, rhs); - } - else - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - } - break; - - default: - panic_impossible (); - } - - return retval; -} - -template -octave_value -octave_base_diag::resize (const dim_vector& dv, bool fill) const -{ - octave_value retval; - if (dv.length () == 2) - { - DMT rm (matrix); - rm.resize (dv(0), dv(1)); - retval = rm; - } - else - retval = to_dense ().resize (dv, fill); - return retval; -} - -template -bool -octave_base_diag::is_true (void) const -{ - return to_dense ().is_true (); -} - -// FIXME: this should be achieveable using ::real -template inline T helper_getreal (T x) { return x; } -template inline T helper_getreal (std::complex x) { return x.real (); } -// FIXME: we really need some traits so that ad hoc hooks like this are not necessary -template inline T helper_iscomplex (T) { return false; } -template inline T helper_iscomplex (std::complex) { return true; } - -template -double -octave_base_diag::double_value (bool force_conversion) const -{ - double retval = lo_ieee_nan_value (); - typedef typename DMT::element_type el_type; - - if (helper_iscomplex (el_type ()) && ! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real scalar"); - - if (numel () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - type_name (), "real scalar"); - - retval = helper_getreal (el_type (matrix (0, 0))); - } - else - gripe_invalid_conversion (type_name (), "real scalar"); - - return retval; -} - -template -float -octave_base_diag::float_value (bool force_conversion) const -{ - float retval = lo_ieee_float_nan_value (); - typedef typename DMT::element_type el_type; - - if (helper_iscomplex (el_type ()) && ! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real scalar"); - - if (numel () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - type_name (), "real scalar"); - - retval = helper_getreal (el_type (matrix (0, 0))); - } - else - gripe_invalid_conversion (type_name (), "real scalar"); - - return retval; -} - -template -Complex -octave_base_diag::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - type_name (), "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion (type_name (), "complex scalar"); - - return retval; -} - -template -FloatComplex -octave_base_diag::float_complex_value (bool) const -{ - float tmp = lo_ieee_float_nan_value (); - - FloatComplex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - type_name (), "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion (type_name (), "complex scalar"); - - return retval; -} - -template -Matrix -octave_base_diag::matrix_value (bool) const -{ - return Matrix (diag_matrix_value ()); -} - -template -FloatMatrix -octave_base_diag::float_matrix_value (bool) const -{ - return FloatMatrix (float_diag_matrix_value ()); -} - -template -ComplexMatrix -octave_base_diag::complex_matrix_value (bool) const -{ - return ComplexMatrix (complex_diag_matrix_value ()); -} - -template -FloatComplexMatrix -octave_base_diag::float_complex_matrix_value (bool) const -{ - return FloatComplexMatrix (float_complex_diag_matrix_value ()); -} - -template -NDArray -octave_base_diag::array_value (bool) const -{ - return NDArray (matrix_value ()); -} - -template -FloatNDArray -octave_base_diag::float_array_value (bool) const -{ - return FloatNDArray (float_matrix_value ()); -} - -template -ComplexNDArray -octave_base_diag::complex_array_value (bool) const -{ - return ComplexNDArray (complex_matrix_value ()); -} - -template -FloatComplexNDArray -octave_base_diag::float_complex_array_value (bool) const -{ - return FloatComplexNDArray (float_complex_matrix_value ()); -} - -template -boolNDArray -octave_base_diag::bool_array_value (bool warn) const -{ - return to_dense ().bool_array_value (warn); -} - -template -charNDArray -octave_base_diag::char_array_value (bool warn) const -{ - return to_dense ().char_array_value (warn); -} - -template -SparseMatrix -octave_base_diag::sparse_matrix_value (bool) const -{ - return SparseMatrix (diag_matrix_value ()); -} - -template -SparseComplexMatrix -octave_base_diag::sparse_complex_matrix_value (bool) const -{ - return SparseComplexMatrix (complex_diag_matrix_value ()); -} - -template -idx_vector -octave_base_diag::index_vector (void) const -{ - return to_dense ().index_vector (); -} - -template -octave_value -octave_base_diag::convert_to_str_internal (bool pad, bool force, char type) const -{ - return to_dense ().convert_to_str_internal (pad, force, type); -} - -template -bool -octave_base_diag::save_ascii (std::ostream& os) -{ - os << "# rows: " << matrix.rows () << "\n" - << "# columns: " << matrix.columns () << "\n"; - - os << matrix.diag (); - - return true; -} - -template -bool -octave_base_diag::load_ascii (std::istream& is) -{ - octave_idx_type r = 0, c = 0; - bool success = true; - - if (extract_keyword (is, "rows", r, true) - && extract_keyword (is, "columns", c, true)) - { - octave_idx_type l = r < c ? r : c; - MT tmp (l, 1); - is >> tmp; - - if (!is) - { - error ("load: failed to load diagonal matrix constant"); - success = false; - } - else - { - // This is a little tricky, as we have the Matrix type, but - // not ColumnVector type. We need to help the compiler get - // through the inheritance tree. - typedef typename DMT::element_type el_type; - matrix = DMT (MDiagArray2 (MArray (tmp))); - matrix.resize (r, c); - - // Invalidate cache. Probably not necessary, but safe. - dense_cache = octave_value (); - } - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - - return success; -} - -template -void -octave_base_diag::print_raw (std::ostream& os, - bool pr_as_read_syntax) const -{ - return octave_print_internal (os, matrix, pr_as_read_syntax, - current_print_indent_level ()); -} - -template -mxArray * -octave_base_diag::as_mxArray (void) const -{ - return to_dense ().as_mxArray (); -} - -template -bool -octave_base_diag::print_as_scalar (void) const -{ - dim_vector dv = dims (); - - return (dv.all_ones () || dv.any_zero ()); -} - -template -void -octave_base_diag::print (std::ostream& os, bool pr_as_read_syntax) const -{ - print_raw (os, pr_as_read_syntax); - newline (os); -} -template -int -octave_base_diag::write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const -{ - return to_dense ().write (os, block_size, output_type, skip, flt_fmt); -} - -template -void -octave_base_diag::print_info (std::ostream& os, - const std::string& prefix) const -{ - matrix.print_info (os, prefix); -} - -template -octave_value -octave_base_diag::to_dense (void) const -{ - if (! dense_cache.is_defined ()) - dense_cache = MT (matrix); - - return dense_cache; -} - diff -r d02b229ce693 -r a132d206a36a src/ov-base-diag.h --- a/src/ov-base-diag.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,226 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_base_diag_h) -#define octave_base_diag_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "str-vec.h" - -#include "oct-obj.h" -#include "ov-base.h" -#include "ov-typeinfo.h" - -class tree_walker; - -// Real matrix values. - -template -class -octave_base_diag : public octave_base_value -{ - -public: - - octave_base_diag (void) - : octave_base_value (), matrix (), dense_cache () { } - - octave_base_diag (const DMT& m) - : octave_base_value (), matrix (m), dense_cache () - { } - - octave_base_diag (const octave_base_diag& m) - : octave_base_value (), matrix (m.matrix), dense_cache () { } - - ~octave_base_diag (void) { } - - size_t byte_size (void) const { return matrix.byte_size (); } - - octave_value squeeze (void) const { return matrix; } - - octave_value full_value (void) const { return to_dense (); } - - octave_value subsref (const std::string& type, - const std::list& idx); - - octave_value_list subsref (const std::string& type, - const std::list& idx, int) - { return subsref (type, idx); } - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - octave_value subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - dim_vector dims (void) const { return matrix.dims (); } - - octave_idx_type nnz (void) const { return to_dense ().nnz (); } - - octave_value reshape (const dim_vector& new_dims) const - { return to_dense ().reshape (new_dims); } - - octave_value permute (const Array& vec, bool inv = false) const - { return to_dense ().permute (vec, inv); } - - octave_value resize (const dim_vector& dv, bool fill = false) const; - - octave_value all (int dim = 0) const { return MT (matrix).all (dim); } - octave_value any (int dim = 0) const { return MT (matrix).any (dim); } - - MatrixType matrix_type (void) const { return MatrixType::Diagonal; } - MatrixType matrix_type (const MatrixType&) const - { return matrix_type (); } - - octave_value diag (octave_idx_type k = 0) const - { return octave_value (matrix.diag (k)); } - - octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const - { return to_dense ().sort (dim, mode); } - octave_value sort (Array &sidx, octave_idx_type dim = 0, - sortmode mode = ASCENDING) const - { return to_dense ().sort (sidx, dim, mode); } - - sortmode is_sorted (sortmode mode = UNSORTED) const - { return to_dense ().is_sorted (mode); } - - Array sort_rows_idx (sortmode mode = ASCENDING) const - { return to_dense ().sort_rows_idx (mode); } - - sortmode is_sorted_rows (sortmode mode = UNSORTED) const - { return to_dense ().is_sorted_rows (mode); } - - bool is_matrix_type (void) const { return true; } - - bool is_numeric_type (void) const { return true; } - - bool is_defined (void) const { return true; } - - bool is_constant (void) const { return true; } - - bool is_true (void) const; - - bool is_diag_matrix (void) const { return true; } - - double double_value (bool = false) const; - - float float_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - idx_vector index_vector (void) const; - - Matrix matrix_value (bool = false) const; - - FloatMatrix float_matrix_value (bool = false) const; - - Complex complex_value (bool = false) const; - - FloatComplex float_complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - FloatComplexMatrix float_complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const; - - FloatComplexNDArray float_complex_array_value (bool = false) const; - - boolNDArray bool_array_value (bool warn = false) const; - - charNDArray char_array_value (bool = false) const; - - NDArray array_value (bool = false) const; - - FloatNDArray float_array_value (bool = false) const; - - SparseMatrix sparse_matrix_value (bool = false) const; - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; - - int8NDArray - int8_array_value (void) const { return to_dense ().int8_array_value (); } - - int16NDArray - int16_array_value (void) const { return to_dense ().int16_array_value (); } - - int32NDArray - int32_array_value (void) const { return to_dense ().int32_array_value (); } - - int64NDArray - int64_array_value (void) const { return to_dense ().int64_array_value (); } - - uint8NDArray - uint8_array_value (void) const { return to_dense ().uint8_array_value (); } - - uint16NDArray - uint16_array_value (void) const { return to_dense ().uint16_array_value (); } - - uint32NDArray - uint32_array_value (void) const { return to_dense ().uint32_array_value (); } - - uint64NDArray - uint64_array_value (void) const { return to_dense ().uint64_array_value (); } - - octave_value convert_to_str_internal (bool pad, bool force, char type) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const; - - mxArray *as_mxArray (void) const; - - bool print_as_scalar (void) const; - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_info (std::ostream& os, const std::string& prefix) const; - -protected: - - DMT matrix; - - octave_value to_dense (void) const; - - virtual bool chk_valid_scalar (const octave_value&, - typename DMT::element_type&) const = 0; - -private: - - mutable octave_value dense_cache; - -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-base-int.cc --- a/src/ov-base-int.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,608 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "lo-ieee.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "quit.h" -#include "oct-locbuf.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "oct-stream.h" -#include "ops.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-base-mat.cc" -#include "ov-base-scalar.h" -#include "ov-base-scalar.cc" -#include "ov-base-int.h" -#include "ov-int-traits.h" -#include "pr-output.h" -#include "variables.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -// We have all the machinery below (octave_base_int_helper and -// octave_base_int_helper_traits) to avoid a few warnings from GCC -// about comparisons always false due to limited range of data types. -// Ugh. The cure may be worse than the disease. - -template -struct octave_base_int_helper -{ - static bool - char_value_out_of_range (T val) { return val < 0 || val > UCHAR_MAX; } -}; - -template -struct octave_base_int_helper -{ - static bool char_value_out_of_range (T) { return false; } -}; - -template -struct octave_base_int_helper -{ - static bool char_value_out_of_range (T val) { return val > UCHAR_MAX; } -}; - -template -struct octave_base_int_helper -{ - static bool char_value_out_of_range (T val) { return val < 0; } -}; - -// For all types other than char, signed char, and unsigned char, we -// assume that the upper limit for the range of allowable values is -// larger than the range for unsigned char. If that's not true, we -// are still OK, but will see the warnings again for any other types -// that do not meet this assumption. - -template -struct octave_base_int_helper_traits -{ - static const bool can_be_larger_than_uchar_max = true; -}; - -template <> -struct octave_base_int_helper_traits -{ - static const bool can_be_larger_than_uchar_max = false; -}; - -template <> -struct octave_base_int_helper_traits -{ - static const bool can_be_larger_than_uchar_max = false; -}; - -template <> -struct octave_base_int_helper_traits -{ - static const bool can_be_larger_than_uchar_max = false; -}; - - -template -octave_base_value * -octave_base_int_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (this->matrix.nelem () == 1) - retval = new typename octave_value_int_traits::scalar_type (this->matrix (0)); - - return retval; -} - -template -octave_value -octave_base_int_matrix::convert_to_str_internal (bool, bool, char type) const -{ - octave_value retval; - dim_vector dv = this->dims (); - octave_idx_type nel = dv.numel (); - - charNDArray chm (dv); - - bool warned = false; - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_quit (); - - typename T::element_type tmp = this->matrix(i); - - typedef typename T::element_type::val_type val_type; - - val_type ival = tmp.value (); - - static const bool is_signed = std::numeric_limits::is_signed; - static const bool can_be_larger_than_uchar_max - = octave_base_int_helper_traits::can_be_larger_than_uchar_max; - - if (octave_base_int_helper::char_value_out_of_range (ival)) - { - // FIXME -- is there something better we could do? - - ival = 0; - - if (! warned) - { - ::warning ("range error for conversion to character value"); - warned = true; - } - } - else - chm (i) = static_cast (ival); - } - - retval = octave_value (chm, type); - - return retval; -} - -template -bool -octave_base_int_matrix::save_ascii (std::ostream& os) -{ - dim_vector d = this->dims (); - - os << "# ndims: " << d.length () << "\n"; - - for (int i = 0; i < d.length (); i++) - os << " " << d (i); - - os << "\n" << this->matrix; - - return true; -} - -template -bool -octave_base_int_matrix::load_ascii (std::istream& is) -{ - int mdims = 0; - bool success = true; - - if (extract_keyword (is, "ndims", mdims, true)) - { - if (mdims >= 0) - { - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - is >> dv(i); - - T tmp(dv); - - is >> tmp; - - if (!is) - { - error ("load: failed to load matrix constant"); - success = false; - } - - this->matrix = tmp; - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - } - else - error ("load: failed to extract number of dimensions"); - - return success; -} - -template -bool -octave_base_int_matrix::save_binary (std::ostream& os, bool&) -{ - dim_vector d = this->dims (); - if (d.length () < 1) - return false; - - // Use negative value for ndims to differentiate with old format!! - int32_t tmp = - d.length (); - os.write (reinterpret_cast (&tmp), 4); - for (int i=0; i < d.length (); i++) - { - tmp = d(i); - os.write (reinterpret_cast (&tmp), 4); - } - - os.write (reinterpret_cast (this->matrix.data ()), this->byte_size ()); - - return true; -} - -template -bool -octave_base_int_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format ) -{ - int32_t mdims; - if (! is.read (reinterpret_cast (&mdims), 4)) - return false; - if (swap) - swap_bytes<4> (&mdims); - if (mdims >= 0) - return false; - - mdims = - mdims; - int32_t di; - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - { - if (! is.read (reinterpret_cast (&di), 4)) - return false; - if (swap) - swap_bytes<4> (&di); - dv(i) = di; - } - - // Convert an array with a single dimension to be a row vector. - // Octave should never write files like this, other software - // might. - - if (mdims == 1) - { - mdims = 2; - dv.resize (mdims); - dv(1) = dv(0); - dv(0) = 1; - } - - T m (dv); - - if (! is.read (reinterpret_cast (m.fortran_vec ()), m.byte_size ())) - return false; - - if (swap) - { - int nel = dv.numel (); - int bytes = nel / m.byte_size (); - for (int i = 0; i < nel; i++) - switch (bytes) - { - case 8: - swap_bytes<8> (&m(i)); - break; - case 4: - swap_bytes<4> (&m(i)); - break; - case 2: - swap_bytes<2> (&m(i)); - break; - case 1: - default: - break; - } - } - - this->matrix = m; - return true; -} - -#if defined (HAVE_HDF5) - -template -bool -octave_base_int_matrix::save_hdf5 (hid_t loc_id, const char *name, bool) -{ - hid_t save_type_hid = HDF5_SAVE_TYPE; - bool retval = true; - dim_vector dv = this->dims (); - int empty = save_hdf5_empty (loc_id, name, dv); - if (empty) - return (empty > 0); - - int rank = dv.length (); - hid_t space_hid = -1, data_hid = -1; - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - - // Octave uses column-major, while HDF5 uses row-major ordering - for (int i = 0; i < rank; i++) - hdims[i] = dv (rank-i-1); - - space_hid = H5Screate_simple (rank, hdims, 0); - - if (space_hid < 0) return false; -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - return false; - } - - retval = H5Dwrite (data_hid, save_type_hid, H5S_ALL, H5S_ALL, - H5P_DEFAULT, this->matrix.data ()) >= 0; - - H5Dclose (data_hid); - H5Sclose (space_hid); - - return retval; -} - -template -bool -octave_base_int_matrix::load_hdf5 (hid_t loc_id, const char *name) -{ - hid_t save_type_hid = HDF5_SAVE_TYPE; - bool retval = false; - dim_vector dv; - int empty = load_hdf5_empty (loc_id, name, dv); - if (empty > 0) - this->matrix.resize (dv); - if (empty) - return (empty > 0); - -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t space_id = H5Dget_space (data_hid); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank < 1) - { - H5Sclose (space_id); - H5Dclose (data_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_id, hdims, maxdims); - - // Octave uses column-major, while HDF5 uses row-major ordering - if (rank == 1) - { - dv.resize (2); - dv(0) = 1; - dv(1) = hdims[0]; - } - else - { - dv.resize (rank); - for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) - dv(j) = hdims[i]; - } - - T m (dv); - if (H5Dread (data_hid, save_type_hid, H5S_ALL, H5S_ALL, - H5P_DEFAULT, m.fortran_vec ()) >= 0) - { - retval = true; - this->matrix = m; - } - - H5Sclose (space_id); - H5Dclose (data_hid); - - return retval; -} - -#endif - -template -void -octave_base_int_matrix::print_raw (std::ostream& os, - bool pr_as_read_syntax) const -{ - octave_print_internal (os, this->matrix, pr_as_read_syntax, - this->current_print_indent_level ()); -} - -template -octave_value -octave_base_int_scalar::convert_to_str_internal (bool, bool, char type) const -{ - octave_value retval; - - T tmp = this->scalar; - - typedef typename T::val_type val_type; - - val_type ival = tmp.value (); - - static const bool is_signed = std::numeric_limits::is_signed; - static const bool can_be_larger_than_uchar_max - = octave_base_int_helper_traits::can_be_larger_than_uchar_max; - - if (octave_base_int_helper::char_value_out_of_range (ival)) - { - // FIXME -- is there something better we could do? - - ival = 0; - - ::warning ("range error for conversion to character value"); - } - else - retval = octave_value (std::string (1, static_cast (ival)), type); - - return retval; -} - -template -bool -octave_base_int_scalar::save_ascii (std::ostream& os) -{ - os << this->scalar << "\n"; - return true; -} - -template -bool -octave_base_int_scalar::load_ascii (std::istream& is) -{ - is >> this->scalar; - if (!is) - { - error ("load: failed to load scalar constant"); - return false; - } - return true; -} - -template -bool -octave_base_int_scalar::save_binary (std::ostream& os, bool&) -{ - os.write (reinterpret_cast (&(this->scalar)), this->byte_size ()); - return true; -} - -template -bool -octave_base_int_scalar::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format) -{ - T tmp; - if (! is.read (reinterpret_cast (&tmp), this->byte_size ())) - return false; - - if (swap) - switch (this->byte_size ()) - { - case 8: - swap_bytes<8> (&tmp); - break; - case 4: - swap_bytes<4> (&tmp); - break; - case 2: - swap_bytes<2> (&tmp); - break; - case 1: - default: - break; - } - this->scalar = tmp; - return true; -} - -#if defined (HAVE_HDF5) - -template -bool -octave_base_int_scalar::save_hdf5 (hid_t loc_id, const char *name, bool) -{ - hid_t save_type_hid = HDF5_SAVE_TYPE; - bool retval = true; - hsize_t dimens[3]; - hid_t space_hid = -1, data_hid = -1; - - space_hid = H5Screate_simple (0, dimens, 0); - if (space_hid < 0) return false; - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - return false; - } - - retval = H5Dwrite (data_hid, save_type_hid, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &(this->scalar)) >= 0; - - H5Dclose (data_hid); - H5Sclose (space_hid); - - return retval; -} - -template -bool -octave_base_int_scalar::load_hdf5 (hid_t loc_id, const char *name) -{ - hid_t save_type_hid = HDF5_SAVE_TYPE; -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t space_id = H5Dget_space (data_hid); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank != 0) - { - H5Dclose (data_hid); - return false; - } - - T tmp; - if (H5Dread (data_hid, save_type_hid, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &tmp) < 0) - { - H5Dclose (data_hid); - return false; - } - - this->scalar = tmp; - - H5Dclose (data_hid); - - return true; -} - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-base-int.h --- a/src/ov-base-int.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,129 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_base_int_matrix_h) -#define octave_base_int_matrix_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "error.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-base-scalar.h" -#include "ov-typeinfo.h" - -// base int matrix values. - -template -class -octave_base_int_matrix : public octave_base_matrix -{ -public: - - octave_base_int_matrix (void) : octave_base_matrix () { } - - octave_base_int_matrix (const T& nda) : octave_base_matrix (nda) { } - - ~octave_base_int_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_base_int_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_base_int_matrix (); } - - octave_base_value *try_narrowing_conversion (void); - - bool is_real_type (void) const { return true; } - - // void increment (void) { matrix += 1; } - - // void decrement (void) { matrix -= 1; } - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - octave_value convert_to_str_internal (bool, bool, char type) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& ); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format ); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif -}; - -// base int scalar values. - -template -class -octave_base_int_scalar : public octave_base_scalar -{ -public: - - octave_base_int_scalar (void) : octave_base_scalar () { } - - octave_base_int_scalar (const T& s) : octave_base_scalar (s) { } - - ~octave_base_int_scalar (void) { } - - octave_base_value *clone (void) const { return new octave_base_int_scalar (*this); } - octave_base_value *empty_clone (void) const { return new octave_base_int_scalar (); } - - octave_base_value *try_narrowing_conversion (void) { return 0; } - - bool is_real_type (void) const { return true; } - - // void increment (void) { scalar += 1; } - - // void decrement (void) { scalar -= 1; } - - octave_value convert_to_str_internal (bool, bool, char type) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& ); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format ); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool ); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-base-mat.cc --- a/src/ov-base-mat.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,482 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "Cell.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-base-scalar.h" -#include "pr-output.h" - -template -octave_value -octave_base_matrix::subsref (const std::string& type, - const std::list& idx) -{ - octave_value retval; - - switch (type[0]) - { - case '(': - retval = do_index_op (idx.front ()); - break; - - case '{': - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - return retval.next_subsref (type, idx); -} - -template -octave_value -octave_base_matrix::subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - octave_value retval; - - switch (type[0]) - { - case '(': - { - if (type.length () == 1) - retval = numeric_assign (type, idx, rhs); - else if (is_empty ()) - { - // Allow conversion of empty matrix to some other type in - // cases like - // - // x = []; x(i).f = rhs - - if (type[1] == '.') - { - octave_value tmp = octave_value::empty_conv (type, rhs); - - retval = tmp.subsasgn (type, idx, rhs); - } - else - error ("invalid assignment expression"); - } - else - { - std::string nm = type_name (); - error ("in indexed assignment of %s, last lhs index must be ()", - nm.c_str ()); - } - } - break; - - case '{': - case '.': - { - if (is_empty ()) - { - octave_value tmp = octave_value::empty_conv (type, rhs); - - retval = tmp.subsasgn (type, idx, rhs); - } - else - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - } - break; - - default: - panic_impossible (); - } - - return retval; -} - -template -octave_value -octave_base_matrix::do_index_op (const octave_value_list& idx, - bool resize_ok) -{ - octave_value retval; - - octave_idx_type n_idx = idx.length (); - - int nd = matrix.ndims (); - const MT& cmatrix = matrix; - - switch (n_idx) - { - case 0: - retval = matrix; - break; - - case 1: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - { - // optimize single scalar index. - if (! resize_ok && i.is_scalar ()) - retval = cmatrix.checkelem (i(0)); - else - retval = MT (matrix.index (i, resize_ok)); - } - } - break; - - case 2: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - { - idx_vector j = idx (1).index_vector (); - - if (! error_state) - { - // optimize two scalar indices. - if (! resize_ok && i.is_scalar () && j.is_scalar ()) - retval = cmatrix.checkelem (i(0), j(0)); - else - retval = MT (matrix.index (i, j, resize_ok)); - } - } - } - break; - - default: - { - Array idx_vec (dim_vector (n_idx, 1)); - bool scalar_opt = n_idx == nd && ! resize_ok; - const dim_vector dv = matrix.dims (); - - for (octave_idx_type i = 0; i < n_idx; i++) - { - idx_vec(i) = idx(i).index_vector (); - - if (error_state) - break; - - scalar_opt = (scalar_opt && idx_vec(i).is_scalar ()); - } - - if (! error_state) - { - if (scalar_opt) - retval = cmatrix.checkelem (conv_to_int_array (idx_vec)); - else - retval = MT (matrix.index (idx_vec, resize_ok)); - } - } - break; - } - - return retval; -} - -template -void -octave_base_matrix::assign (const octave_value_list& idx, const MT& rhs) -{ - octave_idx_type n_idx = idx.length (); - - switch (n_idx) - { - case 0: - panic_impossible (); - break; - - case 1: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - matrix.assign (i, rhs); - } - break; - - case 2: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - { - idx_vector j = idx (1).index_vector (); - - if (! error_state) - matrix.assign (i, j, rhs); - } - } - break; - - default: - { - Array idx_vec (dim_vector (n_idx, 1)); - - for (octave_idx_type i = 0; i < n_idx; i++) - { - idx_vec(i) = idx(i).index_vector (); - - if (error_state) - break; - } - - if (! error_state) - matrix.assign (idx_vec, rhs); - } - break; - } - - // Clear cache. - clear_cached_info (); -} - -template -MatrixType -octave_base_matrix::matrix_type (const MatrixType& _typ) const -{ - delete typ; - typ = new MatrixType (_typ); - return *typ; -} - -template -void -octave_base_matrix::assign (const octave_value_list& idx, - typename MT::element_type rhs) -{ - octave_idx_type n_idx = idx.length (); - - int nd = matrix.ndims (); - - MT mrhs (dim_vector (1, 1), rhs); - - switch (n_idx) - { - case 0: - panic_impossible (); - break; - - case 1: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - { - // optimize single scalar index. - if (i.is_scalar () && i(0) < matrix.numel ()) - matrix(i(0)) = rhs; - else - matrix.assign (i, mrhs); - } - } - break; - - case 2: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - { - idx_vector j = idx (1).index_vector (); - - if (! error_state) - { - // optimize two scalar indices. - if (i.is_scalar () && j.is_scalar () && nd == 2 - && i(0) < matrix.rows () && j(0) < matrix.columns ()) - matrix(i(0), j(0)) = rhs; - else - matrix.assign (i, j, mrhs); - } - } - } - break; - - default: - { - Array idx_vec (dim_vector (n_idx, 1)); - bool scalar_opt = n_idx == nd; - const dim_vector dv = matrix.dims ().redim (n_idx); - - for (octave_idx_type i = 0; i < n_idx; i++) - { - idx_vec(i) = idx(i).index_vector (); - - if (error_state) - break; - - scalar_opt = (scalar_opt && idx_vec(i).is_scalar () - && idx_vec(i)(0) < dv(i)); - } - - if (! error_state) - { - if (scalar_opt) - { - // optimize all scalar indices. Don't construct an index array, - // but rather calc a scalar index directly. - octave_idx_type k = 1, j = 0; - for (octave_idx_type i = 0; i < n_idx; i++) - { - j += idx_vec(i)(0) * k; - k *= dv (i); - } - matrix(j) = rhs; - } - else - matrix.assign (idx_vec, mrhs); - } - } - break; - } - - // Clear cache. - clear_cached_info (); -} - -template -void -octave_base_matrix::delete_elements (const octave_value_list& idx) -{ - octave_idx_type len = idx.length (); - - Array ra_idx (dim_vector (len, 1)); - - for (octave_idx_type i = 0; i < len; i++) - ra_idx(i) = idx(i).index_vector (); - - matrix.delete_elements (ra_idx); - - // Clear cache. - clear_cached_info (); -} - -template -octave_value -octave_base_matrix::resize (const dim_vector& dv, bool fill) const -{ - MT retval (matrix); - if (fill) - retval.resize (dv, 0); - else - retval.resize (dv); - return retval; -} - -template -bool -octave_base_matrix::is_true (void) const -{ - bool retval = false; - dim_vector dv = matrix.dims (); - int nel = dv.numel (); - - if (nel > 0) - { - MT t1 (matrix.reshape (dim_vector (nel, 1))); - - if (t1.any_element_is_nan ()) - gripe_nan_to_logical_conversion (); - else - { - boolNDArray t2 = t1.all (); - - retval = t2(0); - } - } - - return retval; -} - -template -bool -octave_base_matrix::print_as_scalar (void) const -{ - dim_vector dv = dims (); - - return (dv.all_ones () || dv.any_zero ()); -} - -template -void -octave_base_matrix::print (std::ostream& os, bool pr_as_read_syntax) const -{ - print_raw (os, pr_as_read_syntax); - newline (os); -} - -template -void -octave_base_matrix::print_info (std::ostream& os, - const std::string& prefix) const -{ - matrix.print_info (os, prefix); -} - -template -octave_value -octave_base_matrix::fast_elem_extract (octave_idx_type n) const -{ - if (n < matrix.numel ()) - return matrix(n); - else - return octave_value (); -} - -template -bool -octave_base_matrix::fast_elem_insert (octave_idx_type n, - const octave_value& x) -{ - if (n < matrix.numel ()) - { - // Don't use builtin_type () here to avoid an extra VM call. - typedef typename MT::element_type ET; - const builtin_type_t btyp = class_to_btyp::btyp; - if (btyp == btyp_unknown) // Dead branch? - return false; - - // Set up the pointer to the proper place. - void *here = reinterpret_cast (&matrix(n)); - // Ask x to store there if it can. - return x.get_rep ().fast_elem_insert_self (here, btyp); - } - else - return false; -} diff -r d02b229ce693 -r a132d206a36a src/ov-base-mat.h --- a/src/ov-base-mat.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,204 +0,0 @@ -/* - -Copyright (C) 1998-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_base_matrix_h) -#define octave_base_matrix_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "str-vec.h" -#include "MatrixType.h" - -#include "error.h" -#include "oct-obj.h" -#include "ov-base.h" -#include "ov-typeinfo.h" - -class tree_walker; - -// Real matrix values. - -template -class -octave_base_matrix : public octave_base_value -{ -public: - - octave_base_matrix (void) - : octave_base_value (), matrix (), typ (), idx_cache () { } - - octave_base_matrix (const MT& m, const MatrixType& t = MatrixType ()) - : octave_base_value (), matrix (m), - typ (t.is_known () ? new MatrixType (t) : 0), idx_cache () - { - if (matrix.ndims () == 0) - matrix.resize (dim_vector (0, 0)); - } - - octave_base_matrix (const octave_base_matrix& m) - : octave_base_value (), matrix (m.matrix), - typ (m.typ ? new MatrixType (*m.typ) : 0), - idx_cache (m.idx_cache ? new idx_vector (*m.idx_cache) : 0) - { } - - ~octave_base_matrix (void) { clear_cached_info (); } - - size_t byte_size (void) const { return matrix.byte_size (); } - - octave_value squeeze (void) const { return MT (matrix.squeeze ()); } - - octave_value full_value (void) const { return matrix; } - - void maybe_economize (void) { matrix.maybe_economize (); } - - octave_value subsref (const std::string& type, - const std::list& idx); - - octave_value_list subsref (const std::string& type, - const std::list& idx, int) - { return subsref (type, idx); } - - octave_value subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - octave_value_list do_multi_index_op (int, const octave_value_list& idx) - { return do_index_op (idx); } - - void assign (const octave_value_list& idx, const MT& rhs); - - void assign (const octave_value_list& idx, typename MT::element_type rhs); - - void delete_elements (const octave_value_list& idx); - - dim_vector dims (void) const { return matrix.dims (); } - - octave_idx_type numel (void) const { return matrix.numel (); } - - int ndims (void) const { return matrix.ndims (); } - - octave_idx_type nnz (void) const { return matrix.nnz (); } - - octave_value reshape (const dim_vector& new_dims) const - { return MT (matrix.reshape (new_dims)); } - - octave_value permute (const Array& vec, bool inv = false) const - { return MT (matrix.permute (vec, inv)); } - - octave_value resize (const dim_vector& dv, bool fill = false) const; - - octave_value all (int dim = 0) const { return matrix.all (dim); } - octave_value any (int dim = 0) const { return matrix.any (dim); } - - MatrixType matrix_type (void) const { return typ ? *typ : MatrixType (); } - MatrixType matrix_type (const MatrixType& _typ) const; - - octave_value diag (octave_idx_type k = 0) const - { return octave_value (matrix.diag (k)); } - - octave_value diag (octave_idx_type m, octave_idx_type n) const - { return octave_value (matrix.diag (m, n)); } - - octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const - { return octave_value (matrix.sort (dim, mode)); } - octave_value sort (Array &sidx, octave_idx_type dim = 0, - sortmode mode = ASCENDING) const - { return octave_value (matrix.sort (sidx, dim, mode)); } - - sortmode is_sorted (sortmode mode = UNSORTED) const - { return matrix.is_sorted (mode); } - - Array sort_rows_idx (sortmode mode = ASCENDING) const - { return matrix.sort_rows_idx (mode); } - - sortmode is_sorted_rows (sortmode mode = UNSORTED) const - { return matrix.is_sorted_rows (mode); } - - bool is_matrix_type (void) const { return true; } - - bool is_numeric_type (void) const { return true; } - - bool is_defined (void) const { return true; } - - bool is_constant (void) const { return true; } - - bool is_true (void) const; - - bool print_as_scalar (void) const; - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_info (std::ostream& os, const std::string& prefix) const; - - MT& matrix_ref (void) - { - clear_cached_info (); - return matrix; - } - - const MT& matrix_ref (void) const - { - return matrix; - } - - octave_value - fast_elem_extract (octave_idx_type n) const; - - bool - fast_elem_insert (octave_idx_type n, const octave_value& x); - -protected: - - MT matrix; - - idx_vector set_idx_cache (const idx_vector& idx) const - { - delete idx_cache; - idx_cache = idx ? new idx_vector (idx) : 0; - return idx; - } - - void clear_cached_info (void) const - { - delete typ; typ = 0; - delete idx_cache; idx_cache = 0; - } - - mutable MatrixType *typ; - mutable idx_vector *idx_cache; - -private: - - // No assignment. - - octave_base_matrix& operator = (const octave_base_matrix&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-base-scalar.cc --- a/src/ov-base-scalar.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,184 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "oct-obj.h" -#include "ov-base.h" -#include "ov-cx-mat.h" -#include "ov-re-mat.h" -#include "ov-base-scalar.h" -#include "pr-output.h" - -template -octave_value -octave_base_scalar::subsref (const std::string& type, - const std::list& idx) -{ - octave_value retval; - - switch (type[0]) - { - case '(': - retval = do_index_op (idx.front ()); - break; - - case '{': - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - return retval.next_subsref (type, idx); -} - -template -octave_value -octave_base_scalar::subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - octave_value retval; - - switch (type[0]) - { - case '(': - { - if (type.length () == 1) - retval = numeric_assign (type, idx, rhs); - else - { - std::string nm = type_name (); - error ("in indexed assignment of %s, last rhs index must be ()", - nm.c_str ()); - } - } - break; - - case '{': - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - return retval; -} - -template -octave_value -octave_base_scalar::permute (const Array& vec, bool inv) const -{ - return Array (dim_vector (1, 1), scalar).permute (vec, inv); -} - -template -octave_value -octave_base_scalar::reshape (const dim_vector& new_dims) const -{ - return Array (dim_vector (1, 1), scalar).reshape (new_dims); -} - -template -octave_value -octave_base_scalar::diag (octave_idx_type k) const -{ - return Array (dim_vector (1, 1), scalar).diag (k); -} - -template -octave_value -octave_base_scalar::diag (octave_idx_type m, octave_idx_type n) const -{ - return Array (dim_vector (1, 1), scalar).diag (m, n); -} - -template -bool -octave_base_scalar::is_true (void) const -{ - bool retval = false; - - if (xisnan (scalar)) - gripe_nan_to_logical_conversion (); - else - retval = (scalar != ST ()); - - return retval; -} - -template -void -octave_base_scalar::print (std::ostream& os, bool pr_as_read_syntax) const -{ - print_raw (os, pr_as_read_syntax); - newline (os); -} - -template -void -octave_base_scalar::print_raw (std::ostream& os, - bool pr_as_read_syntax) const -{ - indent (os); - octave_print_internal (os, scalar, pr_as_read_syntax); -} - -template -bool -octave_base_scalar::print_name_tag (std::ostream& os, - const std::string& name) const -{ - indent (os); - os << name << " = "; - return false; -} - -template -bool -octave_base_scalar::fast_elem_insert_self (void *where, builtin_type_t btyp) const -{ - - // Don't use builtin_type () here to avoid an extra VM call. - if (btyp == class_to_btyp::btyp) - { - *(reinterpret_cast(where)) = scalar; - return true; - } - else - return false; -} diff -r d02b229ce693 -r a132d206a36a src/ov-base-scalar.h --- a/src/ov-base-scalar.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,157 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_base_scalar_h) -#define octave_base_scalar_h 1 - -#include - -#include -#include - -#include "lo-mappers.h" -#include "lo-utils.h" -#include "oct-alloc.h" -#include "str-vec.h" -#include "MatrixType.h" - -#include "ov-base.h" -#include "ov-typeinfo.h" - -// Real scalar values. - -template -class -octave_base_scalar : public octave_base_value -{ -public: - - octave_base_scalar (void) - : octave_base_value (), scalar () { } - - octave_base_scalar (const ST& s) - : octave_base_value (), scalar (s) { } - - octave_base_scalar (const octave_base_scalar& s) - : octave_base_value (), scalar (s.scalar) { } - - ~octave_base_scalar (void) { } - - octave_value squeeze (void) const { return scalar; } - - octave_value full_value (void) const { return scalar; } - - octave_value subsref (const std::string& type, - const std::list& idx); - - octave_value_list subsref (const std::string& type, - const std::list& idx, int) - { return subsref (type, idx); } - - octave_value subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - octave_value_list do_multi_index_op (int, const octave_value_list& idx) - { return do_index_op (idx); } - - bool is_constant (void) const { return true; } - - bool is_defined (void) const { return true; } - - dim_vector dims (void) const { static dim_vector dv (1, 1); return dv; } - - octave_idx_type numel (void) const { return 1; } - - int ndims (void) const { return 2; } - - octave_idx_type nnz (void) const { return (scalar != ST ()) ? 1 : 0; } - - octave_value permute (const Array&, bool = false) const; - - octave_value reshape (const dim_vector& new_dims) const; - - size_t byte_size (void) const { return sizeof (ST); } - - octave_value all (int = 0) const { return (scalar != ST ()); } - - octave_value any (int = 0) const { return (scalar != ST ()); } - - octave_value diag (octave_idx_type k = 0) const; - - octave_value diag (octave_idx_type m, octave_idx_type n) const; - - octave_value sort (octave_idx_type, sortmode) const - { return octave_value (scalar); } - octave_value sort (Array &sidx, octave_idx_type, - sortmode) const - { - sidx.resize (dim_vector (1, 1)); - sidx(0) = 0; - return octave_value (scalar); - } - - sortmode is_sorted (sortmode mode = UNSORTED) const - { return mode ? mode : ASCENDING; } - - Array sort_rows_idx (sortmode) const - { - return Array (dim_vector (1, 1), - static_cast (0)); - } - - sortmode is_sorted_rows (sortmode mode = UNSORTED) const - { return mode ? mode : ASCENDING; } - - MatrixType matrix_type (void) const { return MatrixType::Diagonal; } - MatrixType matrix_type (const MatrixType&) const - { return matrix_type (); } - - bool is_scalar_type (void) const { return true; } - - bool is_numeric_type (void) const { return true; } - - bool is_true (void) const; - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool print_name_tag (std::ostream& os, const std::string& name) const; - - // Unsafe. This function exists to support the MEX interface. - // You should not use it anywhere else. - void *mex_get_data (void) const { return const_cast (&scalar); } - - const ST& scalar_ref (void) const { return scalar; } - - ST& scalar_ref (void) { return scalar; } - - bool fast_elem_insert_self (void *where, builtin_type_t btyp) const; - -protected: - - // The value of this scalar. - ST scalar; -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-base-sparse.cc --- a/src/ov-base-sparse.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,465 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "oct-obj.h" -#include "ov-base.h" -#include "quit.h" -#include "pr-output.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -#include "boolSparse.h" -#include "ov-base-sparse.h" -#include "pager.h" - -template -octave_value -octave_base_sparse::do_index_op (const octave_value_list& idx, - bool resize_ok) -{ - octave_value retval; - - octave_idx_type n_idx = idx.length (); - - switch (n_idx) - { - case 0: - retval = matrix; - break; - - case 1: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - retval = octave_value (matrix.index (i, resize_ok)); - } - break; - - case 2: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - { - idx_vector j = idx (1).index_vector (); - - if (! error_state) - retval = octave_value (matrix.index (i, j, resize_ok)); - } - } - break; - default: - error ("sparse indexing needs 1 or 2 indices"); - } - - return retval; -} - -template -octave_value -octave_base_sparse::subsref (const std::string& type, - const std::list& idx) -{ - octave_value retval; - - switch (type[0]) - { - case '(': - retval = do_index_op (idx.front ()); - break; - - case '{': - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - return retval.next_subsref (type, idx); -} - -template -octave_value -octave_base_sparse::subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - octave_value retval; - - switch (type[0]) - { - case '(': - { - if (type.length () == 1) - retval = numeric_assign (type, idx, rhs); - else - { - std::string nm = type_name (); - error ("in indexed assignment of %s, last lhs index must be ()", - nm.c_str ()); - } - } - break; - - case '{': - case '.': - { - if (is_empty ()) - { - octave_value tmp = octave_value::empty_conv (type, rhs); - - retval = tmp.subsasgn (type, idx, rhs); - } - else - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - } - break; - - default: - panic_impossible (); - } - - return retval; -} - -template -void -octave_base_sparse::assign (const octave_value_list& idx, const T& rhs) -{ - - octave_idx_type len = idx.length (); - - switch (len) - { - case 1: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - matrix.assign (i, rhs); - - break; - } - - case 2: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - { - idx_vector j = idx (1).index_vector (); - - if (! error_state) - matrix.assign (i, j, rhs); - } - - break; - } - - default: - error ("sparse indexing needs 1 or 2 indices"); - } - - - // Invalidate matrix type. - typ.invalidate_type (); -} - -template -void -octave_base_sparse::delete_elements (const octave_value_list& idx) -{ - octave_idx_type len = idx.length (); - - switch (len) - { - case 1: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - matrix.delete_elements (i); - - break; - } - - case 2: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - { - idx_vector j = idx (1).index_vector (); - - if (! error_state) - matrix.delete_elements (i, j); - } - - break; - } - - default: - error ("sparse indexing needs 1 or 2 indices"); - } - - // Invalidate the matrix type - typ.invalidate_type (); -} - -template -octave_value -octave_base_sparse::resize (const dim_vector& dv, bool) const -{ - T retval (matrix); - retval.resize (dv); - return retval; -} - -template -bool -octave_base_sparse::is_true (void) const -{ - bool retval = false; - dim_vector dv = matrix.dims (); - octave_idx_type nel = dv.numel (); - octave_idx_type nz = nnz (); - - if (nz == nel && nel > 0) - { - T t1 (matrix.reshape (dim_vector (nel, 1))); - - SparseBoolMatrix t2 = t1.all (); - - retval = t2(0); - } - - return retval; -} - -template -bool -octave_base_sparse::print_as_scalar (void) const -{ - dim_vector dv = dims (); - - return (dv.all_ones () || dv.any_zero ()); -} - -template -void -octave_base_sparse::print (std::ostream& os, bool pr_as_read_syntax) const -{ - print_raw (os, pr_as_read_syntax); - newline (os); -} - -template -void -octave_base_sparse::print_info (std::ostream& os, - const std::string& prefix) const -{ - matrix.print_info (os, prefix); -} - -template -void -octave_base_sparse::print_raw (std::ostream& os, - bool pr_as_read_syntax) const -{ - octave_idx_type nr = matrix.rows (); - octave_idx_type nc = matrix.cols (); - octave_idx_type nz = nnz (); - - // FIXME -- this should probably all be handled by a - // separate octave_print_internal function that can handle format - // compact, loose, etc. - - os << "Compressed Column Sparse (rows = " << nr - << ", cols = " << nc - << ", nnz = " << nz; - - // Avoid calling numel here since it can easily overflow - // octave_idx_type even when there is no real problem storing the - // sparse array. - - double dnr = nr; - double dnc = nc; - double dnel = dnr * dnc; - - if (dnel > 0) - { - double pct = (nz / dnel * 100); - - int prec = 2; - - // Display at least 2 significant figures and up to 4 as we - // approach 100%. Avoid having limited precision of the display - // result in reporting 100% for matrices that are not actually - // 100% full. - - if (pct == 100) - prec = 3; - else - { - if (pct > 99.9) - prec = 4; - else if (pct > 99) - prec = 3; - - if (pct > 99.99) - pct = 99.99; - } - - os << " [" << std::setprecision (prec) << pct << "%]"; - } - - os << ")\n"; - - // add one to the printed indices to go from - // zero-based to one-based arrays - - if (nz != 0) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - // FIXME -- is there an easy way to get the max row - // and column indices so we can set the width appropriately - // and line up the columns here? Similarly, we should look - // at all the nonzero values and display them with the same - // formatting rules that apply to columns of a matrix. - - for (octave_idx_type i = matrix.cidx (j); i < matrix.cidx (j+1); i++) - { - os << "\n"; - os << " (" << matrix.ridx (i)+1 << - ", " << j+1 << ") -> "; - - octave_print_internal (os, matrix.data (i), pr_as_read_syntax); - } - } - } -} - -template -bool -octave_base_sparse::save_ascii (std::ostream& os) -{ - dim_vector dv = this->dims (); - - // Ensure that additional memory is deallocated - matrix.maybe_compress (); - - os << "# nnz: " << nnz () << "\n"; - os << "# rows: " << dv (0) << "\n"; - os << "# columns: " << dv (1) << "\n"; - - os << this->matrix; - - return true; -} - -template -bool -octave_base_sparse::load_ascii (std::istream& is) -{ - octave_idx_type nz = 0; - octave_idx_type nr = 0; - octave_idx_type nc = 0; - bool success = true; - - if (extract_keyword (is, "nnz", nz, true) && - extract_keyword (is, "rows", nr, true) && - extract_keyword (is, "columns", nc, true)) - { - T tmp (nr, nc, nz); - - is >> tmp; - - if (!is) - { - error ("load: failed to load matrix constant"); - success = false; - } - - matrix = tmp; - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - - return success; -} - -template -octave_value -octave_base_sparse::map (octave_base_value::unary_mapper_t umap) const -{ - // Try the map on the dense value. - octave_value retval = this->full_value ().map (umap); - - // Sparsify the result if possible. - // FIXME: intentionally skip this step for string mappers. Is this wanted? - if (umap >= umap_xisalnum && umap <= umap_xtoupper) - return retval; - - switch (retval.builtin_type ()) - { - case btyp_double: - retval = retval.sparse_matrix_value (); - break; - case btyp_complex: - retval = retval.sparse_complex_matrix_value (); - break; - case btyp_bool: - retval = retval.sparse_bool_matrix_value (); - break; - default: - break; - } - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/ov-base-sparse.h --- a/src/ov-base-sparse.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,175 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_base_sparse_h) -#define octave_base_sparse_h 1 - -#include - -#include -#include - -#include "str-vec.h" - -#include "error.h" -#include "oct-obj.h" -#include "ov-base.h" -#include "ov-typeinfo.h" - -#include "boolSparse.h" -#include "MatrixType.h" - -class tree_walker; - -class octave_sparse_bool_matrix; - -template -class -octave_base_sparse : public octave_base_value -{ - public: - - octave_base_sparse (void) - : octave_base_value (), matrix (), typ (MatrixType ()) - { } - - octave_base_sparse (const T& a) : octave_base_value (), matrix (a), - typ (MatrixType ()) - { - if (matrix.ndims () == 0) - matrix.resize (dim_vector (0, 0)); - } - - octave_base_sparse (const T& a, const MatrixType& t) : octave_base_value (), - matrix (a), typ (t) - { - if (matrix.ndims () == 0) - matrix.resize (dim_vector (0, 0)); - } - - octave_base_sparse (const octave_base_sparse& a) : - octave_base_value (), matrix (a.matrix), typ (a.typ) { } - - ~octave_base_sparse (void) { } - - octave_idx_type nnz (void) const { return matrix.nnz (); } - - octave_idx_type nzmax (void) const { return matrix.nzmax (); } - - size_t byte_size (void) const { return matrix.byte_size (); } - - octave_value squeeze (void) const { return matrix.squeeze (); } - - octave_value full_value (void) const { return matrix.matrix_value (); } - - octave_value subsref (const std::string& type, - const std::list& idx); - - octave_value_list subsref (const std::string& type, - const std::list& idx, int) - { return subsref (type, idx); } - - octave_value subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - void assign (const octave_value_list& idx, const T& rhs); - - void delete_elements (const octave_value_list& idx); - - dim_vector dims (void) const { return matrix.dims (); } - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - octave_value reshape (const dim_vector& new_dims) const - { return T (matrix.reshape (new_dims)); } - - octave_value permute (const Array& vec, bool inv = false) const - { return T (matrix.permute (vec, inv)); } - - octave_value resize (const dim_vector& dv, bool = false) const; - - octave_value all (int dim = 0) const { return matrix.all (dim); } - octave_value any (int dim = 0) const { return matrix.any (dim); } - - octave_value diag (octave_idx_type k = 0) const - { return octave_value (matrix.diag (k)); } - - octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const - { return octave_value (matrix.sort (dim, mode)); } - octave_value sort (Array &sidx, octave_idx_type dim = 0, - sortmode mode = ASCENDING) const - { return octave_value (matrix.sort (sidx, dim, mode)); } - - sortmode is_sorted (sortmode mode = UNSORTED) const - { return full_value ().is_sorted (mode); } - - MatrixType matrix_type (void) const { return typ; } - MatrixType matrix_type (const MatrixType& _typ) const - { MatrixType ret = typ; typ = _typ; return ret; } - - bool is_matrix_type (void) const { return true; } - - bool is_numeric_type (void) const { return true; } - - bool is_sparse_type (void) const { return true; } - - bool is_defined (void) const { return true; } - - bool is_constant (void) const { return true; } - - bool is_true (void) const; - - octave_idx_type capacity (void) const { return matrix.capacity (); } - - bool print_as_scalar (void) const; - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_info (std::ostream& os, const std::string& prefix) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - // Unsafe. These functions exists to support the MEX interface. - // You should not use them anywhere else. - void *mex_get_data (void) const { return matrix.mex_get_data (); } - - octave_idx_type *mex_get_ir (void) const { return matrix.mex_get_ir (); } - - octave_idx_type *mex_get_jc (void) const { return matrix.mex_get_jc (); } - -protected: - - octave_value map (octave_base_value::unary_mapper_t umap) const; - - T matrix; - - mutable MatrixType typ; -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-base.cc --- a/src/ov-base.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1579 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "lo-ieee.h" -#include "lo-mappers.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "oct-stream.h" -#include "ops.h" -#include "ov-base.h" -#include "ov-cell.h" -#include "ov-ch-mat.h" -#include "ov-complex.h" -#include "ov-cx-mat.h" -#include "ov-range.h" -#include "ov-re-mat.h" -#include "ov-scalar.h" -#include "ov-str-mat.h" -#include "ov-fcn-handle.h" -#include "parse.h" -#include "pr-output.h" -#include "utils.h" -#include "variables.h" - -builtin_type_t btyp_mixed_numeric (builtin_type_t x, builtin_type_t y) -{ - builtin_type_t retval = btyp_unknown; - - if (x == btyp_bool) - x = btyp_double; - if (y == btyp_bool) - y = btyp_double; - - if (x <= btyp_float_complex && y <= btyp_float_complex) - retval = static_cast (x | y); - else if (x <= btyp_uint64 && y <= btyp_float) - retval = x; - else if (x <= btyp_float && y <= btyp_uint64) - retval = y; - else if ((x >= btyp_int8 && x <= btyp_int64 - && y >= btyp_int8 && y <= btyp_int64) - || (x >= btyp_uint8 && x <= btyp_uint64 - && y >= btyp_uint8 && y <= btyp_uint64)) - retval = (x > y) ? x : y; - - return retval; -} - -std::string btyp_class_name[btyp_num_types] = -{ - "double", "single", "double", "single", - "int8", "int16", "int32", "int64", - "uint8", "uint16", "uint32", "uint64", - "logical", "char", - "struct", "cell", "function_handle" -}; - -string_vector -get_builtin_classes (void) -{ - static string_vector retval; - - if (retval.is_empty ()) - { - int n = btyp_num_types - 2; - retval = string_vector (n); - int j = 0; - for (int i = 0; i < btyp_num_types; i++) - { - builtin_type_t ityp = static_cast (i); - if (ityp != btyp_complex && ityp != btyp_float_complex) - retval(j++) = btyp_class_name[i]; - } - } - - return retval; -} - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_base_value, - "", "unknown"); - -// TRUE means to perform automatic sparse to real mutation if there -// is memory to be saved -bool Vsparse_auto_mutate = false; - -octave_base_value * -octave_base_value::empty_clone (void) const -{ - return resize (dim_vector ()).clone (); -} - -octave_value -octave_base_value::squeeze (void) const -{ - std::string nm = type_name (); - error ("squeeze: invalid operation for %s type", nm.c_str ()); - return octave_value (); -} - -octave_value -octave_base_value::full_value (void) const -{ - gripe_wrong_type_arg ("full: invalid operation for %s type", type_name ()); - return octave_value (); -} - -Matrix -octave_base_value::size (void) -{ - const dim_vector dv = dims (); - Matrix mdv (1, dv.length ()); - for (octave_idx_type i = 0; i < dv.length (); i++) - mdv(i) = dv(i); - return mdv; -} - -octave_idx_type -octave_base_value::numel (const octave_value_list& idx) -{ - return dims_to_numel (dims (), idx); -} - -octave_value -octave_base_value::subsref (const std::string&, - const std::list&) -{ - std::string nm = type_name (); - error ("can't perform indexing operations for %s type", nm.c_str ()); - return octave_value (); -} - -octave_value_list -octave_base_value::subsref (const std::string&, - const std::list&, int) -{ - std::string nm = type_name (); - error ("can't perform indexing operations for %s type", nm.c_str ()); - return octave_value (); -} - -octave_value -octave_base_value::subsref (const std::string& type, - const std::list& idx, - bool /* auto_add */) -{ - // This way we may get a more meaningful error message. - return subsref (type, idx); -} - -octave_value_list -octave_base_value::subsref (const std::string& type, - const std::list& idx, - int nargout, - const std::list *) -{ - // Fall back to call without passing lvalue list. - return subsref (type, idx, nargout); -} - -octave_value -octave_base_value::do_index_op (const octave_value_list&, bool) -{ - std::string nm = type_name (); - error ("can't perform indexing operations for %s type", nm.c_str ()); - return octave_value (); -} - -octave_value_list -octave_base_value::do_multi_index_op (int, const octave_value_list&) -{ - std::string nm = type_name (); - error ("can't perform indexing operations for %s type", nm.c_str ()); - return octave_value (); -} - -octave_value_list -octave_base_value::do_multi_index_op (int nargout, const octave_value_list& idx, - const std::list *) -{ - // Fall back. - return do_multi_index_op (nargout, idx); -} - -idx_vector -octave_base_value::index_vector (void) const -{ - std::string nm = type_name (); - error ("%s type invalid as index value", nm.c_str ()); - return idx_vector (); -} - -octave_value -octave_base_value::subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - octave_value retval; - - if (is_defined ()) - { - if (is_numeric_type ()) - { - switch (type[0]) - { - case '(': - { - if (type.length () == 1) - retval = numeric_assign (type, idx, rhs); - else if (is_empty ()) - { - // Allow conversion of empty matrix to some other - // type in cases like - // - // x = []; x(i).f = rhs - - octave_value tmp = octave_value::empty_conv (type, rhs); - - retval = tmp.subsasgn (type, idx, rhs); - } - else - { - std::string nm = type_name (); - error ("in indexed assignment of %s, last rhs index must be ()", - nm.c_str ()); - } - } - break; - - case '{': - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - } - else - { - std::string nm = type_name (); - error ("can't perform indexed assignment for %s type", nm.c_str ()); - } - } - else - { - // Create new object of appropriate type for given index and rhs - // types and then call undef_subsasgn for that object. - - octave_value tmp = octave_value::empty_conv (type, rhs); - - retval = tmp.undef_subsasgn (type, idx, rhs); - } - - return retval; -} - -octave_value -octave_base_value::undef_subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - // In most cases, undef_subsasgn is handled the sams as subsasgn. One - // exception is octave_class objects. - - return subsasgn (type, idx, rhs); -} - -octave_idx_type -octave_base_value::nnz (void) const -{ - gripe_wrong_type_arg ("octave_base_value::nnz ()", type_name ()); - return -1; -} - -octave_idx_type -octave_base_value::nzmax (void) const -{ - return numel (); -} - -octave_idx_type -octave_base_value::nfields (void) const -{ - gripe_wrong_type_arg ("octave_base_value::nfields ()", type_name ()); - return -1; -} - -octave_value -octave_base_value::reshape (const dim_vector&) const -{ - gripe_wrong_type_arg ("octave_base_value::reshape ()", type_name ()); - return octave_value (); -} - -octave_value -octave_base_value::permute (const Array&, bool) const -{ - gripe_wrong_type_arg ("octave_base_value::permute ()", type_name ()); - return octave_value (); -} - -octave_value -octave_base_value::resize (const dim_vector&, bool) const -{ - gripe_wrong_type_arg ("octave_base_value::resize ()", type_name ()); - return octave_value (); -} - -MatrixType -octave_base_value::matrix_type (void) const -{ - gripe_wrong_type_arg ("octave_base_value::matrix_type ()", type_name ()); - return MatrixType (); -} - -MatrixType -octave_base_value::matrix_type (const MatrixType&) const -{ - gripe_wrong_type_arg ("octave_base_value::matrix_type ()", type_name ()); - return MatrixType (); -} - -octave_value -octave_base_value::all (int) const -{ - return 0.0; -} - -octave_value -octave_base_value::any (int) const -{ - return 0.0; -} - -octave_value -octave_base_value::convert_to_str (bool pad, bool force, char type) const -{ - octave_value retval = convert_to_str_internal (pad, force, type); - - if (! force && is_numeric_type ()) - gripe_implicit_conversion ("Octave:num-to-str", - type_name (), retval.type_name ()); - - return retval; -} - -octave_value -octave_base_value::convert_to_str_internal (bool, bool, char) const -{ - gripe_wrong_type_arg ("octave_base_value::convert_to_str_internal ()", - type_name ()); - return octave_value (); -} - -void -octave_base_value::convert_to_row_or_column_vector (void) -{ - gripe_wrong_type_arg - ("octave_base_value::convert_to_row_or_column_vector ()", - type_name ()); -} - -void -octave_base_value::print (std::ostream&, bool) const -{ - gripe_wrong_type_arg ("octave_base_value::print ()", type_name ()); -} - -void -octave_base_value::print_raw (std::ostream&, bool) const -{ - gripe_wrong_type_arg ("octave_base_value::print_raw ()", type_name ()); -} - -bool -octave_base_value::print_name_tag (std::ostream& os, const std::string& name) const -{ - bool retval = false; - - indent (os); - - if (print_as_scalar ()) - os << name << " = "; - else - { - os << name << " ="; - newline (os); - if (! Vcompact_format) - newline (os); - - retval = true; - } - - return retval; -} - -void -octave_base_value::print_with_name (std::ostream& output_buf, - const std::string& name, - bool print_padding) -{ - bool pad_after = print_name_tag (output_buf, name); - - print (output_buf); - - if (print_padding && pad_after && ! Vcompact_format) - newline (output_buf); -} - -void -octave_base_value::print_info (std::ostream& os, - const std::string& /* prefix */) const -{ - os << "no info for type: " << type_name () << "\n"; -} - -#define INT_CONV_METHOD(T, F, MIN_LIMIT, MAX_LIMIT) \ - T \ - octave_base_value::F ## _value (bool require_int, bool frc_str_conv) const \ - { \ - T retval = 0; \ - \ - double d = double_value (frc_str_conv); \ - \ - if (! error_state) \ - { \ - if (require_int && D_NINT (d) != d) \ - error_with_cfn ("conversion of %g to " #T " value failed", d); \ - else if (d < MIN_LIMIT) \ - retval = MIN_LIMIT; \ - else if (d > MAX_LIMIT) \ - retval = MAX_LIMIT; \ - else \ - retval = static_cast (::fix (d)); \ - } \ - else \ - gripe_wrong_type_arg ("octave_base_value::" #F "_value ()", \ - type_name ()); \ - \ - return retval; \ - } - -INT_CONV_METHOD (short int, short, SHRT_MIN, SHRT_MAX) -INT_CONV_METHOD (unsigned short int, ushort, 0, USHRT_MAX) - -INT_CONV_METHOD (int, int, INT_MIN, INT_MAX) -INT_CONV_METHOD (unsigned int, uint, 0, UINT_MAX) - -INT_CONV_METHOD (long int, long, LONG_MIN, LONG_MAX) -INT_CONV_METHOD (unsigned long int, ulong, 0, ULONG_MAX) - -int -octave_base_value::nint_value (bool frc_str_conv) const -{ - int retval = 0; - - double d = double_value (frc_str_conv); - - if (! error_state) - { - if (xisnan (d)) - { - error ("conversion of NaN to integer value failed"); - return retval; - } - - retval = static_cast (::fix (d)); - } - else - gripe_wrong_type_arg ("octave_base_value::nint_value ()", type_name ()); - - return retval; -} - -double -octave_base_value::double_value (bool) const -{ - double retval = lo_ieee_nan_value (); - gripe_wrong_type_arg ("octave_base_value::double_value ()", type_name ()); - return retval; -} - -float -octave_base_value::float_value (bool) const -{ - float retval = lo_ieee_float_nan_value (); - gripe_wrong_type_arg ("octave_base_value::float_value ()", type_name ()); - return retval; -} - -Cell -octave_base_value::cell_value () const -{ - Cell retval; - gripe_wrong_type_arg ("octave_base_value::cell_value()", type_name ()); - return retval; -} - -Matrix -octave_base_value::matrix_value (bool) const -{ - Matrix retval; - gripe_wrong_type_arg ("octave_base_value::matrix_value()", type_name ()); - return retval; -} - -FloatMatrix -octave_base_value::float_matrix_value (bool) const -{ - FloatMatrix retval; - gripe_wrong_type_arg ("octave_base_value::float_matrix_value()", type_name ()); - return retval; -} - -NDArray -octave_base_value::array_value (bool) const -{ - FloatNDArray retval; - gripe_wrong_type_arg ("octave_base_value::array_value()", type_name ()); - return retval; -} - -FloatNDArray -octave_base_value::float_array_value (bool) const -{ - FloatNDArray retval; - gripe_wrong_type_arg ("octave_base_value::float_array_value()", type_name ()); - return retval; -} - -Complex -octave_base_value::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - Complex retval (tmp, tmp); - gripe_wrong_type_arg ("octave_base_value::complex_value()", type_name ()); - return retval; -} - -FloatComplex -octave_base_value::float_complex_value (bool) const -{ - float tmp = lo_ieee_float_nan_value (); - FloatComplex retval (tmp, tmp); - gripe_wrong_type_arg ("octave_base_value::float_complex_value()", type_name ()); - return retval; -} - -ComplexMatrix -octave_base_value::complex_matrix_value (bool) const -{ - ComplexMatrix retval; - gripe_wrong_type_arg ("octave_base_value::complex_matrix_value()", - type_name ()); - return retval; -} - -FloatComplexMatrix -octave_base_value::float_complex_matrix_value (bool) const -{ - FloatComplexMatrix retval; - gripe_wrong_type_arg ("octave_base_value::float_complex_matrix_value()", - type_name ()); - return retval; -} - -ComplexNDArray -octave_base_value::complex_array_value (bool) const -{ - ComplexNDArray retval; - gripe_wrong_type_arg ("octave_base_value::complex_array_value()", - type_name ()); - return retval; -} - -FloatComplexNDArray -octave_base_value::float_complex_array_value (bool) const -{ - FloatComplexNDArray retval; - gripe_wrong_type_arg ("octave_base_value::float_complex_array_value()", - type_name ()); - return retval; -} - -bool -octave_base_value::bool_value (bool) const -{ - bool retval = false; - gripe_wrong_type_arg ("octave_base_value::bool_value()", type_name ()); - return retval; -} - -boolMatrix -octave_base_value::bool_matrix_value (bool) const -{ - boolMatrix retval; - gripe_wrong_type_arg ("octave_base_value::bool_matrix_value()", - type_name ()); - return retval; -} - -boolNDArray -octave_base_value::bool_array_value (bool) const -{ - boolNDArray retval; - gripe_wrong_type_arg ("octave_base_value::bool_array_value()", - type_name ()); - return retval; -} - -charMatrix -octave_base_value::char_matrix_value (bool force) const -{ - charMatrix retval; - - octave_value tmp = convert_to_str (false, force); - - if (! error_state) - retval = tmp.char_matrix_value (); - - return retval; -} - -charNDArray -octave_base_value::char_array_value (bool) const -{ - charNDArray retval; - gripe_wrong_type_arg ("octave_base_value::char_array_value()", - type_name ()); - return retval; -} - -SparseMatrix -octave_base_value::sparse_matrix_value (bool) const -{ - SparseMatrix retval; - gripe_wrong_type_arg ("octave_base_value::sparse_matrix_value()", type_name ()); - return retval; -} - -SparseComplexMatrix -octave_base_value::sparse_complex_matrix_value (bool) const -{ - SparseComplexMatrix retval; - gripe_wrong_type_arg ("octave_base_value::sparse_complex_matrix_value()", type_name ()); - return retval; -} - -SparseBoolMatrix -octave_base_value::sparse_bool_matrix_value (bool) const -{ - SparseBoolMatrix retval; - gripe_wrong_type_arg ("octave_base_value::sparse_bool_matrix_value()", type_name ()); - return retval; -} - -DiagMatrix -octave_base_value::diag_matrix_value (bool) const -{ - DiagMatrix retval; - gripe_wrong_type_arg ("octave_base_value::diag_matrix_value()", type_name ()); - return retval; -} - -FloatDiagMatrix -octave_base_value::float_diag_matrix_value (bool) const -{ - FloatDiagMatrix retval; - gripe_wrong_type_arg ("octave_base_value::float_diag_matrix_value()", type_name ()); - return retval; -} - -ComplexDiagMatrix -octave_base_value::complex_diag_matrix_value (bool) const -{ - ComplexDiagMatrix retval; - gripe_wrong_type_arg ("octave_base_value::complex_diag_matrix_value()", type_name ()); - return retval; -} - -FloatComplexDiagMatrix -octave_base_value::float_complex_diag_matrix_value (bool) const -{ - FloatComplexDiagMatrix retval; - gripe_wrong_type_arg ("octave_base_value::float_complex_diag_matrix_value()", type_name ()); - return retval; -} - -PermMatrix -octave_base_value::perm_matrix_value (void) const -{ - PermMatrix retval; - gripe_wrong_type_arg ("octave_base_value::perm_matrix_value()", type_name ()); - return retval; -} - -octave_int8 -octave_base_value::int8_scalar_value (void) const -{ - octave_int8 retval; - gripe_wrong_type_arg ("octave_base_value::int8_scalar_value()", - type_name ()); - return retval; -} - -octave_int16 -octave_base_value::int16_scalar_value (void) const -{ - octave_int16 retval; - gripe_wrong_type_arg ("octave_base_value::int16_scalar_value()", - type_name ()); - return retval; -} - -octave_int32 -octave_base_value::int32_scalar_value (void) const -{ - octave_int32 retval; - gripe_wrong_type_arg ("octave_base_value::int32_scalar_value()", - type_name ()); - return retval; -} - -octave_int64 -octave_base_value::int64_scalar_value (void) const -{ - octave_int64 retval; - gripe_wrong_type_arg ("octave_base_value::int64_scalar_value()", - type_name ()); - return retval; -} - -octave_uint8 -octave_base_value::uint8_scalar_value (void) const -{ - octave_uint8 retval; - gripe_wrong_type_arg ("octave_base_value::uint8_scalar_value()", - type_name ()); - return retval; -} - -octave_uint16 -octave_base_value::uint16_scalar_value (void) const -{ - octave_uint16 retval; - gripe_wrong_type_arg ("octave_base_value::uint16_scalar_value()", - type_name ()); - return retval; -} - -octave_uint32 -octave_base_value::uint32_scalar_value (void) const -{ - octave_uint32 retval; - gripe_wrong_type_arg ("octave_base_value::uint32_scalar_value()", - type_name ()); - return retval; -} - -octave_uint64 -octave_base_value::uint64_scalar_value (void) const -{ - octave_uint64 retval; - gripe_wrong_type_arg ("octave_base_value::uint64_scalar_value()", - type_name ()); - return retval; -} - -int8NDArray -octave_base_value::int8_array_value (void) const -{ - int8NDArray retval; - gripe_wrong_type_arg ("octave_base_value::int8_array_value()", - type_name ()); - return retval; -} - -int16NDArray -octave_base_value::int16_array_value (void) const -{ - int16NDArray retval; - gripe_wrong_type_arg ("octave_base_value::int16_array_value()", - type_name ()); - return retval; -} - -int32NDArray -octave_base_value::int32_array_value (void) const -{ - int32NDArray retval; - gripe_wrong_type_arg ("octave_base_value::int32_array_value()", - type_name ()); - return retval; -} - -int64NDArray -octave_base_value::int64_array_value (void) const -{ - int64NDArray retval; - gripe_wrong_type_arg ("octave_base_value::int64_array_value()", - type_name ()); - return retval; -} - -uint8NDArray -octave_base_value::uint8_array_value (void) const -{ - uint8NDArray retval; - gripe_wrong_type_arg ("octave_base_value::uint8_array_value()", - type_name ()); - return retval; -} - -uint16NDArray -octave_base_value::uint16_array_value (void) const -{ - uint16NDArray retval; - gripe_wrong_type_arg ("octave_base_value::uint16_array_value()", - type_name ()); - return retval; -} - -uint32NDArray -octave_base_value::uint32_array_value (void) const -{ - uint32NDArray retval; - gripe_wrong_type_arg ("octave_base_value::uint32_array_value()", - type_name ()); - return retval; -} - -uint64NDArray -octave_base_value::uint64_array_value (void) const -{ - uint64NDArray retval; - gripe_wrong_type_arg ("octave_base_value::uint64_array_value()", - type_name ()); - return retval; -} - -string_vector -octave_base_value::all_strings (bool pad) const -{ - string_vector retval; - - octave_value tmp = convert_to_str (pad, true); - - if (! error_state) - retval = tmp.all_strings (); - - return retval; -} - -std::string -octave_base_value::string_value (bool force) const -{ - std::string retval; - - octave_value tmp = convert_to_str (force); - - if (! error_state) - retval = tmp.string_value (); - - return retval; -} - -Array -octave_base_value::cellstr_value (void) const -{ - Array retval; - gripe_wrong_type_arg ("octave_base_value::cellstry_value()", - type_name ()); - return retval; -} - -Range -octave_base_value::range_value (void) const -{ - Range retval; - gripe_wrong_type_arg ("octave_base_value::range_value()", type_name ()); - return retval; -} - -octave_map -octave_base_value::map_value (void) const -{ - octave_map retval; - gripe_wrong_type_arg ("octave_base_value::map_value()", type_name ()); - return retval; -} - -octave_scalar_map -octave_base_value::scalar_map_value (void) const -{ - octave_map tmp = map_value (); - - if (tmp.numel () == 1) - return tmp.checkelem (0); - else - { - if (! error_state) - error ("invalid conversion of multi-dimensional struct to scalar struct"); - - return octave_scalar_map (); - } -} - -string_vector -octave_base_value::map_keys (void) const -{ - string_vector retval; - gripe_wrong_type_arg ("octave_base_value::map_keys()", type_name ()); - return retval; -} - -size_t -octave_base_value::nparents (void) const -{ - size_t retval = 0; - gripe_wrong_type_arg ("octave_base_value::nparents()", type_name ()); - return retval; -} - -std::list -octave_base_value::parent_class_name_list (void) const -{ - std::list retval; - gripe_wrong_type_arg ("octave_base_value::parent_class_name_list()", - type_name ()); - return retval; -} - -string_vector -octave_base_value::parent_class_names (void) const -{ - string_vector retval; - gripe_wrong_type_arg ("octave_base_value::parent_class_names()", - type_name ()); - return retval; -} - -octave_function * -octave_base_value::function_value (bool silent) -{ - octave_function *retval = 0; - - if (! silent) - gripe_wrong_type_arg ("octave_base_value::function_value()", - type_name ()); - return retval; -} - -octave_user_function * -octave_base_value::user_function_value (bool silent) -{ - octave_user_function *retval = 0; - - if (! silent) - gripe_wrong_type_arg ("octave_base_value::user_function_value()", - type_name ()); - return retval; -} - -octave_user_script * -octave_base_value::user_script_value (bool silent) -{ - octave_user_script *retval = 0; - - if (! silent) - gripe_wrong_type_arg ("octave_base_value::user_script_value()", - type_name ()); - return retval; -} - -octave_user_code * -octave_base_value::user_code_value (bool silent) -{ - octave_user_code *retval = 0; - - if (! silent) - gripe_wrong_type_arg ("octave_base_value::user_code_value()", - type_name ()); - return retval; -} - -octave_fcn_handle * -octave_base_value::fcn_handle_value (bool silent) -{ - octave_fcn_handle *retval = 0; - - if (! silent) - gripe_wrong_type_arg ("octave_base_value::fcn_handle_value()", - type_name ()); - return retval; -} - -octave_fcn_inline * -octave_base_value::fcn_inline_value (bool silent) -{ - octave_fcn_inline *retval = 0; - - if (! silent) - gripe_wrong_type_arg ("octave_base_value::fcn_inline_value()", - type_name ()); - return retval; -} - -octave_value_list -octave_base_value::list_value (void) const -{ - octave_value_list retval; - gripe_wrong_type_arg ("octave_base_value::list_value()", type_name ()); - return retval; -} - -bool -octave_base_value::save_ascii (std::ostream&) -{ - gripe_wrong_type_arg ("octave_base_value::save_ascii()", type_name ()); - return false; -} - -bool -octave_base_value::load_ascii (std::istream&) -{ - gripe_wrong_type_arg ("octave_base_value::load_ascii()", type_name ()); - return false; -} - -bool -octave_base_value::save_binary (std::ostream&, bool&) -{ - gripe_wrong_type_arg ("octave_base_value::save_binary()", type_name ()); - return false; -} - -bool -octave_base_value::load_binary (std::istream&, bool, - oct_mach_info::float_format) -{ - gripe_wrong_type_arg ("octave_base_value::load_binary()", type_name ()); - return false; -} - -#if defined (HAVE_HDF5) - -bool -octave_base_value::save_hdf5 (hid_t, const char *, bool) -{ - gripe_wrong_type_arg ("octave_base_value::save_binary()", type_name ()); - - return false; -} - -bool -octave_base_value::load_hdf5 (hid_t, const char *) -{ - gripe_wrong_type_arg ("octave_base_value::load_binary()", type_name ()); - - return false; -} - -#endif - -int -octave_base_value::write (octave_stream&, int, oct_data_conv::data_type, - int, oct_mach_info::float_format) const -{ - gripe_wrong_type_arg ("octave_base_value::write()", type_name ()); - - return false; -} - -mxArray * -octave_base_value::as_mxArray (void) const -{ - return 0; -} - -octave_value -octave_base_value::diag (octave_idx_type) const -{ - gripe_wrong_type_arg ("octave_base_value::diag ()", type_name ()); - - return octave_value (); -} - -octave_value -octave_base_value::diag (octave_idx_type, octave_idx_type) const -{ - gripe_wrong_type_arg ("octave_base_value::diag ()", type_name ()); - - return octave_value (); -} - -octave_value -octave_base_value::sort (octave_idx_type, sortmode) const -{ - gripe_wrong_type_arg ("octave_base_value::sort ()", type_name ()); - - return octave_value (); -} - -octave_value -octave_base_value::sort (Array &, - octave_idx_type, sortmode) const -{ - gripe_wrong_type_arg ("octave_base_value::sort ()", type_name ()); - - return octave_value (); -} - -sortmode -octave_base_value::is_sorted (sortmode) const -{ - gripe_wrong_type_arg ("octave_base_value::is_sorted ()", type_name ()); - - return UNSORTED; -} - -Array -octave_base_value::sort_rows_idx (sortmode) const -{ - gripe_wrong_type_arg ("octave_base_value::sort_rows_idx ()", type_name ()); - - return Array (); -} - -sortmode -octave_base_value::is_sorted_rows (sortmode) const -{ - gripe_wrong_type_arg ("octave_base_value::is_sorted_rows ()", type_name ()); - - return UNSORTED; -} - - -const char * -octave_base_value::get_umap_name (unary_mapper_t umap) -{ - static const char *names[num_unary_mappers] = - { - "abs", - "acos", - "acosh", - "angle", - "arg", - "asin", - "asinh", - "atan", - "atanh", - "cbrt", - "ceil", - "conj", - "cos", - "cosh", - "erf", - "erfinv", - "erfcinv", - "erfc", - "exp", - "expm1", - "finite", - "fix", - "floor", - "gamma", - "imag", - "isinf", - "isna", - "isnan", - "lgamma", - "log", - "log2", - "log10", - "log1p", - "real", - "round", - "roundb", - "signum", - "sin", - "sinh", - "sqrt", - "tan", - "tanh", - "isalnum", - "isalpha", - "isascii", - "iscntrl", - "isdigit", - "isgraph", - "islower", - "isprint", - "ispunct", - "isspace", - "isupper", - "isxdigit", - "toascii", - "tolower", - "toupper" - }; - - if (umap < 0 || umap >= num_unary_mappers) - return "unknown"; - else - return names[umap]; -} - -octave_value -octave_base_value::map (unary_mapper_t umap) const -{ - error ("%s: not defined for %s", get_umap_name (umap), type_name ().c_str ()); - return octave_value (); -} - -void -octave_base_value::lock (void) -{ - gripe_wrong_type_arg ("octave_base_value::lock ()", type_name ()); -} - -void -octave_base_value::unlock (void) -{ - gripe_wrong_type_arg ("octave_base_value::unlock ()", type_name ()); -} - -void -octave_base_value::dump (std::ostream& os) const -{ - dim_vector dv = this->dims (); - - os << "class: " << this->class_name () - << " type: " << this->type_name () - << " dims: " << dv.str (); -} - -static void -gripe_indexed_assignment (const std::string& tn1, const std::string& tn2) -{ - error ("assignment of `%s' to indexed `%s' not implemented", - tn2.c_str (), tn1.c_str ()); -} - -static void -gripe_assign_conversion_failed (const std::string& tn1, - const std::string& tn2) -{ - error ("type conversion for assignment of `%s' to indexed `%s' failed", - tn2.c_str (), tn1.c_str ()); -} - -static void -gripe_no_conversion (const std::string& on, const std::string& tn1, - const std::string& tn2) -{ - error ("operator %s: no conversion for assignment of `%s' to indexed `%s'", - on.c_str (), tn2.c_str (), tn1.c_str ()); -} - -octave_value -octave_base_value::numeric_assign (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - octave_value retval; - - if (idx.front ().empty ()) - { - error ("missing index in indexed assignment"); - return retval; - } - - int t_lhs = type_id (); - int t_rhs = rhs.type_id (); - - octave_value_typeinfo::assign_op_fcn f - = octave_value_typeinfo::lookup_assign_op (octave_value::op_asn_eq, - t_lhs, t_rhs); - - bool done = false; - - if (f) - { - f (*this, idx.front (), rhs.get_rep ()); - - done = (! error_state); - } - - if (done) - { - count++; - retval = octave_value (this); - } - else - { - int t_result - = octave_value_typeinfo::lookup_pref_assign_conv (t_lhs, t_rhs); - - if (t_result >= 0) - { - octave_base_value::type_conv_fcn cf - = octave_value_typeinfo::lookup_widening_op (t_lhs, t_result); - - if (cf) - { - octave_base_value *tmp = cf (*this); - - if (tmp) - { - octave_value val (tmp); - - retval = val.subsasgn (type, idx, rhs); - - done = (! error_state); - } - else - gripe_assign_conversion_failed (type_name (), - rhs.type_name ()); - } - else - gripe_indexed_assignment (type_name (), rhs.type_name ()); - } - - if (! (done || error_state)) - { - octave_value tmp_rhs; - - octave_base_value::type_conv_info cf_rhs - = rhs.numeric_conversion_function (); - - octave_base_value::type_conv_info cf_this - = numeric_conversion_function (); - - // Try biased (one-sided) conversions first. - if (cf_rhs.type_id () >= 0 - && (octave_value_typeinfo::lookup_assign_op (octave_value::op_asn_eq, - t_lhs, cf_rhs.type_id ()) - || octave_value_typeinfo::lookup_pref_assign_conv (t_lhs, - cf_rhs.type_id ()) >= 0)) - cf_this = 0; - else if (cf_this.type_id () >= 0 - && (octave_value_typeinfo::lookup_assign_op (octave_value::op_asn_eq, - cf_this.type_id (), t_rhs) - || octave_value_typeinfo::lookup_pref_assign_conv (cf_this.type_id (), - t_rhs) >= 0)) - cf_rhs = 0; - - if (cf_rhs) - { - octave_base_value *tmp = cf_rhs (rhs.get_rep ()); - - if (tmp) - tmp_rhs = octave_value (tmp); - else - { - gripe_assign_conversion_failed (type_name (), - rhs.type_name ()); - return octave_value (); - } - } - else - tmp_rhs = rhs; - - count++; - octave_value tmp_lhs = octave_value (this); - - if (cf_this) - { - octave_base_value *tmp = cf_this (*this); - - if (tmp) - tmp_lhs = octave_value (tmp); - else - { - gripe_assign_conversion_failed (type_name (), - rhs.type_name ()); - return octave_value (); - } - } - - if (cf_this || cf_rhs) - { - retval = tmp_lhs.subsasgn (type, idx, tmp_rhs); - - done = (! error_state); - } - else - gripe_no_conversion (octave_value::assign_op_as_string (octave_value::op_asn_eq), - type_name (), rhs.type_name ()); - } - } - - // The assignment may have converted to a type that is wider than - // necessary. - - retval.maybe_mutate (); - - return retval; -} - -// Current indentation. -int octave_base_value::curr_print_indent_level = 0; - -// TRUE means we are at the beginning of a line. -bool octave_base_value::beginning_of_line = true; - -// Each print() function should call this before printing anything. -// -// This doesn't need to be fast, but isn't there a better way? - -void -octave_base_value::indent (std::ostream& os) const -{ - assert (curr_print_indent_level >= 0); - - if (beginning_of_line) - { - // FIXME -- do we need this? - // os << prefix; - - for (int i = 0; i < curr_print_indent_level; i++) - os << " "; - - beginning_of_line = false; - } -} - -// All print() functions should use this to print new lines. - -void -octave_base_value::newline (std::ostream& os) const -{ - os << "\n"; - - beginning_of_line = true; -} - -// For ressetting print state. - -void -octave_base_value::reset (void) const -{ - beginning_of_line = true; - curr_print_indent_level = 0; -} - - -octave_value -octave_base_value::fast_elem_extract (octave_idx_type) const -{ - return octave_value (); -} - -bool -octave_base_value::fast_elem_insert (octave_idx_type, const octave_value&) -{ - return false; -} - -bool -octave_base_value::fast_elem_insert_self (void *, builtin_type_t) const -{ - return false; -} - -CONVDECLX (matrix_conv) -{ - return new octave_matrix (); -} - -CONVDECLX (complex_matrix_conv) -{ - return new octave_complex_matrix (); -} - -CONVDECLX (string_conv) -{ - return new octave_char_matrix_str (); -} - -CONVDECLX (cell_conv) -{ - return new octave_cell (); -} - -void -install_base_type_conversions (void) -{ - INSTALL_ASSIGNCONV (octave_base_value, octave_scalar, octave_matrix); - INSTALL_ASSIGNCONV (octave_base_value, octave_matrix, octave_matrix); - INSTALL_ASSIGNCONV (octave_base_value, octave_complex, octave_complex_matrix); - INSTALL_ASSIGNCONV (octave_base_value, octave_complex_matrix, octave_complex_matrix); - INSTALL_ASSIGNCONV (octave_base_value, octave_range, octave_matrix); - INSTALL_ASSIGNCONV (octave_base_value, octave_char_matrix_str, octave_char_matrix_str); - INSTALL_ASSIGNCONV (octave_base_value, octave_cell, octave_cell); - - INSTALL_WIDENOP (octave_base_value, octave_matrix, matrix_conv); - INSTALL_WIDENOP (octave_base_value, octave_complex_matrix, complex_matrix_conv); - INSTALL_WIDENOP (octave_base_value, octave_char_matrix_str, string_conv); - INSTALL_WIDENOP (octave_base_value, octave_cell, cell_conv); -} - -DEFUN (sparse_auto_mutate, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} sparse_auto_mutate ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} sparse_auto_mutate (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} sparse_auto_mutate (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will\n\ -automatically mutate sparse matrices to full matrices to save memory.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -s = speye (3);\n\ -sparse_auto_mutate (false);\n\ -s(:, 1) = 1;\n\ -typeinfo (s)\n\ -@result{} sparse matrix\n\ -sparse_auto_mutate (true);\n\ -s(1, :) = 1;\n\ -typeinfo (s)\n\ -@result{} matrix\n\ -@end group\n\ -@end example\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (sparse_auto_mutate); -} - -/* -%!test -%! s = speye (3); -%! sparse_auto_mutate (false); -%! s(:, 1) = 1; -%! assert (typeinfo (s), "sparse matrix"); -%! sparse_auto_mutate (true); -%! s(1, :) = 1; -%! assert (typeinfo (s), "matrix"); -%! sparse_auto_mutate (false); -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-base.h --- a/src/ov-base.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,820 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_base_value_h) -#define octave_base_value_h 1 - -#include - -#include -#include -#include - -#include "Range.h" -#include "data-conv.h" -#include "mxarray.h" -#include "mx-base.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-hdf5.h" - -class Cell; -class octave_map; -class octave_scalar_map; -class octave_value; -class octave_value_list; -class octave_stream; -class octave_function; -class octave_user_function; -class octave_user_script; -class octave_user_code; -class octave_fcn_handle; -class octave_fcn_inline; -class octave_value_list; -class octave_lvalue; - -class tree_walker; - -enum builtin_type_t -{ - btyp_double, - btyp_float, - btyp_complex, - btyp_float_complex, - btyp_int8, - btyp_int16, - btyp_int32, - btyp_int64, - btyp_uint8, - btyp_uint16, - btyp_uint32, - btyp_uint64, - btyp_bool, - btyp_char, - btyp_struct, - btyp_cell, - btyp_func_handle, - btyp_unknown, - btyp_num_types = btyp_unknown -}; - -extern OCTINTERP_API std::string -btyp_class_name [btyp_num_types]; - -extern OCTINTERP_API string_vector -get_builtin_classes (void); - -inline bool btyp_isnumeric (builtin_type_t btyp) -{ return btyp <= btyp_uint64; } - -inline bool btyp_isinteger (builtin_type_t btyp) -{ return btyp >= btyp_int8 && btyp <= btyp_uint64; } - -inline bool btyp_isfloat (builtin_type_t btyp) -{ return btyp <= btyp_float_complex; } - -inline bool btyp_isarray (builtin_type_t btyp) -{ return btyp <= btyp_char; } - -// Compute a numeric type for a possibly mixed-type operation, using these rules: -// bool -> double -// single + double -> single -// real + complex -> complex -// integer + real -> integer -// uint + uint -> uint (the bigger one) -// sint + sint -> sint (the bigger one) -// -// failing otherwise. - -extern OCTINTERP_API -builtin_type_t btyp_mixed_numeric (builtin_type_t x, builtin_type_t y); - -template -struct class_to_btyp -{ - static const builtin_type_t btyp = btyp_unknown; -}; - -#define DEF_CLASS_TO_BTYP(CLASS,BTYP) \ -template <> \ -struct class_to_btyp \ -{ static const builtin_type_t btyp = BTYP; } - -DEF_CLASS_TO_BTYP (double, btyp_double); -DEF_CLASS_TO_BTYP (float, btyp_float); -DEF_CLASS_TO_BTYP (Complex, btyp_complex); -DEF_CLASS_TO_BTYP (FloatComplex, btyp_float_complex); -DEF_CLASS_TO_BTYP (octave_int8, btyp_int8); -DEF_CLASS_TO_BTYP (octave_int16, btyp_int16); -DEF_CLASS_TO_BTYP (octave_int32, btyp_int32); -DEF_CLASS_TO_BTYP (octave_int64, btyp_int64); -DEF_CLASS_TO_BTYP (octave_uint8, btyp_uint8); -DEF_CLASS_TO_BTYP (octave_uint16, btyp_uint16); -DEF_CLASS_TO_BTYP (octave_uint32, btyp_uint32); -DEF_CLASS_TO_BTYP (octave_uint64, btyp_uint64); -DEF_CLASS_TO_BTYP (bool, btyp_bool); -DEF_CLASS_TO_BTYP (char, btyp_char); - -// T_ID is the type id of struct objects, set by register_type(). -// T_NAME is the type name of struct objects. - -#define DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA \ - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA2 (OCTAVE_EMPTY_CPP_ARG) - -#define DECLARE_OV_BASE_TYPEID_FUNCTIONS_AND_DATA \ - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA2(virtual) - -#define DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA2(VIRTUAL) \ - public: \ - VIRTUAL int type_id (void) const { return t_id; } \ - VIRTUAL std::string type_name (void) const { return t_name; } \ - VIRTUAL std::string class_name (void) const { return c_name; } \ - static int static_type_id (void) { return t_id; } \ - static std::string static_type_name (void) { return t_name; } \ - static std::string static_class_name (void) { return c_name; } \ - static void register_type (void); \ - \ - private: \ - static int t_id; \ - static const std::string t_name; \ - static const std::string c_name; - - -#define DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA(t, n, c) \ - int t::t_id (-1); \ - const std::string t::t_name (n); \ - const std::string t::c_name (c); \ - void t::register_type (void) \ - { \ - static t exemplar; \ - octave_value v (&exemplar, true); \ - t_id = octave_value_typeinfo::register_type (t::t_name, t::c_name, v); \ - } - -// A base value type, so that derived types only have to redefine what -// they need (if they are derived from octave_base_value instead of -// octave_value). - -class -OCTINTERP_API -octave_base_value -{ -public: - - typedef octave_base_value * (*type_conv_fcn) (const octave_base_value&); - - // type conversion, including result type information - class type_conv_info - { - public: - type_conv_info (type_conv_fcn f = 0, int t = -1) : _fcn (f), _type_id (t) { } - - operator type_conv_fcn (void) const { return _fcn; } - - octave_base_value * operator () (const octave_base_value &v) const - { return (*_fcn) (v); } - - int type_id (void) const { return _type_id; } - - private: - type_conv_fcn _fcn; - int _type_id; - }; - - friend class octave_value; - - octave_base_value (void) : count (1) { } - - octave_base_value (const octave_base_value&) : count (1) { } - - virtual ~octave_base_value (void) { } - - // Unconditional clone. Always clones. - virtual octave_base_value * - clone (void) const { return new octave_base_value (*this); } - - // Empty clone. - virtual octave_base_value * - empty_clone (void) const; - - // Unique clone. Usually clones, but may be overriden to fake the - // cloning when sharing copies is to be controlled from within an - // instance (see octave_class). - virtual octave_base_value * - unique_clone (void) { return clone (); } - - virtual type_conv_info - numeric_conversion_function (void) const - { return type_conv_info (); } - - virtual type_conv_info - numeric_demotion_function (void) const - { return type_conv_info (); } - - virtual octave_value squeeze (void) const; - - virtual octave_value full_value (void) const; - - virtual octave_base_value *try_narrowing_conversion (void) { return 0; } - - virtual void maybe_economize (void) { } - - virtual Matrix size (void); - - virtual octave_idx_type numel (const octave_value_list&); - - virtual octave_value - subsref (const std::string& type, - const std::list& idx); - - virtual octave_value_list - subsref (const std::string& type, - const std::list& idx, - int nargout); - - virtual octave_value - subsref (const std::string& type, - const std::list& idx, - bool auto_add); - - virtual octave_value_list - subsref (const std::string& type, - const std::list& idx, - int nargout, - const std::list *lvalue_list); - - virtual octave_value - do_index_op (const octave_value_list& idx, bool resize_ok = false); - - virtual octave_value_list - do_multi_index_op (int nargout, const octave_value_list& idx); - - virtual octave_value_list - do_multi_index_op (int nargout, const octave_value_list& idx, - const std::list *lvalue_list); - - virtual void assign (const std::string&, const octave_value&) { } - - virtual octave_value - subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - virtual octave_value - undef_subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - virtual idx_vector index_vector (void) const; - - virtual dim_vector dims (void) const { return dim_vector (); } - - octave_idx_type rows (void) const - { - const dim_vector dv = dims (); - - return dv(0); - } - - octave_idx_type columns (void) const - { - const dim_vector dv = dims (); - - return dv(1); - } - - virtual int ndims (void) const - { return dims ().length (); } - - virtual octave_idx_type numel (void) const { return dims ().numel (); } - - virtual octave_idx_type capacity (void) const { return numel (); } - - virtual size_t byte_size (void) const { return 0; } - - virtual octave_idx_type nnz (void) const; - - virtual octave_idx_type nzmax (void) const; - - virtual octave_idx_type nfields (void) const; - - virtual octave_value reshape (const dim_vector&) const; - - virtual octave_value permute (const Array& vec, bool = false) const; - - virtual octave_value resize (const dim_vector&, bool fill = false) const; - - virtual MatrixType matrix_type (void) const; - - virtual MatrixType matrix_type (const MatrixType& typ) const; - - virtual bool is_defined (void) const { return false; } - - bool is_empty (void) const { return numel () == 0; } - - virtual bool is_cell (void) const { return false; } - - virtual bool is_cellstr (void) const { return false; } - - virtual bool is_real_scalar (void) const { return false; } - - virtual bool is_real_matrix (void) const { return false; } - - virtual bool is_real_nd_array (void) const { return false; } - - virtual bool is_complex_scalar (void) const { return false; } - - virtual bool is_complex_matrix (void) const { return false; } - - virtual bool is_bool_scalar (void) const { return false; } - - virtual bool is_bool_matrix (void) const { return false; } - - virtual bool is_char_matrix (void) const { return false; } - - virtual bool is_diag_matrix (void) const { return false; } - - virtual bool is_perm_matrix (void) const { return false; } - - virtual bool is_string (void) const { return false; } - - virtual bool is_sq_string (void) const { return false; } - - virtual bool is_range (void) const { return false; } - - virtual bool is_map (void) const { return false; } - - virtual bool is_object (void) const { return false; } - - virtual bool is_cs_list (void) const { return false; } - - virtual bool is_magic_colon (void) const { return false; } - - virtual bool is_all_va_args (void) const { return false; } - - virtual octave_value all (int = 0) const; - - virtual octave_value any (int = 0) const; - - virtual builtin_type_t builtin_type (void) const { return btyp_unknown; } - - virtual bool is_double_type (void) const { return false; } - - virtual bool is_single_type (void) const { return false; } - - virtual bool is_float_type (void) const { return false; } - - virtual bool is_int8_type (void) const { return false; } - - virtual bool is_int16_type (void) const { return false; } - - virtual bool is_int32_type (void) const { return false; } - - virtual bool is_int64_type (void) const { return false; } - - virtual bool is_uint8_type (void) const { return false; } - - virtual bool is_uint16_type (void) const { return false; } - - virtual bool is_uint32_type (void) const { return false; } - - virtual bool is_uint64_type (void) const { return false; } - - virtual bool is_bool_type (void) const { return false; } - - virtual bool is_integer_type (void) const { return false; } - - virtual bool is_real_type (void) const { return false; } - - virtual bool is_complex_type (void) const { return false; } - - // Would be nice to get rid of the next four functions: - - virtual bool is_scalar_type (void) const { return false; } - - virtual bool is_matrix_type (void) const { return false; } - - virtual bool is_numeric_type (void) const { return false; } - - virtual bool is_sparse_type (void) const { return false; } - - virtual bool is_true (void) const { return false; } - - virtual bool is_null_value (void) const { return false; } - - virtual bool is_constant (void) const { return false; } - - virtual bool is_function_handle (void) const { return false; } - - virtual bool is_anonymous_function (void) const { return false; } - - virtual bool is_inline_function (void) const { return false; } - - virtual bool is_function (void) const { return false; } - - virtual bool is_user_script (void) const { return false; } - - virtual bool is_user_function (void) const { return false; } - - virtual bool is_user_code (void) const { return false; } - - virtual bool is_builtin_function (void) const { return false; } - - virtual bool is_dld_function (void) const { return false; } - - virtual bool is_mex_function (void) const { return false; } - - virtual void erase_subfunctions (void) { } - - virtual short int short_value (bool = false, bool = false) const; - - virtual unsigned short int ushort_value (bool = false, bool = false) const; - - virtual int int_value (bool = false, bool = false) const; - - virtual unsigned int uint_value (bool = false, bool = false) const; - - virtual int nint_value (bool = false) const; - - virtual long int long_value (bool = false, bool = false) const; - - virtual unsigned long int ulong_value (bool = false, bool = false) const; - - virtual double double_value (bool = false) const; - - virtual float float_value (bool = false) const; - - virtual double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - virtual float float_scalar_value (bool frc_str_conv = false) const - { return float_value (frc_str_conv); } - - virtual Cell cell_value (void) const; - - virtual Matrix matrix_value (bool = false) const; - - virtual FloatMatrix float_matrix_value (bool = false) const; - - virtual NDArray array_value (bool = false) const; - - virtual FloatNDArray float_array_value (bool = false) const; - - virtual Complex complex_value (bool = false) const; - - virtual FloatComplex float_complex_value (bool = false) const; - - virtual ComplexMatrix complex_matrix_value (bool = false) const; - - virtual FloatComplexMatrix float_complex_matrix_value (bool = false) const; - - virtual ComplexNDArray complex_array_value (bool = false) const; - - virtual FloatComplexNDArray float_complex_array_value (bool = false) const; - - virtual bool bool_value (bool = false) const; - - virtual boolMatrix bool_matrix_value (bool = false) const; - - virtual boolNDArray bool_array_value (bool = false) const; - - virtual charMatrix char_matrix_value (bool force = false) const; - - virtual charNDArray char_array_value (bool = false) const; - - virtual SparseMatrix sparse_matrix_value (bool = false) const; - - virtual SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; - - virtual SparseBoolMatrix sparse_bool_matrix_value (bool = false) const; - - virtual DiagMatrix diag_matrix_value (bool = false) const; - - virtual FloatDiagMatrix float_diag_matrix_value (bool = false) const; - - virtual ComplexDiagMatrix complex_diag_matrix_value (bool = false) const; - - virtual FloatComplexDiagMatrix float_complex_diag_matrix_value (bool = false) const; - - virtual PermMatrix perm_matrix_value (void) const; - - virtual octave_int8 int8_scalar_value (void) const; - - virtual octave_int16 int16_scalar_value (void) const; - - virtual octave_int32 int32_scalar_value (void) const; - - virtual octave_int64 int64_scalar_value (void) const; - - virtual octave_uint8 uint8_scalar_value (void) const; - - virtual octave_uint16 uint16_scalar_value (void) const; - - virtual octave_uint32 uint32_scalar_value (void) const; - - virtual octave_uint64 uint64_scalar_value (void) const; - - virtual int8NDArray int8_array_value (void) const; - - virtual int16NDArray int16_array_value (void) const; - - virtual int32NDArray int32_array_value (void) const; - - virtual int64NDArray int64_array_value (void) const; - - virtual uint8NDArray uint8_array_value (void) const; - - virtual uint16NDArray uint16_array_value (void) const; - - virtual uint32NDArray uint32_array_value (void) const; - - virtual uint64NDArray uint64_array_value (void) const; - - virtual string_vector all_strings (bool pad = false) const; - - virtual std::string string_value (bool force = false) const; - - virtual Array cellstr_value (void) const; - - virtual Range range_value (void) const; - - virtual octave_map map_value (void) const; - - virtual octave_scalar_map scalar_map_value (void) const; - - virtual string_vector map_keys (void) const; - - virtual size_t nparents (void) const; - - virtual std::list parent_class_name_list (void) const; - - virtual string_vector parent_class_names (void) const; - - virtual octave_base_value *find_parent_class (const std::string&) - { return 0; } - - virtual octave_base_value *unique_parent_class (const std::string&) - { return 0; } - - virtual octave_function *function_value (bool silent = false); - - virtual octave_user_function *user_function_value (bool silent = false); - - virtual octave_user_script *user_script_value (bool silent = false); - - virtual octave_user_code *user_code_value (bool silent = false); - - virtual octave_fcn_handle *fcn_handle_value (bool silent = false); - - virtual octave_fcn_inline *fcn_inline_value (bool silent = false); - - virtual octave_value_list list_value (void) const; - - virtual octave_value convert_to_str (bool pad = false, bool force = false, - char type = '\'') const; - virtual octave_value - convert_to_str_internal (bool pad, bool force, char type) const; - - virtual void convert_to_row_or_column_vector (void); - - virtual bool print_as_scalar (void) const { return false; } - - virtual void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - virtual void - print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - virtual bool - print_name_tag (std::ostream& os, const std::string& name) const; - - virtual void - print_with_name (std::ostream& output_buf, const std::string& name, - bool print_padding = true); - - virtual void print_info (std::ostream& os, const std::string& prefix) const; - - virtual bool save_ascii (std::ostream& os); - - virtual bool load_ascii (std::istream& is); - - virtual bool save_binary (std::ostream& os, bool& save_as_floats); - - virtual bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - virtual bool - save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - virtual bool - load_hdf5 (hid_t loc_id, const char *name); -#endif - - virtual int - write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const; - - virtual void *mex_get_data (void) const { return 0; } - - virtual octave_idx_type *mex_get_ir (void) const { return 0; } - - virtual octave_idx_type *mex_get_jc (void) const { return 0; } - - virtual mxArray *as_mxArray (void) const; - - virtual octave_value diag (octave_idx_type k = 0) const; - - virtual octave_value diag (octave_idx_type m, octave_idx_type n) const; - - virtual octave_value sort (octave_idx_type dim = 0, - sortmode mode = ASCENDING) const; - virtual octave_value sort (Array &sidx, - octave_idx_type dim = 0, - sortmode mode = ASCENDING) const; - - virtual sortmode is_sorted (sortmode mode = UNSORTED) const; - - virtual Array - sort_rows_idx (sortmode mode = ASCENDING) const; - - virtual sortmode is_sorted_rows (sortmode mode = UNSORTED) const; - - virtual void lock (void); - - virtual void unlock (void); - - virtual bool islocked (void) const { return false; } - - virtual void dump (std::ostream& os) const; - - // Standard mappers. Register new ones here. - enum unary_mapper_t - { - umap_abs, - umap_acos, - umap_acosh, - umap_angle, - umap_arg, - umap_asin, - umap_asinh, - umap_atan, - umap_atanh, - umap_cbrt, - umap_ceil, - umap_conj, - umap_cos, - umap_cosh, - umap_erf, - umap_erfinv, - umap_erfcinv, - umap_erfc, - umap_erfcx, - umap_exp, - umap_expm1, - umap_finite, - umap_fix, - umap_floor, - umap_gamma, - umap_imag, - umap_isinf, - umap_isna, - umap_isnan, - umap_lgamma, - umap_log, - umap_log2, - umap_log10, - umap_log1p, - umap_real, - umap_round, - umap_roundb, - umap_signum, - umap_sin, - umap_sinh, - umap_sqrt, - umap_tan, - umap_tanh, - umap_xisalnum, - umap_xisalpha, - umap_xisascii, - umap_xiscntrl, - umap_xisdigit, - umap_xisgraph, - umap_xislower, - umap_xisprint, - umap_xispunct, - umap_xisspace, - umap_xisupper, - umap_xisxdigit, - umap_xtoascii, - umap_xtolower, - umap_xtoupper, - umap_unknown, - num_unary_mappers = umap_unknown - }; - - virtual octave_value map (unary_mapper_t) const; - - // These are fast indexing & assignment shortcuts for extracting - // or inserting a single scalar from/to an array. - - // Extract the n-th element, aka val(n). Result is undefined if val is not an - // array type or n is out of range. Never error. - virtual octave_value - fast_elem_extract (octave_idx_type n) const; - - // Assign the n-th element, aka val(n) = x. Returns false if val is not an - // array type, x is not a matching scalar type, or n is out of range. - // Never error. - virtual bool - fast_elem_insert (octave_idx_type n, const octave_value& x); - - // This is a helper for the above, to be overriden in scalar types. The - // whole point is to handle the insertion efficiently with just *two* VM - // calls, which is basically the theoretical minimum. - virtual bool - fast_elem_insert_self (void *where, builtin_type_t btyp) const; - - // Grab the reference count. For use by jit. - void - grab (void) - { - ++count; - } - - // Release the reference count. For use by jit. - void - release (void) - { - if (--count == 0) - delete this; - } - -protected: - - // This should only be called for derived types. - - octave_value numeric_assign (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - void reset_indent_level (void) const - { curr_print_indent_level = 0; } - - void increment_indent_level (void) const - { curr_print_indent_level += 2; } - - void decrement_indent_level (void) const - { curr_print_indent_level -= 2; } - - int current_print_indent_level (void) const - { return curr_print_indent_level; } - - void indent (std::ostream& os) const; - - void newline (std::ostream& os) const; - - void reset (void) const; - - // A reference count. - // NOTE: the declaration is octave_idx_type because with 64-bit indexing, - // it is well possible to have more than MAX_INT copies of a single value - // (think of an empty cell array with >2G elements). - octave_refcount count; - -private: - - static const char *get_umap_name (unary_mapper_t); - - static int curr_print_indent_level; - static bool beginning_of_line; - - DECLARE_OV_BASE_TYPEID_FUNCTIONS_AND_DATA -}; - -// TRUE means to perform automatic sparse to real mutation if there -// is memory to be saved -extern OCTINTERP_API bool Vsparse_auto_mutate; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-bool-mat.cc --- a/src/ov-bool-mat.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,588 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "lo-ieee.h" -#include "mx-base.h" -#include "oct-locbuf.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "ops.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-base-mat.cc" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-re-mat.h" -#include "pr-output.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-hdf5.h" -#include "ls-utils.h" - -template class octave_base_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_bool_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_bool_matrix, - "bool matrix", "logical"); - -static octave_base_value * -default_numeric_conversion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_bool_matrix&); - - return new octave_matrix (NDArray (v.bool_array_value ())); -} - -octave_base_value::type_conv_info -octave_bool_matrix::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_conversion_function, - octave_matrix::static_type_id ()); -} - -octave_base_value * -octave_bool_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (matrix.ndims () == 2) - { - boolMatrix bm = matrix.matrix_value (); - - octave_idx_type nr = bm.rows (); - octave_idx_type nc = bm.cols (); - - if (nr == 1 && nc == 1) - retval = new octave_bool (bm (0, 0)); - } - - return retval; -} - -double -octave_bool_matrix::double_value (bool) const -{ - double retval = lo_ieee_nan_value (); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "bool matrix", "real scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("bool matrix", "real scalar"); - - return retval; -} - -float -octave_bool_matrix::float_value (bool) const -{ - float retval = lo_ieee_float_nan_value (); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "bool matrix", "real scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("bool matrix", "real scalar"); - - return retval; -} - -Complex -octave_bool_matrix::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "bool matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("bool matrix", "complex scalar"); - - return retval; -} - -FloatComplex -octave_bool_matrix::float_complex_value (bool) const -{ - float tmp = lo_ieee_float_nan_value (); - - FloatComplex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "bool matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("bool matrix", "complex scalar"); - - return retval; -} - -octave_value -octave_bool_matrix::convert_to_str_internal (bool pad, bool force, - char type) const -{ - octave_value tmp = octave_value (array_value ()); - return tmp.convert_to_str (pad, force, type); -} - -void -octave_bool_matrix::print_raw (std::ostream& os, - bool pr_as_read_syntax) const -{ - octave_print_internal (os, matrix, pr_as_read_syntax, - current_print_indent_level ()); -} - -bool -octave_bool_matrix::save_ascii (std::ostream& os) -{ - dim_vector d = dims (); - if (d.length () > 2) - { - NDArray tmp = array_value (); - os << "# ndims: " << d.length () << "\n"; - - for (int i = 0; i < d.length (); i++) - os << " " << d (i); - - os << "\n" << tmp; - } - else - { - // Keep this case, rather than use generic code above for backward - // compatiability. Makes load_ascii much more complex!! - os << "# rows: " << rows () << "\n" - << "# columns: " << columns () << "\n"; - - Matrix tmp = matrix_value (); - - os << tmp; - } - - return true; -} - -bool -octave_bool_matrix::load_ascii (std::istream& is) -{ - bool success = true; - - string_vector keywords (2); - - keywords[0] = "ndims"; - keywords[1] = "rows"; - - std::string kw; - octave_idx_type val = 0; - - if (extract_keyword (is, keywords, kw, val, true)) - { - if (kw == "ndims") - { - int mdims = static_cast (val); - - if (mdims >= 0) - { - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - is >> dv(i); - - if (is) - { - boolNDArray btmp (dv); - - if (btmp.is_empty ()) - matrix = btmp; - else - { - NDArray tmp(dv); - is >> tmp; - - if (is) - { - for (octave_idx_type i = 0; i < btmp.nelem (); i++) - btmp.elem (i) = (tmp.elem (i) != 0.); - - matrix = btmp; - } - else - { - error ("load: failed to load matrix constant"); - success = false; - } - } - } - else - { - error ("load: failed to extract dimensions"); - success = false; - } - } - else - { - error ("load: failed to extract number of dimensions"); - success = false; - } - } - else if (kw == "rows") - { - octave_idx_type nr = val; - octave_idx_type nc = 0; - - if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) - { - if (nr > 0 && nc > 0) - { - Matrix tmp (nr, nc); - is >> tmp; - if (is) - { - boolMatrix btmp (nr, nc); - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - btmp.elem (i,j) = (tmp.elem (i, j) != 0.); - - matrix = btmp; - } - else - { - error ("load: failed to load matrix constant"); - success = false; - } - } - else if (nr == 0 || nc == 0) - matrix = boolMatrix (nr, nc); - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - } - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - - return success; -} - -bool -octave_bool_matrix::save_binary (std::ostream& os, bool& /* save_as_floats */) -{ - - dim_vector d = dims (); - if (d.length () < 1) - return false; - - // Use negative value for ndims to differentiate with old format!! - int32_t tmp = - d.length (); - os.write (reinterpret_cast (&tmp), 4); - for (int i = 0; i < d.length (); i++) - { - tmp = d(i); - os.write (reinterpret_cast (&tmp), 4); - } - - boolNDArray m = bool_array_value (); - bool *mtmp = m.fortran_vec (); - octave_idx_type nel = m.nelem (); - OCTAVE_LOCAL_BUFFER (char, htmp, nel); - - for (octave_idx_type i = 0; i < nel; i++) - htmp[i] = (mtmp[i] ? 1 : 0); - - os.write (htmp, nel); - - return true; -} - -bool -octave_bool_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format /* fmt */) -{ - int32_t mdims; - if (! is.read (reinterpret_cast (&mdims), 4)) - return false; - if (swap) - swap_bytes<4> (&mdims); - if (mdims >= 0) - return false; - - // mdims is negative for consistency with other matrices, where it is - // negative to allow the positive value to be used for rows/cols for - // backward compatibility - mdims = - mdims; - int32_t di; - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - { - if (! is.read (reinterpret_cast (&di), 4)) - return false; - if (swap) - swap_bytes<4> (&di); - dv(i) = di; - } - - // Convert an array with a single dimension to be a row vector. - // Octave should never write files like this, other software - // might. - - if (mdims == 1) - { - mdims = 2; - dv.resize (mdims); - dv(1) = dv(0); - dv(0) = 1; - } - - octave_idx_type nel = dv.numel (); - OCTAVE_LOCAL_BUFFER (char, htmp, nel); - if (! is.read (htmp, nel)) - return false; - boolNDArray m(dv); - bool *mtmp = m.fortran_vec (); - for (octave_idx_type i = 0; i < nel; i++) - mtmp[i] = (htmp[i] ? 1 : 0); - matrix = m; - - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_bool_matrix::save_hdf5 (hid_t loc_id, const char *name, - bool /* save_as_floats */) -{ - dim_vector dv = dims (); - int empty = save_hdf5_empty (loc_id, name, dv); - if (empty) - return (empty > 0); - - int rank = dv.length (); - hid_t space_hid = -1, data_hid = -1; - bool retval = true; - boolNDArray m = bool_array_value (); - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - - // Octave uses column-major, while HDF5 uses row-major ordering - for (int i = 0; i < rank; i++) - hdims[i] = dv (rank-i-1); - - space_hid = H5Screate_simple (rank, hdims, 0); - if (space_hid < 0) return false; -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_HBOOL, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_HBOOL, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - return false; - } - - octave_idx_type nel = m.nelem (); - bool *mtmp = m.fortran_vec (); - OCTAVE_LOCAL_BUFFER (hbool_t, htmp, nel); - - for (octave_idx_type i = 0; i < nel; i++) - htmp[i] = mtmp[i]; - - retval = H5Dwrite (data_hid, H5T_NATIVE_HBOOL, H5S_ALL, H5S_ALL, - H5P_DEFAULT, htmp) >= 0; - - H5Dclose (data_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_bool_matrix::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; - - dim_vector dv; - int empty = load_hdf5_empty (loc_id, name, dv); - if (empty > 0) - matrix.resize (dv); - if (empty) - return (empty > 0); - -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t space_id = H5Dget_space (data_hid); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank < 1) - { - H5Dclose (data_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_id, hdims, maxdims); - - // Octave uses column-major, while HDF5 uses row-major ordering - if (rank == 1) - { - dv.resize (2); - dv(0) = 1; - dv(1) = hdims[0]; - } - else - { - dv.resize (rank); - for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) - dv(j) = hdims[i]; - } - - octave_idx_type nel = dv.numel (); - OCTAVE_LOCAL_BUFFER (hbool_t, htmp, nel); - if (H5Dread (data_hid, H5T_NATIVE_HBOOL, H5S_ALL, H5S_ALL, H5P_DEFAULT, htmp) >= 0) - { - retval = true; - - boolNDArray btmp (dv); - for (octave_idx_type i = 0; i < nel; i++) - btmp.elem (i) = htmp[i]; - - matrix = btmp; - } - - H5Dclose (data_hid); - - return retval; -} - -#endif - -mxArray * -octave_bool_matrix::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxLOGICAL_CLASS, dims (), mxREAL); - - bool *pr = static_cast (retval->get_data ()); - - mwSize nel = numel (); - - const bool *p = matrix.data (); - - for (mwIndex i = 0; i < nel; i++) - pr[i] = p[i]; - - return retval; -} - -DEFUN (logical, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} logical (@var{x})\n\ -Convert @var{x} to logical type.\n\ -@seealso{double, single, char}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - octave_value arg = args(0); - if (arg.is_bool_type ()) - retval = arg; - else if (arg.is_numeric_type ()) - { - if (arg.is_sparse_type ()) - retval = arg.sparse_bool_matrix_value (); - else if (arg.is_scalar_type ()) - retval = arg.bool_value (); - else - retval = arg.bool_array_value (); - } - else - gripe_wrong_type_arg ("logical", arg); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! m = eye (2) != 0; -%! s = !0; -%! c = {"double", "single", "int8", "int16", "int32", "int64", "uint8", "uint16", "uint32", "uint64", "logical"}; -%! for i = 1:numel (c) -%! assert (logical (eye (2, c{i})), m) -%! assert (logical (eye (1, c{i})), s) -%! endfor -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-bool-mat.h --- a/src/ov-bool-mat.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,235 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_bool_matrix_h) -#define octave_bool_matrix_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" - -#include "error.h" -#include "oct-stream.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" - -#include "MatrixType.h" - -class octave_value_list; - -class tree_walker; - -// Character matrix values. - -class -octave_bool_matrix : public octave_base_matrix -{ -public: - - octave_bool_matrix (void) - : octave_base_matrix () { } - - octave_bool_matrix (const boolNDArray& bnda) - : octave_base_matrix (bnda) { } - - octave_bool_matrix (const Array& bnda) - : octave_base_matrix (bnda) { } - - octave_bool_matrix (const boolMatrix& bm) - : octave_base_matrix (bm) { } - - octave_bool_matrix (const boolMatrix& bm, const MatrixType& t) - : octave_base_matrix (bm, t) { } - - octave_bool_matrix (const boolNDArray& bm, const idx_vector& cache) - : octave_base_matrix (bm) - { - set_idx_cache (cache); - } - - octave_bool_matrix (const octave_bool_matrix& bm) - : octave_base_matrix (bm) { } - - ~octave_bool_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_bool_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_bool_matrix (); } - - type_conv_info numeric_conversion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - idx_vector index_vector (void) const - { return idx_cache ? *idx_cache : set_idx_cache (idx_vector (matrix)); } - - builtin_type_t builtin_type (void) const { return btyp_bool; } - - bool is_bool_matrix (void) const { return true; } - - bool is_bool_type (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_numeric_type (void) const { return false; } - - int8NDArray - int8_array_value (void) const { return int8NDArray (matrix); } - - int16NDArray - int16_array_value (void) const { return int16NDArray (matrix); } - - int32NDArray - int32_array_value (void) const { return int32NDArray (matrix); } - - int64NDArray - int64_array_value (void) const { return int64NDArray (matrix); } - - uint8NDArray - uint8_array_value (void) const { return uint8NDArray (matrix); } - - uint16NDArray - uint16_array_value (void) const { return uint16NDArray (matrix); } - - uint32NDArray - uint32_array_value (void) const { return uint32NDArray (matrix); } - - uint64NDArray - uint64_array_value (void) const { return uint64NDArray (matrix); } - - double double_value (bool = false) const; - - float float_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const - { return Matrix (matrix.matrix_value ()); } - - FloatMatrix float_matrix_value (bool = false) const - { return FloatMatrix (matrix.matrix_value ()); } - - NDArray array_value (bool = false) const - { return NDArray (matrix); } - - FloatNDArray float_array_value (bool = false) const - { return FloatNDArray (matrix); } - - Complex complex_value (bool = false) const; - - FloatComplex float_complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const - { return ComplexMatrix (matrix.matrix_value ( )); } - - FloatComplexMatrix float_complex_matrix_value (bool = false) const - { return FloatComplexMatrix (matrix.matrix_value ( )); } - - ComplexNDArray complex_array_value (bool = false) const - { return ComplexNDArray (matrix); } - - FloatComplexNDArray float_complex_array_value (bool = false) const - { return FloatComplexNDArray (matrix); } - - charNDArray - char_array_value (bool = false) const - { - charNDArray retval (dims ()); - - octave_idx_type nel = numel (); - - for (octave_idx_type i = 0; i < nel; i++) - retval(i) = static_cast(matrix(i)); - - return retval; - } - - boolMatrix bool_matrix_value (bool = false) const - { return matrix.matrix_value (); } - - boolNDArray bool_array_value (bool = false) const - { return matrix; } - - SparseMatrix sparse_matrix_value (bool = false) const - { return SparseMatrix (Matrix (matrix.matrix_value ())); } - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const - { return SparseComplexMatrix (ComplexMatrix (matrix.matrix_value ())); } - - SparseBoolMatrix sparse_bool_matrix_value (bool = false) const - { return SparseBoolMatrix (matrix.matrix_value ()); } - - octave_value convert_to_str_internal (bool pad, bool force, char type) const; - - // Use matrix_ref here to clear index cache. - void invert (void) { matrix_ref ().invert (); } - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { return os.write (matrix, block_size, output_type, skip, flt_fmt); } - - // Unsafe. This function exists to support the MEX interface. - // You should not use it anywhere else. - void *mex_get_data (void) const { return matrix.mex_get_data (); } - - mxArray *as_mxArray (void) const; - - // Mapper functions are converted to double for treatment - octave_value map (unary_mapper_t umap) const - { - octave_matrix m (array_value ()); - return m.map (umap); - } - -protected: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-bool-sparse.cc --- a/src/ov-bool-sparse.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,793 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "ov-base.h" -#include "ov-scalar.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "gripes.h" -#include "ops.h" -#include "oct-locbuf.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "ov-bool-sparse.h" - -#include "ov-base-sparse.h" -#include "ov-base-sparse.cc" - -template class OCTINTERP_API octave_base_sparse; - -DEFINE_OCTAVE_ALLOCATOR (octave_sparse_bool_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_sparse_bool_matrix, "sparse bool matrix", "logical"); - -static octave_base_value * -default_numeric_conversion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_sparse_bool_matrix&); - - return new octave_sparse_matrix (SparseMatrix (v.sparse_bool_matrix_value ())); -} - -octave_base_value::type_conv_info -octave_sparse_bool_matrix::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_conversion_function, - octave_sparse_matrix::static_type_id ()); -} - -octave_base_value * -octave_sparse_bool_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (Vsparse_auto_mutate) - { - // Don't use numel, since it can overflow for very large matrices - // Note that for the second test, this means it becomes approximative - // since it involves a cast to double to avoid issues of overflow - if (matrix.rows () == 1 && matrix.cols () == 1) - { - // Const copy of the matrix, so the right version of () operator used - const SparseBoolMatrix tmp (matrix); - - retval = new octave_bool (tmp (0)); - } - else if (matrix.cols () > 0 && matrix.rows () > 0 - && (double (matrix.byte_size ()) > double (matrix.rows ()) - * double (matrix.cols ()) * sizeof (bool))) - retval = new octave_bool_matrix (matrix.matrix_value ()); - } - - return retval; -} - -double -octave_sparse_bool_matrix::double_value (bool) const -{ - double retval = lo_ieee_nan_value (); - - if (numel () > 0) - { - if (numel () > 1) - gripe_implicit_conversion ("Octave:array-to-scalar", - "bool sparse matrix", "real scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("bool sparse matrix", "real scalar"); - - return retval; -} - -Complex -octave_sparse_bool_matrix::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - if (numel () > 1) - gripe_implicit_conversion ("Octave:array-to-scalar", - "bool sparse matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("bool sparse matrix", "complex scalar"); - - return retval; -} - -octave_value -octave_sparse_bool_matrix::convert_to_str_internal (bool pad, bool force, - char type) const -{ - octave_value tmp = octave_value (array_value ()); - return tmp.convert_to_str (pad, force, type); -} - -// FIXME These are inefficient ways of creating full matrices - -Matrix -octave_sparse_bool_matrix::matrix_value (bool) const -{ - return Matrix (matrix.matrix_value ()); -} - -ComplexMatrix -octave_sparse_bool_matrix::complex_matrix_value (bool) const -{ - return ComplexMatrix (matrix.matrix_value ()); -} - -ComplexNDArray -octave_sparse_bool_matrix::complex_array_value (bool) const -{ - return ComplexNDArray (ComplexMatrix (matrix.matrix_value ())); -} - -NDArray -octave_sparse_bool_matrix::array_value (bool) const -{ - return NDArray (Matrix (matrix.matrix_value ())); -} - -charNDArray -octave_sparse_bool_matrix::char_array_value (bool) const -{ - charNDArray retval (dims (), 0); - octave_idx_type nc = matrix.cols (); - octave_idx_type nr = matrix.rows (); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = matrix.cidx (j); i < matrix.cidx (j+1); i++) - retval(matrix.ridx (i) + nr * j) = static_cast(matrix.data (i)); - - return retval; -} - -boolMatrix -octave_sparse_bool_matrix::bool_matrix_value (bool) const -{ - return matrix.matrix_value (); -} - -boolNDArray -octave_sparse_bool_matrix::bool_array_value (bool) const -{ - return boolNDArray (matrix.matrix_value ()); -} - - -SparseMatrix -octave_sparse_bool_matrix::sparse_matrix_value (bool) const -{ - return SparseMatrix (this->matrix); -} - -SparseComplexMatrix -octave_sparse_bool_matrix::sparse_complex_matrix_value (bool) const -{ - return SparseComplexMatrix (this->matrix); -} - -bool -octave_sparse_bool_matrix::save_binary (std::ostream& os, bool&) -{ - dim_vector d = this->dims (); - if (d.length () < 1) - return false; - - // Ensure that additional memory is deallocated - matrix.maybe_compress (); - - int nr = d(0); - int nc = d(1); - int nz = nnz (); - - int32_t itmp; - // Use negative value for ndims to be consistent with other formats - itmp= -2; - os.write (reinterpret_cast (&itmp), 4); - - itmp= nr; - os.write (reinterpret_cast (&itmp), 4); - - itmp= nc; - os.write (reinterpret_cast (&itmp), 4); - - itmp= nz; - os.write (reinterpret_cast (&itmp), 4); - - // add one to the printed indices to go from - // zero-based to one-based arrays - for (int i = 0; i < nc+1; i++) - { - octave_quit (); - itmp = matrix.cidx (i); - os.write (reinterpret_cast (&itmp), 4); - } - - for (int i = 0; i < nz; i++) - { - octave_quit (); - itmp = matrix.ridx (i); - os.write (reinterpret_cast (&itmp), 4); - } - - OCTAVE_LOCAL_BUFFER (char, htmp, nz); - - for (int i = 0; i < nz; i++) - htmp[i] = (matrix.data (i) ? 1 : 0); - - os.write (htmp, nz); - - return true; -} - -bool -octave_sparse_bool_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format /* fmt */) -{ - int32_t nz, nc, nr, tmp; - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - - if (swap) - swap_bytes<4> (&tmp); - - if (tmp != -2) { - error ("load: only 2D sparse matrices are supported"); - return false; - } - - if (! is.read (reinterpret_cast (&nr), 4)) - return false; - if (! is.read (reinterpret_cast (&nc), 4)) - return false; - if (! is.read (reinterpret_cast (&nz), 4)) - return false; - - if (swap) - { - swap_bytes<4> (&nr); - swap_bytes<4> (&nc); - swap_bytes<4> (&nz); - } - - SparseBoolMatrix m (static_cast (nr), - static_cast (nc), - static_cast (nz)); - - for (int i = 0; i < nc+1; i++) - { - octave_quit (); - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - if (swap) - swap_bytes<4> (&tmp); - m.cidx (i) = tmp; - } - - for (int i = 0; i < nz; i++) - { - octave_quit (); - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - if (swap) - swap_bytes<4> (&tmp); - m.ridx (i) = tmp; - } - - if (error_state || ! is) - return false; - - OCTAVE_LOCAL_BUFFER (char, htmp, nz); - - if (! is.read (htmp, nz)) - return false; - - for (int i = 0; i < nz; i++) - m.data(i) = (htmp[i] ? 1 : 0); - - if (! m.indices_ok ()) - return false; - - matrix = m; - - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_sparse_bool_matrix::save_hdf5 (hid_t loc_id, const char *name, bool) -{ - dim_vector dv = dims (); - int empty = save_hdf5_empty (loc_id, name, dv); - if (empty) - return (empty > 0); - - // Ensure that additional memory is deallocated - matrix.maybe_compress (); -#if HAVE_HDF5_18 - hid_t group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - hid_t group_hid = H5Gcreate (loc_id, name, 0); -#endif - if (group_hid < 0) - return false; - - hid_t space_hid = -1, data_hid = -1; - bool retval = true; - SparseBoolMatrix m = sparse_bool_matrix_value (); - octave_idx_type tmp; - hsize_t hdims[2]; - - space_hid = H5Screate_simple (0, hdims, 0); - if (space_hid < 0) - { - H5Gclose (group_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - tmp = m.rows (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &tmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - tmp = m.cols (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &tmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - tmp = m.nnz (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &tmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - - hdims[0] = m.cols () + 1; - hdims[1] = 1; - - space_hid = H5Screate_simple (2, hdims, 0); - - if (space_hid < 0) - { - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - octave_idx_type * itmp = m.xcidx (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, itmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - - hdims[0] = m.nnz (); - hdims[1] = 1; - - space_hid = H5Screate_simple (2, hdims, 0); - - if (space_hid < 0) - { - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - itmp = m.xridx (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, itmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "data", H5T_NATIVE_HBOOL, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "data", H5T_NATIVE_HBOOL, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hbool_t, htmp, m.nnz ()); - for (int i = 0; i < m.nnz (); i++) - htmp[i] = m.xdata(i); - - retval = H5Dwrite (data_hid, H5T_NATIVE_HBOOL, H5S_ALL, H5S_ALL, - H5P_DEFAULT, htmp) >= 0; - H5Dclose (data_hid); - H5Sclose (space_hid); - H5Gclose (group_hid); - - return retval; -} - -bool -octave_sparse_bool_matrix::load_hdf5 (hid_t loc_id, const char *name) -{ - octave_idx_type nr, nc, nz; - hid_t group_hid, data_hid, space_hid; - hsize_t rank; - - dim_vector dv; - int empty = load_hdf5_empty (loc_id, name, dv); - if (empty > 0) - matrix.resize (dv); - if (empty) - return (empty > 0); - -#if HAVE_HDF5_18 - group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); -#else - group_hid = H5Gopen (loc_id, name); -#endif - if (group_hid < 0 ) return false; - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "nr", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "nr"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nr) < 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "nc", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "nc"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nc) < 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "nz", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "nz"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nz) < 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - - SparseBoolMatrix m (static_cast (nr), - static_cast (nc), - static_cast (nz)); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "cidx", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "cidx"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 2) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - if (static_cast (hdims[0]) != nc + 1 - || static_cast (hdims[1]) != 1) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - octave_idx_type *itmp = m.xcidx (); - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, itmp) < 0) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "ridx", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "ridx"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 2) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - if (static_cast (hdims[0]) != nz - || static_cast (hdims[1]) != 1) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - itmp = m.xridx (); - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, itmp) < 0) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "data", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "data"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 2) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - if (static_cast (hdims[0]) != nz - || static_cast (hdims[1]) != 1) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hbool_t, htmp, nz); - bool retval = false; - if (H5Dread (data_hid, H5T_NATIVE_HBOOL, H5S_ALL, H5S_ALL, - H5P_DEFAULT, htmp) >= 0 - && m.indices_ok ()) - { - retval = true; - - for (int i = 0; i < nz; i++) - m.xdata(i) = htmp[i]; - - matrix = m; - } - - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - - return retval; -} - -#endif - -mxArray * -octave_sparse_bool_matrix::as_mxArray (void) const -{ - mwSize nz = nzmax (); - mxArray *retval = new mxArray (mxLOGICAL_CLASS, rows (), columns (), - nz, mxREAL); - bool *pr = static_cast (retval->get_data ()); - mwIndex *ir = retval->get_ir (); - mwIndex *jc = retval->get_jc (); - - for (mwIndex i = 0; i < nz; i++) - { - pr[i] = matrix.data (i); - ir[i] = matrix.ridx (i); - } - - for (mwIndex i = 0; i < columns () + 1; i++) - jc[i] = matrix.cidx (i); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/ov-bool-sparse.h --- a/src/ov-bool-sparse.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,157 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_sparse_bool_matrix_h) -#define octave_sparse_bool_matrix_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-stream.h" -#include "ov-base.h" -#include "ov-typeinfo.h" - -#include "boolSparse.h" -#include "ov-base-sparse.h" -#include "ov-re-sparse.h" - -class octave_value_list; - -class tree_walker; - -class -OCTINTERP_API -octave_sparse_bool_matrix : public octave_base_sparse -{ -public: - - octave_sparse_bool_matrix (void) - : octave_base_sparse () { } - - octave_sparse_bool_matrix (const SparseBoolMatrix& bnda) - : octave_base_sparse (bnda) { } - - octave_sparse_bool_matrix (const SparseBoolMatrix& bnda, - const MatrixType& t) - : octave_base_sparse (bnda, t) { } - - octave_sparse_bool_matrix (const boolNDArray& m) - : octave_base_sparse (SparseBoolMatrix (m)) { } - - octave_sparse_bool_matrix (const boolMatrix& m) - : octave_base_sparse (SparseBoolMatrix (m)) { } - - octave_sparse_bool_matrix (const Sparse& a) - : octave_base_sparse (a) { } - - octave_sparse_bool_matrix (const octave_sparse_bool_matrix& bm) - : octave_base_sparse (bm) { } - - ~octave_sparse_bool_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_sparse_bool_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_sparse_bool_matrix (); } - - type_conv_info numeric_conversion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - // FIXME Adapt idx_vector to allow sparse logical indexing!! - idx_vector index_vector (void) const - { return idx_vector (bool_array_value ()); } - - builtin_type_t builtin_type (void) const { return btyp_bool; } - - bool is_bool_matrix (void) const { return true; } - - bool is_bool_type (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_numeric_type (void) const { return false; } - - double double_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const; - - NDArray array_value (bool = false) const; - - Complex complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const; - - charNDArray char_array_value (bool = false) const; - - boolMatrix bool_matrix_value (bool = false) const; - - boolNDArray bool_array_value (bool = false) const; - - SparseMatrix sparse_matrix_value (bool = false) const; - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; - - SparseBoolMatrix sparse_bool_matrix_value (bool = false) const - { return matrix; } - - octave_value convert_to_str_internal (bool pad, bool force, char type) const; - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - mxArray *as_mxArray (void) const; - - // Mapper functions are converted to double for treatment - octave_value map (unary_mapper_t umap) const - { - octave_sparse_matrix m (sparse_matrix_value ()); - return m.map (umap); - } - -protected: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-bool.cc --- a/src/ov-bool.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,240 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "mx-base.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "ops.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-base.h" -#include "ov-base-scalar.h" -#include "ov-base-scalar.cc" -#include "ov-re-mat.h" -#include "ov-scalar.h" -#include "pr-output.h" - -#include "ls-oct-ascii.h" -#include "ls-hdf5.h" - -template class octave_base_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_bool); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_bool, "bool", "logical"); - -static octave_base_value * -default_numeric_conversion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_bool&); - - return new octave_scalar (v.bool_value ()); -} - -octave_base_value::type_conv_info -octave_bool::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_conversion_function, - octave_scalar::static_type_id ()); - -} - -octave_value -octave_bool::do_index_op (const octave_value_list& idx, bool resize_ok) -{ - // FIXME -- this doesn't solve the problem of - // - // a = 1; a([1,1], [1,1], [1,1]) - // - // and similar constructions. Hmm... - - // FIXME -- using this constructor avoids narrowing the - // 1x1 matrix back to a scalar value. Need a better solution - // to this problem. - - octave_value tmp (new octave_bool_matrix (bool_matrix_value ())); - - return tmp.do_index_op (idx, resize_ok); -} - -octave_value -octave_bool::resize (const dim_vector& dv, bool fill) const -{ - if (fill) - { - boolNDArray retval (dv, false); - if (dv.numel ()) - retval(0) = scalar; - return retval; - } - else - { - boolNDArray retval (dv); - if (dv.numel ()) - retval(0) = scalar; - return retval; - } -} - -octave_value -octave_bool::convert_to_str_internal (bool, bool, char type) const -{ - char s[2]; - s[0] = static_cast (scalar); - s[1] = '\0'; - - return octave_value (s, type); -} - -bool -octave_bool::save_ascii (std::ostream& os) -{ - double d = double_value (); - - octave_write_double (os, d); - os << "\n"; - - return true; -} - -bool -octave_bool::load_ascii (std::istream& is) -{ - scalar = (octave_read_value (is) != 0.); - - if (!is) - { - error ("load: failed to load scalar constant"); - return false; - } - - return true; -} - -bool -octave_bool::save_binary (std::ostream& os, bool& /* save_as_floats */) -{ - char tmp = (scalar ? 1 : 0); - os.write (reinterpret_cast (&tmp), 1); - - return true; -} - -bool -octave_bool::load_binary (std::istream& is, bool /* swap */, - oct_mach_info::float_format /* fmt */) -{ - char tmp; - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - scalar = (tmp ? 1 : 0); - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_bool::save_hdf5 (hid_t loc_id, const char *name, - bool /* save_as_floats */) -{ - hsize_t dimens[3]; - hid_t space_hid = -1, data_hid = -1; - bool retval = true; - - space_hid = H5Screate_simple (0, dimens, 0); - if (space_hid < 0) return false; -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_DOUBLE, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_DOUBLE, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - return false; - } - - double tmp = double_value (); - retval = H5Dwrite (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &tmp) >= 0; - - H5Dclose (data_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_bool::load_hdf5 (hid_t loc_id, const char *name) -{ -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t space_id = H5Dget_space (data_hid); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank != 0) - { - H5Dclose (data_hid); - return false; - } - - double dtmp; - if (H5Dread (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &dtmp) < 0) - { - H5Dclose (data_hid); - return false; - } - - scalar = (dtmp != 0.); - - H5Dclose (data_hid); - - return true; -} - -#endif - -mxArray * -octave_bool::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxLOGICAL_CLASS, 1, 1, mxREAL); - - bool *pr = static_cast (retval->get_data ()); - - pr[0] = scalar; - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/ov-bool.h --- a/src/ov-bool.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,251 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_bool_h) -#define octave_bool_h 1 - -#include - -#include -#include - -#include "lo-utils.h" -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "oct-stream.h" -#include "ov-base.h" -#include "ov-base-scalar.h" -#include "ov-bool-mat.h" -#include "ov-scalar.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// Real scalar values. - -class -OCTINTERP_API -octave_bool : public octave_base_scalar -{ -public: - - octave_bool (void) - : octave_base_scalar (false) { } - - octave_bool (bool b) - : octave_base_scalar (b) { } - - octave_bool (const octave_bool& s) - : octave_base_scalar (s) { } - - ~octave_bool (void) { } - - octave_base_value *clone (void) const { return new octave_bool (*this); } - octave_base_value *empty_clone (void) const { return new octave_bool_matrix (); } - - type_conv_info numeric_conversion_function (void) const; - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - idx_vector index_vector (void) const { return idx_vector (scalar); } - - builtin_type_t builtin_type (void) const { return btyp_bool; } - - bool is_real_scalar (void) const { return true; } - - bool is_bool_scalar (void) const { return true; } - - bool is_bool_type (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_numeric_type (void) const { return false; } - - bool is_true (void) const { return scalar; } - - int8NDArray - int8_array_value (void) const - { return int8NDArray (dim_vector (1, 1), scalar); } - - int16NDArray - int16_array_value (void) const - { return int16NDArray (dim_vector (1, 1), scalar); } - - int32NDArray - int32_array_value (void) const - { return int32NDArray (dim_vector (1, 1), scalar); } - - int64NDArray - int64_array_value (void) const - { return int64NDArray (dim_vector (1, 1), scalar); } - - uint8NDArray - uint8_array_value (void) const - { return uint8NDArray (dim_vector (1, 1), scalar); } - - uint16NDArray - uint16_array_value (void) const - { return uint16NDArray (dim_vector (1, 1), scalar); } - - uint32NDArray - uint32_array_value (void) const - { return uint32NDArray (dim_vector (1, 1), scalar); } - - uint64NDArray - uint64_array_value (void) const - { return uint64NDArray (dim_vector (1, 1), scalar); } - - octave_int8 - int8_scalar_value (void) const { return octave_int8 (scalar); } - - octave_int16 - int16_scalar_value (void) const { return octave_int16 (scalar); } - - octave_int32 - int32_scalar_value (void) const { return octave_int32 (scalar); } - - octave_int64 - int64_scalar_value (void) const { return octave_int64 (scalar); } - - octave_uint8 - uint8_scalar_value (void) const { return octave_uint8 (scalar); } - - octave_uint16 - uint16_scalar_value (void) const { return octave_uint16 (scalar); } - - octave_uint32 - uint32_scalar_value (void) const { return octave_uint32 (scalar); } - - octave_uint64 - uint64_scalar_value (void) const { return octave_uint64 (scalar); } - - double double_value (bool = false) const { return scalar; } - - float float_value (bool = false) const { return scalar; } - - double scalar_value (bool = false) const { return scalar; } - - float float_scalar_value (bool = false) const { return scalar; } - - Matrix matrix_value (bool = false) const - { return Matrix (1, 1, scalar); } - - FloatMatrix float_matrix_value (bool = false) const - { return FloatMatrix (1, 1, scalar); } - - NDArray array_value (bool = false) const - { return NDArray (dim_vector (1, 1), static_cast (scalar)); } - - FloatNDArray float_array_value (bool = false) const - { return FloatNDArray (dim_vector (1, 1), static_cast (scalar)); } - - Complex complex_value (bool = false) const { return scalar; } - - FloatComplex float_complex_value (bool = false) const { return scalar; } - - ComplexMatrix complex_matrix_value (bool = false) const - { return ComplexMatrix (1, 1, Complex (scalar)); } - - FloatComplexMatrix float_complex_matrix_value (bool = false) const - { return FloatComplexMatrix (1, 1, FloatComplex (scalar)); } - - ComplexNDArray complex_array_value (bool = false) const - { return ComplexNDArray (dim_vector (1, 1), Complex (scalar)); } - - FloatComplexNDArray float_complex_array_value (bool = false) const - { return FloatComplexNDArray (dim_vector (1, 1), FloatComplex (scalar)); } - - SparseMatrix sparse_matrix_value (bool = false) const - { return SparseMatrix (Matrix (1, 1, scalar)); } - - // FIXME Need SparseComplexMatrix (Matrix) constructor!!! - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const - { return SparseComplexMatrix (sparse_matrix_value ()); } - - SparseBoolMatrix sparse_bool_matrix_value (bool = false) const - { return SparseBoolMatrix (boolMatrix (1, 1, scalar)); } - - charNDArray - char_array_value (bool = false) const - { - charNDArray retval (dim_vector (1, 1)); - retval(0) = static_cast (scalar); - return retval; - } - - bool bool_value (bool = false) const { return scalar; } - - boolMatrix bool_matrix_value (bool = false) const - { return boolMatrix (1, 1, scalar); } - - boolNDArray bool_array_value (bool = false) const - { return boolNDArray (dim_vector (1, 1), scalar); } - - octave_value resize (const dim_vector& dv, bool fill = false) const; - - octave_value convert_to_str_internal (bool pad, bool force, char type) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { - return os.write (bool_array_value (), block_size, output_type, - skip, flt_fmt); - } - - mxArray *as_mxArray (void) const; - - // Mapper functions are converted to double for treatment - octave_value map (unary_mapper_t umap) const - { - octave_scalar m (scalar_value ()); - return m.map (umap); - } - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-builtin.cc --- a/src/ov-builtin.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,173 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "ov-builtin.h" -#include "ov.h" -#include "profiler.h" -#include "toplev.h" -#include "unwind-prot.h" - -DEFINE_OCTAVE_ALLOCATOR (octave_builtin); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_builtin, - "built-in function", - "built-in function"); - -octave_value_list -octave_builtin::subsref (const std::string& type, - const std::list& idx, - int nargout) -{ - return octave_builtin::subsref (type, idx, nargout, 0); -} - -octave_value_list -octave_builtin::subsref (const std::string& type, - const std::list& idx, - int nargout, const std::list* lvalue_list) -{ - octave_value_list retval; - - switch (type[0]) - { - case '(': - { - int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout; - - retval = do_multi_index_op (tmp_nargout, idx.front (), - idx.size () == 1 ? lvalue_list : 0); - } - break; - - case '{': - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - // FIXME -- perhaps there should be an - // octave_value_list::next_subsref member function? See also - // octave_user_function::subsref. - // - // FIXME -- Note that if a function call returns multiple - // values, and there is further indexing to perform, then we are - // ignoring all but the first value. Is this really what we want to - // do? If it is not, then what should happen for stat("file").size, - // for exmaple? - - if (idx.size () > 1) - retval = retval(0).next_subsref (nargout, type, idx); - - return retval; -} - -octave_value_list -octave_builtin::do_multi_index_op (int nargout, const octave_value_list& args) -{ - return octave_builtin::do_multi_index_op (nargout, args, 0); -} - -octave_value_list -octave_builtin::do_multi_index_op (int nargout, const octave_value_list& args, - const std::list *lvalue_list) -{ - octave_value_list retval; - - if (error_state) - return retval; - - if (args.has_magic_colon ()) - ::error ("invalid use of colon in function argument list"); - else - { - unwind_protect frame; - - octave_call_stack::push (this); - - frame.add_fcn (octave_call_stack::pop); - - if (lvalue_list || curr_lvalue_list) - { - frame.protect_var (curr_lvalue_list); - curr_lvalue_list = lvalue_list; - } - - try - { - BEGIN_PROFILER_BLOCK (profiler_name ()) - - retval = (*f) (args, nargout); - // Do not allow null values to be returned from functions. - // FIXME -- perhaps true builtins should be allowed? - retval.make_storable_values (); - // Fix the case of a single undefined value. - // This happens when a compiled function uses - // octave_value retval; - // instead of - // octave_value_list retval; - // the idiom is very common, so we solve that here. - if (retval.length () == 1 && retval.xelem (0).is_undefined ()) - retval.clear (); - - END_PROFILER_BLOCK - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - - return retval; -} - -jit_type * -octave_builtin::to_jit (void) const -{ - return jtype; -} - -void -octave_builtin::stash_jit (jit_type &type) -{ - jtype = &type; -} - -octave_builtin::fcn -octave_builtin::function (void) const -{ - return f; -} - -const std::list *octave_builtin::curr_lvalue_list = 0; diff -r d02b229ce693 -r a132d206a36a src/ov-builtin.h --- a/src/ov-builtin.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,117 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_builtin_h) -#define octave_builtin_h 1 - -#include - -#include "ov-fcn.h" -#include "ov-typeinfo.h" - -class octave_value; -class octave_value_list; -class jit_type; - -// Builtin functions. - -class -OCTINTERP_API -octave_builtin : public octave_function -{ -public: - - octave_builtin (void) : octave_function (), f (0), file (), jtype (0) { } - - typedef octave_value_list (*fcn) (const octave_value_list&, int); - - octave_builtin (fcn ff, const std::string& nm = std::string (), - const std::string& ds = std::string ()) - : octave_function (nm, ds), f (ff), file (), jtype (0) { } - - octave_builtin (fcn ff, const std::string& nm, const std::string& fnm, - const std::string& ds) - : octave_function (nm, ds), f (ff), file (fnm), jtype (0) { } - - ~octave_builtin (void) { } - - std::string src_file_name (void) const { return file; } - - octave_value subsref (const std::string& type, - const std::list& idx) - { - octave_value_list tmp = subsref (type, idx, 1); - return tmp.length () > 0 ? tmp(0) : octave_value (); - } - - octave_value_list subsref (const std::string& type, - const std::list& idx, - int nargout); - - octave_value_list subsref (const std::string& type, - const std::list& idx, - int nargout, const std::list* lvalue_list); - - octave_function *function_value (bool = false) { return this; } - - bool is_builtin_function (void) const { return true; } - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& args); - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& args, - const std::list* lvalue_list); - - jit_type *to_jit (void) const; - - void stash_jit (jit_type& type); - - fcn function (void) const; - - static const std::list *curr_lvalue_list; - -protected: - - // A pointer to the actual function. - fcn f; - - // The name of the file where this function was defined. - std::string file; - - // A pointer to the jit type that represents the function. - jit_type *jtype; - -private: - - // No copying! - - octave_builtin (const octave_builtin& ob); - - octave_builtin& operator = (const octave_builtin& ob); - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-cell.cc --- a/src/ov-cell.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1528 +0,0 @@ -/* - -Copyright (C) 1999-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include - -#include "Array-util.h" -#include "byte-swap.h" -#include "lo-utils.h" -#include "quit.h" -#include "oct-locbuf.h" - -#include "defun.h" -#include "error.h" -#include "ov-cell.h" -#include "oct-obj.h" -#include "unwind-prot.h" -#include "utils.h" -#include "ov-base-mat.h" -#include "ov-base-mat.cc" -#include "ov-re-mat.h" -#include "ov-scalar.h" -#include "pr-output.h" -#include "ov-scalar.h" -#include "gripes.h" - -#include "ls-oct-ascii.h" -#include "ls-oct-binary.h" -#include "ls-hdf5.h" -#include "ls-utils.h" - -// Cell is able to handle octave_value indexing by itself, so just forward -// everything. - -template <> -octave_value -octave_base_matrix::do_index_op (const octave_value_list& idx, - bool resize_ok) -{ - return matrix.index (idx, resize_ok); -} - -template <> -void -octave_base_matrix::assign (const octave_value_list& idx, const Cell& rhs) -{ - matrix.assign (idx, rhs); -} - -template <> -void -octave_base_matrix::assign (const octave_value_list& idx, octave_value rhs) -{ - // FIXME: Really? - if (rhs.is_cell ()) - matrix.assign (idx, rhs.cell_value ()); - else - matrix.assign (idx, Cell (rhs)); -} - -template <> -void -octave_base_matrix::delete_elements (const octave_value_list& idx) -{ - matrix.delete_elements (idx); -} - -// FIXME: this list of specializations is becoming so long that we should really ask -// whether octave_cell should inherit from octave_base_matrix at all. - -template <> -octave_value -octave_base_matrix::fast_elem_extract (octave_idx_type n) const -{ - if (n < matrix.numel ()) - return Cell (matrix(n)); - else - return octave_value (); -} - -template <> -bool -octave_base_matrix::fast_elem_insert (octave_idx_type n, - const octave_value& x) -{ - const octave_cell *xrep = - dynamic_cast (&x.get_rep ()); - - bool retval = xrep && xrep->matrix.numel () == 1 && n < matrix.numel (); - if (retval) - matrix(n) = xrep->matrix(0); - - return retval; -} - -template class octave_base_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_cell); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_cell, "cell", "cell"); - -static void -gripe_failed_assignment (void) -{ - error ("assignment to cell array failed"); -} - -octave_value_list -octave_cell::subsref (const std::string& type, - const std::list& idx, - int nargout) -{ - octave_value_list retval; - - switch (type[0]) - { - case '(': - retval(0) = do_index_op (idx.front ()); - break; - - case '{': - { - octave_value tmp = do_index_op (idx.front ()); - - if (! error_state) - { - Cell tcell = tmp.cell_value (); - - if (tcell.length () == 1) - retval(0) = tcell(0,0); - else - retval = octave_value (octave_value_list (tcell), true); - } - } - break; - - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - // FIXME -- perhaps there should be an - // octave_value_list::next_subsref member function? See also - // octave_user_function::subsref. - - if (idx.size () > 1) - retval = retval(0).next_subsref (nargout, type, idx); - - return retval; -} - -octave_value -octave_cell::subsref (const std::string& type, - const std::list& idx, - bool auto_add) -{ - octave_value retval; - - switch (type[0]) - { - case '(': - retval = do_index_op (idx.front (), auto_add); - break; - - case '{': - { - octave_value tmp = do_index_op (idx.front (), auto_add); - - if (! error_state) - { - const Cell tcell = tmp.cell_value (); - - if (tcell.length () == 1) - retval = tcell(0,0); - else - retval = octave_value (octave_value_list (tcell), true); - } - } - break; - - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - // FIXME -- perhaps there should be an - // octave_value_list::next_subsref member function? See also - // octave_user_function::subsref. - - if (idx.size () > 1) - retval = retval.next_subsref (auto_add, type, idx); - - return retval; -} - -octave_value -octave_cell::subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - octave_value retval; - - int n = type.length (); - - octave_value t_rhs = rhs; - - clear_cellstr_cache (); - - if (idx.front ().empty ()) - { - error ("missing index in indexed assignment"); - return retval; - } - - if (n > 1) - { - switch (type[0]) - { - case '(': - { - if (is_empty () && type[1] == '.') - { - // Allow conversion of empty cell array to some other - // type in cases like - // - // x = {}; x(i).f = rhs - - octave_value tmp = octave_value::empty_conv (type, rhs); - - return tmp.subsasgn (type, idx, rhs); - } - else - { - octave_value tmp = do_index_op (idx.front (), true); - - if (! tmp.is_defined ()) - tmp = octave_value::empty_conv (type.substr (1), rhs); - - if (! error_state) - { - std::list next_idx (idx); - - next_idx.erase (next_idx.begin ()); - - tmp.make_unique (); - - t_rhs = tmp.subsasgn (type.substr (1), next_idx, rhs); - } - } - } - break; - - case '{': - { - matrix.make_unique (); - Cell tmpc = matrix.index (idx.front (), true); - - if (! error_state) - { - std::list next_idx (idx); - - next_idx.erase (next_idx.begin ()); - - std::string next_type = type.substr (1); - - if (tmpc.numel () == 1) - { - octave_value tmp = tmpc(0); - tmpc = Cell (); - - if (! tmp.is_defined () || tmp.is_zero_by_zero ()) - { - tmp = octave_value::empty_conv (type.substr (1), rhs); - tmp.make_unique (); // probably a no-op. - } - else - // optimization: ignore the copy still stored inside our array. - tmp.make_unique (1); - - if (! error_state) - t_rhs = tmp.subsasgn (next_type, next_idx, rhs); - } - else - gripe_indexed_cs_list (); - } - } - break; - - case '.': - { - if (is_empty ()) - { - // Do nothing; the next branch will handle it. - } - else - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - } - break; - - default: - panic_impossible (); - } - } - - if (! error_state) - { - switch (type[0]) - { - case '(': - { - octave_value_list i = idx.front (); - - if (t_rhs.is_cell ()) - octave_base_matrix::assign (i, t_rhs.cell_value ()); - else - if (t_rhs.is_null_value ()) - octave_base_matrix::delete_elements (i); - else - octave_base_matrix::assign (i, Cell (t_rhs)); - - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - break; - - case '{': - { - octave_value_list idxf = idx.front (); - - if (t_rhs.is_cs_list ()) - { - Cell tmp_cell = Cell (t_rhs.list_value ()); - - // Inquire the proper shape of the RHS. - - dim_vector didx = dims ().redim (idxf.length ()); - for (octave_idx_type k = 0; k < idxf.length (); k++) - if (! idxf(k).is_magic_colon ()) didx(k) = idxf(k).numel (); - - if (didx.numel () == tmp_cell.numel ()) - tmp_cell = tmp_cell.reshape (didx); - - - octave_base_matrix::assign (idxf, tmp_cell); - } - else if (idxf.all_scalars () || do_index_op (idxf, true).numel () == 1) - // Regularize a null matrix if stored into a cell. - octave_base_matrix::assign (idxf, Cell (t_rhs.storable_value ())); - else if (! error_state) - gripe_nonbraced_cs_list_assignment (); - - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - break; - - case '.': - { - if (is_empty ()) - { - // Allow conversion of empty cell array to some other - // type in cases like - // - // x = {}; x.f = rhs - - octave_value tmp = octave_value::empty_conv (type, rhs); - - return tmp.subsasgn (type, idx, rhs); - } - else - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - } - break; - - default: - panic_impossible (); - } - } - - return retval; -} - -bool -octave_cell::is_cellstr (void) const -{ - bool retval; - if (cellstr_cache.get ()) - retval = true; - else - { - retval = matrix.is_cellstr (); - // Allocate empty cache to mark that this is indeed a cellstr. - if (retval) - cellstr_cache.reset (new Array ()); - } - - return retval; -} - -void -octave_cell::assign (const octave_value_list& idx, const Cell& rhs) -{ - clear_cellstr_cache (); - octave_base_matrix::assign (idx, rhs); -} - -void -octave_cell::assign (const octave_value_list& idx, const octave_value& rhs) -{ - clear_cellstr_cache (); - octave_base_matrix::assign (idx, rhs); -} - - -void -octave_cell::delete_elements (const octave_value_list& idx) -{ - clear_cellstr_cache (); - octave_base_matrix::delete_elements (idx); -} - -size_t -octave_cell::byte_size (void) const -{ - size_t retval = 0; - - for (octave_idx_type i = 0; i < numel (); i++) - retval += matrix(i).byte_size (); - - return retval; -} - -octave_value -octave_cell::sort (octave_idx_type dim, sortmode mode) const -{ - octave_value retval; - - if (is_cellstr ()) - { - Array tmp = cellstr_value (); - - tmp = tmp.sort (dim, mode); - - // We already have the cache. - retval = new octave_cell (tmp); - } - else - error ("sort: only cell arrays of character strings may be sorted"); - - return retval; -} - -octave_value -octave_cell::sort (Array &sidx, octave_idx_type dim, - sortmode mode) const -{ - octave_value retval; - - if (is_cellstr ()) - { - Array tmp = cellstr_value (); - - tmp = tmp.sort (sidx, dim, mode); - - // We already have the cache. - retval = new octave_cell (tmp); - } - else - error ("sort: only cell arrays of character strings may be sorted"); - - return retval; -} - -sortmode -octave_cell::is_sorted (sortmode mode) const -{ - sortmode retval = UNSORTED; - - if (is_cellstr ()) - { - Array tmp = cellstr_value (); - - retval = tmp.is_sorted (mode); - } - else - error ("issorted: A is not a cell array of strings"); - - return retval; -} - - -Array -octave_cell::sort_rows_idx (sortmode mode) const -{ - Array retval; - - if (is_cellstr ()) - { - Array tmp = cellstr_value (); - - retval = tmp.sort_rows_idx (mode); - } - else - error ("sortrows: only cell arrays of character strings may be sorted"); - - return retval; -} - -sortmode -octave_cell::is_sorted_rows (sortmode mode) const -{ - sortmode retval = UNSORTED; - - if (is_cellstr ()) - { - Array tmp = cellstr_value (); - - retval = tmp.is_sorted_rows (mode); - } - else - error ("issorted: A is not a cell array of strings"); - - return retval; -} - -bool -octave_cell::is_true (void) const -{ - error ("invalid conversion from cell array to logical value"); - return false; -} - -octave_value_list -octave_cell::list_value (void) const -{ - return octave_value_list (matrix); -} - -string_vector -octave_cell::all_strings (bool pad) const -{ - string_vector retval; - - octave_idx_type nel = numel (); - - int n_elts = 0; - - octave_idx_type max_len = 0; - - std::queue strvec_queue; - - for (octave_idx_type i = 0; i < nel; i++) - { - string_vector s = matrix(i).all_strings (); - - if (error_state) - return retval; - - octave_idx_type s_len = s.length (); - - n_elts += s_len ? s_len : 1; - - octave_idx_type s_max_len = s.max_length (); - - if (s_max_len > max_len) - max_len = s_max_len; - - strvec_queue.push (s); - } - - retval = string_vector (n_elts); - - octave_idx_type k = 0; - - for (octave_idx_type i = 0; i < nel; i++) - { - const string_vector s = strvec_queue.front (); - strvec_queue.pop (); - - octave_idx_type s_len = s.length (); - - if (s_len) - { - for (octave_idx_type j = 0; j < s_len; j++) - { - std::string t = s[j]; - int t_len = t.length (); - - if (pad && max_len > t_len) - t += std::string (max_len - t_len, ' '); - - retval[k++] = t; - } - } - else if (pad) - retval[k++] = std::string (max_len, ' '); - else - retval[k++] = std::string (); - } - - return retval; -} - -Array -octave_cell::cellstr_value (void) const -{ - Array retval; - - if (is_cellstr ()) - { - if (cellstr_cache->is_empty ()) - *cellstr_cache = matrix.cellstr_value (); - - return *cellstr_cache; - } - else - error ("invalid conversion from cell array to array of strings"); - - return retval; -} - -bool -octave_cell::print_as_scalar (void) const -{ - return true; -} - -void -octave_cell::print (std::ostream& os, bool) const -{ - print_raw (os); -} - -void -octave_cell::print_raw (std::ostream& os, bool) const -{ - int nd = matrix.ndims (); - - if (nd == 2) - { - octave_idx_type nr = rows (); - octave_idx_type nc = columns (); - - if (nr > 0 && nc > 0) - { - newline (os); - indent (os); - os << "{"; - newline (os); - - increment_indent_level (); - - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_quit (); - - std::ostringstream buf; - buf << "[" << i+1 << "," << j+1 << "]"; - - octave_value val = matrix(i,j); - - val.print_with_name (os, buf.str ()); - } - } - - decrement_indent_level (); - - indent (os); - os << "}"; - newline (os); - } - else - { - indent (os); - os << "{}"; - if (Vprint_empty_dimensions) - os << "(" << nr << "x" << nc << ")"; - newline (os); - } - } - else - { - indent (os); - dim_vector dv = matrix.dims (); - os << "{" << dv.str () << " Cell Array}"; - newline (os); - } -} - -#define CELL_ELT_TAG "" - -bool -octave_cell::save_ascii (std::ostream& os) -{ - dim_vector d = dims (); - if (d.length () > 2) - { - os << "# ndims: " << d.length () << "\n"; - - for (int i = 0; i < d.length (); i++) - os << " " << d (i); - os << "\n"; - - Cell tmp = cell_value (); - - for (octave_idx_type i = 0; i < d.numel (); i++) - { - octave_value o_val = tmp.elem (i); - - // Recurse to print sub-value. - bool b = save_ascii_data (os, o_val, CELL_ELT_TAG, false, 0); - - if (! b) - return os; - } - } - else - { - // Keep this case, rather than use generic code above for backward - // compatiability. Makes load_ascii much more complex!! - os << "# rows: " << rows () << "\n" - << "# columns: " << columns () << "\n"; - - Cell tmp = cell_value (); - - for (octave_idx_type j = 0; j < tmp.cols (); j++) - { - for (octave_idx_type i = 0; i < tmp.rows (); i++) - { - octave_value o_val = tmp.elem (i, j); - - // Recurse to print sub-value. - bool b = save_ascii_data (os, o_val, CELL_ELT_TAG, false, 0); - - if (! b) - return os; - } - - os << "\n"; - } - } - - return true; -} - -bool -octave_cell::load_ascii (std::istream& is) -{ - bool success = true; - - clear_cellstr_cache (); - - string_vector keywords(2); - - keywords[0] = "ndims"; - keywords[1] = "rows"; - - std::string kw; - octave_idx_type val = 0; - - if (extract_keyword (is, keywords, kw, val, true)) - { - if (kw == "ndims") - { - int mdims = static_cast (val); - - if (mdims >= 0) - { - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - is >> dv(i); - - Cell tmp(dv); - - for (octave_idx_type i = 0; i < dv.numel (); i++) - { - octave_value t2; - bool dummy; - - // recurse to read cell elements - std::string nm = read_ascii_data (is, std::string (), - dummy, t2, i); - - if (nm == CELL_ELT_TAG) - { - if (is) - tmp.elem (i) = t2; - } - else - { - error ("load: cell array element had unexpected name"); - success = false; - break; - } - } - - if (is) - matrix = tmp; - else - { - error ("load: failed to load matrix constant"); - success = false; - } - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - } - else if (kw == "rows") - { - octave_idx_type nr = val; - octave_idx_type nc = 0; - - if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) - { - if (nr > 0 && nc > 0) - { - Cell tmp (nr, nc); - - for (octave_idx_type j = 0; j < nc; j++) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_value t2; - bool dummy; - - // recurse to read cell elements - std::string nm = read_ascii_data (is, std::string (), - dummy, t2, i); - - if (nm == CELL_ELT_TAG) - { - if (is) - tmp.elem (i, j) = t2; - } - else - { - error ("load: cell array element had unexpected name"); - success = false; - goto cell_read_error; - } - } - } - - cell_read_error: - - if (is) - matrix = tmp; - else - { - error ("load: failed to load cell element"); - success = false; - } - } - else if (nr == 0 || nc == 0) - matrix = Cell (nr, nc); - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns for cell array"); - success = false; - } - } - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - - return success; -} - -bool -octave_cell::save_binary (std::ostream& os, bool& save_as_floats) -{ - dim_vector d = dims (); - if (d.length () < 1) - return false; - - // Use negative value for ndims - int32_t di = - d.length (); - os.write (reinterpret_cast (&di), 4); - for (int i = 0; i < d.length (); i++) - { - di = d(i); - os.write (reinterpret_cast (&di), 4); - } - - Cell tmp = cell_value (); - - for (octave_idx_type i = 0; i < d.numel (); i++) - { - octave_value o_val = tmp.elem (i); - - // Recurse to print sub-value. - bool b = save_binary_data (os, o_val, CELL_ELT_TAG, "", 0, - save_as_floats); - - if (! b) - return false; - } - - return true; -} - -bool -octave_cell::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - clear_cellstr_cache (); - - bool success = true; - int32_t mdims; - if (! is.read (reinterpret_cast (&mdims), 4)) - return false; - if (swap) - swap_bytes<4> (&mdims); - if (mdims >= 0) - return false; - - mdims = -mdims; - int32_t di; - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - { - if (! is.read (reinterpret_cast (&di), 4)) - return false; - if (swap) - swap_bytes<4> (&di); - dv(i) = di; - } - - // Convert an array with a single dimension to be a row vector. - // Octave should never write files like this, other software - // might. - - if (mdims == 1) - { - mdims = 2; - dv.resize (mdims); - dv(1) = dv(0); - dv(0) = 1; - } - - octave_idx_type nel = dv.numel (); - Cell tmp(dv); - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_value t2; - bool dummy; - std::string doc; - - // recurse to read cell elements - std::string nm = read_binary_data (is, swap, fmt, std::string (), - dummy, t2, doc); - - if (nm == CELL_ELT_TAG) - { - if (is) - tmp.elem (i) = t2; - } - else - { - error ("load: cell array element had unexpected name"); - success = false; - break; - } - } - - if (is) - matrix = tmp; - else - { - error ("load: failed to load matrix constant"); - success = false; - } - - return success; -} - -void * -octave_cell::mex_get_data (void) const -{ - clear_cellstr_cache (); - return matrix.mex_get_data (); -} - -#if defined (HAVE_HDF5) - -bool -octave_cell::save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) -{ - dim_vector dv = dims (); - int empty = save_hdf5_empty (loc_id, name, dv); - if (empty) - return (empty > 0); - - hsize_t rank = dv.length (); - hid_t space_hid = -1, data_hid = -1, size_hid = -1; - -#if HAVE_HDF5_18 - data_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Gcreate (loc_id, name, 0); -#endif - - if (data_hid < 0) - return false; - - // Have to save cell array shape, since can't have a - // dataset of groups.... - - space_hid = H5Screate_simple (1, &rank, 0); - - if (space_hid < 0) - { - H5Gclose (data_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (octave_idx_type, hdims, rank); - - // Octave uses column-major, while HDF5 uses row-major ordering - for (hsize_t i = 0; i < rank; i++) - hdims[i] = dv(rank-i-1); - -#if HAVE_HDF5_18 - size_hid = H5Dcreate (data_hid, "dims", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - size_hid = H5Dcreate (data_hid, "dims", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (size_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (data_hid); - return false; - } - - if (H5Dwrite (size_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, hdims) < 0) - { - H5Dclose (size_hid); - H5Sclose (space_hid); - H5Gclose (data_hid); - return false; - } - - H5Dclose (size_hid); - H5Sclose (space_hid); - - // Recursively add each element of the cell to this group. - - Cell tmp = cell_value (); - - octave_idx_type nel = dv.numel (); - - for (octave_idx_type i = 0; i < nel; i++) - { - std::ostringstream buf; - int digits = static_cast (gnulib::floor (::log10 (static_cast (nel)) + 1.0)); - buf << "_" << std::setw (digits) << std::setfill ('0') << i; - std::string s = buf.str (); - - if (! add_hdf5_data (data_hid, tmp.elem (i), s.c_str (), "", false, - save_as_floats)) - { - H5Gclose (data_hid); - return false; - } - } - - H5Gclose (data_hid); - - return true; -} - -bool -octave_cell::load_hdf5 (hid_t loc_id, const char *name) -{ - clear_cellstr_cache (); - - bool retval = false; - - dim_vector dv; - int empty = load_hdf5_empty (loc_id, name, dv); - if (empty > 0) - matrix.resize (dv); - if (empty) - return (empty > 0); - -#if HAVE_HDF5_18 - hid_t group_id = H5Gopen (loc_id, name, H5P_DEFAULT); -#else - hid_t group_id = H5Gopen (loc_id, name); -#endif - - if (group_id < 0) - return false; - -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (group_id, "dims", H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (group_id, "dims"); -#endif - hid_t space_hid = H5Dget_space (data_hid); - hsize_t rank = H5Sget_simple_extent_ndims (space_hid); - if (rank != 1) - { - H5Dclose (data_hid); - H5Gclose (group_id); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - // Octave uses column-major, while HDF5 uses row-major ordering. - - dv.resize (hdims[0]); - - OCTAVE_LOCAL_BUFFER (octave_idx_type, tmp, hdims[0]); - - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, tmp) < 0) - { - H5Dclose (data_hid); - H5Gclose (group_id); - return false; - } - - H5Dclose (data_hid); - H5Gclose (group_id); - - for (hsize_t i = 0, j = hdims[0] - 1; i < hdims[0]; i++, j--) - dv(j) = tmp[i]; - - hdf5_callback_data dsub; - - herr_t retval2 = -1; - - Cell m (dv); - - int current_item = 0; - - hsize_t num_obj = 0; -#if HAVE_HDF5_18 - group_id = H5Gopen (loc_id, name, H5P_DEFAULT); -#else - group_id = H5Gopen (loc_id, name); -#endif - H5Gget_num_objs (group_id, &num_obj); - H5Gclose (group_id); - - for (octave_idx_type i = 0; i < dv.numel (); i++) - { - - if (current_item >= static_cast (num_obj)) - retval2 = -1; - else - retval2 = H5Giterate (loc_id, name, ¤t_item, - hdf5_read_next_data, &dsub); - - if (retval2 <= 0) - break; - - octave_value ov = dsub.tc; - m.elem (i) = ov; - - } - - if (retval2 >= 0) - { - matrix = m; - retval = true; - } - - return retval; -} - -#endif - -DEFUN (iscell, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} iscell (@var{x})\n\ -Return true if @var{x} is a cell array object.\n\ -@seealso{ismatrix, isstruct, iscellstr, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_cell (); - else - print_usage (); - - return retval; -} - -DEFUN (cell, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cell (@var{n})\n\ -@deftypefnx {Built-in Function} {} cell (@var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {} cell (@var{m}, @var{n}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} cell ([@var{m} @var{n} @dots{}])\n\ -Create a new cell array object.\n\ -If invoked with a single scalar integer argument, return a square\n\ -@nospell{NxN} cell array. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -the given dimensions.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - dim_vector dims; - - switch (nargin) - { - case 0: - dims = dim_vector (0, 0); - break; - - case 1: - get_dimensions (args(0), "cell", dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).nint_value (); - - if (error_state) - { - error ("cell: expecting scalar arguments"); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, "cell"); - - if (! error_state) - retval = Cell (dims, Matrix ()); - } - - return retval; -} - -DEFUN (iscellstr, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} iscellstr (@var{cell})\n\ -Return true if every element of the cell array @var{cell} is a\n\ -character string.\n\ -@seealso{ischar}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_cellstr (); - else - print_usage (); - - return retval; -} - -// Note that since Fcellstr calls Fiscellstr, we need to have -// Fiscellstr defined first (to provide a declaration) and also we -// should keep it in the same file (so we don't have to provide a -// declaration) and so we don't have to use feval to call it. - -DEFUN (cellstr, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cellstr (@var{string})\n\ -Create a new cell array object from the elements of the string\n\ -array @var{string}.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - octave_value_list tmp = Fiscellstr (args, 1); - - if (tmp(0).is_true ()) - retval = args(0); - else - { - string_vector s = args(0).all_strings (); - - if (! error_state) - retval = (s.is_empty () - ? Cell (octave_value (std::string ())) - : Cell (s, true)); - else - error ("cellstr: argument STRING must be a 2-D character array"); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (struct2cell, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} struct2cell (@var{S})\n\ -Create a new cell array from the objects stored in the struct object.\n\ -If @var{f} is the number of fields in the structure, the resulting\n\ -cell array will have a dimension vector corresponding to\n\ -@code{[@var{F} size(@var{S})]}. For example:\n\ -\n\ -@example\n\ -@group\n\ -s = struct (\"name\", @{\"Peter\", \"Hannah\", \"Robert\"@},\n\ - \"age\", @{23, 16, 3@});\n\ -c = struct2cell (s)\n\ - @result{} c = @{1x1x3 Cell Array@}\n\ -c(1,1,:)(:)\n\ - @result{}\n\ - @{\n\ - [1,1] = Peter\n\ - [2,1] = Hannah\n\ - [3,1] = Robert\n\ - @}\n\ -c(2,1,:)(:)\n\ - @result{}\n\ - @{\n\ - [1,1] = 23\n\ - [2,1] = 16\n\ - [3,1] = 3\n\ - @}\n\ -@end group\n\ -@end example\n\ -\n\ -@seealso{cell2struct, fieldnames}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - const octave_map m = args(0).map_value (); - - if (! error_state) - { - const dim_vector m_dv = m.dims (); - - octave_idx_type num_fields = m.nfields (); - - // The resulting dim_vector should have dimensions: - // [numel(fields) size(struct)] - // except if the struct is a column vector. - - dim_vector result_dv; - if (m_dv (m_dv.length () - 1) == 1) - result_dv.resize (m_dv.length ()); - else - result_dv.resize (m_dv.length () + 1); // Add 1 for the fields. - - result_dv(0) = num_fields; - - for (int i = 1; i < result_dv.length (); i++) - result_dv(i) = m_dv(i-1); - - NoAlias c (result_dv); - - octave_idx_type n_elts = m.numel (); - - // Fill c in one sweep. Note that thanks to octave_map structure, - // we don't need a key lookup at all. - for (octave_idx_type j = 0; j < n_elts; j++) - for (octave_idx_type i = 0; i < num_fields; i++) - c(i,j) = m.contents(i)(j); - - retval = c; - } - else - error ("struct2cell: argument S must be a structure"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! keys = cellstr (char (floor (rand (11,10)*24+65)))'; -%! vals = cellfun (@(x) mat2cell (rand (19,1), ones (19,1), 1), ... -%! mat2cell ([1:11]', ones (11,1), 1), "uniformoutput", false)'; -%! s = struct ([keys; vals]{:}); -%! t = cell2struct ([vals{:}], keys, 2); -%! assert (s, t); -%! assert (struct2cell (s), [vals{:}]'); -%! assert (fieldnames (s), keys'); -*/ - -mxArray * -octave_cell::as_mxArray (void) const -{ - mxArray *retval = new mxArray (dims ()); - - mxArray **elts = static_cast (retval->get_data ()); - - mwSize nel = numel (); - - const octave_value *p = matrix.data (); - - for (mwIndex i = 0; i < nel; i++) - elts[i] = new mxArray (p[i]); - - return retval; -} - -octave_value -octave_cell::map (unary_mapper_t umap) const -{ - switch (umap) - { -#define FORWARD_MAPPER(UMAP) \ - case umap_ ## UMAP: \ - return matrix.UMAP () - FORWARD_MAPPER (xisalnum); - FORWARD_MAPPER (xisalpha); - FORWARD_MAPPER (xisascii); - FORWARD_MAPPER (xiscntrl); - FORWARD_MAPPER (xisdigit); - FORWARD_MAPPER (xisgraph); - FORWARD_MAPPER (xislower); - FORWARD_MAPPER (xisprint); - FORWARD_MAPPER (xispunct); - FORWARD_MAPPER (xisspace); - FORWARD_MAPPER (xisupper); - FORWARD_MAPPER (xisxdigit); - FORWARD_MAPPER (xtoascii); - FORWARD_MAPPER (xtolower); - FORWARD_MAPPER (xtoupper); - - default: - return octave_base_value::map (umap); - } -} diff -r d02b229ce693 -r a132d206a36a src/ov-cell.h --- a/src/ov-cell.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,180 +0,0 @@ -/* - -Copyright (C) 1999-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_cell_h) -#define octave_cell_h 1 - -#include - -#include -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "Cell.h" -#include "error.h" -#include "ov-base-mat.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// Cells. - -class -octave_cell : public octave_base_matrix -{ -public: - - octave_cell (void) - : octave_base_matrix (), cellstr_cache () { } - - octave_cell (const Cell& c) - : octave_base_matrix (c), cellstr_cache () { } - - octave_cell (const Array& str) - : octave_base_matrix (Cell (str)), cellstr_cache (new Array (str)) { } - - octave_cell (const octave_cell& c) - : octave_base_matrix (c), cellstr_cache () { } - - ~octave_cell (void) { } - - octave_base_value *clone (void) const { return new octave_cell (*this); } - octave_base_value *empty_clone (void) const { return new octave_cell (); } - -#if 0 - octave_base_value *try_narrowing_conversion (void); -#endif - - octave_value subsref (const std::string& type, - const std::list& idx) - { - octave_value_list tmp = subsref (type, idx, 1); - return tmp.length () > 0 ? tmp(0) : octave_value (); - } - - octave_value_list subsref (const std::string& type, - const std::list& idx, int); - - octave_value subsref (const std::string& type, - const std::list& idx, - bool auto_add); - - octave_value subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - void assign (const octave_value_list& idx, const Cell& rhs); - - void assign (const octave_value_list& idx, const octave_value& rhs); - - void delete_elements (const octave_value_list& idx); - - size_t byte_size (void) const; - - octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const; - - octave_value sort (Array &sidx, octave_idx_type dim = 0, - sortmode mode = ASCENDING) const; - - sortmode is_sorted (sortmode mode = UNSORTED) const; - - Array sort_rows_idx (sortmode mode = ASCENDING) const; - - sortmode is_sorted_rows (sortmode mode = UNSORTED) const; - - bool is_matrix_type (void) const { return false; } - - bool is_numeric_type (void) const { return false; } - - bool is_defined (void) const { return true; } - - bool is_constant (void) const { return true; } - - bool is_cell (void) const { return true; } - - builtin_type_t builtin_type (void) const { return btyp_cell; } - - bool is_cellstr (void) const; - - bool is_true (void) const; - - Cell cell_value (void) const { return matrix; } - - octave_value_list list_value (void) const; - - octave_value convert_to_str_internal (bool pad, bool, char type) const - { return octave_value (all_strings (pad), type); } - - string_vector all_strings (bool pad = false) const; - - Array cellstr_value (void) const; - - bool print_as_scalar (void) const; - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - octave_value map (unary_mapper_t umap) const; - - mxArray *as_mxArray (void) const; - - // Unsafe. This function exists to support the MEX interface. - // You should not use it anywhere else. - void *mex_get_data (void) const; - -private: - - void clear_cellstr_cache (void) const - { cellstr_cache.reset (); } - - mutable std::auto_ptr > cellstr_cache; - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-ch-mat.cc --- a/src/ov-ch-mat.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,197 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "lo-ieee.h" -#include "mx-base.h" - -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-base-mat.cc" -#include "ov-ch-mat.h" -#include "gripes.h" -#include "pr-output.h" - -template class octave_base_matrix; - -idx_vector -octave_char_matrix::index_vector (void) const -{ - const char *p = matrix.data (); - if (numel () == 1 && *p == ':') - return idx_vector (':'); - else - return idx_vector (array_value (true)); -} - -double -octave_char_matrix::double_value (bool) const -{ - double retval = lo_ieee_nan_value (); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "character matrix", "real scalar"); - - retval = static_cast (matrix (0, 0)); - } - else - gripe_invalid_conversion ("character matrix", "real scalar"); - - return retval; -} - -float -octave_char_matrix::float_value (bool) const -{ - float retval = lo_ieee_float_nan_value (); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "character matrix", "real scalar"); - - retval = static_cast (matrix (0, 0)); - } - else - gripe_invalid_conversion ("character matrix", "real scalar"); - - return retval; -} - -Complex -octave_char_matrix::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "character matrix", "complex scalar"); - - retval = static_cast (matrix (0, 0)); - } - else - gripe_invalid_conversion ("character matrix", "complex scalar"); - - return retval; -} - -FloatComplex -octave_char_matrix::float_complex_value (bool) const -{ - float tmp = lo_ieee_float_nan_value (); - - FloatComplex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "character matrix", "complex scalar"); - - retval = static_cast (matrix (0, 0)); - } - else - gripe_invalid_conversion ("character matrix", "complex scalar"); - - return retval; -} - -void -octave_char_matrix::print_raw (std::ostream& os, - bool pr_as_read_syntax) const -{ - octave_print_internal (os, matrix, pr_as_read_syntax, - current_print_indent_level ()); -} - -mxArray * -octave_char_matrix::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxCHAR_CLASS, dims (), mxREAL); - - mxChar *pr = static_cast (retval->get_data ()); - - mwSize nel = numel (); - - const char *p = matrix.data (); - - for (mwIndex i = 0; i < nel; i++) - pr[i] = p[i]; - - return retval; -} - -// The C++ standard guarantees cctype defines functions, not macros (and hence macros *CAN'T* -// be defined if only cctype is included) -// so there's no need to f*ck around. The exceptions are isascii and toascii, -// which are not C++. -// Oddly enough, all those character functions are int (*) (int), even -// in C++. Wicked! -static inline int xisascii (int c) -{ return isascii (c); } - -static inline int xtoascii (int c) -{ return toascii (c); } - -octave_value -octave_char_matrix::map (unary_mapper_t umap) const -{ - switch (umap) - { -#define STRING_MAPPER(UMAP,FCN,TYPE) \ - case umap_ ## UMAP: \ - return octave_value (matrix.map (FCN)) - - STRING_MAPPER (xisalnum, std::isalnum, bool); - STRING_MAPPER (xisalpha, std::isalpha, bool); - STRING_MAPPER (xisascii, xisascii, bool); - STRING_MAPPER (xiscntrl, std::iscntrl, bool); - STRING_MAPPER (xisdigit, std::isdigit, bool); - STRING_MAPPER (xisgraph, std::isgraph, bool); - STRING_MAPPER (xislower, std::islower, bool); - STRING_MAPPER (xisprint, std::isprint, bool); - STRING_MAPPER (xispunct, std::ispunct, bool); - STRING_MAPPER (xisspace, std::isspace, bool); - STRING_MAPPER (xisupper, std::isupper, bool); - STRING_MAPPER (xisxdigit, std::isxdigit, bool); - STRING_MAPPER (xtoascii, xtoascii, double); - STRING_MAPPER (xtolower, std::tolower, char); - STRING_MAPPER (xtoupper, std::toupper, char); - - default: - { - octave_matrix m (array_value (true)); - return m.map (umap); - } - } -} diff -r d02b229ce693 -r a132d206a36a src/ov-ch-mat.h --- a/src/ov-ch-mat.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,155 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_char_matrix_h) -#define octave_char_matrix_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "error.h" -#include "ov.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// Character matrix values. - -class -octave_char_matrix : public octave_base_matrix -{ -protected: - - octave_char_matrix (void) - : octave_base_matrix () { } - - octave_char_matrix (const charMatrix& chm) - : octave_base_matrix (chm) { } - - octave_char_matrix (const charNDArray& chm) - : octave_base_matrix (chm) { } - - octave_char_matrix (const Array& chm) - : octave_base_matrix (chm) { } - - octave_char_matrix (char c) - : octave_base_matrix (c) { } - - octave_char_matrix (const char *s) - : octave_base_matrix (s) { } - - octave_char_matrix (const std::string& s) - : octave_base_matrix (s) { } - - octave_char_matrix (const string_vector& s) - : octave_base_matrix (s) { } - - octave_char_matrix (const octave_char_matrix& chm) - : octave_base_matrix (chm) { } - -public: - - ~octave_char_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_char_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_char_matrix (); } - - idx_vector index_vector (void) const; - - builtin_type_t builtin_type (void) const { return btyp_char; } - - bool is_char_matrix (void) const { return true; } - bool is_real_matrix (void) const { return true; } - - bool is_real_type (void) const { return true; } - - double double_value (bool = false) const; - - float float_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - float float_scalar_value (bool frc_str_conv = false) const - { return float_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const - { return Matrix (matrix.matrix_value ()); } - - FloatMatrix float_matrix_value (bool = false) const - { return FloatMatrix (matrix.matrix_value ()); } - - NDArray array_value (bool = false) const - { return NDArray (matrix); } - - FloatNDArray float_array_value (bool = false) const - { return FloatNDArray (matrix); } - - Complex complex_value (bool = false) const; - - FloatComplex float_complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const - { return ComplexMatrix (matrix.matrix_value ()); } - - FloatComplexMatrix float_complex_matrix_value (bool = false) const - { return FloatComplexMatrix (matrix.matrix_value ()); } - - ComplexNDArray complex_array_value (bool = false) const - { return ComplexNDArray (matrix); } - - FloatComplexNDArray float_complex_array_value (bool = false) const - { return FloatComplexNDArray (matrix); } - - charMatrix char_matrix_value (bool = false) const - { return matrix.matrix_value (); } - - charNDArray char_array_value (bool = false) const - { return matrix; } - - octave_value convert_to_str_internal (bool, bool, char type) const - { return octave_value (matrix, type); } - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - // Unsafe. This function exists to support the MEX interface. - // You should not use it anywhere else. - void *mex_get_data (void) const { return matrix.mex_get_data (); } - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const; -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-class.cc --- a/src/ov-class.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2282 +0,0 @@ -/* - -Copyright (C) 2007-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "Array-util.h" -#include "byte-swap.h" -#include "oct-locbuf.h" -#include "lo-mappers.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "file-ops.h" -#include "gripes.h" -#include "load-path.h" -#include "ls-hdf5.h" -#include "ls-oct-ascii.h" -#include "ls-oct-binary.h" -#include "ls-utils.h" -#include "oct-lvalue.h" -#include "ov-class.h" -#include "ov-fcn.h" -#include "ov-usr-fcn.h" -#include "pager.h" -#include "parse.h" -#include "pr-output.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "variables.h" - -DEFINE_OCTAVE_ALLOCATOR(octave_class); - -int octave_class::t_id (-1); - -const std::string octave_class::t_name ("class"); - -void -octave_class::register_type (void) -{ - t_id = octave_value_typeinfo::register_type - (octave_class::t_name, "", octave_value (new octave_class ())); -} - -octave_class::octave_class (const octave_map& m, const std::string& id, - const octave_value_list& parents) - : octave_base_value (), map (m), c_name (id), obsolete_copies (0) -{ - octave_idx_type n = parents.length (); - - for (octave_idx_type idx = 0; idx < n; idx++) - { - octave_value parent = parents(idx); - - if (! parent.is_object ()) - error ("parents must be objects"); - else - { - std::string pcnm = parent.class_name (); - - if (find_parent_class (pcnm)) - error ("duplicate class in parent tree"); - else - { - parent_list.push_back (pcnm); - - octave_idx_type nel = map.numel (); - octave_idx_type p_nel = parent.numel (); - - if (nel == 0) - { - if (p_nel == 0) - { - // No elements in MAP or the parent class object, - // so just add the field name. - - map.assign (pcnm, Cell (map.dims ())); - } - else if (p_nel == 1) - { - if (map.nfields () == 0) - { - // No elements or fields in MAP, but the - // parent is class object with one element. - // Resize to match size of parent class and - // make the parent a field in MAP. - - map.resize (parent.dims ()); - - map.assign (pcnm, parent); - } - else - { - // No elements in MAP, but we have at least - // one field. So don't resize, just add the - // field name. - - map.assign (pcnm, Cell (map.dims ())); - } - } - else if (map.nfields () == 0) - { - // No elements or fields in MAP and more than one - // element in the parent class object, so we can - // resize MAP to match parent dimsenions, then - // distribute the elements of the parent object to - // the elements of MAP. - - dim_vector parent_dims = parent.dims (); - - map.resize (parent_dims); - - Cell c (parent_dims); - - octave_map pmap = parent.map_value (); - - std::list plist - = parent.parent_class_name_list (); - - for (octave_idx_type i = 0; i < p_nel; i++) - c(i) = octave_value (pmap.index (i), pcnm, plist); - - map.assign (pcnm, c); - } - else - error ("class: parent class dimension mismatch"); - } - else if (nel == 1 && p_nel == 1) - { - // Simple assignment. - - map.assign (pcnm, parent); - } - else - { - if (p_nel == 1) - { - // Broadcast the scalar parent class object to - // each element of MAP. - - Cell pcell (map.dims (), parent); - - map.assign (pcnm, pcell); - } - - else if (nel == p_nel) - { - // FIXME -- is there a better way to do this? - - // The parent class object has the same number of - // elements as the map we are using to create the - // new object, so distribute those elements to - // each element of the new object by first - // splitting the elements of the parent class - // object into a cell array with one element per - // cell. Then do the assignment all at once. - - Cell c (parent.dims ()); - - octave_map pmap = parent.map_value (); - - std::list plist - = parent.parent_class_name_list (); - - for (octave_idx_type i = 0; i < p_nel; i++) - c(i) = octave_value (pmap.index (i), pcnm, plist); - - map.assign (pcnm, c); - } - else - error ("class: parent class dimension mismatch"); - } - } - } - } - - if (! error_state) - symbol_table::add_to_parent_map (id, parent_list); -} - -octave_base_value * -octave_class::unique_clone (void) -{ - if (count == obsolete_copies) - { - // All remaining copies are obsolete. We don't actually need to clone. - count++; - return this; - } - else - { - // In theory, this shouldn't be happening, but it's here just in case. - if (count < obsolete_copies) - obsolete_copies = 0; - - return clone (); - } -} - -std::string -octave_class::get_current_method_class (void) -{ - std::string retval = class_name (); - - if (nparents () > 0) - { - octave_function *fcn = octave_call_stack::current (); - - // Here we are just looking to see if FCN is a method or constructor - // for any class, not specifically this one. - if (fcn && (fcn->is_class_method () || fcn->is_class_constructor ())) - retval = fcn->dispatch_class (); - } - - return retval; -} - -static void -gripe_invalid_index1 (void) -{ - error ("invalid index for class"); -} - -static void -gripe_invalid_index_for_assignment (void) -{ - error ("invalid index for class assignment"); -} - -static void -gripe_invalid_index_type (const std::string& nm, char t) -{ - error ("%s cannot be indexed with %c", nm.c_str (), t); -} - -static void -gripe_failed_assignment (void) -{ - error ("assignment to class element failed"); -} - -static inline octave_value_list -sanitize (const octave_value_list& ovl) -{ - octave_value_list retval = ovl; - - for (octave_idx_type i = 0; i < ovl.length (); i++) - { - if (retval(i).is_magic_colon ()) - retval(i) = ":"; - } - - return retval; -} - -static inline octave_value -make_idx_args (const std::string& type, - const std::list& idx, - const std::string& who) -{ - octave_value retval; - - size_t len = type.length (); - - if (len == idx.size ()) - { - Cell type_field (1, len); - Cell subs_field (1, len); - - std::list::const_iterator p = idx.begin (); - - for (size_t i = 0; i < len; i++) - { - char t = type[i]; - - switch (t) - { - case '(': - type_field(i) = "()"; - subs_field(i) = Cell (sanitize (*p++)); - break; - - case '{': - type_field(i) = "{}"; - subs_field(i) = Cell (sanitize (*p++)); - break; - - case '.': - { - type_field(i) = "."; - - octave_value_list vlist = *p++; - - if (vlist.length () == 1) - { - octave_value val = vlist(0); - - if (val.is_string ()) - subs_field(i) = val; - else - { - error ("expecting character string argument for `.' index"); - return retval; - } - } - else - { - error ("expecting single argument for `.' index"); - return retval; - } - } - break; - - default: - panic_impossible (); - break; - } - } - - octave_map m; - - m.assign ("type", type_field); - m.assign ("subs", subs_field); - - retval = m; - } - else - error ("invalid index for %s", who.c_str ()); - - return retval; -} - -Cell -octave_class::dotref (const octave_value_list& idx) -{ - Cell retval; - - assert (idx.length () == 1); - - std::string method_class = get_current_method_class (); - - // Find the class in which this method resides before attempting to access - // the requested field. - - octave_base_value *obvp = find_parent_class (method_class); - - if (obvp == 0) - { - error ("malformed class"); - return retval; - } - - octave_map my_map = (obvp != this) ? obvp->map_value () : map; - - std::string nm = idx(0).string_value (); - - if (! error_state) - { - octave_map::const_iterator p = my_map.seek (nm); - - if (p != my_map.end ()) - retval = my_map.contents (p); - else - error ("class has no member `%s'", nm.c_str ()); - } - else - gripe_invalid_index1 (); - - return retval; -} - -static bool -called_from_builtin (void) -{ - octave_function *fcn = octave_call_stack::caller (); - - // FIXME -- we probably need a better check here, or some other - // mechanism to avoid overloaded functions when builtin is used. - // For example, what if someone overloads the builtin function? - // Also, are there other places where using builtin is not properly - // avoiding dispatch? - - return (fcn && fcn->name () == "builtin"); -} - -Matrix -octave_class::size (void) -{ - if (in_class_method () || called_from_builtin ()) - return octave_base_value::size (); - - Matrix retval (1, 2, 1.0); - octave_value meth = symbol_table::find_method ("size", class_name ()); - - if (meth.is_defined ()) - { - count++; - octave_value_list args (1, octave_value (this)); - - octave_value_list lv = feval (meth.function_value (), args, 1); - if (lv.length () > 0 && lv(0).is_matrix_type () && lv(0).dims ().is_vector ()) - retval = lv(0).matrix_value (); - else - error ("@%s/size: invalid return value", class_name ().c_str ()); - } - else - { - dim_vector dv = dims (); - - int nd = dv.length (); - - retval.resize (1, nd); - - for (int i = 0; i < nd; i++) - retval(i) = dv(i); - } - - return retval; -} - -octave_idx_type -octave_class::numel (const octave_value_list& idx) -{ - if (in_class_method () || called_from_builtin ()) - return octave_base_value::numel (idx); - - octave_idx_type retval = -1; - const std::string cn = class_name (); - - octave_value meth = symbol_table::find_method ("numel", cn); - - if (meth.is_defined ()) - { - octave_value_list args (idx.length () + 1, octave_value ()); - - count++; - args(0) = octave_value (this); - - for (octave_idx_type i = 0; i < idx.length (); i++) - args(i+1) = idx(i); - - octave_value_list lv = feval (meth.function_value (), args, 1); - if (lv.length () == 1 && lv(0).is_scalar_type ()) - retval = lv(0).idx_type_value (true); - else - error ("@%s/numel: invalid return value", cn.c_str ()); - } - else - retval = octave_base_value::numel (idx); - - return retval; -} - -octave_value_list -octave_class::subsref (const std::string& type, - const std::list& idx, - int nargout) -{ - octave_value_list retval; - - if (in_class_method () || called_from_builtin ()) - { - // FIXME -- this block of code is the same as the body of - // octave_struct::subsref. Maybe it could be shared instead of - // duplicated. - - int skip = 1; - - switch (type[0]) - { - case '(': - { - if (type.length () > 1 && type[1] == '.') - { - std::list::const_iterator p = idx.begin (); - octave_value_list key_idx = *++p; - - Cell tmp = dotref (key_idx); - - if (! error_state) - { - Cell t = tmp.index (idx.front ()); - - retval(0) = (t.length () == 1) ? t(0) : octave_value (t, true); - - // We handled two index elements, so tell - // next_subsref to skip both of them. - - skip++; - } - } - else - retval(0) = octave_value (map.index (idx.front ()), - c_name, parent_list); - } - break; - - case '.': - { - if (map.numel () > 0) - { - Cell t = dotref (idx.front ()); - - retval(0) = (t.length () == 1) ? t(0) : octave_value (t, true); - } - } - break; - - case '{': - gripe_invalid_index_type (type_name (), type[0]); - break; - - default: - panic_impossible (); - } - - // FIXME -- perhaps there should be an - // octave_value_list::next_subsref member function? See also - // octave_user_function::subsref. - - if (idx.size () > 1) - retval = retval(0).next_subsref (nargout, type, idx, skip); - } - else - { - octave_value meth = symbol_table::find_method ("subsref", class_name ()); - - if (meth.is_defined ()) - { - octave_value_list args; - - args(1) = make_idx_args (type, idx, "subsref"); - - if (error_state) - return octave_value_list (); - - count++; - args(0) = octave_value (this); - - // FIXME: for Matlab compatibility, let us attempt to set up a proper - // value for nargout at least in the simple case where the - // cs-list-type expression - i.e., {} or ().x, is the leading one. - // Note that Octave does not actually need this, since it will - // be able to properly react to varargout a posteriori. - bool maybe_cs_list_query = (type[0] == '.' || type[0] == '{' - || (type.length () > 1 && type[0] == '(' - && type[1] == '.')); - - int true_nargout = nargout; - - if (maybe_cs_list_query) - { - // Set up a proper nargout for the subsref call by calling numel. - octave_value_list tmp; - if (type[0] != '.') tmp = idx.front (); - true_nargout = numel (tmp); - } - - retval = feval (meth.function_value (), args, true_nargout); - - // Since we're handling subsref, return the list in the first value - // if it has more than one element, to be able to pass through - // rvalue1 calls. - if (retval.length () > 1) - retval = octave_value (retval, true); - } - else - { - if (type.length () == 1 && type[0] == '(') - retval(0) = octave_value (map.index (idx.front ()), c_name, - parent_list); - else - gripe_invalid_index1 (); - } - } - - return retval; -} - -octave_value -octave_class::numeric_conv (const Cell& val, const std::string& type) -{ - octave_value retval; - - if (val.length () == 1) - { - retval = val(0); - - if (type.length () > 0 && type[0] == '.' && ! retval.is_map ()) - retval = octave_map (); - } - else - gripe_invalid_index_for_assignment (); - - return retval; -} - -octave_value -octave_class::subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - count++; - return subsasgn_common (octave_value (this), type, idx, rhs); -} - -octave_value -octave_class::undef_subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - // For compatibility with Matlab, pass [] as the first argument to the - // the subsasgn function when the LHS of an indexed assignment is - // undefined. - - return subsasgn_common (Matrix (), type, idx, rhs); -} - -octave_value -octave_class::subsasgn_common (const octave_value& obj, - const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - octave_value retval; - - if (! (in_class_method () || called_from_builtin ())) - { - octave_value meth = symbol_table::find_method ("subsasgn", class_name ()); - - if (meth.is_defined ()) - { - octave_value_list args; - - if (rhs.is_cs_list ()) - { - octave_value_list lrhs = rhs.list_value (); - args.resize (2 + lrhs.length ()); - for (octave_idx_type i = 0; i < lrhs.length (); i++) - args(2+i) = lrhs(i); - } - else - args(2) = rhs; - - args(1) = make_idx_args (type, idx, "subsasgn"); - - if (error_state) - return octave_value_list (); - - args(0) = obj; - - // Now comes the magic. Count copies with me: - // 1. myself (obsolete) - // 2. the copy inside args (obsolete) - // 3. the copy in method's symbol table (working) - // ... possibly more (not obsolete). - // - // So we mark 2 copies as obsolete and hold our fingers crossed. - // But prior to doing that, check whether the routine is amenable - // to the optimization. - // It is essential that the handling function doesn't store extra - // copies anywhere. If it does, things will not break but the - // optimization won't work. - - octave_value_list tmp; - - if (obsolete_copies == 0 && meth.is_user_function () - && meth.user_function_value ()->subsasgn_optimization_ok ()) - { - unwind_protect frame; - frame.protect_var (obsolete_copies); - obsolete_copies = 2; - - tmp = feval (meth.function_value (), args); - } - else - tmp = feval (meth.function_value (), args); - - // FIXME -- should the subsasgn method be able to return - // more than one value? - - if (tmp.length () > 1) - error ("expecting single return value from @%s/subsasgn", - class_name ().c_str ()); - - else - retval = tmp(0); - - return retval; - } - } - - // Find the class in which this method resides before - // attempting to do the indexed assignment. - - std::string method_class = get_current_method_class (); - - octave_base_value *obvp = unique_parent_class (method_class); - if (obvp != this) - { - - if (obvp) - { - obvp->subsasgn (type, idx, rhs); - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - else - error ("malformed class"); - - return retval; - } - - // FIXME -- this block of code is the same as the body of - // octave_struct::subsasgn. Maybe it could be shared instead of - // duplicated. - - int n = type.length (); - - octave_value t_rhs = rhs; - - if (n > 1 && ! (type.length () == 2 && type[0] == '(' && type[1] == '.')) - { - switch (type[0]) - { - case '(': - { - if (type.length () > 1 && type[1] == '.') - { - std::list::const_iterator p = idx.begin (); - octave_value_list t_idx = *p; - - octave_value_list key_idx = *++p; - - assert (key_idx.length () == 1); - - std::string key = key_idx(0).string_value (); - - if (! error_state) - { - octave_value u; - - if (! map.contains (key)) - u = octave_value::empty_conv (type.substr (2), rhs); - else - { - Cell map_val = map.contents (key); - - Cell map_elt = map_val.index (idx.front (), true); - - u = numeric_conv (map_elt, type.substr (2)); - } - - if (! error_state) - { - std::list next_idx (idx); - - // We handled two index elements, so subsasgn to - // needs to skip both of them. - - next_idx.erase (next_idx.begin ()); - next_idx.erase (next_idx.begin ()); - - u.make_unique (); - - t_rhs = u.subsasgn (type.substr (2), next_idx, rhs); - } - } - else - gripe_invalid_index_for_assignment (); - } - else - gripe_invalid_index_for_assignment (); - } - break; - - case '.': - { - octave_value_list key_idx = idx.front (); - - assert (key_idx.length () == 1); - - std::string key = key_idx(0).string_value (); - - std::list next_idx (idx); - - next_idx.erase (next_idx.begin ()); - - std::string next_type = type.substr (1); - - Cell tmpc (1, 1); - octave_map::iterator pkey = map.seek (key); - if (pkey != map.end ()) - { - map.contents (pkey).make_unique (); - tmpc = map.contents (pkey); - } - - // FIXME: better code reuse? - if (! error_state) - { - if (tmpc.numel () == 1) - { - octave_value& tmp = tmpc(0); - - if (! tmp.is_defined () || tmp.is_zero_by_zero ()) - { - tmp = octave_value::empty_conv (next_type, rhs); - tmp.make_unique (); // probably a no-op. - } - else - // optimization: ignore the copy still stored inside our map. - tmp.make_unique (1); - - if (! error_state) - t_rhs = tmp.subsasgn (next_type, next_idx, rhs); - } - else - gripe_indexed_cs_list (); - } - } - break; - - case '{': - gripe_invalid_index_type (type_name (), type[0]); - break; - - default: - panic_impossible (); - } - } - - if (! error_state) - { - switch (type[0]) - { - case '(': - { - if (n > 1 && type[1] == '.') - { - std::list::const_iterator p = idx.begin (); - octave_value_list key_idx = *++p; - - assert (key_idx.length () == 1); - - std::string key = key_idx(0).string_value (); - - if (! error_state) - { - map.assign (idx.front (), key, t_rhs); - - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - else - gripe_failed_assignment (); - } - else - { - if (t_rhs.is_object () || t_rhs.is_map ()) - { - octave_map rhs_map = t_rhs.map_value (); - - if (! error_state) - { - map.assign (idx.front (), rhs_map); - - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - else - error ("invalid class assignment"); - } - else - { - if (t_rhs.is_empty ()) - { - map.delete_elements (idx.front ()); - - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - else - error ("invalid class assignment"); - } - } - } - break; - - case '.': - { - octave_value_list key_idx = idx.front (); - - assert (key_idx.length () == 1); - - std::string key = key_idx(0).string_value (); - - if (t_rhs.is_cs_list ()) - { - Cell tmp_cell = Cell (t_rhs.list_value ()); - - // The shape of the RHS is irrelevant, we just want - // the number of elements to agree and to preserve the - // shape of the left hand side of the assignment. - - if (numel () == tmp_cell.numel ()) - tmp_cell = tmp_cell.reshape (dims ()); - - map.setfield (key, tmp_cell); - } - else - { - Cell tmp_cell(1, 1); - tmp_cell(0) = t_rhs.storable_value (); - map.setfield (key, tmp_cell); - } - - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - break; - - case '{': - gripe_invalid_index_type (type_name (), type[0]); - break; - - default: - panic_impossible (); - } - } - else - gripe_failed_assignment (); - - return retval; -} - -idx_vector -octave_class::index_vector (void) const -{ - idx_vector retval; - - octave_value meth = symbol_table::find_method ("subsindex", class_name ()); - - if (meth.is_defined ()) - { - octave_value_list args; - args(0) = octave_value (new octave_class (map, c_name, parent_list)); - - octave_value_list tmp = feval (meth.function_value (), args, 1); - - if (!error_state && tmp.length () >= 1) - { - if (tmp(0).is_object ()) - error ("subsindex function must return a valid index vector"); - else - // Index vector returned by subsindex is zero based - // (why this inconsistency Mathworks?), and so we must - // add one to the value returned as the index_vector method - // expects it to be one based. - retval = do_binary_op (octave_value::op_add, tmp (0), - octave_value (1.0)).index_vector (); - } - } - else - error ("no subsindex method defined for class %s", - class_name ().c_str ()); - - return retval; -} - -size_t -octave_class::byte_size (void) const -{ - // Neglect the size of the fieldnames. - - size_t retval = 0; - - for (octave_map::const_iterator p = map.begin (); p != map.end (); p++) - { - std::string key = map.key (p); - - octave_value val = octave_value (map.contents (p)); - - retval += val.byte_size (); - } - - return retval; -} - -string_vector -octave_class::map_keys (void) const -{ - string_vector retval; - gripe_wrong_type_arg ("octave_class::map_keys()", type_name ()); - return retval; -} - -octave_base_value * -octave_class::find_parent_class (const std::string& parent_class_name) -{ - octave_base_value* retval = 0; - - if (parent_class_name == class_name ()) - retval = this; - else - { - for (std::list::iterator pit = parent_list.begin (); - pit != parent_list.end (); - pit++) - { - octave_map::const_iterator smap = map.seek (*pit); - - const Cell& tmp = map.contents (smap); - - octave_value vtmp = tmp(0); - - octave_base_value *obvp = vtmp.internal_rep (); - - retval = obvp->find_parent_class (parent_class_name); - - if (retval) - break; - } - } - - return retval; -} - -octave_base_value * -octave_class::unique_parent_class (const std::string& parent_class_name) -{ - octave_base_value* retval = 0; - - if (parent_class_name == class_name ()) - retval = this; - else - { - for (std::list::iterator pit = parent_list.begin (); - pit != parent_list.end (); - pit++) - { - octave_map::iterator smap = map.seek (*pit); - - Cell& tmp = map.contents (smap); - - octave_value& vtmp = tmp(0); - - octave_base_value *obvp = vtmp.internal_rep (); - - // Use find_parent_class first to avoid uniquifying if not necessary. - retval = obvp->find_parent_class (parent_class_name); - - if (retval) - { - vtmp.make_unique (); - obvp = vtmp.internal_rep (); - retval = obvp->unique_parent_class (parent_class_name); - - break; - } - } - } - - return retval; -} - -string_vector -octave_class::all_strings (bool pad) const -{ - string_vector retval; - - octave_value meth = symbol_table::find_method ("char", class_name ()); - - if (meth.is_defined ()) - { - octave_value_list args; - args(0) = octave_value (new octave_class (map, c_name, parent_list)); - - octave_value_list tmp = feval (meth.function_value (), args, 1); - - if (!error_state && tmp.length () >= 1) - { - if (tmp(0).is_string ()) - retval = tmp(0).all_strings (pad); - else - error ("cname/char method did not return a character string"); - } - } - else - error ("no char method defined for class %s", class_name ().c_str ()); - - return retval; -} - - -void -octave_class::print (std::ostream& os, bool) const -{ - print_raw (os); -} - -void -octave_class::print_raw (std::ostream& os, bool) const -{ - unwind_protect frame; - - indent (os); - os << " "; - newline (os); -} - -bool -octave_class::print_name_tag (std::ostream& os, const std::string& name) const -{ - bool retval = false; - - indent (os); - os << name << " ="; - newline (os); - if (! Vcompact_format) - newline (os); - - return retval; -} - -void -octave_class::print_with_name (std::ostream& os, const std::string& name, - bool) -{ - octave_value fcn = symbol_table::find_method ("display", class_name ()); - - if (fcn.is_defined ()) - { - octave_value_list args; - - count++; - args(0) = octave_value (this); - - string_vector arg_names (1); - - arg_names[0] = name; - - args.stash_name_tags (arg_names); - - feval (fcn.function_value (), args); - } - else - { - indent (os); - os << name << " = "; - newline (os); - } -} - -// Loading a class properly requires an exemplar map entry for success. -// If we don't have one, we attempt to create one by calling the constructor -// with no arguments. -bool -octave_class::reconstruct_exemplar (void) -{ - bool retval = false; - - octave_class::exemplar_const_iterator it - = octave_class::exemplar_map.find (c_name); - - if (it != octave_class::exemplar_map.end ()) - retval = true; - else - { - octave_value ctor = symbol_table::find_method (c_name, c_name); - - bool have_ctor = false; - - if (ctor.is_defined () && ctor.is_function ()) - { - octave_function *fcn = ctor.function_value (); - - if (fcn && fcn->is_class_constructor (c_name)) - have_ctor = true; - - // Something has gone terribly wrong if - // symbol_table::find_method (c_name, c_name) does not return - // a class constructor for the class c_name... - assert (have_ctor); - } - - if (have_ctor) - { - octave_value_list result - = ctor.do_multi_index_op (1, octave_value_list ()); - - if (result.length () == 1) - retval = true; - else - warning ("call to constructor for class %s failed", c_name.c_str ()); - } - else - warning ("no constructor for class %s", c_name.c_str ()); - } - - return retval; -} - -void -octave_class::clear_exemplar_map (void) -{ - exemplar_map.clear (); -} - -// Load/save does not provide enough information to reconstruct the -// class inheritance structure. reconstruct_parents () attempts to -// do so. If successful, a "true" value is returned. -// -// Note that we don't check the loaded object structure against the -// class structure here so the user's loadobj method has a chance -// to do its magic. -bool -octave_class::reconstruct_parents (void) -{ - bool retval = true, might_have_inheritance = false; - std::string dbgstr = "dork"; - - // First, check to see if there might be an issue with inheritance. - for (octave_map::const_iterator p = map.begin (); p != map.end (); p++) - { - std::string key = map.key (p); - Cell val = map.contents (p); - if ( val(0).is_object () ) - { - dbgstr = "blork"; - if ( key == val(0).class_name () ) - { - might_have_inheritance = true; - dbgstr = "cork"; - break; - } - } - } - - if (might_have_inheritance) - { - octave_class::exemplar_const_iterator it - = octave_class::exemplar_map.find (c_name); - - if (it == octave_class::exemplar_map.end ()) - retval = false; - else - { - octave_class::exemplar_info exmplr = it->second; - parent_list = exmplr.parents (); - for (std::list::iterator pit = parent_list.begin (); - pit != parent_list.end (); - pit++) - { - dbgstr = *pit; - bool dbgbool = map.contains (*pit); - if (!dbgbool) - { - retval = false; - break; - } - } - } - } - - return retval; -} - -bool -octave_class::save_ascii (std::ostream& os) -{ - os << "# classname: " << class_name () << "\n"; - octave_map m; - if (load_path::find_method (class_name (), "saveobj") != std::string ()) - { - octave_value in = new octave_class (*this); - octave_value_list tmp = feval ("saveobj", in, 1); - if (! error_state) - m = tmp(0).map_value (); - else - return false; - } - else - m = map_value (); - - os << "# length: " << m.nfields () << "\n"; - - octave_map::iterator i = m.begin (); - while (i != m.end ()) - { - octave_value val = map.contents (i); - - bool b = save_ascii_data (os, val, m.key (i), false, 0); - - if (! b) - return os; - - i++; - } - - return true; -} - -bool -octave_class::load_ascii (std::istream& is) -{ - octave_idx_type len = 0; - std::string classname; - bool success = true; - - if (extract_keyword (is, "classname", classname) && classname != "") - { - if (extract_keyword (is, "length", len) && len >= 0) - { - if (len > 0) - { - octave_map m (map); - - for (octave_idx_type j = 0; j < len; j++) - { - octave_value t2; - bool dummy; - - // recurse to read cell elements - std::string nm - = read_ascii_data (is, std::string (), dummy, t2, j); - - if (! is) - break; - - Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); - - if (error_state) - { - error ("load: internal error loading class elements"); - return false; - } - - m.assign (nm, tcell); - } - - if (is) - { - c_name = classname; - reconstruct_exemplar (); - - map = m; - - if (! reconstruct_parents ()) - warning ("load: unable to reconstruct object inheritance"); - else - { - if (load_path::find_method (classname, "loadobj") - != std::string ()) - { - octave_value in = new octave_class (*this); - octave_value_list tmp = feval ("loadobj", in, 1); - - if (! error_state) - map = tmp(0).map_value (); - else - success = false; - } - } - } - else - { - error ("load: failed to load class"); - success = false; - } - } - else if (len == 0 ) - { - map = octave_map (dim_vector (1, 1)); - c_name = classname; - } - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of elements in class"); - success = false; - } - } - else - { - error ("load: failed to extract name of class"); - success = false; - } - - return success; -} - -bool -octave_class::save_binary (std::ostream& os, bool& save_as_floats) -{ - int32_t classname_len = class_name ().length (); - - os.write (reinterpret_cast (&classname_len), 4); - os << class_name (); - - octave_map m; - if (load_path::find_method (class_name (), "saveobj") != std::string ()) - { - octave_value in = new octave_class (*this); - octave_value_list tmp = feval ("saveobj", in, 1); - if (! error_state) - m = tmp(0).map_value (); - else - return false; - } - else - m = map_value (); - - int32_t len = m.nfields (); - os.write (reinterpret_cast (&len), 4); - - octave_map::iterator i = m.begin (); - while (i != m.end ()) - { - octave_value val = map.contents (i); - - bool b = save_binary_data (os, val, m.key (i), "", 0, save_as_floats); - - if (! b) - return os; - - i++; - } - - return true; -} - -bool -octave_class::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - bool success = true; - - int32_t classname_len; - - is.read (reinterpret_cast (&classname_len), 4); - if (! is) - return false; - else if (swap) - swap_bytes<4> (&classname_len); - - { - OCTAVE_LOCAL_BUFFER (char, classname, classname_len+1); - classname[classname_len] = '\0'; - if (! is.read (reinterpret_cast (classname), classname_len)) - return false; - c_name = classname; - } - reconstruct_exemplar (); - - int32_t len; - if (! is.read (reinterpret_cast (&len), 4)) - return false; - if (swap) - swap_bytes<4> (&len); - - if (len > 0) - { - octave_map m (map); - - for (octave_idx_type j = 0; j < len; j++) - { - octave_value t2; - bool dummy; - std::string doc; - - // recurse to read cell elements - std::string nm = read_binary_data (is, swap, fmt, std::string (), - dummy, t2, doc); - - if (! is) - break; - - Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); - - if (error_state) - { - error ("load: internal error loading class elements"); - return false; - } - - m.assign (nm, tcell); - } - - if (is) - { - map = m; - - if (! reconstruct_parents ()) - warning ("load: unable to reconstruct object inheritance"); - else - { - if (load_path::find_method (c_name, "loadobj") != std::string ()) - { - octave_value in = new octave_class (*this); - octave_value_list tmp = feval ("loadobj", in, 1); - - if (! error_state) - map = tmp(0).map_value (); - else - success = false; - } - } - } - else - { - warning ("load: failed to load class"); - success = false; - } - } - else if (len == 0 ) - map = octave_map (dim_vector (1, 1)); - else - panic_impossible (); - - return success; -} - -#if defined (HAVE_HDF5) - -bool -octave_class::save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) -{ - hsize_t hdims[3]; - hid_t group_hid = -1; - hid_t type_hid = -1; - hid_t space_hid = -1; - hid_t class_hid = -1; - hid_t data_hid = -1; - octave_map m; - octave_map::iterator i; - -#if HAVE_HDF5_18 - group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - group_hid = H5Gcreate (loc_id, name, 0); -#endif - if (group_hid < 0) - goto error_cleanup; - - // Add the class name to the group - type_hid = H5Tcopy (H5T_C_S1); H5Tset_size (type_hid, c_name.length () + 1); - if (type_hid < 0) - goto error_cleanup; - - hdims[0] = 0; - space_hid = H5Screate_simple (0 , hdims, 0); - if (space_hid < 0) - goto error_cleanup; -#if HAVE_HDF5_18 - class_hid = H5Dcreate (group_hid, "classname", type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - class_hid = H5Dcreate (group_hid, "classname", type_hid, space_hid, - H5P_DEFAULT); -#endif - if (class_hid < 0 || H5Dwrite (class_hid, type_hid, H5S_ALL, H5S_ALL, - H5P_DEFAULT, c_name.c_str ()) < 0) - goto error_cleanup; - -#if HAVE_HDF5_18 - data_hid = H5Gcreate (group_hid, "value", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Gcreate (group_hid, "value", 0); -#endif - if (data_hid < 0) - goto error_cleanup; - - if (load_path::find_method (class_name (), "saveobj") != std::string ()) - { - octave_value in = new octave_class (*this); - octave_value_list tmp = feval ("saveobj", in, 1); - if (! error_state) - m = tmp(0).map_value (); - else - goto error_cleanup; - } - else - m = map_value (); - - // recursively add each element of the class to this group - i = m.begin (); - while (i != m.end ()) - { - octave_value val = map.contents (i); - - bool retval2 = add_hdf5_data (data_hid, val, m.key (i), "", false, - save_as_floats); - - if (! retval2) - break; - - i++; - } - - error_cleanup: - - if (data_hid > 0) - H5Gclose (data_hid); - - if (class_hid > 0) - H5Dclose (class_hid); - - if (space_hid > 0) - H5Sclose (space_hid); - - if (type_hid > 0) - H5Tclose (type_hid); - - if (group_hid > 0) - H5Gclose (group_hid); - - return true; -} - -bool -octave_class::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; - - hid_t group_hid = -1; - hid_t data_hid = -1; - hid_t type_hid = -1; - hid_t type_class_hid = -1; - hid_t space_hid = -1; - hid_t subgroup_hid = -1; - hid_t st_id = -1; - - hdf5_callback_data dsub; - - herr_t retval2 = 0; - octave_map m (dim_vector (1, 1)); - int current_item = 0; - hsize_t num_obj = 0; - int slen = 0; - hsize_t rank = 0; - -#if HAVE_HDF5_18 - group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); -#else - group_hid = H5Gopen (loc_id, name); -#endif - if (group_hid < 0) - goto error_cleanup; - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "classname", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "classname"); -#endif - - if (data_hid < 0) - goto error_cleanup; - - type_hid = H5Dget_type (data_hid); - - type_class_hid = H5Tget_class (type_hid); - - if (type_class_hid != H5T_STRING) - goto error_cleanup; - - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - goto error_cleanup; - - slen = H5Tget_size (type_hid); - if (slen < 0) - goto error_cleanup; - - // do-while loop here to prevent goto crossing initialization of classname - do - { - OCTAVE_LOCAL_BUFFER (char, classname, slen); - - // create datatype for (null-terminated) string to read into: - st_id = H5Tcopy (H5T_C_S1); - H5Tset_size (st_id, slen); - - if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, - classname) < 0) - { - H5Tclose (st_id); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Tclose (st_id); - H5Dclose (data_hid); - data_hid = -1; - - c_name = classname; - } - while (0); - reconstruct_exemplar (); - -#if HAVE_HDF5_18 - subgroup_hid = H5Gopen (group_hid, name, H5P_DEFAULT); -#else - subgroup_hid = H5Gopen (group_hid, name); -#endif - H5Gget_num_objs (subgroup_hid, &num_obj); - H5Gclose (subgroup_hid); - - while (current_item < static_cast (num_obj) - && (retval2 = H5Giterate (group_hid, name, ¤t_item, - hdf5_read_next_data, &dsub)) > 0) - { - octave_value t2 = dsub.tc; - - Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); - - if (error_state) - { - error ("load: internal error loading class elements"); - return false; - } - - m.assign (dsub.name, tcell); - - } - - if (retval2 >= 0) - { - map = m; - - if (!reconstruct_parents ()) - warning ("load: unable to reconstruct object inheritance"); - else - { - if (load_path::find_method (c_name, "loadobj") != std::string ()) - { - octave_value in = new octave_class (*this); - octave_value_list tmp = feval ("loadobj", in, 1); - - if (! error_state) - { - map = tmp(0).map_value (); - retval = true; - } - else - retval = false; - } - else - retval = true; - } - } - - error_cleanup: - if (data_hid > 0) - H5Dclose (data_hid); - - if (data_hid > 0) - H5Gclose (group_hid); - - return retval; -} - -#endif - -mxArray * -octave_class::as_mxArray (void) const -{ - gripe_wrong_type_arg ("octave_class::as_mxArray ()", type_name ()); - - return 0; -} - -bool -octave_class::in_class_method (void) -{ - octave_function *fcn = octave_call_stack::current (); - - return (fcn - && (fcn->is_class_method () - || fcn->is_class_constructor () - || fcn->is_anonymous_function_of_class () - || fcn->is_private_function_of_class (class_name ())) - && find_parent_class (fcn->dispatch_class ())); -} - -octave_class::exemplar_info::exemplar_info (const octave_value& obj) - : field_names (), parent_class_names () -{ - if (obj.is_object ()) - { - octave_map m = obj.map_value (); - field_names = m.keys (); - - parent_class_names = obj.parent_class_name_list (); - } - else - error ("invalid call to exemplar_info constructor"); -} - - -// A map from class names to lists of fields. -std::map octave_class::exemplar_map; - -bool -octave_class::exemplar_info::compare (const octave_value& obj) const -{ - bool retval = true; - - if (obj.is_object ()) - { - if (nfields () == obj.nfields ()) - { - octave_map obj_map = obj.map_value (); - string_vector obj_fnames = obj_map.keys (); - string_vector fnames = fields (); - - for (octave_idx_type i = 0; i < nfields (); i++) - { - if (obj_fnames[i] != fnames[i]) - { - retval = false; - error ("mismatch in field names"); - break; - } - } - - if (nparents () == obj.nparents ()) - { - std::list obj_parents - = obj.parent_class_name_list (); - std::list pnames = parents (); - - std::list::const_iterator p = obj_parents.begin (); - std::list::const_iterator q = pnames.begin (); - - while (p != obj_parents.end ()) - { - if (*p++ != *q++) - { - retval = false; - error ("mismatch in parent classes"); - break; - } - } - } - else - { - retval = false; - error ("mismatch in number of parent classes"); - } - } - else - { - retval = false; - error ("mismatch in number of fields"); - } - } - else - { - retval = false; - error ("invalid comparison of class exemplar to non-class object"); - } - - return retval; -} - -DEFUN (class, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} class (@var{expr})\n\ -@deftypefnx {Built-in Function} {} class (@var{s}, @var{id})\n\ -@deftypefnx {Built-in Function} {} class (@var{s}, @var{id}, @var{p}, @dots{})\n\ -Return the class of the expression @var{expr} or create a class with\n\ -fields from structure @var{s} and name (string) @var{id}. Additional\n\ -arguments name a list of parent classes from which the new class is\n\ -derived.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - print_usage (); - else if (nargin == 1) - retval = args(0).class_name (); - else - { - octave_function *fcn = octave_call_stack::caller (); - - std::string id = args(1).string_value (); - - if (! error_state) - { - if (fcn) - { - if (fcn->is_class_constructor (id) || fcn->is_class_method (id)) - { - octave_map m = args(0).map_value (); - - if (! error_state) - { - if (nargin == 2) - retval - = octave_value (new octave_class - (m, id, std::list ())); - else - { - octave_value_list parents = args.slice (2, nargin-2); - - retval - = octave_value (new octave_class (m, id, parents)); - } - - if (! error_state) - { - octave_class::exemplar_const_iterator it - = octave_class::exemplar_map.find (id); - - if (it == octave_class::exemplar_map.end ()) - octave_class::exemplar_map[id] - = octave_class::exemplar_info (retval); - else if (! it->second.compare (retval)) - error ("class: object of class `%s' does not match previously constructed objects", - id.c_str ()); - } - } - else - error ("class: expecting structure S as first argument"); - } - else - error ("class: `%s' is invalid as a class name in this context", - id.c_str ()); - } - else - error ("class: invalid call from outside class constructor or method"); - } - else - error ("class: ID (class name) must be a character string"); - } - - return retval; -} - -DEFUN (__isa_parent__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __isa_parent__ (@var{class}, @var{name})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 2) - { - octave_value cls = args(0); - octave_value nm = args(1); - - if (! error_state) - { - if (cls.find_parent_class (nm.string_value ())) - retval = true; - } - else - error ("__isa_parent__: expecting arguments to be character strings"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__parent_classes__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __parent_classes__ (@var{x})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval = Cell (); - - if (args.length () == 1) - { - octave_value arg = args(0); - - if (arg.is_object ()) - retval = Cell (arg.parent_class_names ()); - } - else - print_usage (); - - return retval; -} - -DEFUN (isobject, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isobject (@var{x})\n\ -Return true if @var{x} is a class object.\n\ -@seealso{class, typeinfo, isa, ismethod}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_object (); - else - print_usage (); - - return retval; -} - -DEFUN (ismethod, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ismethod (@var{x}, @var{method})\n\ -Return true if @var{x} is a class object and the string @var{method}\n\ -is a method of this class.\n\ -@seealso{isobject}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - octave_value arg = args(0); - - std::string class_name; - - if (arg.is_object ()) - class_name = arg.class_name (); - else if (arg.is_string ()) - class_name = arg.string_value (); - else - error ("ismethod: expecting object or class name as first argument"); - - if (! error_state) - { - std::string method = args(1).string_value (); - - if (! error_state) - { - if (load_path::find_method (class_name, method) != std::string ()) - retval = true; - else - retval = false; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (methods, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} methods (@var{x})\n\ -@deftypefnx {Built-in Function} {} methods (\"classname\")\n\ -Return a cell array containing the names of the methods for the\n\ -object @var{x} or the named class.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - octave_value arg = args(0); - - std::string class_name; - - if (arg.is_object ()) - class_name = arg.class_name (); - else if (arg.is_string ()) - class_name = arg.string_value (); - else - error ("methods: expecting object or class name as argument"); - - if (! error_state) - { - string_vector sv = load_path::methods (class_name); - - if (nargout == 0) - { - octave_stdout << "Methods for class " << class_name << ":\n\n"; - - sv.list_in_columns (octave_stdout); - - octave_stdout << std::endl; - } - else - retval = Cell (sv); - } - } - else - print_usage (); - - return retval; -} - -static bool -is_built_in_class (const std::string& cn) -{ - static std::set built_in_class_names; - - if (built_in_class_names.empty ()) - { - built_in_class_names.insert ("double"); - built_in_class_names.insert ("single"); - built_in_class_names.insert ("cell"); - built_in_class_names.insert ("struct"); - built_in_class_names.insert ("logical"); - built_in_class_names.insert ("char"); - built_in_class_names.insert ("function handle"); - built_in_class_names.insert ("int8"); - built_in_class_names.insert ("uint8"); - built_in_class_names.insert ("int16"); - built_in_class_names.insert ("uint16"); - built_in_class_names.insert ("int32"); - built_in_class_names.insert ("uint32"); - built_in_class_names.insert ("int64"); - built_in_class_names.insert ("uint64"); - } - - return built_in_class_names.find (cn) != built_in_class_names.end (); -} - -DEFUN (superiorto, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} superiorto (@var{class_name}, @dots{})\n\ -When called from a class constructor, mark the object currently\n\ -constructed as having a higher precedence than @var{class_name}.\n\ -More that one such class can be specified in a single call.\n\ -This function may only be called from a class constructor.\n\ -@end deftypefn") -{ - octave_value retval; - - octave_function *fcn = octave_call_stack::caller (); - - if (fcn && fcn->is_class_constructor ()) - { - for (int i = 0; i < args.length (); i++) - { - std::string class_name = args(i).string_value (); - - if (! error_state) - { - if (! is_built_in_class (class_name)) - { - std::string this_class_name = fcn->name (); - - if (! symbol_table::set_class_relationship (this_class_name, - class_name)) - { - error ("superiorto: precedence already set for %s and %s", - this_class_name.c_str (), class_name.c_str ()); - break; - } - } - else - { - // User defined classes always have higher precedence - // than built-in classes. - } - } - else - { - error ("superiorto: expecting argument to be class name"); - break; - } - } - } - else - error ("superiorto: invalid call from outside class constructor"); - - return retval; -} - -DEFUN (inferiorto, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} inferiorto (@var{class_name}, @dots{})\n\ -When called from a class constructor, mark the object currently\n\ -constructed as having a lower precedence than @var{class_name}.\n\ -More that one such class can be specified in a single call.\n\ -This function may only be called from a class constructor.\n\ -@end deftypefn") -{ - octave_value retval; - - octave_function *fcn = octave_call_stack::caller (); - - if (fcn && fcn->is_class_constructor ()) - { - for (int i = 0; i < args.length (); i++) - { - std::string class_name = args(i).string_value (); - - if (! error_state) - { - if (! is_built_in_class (class_name)) - { - std::string this_class_name = fcn->name (); - - symbol_table::set_class_relationship (class_name, - this_class_name); - - if (! symbol_table::set_class_relationship (this_class_name, - class_name)) - { - error ("inferiorto: precedence already set for %s and %s", - this_class_name.c_str (), class_name.c_str ()); - break; - } - } - else - { - error ("inferiorto: cannot give user-defined class lower precedence than built-in class"); - break; - } - } - else - { - error ("inferiorto: expecting argument to be class name"); - break; - } - } - } - else - error ("inferiorto: invalid call from outside class constructor"); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/ov-class.h --- a/src/ov-class.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,285 +0,0 @@ -/* - -Copyright (C) 2007-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_class_h) -#define octave_class_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-alloc.h" -#include "oct-map.h" -#include "ov-base.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// Data structures. - -class -octave_class : public octave_base_value -{ -public: - - octave_class (void) - : octave_base_value (), map (), c_name (), - parent_list (), obsolete_copies (0) - { } - - octave_class (const octave_map& m, const std::string& id, - const std::list& plist) - : octave_base_value (), map (m), c_name (id), - parent_list (plist), obsolete_copies (0) - { } - - octave_class (const octave_map& m, const std::string& id, - const octave_value_list& parents); - - octave_class (const octave_class& s) - : octave_base_value (s), map (s.map), c_name (s.c_name), - parent_list (s.parent_list), obsolete_copies (0) { } - - ~octave_class (void) { } - - octave_base_value *clone (void) const { return new octave_class (*this); } - - octave_base_value *unique_clone (void); - - octave_base_value *empty_clone (void) const - { - return new octave_class (octave_map (map.keys ()), c_name, parent_list); - } - - Cell dotref (const octave_value_list& idx); - - Matrix size (void); - - octave_idx_type numel (const octave_value_list&); - - octave_value subsref (const std::string& type, - const std::list& idx) - { - octave_value_list tmp = subsref (type, idx, 1); - return tmp.length () > 0 ? tmp(0) : octave_value (); - } - - octave_value_list subsref (const std::string& type, - const std::list& idx, - int nargout); - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& idx) - { - return subsref ("(", std::list (1, idx), nargout); - } - - static octave_value numeric_conv (const Cell& val, - const std::string& type); - - void assign(const std::string& k, const octave_value& rhs) - { map.assign (k, rhs); }; - - octave_value subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - octave_value undef_subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - idx_vector index_vector (void) const; - - dim_vector dims (void) const { return map.dims (); } - - size_t byte_size (void) const; - - // This is the number of elements in each field. The total number - // of elements is numel () * nfields (). - octave_idx_type numel (void) const - { - dim_vector dv = dims (); - return dv.numel (); - } - - octave_idx_type nfields (void) const { return map.nfields (); } - - size_t nparents (void) const { return parent_list.size (); } - - octave_value reshape (const dim_vector& new_dims) const - { - octave_class retval = octave_class (*this); - retval.map = retval.map_value ().reshape (new_dims); - return octave_value (new octave_class (retval)); - } - - octave_value resize (const dim_vector& dv, bool = false) const - { - octave_class retval = octave_class (*this); - retval.map.resize (dv); - return octave_value (new octave_class (retval)); - } - - bool is_defined (void) const { return true; } - - bool is_map (void) const { return false; } - - bool is_object (void) const { return true; } - - octave_map map_value (void) const { return map; } - - string_vector map_keys (void) const; - - std::list parent_class_name_list (void) const - { return parent_list; } - - string_vector parent_class_names (void) const - { return string_vector (parent_list); } - - octave_base_value *find_parent_class (const std::string&); - - octave_base_value *unique_parent_class (const std::string&); - - string_vector all_strings (bool pad) const; - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool print_name_tag (std::ostream& os, const std::string& name) const; - - void print_with_name (std::ostream& os, const std::string& name, - bool print_padding = true); - - bool reconstruct_exemplar (void); - - static void clear_exemplar_map (void); - - bool reconstruct_parents (void); - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - mxArray *as_mxArray (void) const; - -private: - - octave_map map; - - DECLARE_OCTAVE_ALLOCATOR - -public: - int type_id (void) const { return t_id; } - std::string type_name (void) const { return t_name; } - std::string class_name (void) const { return c_name; } - - static int static_type_id (void) { return t_id; } - static std::string static_type_name (void) { return t_name; } - static std::string static_class_name (void) { return ""; } - static void register_type (void); - -private: - static int t_id; - - static const std::string t_name; - std::string c_name; - std::list parent_list; - - bool in_class_method (void); - std::string get_current_method_class (void); - - octave_value subsasgn_common (const octave_value& obj, - const std::string& type, - const std::list& idx, - const octave_value& rhs); - - int obsolete_copies; - -public: - // The list of field names and parent classes defines a class. We - // keep track of each class that has been created so that we know - class exemplar_info - { - public: - - exemplar_info (void) : field_names (), parent_class_names () { } - - exemplar_info (const octave_value& obj); - - exemplar_info (const exemplar_info& x) - : field_names (x.field_names), - parent_class_names (x.parent_class_names) { } - - exemplar_info& operator = (const exemplar_info& x) - { - if (&x != this) - { - field_names = x.field_names; - parent_class_names = x.parent_class_names; - } - return *this; - } - - octave_idx_type nfields (void) const { return field_names.length (); } - - size_t nparents (void) const { return parent_class_names.size (); } - - string_vector fields (void) const { return field_names; } - - std::list parents (void) const { return parent_class_names; } - - bool compare (const octave_value& obj) const; - - private: - - string_vector field_names; - std::list parent_class_names; - }; - - // A map from class names to lists of fields. - static std::map exemplar_map; - - typedef std::map::iterator exemplar_iterator; - typedef std::map::const_iterator exemplar_const_iterator; -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-colon.cc --- a/src/ov-colon.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,48 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "error.h" -#include "pr-output.h" -#include "oct-obj.h" -#include "ov-colon.h" - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_magic_colon, - "magic-colon", "magic-colon"); - -void -octave_magic_colon::print (std::ostream& os, bool) const -{ - indent (os); - print_raw (os); -} - -void -octave_magic_colon::print_raw (std::ostream& os, bool) const -{ - os << ":"; -} diff -r d02b229ce693 -r a132d206a36a src/ov-colon.h --- a/src/ov-colon.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,77 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_magic_colon_h) -#define octave_magic_colon_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "str-vec.h" - -#include "error.h" -#include "ov-base.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// A type to represent `:' as used for indexing. - -class -octave_magic_colon : public octave_base_value -{ -public: - - octave_magic_colon (void) - : octave_base_value () { } - - octave_magic_colon (const octave_magic_colon&) - : octave_base_value () { } - - ~octave_magic_colon (void) { } - - octave_base_value *clone (void) const { return new octave_magic_colon (*this); } - octave_base_value *empty_clone (void) const { return new octave_magic_colon (); } - - idx_vector index_vector (void) const { return idx_vector (':'); } - - bool is_defined (void) const { return true; } - - bool is_constant (void) const { return true; } - - bool is_magic_colon (void) const { return true; } - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - -private: - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-complex.cc --- a/src/ov-complex.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,463 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "lo-ieee.h" -#include "lo-specfun.h" -#include "lo-mappers.h" - -#include "oct-obj.h" -#include "oct-stream.h" -#include "ops.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-base.h" -#include "ov-base-scalar.h" -#include "ov-base-scalar.cc" -#include "ov-cx-mat.h" -#include "ov-scalar.h" -#include "gripes.h" -#include "pr-output.h" -#include "ops.h" - -#include "ls-oct-ascii.h" -#include "ls-hdf5.h" - -template class octave_base_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_complex); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_complex, - "complex scalar", "double"); - -static octave_base_value * -default_numeric_demotion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_complex&); - - return new octave_float_complex (v.float_complex_value ()); -} - -octave_base_value::type_conv_info -octave_complex::numeric_demotion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_demotion_function, - octave_float_complex::static_type_id ()); -} - -octave_base_value * -octave_complex::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - double im = std::imag (scalar); - - if (im == 0.0) - retval = new octave_scalar (std::real (scalar)); - - return retval; -} - -octave_value -octave_complex::do_index_op (const octave_value_list& idx, bool resize_ok) -{ - // FIXME -- this doesn't solve the problem of - // - // a = i; a([1,1], [1,1], [1,1]) - // - // and similar constructions. Hmm... - - // FIXME -- using this constructor avoids narrowing the - // 1x1 matrix back to a scalar value. Need a better solution - // to this problem. - - octave_value tmp (new octave_complex_matrix (complex_matrix_value ())); - - return tmp.do_index_op (idx, resize_ok); -} - -double -octave_complex::double_value (bool force_conversion) const -{ - double retval = lo_ieee_nan_value (); - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real scalar"); - - retval = std::real (scalar); - - return retval; -} - -float -octave_complex::float_value (bool force_conversion) const -{ - float retval = lo_ieee_float_nan_value (); - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real scalar"); - - retval = std::real (scalar); - - return retval; -} - -Matrix -octave_complex::matrix_value (bool force_conversion) const -{ - Matrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real matrix"); - - retval = Matrix (1, 1, std::real (scalar)); - - return retval; -} - -FloatMatrix -octave_complex::float_matrix_value (bool force_conversion) const -{ - FloatMatrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real matrix"); - - retval = FloatMatrix (1, 1, std::real (scalar)); - - return retval; -} - -NDArray -octave_complex::array_value (bool force_conversion) const -{ - NDArray retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real matrix"); - - retval = NDArray (dim_vector (1, 1), std::real (scalar)); - - return retval; -} - -FloatNDArray -octave_complex::float_array_value (bool force_conversion) const -{ - FloatNDArray retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real matrix"); - - retval = FloatNDArray (dim_vector (1, 1), std::real (scalar)); - - return retval; -} - -Complex -octave_complex::complex_value (bool) const -{ - return scalar; -} - -FloatComplex -octave_complex::float_complex_value (bool) const -{ - return static_cast (scalar); -} - -ComplexMatrix -octave_complex::complex_matrix_value (bool) const -{ - return ComplexMatrix (1, 1, scalar); -} - -FloatComplexMatrix -octave_complex::float_complex_matrix_value (bool) const -{ - return FloatComplexMatrix (1, 1, static_cast (scalar)); -} - -ComplexNDArray -octave_complex::complex_array_value (bool /* force_conversion */) const -{ - return ComplexNDArray (dim_vector (1, 1), scalar); -} - -FloatComplexNDArray -octave_complex::float_complex_array_value (bool /* force_conversion */) const -{ - return FloatComplexNDArray (dim_vector (1, 1), static_cast (scalar)); -} - -octave_value -octave_complex::resize (const dim_vector& dv, bool fill) const -{ - if (fill) - { - ComplexNDArray retval (dv, Complex (0)); - - if (dv.numel ()) - retval(0) = scalar; - - return retval; - } - else - { - ComplexNDArray retval (dv); - - if (dv.numel ()) - retval(0) = scalar; - - return retval; - } -} - -octave_value -octave_complex::diag (octave_idx_type m, octave_idx_type n) const -{ - return ComplexDiagMatrix (Array (dim_vector (1, 1), scalar), m, n); -} - -bool -octave_complex::save_ascii (std::ostream& os) -{ - Complex c = complex_value (); - - octave_write_complex (os, c); - - os << "\n"; - - return true; -} - -bool -octave_complex::load_ascii (std::istream& is) -{ - scalar = octave_read_value (is); - - if (!is) - { - error ("load: failed to load complex scalar constant"); - return false; - } - - return true; -} - - -bool -octave_complex::save_binary (std::ostream& os, bool& /* save_as_floats */) -{ - char tmp = static_cast (LS_DOUBLE); - os.write (reinterpret_cast (&tmp), 1); - Complex ctmp = complex_value (); - os.write (reinterpret_cast (&ctmp), 16); - - return true; -} - -bool -octave_complex::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - char tmp; - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - - Complex ctmp; - read_doubles (is, reinterpret_cast (&ctmp), - static_cast (tmp), 2, swap, fmt); - if (error_state || ! is) - return false; - - scalar = ctmp; - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_complex::save_hdf5 (hid_t loc_id, const char *name, - bool /* save_as_floats */) -{ - hsize_t dimens[3]; - hid_t space_hid = -1, type_hid = -1, data_hid = -1; - bool retval = true; - - space_hid = H5Screate_simple (0, dimens, 0); - if (space_hid < 0) - return false; - - type_hid = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); - if (type_hid < 0) - { - H5Sclose (space_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - return false; - } - - Complex tmp = complex_value (); - retval = H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, H5P_DEFAULT, - &tmp) >= 0; - - H5Dclose (data_hid); - H5Tclose (type_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_complex::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t type_hid = H5Dget_type (data_hid); - - hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); - - if (! hdf5_types_compatible (type_hid, complex_type)) - { - H5Tclose (complex_type); - H5Dclose (data_hid); - return false; - } - - hid_t space_id = H5Dget_space (data_hid); - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank != 0) - { - H5Tclose (complex_type); - H5Sclose (space_id); - H5Dclose (data_hid); - return false; - } - - // complex scalar: - Complex ctmp; - if (H5Dread (data_hid, complex_type, H5S_ALL, H5S_ALL, H5P_DEFAULT, - &ctmp) >= 0) - { - retval = true; - scalar = ctmp; - } - - H5Tclose (complex_type); - H5Sclose (space_id); - H5Dclose (data_hid); - - return retval; -} - -#endif - -mxArray * -octave_complex::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxDOUBLE_CLASS, 1, 1, mxCOMPLEX); - - double *pr = static_cast (retval->get_data ()); - double *pi = static_cast (retval->get_imag_data ()); - - pr[0] = std::real (scalar); - pi[0] = std::imag (scalar); - - return retval; -} - -octave_value -octave_complex::map (unary_mapper_t umap) const -{ - switch (umap) - { -#define SCALAR_MAPPER(UMAP, FCN) \ - case umap_ ## UMAP: \ - return octave_value (FCN (scalar)) - - SCALAR_MAPPER (abs, std::abs); - SCALAR_MAPPER (acos, ::acos); - SCALAR_MAPPER (acosh, ::acosh); - SCALAR_MAPPER (angle, std::arg); - SCALAR_MAPPER (arg, std::arg); - SCALAR_MAPPER (asin, ::asin); - SCALAR_MAPPER (asinh, ::asinh); - SCALAR_MAPPER (atan, ::atan); - SCALAR_MAPPER (atanh, ::atanh); - SCALAR_MAPPER (ceil, ::ceil); - SCALAR_MAPPER (conj, std::conj); - SCALAR_MAPPER (cos, std::cos); - SCALAR_MAPPER (cosh, std::cosh); - SCALAR_MAPPER (exp, std::exp); - SCALAR_MAPPER (expm1, ::expm1); - SCALAR_MAPPER (fix, ::fix); - SCALAR_MAPPER (floor, ::floor); - SCALAR_MAPPER (imag, std::imag); - SCALAR_MAPPER (log, std::log); - SCALAR_MAPPER (log2, xlog2); - SCALAR_MAPPER (log10, std::log10); - SCALAR_MAPPER (log1p, ::log1p); - SCALAR_MAPPER (real, std::real); - SCALAR_MAPPER (round, xround); - SCALAR_MAPPER (roundb, xroundb); - SCALAR_MAPPER (signum, ::signum); - SCALAR_MAPPER (sin, std::sin); - SCALAR_MAPPER (sinh, std::sinh); - SCALAR_MAPPER (sqrt, std::sqrt); - SCALAR_MAPPER (tan, std::tan); - SCALAR_MAPPER (tanh, std::tanh); - SCALAR_MAPPER (finite, xfinite); - SCALAR_MAPPER (isinf, xisinf); - SCALAR_MAPPER (isna, octave_is_NA); - SCALAR_MAPPER (isnan, xisnan); - - default: - return octave_base_value::map (umap); - } -} diff -r d02b229ce693 -r a132d206a36a src/ov-complex.h --- a/src/ov-complex.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,209 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_complex_h) -#define octave_complex_h 1 - -#include - -#include -#include - -#include "lo-ieee.h" -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "gripes.h" -#include "error.h" -#include "ov-base.h" -#include "ov-cx-mat.h" -#include "ov-base-scalar.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// Complex scalar values. - -class -OCTINTERP_API -octave_complex : public octave_base_scalar -{ -public: - - octave_complex (void) - : octave_base_scalar () { } - - octave_complex (const Complex& c) - : octave_base_scalar (c) { } - - octave_complex (const octave_complex& c) - : octave_base_scalar (c) { } - - ~octave_complex (void) { } - - octave_base_value *clone (void) const { return new octave_complex (*this); } - - // We return an octave_complex_matrix object here instead of an - // octave_complex object so that in expressions like A(2,2,2) = 2 - // (for A previously undefined), A will be empty instead of a 1x1 - // object. - octave_base_value *empty_clone (void) const - { return new octave_complex_matrix (); } - - type_conv_info numeric_demotion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - // Use this to give a more specific error message - idx_vector index_vector (void) const - { - error ( - "attempted to use a complex scalar as an index\n" - " (forgot to initialize i or j?)"); - return idx_vector (); - } - - octave_value any (int = 0) const - { - return (scalar != Complex (0, 0) - && ! (lo_ieee_isnan (std::real (scalar)) - || lo_ieee_isnan (std::imag (scalar)))); - } - - builtin_type_t builtin_type (void) const { return btyp_complex; } - - bool is_complex_scalar (void) const { return true; } - - bool is_complex_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - double double_value (bool = false) const; - - float float_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - float float_scalar_value (bool frc_str_conv = false) const - { return float_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const; - - FloatMatrix float_matrix_value (bool = false) const; - - NDArray array_value (bool = false) const; - - FloatNDArray float_array_value (bool = false) const; - - SparseMatrix sparse_matrix_value (bool = false) const - { return SparseMatrix (matrix_value ()); } - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const - { return SparseComplexMatrix (complex_matrix_value ()); } - - octave_value resize (const dim_vector& dv, bool fill = false) const; - - Complex complex_value (bool = false) const; - - FloatComplex float_complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - FloatComplexMatrix float_complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const; - - FloatComplexNDArray float_complex_array_value (bool = false) const; - - bool bool_value (bool warn = false) const - { - if (xisnan (scalar)) - gripe_nan_to_logical_conversion (); - else if (warn && scalar != 0.0 && scalar != 1.0) - gripe_logical_conversion (); - - return scalar != 0.0; - } - - boolNDArray bool_array_value (bool warn = false) const - { - if (xisnan (scalar)) - gripe_nan_to_logical_conversion (); - else if (warn && scalar != 0.0 && scalar != 1.0) - gripe_logical_conversion (); - - return boolNDArray (dim_vector (1, 1), scalar != 0.0); - } - - octave_value diag (octave_idx_type m, octave_idx_type n) const; - - void increment (void) { scalar += 1.0; } - - void decrement (void) { scalar -= 1.0; } - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { - // Yes, for compatibility, we drop the imaginary part here. - return os.write (array_value (true), block_size, output_type, - skip, flt_fmt); - } - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const; - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -typedef octave_complex octave_complex_scalar; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-cs-list.cc --- a/src/ov-cs-list.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,62 +0,0 @@ -/* - -Copyright (C) 2002-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "lo-utils.h" - -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "ov-cs-list.h" -#include "unwind-prot.h" - -DEFINE_OCTAVE_ALLOCATOR (octave_cs_list); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_cs_list, "cs-list", "cs-list"); - -octave_cs_list::octave_cs_list (const Cell& c) - : octave_base_value (), lst (c) -{ -} - -octave_value -octave_cs_list::subsref (const std::string&, - const std::list&) -{ - gripe_indexed_cs_list (); - return octave_value (); -} - -octave_value_list -octave_cs_list::subsref (const std::string&, - const std::list&, int) -{ - gripe_indexed_cs_list (); - return octave_value_list (); -} - diff -r d02b229ce693 -r a132d206a36a src/ov-cs-list.h --- a/src/ov-cs-list.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,91 +0,0 @@ -/* - -Copyright (C) 2002-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_cs_list_h) -#define octave_cs_list_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "str-vec.h" - -#include "Cell.h" -#include "error.h" -#include "oct-alloc.h" -#include "oct-obj.h" -#include "ov-typeinfo.h" - -class tree_walker; - -// Lists. - -class -octave_cs_list : public octave_base_value -{ -public: - - octave_cs_list (void) - : octave_base_value (), lst () { } - - octave_cs_list (const octave_value_list& l) - : octave_base_value (), lst (l) { } - - octave_cs_list (const Cell& c); - - octave_cs_list (const octave_cs_list& l) - : octave_base_value (), lst (l.lst) { } - - ~octave_cs_list (void) { } - - octave_base_value *clone (void) const { return new octave_cs_list (*this); } - octave_base_value *empty_clone (void) const { return new octave_cs_list (); } - - dim_vector dims (void) const { return dim_vector (1, lst.length ()); } - - bool is_defined (void) const { return true; } - - bool is_constant (void) const { return true; } - - bool is_cs_list (void) const { return true; } - - octave_value_list list_value (void) const { return lst; } - - octave_value subsref (const std::string& type, - const std::list& idx); - - octave_value_list subsref (const std::string& type, - const std::list& idx, int); - -private: - - // The list of Octave values. - octave_value_list lst; - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-cx-diag.cc --- a/src/ov-cx-diag.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,238 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "byte-swap.h" - -#include "ov-cx-diag.h" -#include "ov-flt-cx-diag.h" -#include "ov-re-diag.h" -#include "ov-base-diag.cc" -#include "ov-complex.h" -#include "ov-cx-mat.h" -#include "ls-utils.h" - -template class octave_base_diag; - -DEFINE_OCTAVE_ALLOCATOR (octave_complex_diag_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_complex_diag_matrix, - "complex diagonal matrix", "double"); - -static octave_base_value * -default_numeric_conversion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_complex_diag_matrix&); - - return new octave_complex_matrix (v.complex_matrix_value ()); -} - -octave_base_value::type_conv_info -octave_complex_diag_matrix::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_conversion_function, - octave_complex_matrix::static_type_id ()); -} - -static octave_base_value * -default_numeric_demotion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_complex_diag_matrix&); - - return new octave_float_complex_diag_matrix (v.float_complex_diag_matrix_value ()); -} - -octave_base_value::type_conv_info -octave_complex_diag_matrix::numeric_demotion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_demotion_function, - octave_float_complex_diag_matrix::static_type_id ()); -} - -octave_base_value * -octave_complex_diag_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (matrix.nelem () == 1) - { - retval = new octave_complex (matrix (0, 0)); - octave_base_value *rv2 = retval->try_narrowing_conversion (); - if (rv2) - { - delete retval; - retval = rv2; - } - } - else if (matrix.all_elements_are_real ()) - { - return new octave_diag_matrix (::real (matrix)); - } - - return retval; -} - -DiagMatrix -octave_complex_diag_matrix::diag_matrix_value (bool force_conversion) const -{ - DiagMatrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - type_name (), "real matrix"); - - retval = ::real (matrix); - - return retval; -} - -FloatDiagMatrix -octave_complex_diag_matrix::float_diag_matrix_value (bool force_conversion) const -{ - DiagMatrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - type_name (), "real matrix"); - - retval = ::real (matrix); - - return retval; -} - -ComplexDiagMatrix -octave_complex_diag_matrix::complex_diag_matrix_value (bool) const -{ - return matrix; -} - -FloatComplexDiagMatrix -octave_complex_diag_matrix::float_complex_diag_matrix_value (bool) const -{ - return FloatComplexDiagMatrix (matrix); -} - -octave_value -octave_complex_diag_matrix::map (unary_mapper_t umap) const -{ - switch (umap) - { - case umap_abs: - return matrix.abs (); - case umap_real: - return ::real (matrix); - case umap_conj: - return ::conj (matrix); - case umap_imag: - return ::imag (matrix); - case umap_sqrt: - { - ComplexColumnVector tmp = matrix.diag ().map (std::sqrt); - ComplexDiagMatrix retval (tmp); - retval.resize (matrix.rows (), matrix.columns ()); - return retval; - } - default: - return to_dense ().map (umap); - } -} - -bool -octave_complex_diag_matrix::save_binary (std::ostream& os, bool& save_as_floats) -{ - - int32_t r = matrix.rows (), c = matrix.cols (); - os.write (reinterpret_cast (&r), 4); - os.write (reinterpret_cast (&c), 4); - - ComplexMatrix m = ComplexMatrix (matrix.diag ()); - save_type st = LS_DOUBLE; - if (save_as_floats) - { - if (m.too_large_for_float ()) - { - warning ("save: some values too large to save as floats --"); - warning ("save: saving as doubles instead"); - } - else - st = LS_FLOAT; - } - else if (matrix.length () > 4096) // FIXME -- make this configurable. - { - double max_val, min_val; - if (m.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - } - - const Complex *mtmp = m.data (); - write_doubles (os, reinterpret_cast (mtmp), st, 2 * m.numel ()); - - return true; -} - -bool -octave_complex_diag_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - int32_t r, c; - char tmp; - if (! (is.read (reinterpret_cast (&r), 4) - && is.read (reinterpret_cast (&c), 4) - && is.read (reinterpret_cast (&tmp), 1))) - return false; - if (swap) - { - swap_bytes<4> (&r); - swap_bytes<4> (&c); - } - - ComplexDiagMatrix m (r, c); - Complex *im = m.fortran_vec (); - octave_idx_type len = m.length (); - read_doubles (is, reinterpret_cast (im), - static_cast (tmp), 2 * len, swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - - return true; -} - -bool -octave_complex_diag_matrix::chk_valid_scalar (const octave_value& val, - Complex& x) const -{ - bool retval = val.is_complex_scalar () || val.is_real_scalar (); - if (retval) - x = val.complex_value (); - return retval; -} - -/* - -%% bug #36368 -%!assert (diag ([1+i, 1-i])^2 , diag ([2i, -2i]), 4*eps); - -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-cx-diag.h --- a/src/ov-cx-diag.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,95 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_complex_diag_matrix_h) -#define octave_complex_diag_matrix_h 1 - -#include "ov-base.h" -#include "ov-base-diag.h" -#include "ov-cx-mat.h" -#include "ov-typeinfo.h" - -// Real diagonal matrix values. - -class -OCTINTERP_API -octave_complex_diag_matrix - : public octave_base_diag -{ -public: - - octave_complex_diag_matrix (void) - : octave_base_diag () { } - - octave_complex_diag_matrix (const ComplexDiagMatrix& m) - : octave_base_diag (m) { } - - octave_complex_diag_matrix (const octave_complex_diag_matrix& m) - : octave_base_diag (m) { } - - ~octave_complex_diag_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_complex_diag_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_complex_diag_matrix (); } - - type_conv_info numeric_conversion_function (void) const; - - type_conv_info numeric_demotion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - builtin_type_t builtin_type (void) const { return btyp_complex; } - - bool is_complex_matrix (void) const { return true; } - - bool is_complex_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - DiagMatrix diag_matrix_value (bool = false) const; - - FloatDiagMatrix float_diag_matrix_value (bool = false) const; - - ComplexDiagMatrix complex_diag_matrix_value (bool = false) const; - - FloatComplexDiagMatrix float_complex_diag_matrix_value (bool = false) const; - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - - octave_value map (unary_mapper_t umap) const; - -private: - - bool chk_valid_scalar (const octave_value&, - Complex&) const; - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-cx-mat.cc --- a/src/ov-cx-mat.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,803 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "data-conv.h" -#include "lo-ieee.h" -#include "lo-specfun.h" -#include "lo-mappers.h" -#include "mx-base.h" -#include "mach-info.h" -#include "oct-locbuf.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "oct-stream.h" -#include "ops.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-base-mat.cc" -#include "ov-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-re-mat.h" -#include "ov-scalar.h" -#include "pr-output.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-hdf5.h" -#include "ls-utils.h" - -template class octave_base_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_complex_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_complex_matrix, - "complex matrix", "double"); - -static octave_base_value * -default_numeric_demotion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_complex_matrix&); - - return new octave_float_complex_matrix (v.float_complex_matrix_value ()); -} - -octave_base_value::type_conv_info -octave_complex_matrix::numeric_demotion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_demotion_function, - octave_float_complex_matrix::static_type_id ()); -} - -octave_base_value * -octave_complex_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (matrix.numel () == 1) - { - Complex c = matrix (0); - - if (std::imag (c) == 0.0) - retval = new octave_scalar (std::real (c)); - else - retval = new octave_complex (c); - } - else if (matrix.all_elements_are_real ()) - retval = new octave_matrix (::real (matrix)); - - return retval; -} - -double -octave_complex_matrix::double_value (bool force_conversion) const -{ - double retval = lo_ieee_nan_value (); - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real scalar"); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "complex matrix", "real scalar"); - - retval = std::real (matrix (0, 0)); - } - else - gripe_invalid_conversion ("complex matrix", "real scalar"); - - return retval; -} - -float -octave_complex_matrix::float_value (bool force_conversion) const -{ - float retval = lo_ieee_float_nan_value (); - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real scalar"); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "complex matrix", "real scalar"); - - retval = std::real (matrix (0, 0)); - } - else - gripe_invalid_conversion ("complex matrix", "real scalar"); - - return retval; -} - -Matrix -octave_complex_matrix::matrix_value (bool force_conversion) const -{ - Matrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real matrix"); - - retval = ::real (matrix.matrix_value ()); - - return retval; -} - -FloatMatrix -octave_complex_matrix::float_matrix_value (bool force_conversion) const -{ - FloatMatrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real matrix"); - - retval = ::real (matrix.matrix_value ()); - - return retval; -} - -Complex -octave_complex_matrix::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "complex matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("complex matrix", "complex scalar"); - - return retval; -} - -FloatComplex -octave_complex_matrix::float_complex_value (bool) const -{ - float tmp = lo_ieee_float_nan_value (); - - FloatComplex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "complex matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("complex matrix", "complex scalar"); - - return retval; -} - -ComplexMatrix -octave_complex_matrix::complex_matrix_value (bool) const -{ - return matrix.matrix_value (); -} - -FloatComplexMatrix -octave_complex_matrix::float_complex_matrix_value (bool) const -{ - return FloatComplexMatrix (matrix.matrix_value ()); -} - -boolNDArray -octave_complex_matrix::bool_array_value (bool warn) const -{ - if (matrix.any_element_is_nan ()) - gripe_nan_to_logical_conversion (); - else if (warn && (! matrix.all_elements_are_real () - || real (matrix).any_element_not_one_or_zero ())) - gripe_logical_conversion (); - - return mx_el_ne (matrix, Complex (0.0)); -} - -charNDArray -octave_complex_matrix::char_array_value (bool frc_str_conv) const -{ - charNDArray retval; - - if (! frc_str_conv) - gripe_implicit_conversion ("Octave:num-to-str", - "complex matrix", "string"); - else - { - retval = charNDArray (dims ()); - octave_idx_type nel = numel (); - - for (octave_idx_type i = 0; i < nel; i++) - retval.elem (i) = static_cast(std::real (matrix.elem (i))); - } - - return retval; -} - -FloatComplexNDArray -octave_complex_matrix::float_complex_array_value (bool) const -{ - return FloatComplexNDArray (matrix); -} - -SparseMatrix -octave_complex_matrix::sparse_matrix_value (bool force_conversion) const -{ - SparseMatrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real matrix"); - - retval = SparseMatrix (::real (matrix.matrix_value ())); - - return retval; -} - -SparseComplexMatrix -octave_complex_matrix::sparse_complex_matrix_value (bool) const -{ - return SparseComplexMatrix (matrix.matrix_value ()); -} - -octave_value -octave_complex_matrix::diag (octave_idx_type k) const -{ - octave_value retval; - if (k == 0 && matrix.ndims () == 2 - && (matrix.rows () == 1 || matrix.columns () == 1)) - retval = ComplexDiagMatrix (DiagArray2 (matrix)); - else - retval = octave_base_matrix::diag (k); - - return retval; -} - -octave_value -octave_complex_matrix::diag (octave_idx_type m, octave_idx_type n) const -{ - octave_value retval; - - if (matrix.ndims () == 2 - && (matrix.rows () == 1 || matrix.columns () == 1)) - { - ComplexMatrix mat = matrix.matrix_value (); - - retval = mat.diag (m, n); - } - else - error ("diag: expecting vector argument"); - - return retval; -} - -bool -octave_complex_matrix::save_ascii (std::ostream& os) -{ - dim_vector d = dims (); - if (d.length () > 2) - { - ComplexNDArray tmp = complex_array_value (); - - os << "# ndims: " << d.length () << "\n"; - - for (int i = 0; i < d.length (); i++) - os << " " << d (i); - - os << "\n" << tmp; - } - else - { - // Keep this case, rather than use generic code above for backward - // compatiability. Makes load_ascii much more complex!! - os << "# rows: " << rows () << "\n" - << "# columns: " << columns () << "\n"; - - os << complex_matrix_value (); - } - - return true; -} - -bool -octave_complex_matrix::load_ascii (std::istream& is) -{ - bool success = true; - - string_vector keywords(2); - - keywords[0] = "ndims"; - keywords[1] = "rows"; - - std::string kw; - octave_idx_type val = 0; - - if (extract_keyword (is, keywords, kw, val, true)) - { - if (kw == "ndims") - { - int mdims = static_cast (val); - - if (mdims >= 0) - { - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - is >> dv(i); - - if (is) - { - ComplexNDArray tmp(dv); - - is >> tmp; - - if (is) - matrix = tmp; - else - { - error ("load: failed to load matrix constant"); - success = false; - } - } - else - { - error ("load: failed to read dimensions"); - success = false; - } - } - else - { - error ("load: failed to extract number of dimensions"); - success = false; - } - } - else if (kw == "rows") - { - octave_idx_type nr = val; - octave_idx_type nc = 0; - - if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) - { - if (nr > 0 && nc > 0) - { - ComplexMatrix tmp (nr, nc); - is >> tmp; - if (is) - matrix = tmp; - else - { - error ("load: failed to load matrix constant"); - success = false; - } - } - else if (nr == 0 || nc == 0) - matrix = ComplexMatrix (nr, nc); - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - } - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - - return success; -} - -bool -octave_complex_matrix::save_binary (std::ostream& os, bool& save_as_floats) -{ - dim_vector d = dims (); - if (d.length () < 1) - return false; - - // Use negative value for ndims to differentiate with old format!! - int32_t tmp = - d.length (); - os.write (reinterpret_cast (&tmp), 4); - for (int i = 0; i < d.length (); i++) - { - tmp = d(i); - os.write (reinterpret_cast (&tmp), 4); - } - - ComplexNDArray m = complex_array_value (); - save_type st = LS_DOUBLE; - if (save_as_floats) - { - if (m.too_large_for_float ()) - { - warning ("save: some values too large to save as floats --"); - warning ("save: saving as doubles instead"); - } - else - st = LS_FLOAT; - } - else if (d.numel () > 4096) // FIXME -- make this configurable. - { - double max_val, min_val; - if (m.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - } - - - const Complex *mtmp = m.data (); - write_doubles (os, reinterpret_cast (mtmp), st, 2 * d.numel ()); - - return true; -} - -bool -octave_complex_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - char tmp; - int32_t mdims; - if (! is.read (reinterpret_cast (&mdims), 4)) - return false; - if (swap) - swap_bytes<4> (&mdims); - if (mdims < 0) - { - mdims = - mdims; - int32_t di; - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - { - if (! is.read (reinterpret_cast (&di), 4)) - return false; - if (swap) - swap_bytes<4> (&di); - dv(i) = di; - } - - // Convert an array with a single dimension to be a row vector. - // Octave should never write files like this, other software - // might. - - if (mdims == 1) - { - mdims = 2; - dv.resize (mdims); - dv(1) = dv(0); - dv(0) = 1; - } - - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - - ComplexNDArray m(dv); - Complex *im = m.fortran_vec (); - read_doubles (is, reinterpret_cast (im), - static_cast (tmp), 2 * dv.numel (), swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - } - else - { - int32_t nr, nc; - nr = mdims; - if (! is.read (reinterpret_cast (&nc), 4)) - return false; - if (swap) - swap_bytes<4> (&nc); - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - ComplexMatrix m (nr, nc); - Complex *im = m.fortran_vec (); - octave_idx_type len = nr * nc; - read_doubles (is, reinterpret_cast (im), - static_cast (tmp), 2*len, swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - } - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_complex_matrix::save_hdf5 (hid_t loc_id, const char *name, - bool save_as_floats) -{ - dim_vector dv = dims (); - int empty = save_hdf5_empty (loc_id, name, dv); - if (empty) - return (empty > 0); - - int rank = dv.length (); - hid_t space_hid = -1, data_hid = -1, type_hid = -1; - bool retval = true; - ComplexNDArray m = complex_array_value (); - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - - // Octave uses column-major, while HDF5 uses row-major ordering - for (int i = 0; i < rank; i++) - hdims[i] = dv (rank-i-1); - - space_hid = H5Screate_simple (rank, hdims, 0); - if (space_hid < 0) return false; - - hid_t save_type_hid = H5T_NATIVE_DOUBLE; - - if (save_as_floats) - { - if (m.too_large_for_float ()) - { - warning ("save: some values too large to save as floats --"); - warning ("save: saving as doubles instead"); - } - else - save_type_hid = H5T_NATIVE_FLOAT; - } -#if HAVE_HDF5_INT2FLOAT_CONVERSIONS - // hdf5 currently doesn't support float/integer conversions - else - { - double max_val, min_val; - - if (m.all_integers (max_val, min_val)) - save_type_hid - = save_type_to_hdf5 (get_save_type (max_val, min_val)); - } -#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ - - type_hid = hdf5_make_complex_type (save_type_hid); - if (type_hid < 0) - { - H5Sclose (space_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - return false; - } - - hid_t complex_type_hid = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); - if (complex_type_hid < 0) retval = false; - - if (retval) - { - Complex *mtmp = m.fortran_vec (); - if (H5Dwrite (data_hid, complex_type_hid, H5S_ALL, H5S_ALL, H5P_DEFAULT, - mtmp) < 0) - { - H5Tclose (complex_type_hid); - retval = false; - } - } - - H5Tclose (complex_type_hid); - H5Dclose (data_hid); - H5Tclose (type_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_complex_matrix::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; - - dim_vector dv; - int empty = load_hdf5_empty (loc_id, name, dv); - if (empty > 0) - matrix.resize (dv); - if (empty) - return (empty > 0); - -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t type_hid = H5Dget_type (data_hid); - - hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); - - if (! hdf5_types_compatible (type_hid, complex_type)) - { - H5Tclose (complex_type); - H5Dclose (data_hid); - return false; - } - - hid_t space_id = H5Dget_space (data_hid); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank < 1) - { - H5Tclose (complex_type); - H5Sclose (space_id); - H5Dclose (data_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_id, hdims, maxdims); - - // Octave uses column-major, while HDF5 uses row-major ordering - if (rank == 1) - { - dv.resize (2); - dv(0) = 1; - dv(1) = hdims[0]; - } - else - { - dv.resize (rank); - for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) - dv(j) = hdims[i]; - } - - ComplexNDArray m (dv); - Complex *reim = m.fortran_vec (); - if (H5Dread (data_hid, complex_type, H5S_ALL, H5S_ALL, H5P_DEFAULT, - reim) >= 0) - { - retval = true; - matrix = m; - } - - H5Tclose (complex_type); - H5Sclose (space_id); - H5Dclose (data_hid); - - return retval; -} - -#endif - -void -octave_complex_matrix::print_raw (std::ostream& os, - bool pr_as_read_syntax) const -{ - octave_print_internal (os, matrix, pr_as_read_syntax, - current_print_indent_level ()); -} - -mxArray * -octave_complex_matrix::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxDOUBLE_CLASS, dims (), mxCOMPLEX); - - double *pr = static_cast (retval->get_data ()); - double *pi = static_cast (retval->get_imag_data ()); - - mwSize nel = numel (); - - const Complex *p = matrix.data (); - - for (mwIndex i = 0; i < nel; i++) - { - pr[i] = std::real (p[i]); - pi[i] = std::imag (p[i]); - } - - return retval; -} - -octave_value -octave_complex_matrix::map (unary_mapper_t umap) const -{ - switch (umap) - { - // Mappers handled specially. - case umap_real: - return ::real (matrix); - case umap_imag: - return ::imag (matrix); - case umap_conj: - return ::conj (matrix); - -#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.FCN ()) - - ARRAY_METHOD_MAPPER (abs, abs); - ARRAY_METHOD_MAPPER (isnan, isnan); - ARRAY_METHOD_MAPPER (isinf, isinf); - ARRAY_METHOD_MAPPER (finite, isfinite); - -#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.map (FCN)) - - ARRAY_MAPPER (acos, Complex, ::acos); - ARRAY_MAPPER (acosh, Complex, ::acosh); - ARRAY_MAPPER (angle, double, std::arg); - ARRAY_MAPPER (arg, double, std::arg); - ARRAY_MAPPER (asin, Complex, ::asin); - ARRAY_MAPPER (asinh, Complex, ::asinh); - ARRAY_MAPPER (atan, Complex, ::atan); - ARRAY_MAPPER (atanh, Complex, ::atanh); - ARRAY_MAPPER (ceil, Complex, ::ceil); - ARRAY_MAPPER (cos, Complex, std::cos); - ARRAY_MAPPER (cosh, Complex, std::cosh); - ARRAY_MAPPER (exp, Complex, std::exp); - ARRAY_MAPPER (expm1, Complex, ::expm1); - ARRAY_MAPPER (fix, Complex, ::fix); - ARRAY_MAPPER (floor, Complex, ::floor); - ARRAY_MAPPER (log, Complex, std::log); - ARRAY_MAPPER (log2, Complex, xlog2); - ARRAY_MAPPER (log10, Complex, std::log10); - ARRAY_MAPPER (log1p, Complex, ::log1p); - ARRAY_MAPPER (round, Complex, xround); - ARRAY_MAPPER (roundb, Complex, xroundb); - ARRAY_MAPPER (signum, Complex, ::signum); - ARRAY_MAPPER (sin, Complex, std::sin); - ARRAY_MAPPER (sinh, Complex, std::sinh); - ARRAY_MAPPER (sqrt, Complex, std::sqrt); - ARRAY_MAPPER (tan, Complex, std::tan); - ARRAY_MAPPER (tanh, Complex, std::tanh); - ARRAY_MAPPER (isna, bool, octave_is_NA); - - default: - return octave_base_value::map (umap); - } -} diff -r d02b229ce693 -r a132d206a36a src/ov-cx-mat.h --- a/src/ov-cx-mat.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,183 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_complex_matrix_h) -#define octave_complex_matrix_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-stream.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-typeinfo.h" - -#include "MatrixType.h" - -class octave_value_list; - -class tree_walker; - -// Complex matrix values. - -class -OCTINTERP_API -octave_complex_matrix : public octave_base_matrix -{ -public: - - octave_complex_matrix (void) - : octave_base_matrix () { } - - octave_complex_matrix (const ComplexNDArray& m) - : octave_base_matrix (m) { } - - octave_complex_matrix (const ComplexMatrix& m) - : octave_base_matrix (m) { } - - octave_complex_matrix (const ComplexMatrix& m, const MatrixType& t) - : octave_base_matrix (m, t) { } - - octave_complex_matrix (const Array& m) - : octave_base_matrix (ComplexNDArray (m)) { } - - octave_complex_matrix (const ComplexDiagMatrix& d) - : octave_base_matrix (ComplexMatrix (d)) { } - - octave_complex_matrix (const ComplexRowVector& v) - : octave_base_matrix (ComplexMatrix (v)) { } - - octave_complex_matrix (const ComplexColumnVector& v) - : octave_base_matrix (ComplexMatrix (v)) { } - - octave_complex_matrix (const octave_complex_matrix& cm) - : octave_base_matrix (cm) { } - - ~octave_complex_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_complex_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_complex_matrix (); } - - type_conv_info numeric_demotion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - builtin_type_t builtin_type (void) const { return btyp_complex; } - - bool is_complex_matrix (void) const { return true; } - - bool is_complex_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - double double_value (bool = false) const; - - float float_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - float float_scalar_value (bool frc_str_conv = false) const - { return float_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const; - - FloatMatrix float_matrix_value (bool = false) const; - - Complex complex_value (bool = false) const; - - FloatComplex float_complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - FloatComplexMatrix float_complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const { return matrix; } - - FloatComplexNDArray float_complex_array_value (bool = false) const; - - boolNDArray bool_array_value (bool warn = false) const; - - charNDArray char_array_value (bool frc_str_conv = false) const; - - SparseMatrix sparse_matrix_value (bool = false) const; - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; - - octave_value diag (octave_idx_type k = 0) const; - - octave_value diag (octave_idx_type m, octave_idx_type n) const; - - void increment (void) { matrix += Complex (1.0); } - - void decrement (void) { matrix -= Complex (1.0); } - - void changesign (void) { matrix.changesign (); } - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { - // Yes, for compatibility, we drop the imaginary part here. - return os.write (matrix_value (true), block_size, output_type, - skip, flt_fmt); - } - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const; - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-cx-sparse.cc --- a/src/ov-cx-sparse.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,934 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "lo-specfun.h" -#include "lo-mappers.h" -#include "oct-locbuf.h" - -#include "ov-base.h" -#include "ov-scalar.h" -#include "ov-complex.h" -#include "gripes.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -#include "ov-base-sparse.h" -#include "ov-base-sparse.cc" - -#include "ov-bool-sparse.h" - -template class OCTINTERP_API octave_base_sparse; - -DEFINE_OCTAVE_ALLOCATOR (octave_sparse_complex_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_sparse_complex_matrix, "sparse complex matrix", "double"); - -octave_base_value * -octave_sparse_complex_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (Vsparse_auto_mutate) - { - int nr = matrix.rows (); - int nc = matrix.cols (); - - // Don't use numel, since it can overflow for very large matrices - // Note that for the tests on matrix size, they become approximative - // since they involves a cast to double to avoid issues of overflow - if (matrix.rows () == 1 && matrix.cols () == 1) - { - // Const copy of the matrix, so the right version of () operator used - const SparseComplexMatrix tmp (matrix); - - Complex c = tmp (0, 0); - - if (std::imag (c) == 0.0) - retval = new octave_scalar (std::real (c)); - else - retval = new octave_complex (c); - } - else if (nr == 0 || nc == 0) - retval = new octave_matrix (Matrix (nr, nc)); - else if (matrix.all_elements_are_real ()) - if (matrix.cols () > 0 && matrix.rows () > 0 - && (double (matrix.byte_size ()) > double (matrix.rows ()) - * double (matrix.cols ()) * sizeof (double))) - retval = new octave_matrix (::real (matrix.matrix_value ())); - else - retval = new octave_sparse_matrix (::real (matrix)); - else if (matrix.cols () > 0 && matrix.rows () > 0 - && (double (matrix.byte_size ()) > double (matrix.rows ()) - * double (matrix.cols ()) * sizeof (Complex))) - retval = new octave_complex_matrix (matrix.matrix_value ()); - } - else - { - if (matrix.all_elements_are_real ()) - retval = new octave_sparse_matrix (::real (matrix)); - } - - return retval; -} - -double -octave_sparse_complex_matrix::double_value (bool force_conversion) const -{ - double retval = lo_ieee_nan_value (); - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex sparse matrix", "real scalar"); - - // FIXME -- maybe this should be a function, valid_as_scalar() - if (numel () > 0) - { - if (numel () > 1) - gripe_implicit_conversion ("Octave:array-to-scalar", - "complex sparse matrix", "real scalar"); - - retval = std::real (matrix (0, 0)); - } - else - gripe_invalid_conversion ("complex sparse matrix", "real scalar"); - - return retval; -} - -Matrix -octave_sparse_complex_matrix::matrix_value (bool force_conversion) const -{ - Matrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex sparse matrix", "real matrix"); - - retval = ::real (matrix.matrix_value ()); - - return retval; -} - -Complex -octave_sparse_complex_matrix::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - // FIXME -- maybe this should be a function, valid_as_scalar() - if (numel () > 0) - { - if (numel () > 1) - gripe_implicit_conversion ("Octave:array-to-scalar", - "complex sparse matrix", "real scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("complex sparse matrix", "real scalar"); - - return retval; -} - -ComplexMatrix -octave_sparse_complex_matrix::complex_matrix_value (bool) const -{ - return matrix.matrix_value (); -} - -ComplexNDArray -octave_sparse_complex_matrix::complex_array_value (bool) const -{ - return ComplexNDArray (matrix.matrix_value ()); -} - -charNDArray -octave_sparse_complex_matrix::char_array_value (bool frc_str_conv) const -{ - charNDArray retval; - - if (! frc_str_conv) - gripe_implicit_conversion ("Octave:num-to-str", - "sparse complex matrix", "string"); - else - { - retval = charNDArray (dims (), 0); - octave_idx_type nc = matrix.cols (); - octave_idx_type nr = matrix.rows (); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = matrix.cidx (j); i < matrix.cidx (j+1); i++) - retval(matrix.ridx (i) + nr * j) = - static_cast(std::real (matrix.data (i))); - } - - return retval; -} - -SparseMatrix -octave_sparse_complex_matrix::sparse_matrix_value (bool force_conversion) const -{ - SparseMatrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex sparse matrix", - "real sparse matrix"); - - retval = ::real (matrix); - - return retval; -} - -SparseBoolMatrix -octave_sparse_complex_matrix::sparse_bool_matrix_value (bool warn) const -{ - if (matrix.any_element_is_nan ()) - gripe_nan_to_logical_conversion (); - else if (warn && (! matrix.all_elements_are_real () - || real (matrix).any_element_not_one_or_zero ())) - gripe_logical_conversion (); - - return mx_el_ne (matrix, Complex (0.0)); -} - -bool -octave_sparse_complex_matrix::save_binary (std::ostream& os, - bool&save_as_floats) -{ - dim_vector d = this->dims (); - if (d.length () < 1) - return false; - - // Ensure that additional memory is deallocated - matrix.maybe_compress (); - - int nr = d(0); - int nc = d(1); - int nz = nnz (); - - int32_t itmp; - // Use negative value for ndims to be consistent with other formats - itmp= -2; - os.write (reinterpret_cast (&itmp), 4); - - itmp= nr; - os.write (reinterpret_cast (&itmp), 4); - - itmp= nc; - os.write (reinterpret_cast (&itmp), 4); - - itmp= nz; - os.write (reinterpret_cast (&itmp), 4); - - save_type st = LS_DOUBLE; - if (save_as_floats) - { - if (matrix.too_large_for_float ()) - { - warning ("save: some values too large to save as floats --"); - warning ("save: saving as doubles instead"); - } - else - st = LS_FLOAT; - } - else if (matrix.nnz () > 8192) // FIXME -- make this configurable. - { - double max_val, min_val; - if (matrix.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - } - - // add one to the printed indices to go from - // zero-based to one-based arrays - for (int i = 0; i < nc+1; i++) - { - octave_quit (); - itmp = matrix.cidx (i); - os.write (reinterpret_cast (&itmp), 4); - } - - for (int i = 0; i < nz; i++) - { - octave_quit (); - itmp = matrix.ridx (i); - os.write (reinterpret_cast (&itmp), 4); - } - - write_doubles (os, reinterpret_cast (matrix.data ()), st, 2 * nz); - - return true; -} - -bool -octave_sparse_complex_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - int32_t nz, nc, nr, tmp; - char ctmp; - - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - - if (swap) - swap_bytes<4> (&tmp); - - if (tmp != -2) { - error ("load: only 2D sparse matrices are supported"); - return false; - } - - if (! is.read (reinterpret_cast (&nr), 4)) - return false; - if (! is.read (reinterpret_cast (&nc), 4)) - return false; - if (! is.read (reinterpret_cast (&nz), 4)) - return false; - - if (swap) - { - swap_bytes<4> (&nr); - swap_bytes<4> (&nc); - swap_bytes<4> (&nz); - } - - SparseComplexMatrix m (static_cast (nr), - static_cast (nc), - static_cast (nz)); - - for (int i = 0; i < nc+1; i++) - { - octave_quit (); - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - if (swap) - swap_bytes<4> (&tmp); - m.cidx (i) = tmp; - } - - for (int i = 0; i < nz; i++) - { - octave_quit (); - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - if (swap) - swap_bytes<4> (&tmp); - m.ridx (i) = tmp; - } - - if (! is.read (reinterpret_cast (&ctmp), 1)) - return false; - - read_doubles (is, reinterpret_cast (m.data ()), - static_cast (ctmp), 2 * nz, swap, fmt); - - if (error_state || ! is) - return false; - - if (! m.indices_ok ()) - return false; - - matrix = m; - - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_sparse_complex_matrix::save_hdf5 (hid_t loc_id, const char *name, - bool save_as_floats) -{ - dim_vector dv = dims (); - int empty = save_hdf5_empty (loc_id, name, dv); - if (empty) - return (empty > 0); - - // Ensure that additional memory is deallocated - matrix.maybe_compress (); - -#if HAVE_HDF5_18 - hid_t group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - hid_t group_hid = H5Gcreate (loc_id, name, 0); -#endif - if (group_hid < 0) - return false; - - hid_t space_hid = -1, data_hid = -1; - bool retval = true; - SparseComplexMatrix m = sparse_complex_matrix_value (); - octave_idx_type tmp; - hsize_t hdims[2]; - - space_hid = H5Screate_simple (0, hdims, 0); - if (space_hid < 0) - { - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - tmp = m.rows (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &tmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - tmp = m.cols (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &tmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - tmp = m.nnz (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &tmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - - hdims[0] = m.cols () + 1; - hdims[1] = 1; - - space_hid = H5Screate_simple (2, hdims, 0); - - if (space_hid < 0) - { - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - octave_idx_type * itmp = m.xcidx (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, itmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - - hdims[0] = m.nnz (); - hdims[1] = 1; - - space_hid = H5Screate_simple (2, hdims, 0); - - if (space_hid < 0) - { - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - itmp = m.xridx (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, itmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - hid_t save_type_hid = H5T_NATIVE_DOUBLE; - - if (save_as_floats) - { - if (m.too_large_for_float ()) - { - warning ("save: some values too large to save as floats --"); - warning ("save: saving as doubles instead"); - } - else - save_type_hid = H5T_NATIVE_FLOAT; - } -#if HAVE_HDF5_INT2FLOAT_CONVERSIONS - // hdf5 currently doesn't support float/integer conversions - else - { - double max_val, min_val; - - if (m.all_integers (max_val, min_val)) - save_type_hid - = save_type_to_hdf5 (get_save_type (max_val, min_val)); - } -#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ - - hid_t type_hid = hdf5_make_complex_type (save_type_hid); - if (type_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "data", type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "data", type_hid, space_hid, H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - - hid_t complex_type_hid = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); - retval = false; - if (complex_type_hid >= 0) - { - Complex * ctmp = m.xdata (); - - retval = H5Dwrite (data_hid, complex_type_hid, H5S_ALL, H5S_ALL, - H5P_DEFAULT, ctmp) >= 0; - } - - H5Dclose (data_hid); - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - - return retval; -} - -bool -octave_sparse_complex_matrix::load_hdf5 (hid_t loc_id, const char *name) -{ - octave_idx_type nr, nc, nz; - hid_t group_hid, data_hid, space_hid; - hsize_t rank; - - dim_vector dv; - int empty = load_hdf5_empty (loc_id, name, dv); - if (empty > 0) - matrix.resize (dv); - if (empty) - return (empty > 0); - -#if HAVE_HDF5_18 - group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); -#else - group_hid = H5Gopen (loc_id, name); -#endif - if (group_hid < 0 ) return false; - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "nr", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "nr"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nr) < 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "nc", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "nc"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nc) < 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "nz", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "nz"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, &nz) < 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - - SparseComplexMatrix m (static_cast (nr), - static_cast (nc), - static_cast (nz)); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "cidx", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "cidx"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 2) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - if (static_cast (hdims[0]) != nc + 1 - || static_cast (hdims[1]) != 1) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - octave_idx_type *itmp = m.xcidx (); - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, itmp) < 0) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "ridx", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "ridx"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 2) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - if (static_cast (hdims[0]) != nz - || static_cast (hdims[1]) != 1) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - itmp = m.xridx (); - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, itmp) < 0) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "data", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "data"); -#endif - hid_t type_hid = H5Dget_type (data_hid); - - hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_DOUBLE); - - if (! hdf5_types_compatible (type_hid, complex_type)) - { - H5Tclose (complex_type); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 2) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - if (static_cast (hdims[0]) != nz - || static_cast (hdims[1]) != 1) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - Complex *ctmp = m.xdata (); - bool retval = false; - if (H5Dread (data_hid, complex_type, H5S_ALL, H5S_ALL, - H5P_DEFAULT, ctmp) >= 0 - && m.indices_ok ()) - { - retval = true; - matrix = m; - } - - H5Tclose (complex_type); - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - - return retval; -} - -#endif - -mxArray * -octave_sparse_complex_matrix::as_mxArray (void) const -{ - mwSize nz = nzmax (); - mxArray *retval = new mxArray (mxDOUBLE_CLASS, rows (), columns (), - nz, mxCOMPLEX); - double *pr = static_cast (retval->get_data ()); - double *pi = static_cast (retval->get_imag_data ()); - mwIndex *ir = retval->get_ir (); - mwIndex *jc = retval->get_jc (); - - for (mwIndex i = 0; i < nz; i++) - { - Complex val = matrix.data (i); - pr[i] = std::real (val); - pi[i] = std::imag (val); - ir[i] = matrix.ridx (i); - } - - for (mwIndex i = 0; i < columns () + 1; i++) - jc[i] = matrix.cidx (i); - - return retval; -} - -octave_value -octave_sparse_complex_matrix::map (unary_mapper_t umap) const -{ - switch (umap) - { - // Mappers handled specially. - case umap_real: - return ::real (matrix); - case umap_imag: - return ::imag (matrix); - -#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.FCN ()) - - ARRAY_METHOD_MAPPER (abs, abs); - -#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.map (FCN)) - - ARRAY_MAPPER (acos, Complex, ::acos); - ARRAY_MAPPER (acosh, Complex, ::acosh); - ARRAY_MAPPER (angle, double, std::arg); - ARRAY_MAPPER (arg, double, std::arg); - ARRAY_MAPPER (asin, Complex, ::asin); - ARRAY_MAPPER (asinh, Complex, ::asinh); - ARRAY_MAPPER (atan, Complex, ::atan); - ARRAY_MAPPER (atanh, Complex, ::atanh); - ARRAY_MAPPER (ceil, Complex, ::ceil); - ARRAY_MAPPER (conj, Complex, std::conj); - ARRAY_MAPPER (cos, Complex, std::cos); - ARRAY_MAPPER (cosh, Complex, std::cosh); - ARRAY_MAPPER (exp, Complex, std::exp); - ARRAY_MAPPER (expm1, Complex, ::expm1); - ARRAY_MAPPER (fix, Complex, ::fix); - ARRAY_MAPPER (floor, Complex, ::floor); - ARRAY_MAPPER (log, Complex, std::log); - ARRAY_MAPPER (log2, Complex, xlog2); - ARRAY_MAPPER (log10, Complex, std::log10); - ARRAY_MAPPER (log1p, Complex, ::log1p); - ARRAY_MAPPER (round, Complex, xround); - ARRAY_MAPPER (roundb, Complex, xroundb); - ARRAY_MAPPER (signum, Complex, ::signum); - ARRAY_MAPPER (sin, Complex, std::sin); - ARRAY_MAPPER (sinh, Complex, std::sinh); - ARRAY_MAPPER (sqrt, Complex, std::sqrt); - ARRAY_MAPPER (tan, Complex, std::tan); - ARRAY_MAPPER (tanh, Complex, std::tanh); - ARRAY_MAPPER (isnan, bool, xisnan); - ARRAY_MAPPER (isna, bool, octave_is_NA); - ARRAY_MAPPER (isinf, bool, xisinf); - ARRAY_MAPPER (finite, bool, xfinite); - - default: // Attempt to go via dense matrix. - return octave_base_sparse::map (umap); - } -} diff -r d02b229ce693 -r a132d206a36a src/ov-cx-sparse.h --- a/src/ov-cx-sparse.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,160 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_sparse_complex_matrix_h) -#define octave_sparse_complex_matrix_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-stream.h" -#include "ov-base.h" -#include "ov-typeinfo.h" - -#include "CSparse.h" -#include "ov-base-sparse.h" -#include "ov-re-sparse.h" - -class octave_value_list; - -class tree_walker; - -class -OCTINTERP_API -octave_sparse_complex_matrix : public octave_base_sparse -{ -public: - - octave_sparse_complex_matrix (void) - : octave_base_sparse () { } - - octave_sparse_complex_matrix (const ComplexNDArray& m) - : octave_base_sparse (SparseComplexMatrix (m)) { } - - octave_sparse_complex_matrix (const ComplexMatrix& m) - : octave_base_sparse (SparseComplexMatrix (m)) { } - - octave_sparse_complex_matrix (const SparseComplexMatrix& m) - : octave_base_sparse (m) { } - - octave_sparse_complex_matrix (const SparseComplexMatrix& m, - const MatrixType &t) - : octave_base_sparse (m, t) { } - - octave_sparse_complex_matrix (const MSparse& m) - : octave_base_sparse (m) { } - - octave_sparse_complex_matrix (const MSparse& m, - const MatrixType &t) - : octave_base_sparse (m, t) { } - - octave_sparse_complex_matrix (const Sparse& m, - const MatrixType &t) - : octave_base_sparse (SparseComplexMatrix (m), t) { } - - octave_sparse_complex_matrix (const Sparse& m) - : octave_base_sparse (SparseComplexMatrix (m)) { } - - octave_sparse_complex_matrix (const octave_sparse_complex_matrix& cm) - : octave_base_sparse (cm) { } - - ~octave_sparse_complex_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_sparse_complex_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_sparse_complex_matrix (); } - - octave_base_value *try_narrowing_conversion (void); - - builtin_type_t builtin_type (void) const { return btyp_complex; } - - bool is_complex_matrix (void) const { return true; } - - bool is_complex_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - double double_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const; - - Complex complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const; - - charNDArray char_array_value (bool frc_str_conv = false) const; - - SparseMatrix sparse_matrix_value (bool = false) const; - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const - { return matrix; } - - SparseBoolMatrix sparse_bool_matrix_value (bool warn = false) const; - -#if 0 - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { - // Yes, for compatibility, we drop the imaginary part here. - return os.write (matrix_value (true), block_size, output_type, - skip, flt_fmt); - } -#endif - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const; - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-dld-fcn.cc --- a/src/ov-dld-fcn.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,90 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "oct-shlib.h" - -#include -#include "dynamic-ld.h" -#include "error.h" -#include "oct-obj.h" -#include "ov-dld-fcn.h" -#include "ov.h" - -DEFINE_OCTAVE_ALLOCATOR (octave_dld_function); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_dld_function, - "dynamically-linked function", - "dynamically-linked function"); - - -octave_dld_function::octave_dld_function - (octave_builtin::fcn ff, const octave_shlib& shl, - const std::string& nm, const std::string& ds) - : octave_builtin (ff, nm, ds), sh_lib (shl) -{ - mark_fcn_file_up_to_date (time_parsed ()); - - std::string file_name = fcn_file_name (); - - system_fcn_file - = (! file_name.empty () - && Voct_file_dir == file_name.substr (0, Voct_file_dir.length ())); -} - -octave_dld_function::~octave_dld_function (void) -{ - octave_dynamic_loader::remove_oct (my_name, sh_lib); -} - -std::string -octave_dld_function::fcn_file_name (void) const -{ - return sh_lib.file_name (); -} - -octave_time -octave_dld_function::time_parsed (void) const -{ - return sh_lib.time_loaded (); -} - -// Note: this wrapper around the octave_dld_function constructor is -// necessary to work around a MSVC limitation handling in -// virtual destructors that prevents unloading a dynamic module -// before *all* objects (of class using a virtual dtor) have -// been fully deleted; indeed, MSVC attaches auto-generated code -// (scalar deleting destructor) to objects created in a dynamic -// module, and this code will be executed in the dynamic module -// context at object deletion; unloading the dynamic module -// before objects have been deleted will make the "delete" code -// of objects to point to an invalid code segment. - -octave_dld_function* -octave_dld_function::create (octave_builtin::fcn ff, const octave_shlib& shl, - const std::string& nm, const std::string& ds) -{ - return new octave_dld_function (ff, shl, nm, ds); -} diff -r d02b229ce693 -r a132d206a36a src/ov-dld-fcn.h --- a/src/ov-dld-fcn.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,103 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_dld_function_h) -#define octave_dld_function_h 1 - -#include - -#include "oct-shlib.h" - -#include "ov-fcn.h" -#include "ov-builtin.h" -#include "ov-typeinfo.h" - -class octave_shlib; - -class octave_value; -class octave_value_list; - -// Dynamically-linked functions. - -class -OCTINTERP_API -octave_dld_function : public octave_builtin -{ -public: - - octave_dld_function (void) - : sh_lib (), t_checked (), system_fcn_file () - { } - - octave_dld_function (octave_builtin::fcn ff, const octave_shlib& shl, - const std::string& nm = std::string (), - const std::string& ds = std::string ()); - - ~octave_dld_function (void); - - void mark_fcn_file_up_to_date (const octave_time& t) { t_checked = t; } - - std::string fcn_file_name (void) const; - - octave_time time_parsed (void) const; - - octave_time time_checked (void) const { return t_checked; } - - bool is_system_fcn_file (void) const { return system_fcn_file; } - - bool is_builtin_function (void) const { return false; } - - bool is_dld_function (void) const { return true; } - - static octave_dld_function* create (octave_builtin::fcn ff, - const octave_shlib& shl, - const std::string& nm = std::string (), - const std::string& ds = std::string ()); - - octave_shlib get_shlib (void) const - { return sh_lib; } - -private: - - octave_shlib sh_lib; - - // The time the file was last checked to see if it needs to be - // parsed again. - mutable octave_time t_checked; - - // True if this function came from a file that is considered to be a - // system function. This affects whether we check the time stamp - // on the file to see if it has changed. - bool system_fcn_file; - - // No copying! - - octave_dld_function (const octave_dld_function& fn); - - octave_dld_function& operator = (const octave_dld_function& fn); - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-fcn-handle.cc --- a/src/ov-fcn-handle.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2000 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague, a.s. -Copyright (C) 2010 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "file-ops.h" -#include "oct-locbuf.h" - -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "oct-map.h" -#include "ov-base.h" -#include "ov-fcn-handle.h" -#include "ov-usr-fcn.h" -#include "pr-output.h" -#include "pt-pr-code.h" -#include "pt-misc.h" -#include "pt-stmt.h" -#include "pt-cmd.h" -#include "pt-exp.h" -#include "pt-assign.h" -#include "pt-arg-list.h" -#include "variables.h" -#include "parse.h" -#include "unwind-prot.h" -#include "defaults.h" -#include "file-stat.h" -#include "load-path.h" -#include "oct-env.h" - -#include "byte-swap.h" -#include "ls-ascii-helper.h" -#include "ls-hdf5.h" -#include "ls-oct-ascii.h" -#include "ls-oct-binary.h" -#include "ls-utils.h" - -DEFINE_OCTAVE_ALLOCATOR (octave_fcn_handle); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_fcn_handle, - "function handle", - "function_handle"); - -const std::string octave_fcn_handle::anonymous ("@"); - -octave_fcn_handle::octave_fcn_handle (const octave_value& f, - const std::string& n) - : fcn (f), nm (n), has_overloads (false) -{ - octave_user_function *uf = fcn.user_function_value (true); - - if (uf && nm != anonymous) - symbol_table::cache_name (uf->scope (), nm); - - if (uf && uf->is_nested_function ()) - ::error ("handles to nested functions are not yet supported"); -} - -octave_value_list -octave_fcn_handle::subsref (const std::string& type, - const std::list& idx, - int nargout) -{ - return octave_fcn_handle::subsref (type, idx, nargout, 0); -} - -octave_value_list -octave_fcn_handle::subsref (const std::string& type, - const std::list& idx, - int nargout, const std::list* lvalue_list) -{ - octave_value_list retval; - - switch (type[0]) - { - case '(': - { - int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout; - - retval = do_multi_index_op (tmp_nargout, idx.front (), - idx.size () == 1 ? lvalue_list : 0); - } - break; - - case '{': - case '.': - { - std::string tnm = type_name (); - error ("%s cannot be indexed with %c", tnm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - // FIXME -- perhaps there should be an - // octave_value_list::next_subsref member function? See also - // octave_builtin::subsref. - - if (idx.size () > 1) - retval = retval(0).next_subsref (nargout, type, idx); - - return retval; -} - -octave_value_list -octave_fcn_handle::do_multi_index_op (int nargout, - const octave_value_list& args) -{ - return do_multi_index_op (nargout, args, 0); -} - -octave_value_list -octave_fcn_handle::do_multi_index_op (int nargout, - const octave_value_list& args, - const std::list* lvalue_list) -{ - octave_value_list retval; - - out_of_date_check (fcn, std::string (), false); - - if (has_overloads) - { - // Possibly overloaded function. - octave_value ov_fcn; - - // Compute dispatch type. - builtin_type_t btyp; - std::string dispatch_type = get_dispatch_type (args, btyp); - - // Retrieve overload. - if (btyp != btyp_unknown) - { - out_of_date_check (builtin_overloads[btyp], dispatch_type, false); - ov_fcn = builtin_overloads[btyp]; - } - else - { - str_ov_map::iterator it = overloads.find (dispatch_type); - - if (it == overloads.end ()) - { - // Try parent classes too. - - std::list plist - = symbol_table::parent_classes (dispatch_type); - - std::list::const_iterator pit = plist.begin (); - - while (pit != plist.end ()) - { - std::string pname = *pit; - - std::string fnm = fcn_name (); - - octave_value ftmp = symbol_table::find_method (fnm, pname); - - if (ftmp.is_defined ()) - { - set_overload (pname, ftmp); - - out_of_date_check (ftmp, pname, false); - ov_fcn = ftmp; - - break; - } - - pit++; - } - } - else - { - out_of_date_check (it->second, dispatch_type, false); - ov_fcn = it->second; - } - } - - if (ov_fcn.is_defined ()) - retval = ov_fcn.do_multi_index_op (nargout, args, lvalue_list); - else if (fcn.is_defined ()) - retval = fcn.do_multi_index_op (nargout, args, lvalue_list); - else - error ("%s: no method for class %s", nm.c_str (), dispatch_type.c_str ()); - } - else - { - // Non-overloaded function (anonymous, subfunction, private function). - if (fcn.is_defined ()) - retval = fcn.do_multi_index_op (nargout, args, lvalue_list); - else - error ("%s: no longer valid function handle", nm.c_str ()); - } - - return retval; -} - -bool -octave_fcn_handle::is_equal_to (const octave_fcn_handle& h) const -{ - bool retval = fcn.is_copy_of (h.fcn) && (has_overloads == h.has_overloads); - retval = retval && (overloads.size () == h.overloads.size ()); - - if (retval && has_overloads) - { - for (int i = 0; i < btyp_num_types && retval; i++) - retval = builtin_overloads[i].is_copy_of (h.builtin_overloads[i]); - - str_ov_map::const_iterator iter = overloads.begin (), hiter = h.overloads.begin (); - for (; iter != overloads.end () && retval; iter++, hiter++) - retval = (iter->first == hiter->first) && (iter->second.is_copy_of (hiter->second)); - } - - return retval; -} - -bool -octave_fcn_handle::set_fcn (const std::string &octaveroot, - const std::string& fpath) -{ - bool success = true; - - if (octaveroot.length () != 0 - && fpath.length () >= octaveroot.length () - && fpath.substr (0, octaveroot.length ()) == octaveroot - && OCTAVE_EXEC_PREFIX != octaveroot) - { - // First check if just replacing matlabroot is enough - std::string str = OCTAVE_EXEC_PREFIX + - fpath.substr (octaveroot.length ()); - file_stat fs (str); - - if (fs.exists ()) - { - size_t xpos = str.find_last_of (file_ops::dir_sep_chars ()); - - std::string dir_name = str.substr (0, xpos); - - octave_function *xfcn - = load_fcn_from_file (str, dir_name, "", nm); - - if (xfcn) - { - octave_value tmp (xfcn); - - fcn = octave_value (new octave_fcn_handle (tmp, nm)); - } - else - { - error ("function handle points to non-existent function"); - success = false; - } - } - else - { - // Next just search for it anywhere in the system path - string_vector names(3); - names(0) = nm + ".oct"; - names(1) = nm + ".mex"; - names(2) = nm + ".m"; - - dir_path p (load_path::system_path ()); - - str = octave_env::make_absolute (p.find_first_of (names)); - - size_t xpos = str.find_last_of (file_ops::dir_sep_chars ()); - - std::string dir_name = str.substr (0, xpos); - - octave_function *xfcn = load_fcn_from_file (str, dir_name, "", nm); - - if (xfcn) - { - octave_value tmp (xfcn); - - fcn = octave_value (new octave_fcn_handle (tmp, nm)); - } - else - { - error ("function handle points to non-existent function"); - success = false; - } - } - } - else - { - if (fpath.length () > 0) - { - size_t xpos = fpath.find_last_of (file_ops::dir_sep_chars ()); - - std::string dir_name = fpath.substr (0, xpos); - - octave_function *xfcn = load_fcn_from_file (fpath, dir_name, "", nm); - - if (xfcn) - { - octave_value tmp (xfcn); - - fcn = octave_value (new octave_fcn_handle (tmp, nm)); - } - else - { - error ("function handle points to non-existent function"); - success = false; - } - } - else - { - fcn = symbol_table::find_function (nm); - - if (! fcn.is_function ()) - { - error ("function handle points to non-existent function"); - success = false; - } - } - } - - return success; -} - -bool -octave_fcn_handle::save_ascii (std::ostream& os) -{ - if (nm == anonymous) - { - os << nm << "\n"; - - print_raw (os, true); - os << "\n"; - - if (fcn.is_undefined ()) - return false; - - octave_user_function *f = fcn.user_function_value (); - - std::list vars - = symbol_table::all_variables (f->scope (), 0); - - size_t varlen = vars.size (); - - if (varlen > 0) - { - os << "# length: " << varlen << "\n"; - - for (std::list::const_iterator p = vars.begin (); - p != vars.end (); p++) - { - if (! save_ascii_data (os, p->varval (), p->name (), false, 0)) - return os; - } - } - } - else - { - octave_function *f = function_value (); - std::string fnm = f ? f->fcn_file_name () : std::string (); - - os << "# octaveroot: " << OCTAVE_EXEC_PREFIX << "\n"; - if (! fnm.empty ()) - os << "# path: " << fnm << "\n"; - os << nm << "\n"; - } - - return true; -} - -bool -octave_fcn_handle::load_ascii (std::istream& is) -{ - bool success = true; - - std::streampos pos = is.tellg (); - std::string octaveroot = extract_keyword (is, "octaveroot", true); - if (octaveroot.length () == 0) - { - is.seekg (pos); - is.clear (); - } - pos = is.tellg (); - std::string fpath = extract_keyword (is, "path", true); - if (fpath.length () == 0) - { - is.seekg (pos); - is.clear (); - } - - is >> nm; - - if (nm == anonymous) - { - skip_preceeding_newline (is); - - std::string buf; - - if (is) - { - - // Get a line of text whitespace characters included, leaving - // newline in the stream. - buf = read_until_newline (is, true); - - } - - pos = is.tellg (); - - unwind_protect_safe frame; - - // Set up temporary scope to use for evaluating the text that - // defines the anonymous function. - - symbol_table::scope_id local_scope = symbol_table::alloc_scope (); - frame.add_fcn (symbol_table::erase_scope, local_scope); - - symbol_table::set_scope (local_scope); - - octave_call_stack::push (local_scope, 0); - frame.add_fcn (octave_call_stack::pop); - - octave_idx_type len = 0; - - if (extract_keyword (is, "length", len, true) && len >= 0) - { - if (len > 0) - { - for (octave_idx_type i = 0; i < len; i++) - { - octave_value t2; - bool dummy; - - std::string name - = read_ascii_data (is, std::string (), dummy, t2, i); - - if (!is) - { - error ("load: failed to load anonymous function handle"); - break; - } - - symbol_table::varref (name, local_scope, 0) = t2; - } - } - } - else - { - is.seekg (pos); - is.clear (); - } - - if (is && success) - { - int parse_status; - octave_value anon_fcn_handle = - eval_string (buf, true, parse_status); - - if (parse_status == 0) - { - octave_fcn_handle *fh = - anon_fcn_handle.fcn_handle_value (); - - if (fh) - { - fcn = fh->fcn; - - octave_user_function *uf = fcn.user_function_value (true); - - if (uf) - symbol_table::cache_name (uf->scope (), nm); - } - else - success = false; - } - else - success = false; - } - else - success = false; - } - else - success = set_fcn (octaveroot, fpath); - - return success; -} - -bool -octave_fcn_handle::save_binary (std::ostream& os, bool& save_as_floats) -{ - if (nm == anonymous) - { - std::ostringstream nmbuf; - - if (fcn.is_undefined ()) - return false; - - octave_user_function *f = fcn.user_function_value (); - - std::list vars - = symbol_table::all_variables (f->scope (), 0); - - size_t varlen = vars.size (); - - if (varlen > 0) - nmbuf << nm << " " << varlen; - else - nmbuf << nm; - - std::string buf_str = nmbuf.str (); - int32_t tmp = buf_str.length (); - os.write (reinterpret_cast (&tmp), 4); - os.write (buf_str.c_str (), buf_str.length ()); - - std::ostringstream buf; - print_raw (buf, true); - std::string stmp = buf.str (); - tmp = stmp.length (); - os.write (reinterpret_cast (&tmp), 4); - os.write (stmp.c_str (), stmp.length ()); - - if (varlen > 0) - { - for (std::list::const_iterator p = vars.begin (); - p != vars.end (); p++) - { - if (! save_binary_data (os, p->varval (), p->name (), - "", 0, save_as_floats)) - return os; - } - } - } - else - { - std::ostringstream nmbuf; - - octave_function *f = function_value (); - std::string fnm = f ? f->fcn_file_name () : std::string (); - - nmbuf << nm << "\n" << OCTAVE_EXEC_PREFIX << "\n" << fnm; - - std::string buf_str = nmbuf.str (); - int32_t tmp = buf_str.length (); - os.write (reinterpret_cast (&tmp), 4); - os.write (buf_str.c_str (), buf_str.length ()); - } - - return true; -} - -bool -octave_fcn_handle::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - bool success = true; - - int32_t tmp; - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - if (swap) - swap_bytes<4> (&tmp); - - OCTAVE_LOCAL_BUFFER (char, ctmp1, tmp+1); - // is.get (ctmp1, tmp+1, 0); caused is.eof () to be true though - // effectively not reading over file end - is.read (ctmp1, tmp); - ctmp1[tmp] = 0; - nm = std::string (ctmp1); - - if (! is) - return false; - - size_t anl = anonymous.length (); - - if (nm.length () >= anl && nm.substr (0, anl) == anonymous) - { - octave_idx_type len = 0; - - if (nm.length () > anl) - { - std::istringstream nm_is (nm.substr (anl)); - nm_is >> len; - nm = nm.substr (0, anl); - } - - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - if (swap) - swap_bytes<4> (&tmp); - - OCTAVE_LOCAL_BUFFER (char, ctmp2, tmp+1); - // is.get (ctmp2, tmp+1, 0); caused is.eof () to be true though - // effectively not reading over file end - is.read (ctmp2, tmp); - ctmp2[tmp] = 0; - - unwind_protect_safe frame; - - // Set up temporary scope to use for evaluating the text that - // defines the anonymous function. - - symbol_table::scope_id local_scope = symbol_table::alloc_scope (); - frame.add_fcn (symbol_table::erase_scope, local_scope); - - symbol_table::set_scope (local_scope); - - octave_call_stack::push (local_scope, 0); - frame.add_fcn (octave_call_stack::pop); - - if (len > 0) - { - for (octave_idx_type i = 0; i < len; i++) - { - octave_value t2; - bool dummy; - std::string doc; - - std::string name = - read_binary_data (is, swap, fmt, std::string (), - dummy, t2, doc); - - if (!is) - { - error ("load: failed to load anonymous function handle"); - break; - } - - symbol_table::varref (name, local_scope) = t2; - } - } - - if (is && success) - { - int parse_status; - octave_value anon_fcn_handle = - eval_string (ctmp2, true, parse_status); - - if (parse_status == 0) - { - octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value (); - - if (fh) - { - fcn = fh->fcn; - - octave_user_function *uf = fcn.user_function_value (true); - - if (uf) - symbol_table::cache_name (uf->scope (), nm); - } - else - success = false; - } - else - success = false; - } - } - else - { - std::string octaveroot; - std::string fpath; - - if (nm.find_first_of ("\n") != std::string::npos) - { - size_t pos1 = nm.find_first_of ("\n"); - size_t pos2 = nm.find_first_of ("\n", pos1 + 1); - octaveroot = nm.substr (pos1 + 1, pos2 - pos1 - 1); - fpath = nm.substr (pos2 + 1); - nm = nm.substr (0, pos1); - } - - success = set_fcn (octaveroot, fpath); - } - - return success; -} - -#if defined (HAVE_HDF5) -bool -octave_fcn_handle::save_hdf5 (hid_t loc_id, const char *name, - bool save_as_floats) -{ - bool retval = true; - - hid_t group_hid = -1; -#if HAVE_HDF5_18 - group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - group_hid = H5Gcreate (loc_id, name, 0); -#endif - if (group_hid < 0) - return false; - - hid_t space_hid = -1, data_hid = -1, type_hid = -1;; - - // attach the type of the variable - type_hid = H5Tcopy (H5T_C_S1); - H5Tset_size (type_hid, nm.length () + 1); - if (type_hid < 0) - { - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, 2); - hdims[0] = 0; - hdims[1] = 0; - space_hid = H5Screate_simple (0 , hdims, 0); - if (space_hid < 0) - { - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "nm", type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "nm", type_hid, space_hid, H5P_DEFAULT); -#endif - if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, - H5P_DEFAULT, nm.c_str ()) < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - H5Dclose (data_hid); - - if (nm == anonymous) - { - std::ostringstream buf; - print_raw (buf, true); - std::string stmp = buf.str (); - - // attach the type of the variable - H5Tset_size (type_hid, stmp.length () + 1); - if (type_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "fcn", type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "fcn", type_hid, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, - H5P_DEFAULT, stmp.c_str ()) < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - - octave_user_function *f = fcn.user_function_value (); - - std::list vars - = symbol_table::all_variables (f->scope (), 0); - - size_t varlen = vars.size (); - - if (varlen > 0) - { - hid_t as_id = H5Screate (H5S_SCALAR); - - if (as_id >= 0) - { -#if HAVE_HDF5_18 - hid_t a_id = H5Acreate (group_hid, "SYMBOL_TABLE", - H5T_NATIVE_IDX, as_id, - H5P_DEFAULT, H5P_DEFAULT); - -#else - hid_t a_id = H5Acreate (group_hid, "SYMBOL_TABLE", - H5T_NATIVE_IDX, as_id, H5P_DEFAULT); -#endif - - if (a_id >= 0) - { - retval = (H5Awrite (a_id, H5T_NATIVE_IDX, &varlen) >= 0); - - H5Aclose (a_id); - } - else - retval = false; - - H5Sclose (as_id); - } - else - retval = false; -#if HAVE_HDF5_18 - data_hid = H5Gcreate (group_hid, "symbol table", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Gcreate (group_hid, "symbol table", 0); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - - for (std::list::const_iterator p = vars.begin (); - p != vars.end (); p++) - { - if (! add_hdf5_data (data_hid, p->varval (), p->name (), - "", false, save_as_floats)) - break; - } - H5Gclose (data_hid); - } - } - else - { - std::string octaveroot = OCTAVE_EXEC_PREFIX; - - octave_function *f = function_value (); - std::string fpath = f ? f->fcn_file_name () : std::string (); - - H5Sclose (space_hid); - hdims[0] = 1; - hdims[1] = octaveroot.length (); - space_hid = H5Screate_simple (0 , hdims, 0); - if (space_hid < 0) - { - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - - H5Tclose (type_hid); - type_hid = H5Tcopy (H5T_C_S1); - H5Tset_size (type_hid, octaveroot.length () + 1); -#if HAVE_HDF5_18 - hid_t a_id = H5Acreate (group_hid, "OCTAVEROOT", - type_hid, space_hid, H5P_DEFAULT, H5P_DEFAULT); -#else - hid_t a_id = H5Acreate (group_hid, "OCTAVEROOT", - type_hid, space_hid, H5P_DEFAULT); -#endif - - if (a_id >= 0) - { - retval = (H5Awrite (a_id, type_hid, octaveroot.c_str ()) >= 0); - - H5Aclose (a_id); - } - else - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - hdims[0] = 1; - hdims[1] = fpath.length (); - space_hid = H5Screate_simple (0 , hdims, 0); - if (space_hid < 0) - { - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - - H5Tclose (type_hid); - type_hid = H5Tcopy (H5T_C_S1); - H5Tset_size (type_hid, fpath.length () + 1); - -#if HAVE_HDF5_18 - a_id = H5Acreate (group_hid, "FILE", type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT); -#else - a_id = H5Acreate (group_hid, "FILE", type_hid, space_hid, H5P_DEFAULT); -#endif - - if (a_id >= 0) - { - retval = (H5Awrite (a_id, type_hid, fpath.c_str ()) >= 0); - - H5Aclose (a_id); - } - else - retval = false; - } - - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - - return retval; -} - -bool -octave_fcn_handle::load_hdf5 (hid_t loc_id, const char *name) -{ - bool success = true; - - hid_t group_hid, data_hid, space_hid, type_hid, type_class_hid, st_id; - hsize_t rank; - int slen; - -#if HAVE_HDF5_18 - group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); -#else - group_hid = H5Gopen (loc_id, name); -#endif - if (group_hid < 0) - return false; - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "nm", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "nm"); -#endif - - if (data_hid < 0) - { - H5Gclose (group_hid); - return false; - } - - type_hid = H5Dget_type (data_hid); - type_class_hid = H5Tget_class (type_hid); - - if (type_class_hid != H5T_STRING) - { - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - slen = H5Tget_size (type_hid); - if (slen < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (char, nm_tmp, slen); - - // create datatype for (null-terminated) string to read into: - st_id = H5Tcopy (H5T_C_S1); - H5Tset_size (st_id, slen); - - if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, nm_tmp) < 0) - { - H5Tclose (st_id); - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - H5Tclose (st_id); - H5Dclose (data_hid); - nm = nm_tmp; - - if (nm == anonymous) - { -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "fcn", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "fcn"); -#endif - - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - - H5Tclose (type_hid); - type_hid = H5Dget_type (data_hid); - type_class_hid = H5Tget_class (type_hid); - - if (type_class_hid != H5T_STRING) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - slen = H5Tget_size (type_hid); - if (slen < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (char, fcn_tmp, slen); - - // create datatype for (null-terminated) string to read into: - st_id = H5Tcopy (H5T_C_S1); - H5Tset_size (st_id, slen); - - if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, fcn_tmp) < 0) - { - H5Tclose (st_id); - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - H5Tclose (st_id); - H5Dclose (data_hid); - - octave_idx_type len = 0; - - // we have to pull some shenanigans here to make sure - // HDF5 doesn't print out all sorts of error messages if we - // call H5Aopen for a non-existing attribute - - H5E_auto_t err_func; - void *err_func_data; - - // turn off error reporting temporarily, but save the error - // reporting function: -#if HAVE_HDF5_18 - H5Eget_auto (H5E_DEFAULT, &err_func, &err_func_data); - H5Eset_auto (H5E_DEFAULT, 0, 0); -#else - H5Eget_auto (&err_func, &err_func_data); - H5Eset_auto (0, 0); -#endif - - hid_t attr_id = H5Aopen_name (group_hid, "SYMBOL_TABLE"); - - if (attr_id >= 0) - { - if (H5Aread (attr_id, H5T_NATIVE_IDX, &len) < 0) - success = false; - - H5Aclose (attr_id); - } - - // restore error reporting: -#if HAVE_HDF5_18 - H5Eset_auto (H5E_DEFAULT, err_func, err_func_data); -#else - H5Eset_auto (err_func, err_func_data); -#endif - - unwind_protect_safe frame; - - // Set up temporary scope to use for evaluating the text that - // defines the anonymous function. - - symbol_table::scope_id local_scope = symbol_table::alloc_scope (); - frame.add_fcn (symbol_table::erase_scope, local_scope); - - symbol_table::set_scope (local_scope); - - octave_call_stack::push (local_scope, 0); - frame.add_fcn (octave_call_stack::pop); - - if (len > 0 && success) - { - hsize_t num_obj = 0; -#if HAVE_HDF5_18 - data_hid = H5Gopen (group_hid, "symbol table", H5P_DEFAULT); -#else - data_hid = H5Gopen (group_hid, "symbol table"); -#endif - H5Gget_num_objs (data_hid, &num_obj); - H5Gclose (data_hid); - - if (num_obj != static_cast(len)) - { - error ("load: failed to load anonymous function handle"); - success = false; - } - - if (! error_state) - { - hdf5_callback_data dsub; - int current_item = 0; - for (octave_idx_type i = 0; i < len; i++) - { - if (H5Giterate (group_hid, "symbol table", ¤t_item, - hdf5_read_next_data, &dsub) <= 0) - { - error ("load: failed to load anonymous function handle"); - success = false; - break; - } - - symbol_table::varref (dsub.name, local_scope) = dsub.tc; - } - } - } - - if (success) - { - int parse_status; - octave_value anon_fcn_handle = - eval_string (fcn_tmp, true, parse_status); - - if (parse_status == 0) - { - octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value (); - - if (fh) - { - fcn = fh->fcn; - - octave_user_function *uf = fcn.user_function_value (true); - - if (uf) - symbol_table::cache_name (uf->scope (), nm); - } - else - success = false; - } - else - success = false; - } - - frame.run (); - } - else - { - std::string octaveroot; - std::string fpath; - - // we have to pull some shenanigans here to make sure - // HDF5 doesn't print out all sorts of error messages if we - // call H5Aopen for a non-existing attribute - - H5E_auto_t err_func; - void *err_func_data; - - // turn off error reporting temporarily, but save the error - // reporting function: -#if HAVE_HDF5_18 - H5Eget_auto (H5E_DEFAULT, &err_func, &err_func_data); - H5Eset_auto (H5E_DEFAULT, 0, 0); -#else - H5Eget_auto (&err_func, &err_func_data); - H5Eset_auto (0, 0); -#endif - - hid_t attr_id = H5Aopen_name (group_hid, "OCTAVEROOT"); - if (attr_id >= 0) - { - H5Tclose (type_hid); - type_hid = H5Aget_type (attr_id); - type_class_hid = H5Tget_class (type_hid); - - if (type_class_hid != H5T_STRING) - success = false; - else - { - slen = H5Tget_size (type_hid); - st_id = H5Tcopy (H5T_C_S1); - H5Tset_size (st_id, slen); - OCTAVE_LOCAL_BUFFER (char, root_tmp, slen); - - if (H5Aread (attr_id, st_id, root_tmp) < 0) - success = false; - else - octaveroot = root_tmp; - - H5Tclose (st_id); - } - - H5Aclose (attr_id); - } - - if (success) - { - attr_id = H5Aopen_name (group_hid, "FILE"); - if (attr_id >= 0) - { - H5Tclose (type_hid); - type_hid = H5Aget_type (attr_id); - type_class_hid = H5Tget_class (type_hid); - - if (type_class_hid != H5T_STRING) - success = false; - else - { - slen = H5Tget_size (type_hid); - st_id = H5Tcopy (H5T_C_S1); - H5Tset_size (st_id, slen); - OCTAVE_LOCAL_BUFFER (char, path_tmp, slen); - - if (H5Aread (attr_id, st_id, path_tmp) < 0) - success = false; - else - fpath = path_tmp; - - H5Tclose (st_id); - } - - H5Aclose (attr_id); - } - } - - // restore error reporting: -#if HAVE_HDF5_18 - H5Eset_auto (H5E_DEFAULT, err_func, err_func_data); -#else - H5Eset_auto (err_func, err_func_data); -#endif - - success = (success ? set_fcn (octaveroot, fpath) : success); - } - - H5Tclose (type_hid); - H5Sclose (space_hid); - H5Gclose (group_hid); - - return success; -} - -#endif - -/* -%!test -%! a = 2; -%! f = @(x) a + x; -%! g = @(x) 2 * x; -%! hm = @version; -%! hdld = @svd; -%! hbi = @log2; -%! f2 = f; -%! g2 = g; -%! hm2 = hm; -%! hdld2 = hdld; -%! hbi2 = hbi; -%! modes = {"-text", "-binary"}; -%! if (!isempty (findstr (octave_config_info ("DEFS"), "HAVE_HDF5"))) -%! modes(end+1) = "-hdf5"; -%! endif -%! for i = 1:numel (modes) -%! mode = modes{i}; -%! nm = tmpnam (); -%! unwind_protect -%! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2"); -%! clear f2 g2 hm2 hdld2 hbi2 -%! load (nm); -%! assert (f (2), f2 (2)); -%! assert (g (2), g2 (2)); -%! assert (g (3), g2 (3)); -%! unlink (nm); -%! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2"); -%! unwind_protect_cleanup -%! unlink (nm); -%! end_unwind_protect -%! endfor -*/ - -void -octave_fcn_handle::print (std::ostream& os, bool pr_as_read_syntax) const -{ - print_raw (os, pr_as_read_syntax); - newline (os); -} - -void -octave_fcn_handle::print_raw (std::ostream& os, bool pr_as_read_syntax) const -{ - bool printed = false; - - if (nm == anonymous) - { - tree_print_code tpc (os); - - // FCN is const because this member function is, so we can't - // use it to call user_function_value, so we make a copy first. - - octave_value ftmp = fcn; - - octave_user_function *f = ftmp.user_function_value (); - - if (f) - { - tree_parameter_list *p = f->parameter_list (); - - os << "@("; - - if (p) - p->accept (tpc); - - os << ") "; - - tpc.print_fcn_handle_body (f->body ()); - - printed = true; - } - } - - if (! printed) - octave_print_internal (os, "@" + nm, pr_as_read_syntax, - current_print_indent_level ()); -} - -octave_value -make_fcn_handle (const std::string& nm, bool local_funcs) -{ - octave_value retval; - - // Bow to the god of compatibility. - - // FIXME -- it seems ugly to put this here, but there is no single - // function in the parser that converts from the operator name to - // the corresponding function name. At least try to do it without N - // string compares. - - std::string tnm = nm; - - size_t len = nm.length (); - - if (len == 3 && nm == ".**") - tnm = "power"; - else if (len == 2) - { - if (nm[0] == '.') - { - switch (nm[1]) - { - case '\'': - tnm = "transpose"; - break; - - case '+': - tnm = "plus"; - break; - - case '-': - tnm = "minus"; - break; - - case '*': - tnm = "times"; - break; - - case '/': - tnm = "rdivide"; - break; - - case '^': - tnm = "power"; - break; - - case '\\': - tnm = "ldivide"; - break; - } - } - else if (nm[1] == '=') - { - switch (nm[0]) - { - case '<': - tnm = "le"; - break; - - case '=': - tnm = "eq"; - break; - - case '>': - tnm = "ge"; - break; - - case '~': - case '!': - tnm = "ne"; - break; - } - } - else if (nm == "**") - tnm = "mpower"; - } - else if (len == 1) - { - switch (nm[0]) - { - case '~': - case '!': - tnm = "not"; - break; - - case '\'': - tnm = "ctranspose"; - break; - - case '+': - tnm = "plus"; - break; - - case '-': - tnm = "minus"; - break; - - case '*': - tnm = "mtimes"; - break; - - case '/': - tnm = "mrdivide"; - break; - - case '^': - tnm = "mpower"; - break; - - case '\\': - tnm = "mldivide"; - break; - - case '<': - tnm = "lt"; - break; - - case '>': - tnm = "gt"; - break; - - case '&': - tnm = "and"; - break; - - case '|': - tnm = "or"; - break; - } - } - - octave_value f = symbol_table::find_function (tnm, octave_value_list (), - local_funcs); - - octave_function *fptr = f.function_value (true); - - // Here we are just looking to see if FCN is a method or constructor - // for any class. - if (local_funcs && fptr - && (fptr->is_subfunction () || fptr->is_private_function () - || fptr->is_class_constructor ())) - { - // Locally visible function. - retval = octave_value (new octave_fcn_handle (f, tnm)); - } - else - { - // Globally visible (or no match yet). Query overloads. - std::list classes = load_path::overloads (tnm); - bool any_match = fptr != 0 || classes.size () > 0; - if (! any_match) - { - // No match found, try updating load_path and query classes again. - load_path::update (); - classes = load_path::overloads (tnm); - any_match = classes.size () > 0; - } - - if (any_match) - { - octave_fcn_handle *fh = new octave_fcn_handle (f, tnm); - retval = fh; - - for (std::list::iterator iter = classes.begin (); - iter != classes.end (); iter++) - { - std::string class_name = *iter; - octave_value fmeth = symbol_table::find_method (tnm, class_name); - - bool is_builtin = false; - for (int i = 0; i < btyp_num_types; i++) - { - // FIXME: Too slow? Maybe binary lookup? - if (class_name == btyp_class_name[i]) - { - is_builtin = true; - fh->set_overload (static_cast (i), fmeth); - } - } - - if (! is_builtin) - fh->set_overload (class_name, fmeth); - } - } - else - error ("@%s: no function and no method found", tnm.c_str ()); - } - - return retval; -} - -/* -%!test -%! x = {".**", "power"; -%! ".'", "transpose"; -%! ".+", "plus"; -%! ".-", "minus"; -%! ".*", "times"; -%! "./", "rdivide"; -%! ".^", "power"; -%! ".\\", "ldivide"; -%! "<=", "le"; -%! "==", "eq"; -%! ">=", "ge"; -%! "~=", "ne"; -%! "!=", "ne"; -%! "**", "mpower"; -%! "~", "not"; -%! "!", "not"; -%! "\'", "ctranspose"; -%! "+", "plus"; -%! "-", "minus"; -%! "*", "mtimes"; -%! "/", "mrdivide"; -%! "^", "mpower"; -%! "\\", "mldivide"; -%! "<", "lt"; -%! ">", "gt"; -%! "&", "and"; -%! "|", "or"}; -%! for i = 1:rows (x) -%! assert (functions (str2func (x{i,1})).function, x{i,2}); -%! endfor -*/ - -DEFUN (functions, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} functions (@var{fcn_handle})\n\ -Return a struct containing information about the function handle\n\ -@var{fcn_handle}.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - octave_fcn_handle *fh = args(0).fcn_handle_value (); - - if (! error_state) - { - octave_function *fcn = fh ? fh->function_value () : 0; - - if (fcn) - { - octave_scalar_map m; - - std::string fh_nm = fh->fcn_name (); - - if (fh_nm == octave_fcn_handle::anonymous) - { - std::ostringstream buf; - fh->print_raw (buf); - m.setfield ("function", buf.str ()); - - m.setfield ("type", "anonymous"); - } - else - { - m.setfield ("function", fh_nm); - - if (fcn->is_subfunction ()) - { - m.setfield ("type", "subfunction"); - Cell parentage (dim_vector (1, 2)); - parentage.elem (0) = fh_nm; - parentage.elem (1) = fcn->parent_fcn_name (); - m.setfield ("parentage", octave_value (parentage)); - } - else if (fcn->is_private_function ()) - m.setfield ("type", "private"); - else if (fh->is_overloaded ()) - m.setfield ("type", "overloaded"); - else - m.setfield ("type", "simple"); - } - - std::string nm = fcn->fcn_file_name (); - - if (fh_nm == octave_fcn_handle::anonymous) - { - m.setfield ("file", nm); - - octave_user_function *fu = fh->user_function_value (); - - std::list vars - = symbol_table::all_variables (fu->scope (), 0); - - size_t varlen = vars.size (); - - if (varlen > 0) - { - octave_scalar_map ws; - for (std::list::const_iterator p = vars.begin (); - p != vars.end (); p++) - { - ws.assign (p->name (), p->varval (0)); - } - - m.setfield ("workspace", ws); - } - } - else if (fcn->is_user_function () || fcn->is_user_script ()) - { - octave_function *fu = fh->function_value (); - m.setfield ("file", fu->fcn_file_name ()); - } - else - m.setfield ("file", ""); - - retval = m; - } - else - error ("functions: FCN_HANDLE is not a valid function handle object"); - } - else - error ("functions: FCN_HANDLE argument must be a function handle object"); - } - else - print_usage (); - - return retval; -} - -DEFUN (func2str, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} func2str (@var{fcn_handle})\n\ -Return a string containing the name of the function referenced by\n\ -the function handle @var{fcn_handle}.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - octave_fcn_handle *fh = args(0).fcn_handle_value (); - - if (! error_state && fh) - { - std::string fh_nm = fh->fcn_name (); - - if (fh_nm == octave_fcn_handle::anonymous) - { - std::ostringstream buf; - - fh->print_raw (buf); - - retval = buf.str (); - } - else - retval = fh_nm; - } - else - error ("func2str: FCN_HANDLE must be a valid function handle"); - } - else - print_usage (); - - return retval; -} - -DEFUN (str2func, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} str2func (@var{fcn_name})\n\ -@deftypefnx {Built-in Function} {} str2func (@var{fcn_name}, \"global\")\n\ -Return a function handle constructed from the string @var{fcn_name}.\n\ -If the optional \"global\" argument is passed, locally visible functions\n\ -are ignored in the lookup.\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string nm = args(0).string_value (); - - if (! error_state) - retval = make_fcn_handle (nm, nargin != 2); - else - error ("str2func: FCN_NAME must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!function y = __testrecursionfunc (f, x, n) -%! if (nargin < 3) -%! n = 0; -%! endif -%! if (n > 2) -%! y = f (x); -%! else -%! n++; -%! y = __testrecursionfunc (@(x) f (2*x), x, n); -%! endif -%!endfunction -%! -%!assert (__testrecursionfunc (@(x) x, 1), 8) -*/ - -DEFUN (is_function_handle, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} is_function_handle (@var{x})\n\ -Return true if @var{x} is a function handle.\n\ -@seealso{isa, typeinfo, class}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - retval = args(0).is_function_handle (); - else - print_usage (); - - return retval; -} - -/* -%!shared fh -%! fh = @(x) x; - -%!assert (is_function_handle (fh)) -%!assert (! is_function_handle ({fh})) -%!assert (! is_function_handle (1)) - -%!error is_function_handle () -%!error is_function_handle (1, 2) -*/ - -octave_fcn_binder::octave_fcn_binder (const octave_value& f, - const octave_value& root, - const octave_value_list& templ, - const std::vector& mask, - int exp_nargin) -: octave_fcn_handle (f), root_handle (root), arg_template (templ), - arg_mask (mask), expected_nargin (exp_nargin) -{ -} - -octave_fcn_handle * -octave_fcn_binder::maybe_binder (const octave_value& f) -{ - octave_fcn_handle *retval = 0; - - octave_user_function *usr_fcn = f.user_function_value (false); - tree_parameter_list *param_list = usr_fcn ? usr_fcn->parameter_list () : 0; - - // Verify that the body is a single expression (always true in theory). - - tree_statement_list *cmd_list = usr_fcn ? usr_fcn->body () : 0; - tree_expression *body_expr = (cmd_list->length () == 1 - ? cmd_list->front ()->expression () : 0); - - - if (body_expr && body_expr->is_index_expression () - && ! (param_list && param_list->takes_varargs ())) - { - // It's an index expression. - tree_index_expression *idx_expr = dynamic_cast (body_expr); - tree_expression *head_expr = idx_expr->expression (); - std::list arg_lists = idx_expr->arg_lists (); - std::string type_tags = idx_expr->type_tags (); - - if (type_tags.length () == 1 && type_tags[0] == '(' - && head_expr->is_identifier ()) - { - assert (arg_lists.size () == 1); - - // It's a single index expression: a(x,y,....) - tree_identifier *head_id = dynamic_cast (head_expr); - tree_argument_list *arg_list = arg_lists.front (); - - // Build a map of input params to their position. - std::map arginmap; - int npar = 0; - - if (param_list) - { - for (tree_parameter_list::iterator it = param_list->begin (); - it != param_list->end (); ++it, ++npar) - { - tree_decl_elt *elt = *it; - tree_identifier *id = elt ? elt->ident () : 0; - if (id && ! id->is_black_hole ()) - arginmap[id->name ()] = npar; - } - } - - if (arg_list && arg_list->length () > 0) - { - bool bad = false; - int nargs = arg_list->length (); - octave_value_list arg_template (nargs); - std::vector arg_mask (nargs); - - // Verify that each argument is either a named param, a constant, or a defined identifier. - int iarg = 0; - for (tree_argument_list::iterator it = arg_list->begin (); - it != arg_list->end (); ++it, ++iarg) - { - tree_expression *elt = *it; - if (elt && elt->is_constant ()) - { - arg_template(iarg) = elt->rvalue1 (); - arg_mask[iarg] = -1; - } - else if (elt && elt->is_identifier ()) - { - tree_identifier *elt_id = dynamic_cast (elt); - if (arginmap.find (elt_id->name ()) != arginmap.end ()) - { - arg_mask[iarg] = arginmap[elt_id->name ()]; - } - else if (elt_id->is_defined ()) - { - arg_template(iarg) = elt_id->rvalue1 (); - arg_mask[iarg] = -1; - } - else - { - bad = true; - break; - } - } - else - { - bad = true; - break; - } - } - - octave_value root_val; - - if (! bad) - { - // If the head is a value, use it as root. - if (head_id->is_defined ()) - root_val = head_id->rvalue1 (); - else - { - // It's a name. - std::string head_name = head_id->name (); - // Function handles can't handle legacy dispatch, so - // we make sure it's not defined. - if (symbol_table::get_dispatch (head_name).size () > 0) - bad = true; - else - { - // Simulate try/catch. - unwind_protect frame; - interpreter_try (frame); - - root_val = make_fcn_handle (head_name); - if (error_state) - bad = true; - } - } - } - - if (! bad) - { - // Stash proper name tags. - std::list arg_names = idx_expr->arg_names (); - assert (arg_names.size () == 1); - arg_template.stash_name_tags (arg_names.front ()); - - retval = new octave_fcn_binder (f, root_val, arg_template, - arg_mask, npar); - } - } - } - } - - if (! retval) - retval = new octave_fcn_handle (f, octave_fcn_handle::anonymous); - - return retval; -} - -octave_value_list -octave_fcn_binder::do_multi_index_op (int nargout, - const octave_value_list& args) -{ - return do_multi_index_op (nargout, args, 0); -} - -octave_value_list -octave_fcn_binder::do_multi_index_op (int nargout, - const octave_value_list& args, - const std::list* lvalue_list) -{ - octave_value_list retval; - - if (args.length () == expected_nargin) - { - for (int i = 0; i < arg_template.length (); i++) - { - int j = arg_mask[i]; - if (j >= 0) - arg_template(i) = args(j); // May force a copy... - } - - // Make a shallow copy of arg_template, to ensure consistency throughout the following - // call even if we happen to get back here. - octave_value_list tmp (arg_template); - retval = root_handle.do_multi_index_op (nargout, tmp, lvalue_list); - } - else - retval = octave_fcn_handle::do_multi_index_op (nargout, args, lvalue_list); - - return retval; -} - -/* -%!function r = __f (g, i) -%! r = g(i); -%!endfunction -%!test -%! x = [1,2;3,4]; -%! assert (__f (@(i) x(:,i), 1), [1;3]); -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-fcn-handle.h --- a/src/ov-fcn-handle.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,219 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_fcn_handle_h) -#define octave_fcn_handle_h 1 - -#include -#include -#include - -#include "oct-alloc.h" - -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-fcn.h" -#include "ov-typeinfo.h" - -// Function handles. - -class -OCTINTERP_API -octave_fcn_handle : public octave_base_value -{ -private: - - typedef std::map str_ov_map; - -public: - - static const std::string anonymous; - - octave_fcn_handle (void) - : fcn (), nm (), has_overloads (false), overloads () { } - - octave_fcn_handle (const std::string& n) - : fcn (), nm (n), has_overloads (false), overloads () { } - - octave_fcn_handle (const octave_value& f, const std::string& n = anonymous); - - octave_fcn_handle (const octave_fcn_handle& fh) - : octave_base_value (fh), fcn (fh.fcn), nm (fh.nm), - has_overloads (fh.has_overloads), overloads () - { - for (int i = 0; i < btyp_num_types; i++) - builtin_overloads[i] = fh.builtin_overloads[i]; - - overloads = fh.overloads; - } - - ~octave_fcn_handle (void) { } - - octave_base_value *clone (void) const { return new octave_fcn_handle (*this); } - octave_base_value *empty_clone (void) const { return new octave_fcn_handle (); } - - octave_value subsref (const std::string& type, - const std::list& idx) - { - octave_value_list tmp = subsref (type, idx, 1); - return tmp.length () > 0 ? tmp(0) : octave_value (); - } - - octave_value_list subsref (const std::string& type, - const std::list& idx, - int nargout); - - octave_value_list subsref (const std::string& type, - const std::list& idx, - int nargout, const std::list* lvalue_list); - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& args); - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& args, - const std::list* lvalue_list); - - bool is_defined (void) const { return true; } - - bool is_function_handle (void) const { return true; } - - builtin_type_t builtin_type (void) const { return btyp_func_handle; } - - bool is_overloaded (void) const { return has_overloads; } - - dim_vector dims (void) const { static dim_vector dv (1, 1); return dv; } - - octave_function *function_value (bool = false) - { return fcn.function_value (); } - - octave_user_function *user_function_value (bool = false) - { return fcn.user_function_value (); } - - octave_fcn_handle *fcn_handle_value (bool = false) { return this; } - - octave_value fcn_val (void) const { return fcn; } - - std::string fcn_name (void) const { return nm; } - - void set_overload (builtin_type_t btyp, const octave_value& ov_fcn) - { - if (btyp != btyp_unknown) - { - has_overloads = true; - builtin_overloads[btyp] = ov_fcn; - } - - } - - void set_overload (const std::string& dispatch_type, const octave_value& ov_fcn) - { - has_overloads = true; - overloads[dispatch_type] = ov_fcn; - } - - bool is_equal_to (const octave_fcn_handle&) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - // Simple function handles are printed without a newline. - bool print_as_scalar (void) const { return nm != anonymous; } - -private: - - bool set_fcn (const std::string &octaveroot, const std::string& fpath); - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA - -protected: - - // The function we are handling. - octave_value fcn; - - // The name of the handle, including the "@". - std::string nm; - - // Whether the function is overloaded at all. - bool has_overloads; - - // Overloads for builtin types. We use array to make lookup faster. - octave_value builtin_overloads[btyp_num_types]; - - // Overloads for other classes. - str_ov_map overloads; - - friend octave_value make_fcn_handle (const std::string &, bool); -}; - -extern octave_value make_fcn_handle (const std::string& nm, - bool local_funcs = true); - -class -OCTINTERP_API -octave_fcn_binder : public octave_fcn_handle -{ -private: - // Private ctor. - octave_fcn_binder (const octave_value& f, const octave_value& root, - const octave_value_list& templ, - const std::vector& mask, int exp_nargin); - -public: - - // Factory method. - static octave_fcn_handle *maybe_binder (const octave_value& f); - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& args); - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& args, - const std::list* lvalue_list); - -protected: - - octave_value root_handle; - octave_value_list arg_template; - std::vector arg_mask; - int expected_nargin; -}; -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-fcn-inline.cc --- a/src/ov-fcn-inline.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1019 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -In addition to the terms of the GPL, you are permitted to link -this program with any Open Source program, as defined by the -Open Source Initiative (www.opensource.org) - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include - -#include "oct-locbuf.h" - -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "oct-map.h" -#include "ov-base.h" -#include "ov-fcn-inline.h" -#include "ov-usr-fcn.h" -#include "pr-output.h" -#include "variables.h" -#include "parse.h" -#include "toplev.h" - -#include "byte-swap.h" -#include "ls-ascii-helper.h" -#include "ls-oct-ascii.h" -#include "ls-hdf5.h" -#include "ls-utils.h" - -DEFINE_OCTAVE_ALLOCATOR (octave_fcn_inline); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_fcn_inline, - "inline function", - "function_handle"); - -octave_fcn_inline::octave_fcn_inline (const std::string& f, - const string_vector& a, - const std::string& n) - : octave_fcn_handle (n), iftext (f), ifargs (a) -{ - // Form a string representing the function. - - std::ostringstream buf; - - buf << "@("; - - for (int i = 0; i < ifargs.length (); i++) - { - if (i > 0) - buf << ", "; - - buf << ifargs(i); - } - - buf << ") " << iftext; - - int parse_status; - octave_value anon_fcn_handle = eval_string (buf.str (), true, parse_status); - - if (parse_status == 0) - { - octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value (); - - if (fh) - { - fcn = fh->fcn_val (); - - octave_user_function *uf = fcn.user_function_value (); - - if (uf) - { - octave_function *curr_fcn = octave_call_stack::current (); - - if (curr_fcn) - { - symbol_table::scope_id parent_scope - = curr_fcn->parent_fcn_scope (); - - if (parent_scope < 0) - parent_scope = curr_fcn->scope (); - - uf->stash_parent_fcn_scope (parent_scope); - } - } - } - } - - if (fcn.is_undefined ()) - error ("inline: unable to define function"); -} - -// This function is supplied to allow a Matlab style class structure -// to be returned.. -octave_map -octave_fcn_inline::map_value (void) const -{ - octave_scalar_map m; - - m.assign ("version", 1.0); - m.assign ("isEmpty", 0.0); - m.assign ("expr", fcn_text ()); - - string_vector args = fcn_arg_names (); - - m.assign ("numArgs", args.length ()); - m.assign ("args", args); - - std::ostringstream buf; - - for (int i = 0; i < args.length (); i++) - buf << args(i) << " = INLINE_INPUTS_{" << i + 1 << "}; "; - - m.assign ("inputExpr", buf.str ()); - - return m; -} - -bool -octave_fcn_inline::save_ascii (std::ostream& os) -{ - os << "# nargs: " << ifargs.length () << "\n"; - for (int i = 0; i < ifargs.length (); i++) - os << ifargs(i) << "\n"; - if (nm.length () < 1) - // Write an invalid value to flag empty fcn handle name. - os << "0\n"; - else - os << nm << "\n"; - os << iftext << "\n"; - return true; -} - -bool -octave_fcn_inline::load_ascii (std::istream& is) -{ - int nargs; - if (extract_keyword (is, "nargs", nargs, true)) - { - ifargs.resize (nargs); - for (int i = 0; i < nargs; i++) - is >> ifargs(i); - is >> nm; - if (nm == "0") - nm = ""; - - skip_preceeding_newline (is); - - std::string buf; - - if (is) - { - - // Get a line of text whitespace characters included, - // leaving newline in the stream. - buf = read_until_newline (is, true); - } - - iftext = buf; - - octave_fcn_inline tmp (iftext, ifargs, nm); - fcn = tmp.fcn; - - return true; - } - else - return false; -} - -bool -octave_fcn_inline::save_binary (std::ostream& os, bool&) -{ - int32_t tmp = ifargs.length (); - os.write (reinterpret_cast (&tmp), 4); - for (int i = 0; i < ifargs.length (); i++) - { - tmp = ifargs(i).length (); - os.write (reinterpret_cast (&tmp), 4); - os.write (ifargs(i).c_str (), ifargs(i).length ()); - } - tmp = nm.length (); - os.write (reinterpret_cast (&tmp), 4); - os.write (nm.c_str (), nm.length ()); - tmp = iftext.length (); - os.write (reinterpret_cast (&tmp), 4); - os.write (iftext.c_str (), iftext.length ()); - return true; -} - -bool -octave_fcn_inline::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format) -{ - int32_t nargs; - if (! is.read (reinterpret_cast (&nargs), 4)) - return false; - if (swap) - swap_bytes<4> (&nargs); - - if (nargs < 1) - return false; - else - { - int32_t tmp; - ifargs.resize (nargs); - for (int i = 0; i < nargs; i++) - { - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - if (swap) - swap_bytes<4> (&tmp); - - OCTAVE_LOCAL_BUFFER (char, ctmp, tmp+1); - is.read (ctmp, tmp); - ifargs(i) = std::string (ctmp); - - if (! is) - return false; - } - - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - if (swap) - swap_bytes<4> (&tmp); - - OCTAVE_LOCAL_BUFFER (char, ctmp1, tmp+1); - is.read (ctmp1, tmp); - nm = std::string (ctmp1); - - if (! is) - return false; - - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - if (swap) - swap_bytes<4> (&tmp); - - OCTAVE_LOCAL_BUFFER (char, ctmp2, tmp+1); - is.read (ctmp2, tmp); - iftext = std::string (ctmp2); - - if (! is) - return false; - - octave_fcn_inline ftmp (iftext, ifargs, nm); - fcn = ftmp.fcn; - } - return true; -} - -#if defined (HAVE_HDF5) -bool -octave_fcn_inline::save_hdf5 (hid_t loc_id, const char *name, - bool /* save_as_floats */) -{ - hid_t group_hid = -1; -#if HAVE_HDF5_18 - group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - group_hid = H5Gcreate (loc_id, name, 0); -#endif - if (group_hid < 0 ) return false; - - size_t len = 0; - for (int i = 0; i < ifargs.length (); i++) - if (len < ifargs(i).length ()) - len = ifargs(i).length (); - - hid_t space_hid = -1, data_hid = -1, type_hid = -1;; - bool retval = true; - - // FIXME Is there a better way of saving string vectors, than a - // null padded matrix? - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, 2); - - // Octave uses column-major, while HDF5 uses row-major ordering - hdims[1] = ifargs.length (); - hdims[0] = len + 1; - - space_hid = H5Screate_simple (2, hdims, 0); - if (space_hid < 0) - { - H5Gclose (group_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "args", H5T_NATIVE_CHAR, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "args", H5T_NATIVE_CHAR, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (char, s, ifargs.length () * (len + 1)); - - // Save the args as a null teminated list - for (int i = 0; i < ifargs.length (); i++) - { - const char * cptr = ifargs(i).c_str (); - for (size_t j = 0; j < ifargs(i).length (); j++) - s[i*(len+1)+j] = *cptr++; - s[ifargs(i).length ()] = '\0'; - } - - retval = H5Dwrite (data_hid, H5T_NATIVE_CHAR, H5S_ALL, H5S_ALL, - H5P_DEFAULT, s) >= 0; - - H5Dclose (data_hid); - H5Sclose (space_hid); - - if (!retval) - { - H5Gclose (group_hid); - return false; - } - - // attach the type of the variable - type_hid = H5Tcopy (H5T_C_S1); - H5Tset_size (type_hid, nm.length () + 1); - if (type_hid < 0) - { - H5Gclose (group_hid); - return false; - } - - hdims[0] = 0; - space_hid = H5Screate_simple (0 , hdims, 0); - if (space_hid < 0) - { - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "nm", type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "nm", type_hid, space_hid, H5P_DEFAULT); -#endif - if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, - H5P_DEFAULT, nm.c_str ()) < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - H5Dclose (data_hid); - - // attach the type of the variable - H5Tset_size (type_hid, iftext.length () + 1); - if (type_hid < 0) - { - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "iftext", type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "iftext", type_hid, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, - H5P_DEFAULT, iftext.c_str ()) < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - - return retval; -} - -bool -octave_fcn_inline::load_hdf5 (hid_t loc_id, const char *name) -{ - hid_t group_hid, data_hid, space_hid, type_hid, type_class_hid, st_id; - hsize_t rank; - int slen; - -#if HAVE_HDF5_18 - group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); -#else - group_hid = H5Gopen (loc_id, name); -#endif - if (group_hid < 0 ) return false; - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "args", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "args"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 2) - { - H5Dclose (data_hid); - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - ifargs.resize (hdims[1]); - - OCTAVE_LOCAL_BUFFER (char, s1, hdims[0] * hdims[1]); - - if (H5Dread (data_hid, H5T_NATIVE_UCHAR, H5S_ALL, H5S_ALL, - H5P_DEFAULT, s1) < 0) - { - H5Dclose (data_hid); - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - H5Sclose (space_hid); - - for (size_t i = 0; i < hdims[1]; i++) - ifargs(i) = std::string (s1 + i*hdims[0]); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "nm", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "nm"); -#endif - - if (data_hid < 0) - { - H5Gclose (group_hid); - return false; - } - - type_hid = H5Dget_type (data_hid); - type_class_hid = H5Tget_class (type_hid); - - if (type_class_hid != H5T_STRING) - { - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - slen = H5Tget_size (type_hid); - if (slen < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (char, nm_tmp, slen); - - // create datatype for (null-terminated) string to read into: - st_id = H5Tcopy (H5T_C_S1); - H5Tset_size (st_id, slen); - - if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, nm_tmp) < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - H5Tclose (st_id); - H5Dclose (data_hid); - nm = nm_tmp; - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "iftext", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "iftext"); -#endif - - if (data_hid < 0) - { - H5Gclose (group_hid); - return false; - } - - type_hid = H5Dget_type (data_hid); - type_class_hid = H5Tget_class (type_hid); - - if (type_class_hid != H5T_STRING) - { - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - slen = H5Tget_size (type_hid); - if (slen < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (char, iftext_tmp, slen); - - // create datatype for (null-terminated) string to read into: - st_id = H5Tcopy (H5T_C_S1); - H5Tset_size (st_id, slen); - - if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, iftext_tmp) < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - H5Gclose (group_hid); - return false; - } - H5Tclose (st_id); - H5Dclose (data_hid); - iftext = iftext_tmp; - - octave_fcn_inline ftmp (iftext, ifargs, nm); - fcn = ftmp.fcn; - - return true; -} -#endif - -void -octave_fcn_inline::print (std::ostream& os, bool pr_as_read_syntax) const -{ - print_raw (os, pr_as_read_syntax); - newline (os); -} - -void -octave_fcn_inline::print_raw (std::ostream& os, bool pr_as_read_syntax) const -{ - std::ostringstream buf; - - if (nm.empty ()) - buf << "f("; - else - buf << nm << "("; - - for (int i = 0; i < ifargs.length (); i++) - { - if (i) - buf << ", "; - - buf << ifargs(i); - } - - buf << ") = " << iftext; - - octave_print_internal (os, buf.str (), pr_as_read_syntax, - current_print_indent_level ()); -} - -octave_value -octave_fcn_inline::convert_to_str_internal (bool, bool, char type) const -{ - return octave_value (fcn_text (), type); -} - -DEFUNX ("inline", Finline, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} inline (@var{str})\n\ -@deftypefnx {Built-in Function} {} inline (@var{str}, @var{arg1}, @dots{})\n\ -@deftypefnx {Built-in Function} {} inline (@var{str}, @var{n})\n\ -Create an inline function from the character string @var{str}.\n\ -If called with a single argument, the arguments of the generated\n\ -function are extracted from the function itself. The generated\n\ -function arguments will then be in alphabetical order. It should\n\ -be noted that i, and j are ignored as arguments due to the\n\ -ambiguity between their use as a variable or their use as an inbuilt\n\ -constant. All arguments followed by a parenthesis are considered\n\ -to be functions.\n\ -\n\ -If the second and subsequent arguments are character strings,\n\ -they are the names of the arguments of the function.\n\ -\n\ -If the second argument is an integer @var{n}, the arguments are\n\ -@code{\"x\"}, @code{\"P1\"}, @dots{}, @code{\"P@var{N}\"}.\n\ -@seealso{argnames, formula, vectorize}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin > 0) - { - if (args(0).is_string ()) - { - std::string fun = args(0).string_value (); - string_vector fargs; - - if (nargin == 1) - { - bool is_arg = false; - bool in_string = false; - std::string tmp_arg; - size_t i = 0; - size_t fun_length = fun.length (); - - while (i < fun_length) - { - bool terminate_arg = false; - char c = fun[i++]; - - if (in_string) - { - if (c == '\'' || c == '\"') - in_string = false; - } - else if (c == '\'' || c == '\"') - { - in_string = true; - if (is_arg) - terminate_arg = true; - } - else if (! isalpha (c) && c != '_') - if (! is_arg) - continue; - else if (isdigit (c)) - tmp_arg.append (1, c); - else - { - // Before we do anything remove trailing whitespaces. - while (i < fun_length && isspace (c)) - c = fun[i++]; - - // Do we have a variable or a function? - if (c != '(') - terminate_arg = true; - else - { - tmp_arg = std::string (); - is_arg = false; - } - } - else if (! is_arg) - { - if (c == 'e' || c == 'E') - { - // possible number in exponent form, not arg - if (isdigit (fun[i]) - || fun[i] == '-' || fun[i] == '+') - continue; - } - is_arg = true; - tmp_arg.append (1, c); - } - else - { - tmp_arg.append (1, c); - } - - if (terminate_arg || (i == fun_length && is_arg)) - { - bool have_arg = false; - - for (int j = 0; j < fargs.length (); j++) - if (tmp_arg == fargs (j)) - { - have_arg = true; - break; - } - - if (! have_arg && tmp_arg != "i" && tmp_arg != "j" && - tmp_arg != "NaN" && tmp_arg != "nan" && - tmp_arg != "Inf" && tmp_arg != "inf" && - tmp_arg != "NA" && tmp_arg != "pi" && - tmp_arg != "e" && tmp_arg != "eps") - fargs.append (tmp_arg); - - tmp_arg = std::string (); - is_arg = false; - } - } - - // Sort the arguments into ascii order. - fargs.sort (); - } - else if (nargin == 2 && args(1).is_numeric_type ()) - { - if (! args(1).is_scalar_type ()) - { - error ("inline: N must be an integer"); - return retval; - } - - int n = args(1).int_value (); - - if (! error_state) - { - if (n >= 0) - { - fargs.resize (n+1); - - fargs(0) = "x"; - - for (int i = 1; i < n+1; i++) - { - std::ostringstream buf; - buf << "P" << i; - fargs(i) = buf.str (); - } - } - else - { - error ("inline: N must be a positive integer or zero"); - return retval; - } - } - else - { - error ("inline: N must be an integer"); - return retval; - } - } - else - { - fargs.resize (nargin - 1); - - for (int i = 1; i < nargin; i++) - { - if (args(i).is_string ()) - { - std::string s = args(i).string_value (); - fargs(i-1) = s; - } - else - { - error ("inline: expecting string arguments"); - return retval; - } - } - } - - retval = octave_value (new octave_fcn_inline (fun, fargs)); - } - else - error ("inline: STR argument must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!shared fn -%! fn = inline ("x.^2 + 1"); -%!assert (feval (fn, 6), 37) -%!assert (fn (6), 37) -## FIXME: Need tests for other 2 calling forms of inline() - -## Test input validation -%!error inline () -%!error inline (1) -%!error inline ("2", ones (2,2)) -%!error inline ("2", -1) -%!error inline ("2", "x", -1, "y") -*/ - -DEFUN (formula, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} formula (@var{fun})\n\ -Return a character string representing the inline function @var{fun}.\n\ -Note that @code{char (@var{fun})} is equivalent to\n\ -@code{formula (@var{fun})}.\n\ -@seealso{argnames, inline, vectorize}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_fcn_inline* fn = args(0).fcn_inline_value (true); - - if (fn) - retval = octave_value (fn->fcn_text ()); - else - error ("formula: FUN must be an inline function"); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (formula (fn), "x.^2 + 1") -%!assert (formula (fn), char (fn)) - -## Test input validation -%!error formula () -%!error formula (1, 2) -%!error formula (1) -*/ - -DEFUN (argnames, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} argnames (@var{fun})\n\ -Return a cell array of character strings containing the names of\n\ -the arguments of the inline function @var{fun}.\n\ -@seealso{inline, formula, vectorize}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_fcn_inline *fn = args(0).fcn_inline_value (true); - - if (fn) - { - string_vector t1 = fn->fcn_arg_names (); - - Cell t2 (dim_vector (t1.length (), 1)); - - for (int i = 0; i < t1.length (); i++) - t2(i) = t1(i); - - retval = t2; - } - else - error ("argnames: FUN must be an inline function"); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (argnames (fn), {"x"}) -%!assert (argnames (inline ("1e-3*y + 2e4*z")), {"y"; "z"}) -%!assert (argnames (inline ("2", 2)), {"x"; "P1"; "P2"}) - -## Test input validation -%!error argnames () -%!error argnames (1, 2) -%!error argnames (1) -*/ - -DEFUN (vectorize, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} vectorize (@var{fun})\n\ -Create a vectorized version of the inline function @var{fun}\n\ -by replacing all occurrences of @code{*}, @code{/}, etc., with\n\ -@code{.*}, @code{./}, etc.\n\ -\n\ -This may be useful, for example, when using inline functions with\n\ -numerical integration or optimization where a vector-valued function\n\ -is expected.\n\ -\n\ -@example\n\ -@group\n\ -fcn = vectorize (inline (\"x^2 - 1\"))\n\ - @result{} fcn = f(x) = x.^2 - 1\n\ -quadv (fcn, 0, 3)\n\ - @result{} 6\n\ -@end group\n\ -@end example\n\ -@seealso{inline, formula, argnames}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - std::string old_func; - octave_fcn_inline* old = 0; - bool func_is_string = true; - - if (args(0).is_string ()) - old_func = args(0).string_value (); - else - { - old = args(0).fcn_inline_value (true); - func_is_string = false; - - if (old) - old_func = old->fcn_text (); - else - error ("vectorize: FUN must be a string or inline function"); - } - - if (! error_state) - { - std::string new_func; - size_t i = 0; - - while (i < old_func.length ()) - { - std::string t1 = old_func.substr (i, 1); - - if (t1 == "*" || t1 == "/" || t1 == "\\" || t1 == "^") - { - if (i && old_func.substr (i-1, 1) != ".") - new_func.append ("."); - - // Special case for ** operator. - if (t1 == "*" && i < (old_func.length () - 1) - && old_func.substr (i+1, 1) == "*") - { - new_func.append ("*"); - i++; - } - } - new_func.append (t1); - i++; - } - - if (func_is_string) - retval = octave_value (new_func); - else - retval = octave_value (new octave_fcn_inline - (new_func, old->fcn_arg_names ())); - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (char (vectorize (fn)), "x.^2 + 1") -%!assert (char (vectorize (inline ("1e-3*y + 2e4*z"))), "1e-3.*y + 2e4.*z") -%!assert (char (vectorize (inline ("2**x^5"))), "2.**x.^5") -%!assert (vectorize ("x.^2 + 1"), "x.^2 + 1") -%!assert (vectorize ("1e-3*y + 2e4*z"), "1e-3.*y + 2e4.*z") -%!assert (vectorize ("2**x^5"), "2.**x.^5") - -## Test input validation -%!error vectorize () -%!error vectorize (1, 2) -%!error vectorize (1) -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-fcn-inline.h --- a/src/ov-fcn-inline.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,104 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_fcn_inline_h) -#define octave_fcn_inline_h 1 - -#include -#include - -#include "oct-alloc.h" - -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-fcn.h" -#include "ov-typeinfo.h" -#include "symtab.h" -#include "ov-fcn-handle.h" - -// Inline functions. - -class -OCTINTERP_API -octave_fcn_inline : public octave_fcn_handle -{ -public: - - octave_fcn_inline (void) - : octave_fcn_handle (), iftext (), ifargs () { } - - octave_fcn_inline (const std::string& f, const string_vector& a, - const std::string& n = std::string ()); - - octave_fcn_inline (const octave_fcn_inline& fi) - : octave_fcn_handle (fi), iftext (fi.iftext), ifargs (fi.ifargs) { } - - ~octave_fcn_inline (void) { } - - octave_base_value *clone (void) const { return new octave_fcn_inline (*this); } - octave_base_value *empty_clone (void) const { return new octave_fcn_inline (); } - - bool is_inline_function (void) const { return true; } - - octave_fcn_inline *fcn_inline_value (bool = false) { return this; } - - std::string fcn_text (void) const { return iftext; } - - string_vector fcn_arg_names (void) const { return ifargs; } - - octave_value convert_to_str_internal (bool, bool, char) const; - - octave_map map_value (void) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA - - // The expression of an inline function. - std::string iftext; - - // The args of an inline function. - string_vector ifargs; -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-fcn.cc --- a/src/ov-fcn.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "oct-obj.h" -#include "ov-fcn.h" - -DEFINE_OCTAVE_ALLOCATOR (octave_function); - -octave_base_value * -octave_function::clone (void) const -{ - panic_impossible (); - return 0; -} - -octave_base_value * -octave_function::empty_clone (void) const -{ - panic_impossible (); - return 0; -} diff -r d02b229ce693 -r a132d206a36a src/ov-fcn.h --- a/src/ov-fcn.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,193 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_function_h) -#define octave_function_h 1 - -#include - -#include "oct-time.h" -#include "str-vec.h" - -#include "oct-alloc.h" -#include "oct-obj.h" -#include "ov-base.h" -#include "ov-typeinfo.h" -#include "symtab.h" - -class tree_walker; - -// Functions. - -class -OCTINTERP_API -octave_function : public octave_base_value -{ -public: - - octave_function (void) - : relative (false), locked (false), private_function (false), - xdispatch_class (), my_name (), my_dir_name (), doc () { } - - ~octave_function (void) { } - - octave_base_value *clone (void) const; - octave_base_value *empty_clone (void) const; - - bool is_defined (void) const { return true; } - - bool is_function (void) const { return true; } - - virtual bool is_system_fcn_file (void) const { return false; } - - virtual std::string fcn_file_name (void) const { return std::string (); } - - virtual std::string src_file_name (void) const { return std::string (); } - - // The name to show in the profiler (also used as map-key). - virtual std::string profiler_name (void) const { return name (); } - - virtual std::string parent_fcn_name (void) const { return std::string (); } - - virtual symbol_table::scope_id parent_fcn_scope (void) const { return -1; } - - virtual void mark_fcn_file_up_to_date (const octave_time&) { } - - virtual symbol_table::scope_id scope (void) { return -1; } - - virtual octave_time time_parsed (void) const - { return octave_time (static_cast (0)); } - - virtual octave_time time_checked (void) const - { return octave_time (static_cast (0)); } - - virtual bool is_subfunction (void) const { return false; } - - virtual bool is_class_constructor (const std::string& = std::string ()) const - { return false; } - - virtual bool is_class_method (const std::string& = std::string ()) const - { return false; } - - virtual bool takes_varargs (void) const { return false; } - - virtual bool takes_var_return (void) const { return false; } - - void stash_dispatch_class (const std::string& nm) { xdispatch_class = nm; } - - std::string dispatch_class (void) const { return xdispatch_class; } - - virtual void - mark_as_private_function (const std::string& cname = std::string ()) - { - private_function = true; - xdispatch_class = cname; - } - - bool is_private_function (void) const { return private_function; } - - bool is_private_function_of_class (const std::string& nm) const - { return private_function && xdispatch_class == nm; } - - virtual bool - is_anonymous_function_of_class (const std::string& = std::string ()) const - { return false; } - - std::string dir_name (void) const { return my_dir_name; } - - void stash_dir_name (const std::string& dir) { my_dir_name = dir; } - - void lock (void) - { - this->lock_subfunctions (); - locked = true; - } - - void unlock (void) - { - this->unlock_subfunctions (); - locked = false; - } - - bool islocked (void) const { return locked; } - - virtual void lock_subfunctions (void) { } - - virtual void unlock_subfunctions (void) { } - - void mark_relative (void) { relative = true; } - - bool is_relative (void) const { return relative; } - - std::string name (void) const { return my_name; } - - void document (const std::string& ds) { doc = ds; } - - std::string doc_string (void) const { return doc; } - - virtual void unload (void) { } - - virtual void accept (tree_walker&) { } - -protected: - - octave_function (const std::string& nm, - const std::string& ds = std::string ()) - : relative (false), locked (false), private_function (false), - xdispatch_class (), my_name (nm), my_dir_name (), doc (ds) { } - - // TRUE if this function was found from a relative path element. - bool relative; - - // TRUE if this function is tagged so that it can't be cleared. - bool locked; - - // TRUE means this is a private function. - bool private_function; - - // If this object is a class method or constructor, or a private - // function inside a class directory, this is the name of the class - // to which the method belongs. - std::string xdispatch_class; - - // The name of this function. - std::string my_name; - - // The name of the directory in the path where we found this - // function. May be relative. - std::string my_dir_name; - - // The help text for this function. - std::string doc; - -private: - - // No copying! - - octave_function (const octave_function& f); - - octave_function& operator = (const octave_function& f); - - DECLARE_OCTAVE_ALLOCATOR -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-float.cc --- a/src/ov-float.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,346 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "data-conv.h" -#include "mach-info.h" -#include "lo-specfun.h" -#include "lo-mappers.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-stream.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-base.h" -#include "ov-base-scalar.h" -#include "ov-base-scalar.cc" -#include "ov-flt-re-mat.h" -#include "ov-typeinfo.h" -#include "pr-output.h" -#include "xdiv.h" -#include "xpow.h" -#include "ops.h" - -#include "ls-oct-ascii.h" -#include "ls-hdf5.h" - -template class octave_base_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_float_scalar); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_scalar, "float scalar", "single"); - -octave_value -octave_float_scalar::do_index_op (const octave_value_list& idx, bool resize_ok) -{ - // FIXME -- this doesn't solve the problem of - // - // a = 1; a([1,1], [1,1], [1,1]) - // - // and similar constructions. Hmm... - - // FIXME -- using this constructor avoids narrowing the - // 1x1 matrix back to a scalar value. Need a better solution - // to this problem. - - octave_value tmp (new octave_float_matrix (float_matrix_value ())); - - return tmp.do_index_op (idx, resize_ok); -} - -octave_value -octave_float_scalar::resize (const dim_vector& dv, bool fill) const -{ - if (fill) - { - FloatNDArray retval (dv, 0); - - if (dv.numel ()) - retval(0) = scalar; - - return retval; - } - else - { - FloatNDArray retval (dv); - - if (dv.numel ()) - retval(0) = scalar; - - return retval; - } -} - -octave_value -octave_float_scalar::diag (octave_idx_type m, octave_idx_type n) const -{ - return FloatDiagMatrix (Array (dim_vector (1, 1), scalar), m, n); -} - -octave_value -octave_float_scalar::convert_to_str_internal (bool, bool, char type) const -{ - octave_value retval; - - if (xisnan (scalar)) - gripe_nan_to_character_conversion (); - else - { - int ival = NINT (scalar); - - if (ival < 0 || ival > UCHAR_MAX) - { - // FIXME -- is there something better we could do? - - ival = 0; - - ::warning ("range error for conversion to character value"); - } - - retval = octave_value (std::string (1, static_cast (ival)), type); - } - - return retval; -} - -bool -octave_float_scalar::save_ascii (std::ostream& os) -{ - float d = float_value (); - - octave_write_float (os, d); - - os << "\n"; - - return true; -} - -bool -octave_float_scalar::load_ascii (std::istream& is) -{ - scalar = octave_read_value (is); - if (!is) - { - error ("load: failed to load scalar constant"); - return false; - } - - return true; -} - -bool -octave_float_scalar::save_binary (std::ostream& os, bool& /* save_as_floats */) -{ - char tmp = LS_FLOAT; - os.write (reinterpret_cast (&tmp), 1); - float dtmp = float_value (); - os.write (reinterpret_cast (&dtmp), 4); - - return true; -} - -bool -octave_float_scalar::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - char tmp; - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - - float dtmp; - read_floats (is, &dtmp, static_cast (tmp), 1, swap, fmt); - if (error_state || ! is) - return false; - - scalar = dtmp; - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_float_scalar::save_hdf5 (hid_t loc_id, const char *name, - bool /* save_as_floats */) -{ - hsize_t dimens[3]; - hid_t space_hid = -1, data_hid = -1; - bool retval = true; - - space_hid = H5Screate_simple (0, dimens, 0); - if (space_hid < 0) return false; -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_FLOAT, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_FLOAT, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - return false; - } - - float tmp = float_value (); - retval = H5Dwrite (data_hid, H5T_NATIVE_FLOAT, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &tmp) >= 0; - - H5Dclose (data_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_float_scalar::load_hdf5 (hid_t loc_id, const char *name) -{ -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t space_id = H5Dget_space (data_hid); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank != 0) - { - H5Dclose (data_hid); - return false; - } - - float dtmp; - if (H5Dread (data_hid, H5T_NATIVE_FLOAT, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &dtmp) < 0) - { - H5Dclose (data_hid); - return false; - } - - scalar = dtmp; - - H5Dclose (data_hid); - - return true; -} - -#endif - -mxArray * -octave_float_scalar::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxSINGLE_CLASS, 1, 1, mxREAL); - - float *pr = static_cast (retval->get_data ()); - - pr[0] = scalar; - - return retval; -} - -octave_value -octave_float_scalar::map (unary_mapper_t umap) const -{ - switch (umap) - { - case umap_imag: - return 0.0f; - - case umap_real: - case umap_conj: - return scalar; - -#define SCALAR_MAPPER(UMAP, FCN) \ - case umap_ ## UMAP: \ - return octave_value (FCN (scalar)) - - SCALAR_MAPPER (abs, ::fabsf); - SCALAR_MAPPER (acos, rc_acos); - SCALAR_MAPPER (acosh, rc_acosh); - SCALAR_MAPPER (angle, ::arg); - SCALAR_MAPPER (arg, ::arg); - SCALAR_MAPPER (asin, rc_asin); - SCALAR_MAPPER (asinh, ::asinhf); - SCALAR_MAPPER (atan, ::atanf); - SCALAR_MAPPER (atanh, rc_atanh); - SCALAR_MAPPER (erf, ::erff); - SCALAR_MAPPER (erfinv, ::erfinv); - SCALAR_MAPPER (erfcinv, ::erfcinv); - SCALAR_MAPPER (erfc, ::erfcf); - SCALAR_MAPPER (erfcx, ::erfcx); - SCALAR_MAPPER (gamma, xgamma); - SCALAR_MAPPER (lgamma, rc_lgamma); - SCALAR_MAPPER (cbrt, ::cbrtf); - SCALAR_MAPPER (ceil, ::ceilf); - SCALAR_MAPPER (cos, ::cosf); - SCALAR_MAPPER (cosh, ::coshf); - SCALAR_MAPPER (exp, ::expf); - SCALAR_MAPPER (expm1, ::expm1f); - SCALAR_MAPPER (fix, ::fix); - SCALAR_MAPPER (floor, ::floorf); - SCALAR_MAPPER (log, rc_log); - SCALAR_MAPPER (log2, rc_log2); - SCALAR_MAPPER (log10, rc_log10); - SCALAR_MAPPER (log1p, rc_log1p); - SCALAR_MAPPER (round, xround); - SCALAR_MAPPER (roundb, xroundb); - SCALAR_MAPPER (signum, ::signum); - SCALAR_MAPPER (sin, ::sinf); - SCALAR_MAPPER (sinh, ::sinhf); - SCALAR_MAPPER (sqrt, rc_sqrt); - SCALAR_MAPPER (tan, ::tanf); - SCALAR_MAPPER (tanh, ::tanhf); - SCALAR_MAPPER (finite, xfinite); - SCALAR_MAPPER (isinf, xisinf); - SCALAR_MAPPER (isna, octave_is_NA); - SCALAR_MAPPER (isnan, xisnan); - - default: - return octave_base_value::map (umap); - } -} - -bool -octave_float_scalar::fast_elem_insert_self (void *where, builtin_type_t btyp) const -{ - - // Support inline real->complex conversion. - if (btyp == btyp_float) - { - *(reinterpret_cast(where)) = scalar; - return true; - } - else if (btyp == btyp_float_complex) - { - *(reinterpret_cast(where)) = scalar; - return true; - } - else - return false; -} diff -r d02b229ce693 -r a132d206a36a src/ov-float.h --- a/src/ov-float.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,258 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_float_h) -#define octave_float_h 1 - -#include - -#include -#include - -#include "lo-ieee.h" -#include "lo-mappers.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "gripes.h" -#include "ov-base.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-base-scalar.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// Real scalar values. - -class -OCTINTERP_API -octave_float_scalar : public octave_base_scalar -{ -public: - - octave_float_scalar (void) - : octave_base_scalar (0.0) { } - - octave_float_scalar (float d) - : octave_base_scalar (d) { } - - octave_float_scalar (const octave_float_scalar& s) - : octave_base_scalar (s) { } - - ~octave_float_scalar (void) { } - - octave_base_value *clone (void) const { return new octave_float_scalar (*this); } - - // We return an octave_matrix here instead of an octave_float_scalar so - // that in expressions like A(2,2,2) = 2 (for A previously - // undefined), A will be empty instead of a 1x1 object. - octave_base_value *empty_clone (void) const { return new octave_float_matrix (); } - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - idx_vector index_vector (void) const { return idx_vector (scalar); } - - octave_value any (int = 0) const - { return (scalar != 0 && ! lo_ieee_isnan (scalar)); } - - builtin_type_t builtin_type (void) const { return btyp_float; } - - bool is_real_scalar (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_single_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - int8NDArray - int8_array_value (void) const - { return int8NDArray (dim_vector (1, 1), scalar); } - - int16NDArray - int16_array_value (void) const - { return int16NDArray (dim_vector (1, 1), scalar); } - - int32NDArray - int32_array_value (void) const - { return int32NDArray (dim_vector (1, 1), scalar); } - - int64NDArray - int64_array_value (void) const - { return int64NDArray (dim_vector (1, 1), scalar); } - - uint8NDArray - uint8_array_value (void) const - { return uint8NDArray (dim_vector (1, 1), scalar); } - - uint16NDArray - uint16_array_value (void) const - { return uint16NDArray (dim_vector (1, 1), scalar); } - - uint32NDArray - uint32_array_value (void) const - { return uint32NDArray (dim_vector (1, 1), scalar); } - - uint64NDArray - uint64_array_value (void) const - { return uint64NDArray (dim_vector (1, 1), scalar); } - -#define DEFINE_INT_SCALAR_VALUE(TYPE) \ - octave_ ## TYPE \ - TYPE ## _scalar_value (void) const \ - { return octave_ ## TYPE (scalar); } - - DEFINE_INT_SCALAR_VALUE (int8) - DEFINE_INT_SCALAR_VALUE (int16) - DEFINE_INT_SCALAR_VALUE (int32) - DEFINE_INT_SCALAR_VALUE (int64) - DEFINE_INT_SCALAR_VALUE (uint8) - DEFINE_INT_SCALAR_VALUE (uint16) - DEFINE_INT_SCALAR_VALUE (uint32) - DEFINE_INT_SCALAR_VALUE (uint64) - -#undef DEFINE_INT_SCALAR_VALUE - - double double_value (bool = false) const { return static_cast (scalar); } - - float float_value (bool = false) const { return scalar; } - - double scalar_value (bool = false) const { return static_cast (scalar); } - - float float_scalar_value (bool = false) const { return scalar; } - - Matrix matrix_value (bool = false) const - { return Matrix (1, 1, scalar); } - - FloatMatrix float_matrix_value (bool = false) const - { return FloatMatrix (1, 1, scalar); } - - NDArray array_value (bool = false) const - { return NDArray (dim_vector (1, 1), scalar); } - - FloatNDArray float_array_value (bool = false) const - { return FloatNDArray (dim_vector (1, 1), scalar); } - - SparseMatrix sparse_matrix_value (bool = false) const - { return SparseMatrix (Matrix (1, 1, scalar)); } - - // FIXME Need SparseComplexMatrix (Matrix) constructor!!! - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const - { return SparseComplexMatrix (sparse_matrix_value ()); } - - octave_value resize (const dim_vector& dv, bool fill = false) const; - - Complex complex_value (bool = false) const { return scalar; } - - FloatComplex float_complex_value (bool = false) const { return scalar; } - - ComplexMatrix complex_matrix_value (bool = false) const - { return ComplexMatrix (1, 1, Complex (scalar)); } - - FloatComplexMatrix float_complex_matrix_value (bool = false) const - { return FloatComplexMatrix (1, 1, FloatComplex (scalar)); } - - ComplexNDArray complex_array_value (bool = false) const - { return ComplexNDArray (dim_vector (1, 1), Complex (scalar)); } - - FloatComplexNDArray float_complex_array_value (bool = false) const - { return FloatComplexNDArray (dim_vector (1, 1), FloatComplex (scalar)); } - - charNDArray - char_array_value (bool = false) const - { - charNDArray retval (dim_vector (1, 1)); - retval(0) = static_cast (scalar); - return retval; - } - - bool bool_value (bool warn = false) const - { - if (xisnan (scalar)) - gripe_nan_to_logical_conversion (); - else if (warn && scalar != 0 && scalar != 1) - gripe_logical_conversion (); - - return scalar; - } - - boolNDArray bool_array_value (bool warn = false) const - { - if (xisnan (scalar)) - gripe_nan_to_logical_conversion (); - else if (warn && scalar != 0 && scalar != 1) - gripe_logical_conversion (); - - return boolNDArray (dim_vector (1, 1), scalar); - } - - octave_value diag (octave_idx_type m, octave_idx_type n) const; - - octave_value convert_to_str_internal (bool pad, bool force, char type) const; - - void increment (void) { ++scalar; } - - void decrement (void) { --scalar; } - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { - return os.write (array_value (), block_size, output_type, - skip, flt_fmt); - } - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const; - - bool fast_elem_insert_self (void *where, builtin_type_t btyp) const; - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-flt-complex.cc --- a/src/ov-flt-complex.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,448 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "lo-ieee.h" -#include "lo-specfun.h" -#include "lo-mappers.h" - -#include "oct-obj.h" -#include "oct-stream.h" -#include "ops.h" -#include "ov-complex.h" -#include "ov-base.h" -#include "ov-base-scalar.h" -#include "ov-base-scalar.cc" -#include "ov-flt-cx-mat.h" -#include "ov-float.h" -#include "ov-flt-complex.h" -#include "gripes.h" -#include "pr-output.h" -#include "ops.h" - -#include "ls-oct-ascii.h" -#include "ls-hdf5.h" - -template class octave_base_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_float_complex); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_complex, - "float complex scalar", "single"); - -octave_base_value * -octave_float_complex::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - float im = std::imag (scalar); - - if (im == 0.0) - retval = new octave_float_scalar (std::real (scalar)); - - return retval; -} - -octave_value -octave_float_complex::do_index_op (const octave_value_list& idx, bool resize_ok) -{ - // FIXME -- this doesn't solve the problem of - // - // a = i; a([1,1], [1,1], [1,1]) - // - // and similar constructions. Hmm... - - // FIXME -- using this constructor avoids narrowing the - // 1x1 matrix back to a scalar value. Need a better solution - // to this problem. - - octave_value tmp (new octave_float_complex_matrix (float_complex_matrix_value ())); - - return tmp.do_index_op (idx, resize_ok); -} - -double -octave_float_complex::double_value (bool force_conversion) const -{ - double retval = lo_ieee_nan_value (); - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real scalar"); - - retval = std::real (scalar); - - return retval; -} - -float -octave_float_complex::float_value (bool force_conversion) const -{ - float retval = lo_ieee_float_nan_value (); - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real scalar"); - - retval = std::real (scalar); - - return retval; -} - -Matrix -octave_float_complex::matrix_value (bool force_conversion) const -{ - Matrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real matrix"); - - retval = Matrix (1, 1, std::real (scalar)); - - return retval; -} - -FloatMatrix -octave_float_complex::float_matrix_value (bool force_conversion) const -{ - FloatMatrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real matrix"); - - retval = FloatMatrix (1, 1, std::real (scalar)); - - return retval; -} - -NDArray -octave_float_complex::array_value (bool force_conversion) const -{ - NDArray retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real matrix"); - - retval = NDArray (dim_vector (1, 1), std::real (scalar)); - - return retval; -} - -FloatNDArray -octave_float_complex::float_array_value (bool force_conversion) const -{ - FloatNDArray retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex scalar", "real matrix"); - - retval = FloatNDArray (dim_vector (1, 1), std::real (scalar)); - - return retval; -} - -Complex -octave_float_complex::complex_value (bool) const -{ - return scalar; -} - -FloatComplex -octave_float_complex::float_complex_value (bool) const -{ - return static_cast (scalar); -} - -ComplexMatrix -octave_float_complex::complex_matrix_value (bool) const -{ - return ComplexMatrix (1, 1, scalar); -} - -FloatComplexMatrix -octave_float_complex::float_complex_matrix_value (bool) const -{ - return FloatComplexMatrix (1, 1, scalar); -} - -ComplexNDArray -octave_float_complex::complex_array_value (bool /* force_conversion */) const -{ - return ComplexNDArray (dim_vector (1, 1), scalar); -} - -FloatComplexNDArray -octave_float_complex::float_complex_array_value (bool /* force_conversion */) const -{ - return FloatComplexNDArray (dim_vector (1, 1), scalar); -} - -octave_value -octave_float_complex::resize (const dim_vector& dv, bool fill) const -{ - if (fill) - { - FloatComplexNDArray retval (dv, FloatComplex (0)); - - if (dv.numel ()) - retval(0) = scalar; - - return retval; - } - else - { - FloatComplexNDArray retval (dv); - - if (dv.numel ()) - retval(0) = scalar; - - return retval; - } -} - -octave_value -octave_float_complex::diag (octave_idx_type m, octave_idx_type n) const -{ - return FloatComplexDiagMatrix (Array (dim_vector (1, 1), scalar), m, n); -} - -bool -octave_float_complex::save_ascii (std::ostream& os) -{ - FloatComplex c = float_complex_value (); - - octave_write_float_complex (os, c); - - os << "\n"; - - return true; -} - -bool -octave_float_complex::load_ascii (std::istream& is) -{ - scalar = octave_read_value (is); - - if (!is) - { - error ("load: failed to load complex scalar constant"); - return false; - } - - return true; -} - - -bool -octave_float_complex::save_binary (std::ostream& os, bool& /* save_as_floats */) -{ - char tmp = static_cast (LS_FLOAT); - os.write (reinterpret_cast (&tmp), 1); - FloatComplex ctmp = float_complex_value (); - os.write (reinterpret_cast (&ctmp), 8); - - return true; -} - -bool -octave_float_complex::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - char tmp; - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - - FloatComplex ctmp; - read_floats (is, reinterpret_cast (&ctmp), - static_cast (tmp), 2, swap, fmt); - if (error_state || ! is) - return false; - - scalar = ctmp; - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_float_complex::save_hdf5 (hid_t loc_id, const char *name, - bool /* save_as_floats */) -{ - hsize_t dimens[3]; - hid_t space_hid = -1, type_hid = -1, data_hid = -1; - bool retval = true; - - space_hid = H5Screate_simple (0, dimens, 0); - if (space_hid < 0) - return false; - - type_hid = hdf5_make_complex_type (H5T_NATIVE_FLOAT); - if (type_hid < 0) - { - H5Sclose (space_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - return false; - } - - FloatComplex tmp = float_complex_value (); - retval = H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, H5P_DEFAULT, - &tmp) >= 0; - - H5Dclose (data_hid); - H5Tclose (type_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_float_complex::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t type_hid = H5Dget_type (data_hid); - - hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_FLOAT); - - if (! hdf5_types_compatible (type_hid, complex_type)) - { - H5Tclose (complex_type); - H5Dclose (data_hid); - return false; - } - - hid_t space_id = H5Dget_space (data_hid); - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank != 0) - { - H5Tclose (complex_type); - H5Sclose (space_id); - H5Dclose (data_hid); - return false; - } - - // complex scalar: - FloatComplex ctmp; - if (H5Dread (data_hid, complex_type, H5S_ALL, H5S_ALL, H5P_DEFAULT, - &ctmp) >= 0) - { - retval = true; - scalar = ctmp; - } - - H5Tclose (complex_type); - H5Sclose (space_id); - H5Dclose (data_hid); - - return retval; -} - -#endif - -mxArray * -octave_float_complex::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxSINGLE_CLASS, 1, 1, mxCOMPLEX); - - float *pr = static_cast (retval->get_data ()); - float *pi = static_cast (retval->get_imag_data ()); - - pr[0] = std::real (scalar); - pi[0] = std::imag (scalar); - - return retval; -} - -octave_value -octave_float_complex::map (unary_mapper_t umap) const -{ - switch (umap) - { -#define SCALAR_MAPPER(UMAP, FCN) \ - case umap_ ## UMAP: \ - return octave_value (FCN (scalar)) - - SCALAR_MAPPER (abs, std::abs); - SCALAR_MAPPER (acos, ::acos); - SCALAR_MAPPER (acosh, ::acosh); - SCALAR_MAPPER (angle, std::arg); - SCALAR_MAPPER (arg, std::arg); - SCALAR_MAPPER (asin, ::asin); - SCALAR_MAPPER (asinh, ::asinh); - SCALAR_MAPPER (atan, ::atan); - SCALAR_MAPPER (atanh, ::atanh); - SCALAR_MAPPER (ceil, ::ceil); - SCALAR_MAPPER (conj, std::conj); - SCALAR_MAPPER (cos, std::cos); - SCALAR_MAPPER (cosh, std::cosh); - SCALAR_MAPPER (exp, std::exp); - SCALAR_MAPPER (expm1, ::expm1); - SCALAR_MAPPER (fix, ::fix); - SCALAR_MAPPER (floor, ::floor); - SCALAR_MAPPER (imag, std::imag); - SCALAR_MAPPER (log, std::log); - SCALAR_MAPPER (log2, xlog2); - SCALAR_MAPPER (log10, std::log10); - SCALAR_MAPPER (log1p, ::log1p); - SCALAR_MAPPER (real, std::real); - SCALAR_MAPPER (round, xround); - SCALAR_MAPPER (roundb, xroundb); - SCALAR_MAPPER (signum, ::signum); - SCALAR_MAPPER (sin, std::sin); - SCALAR_MAPPER (sinh, std::sinh); - SCALAR_MAPPER (sqrt, std::sqrt); - SCALAR_MAPPER (tan, std::tan); - SCALAR_MAPPER (tanh, std::tanh); - SCALAR_MAPPER (finite, xfinite); - SCALAR_MAPPER (isinf, xisinf); - SCALAR_MAPPER (isna, octave_is_NA); - SCALAR_MAPPER (isnan, xisnan); - - default: - return octave_base_value::map (umap); - } -} diff -r d02b229ce693 -r a132d206a36a src/ov-flt-complex.h --- a/src/ov-flt-complex.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,198 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_float_complex_h) -#define octave_float_complex_h 1 - -#include - -#include -#include - -#include "lo-ieee.h" -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "gripes.h" -#include "error.h" -#include "ov-base.h" -#include "ov-flt-cx-mat.h" -#include "ov-base-scalar.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// Complex scalar values. - -class -OCTINTERP_API -octave_float_complex : public octave_base_scalar -{ -public: - - octave_float_complex (void) - : octave_base_scalar () { } - - octave_float_complex (const FloatComplex& c) - : octave_base_scalar (c) { } - - octave_float_complex (const octave_float_complex& c) - : octave_base_scalar (c) { } - - ~octave_float_complex (void) { } - - octave_base_value *clone (void) const { return new octave_float_complex (*this); } - - // We return an octave_float_complex_matrix object here instead of an - // octave_float_complex object so that in expressions like A(2,2,2) = 2 - // (for A previously undefined), A will be empty instead of a 1x1 - // object. - octave_base_value *empty_clone (void) const - { return new octave_float_complex_matrix (); } - - octave_base_value *try_narrowing_conversion (void); - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - octave_value any (int = 0) const - { - return (scalar != FloatComplex (0, 0) - && ! (lo_ieee_isnan (std::real (scalar)) - || lo_ieee_isnan (std::imag (scalar)))); - } - - builtin_type_t builtin_type (void) const { return btyp_float_complex; } - - bool is_complex_scalar (void) const { return true; } - - bool is_complex_type (void) const { return true; } - - bool is_single_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - double double_value (bool = false) const; - - float float_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - float float_scalar_value (bool frc_str_conv = false) const - { return float_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const; - - FloatMatrix float_matrix_value (bool = false) const; - - NDArray array_value (bool = false) const; - - FloatNDArray float_array_value (bool = false) const; - - SparseMatrix sparse_matrix_value (bool = false) const - { return SparseMatrix (matrix_value ()); } - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const - { return SparseComplexMatrix (complex_matrix_value ()); } - - octave_value resize (const dim_vector& dv, bool fill = false) const; - - Complex complex_value (bool = false) const; - - FloatComplex float_complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - FloatComplexMatrix float_complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const; - - FloatComplexNDArray float_complex_array_value (bool = false) const; - - bool bool_value (bool warn = false) const - { - if (xisnan (scalar)) - gripe_nan_to_logical_conversion (); - else if (warn && scalar != 0.0f && scalar != 1.0f) - gripe_logical_conversion (); - - return scalar != 0.0f; - } - - boolNDArray bool_array_value (bool warn = false) const - { - if (xisnan (scalar)) - gripe_nan_to_logical_conversion (); - else if (warn && scalar != 0.0f && scalar != 1.0f) - gripe_logical_conversion (); - - return boolNDArray (dim_vector (1, 1), scalar != 1.0f); - } - - octave_value diag (octave_idx_type m, octave_idx_type n) const; - - void increment (void) { scalar += 1.0; } - - void decrement (void) { scalar -= 1.0; } - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { - // Yes, for compatibility, we drop the imaginary part here. - return os.write (array_value (true), block_size, output_type, - skip, flt_fmt); - } - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const; - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -typedef octave_float_complex octave_float_complex_scalar; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-flt-cx-diag.cc --- a/src/ov-flt-cx-diag.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,207 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "byte-swap.h" - -#include "ov-flt-cx-diag.h" -#include "ov-base-diag.cc" -#include "ov-flt-re-diag.h" -#include "ov-flt-complex.h" -#include "ov-flt-cx-mat.h" -#include "ls-utils.h" - -template class octave_base_diag; - -DEFINE_OCTAVE_ALLOCATOR (octave_float_complex_diag_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_complex_diag_matrix, - "float complex diagonal matrix", "single"); - -static octave_base_value * -default_numeric_conversion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_float_complex_diag_matrix&); - - return new octave_float_complex_matrix (v.float_complex_matrix_value ()); -} - -octave_base_value::type_conv_info -octave_float_complex_diag_matrix::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_conversion_function, - octave_float_complex_matrix::static_type_id ()); -} - -octave_base_value * -octave_float_complex_diag_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (matrix.nelem () == 1) - { - retval = new octave_float_complex (matrix (0, 0)); - octave_base_value *rv2 = retval->try_narrowing_conversion (); - if (rv2) - { - delete retval; - retval = rv2; - } - } - else if (matrix.all_elements_are_real ()) - { - return new octave_float_diag_matrix (::real (matrix)); - } - - return retval; -} - -DiagMatrix -octave_float_complex_diag_matrix::diag_matrix_value (bool force_conversion) const -{ - DiagMatrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - type_name (), "real matrix"); - - retval = ::real (matrix); - - return retval; -} - -FloatDiagMatrix -octave_float_complex_diag_matrix::float_diag_matrix_value (bool force_conversion) const -{ - DiagMatrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - type_name (), "real matrix"); - - retval = ::real (matrix); - - return retval; -} - -ComplexDiagMatrix -octave_float_complex_diag_matrix::complex_diag_matrix_value (bool) const -{ - return ComplexDiagMatrix (matrix); -} - -FloatComplexDiagMatrix -octave_float_complex_diag_matrix::float_complex_diag_matrix_value (bool) const -{ - return matrix; -} - -octave_value -octave_float_complex_diag_matrix::map (unary_mapper_t umap) const -{ - switch (umap) - { - case umap_abs: - return matrix.abs (); - case umap_real: - return ::real (matrix); - case umap_conj: - return ::conj (matrix); - case umap_imag: - return ::imag (matrix); - case umap_sqrt: - { - FloatComplexColumnVector tmp = matrix.diag ().map (std::sqrt); - FloatComplexDiagMatrix retval (tmp); - retval.resize (matrix.rows (), matrix.columns ()); - return retval; - } - default: - return to_dense ().map (umap); - } -} - - -bool -octave_float_complex_diag_matrix::save_binary (std::ostream& os, - bool& /* save_as_floats */) -{ - - int32_t r = matrix.rows (), c = matrix.cols (); - os.write (reinterpret_cast (&r), 4); - os.write (reinterpret_cast (&c), 4); - - FloatComplexMatrix m = FloatComplexMatrix (matrix.diag ()); - save_type st = LS_FLOAT; - if (matrix.length () > 4096) // FIXME -- make this configurable. - { - float max_val, min_val; - if (m.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - } - - const FloatComplex *mtmp = m.data (); - write_floats (os, reinterpret_cast (mtmp), st, 2 * m.numel ()); - - return true; -} - -bool -octave_float_complex_diag_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - int32_t r, c; - char tmp; - if (! (is.read (reinterpret_cast (&r), 4) - && is.read (reinterpret_cast (&c), 4) - && is.read (reinterpret_cast (&tmp), 1))) - return false; - if (swap) - { - swap_bytes<4> (&r); - swap_bytes<4> (&c); - } - - FloatComplexDiagMatrix m (r, c); - FloatComplex *re = m.fortran_vec (); - octave_idx_type len = m.length (); - read_floats (is, reinterpret_cast (re), - static_cast (tmp), 2 * len, swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - - return true; -} - -bool -octave_float_complex_diag_matrix::chk_valid_scalar (const octave_value& val, - FloatComplex& x) const -{ - bool retval = val.is_complex_scalar () || val.is_real_scalar (); - if (retval) - x = val.float_complex_value (); - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/ov-flt-cx-diag.h --- a/src/ov-flt-cx-diag.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_float_complex_diag_matrix_h) -#define octave_float_complex_diag_matrix_h 1 - -#include "ov-base.h" -#include "ov-base-diag.h" -#include "ov-flt-cx-mat.h" -#include "ov-typeinfo.h" - -// Real diagonal matrix values. - -class -OCTINTERP_API -octave_float_complex_diag_matrix - : public octave_base_diag -{ -public: - - octave_float_complex_diag_matrix (void) - : octave_base_diag () { } - - octave_float_complex_diag_matrix (const FloatComplexDiagMatrix& m) - : octave_base_diag (m) { } - - octave_float_complex_diag_matrix (const octave_float_complex_diag_matrix& m) - : octave_base_diag (m) { } - - ~octave_float_complex_diag_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_float_complex_diag_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_float_complex_diag_matrix (); } - - type_conv_info numeric_conversion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - builtin_type_t builtin_type (void) const { return btyp_float_complex; } - - bool is_complex_matrix (void) const { return true; } - - bool is_complex_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - DiagMatrix diag_matrix_value (bool = false) const; - - FloatDiagMatrix float_diag_matrix_value (bool = false) const; - - ComplexDiagMatrix complex_diag_matrix_value (bool = false) const; - - FloatComplexDiagMatrix float_complex_diag_matrix_value (bool = false) const; - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - - octave_value map (unary_mapper_t umap) const; - -private: - - bool chk_valid_scalar (const octave_value&, - FloatComplex&) const; - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-flt-cx-mat.cc --- a/src/ov-flt-cx-mat.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,770 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "data-conv.h" -#include "lo-ieee.h" -#include "lo-specfun.h" -#include "lo-mappers.h" -#include "mx-base.h" -#include "mach-info.h" -#include "oct-locbuf.h" - -#include "gripes.h" -#include "oct-obj.h" -#include "oct-stream.h" -#include "ops.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-base-mat.cc" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "pr-output.h" -#include "ops.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-hdf5.h" -#include "ls-utils.h" - -template class octave_base_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_float_complex_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_complex_matrix, - "float complex matrix", "single"); - -octave_base_value * -octave_float_complex_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (matrix.numel () == 1) - { - FloatComplex c = matrix (0); - - if (std::imag (c) == 0.0) - retval = new octave_float_scalar (std::real (c)); - else - retval = new octave_float_complex (c); - } - else if (matrix.all_elements_are_real ()) - retval = new octave_float_matrix (::real (matrix)); - - return retval; -} - -double -octave_float_complex_matrix::double_value (bool force_conversion) const -{ - double retval = lo_ieee_nan_value (); - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real scalar"); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "complex matrix", "real scalar"); - - retval = std::real (matrix (0, 0)); - } - else - gripe_invalid_conversion ("complex matrix", "real scalar"); - - return retval; -} - -float -octave_float_complex_matrix::float_value (bool force_conversion) const -{ - float retval = lo_ieee_float_nan_value (); - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real scalar"); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "complex matrix", "real scalar"); - - retval = std::real (matrix (0, 0)); - } - else - gripe_invalid_conversion ("complex matrix", "real scalar"); - - return retval; -} - -Matrix -octave_float_complex_matrix::matrix_value (bool force_conversion) const -{ - Matrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real matrix"); - - retval = ::real (matrix.matrix_value ()); - - return retval; -} - -FloatMatrix -octave_float_complex_matrix::float_matrix_value (bool force_conversion) const -{ - FloatMatrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real matrix"); - - retval = ::real (matrix.matrix_value ()); - - return retval; -} - -Complex -octave_float_complex_matrix::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "complex matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("complex matrix", "complex scalar"); - - return retval; -} - -FloatComplex -octave_float_complex_matrix::float_complex_value (bool) const -{ - float tmp = lo_ieee_float_nan_value (); - - FloatComplex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "complex matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("complex matrix", "complex scalar"); - - return retval; -} - -ComplexMatrix -octave_float_complex_matrix::complex_matrix_value (bool) const -{ - return matrix.matrix_value (); -} - -FloatComplexMatrix -octave_float_complex_matrix::float_complex_matrix_value (bool) const -{ - return FloatComplexMatrix (matrix.matrix_value ()); -} - -boolNDArray -octave_float_complex_matrix::bool_array_value (bool warn) const -{ - if (matrix.any_element_is_nan ()) - gripe_nan_to_logical_conversion (); - else if (warn && (! matrix.all_elements_are_real () - || real (matrix).any_element_not_one_or_zero ())) - gripe_logical_conversion (); - - return mx_el_ne (matrix, FloatComplex (0.0)); -} - -charNDArray -octave_float_complex_matrix::char_array_value (bool frc_str_conv) const -{ - charNDArray retval; - - if (! frc_str_conv) - gripe_implicit_conversion ("Octave:num-to-str", - "complex matrix", "string"); - else - { - retval = charNDArray (dims ()); - octave_idx_type nel = numel (); - - for (octave_idx_type i = 0; i < nel; i++) - retval.elem (i) = static_cast(std::real (matrix.elem (i))); - } - - return retval; -} - -FloatComplexNDArray -octave_float_complex_matrix::float_complex_array_value (bool) const -{ - return FloatComplexNDArray (matrix); -} - -SparseMatrix -octave_float_complex_matrix::sparse_matrix_value (bool force_conversion) const -{ - SparseMatrix retval; - - if (! force_conversion) - gripe_implicit_conversion ("Octave:imag-to-real", - "complex matrix", "real matrix"); - - retval = SparseMatrix (::real (complex_matrix_value ())); - - return retval; -} - -SparseComplexMatrix -octave_float_complex_matrix::sparse_complex_matrix_value (bool) const -{ - return SparseComplexMatrix (complex_matrix_value ()); -} - -octave_value -octave_float_complex_matrix::diag (octave_idx_type k) const -{ - octave_value retval; - if (k == 0 && matrix.ndims () == 2 - && (matrix.rows () == 1 || matrix.columns () == 1)) - retval = FloatComplexDiagMatrix (DiagArray2 (matrix)); - else - retval = octave_base_matrix::diag (k); - - return retval; -} - -octave_value -octave_float_complex_matrix::diag (octave_idx_type m, octave_idx_type n) const -{ - octave_value retval; - - if (matrix.ndims () == 2 - && (matrix.rows () == 1 || matrix.columns () == 1)) - { - FloatComplexMatrix mat = matrix.matrix_value (); - - retval = mat.diag (m, n); - } - else - error ("diag: expecting vector argument"); - - return retval; -} - -bool -octave_float_complex_matrix::save_ascii (std::ostream& os) -{ - dim_vector d = dims (); - if (d.length () > 2) - { - FloatComplexNDArray tmp = complex_array_value (); - - os << "# ndims: " << d.length () << "\n"; - - for (int i = 0; i < d.length (); i++) - os << " " << d (i); - - os << "\n" << tmp; - } - else - { - // Keep this case, rather than use generic code above for backward - // compatiability. Makes load_ascii much more complex!! - os << "# rows: " << rows () << "\n" - << "# columns: " << columns () << "\n"; - - os << complex_matrix_value (); - } - - return true; -} - -bool -octave_float_complex_matrix::load_ascii (std::istream& is) -{ - bool success = true; - - string_vector keywords(2); - - keywords[0] = "ndims"; - keywords[1] = "rows"; - - std::string kw; - octave_idx_type val = 0; - - if (extract_keyword (is, keywords, kw, val, true)) - { - if (kw == "ndims") - { - int mdims = static_cast (val); - - if (mdims >= 0) - { - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - is >> dv(i); - - if (is) - { - FloatComplexNDArray tmp(dv); - - is >> tmp; - - if (is) - matrix = tmp; - else - { - error ("load: failed to load matrix constant"); - success = false; - } - } - else - { - error ("load: failed to read dimensions"); - success = false; - } - } - else - { - error ("load: failed to extract number of dimensions"); - success = false; - } - } - else if (kw == "rows") - { - octave_idx_type nr = val; - octave_idx_type nc = 0; - - if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) - { - if (nr > 0 && nc > 0) - { - FloatComplexMatrix tmp (nr, nc); - is >> tmp; - if (is) - matrix = tmp; - else - { - error ("load: failed to load matrix constant"); - success = false; - } - } - else if (nr == 0 || nc == 0) - matrix = FloatComplexMatrix (nr, nc); - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - } - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - - return success; -} - -bool -octave_float_complex_matrix::save_binary (std::ostream& os, bool&) -{ - dim_vector d = dims (); - if (d.length () < 1) - return false; - - // Use negative value for ndims to differentiate with old format!! - int32_t tmp = - d.length (); - os.write (reinterpret_cast (&tmp), 4); - for (int i = 0; i < d.length (); i++) - { - tmp = d(i); - os.write (reinterpret_cast (&tmp), 4); - } - - FloatComplexNDArray m = complex_array_value (); - save_type st = LS_FLOAT; - if (d.numel () > 4096) // FIXME -- make this configurable. - { - float max_val, min_val; - if (m.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - } - - const FloatComplex *mtmp = m.data (); - write_floats (os, reinterpret_cast (mtmp), st, 2 * d.numel ()); - - return true; -} - -bool -octave_float_complex_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - char tmp; - int32_t mdims; - if (! is.read (reinterpret_cast (&mdims), 4)) - return false; - if (swap) - swap_bytes<4> (&mdims); - if (mdims < 0) - { - mdims = - mdims; - int32_t di; - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - { - if (! is.read (reinterpret_cast (&di), 4)) - return false; - if (swap) - swap_bytes<4> (&di); - dv(i) = di; - } - - // Convert an array with a single dimension to be a row vector. - // Octave should never write files like this, other software - // might. - - if (mdims == 1) - { - mdims = 2; - dv.resize (mdims); - dv(1) = dv(0); - dv(0) = 1; - } - - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - - FloatComplexNDArray m(dv); - FloatComplex *im = m.fortran_vec (); - read_floats (is, reinterpret_cast (im), - static_cast (tmp), 2 * dv.numel (), swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - } - else - { - int32_t nr, nc; - nr = mdims; - if (! is.read (reinterpret_cast (&nc), 4)) - return false; - if (swap) - swap_bytes<4> (&nc); - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - FloatComplexMatrix m (nr, nc); - FloatComplex *im = m.fortran_vec (); - octave_idx_type len = nr * nc; - read_floats (is, reinterpret_cast (im), - static_cast (tmp), 2*len, swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - } - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_float_complex_matrix::save_hdf5 (hid_t loc_id, const char *name, bool) -{ - dim_vector dv = dims (); - int empty = save_hdf5_empty (loc_id, name, dv); - if (empty) - return (empty > 0); - - int rank = dv.length (); - hid_t space_hid = -1, data_hid = -1, type_hid = -1; - bool retval = true; - FloatComplexNDArray m = complex_array_value (); - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - - // Octave uses column-major, while HDF5 uses row-major ordering - for (int i = 0; i < rank; i++) - hdims[i] = dv (rank-i-1); - - space_hid = H5Screate_simple (rank, hdims, 0); - if (space_hid < 0) return false; - - hid_t save_type_hid = H5T_NATIVE_FLOAT; - -#if HAVE_HDF5_INT2FLOAT_CONVERSIONS - // hdf5 currently doesn't support float/integer conversions - else - { - float max_val, min_val; - - if (m.all_integers (max_val, min_val)) - save_type_hid - = save_type_to_hdf5 (get_save_type (max_val, min_val)); - } -#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ - - type_hid = hdf5_make_complex_type (save_type_hid); - if (type_hid < 0) - { - H5Sclose (space_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - return false; - } - - hid_t complex_type_hid = hdf5_make_complex_type (H5T_NATIVE_FLOAT); - if (complex_type_hid < 0) retval = false; - - if (retval) - { - FloatComplex *mtmp = m.fortran_vec (); - if (H5Dwrite (data_hid, complex_type_hid, H5S_ALL, H5S_ALL, H5P_DEFAULT, - mtmp) < 0) - { - H5Tclose (complex_type_hid); - retval = false; - } - } - - H5Tclose (complex_type_hid); - H5Dclose (data_hid); - H5Tclose (type_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_float_complex_matrix::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; - - dim_vector dv; - int empty = load_hdf5_empty (loc_id, name, dv); - if (empty > 0) - matrix.resize (dv); - if (empty) - return (empty > 0); - -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t type_hid = H5Dget_type (data_hid); - - hid_t complex_type = hdf5_make_complex_type (H5T_NATIVE_FLOAT); - - if (! hdf5_types_compatible (type_hid, complex_type)) - { - H5Tclose (complex_type); - H5Dclose (data_hid); - return false; - } - - hid_t space_id = H5Dget_space (data_hid); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank < 1) - { - H5Tclose (complex_type); - H5Sclose (space_id); - H5Dclose (data_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_id, hdims, maxdims); - - // Octave uses column-major, while HDF5 uses row-major ordering - if (rank == 1) - { - dv.resize (2); - dv(0) = 1; - dv(1) = hdims[0]; - } - else - { - dv.resize (rank); - for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) - dv(j) = hdims[i]; - } - - FloatComplexNDArray m (dv); - FloatComplex *reim = m.fortran_vec (); - if (H5Dread (data_hid, complex_type, H5S_ALL, H5S_ALL, H5P_DEFAULT, - reim) >= 0) - { - retval = true; - matrix = m; - } - - H5Tclose (complex_type); - H5Sclose (space_id); - H5Dclose (data_hid); - - return retval; -} - -#endif - -void -octave_float_complex_matrix::print_raw (std::ostream& os, - bool pr_as_read_syntax) const -{ - octave_print_internal (os, matrix, pr_as_read_syntax, - current_print_indent_level ()); -} - -mxArray * -octave_float_complex_matrix::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxSINGLE_CLASS, dims (), mxCOMPLEX); - - float *pr = static_cast (retval->get_data ()); - float *pi = static_cast (retval->get_imag_data ()); - - mwSize nel = numel (); - - const FloatComplex *p = matrix.data (); - - for (mwIndex i = 0; i < nel; i++) - { - pr[i] = std::real (p[i]); - pi[i] = std::imag (p[i]); - } - - return retval; -} - -octave_value -octave_float_complex_matrix::map (unary_mapper_t umap) const -{ - switch (umap) - { - // Mappers handled specially. - case umap_real: - return ::real (matrix); - case umap_imag: - return ::imag (matrix); - case umap_conj: - return ::conj (matrix); - -#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.FCN ()) - - ARRAY_METHOD_MAPPER (abs, abs); - ARRAY_METHOD_MAPPER (isnan, isnan); - ARRAY_METHOD_MAPPER (isinf, isinf); - ARRAY_METHOD_MAPPER (finite, isfinite); - -#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.map (FCN)) - - ARRAY_MAPPER (acos, FloatComplex, ::acos); - ARRAY_MAPPER (acosh, FloatComplex, ::acosh); - ARRAY_MAPPER (angle, float, std::arg); - ARRAY_MAPPER (arg, float, std::arg); - ARRAY_MAPPER (asin, FloatComplex, ::asin); - ARRAY_MAPPER (asinh, FloatComplex, ::asinh); - ARRAY_MAPPER (atan, FloatComplex, ::atan); - ARRAY_MAPPER (atanh, FloatComplex, ::atanh); - ARRAY_MAPPER (ceil, FloatComplex, ::ceil); - ARRAY_MAPPER (cos, FloatComplex, std::cos); - ARRAY_MAPPER (cosh, FloatComplex, std::cosh); - ARRAY_MAPPER (exp, FloatComplex, std::exp); - ARRAY_MAPPER (expm1, FloatComplex, ::expm1); - ARRAY_MAPPER (fix, FloatComplex, ::fix); - ARRAY_MAPPER (floor, FloatComplex, ::floor); - ARRAY_MAPPER (log, FloatComplex, std::log); - ARRAY_MAPPER (log2, FloatComplex, xlog2); - ARRAY_MAPPER (log10, FloatComplex, std::log10); - ARRAY_MAPPER (log1p, FloatComplex, ::log1p); - ARRAY_MAPPER (round, FloatComplex, xround); - ARRAY_MAPPER (roundb, FloatComplex, xroundb); - ARRAY_MAPPER (signum, FloatComplex, ::signum); - ARRAY_MAPPER (sin, FloatComplex, std::sin); - ARRAY_MAPPER (sinh, FloatComplex, std::sinh); - ARRAY_MAPPER (sqrt, FloatComplex, std::sqrt); - ARRAY_MAPPER (tan, FloatComplex, std::tan); - ARRAY_MAPPER (tanh, FloatComplex, std::tanh); - ARRAY_MAPPER (isna, bool, octave_is_NA); - - default: - return octave_base_value::map (umap); - } -} diff -r d02b229ce693 -r a132d206a36a src/ov-flt-cx-mat.h --- a/src/ov-flt-cx-mat.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,181 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_float_complex_matrix_h) -#define octave_float_complex_matrix_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-stream.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-typeinfo.h" - -#include "MatrixType.h" - -class octave_value_list; - -class tree_walker; - -// Complex matrix values. - -class -OCTINTERP_API -octave_float_complex_matrix : public octave_base_matrix -{ -public: - - octave_float_complex_matrix (void) - : octave_base_matrix () { } - - octave_float_complex_matrix (const FloatComplexNDArray& m) - : octave_base_matrix (m) { } - - octave_float_complex_matrix (const FloatComplexMatrix& m) - : octave_base_matrix (m) { } - - octave_float_complex_matrix (const FloatComplexMatrix& m, const MatrixType& t) - : octave_base_matrix (m, t) { } - - octave_float_complex_matrix (const Array& m) - : octave_base_matrix (FloatComplexNDArray (m)) { } - - octave_float_complex_matrix (const FloatComplexDiagMatrix& d) - : octave_base_matrix (FloatComplexMatrix (d)) { } - - octave_float_complex_matrix (const FloatComplexRowVector& v) - : octave_base_matrix (FloatComplexMatrix (v)) { } - - octave_float_complex_matrix (const FloatComplexColumnVector& v) - : octave_base_matrix (FloatComplexMatrix (v)) { } - - octave_float_complex_matrix (const octave_float_complex_matrix& cm) - : octave_base_matrix (cm) { } - - ~octave_float_complex_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_float_complex_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_float_complex_matrix (); } - - octave_base_value *try_narrowing_conversion (void); - - builtin_type_t builtin_type (void) const { return btyp_float_complex; } - - bool is_complex_matrix (void) const { return true; } - - bool is_complex_type (void) const { return true; } - - bool is_single_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - double double_value (bool = false) const; - - float float_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - float float_scalar_value (bool frc_str_conv = false) const - { return float_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const; - - FloatMatrix float_matrix_value (bool = false) const; - - Complex complex_value (bool = false) const; - - FloatComplex float_complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - FloatComplexMatrix float_complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const { return matrix; } - - FloatComplexNDArray float_complex_array_value (bool = false) const; - - boolNDArray bool_array_value (bool warn = false) const; - - charNDArray char_array_value (bool frc_str_conv = false) const; - - SparseMatrix sparse_matrix_value (bool = false) const; - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; - - octave_value diag (octave_idx_type k = 0) const; - - octave_value diag (octave_idx_type m, octave_idx_type n) const; - - void increment (void) { matrix += FloatComplex (1.0); } - - void decrement (void) { matrix -= FloatComplex (1.0); } - - void changesign (void) { matrix.changesign (); } - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { - // Yes, for compatibility, we drop the imaginary part here. - return os.write (matrix_value (true), block_size, output_type, - skip, flt_fmt); - } - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const; - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-flt-re-diag.cc --- a/src/ov-flt-re-diag.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,175 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "byte-swap.h" - -#include "ov-flt-re-diag.h" -#include "ov-base-diag.cc" -#include "ov-float.h" -#include "ov-flt-re-mat.h" -#include "ls-utils.h" - -template class octave_base_diag; - -DEFINE_OCTAVE_ALLOCATOR (octave_float_diag_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_diag_matrix, - "float diagonal matrix", "single"); - -static octave_base_value * -default_numeric_conversion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_float_diag_matrix&); - - return new octave_float_matrix (v.float_matrix_value ()); -} - -octave_base_value::type_conv_info -octave_float_diag_matrix::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_conversion_function, - octave_float_matrix::static_type_id ()); -} - -octave_base_value * -octave_float_diag_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (matrix.nelem () == 1) - retval = new octave_float_scalar (matrix (0, 0)); - - return retval; -} - -DiagMatrix -octave_float_diag_matrix::diag_matrix_value (bool) const -{ - return DiagMatrix (matrix); -} - -FloatDiagMatrix -octave_float_diag_matrix::float_diag_matrix_value (bool) const -{ - return matrix; -} - -ComplexDiagMatrix -octave_float_diag_matrix::complex_diag_matrix_value (bool) const -{ - return ComplexDiagMatrix (matrix); -} - -FloatComplexDiagMatrix -octave_float_diag_matrix::float_complex_diag_matrix_value (bool) const -{ - return FloatComplexDiagMatrix (matrix); -} - -octave_value -octave_float_diag_matrix::map (unary_mapper_t umap) const -{ - switch (umap) - { - case umap_abs: - return matrix.abs (); - case umap_real: - case umap_conj: - return matrix; - case umap_imag: - return DiagMatrix (matrix.rows (), matrix.cols (), 0.0); - case umap_sqrt: - { - FloatComplexColumnVector tmp = matrix.diag ().map (rc_sqrt); - FloatComplexDiagMatrix retval (tmp); - retval.resize (matrix.rows (), matrix.columns ()); - return retval; - } - default: - return to_dense ().map (umap); - } -} - -bool -octave_float_diag_matrix::save_binary (std::ostream& os, - bool& /* save_as_floats*/) -{ - - int32_t r = matrix.rows (), c = matrix.cols (); - os.write (reinterpret_cast (&r), 4); - os.write (reinterpret_cast (&c), 4); - - FloatMatrix m = FloatMatrix (matrix.diag ()); - save_type st = LS_FLOAT; - if (matrix.length () > 8192) // FIXME -- make this configurable. - { - float max_val, min_val; - if (m.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - } - - const float *mtmp = m.data (); - write_floats (os, mtmp, st, m.numel ()); - - return true; -} - -bool -octave_float_diag_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - int32_t r, c; - char tmp; - if (! (is.read (reinterpret_cast (&r), 4) - && is.read (reinterpret_cast (&c), 4) - && is.read (reinterpret_cast (&tmp), 1))) - return false; - if (swap) - { - swap_bytes<4> (&r); - swap_bytes<4> (&c); - } - - FloatDiagMatrix m (r, c); - float *re = m.fortran_vec (); - octave_idx_type len = m.length (); - read_floats (is, re, static_cast (tmp), len, swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - - return true; -} - -bool -octave_float_diag_matrix::chk_valid_scalar (const octave_value& val, - float& x) const -{ - bool retval = val.is_real_scalar (); - if (retval) - x = val.float_value (); - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/ov-flt-re-diag.h --- a/src/ov-flt-re-diag.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_float_diag_matrix_h) -#define octave_float_diag_matrix_h 1 - -#include "ov-base.h" -#include "ov-base-diag.h" -#include "ov-flt-re-mat.h" -#include "ov-typeinfo.h" - -// Real diagonal matrix values. - -class -OCTINTERP_API -octave_float_diag_matrix - : public octave_base_diag -{ -public: - - octave_float_diag_matrix (void) - : octave_base_diag () { } - - octave_float_diag_matrix (const FloatDiagMatrix& m) - : octave_base_diag (m) { } - - octave_float_diag_matrix (const octave_float_diag_matrix& m) - : octave_base_diag (m) { } - - ~octave_float_diag_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_float_diag_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_float_diag_matrix (); } - - type_conv_info numeric_conversion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - builtin_type_t builtin_type (void) const { return btyp_float; } - - bool is_real_matrix (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_single_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - DiagMatrix diag_matrix_value (bool = false) const; - - FloatDiagMatrix float_diag_matrix_value (bool = false) const; - - ComplexDiagMatrix complex_diag_matrix_value (bool = false) const; - - FloatComplexDiagMatrix float_complex_diag_matrix_value (bool = false) const; - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - - octave_value map (unary_mapper_t umap) const; - -private: - - bool chk_valid_scalar (const octave_value&, - float&) const; - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-flt-re-mat.cc --- a/src/ov-flt-re-mat.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,886 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "data-conv.h" -#include "lo-ieee.h" -#include "lo-utils.h" -#include "lo-specfun.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "mx-base.h" -#include "quit.h" -#include "oct-locbuf.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "oct-stream.h" -#include "ops.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-base-mat.cc" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-flt-complex.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-re-sparse.h" -#include "ov-flt-re-diag.h" -#include "ov-flt-cx-diag.h" -#include "ov-type-conv.h" -#include "pr-output.h" -#include "variables.h" -#include "ops.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -#if ! defined (UCHAR_MAX) -#define UCHAR_MAX 255 -#endif - -template class octave_base_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_float_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_float_matrix, "float matrix", "single"); - -octave_base_value * -octave_float_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (matrix.nelem () == 1) - retval = new octave_float_scalar (matrix (0)); - - return retval; -} - -double -octave_float_matrix::double_value (bool) const -{ - double retval = lo_ieee_nan_value (); - - if (numel () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "real matrix", "real scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("real matrix", "real scalar"); - - return retval; -} - -float -octave_float_matrix::float_value (bool) const -{ - float retval = lo_ieee_float_nan_value (); - - if (numel () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "real matrix", "real scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("real matrix", "real scalar"); - - return retval; -} - -// FIXME - -Matrix -octave_float_matrix::matrix_value (bool) const -{ - return Matrix (matrix.matrix_value ()); -} - -FloatMatrix -octave_float_matrix::float_matrix_value (bool) const -{ - return matrix.matrix_value (); -} - -Complex -octave_float_matrix::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "real matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("real matrix", "complex scalar"); - - return retval; -} - -FloatComplex -octave_float_matrix::float_complex_value (bool) const -{ - double tmp = lo_ieee_float_nan_value (); - - FloatComplex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "real matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("real matrix", "complex scalar"); - - return retval; -} - -// FIXME - -ComplexMatrix -octave_float_matrix::complex_matrix_value (bool) const -{ - return ComplexMatrix (matrix.matrix_value ()); -} - -FloatComplexMatrix -octave_float_matrix::float_complex_matrix_value (bool) const -{ - return FloatComplexMatrix (matrix.matrix_value ()); -} - -ComplexNDArray -octave_float_matrix::complex_array_value (bool) const -{ - return ComplexNDArray (matrix); -} - -FloatComplexNDArray -octave_float_matrix::float_complex_array_value (bool) const -{ - return FloatComplexNDArray (matrix); -} - -NDArray -octave_float_matrix::array_value (bool) const -{ - return NDArray (matrix); -} - -boolNDArray -octave_float_matrix::bool_array_value (bool warn) const -{ - if (matrix.any_element_is_nan ()) - gripe_nan_to_logical_conversion (); - else if (warn && matrix.any_element_not_one_or_zero ()) - gripe_logical_conversion (); - - return boolNDArray (matrix); -} - -charNDArray -octave_float_matrix::char_array_value (bool) const -{ - charNDArray retval (dims ()); - - octave_idx_type nel = numel (); - - for (octave_idx_type i = 0; i < nel; i++) - retval.elem (i) = static_cast(matrix.elem (i)); - - return retval; -} - -SparseMatrix -octave_float_matrix::sparse_matrix_value (bool) const -{ - return SparseMatrix (matrix_value ()); -} - -SparseComplexMatrix -octave_float_matrix::sparse_complex_matrix_value (bool) const -{ - // FIXME Need a SparseComplexMatrix (Matrix) constructor to make - // this function more efficient. Then this should become - // return SparseComplexMatrix (matrix.matrix_value ()); - return SparseComplexMatrix (sparse_matrix_value ()); -} - -octave_value -octave_float_matrix::diag (octave_idx_type k) const -{ - octave_value retval; - if (k == 0 && matrix.ndims () == 2 - && (matrix.rows () == 1 || matrix.columns () == 1)) - retval = FloatDiagMatrix (DiagArray2 (matrix)); - else - retval = octave_base_matrix::diag (k); - - return retval; -} - -octave_value -octave_float_matrix::diag (octave_idx_type m, octave_idx_type n) const -{ - octave_value retval; - - if (matrix.ndims () == 2 - && (matrix.rows () == 1 || matrix.columns () == 1)) - { - FloatMatrix mat = matrix.matrix_value (); - - retval = mat.diag (m, n); - } - else - error ("diag: expecting vector argument"); - - return retval; -} - -octave_value -octave_float_matrix::convert_to_str_internal (bool, bool, char type) const -{ - octave_value retval; - dim_vector dv = dims (); - octave_idx_type nel = dv.numel (); - - charNDArray chm (dv); - - bool warned = false; - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_quit (); - - float d = matrix (i); - - if (xisnan (d)) - { - gripe_nan_to_character_conversion (); - return retval; - } - else - { - int ival = NINT (d); - - if (ival < 0 || ival > UCHAR_MAX) - { - // FIXME -- is there something - // better we could do? - - ival = 0; - - if (! warned) - { - ::warning ("range error for conversion to character value"); - warned = true; - } - } - - chm (i) = static_cast (ival); - } - } - - retval = octave_value (chm, type); - - return retval; -} - -bool -octave_float_matrix::save_ascii (std::ostream& os) -{ - dim_vector d = dims (); - - if (d.length () > 2) - { - FloatNDArray tmp = float_array_value (); - - os << "# ndims: " << d.length () << "\n"; - - for (int i=0; i < d.length (); i++) - os << " " << d (i); - - os << "\n" << tmp; - } - else - { - // Keep this case, rather than use generic code above for backward - // compatiability. Makes load_ascii much more complex!! - os << "# rows: " << rows () << "\n" - << "# columns: " << columns () << "\n"; - - os << float_matrix_value (); - } - - return true; -} - -bool -octave_float_matrix::load_ascii (std::istream& is) -{ - bool success = true; - - string_vector keywords(2); - - keywords[0] = "ndims"; - keywords[1] = "rows"; - - std::string kw; - octave_idx_type val = 0; - - if (extract_keyword (is, keywords, kw, val, true)) - { - if (kw == "ndims") - { - int mdims = static_cast (val); - - if (mdims >= 0) - { - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - is >> dv(i); - - if (is) - { - FloatNDArray tmp(dv); - - is >> tmp; - - if (is) - matrix = tmp; - else - { - error ("load: failed to load matrix constant"); - success = false; - } - } - else - { - error ("load: failed to read dimensions"); - success = false; - } - } - else - { - error ("load: failed to extract number of dimensions"); - success = false; - } - } - else if (kw == "rows") - { - octave_idx_type nr = val; - octave_idx_type nc = 0; - - if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) - { - if (nr > 0 && nc > 0) - { - FloatMatrix tmp (nr, nc); - is >> tmp; - if (is) - matrix = tmp; - else - { - error ("load: failed to load matrix constant"); - success = false; - } - } - else if (nr == 0 || nc == 0) - matrix = FloatMatrix (nr, nc); - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - } - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - - return success; -} - -bool -octave_float_matrix::save_binary (std::ostream& os, bool&) -{ - - dim_vector d = dims (); - if (d.length () < 1) - return false; - - // Use negative value for ndims to differentiate with old format!! - int32_t tmp = - d.length (); - os.write (reinterpret_cast (&tmp), 4); - for (int i = 0; i < d.length (); i++) - { - tmp = d(i); - os.write (reinterpret_cast (&tmp), 4); - } - - FloatNDArray m = float_array_value (); - save_type st = LS_FLOAT; - if (d.numel () > 8192) // FIXME -- make this configurable. - { - float max_val, min_val; - if (m.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - } - - const float *mtmp = m.data (); - write_floats (os, mtmp, st, d.numel ()); - - return true; -} - -bool -octave_float_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - char tmp; - int32_t mdims; - if (! is.read (reinterpret_cast (&mdims), 4)) - return false; - if (swap) - swap_bytes<4> (&mdims); - if (mdims < 0) - { - mdims = - mdims; - int32_t di; - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - { - if (! is.read (reinterpret_cast (&di), 4)) - return false; - if (swap) - swap_bytes<4> (&di); - dv(i) = di; - } - - // Convert an array with a single dimension to be a row vector. - // Octave should never write files like this, other software - // might. - - if (mdims == 1) - { - mdims = 2; - dv.resize (mdims); - dv(1) = dv(0); - dv(0) = 1; - } - - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - - FloatNDArray m(dv); - float *re = m.fortran_vec (); - read_floats (is, re, static_cast (tmp), dv.numel (), swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - } - else - { - int32_t nr, nc; - nr = mdims; - if (! is.read (reinterpret_cast (&nc), 4)) - return false; - if (swap) - swap_bytes<4> (&nc); - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - FloatMatrix m (nr, nc); - float *re = m.fortran_vec (); - octave_idx_type len = nr * nc; - read_floats (is, re, static_cast (tmp), len, swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - } - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_float_matrix::save_hdf5 (hid_t loc_id, const char *name, bool) -{ - dim_vector dv = dims (); - int empty = save_hdf5_empty (loc_id, name, dv); - if (empty) - return (empty > 0); - - int rank = dv.length (); - hid_t space_hid = -1, data_hid = -1; - bool retval = true; - FloatNDArray m = array_value (); - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - - // Octave uses column-major, while HDF5 uses row-major ordering - for (int i = 0; i < rank; i++) - hdims[i] = dv (rank-i-1); - - space_hid = H5Screate_simple (rank, hdims, 0); - - if (space_hid < 0) return false; - - hid_t save_type_hid = H5T_NATIVE_FLOAT; - -#if HAVE_HDF5_INT2FLOAT_CONVERSIONS - // hdf5 currently doesn't support float/integer conversions - else - { - float max_val, min_val; - - if (m.all_integers (max_val, min_val)) - save_type_hid - = save_type_to_hdf5 (get_save_type (max_val, min_val)); - } -#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - return false; - } - - float *mtmp = m.fortran_vec (); - retval = H5Dwrite (data_hid, H5T_NATIVE_FLOAT, H5S_ALL, H5S_ALL, - H5P_DEFAULT, mtmp) >= 0; - - H5Dclose (data_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_float_matrix::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; - - dim_vector dv; - int empty = load_hdf5_empty (loc_id, name, dv); - if (empty > 0) - matrix.resize (dv); - if (empty) - return (empty > 0); - -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t space_id = H5Dget_space (data_hid); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank < 1) - { - H5Sclose (space_id); - H5Dclose (data_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_id, hdims, maxdims); - - // Octave uses column-major, while HDF5 uses row-major ordering - if (rank == 1) - { - dv.resize (2); - dv(0) = 1; - dv(1) = hdims[0]; - } - else - { - dv.resize (rank); - for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) - dv(j) = hdims[i]; - } - - FloatNDArray m (dv); - float *re = m.fortran_vec (); - if (H5Dread (data_hid, H5T_NATIVE_FLOAT, H5S_ALL, H5S_ALL, - H5P_DEFAULT, re) >= 0) - { - retval = true; - matrix = m; - } - - H5Sclose (space_id); - H5Dclose (data_hid); - - return retval; -} - -#endif - -void -octave_float_matrix::print_raw (std::ostream& os, - bool pr_as_read_syntax) const -{ - octave_print_internal (os, matrix, pr_as_read_syntax, - current_print_indent_level ()); -} - -mxArray * -octave_float_matrix::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxSINGLE_CLASS, dims (), mxREAL); - - float *pr = static_cast (retval->get_data ()); - - mwSize nel = numel (); - - const float *p = matrix.data (); - - for (mwIndex i = 0; i < nel; i++) - pr[i] = p[i]; - - return retval; -} - -// This uses a smarter strategy for doing the complex->real mappers. We -// allocate an array for a real result and keep filling it until a complex -// result is produced. -static octave_value -do_rc_map (const FloatNDArray& a, FloatComplex (&fcn) (float)) -{ - octave_idx_type n = a.numel (); - NoAlias rr (a.dims ()); - - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - - FloatComplex tmp = fcn (a(i)); - if (tmp.imag () == 0.0) - rr(i) = tmp.real (); - else - { - NoAlias rc (a.dims ()); - - for (octave_idx_type j = 0; j < i; j++) - rc(j) = rr(j); - - rc(i) = tmp; - - for (octave_idx_type j = i+1; j < n; j++) - { - octave_quit (); - - rc(j) = fcn (a(j)); - } - - return new octave_float_complex_matrix (rc); - } - } - - return rr; -} - -octave_value -octave_float_matrix::map (unary_mapper_t umap) const -{ - switch (umap) - { - case umap_imag: - return FloatNDArray (matrix.dims (), 0.0); - - case umap_real: - case umap_conj: - return matrix; - - // Mappers handled specially. -#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.FCN ()) - - ARRAY_METHOD_MAPPER (abs, abs); - ARRAY_METHOD_MAPPER (isnan, isnan); - ARRAY_METHOD_MAPPER (isinf, isinf); - ARRAY_METHOD_MAPPER (finite, isfinite); - -#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.map (FCN)) - -#define RC_ARRAY_MAPPER(UMAP, TYPE, FCN) \ - case umap_ ## UMAP: \ - return do_rc_map (matrix, FCN) - - RC_ARRAY_MAPPER (acos, FloatComplex, rc_acos); - RC_ARRAY_MAPPER (acosh, FloatComplex, rc_acosh); - ARRAY_MAPPER (angle, float, ::arg); - ARRAY_MAPPER (arg, float, ::arg); - RC_ARRAY_MAPPER (asin, FloatComplex, rc_asin); - ARRAY_MAPPER (asinh, float, ::asinhf); - ARRAY_MAPPER (atan, float, ::atanf); - RC_ARRAY_MAPPER (atanh, FloatComplex, rc_atanh); - ARRAY_MAPPER (erf, float, ::erff); - ARRAY_MAPPER (erfinv, float, ::erfinv); - ARRAY_MAPPER (erfcinv, float, ::erfcinv); - ARRAY_MAPPER (erfc, float, ::erfcf); - ARRAY_MAPPER (erfcx, float, ::erfcx); - ARRAY_MAPPER (gamma, float, xgamma); - RC_ARRAY_MAPPER (lgamma, FloatComplex, rc_lgamma); - ARRAY_MAPPER (cbrt, float, ::cbrtf); - ARRAY_MAPPER (ceil, float, ::ceilf); - ARRAY_MAPPER (cos, float, ::cosf); - ARRAY_MAPPER (cosh, float, ::coshf); - ARRAY_MAPPER (exp, float, ::expf); - ARRAY_MAPPER (expm1, float, ::expm1f); - ARRAY_MAPPER (fix, float, ::fix); - ARRAY_MAPPER (floor, float, ::floorf); - RC_ARRAY_MAPPER (log, FloatComplex, rc_log); - RC_ARRAY_MAPPER (log2, FloatComplex, rc_log2); - RC_ARRAY_MAPPER (log10, FloatComplex, rc_log10); - RC_ARRAY_MAPPER (log1p, FloatComplex, rc_log1p); - ARRAY_MAPPER (round, float, xround); - ARRAY_MAPPER (roundb, float, xroundb); - ARRAY_MAPPER (signum, float, ::signum); - ARRAY_MAPPER (sin, float, ::sinf); - ARRAY_MAPPER (sinh, float, ::sinhf); - RC_ARRAY_MAPPER (sqrt, FloatComplex, rc_sqrt); - ARRAY_MAPPER (tan, float, ::tanf); - ARRAY_MAPPER (tanh, float, ::tanhf); - ARRAY_MAPPER (isna, bool, octave_is_NA); - - default: - return octave_base_value::map (umap); - } -} - -DEFUN (single, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} single (@var{x})\n\ -Convert @var{x} to single precision type.\n\ -@seealso{double}\n\ -@end deftypefn") -{ - // The OCTAVE_TYPE_CONV_BODY3 macro declares retval, so they go - // inside their own scopes, and we don't declare retval here to - // avoid a shadowed declaration warning. - - if (args.length () == 1) - { - if (args(0).is_diag_matrix ()) - { - if (args(0).is_complex_type ()) - { - OCTAVE_TYPE_CONV_BODY3 (single, octave_float_complex_diag_matrix, octave_float_complex); - } - else - { - OCTAVE_TYPE_CONV_BODY3 (single, octave_float_diag_matrix, octave_float_scalar); - } - } - else if (args(0).is_sparse_type ()) - { - error ("single: sparse type does not support single precision"); - } - else if (args(0).is_complex_type ()) - { - OCTAVE_TYPE_CONV_BODY3 (single, octave_float_complex_matrix, octave_float_complex); - } - else - { - OCTAVE_TYPE_CONV_BODY3 (single, octave_float_matrix, octave_float_scalar); - } - } - else - print_usage (); - - return octave_value (); -} - -/* -%!assert (class (single (1)), "single") -%!assert (class (single (1 + i)), "single") -%!assert (class (single (int8 (1))), "single") -%!assert (class (single (uint8 (1))), "single") -%!assert (class (single (int16 (1))), "single") -%!assert (class (single (uint16 (1))), "single") -%!assert (class (single (int32 (1))), "single") -%!assert (class (single (uint32 (1))), "single") -%!assert (class (single (int64 (1))), "single") -%!assert (class (single (uint64 (1))), "single") -%!assert (class (single (true)), "single") -%!assert (class (single ("A")), "single") -%!error (single (sparse (1))) -%!test -%! x = diag ([1 3 2]); -%! y = single (x); -%! assert (class (x), "double"); -%! assert (class (y), "single"); -%!test -%! x = diag ([i 3 2]); -%! y = single (x); -%! assert (class (x), "double"); -%! assert (class (y), "single"); -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-flt-re-mat.h --- a/src/ov-flt-re-mat.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,214 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_float_matrix_h) -#define octave_float_matrix_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-stream.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-typeinfo.h" - -#include "MatrixType.h" - -class octave_value_list; - -class tree_walker; - -// Real matrix values. - -class -OCTINTERP_API -octave_float_matrix : public octave_base_matrix -{ -public: - - octave_float_matrix (void) - : octave_base_matrix () { } - - octave_float_matrix (const FloatMatrix& m) - : octave_base_matrix (m) { } - - octave_float_matrix (const FloatMatrix& m, const MatrixType& t) - : octave_base_matrix (m, t) { } - - octave_float_matrix (const FloatNDArray& nda) - : octave_base_matrix (nda) { } - - octave_float_matrix (const Array& m) - : octave_base_matrix (FloatNDArray (m)) { } - - octave_float_matrix (const FloatDiagMatrix& d) - : octave_base_matrix (FloatMatrix (d)) { } - - octave_float_matrix (const FloatRowVector& v) - : octave_base_matrix (FloatMatrix (v)) { } - - octave_float_matrix (const FloatColumnVector& v) - : octave_base_matrix (FloatMatrix (v)) { } - - octave_float_matrix (const octave_float_matrix& m) - : octave_base_matrix (m) { } - - ~octave_float_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_float_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_float_matrix (); } - - octave_base_value *try_narrowing_conversion (void); - - idx_vector index_vector (void) const - { return idx_cache ? *idx_cache : set_idx_cache (idx_vector (matrix)); } - - builtin_type_t builtin_type (void) const { return btyp_float; } - - bool is_real_matrix (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_single_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - int8NDArray - int8_array_value (void) const { return int8NDArray (matrix); } - - int16NDArray - int16_array_value (void) const { return int16NDArray (matrix); } - - int32NDArray - int32_array_value (void) const { return int32NDArray (matrix); } - - int64NDArray - int64_array_value (void) const { return int64NDArray (matrix); } - - uint8NDArray - uint8_array_value (void) const { return uint8NDArray (matrix); } - - uint16NDArray - uint16_array_value (void) const { return uint16NDArray (matrix); } - - uint32NDArray - uint32_array_value (void) const { return uint32NDArray (matrix); } - - uint64NDArray - uint64_array_value (void) const { return uint64NDArray (matrix); } - - double double_value (bool = false) const; - - float float_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - float float_scalar_value (bool frc_str_conv = false) const - { return float_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const; - - FloatMatrix float_matrix_value (bool = false) const; - - Complex complex_value (bool = false) const; - - FloatComplex float_complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - FloatComplexMatrix float_complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const; - - FloatComplexNDArray float_complex_array_value (bool = false) const; - - boolNDArray bool_array_value (bool warn = false) const; - - charNDArray char_array_value (bool = false) const; - - NDArray array_value (bool = false) const; - - FloatNDArray float_array_value (bool = false) const { return matrix; } - - SparseMatrix sparse_matrix_value (bool = false) const; - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; - - octave_value diag (octave_idx_type k = 0) const; - - octave_value diag (octave_idx_type m, octave_idx_type n) const; - - // Use matrix_ref here to clear index cache. - void increment (void) { matrix_ref () += 1.0; } - - void decrement (void) { matrix_ref () -= 1.0; } - - void changesign (void) { matrix_ref ().changesign (); } - - octave_value convert_to_str_internal (bool pad, bool force, char type) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { return os.write (matrix, block_size, output_type, skip, flt_fmt); } - - // Unsafe. This function exists to support the MEX interface. - // You should not use it anywhere else. - void *mex_get_data (void) const { return matrix.mex_get_data (); } - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const; - -private: - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-int-traits.h --- a/src/ov-int-traits.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,63 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_value_int_traits_h) -#define octave_value_int_traits_h 1 - -#include "ov-int8.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" - -#include "ov-uint8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" - -template -class -octave_value_int_traits -{ -public: - typedef T scalar_type; -}; - -#define OCTAVE_VALUE_INT_TRAITS(MT, ST) \ - template<> \ - class \ - octave_value_int_traits \ - { \ - public: \ - typedef ST scalar_type; \ - } - -OCTAVE_VALUE_INT_TRAITS(int8NDArray, octave_int8_scalar); -OCTAVE_VALUE_INT_TRAITS(int16NDArray, octave_int16_scalar); -OCTAVE_VALUE_INT_TRAITS(int32NDArray, octave_int32_scalar); -OCTAVE_VALUE_INT_TRAITS(int64NDArray, octave_int64_scalar); - -OCTAVE_VALUE_INT_TRAITS(uint8NDArray, octave_uint8_scalar); -OCTAVE_VALUE_INT_TRAITS(uint16NDArray, octave_uint16_scalar); -OCTAVE_VALUE_INT_TRAITS(uint32NDArray, octave_uint32_scalar); -OCTAVE_VALUE_INT_TRAITS(uint64NDArray, octave_uint64_scalar); - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-int16.cc --- a/src/ov-int16.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "lo-ieee.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "quit.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "ops.h" -#include "ov-base.h" - -#ifdef HAVE_HDF5 -#define HDF5_SAVE_TYPE H5T_NATIVE_INT16 -#endif - -#include "ov-base-int.h" -#include "ov-base-int.cc" -#include "ov-int16.h" -#include "ov-type-conv.h" -#include "pr-output.h" -#include "variables.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -template class octave_base_matrix; - -template class octave_base_int_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_int16_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int16_matrix, - "int16 matrix", "int16"); - -template class octave_base_scalar; - -template class octave_base_int_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_int16_scalar); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int16_scalar, - "int16 scalar", "int16"); - -DEFUN (int16, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} int16 (@var{x})\n\ -Convert @var{x} to 16-bit integer type.\n\ -@end deftypefn") -{ - OCTAVE_TYPE_CONV_BODY (int16); -} - -/* -%!assert (class (int16 (1)), "int16") -%!assert (int16 (1.25), int16 (1)) -%!assert (int16 (1.5), int16 (2)) -%!assert (int16 (-1.5), int16 (-2)) -%!assert (int16 (2^17), int16 (2^16-1)) -%!assert (int16 (-2^17), int16 (-2^16)) -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-int16.h --- a/src/ov-int16.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_int16_h) -#define octave_int16_h 1 - -#define OCTAVE_INT_T octave_int16 - -#define OCTAVE_VALUE_INT_MATRIX_T octave_int16_matrix -#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION int16_array_value - -#define OCTAVE_VALUE_INT_SCALAR_T octave_int16_scalar -#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION int16_scalar_value - -#define OCTAVE_TYPE_PREDICATE_FUNCTION is_int16_type - -#define OCTAVE_INT_MX_CLASS mxINT16_CLASS - -#define OCTAVE_INT_BTYP btyp_int16 - -#include "ov-intx.h" - -#undef OCTAVE_INT_T - -#undef OCTAVE_VALUE_INT_MATRIX_T -#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION - -#undef OCTAVE_VALUE_INT_SCALAR_T -#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION - -#undef OCTAVE_TYPE_PREDICATE_FUNCTION - -#undef OCTAVE_INT_MX_CLASS - -#undef OCTAVE_INT_BTYP - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-int32.cc --- a/src/ov-int32.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "lo-ieee.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "quit.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "ops.h" -#include "ov-base.h" - -#ifdef HAVE_HDF5 -#define HDF5_SAVE_TYPE H5T_NATIVE_INT32 -#endif - -#include "ov-base-int.h" -#include "ov-base-int.cc" -#include "ov-int32.h" -#include "ov-type-conv.h" -#include "pr-output.h" -#include "variables.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -template class octave_base_matrix; - -template class octave_base_int_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_int32_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int32_matrix, - "int32 matrix", "int32"); - -template class octave_base_scalar; - -template class octave_base_int_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_int32_scalar); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int32_scalar, - "int32 scalar", "int32"); - -DEFUN (int32, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} int32 (@var{x})\n\ -Convert @var{x} to 32-bit integer type.\n\ -@end deftypefn") -{ - OCTAVE_TYPE_CONV_BODY (int32); -} - -/* -%!assert (class (int32 (1)), "int32") -%!assert (int32 (1.25), int32 (1)) -%!assert (int32 (1.5), int32 (2)) -%!assert (int32 (-1.5), int32 (-2)) -%!assert (int32 (2^33), int32 (2^32-1)) -%!assert (int32 (-2^33), int32 (-2^32)) -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-int32.h --- a/src/ov-int32.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_int32_h) -#define octave_int32_h 1 - -#define OCTAVE_INT_T octave_int32 - -#define OCTAVE_VALUE_INT_MATRIX_T octave_int32_matrix -#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION int32_array_value - -#define OCTAVE_VALUE_INT_SCALAR_T octave_int32_scalar -#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION int32_scalar_value - -#define OCTAVE_TYPE_PREDICATE_FUNCTION is_int32_type - -#define OCTAVE_INT_MX_CLASS mxINT32_CLASS - -#define OCTAVE_INT_BTYP btyp_int32 - -#include "ov-intx.h" - -#undef OCTAVE_INT_T - -#undef OCTAVE_VALUE_INT_MATRIX_T -#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION - -#undef OCTAVE_VALUE_INT_SCALAR_T -#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION - -#undef OCTAVE_TYPE_PREDICATE_FUNCTION - -#undef OCTAVE_INT_MX_CLASS - -#undef OCTAVE_INT_BTYP - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-int64.cc --- a/src/ov-int64.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "lo-ieee.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "quit.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "ops.h" -#include "ov-base.h" - -#ifdef HAVE_HDF5 -#define HDF5_SAVE_TYPE H5T_NATIVE_INT64 -#endif - -#include "ov-base-int.h" -#include "ov-base-int.cc" -#include "ov-int64.h" -#include "ov-type-conv.h" -#include "pr-output.h" -#include "variables.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -template class octave_base_matrix; - -template class octave_base_int_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_int64_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int64_matrix, - "int64 matrix", "int64"); - -template class octave_base_scalar; - -template class octave_base_int_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_int64_scalar); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int64_scalar, - "int64 scalar", "int64"); - -DEFUN (int64, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} int64 (@var{x})\n\ -Convert @var{x} to 64-bit integer type.\n\ -@end deftypefn") -{ - OCTAVE_TYPE_CONV_BODY (int64); -} - -/* -%!assert (class (int64 (1)), "int64") -%!assert (int64 (1.25), int64 (1)) -%!assert (int64 (1.5), int64 (2)) -%!assert (int64 (-1.5), int64 (-2)) -%!assert (int64 (2^65), int64 (2^64-1)) -%!assert (int64 (-2^65), int64 (-2^64)) -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-int64.h --- a/src/ov-int64.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_int64_h) -#define octave_int64_h 1 - -#define OCTAVE_INT_T octave_int64 - -#define OCTAVE_VALUE_INT_MATRIX_T octave_int64_matrix -#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION int64_array_value - -#define OCTAVE_VALUE_INT_SCALAR_T octave_int64_scalar -#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION int64_scalar_value - -#define OCTAVE_TYPE_PREDICATE_FUNCTION is_int64_type - -#define OCTAVE_INT_MX_CLASS mxINT64_CLASS - -#define OCTAVE_INT_BTYP btyp_int64 - -#include "ov-intx.h" - -#undef OCTAVE_INT_T - -#undef OCTAVE_VALUE_INT_MATRIX_T -#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION - -#undef OCTAVE_VALUE_INT_SCALAR_T -#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION - -#undef OCTAVE_TYPE_PREDICATE_FUNCTION - -#undef OCTAVE_INT_MX_CLASS - -#undef OCTAVE_INT_BTYP - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-int8.cc --- a/src/ov-int8.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "lo-ieee.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "quit.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "ops.h" -#include "ov-base.h" - -#ifdef HAVE_HDF5 -#define HDF5_SAVE_TYPE H5T_NATIVE_INT8 -#endif - -#include "ov-base-int.h" -#include "ov-base-int.cc" -#include "ov-int8.h" -#include "ov-type-conv.h" -#include "pr-output.h" -#include "variables.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -template class octave_base_matrix; - -template class octave_base_int_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_int8_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int8_matrix, - "int8 matrix", "int8"); - -template class octave_base_scalar; - -template class octave_base_int_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_int8_scalar); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_int8_scalar, - "int8 scalar", "int8"); - -DEFUN (int8, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} int8 (@var{x})\n\ -Convert @var{x} to 8-bit integer type.\n\ -@end deftypefn") -{ - OCTAVE_TYPE_CONV_BODY (int8); -} - -/* -%!assert (class (int8 (1)), "int8") -%!assert (int8 (1.25), int8 (1)) -%!assert (int8 (1.5), int8 (2)) -%!assert (int8 (-1.5), int8 (-2)) -%!assert (int8 (2^9), int8 (2^8-1)) -%!assert (int8 (-2^9), int8 (-2^8)) -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-int8.h --- a/src/ov-int8.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_int8_h) -#define octave_int8_h 1 - -#define OCTAVE_INT_T octave_int8 - -#define OCTAVE_VALUE_INT_MATRIX_T octave_int8_matrix -#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION int8_array_value - -#define OCTAVE_VALUE_INT_SCALAR_T octave_int8_scalar -#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION int8_scalar_value - -#define OCTAVE_TYPE_PREDICATE_FUNCTION is_int8_type - -#define OCTAVE_INT_MX_CLASS mxINT8_CLASS - -#define OCTAVE_INT_BTYP btyp_int8 - -#include "ov-intx.h" - -#undef OCTAVE_INT_T - -#undef OCTAVE_VALUE_INT_MATRIX_T -#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION - -#undef OCTAVE_VALUE_INT_SCALAR_T -#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION - -#undef OCTAVE_TYPE_PREDICATE_FUNCTION - -#undef OCTAVE_INT_MX_CLASS - -#undef OCTAVE_INT_BTYP - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-intx.h --- a/src/ov-intx.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,668 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#include - -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-stream.h" -#include "ov-base.h" -#include "ov-base-int.h" -#include "ov-typeinfo.h" -#include "gripes.h" - -#include "ov-re-mat.h" -#include "ov-scalar.h" - -class -OCTINTERP_API -OCTAVE_VALUE_INT_MATRIX_T - : public octave_base_int_matrix > -{ -public: - - OCTAVE_VALUE_INT_MATRIX_T (void) - : octave_base_int_matrix > () { } - - OCTAVE_VALUE_INT_MATRIX_T (const intNDArray& nda) - : octave_base_int_matrix > (nda) { } - - OCTAVE_VALUE_INT_MATRIX_T (const Array& nda) - : octave_base_int_matrix > - (intNDArray (nda)) { } - - ~OCTAVE_VALUE_INT_MATRIX_T (void) { } - - octave_base_value *clone (void) const - { return new OCTAVE_VALUE_INT_MATRIX_T (*this); } - - octave_base_value *empty_clone (void) const - { return new OCTAVE_VALUE_INT_MATRIX_T (); } - - bool OCTAVE_TYPE_PREDICATE_FUNCTION (void) const { return true; } - - bool is_integer_type (void) const { return true; } - - builtin_type_t builtin_type (void) const { return OCTAVE_INT_BTYP; } - -public: - - int8NDArray - int8_array_value (void) const { return int8NDArray (matrix); } - - int16NDArray - int16_array_value (void) const { return int16NDArray (matrix); } - - int32NDArray - int32_array_value (void) const { return int32NDArray (matrix); } - - int64NDArray - int64_array_value (void) const { return int64NDArray (matrix); } - - uint8NDArray - uint8_array_value (void) const { return uint8NDArray (matrix); } - - uint16NDArray - uint16_array_value (void) const { return uint16NDArray (matrix); } - - uint32NDArray - uint32_array_value (void) const { return uint32NDArray (matrix); } - - uint64NDArray - uint64_array_value (void) const { return uint64NDArray (matrix); } - - double - double_value (bool = false) const - { - double retval = lo_ieee_nan_value (); - - if (numel () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - type_name (), "real scalar"); - - retval = matrix(0).double_value (); - } - else - gripe_invalid_conversion (type_name (), "real scalar"); - - return retval; - - } - - float - float_value (bool = false) const - { - float retval = lo_ieee_float_nan_value (); - - if (numel () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - type_name (), "real scalar"); - - retval = matrix(0).float_value (); - } - else - gripe_invalid_conversion (type_name (), "real scalar"); - - return retval; - - } - - double scalar_value (bool = false) const { return double_value (); } - - float float_scalar_value (bool = false) const { return float_value (); } - - Matrix - matrix_value (bool = false) const - { - Matrix retval; - dim_vector dv = dims (); - if (dv.length () > 2) - error ("invalid conversion of %s to Matrix", type_name ().c_str ()); - else - { - retval = Matrix (dv(0), dv(1)); - double *vec = retval.fortran_vec (); - octave_idx_type nel = matrix.numel (); - for (octave_idx_type i = 0; i < nel; i++) - vec[i] = matrix(i).double_value (); - } - return retval; - } - - FloatMatrix - float_matrix_value (bool = false) const - { - FloatMatrix retval; - dim_vector dv = dims (); - if (dv.length () > 2) - error ("invalid conversion of %s to FloatMatrix", type_name ().c_str ()); - else - { - retval = FloatMatrix (dv(0), dv(1)); - float *vec = retval.fortran_vec (); - octave_idx_type nel = matrix.numel (); - for (octave_idx_type i = 0; i < nel; i++) - vec[i] = matrix(i).float_value (); - } - return retval; - } - - ComplexMatrix - complex_matrix_value (bool = false) const - { - ComplexMatrix retval; - dim_vector dv = dims (); - if (dv.length () > 2) - error ("invalid conversion of %s to Matrix", type_name ().c_str ()); - else - { - retval = ComplexMatrix (dv(0), dv(1)); - Complex *vec = retval.fortran_vec (); - octave_idx_type nel = matrix.numel (); - for (octave_idx_type i = 0; i < nel; i++) - vec[i] = Complex (matrix(i).double_value ()); - } - return retval; - } - - FloatComplexMatrix - float_complex_matrix_value (bool = false) const - { - FloatComplexMatrix retval; - dim_vector dv = dims (); - if (dv.length () > 2) - error ("invalid conversion of %s to FloatMatrix", type_name ().c_str ()); - else - { - retval = FloatComplexMatrix (dv(0), dv(1)); - FloatComplex *vec = retval.fortran_vec (); - octave_idx_type nel = matrix.numel (); - for (octave_idx_type i = 0; i < nel; i++) - vec[i] = FloatComplex (matrix(i).float_value ()); - } - return retval; - } - - NDArray - array_value (bool = false) const - { - NDArray retval (matrix.dims ()); - double *vec = retval.fortran_vec (); - octave_idx_type nel = matrix.numel (); - for (octave_idx_type i = 0; i < nel; i++) - vec[i] = matrix(i).double_value (); - return retval; - } - - FloatNDArray - float_array_value (bool = false) const - { - FloatNDArray retval (matrix.dims ()); - float *vec = retval.fortran_vec (); - octave_idx_type nel = matrix.numel (); - for (octave_idx_type i = 0; i < nel; i++) - vec[i] = matrix(i).float_value (); - return retval; - } - - ComplexNDArray - complex_array_value (bool = false) const - { - ComplexNDArray retval (matrix.dims ()); - Complex *vec = retval.fortran_vec (); - octave_idx_type nel = matrix.numel (); - for (octave_idx_type i = 0; i < nel; i++) - vec[i] = Complex (matrix(i).double_value ()); - return retval; - } - - FloatComplexNDArray - float_complex_array_value (bool = false) const - { - FloatComplexNDArray retval (matrix.dims ()); - FloatComplex *vec = retval.fortran_vec (); - octave_idx_type nel = matrix.numel (); - for (octave_idx_type i = 0; i < nel; i++) - vec[i] = FloatComplex (matrix(i).float_value ()); - return retval; - } - - boolNDArray - bool_array_value (bool warn = false) const - { - boolNDArray retval (dims ()); - - octave_idx_type nel = numel (); - - if (warn && matrix.any_element_not_one_or_zero ()) - gripe_logical_conversion (); - - bool *vec = retval.fortran_vec (); - for (octave_idx_type i = 0; i < nel; i++) - vec[i] = matrix(i).bool_value (); - - return retval; - } - - charNDArray - char_array_value (bool = false) const - { - charNDArray retval (dims ()); - - octave_idx_type nel = numel (); - - char *vec = retval.fortran_vec (); - for (octave_idx_type i = 0; i < nel; i++) - vec[i] = matrix(i).char_value (); - - return retval; - } - - // Use matrix_ref here to clear index cache. - void increment (void) - { - matrix_ref () += OCTAVE_INT_T (1); - } - - void decrement (void) - { - matrix_ref () -= OCTAVE_INT_T (1); - } - - void changesign (void) - { - matrix_ref ().changesign (); - } - - idx_vector index_vector (void) const - { return idx_cache ? *idx_cache : set_idx_cache (idx_vector (matrix)); } - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { return os.write (matrix, block_size, output_type, skip, flt_fmt); } - - // Unsafe. This function exists to support the MEX interface. - // You should not use it anywhere else. - void *mex_get_data (void) const { return matrix.mex_get_data (); } - - mxArray *as_mxArray (void) const - { - mxArray *retval = new mxArray (OCTAVE_INT_MX_CLASS, dims (), mxREAL); - - OCTAVE_INT_T::val_type *pr = static_cast (retval->get_data ()); - - mwSize nel = numel (); - - const OCTAVE_INT_T *p = matrix.data (); - - for (mwIndex i = 0; i < nel; i++) - pr[i] = p[i].value (); - - return retval; - } - - octave_value map (unary_mapper_t umap) const - { - switch (umap) - { - case umap_abs: - return matrix.abs (); - case umap_signum: - return matrix.signum (); - case umap_ceil: - case umap_conj: - case umap_fix: - case umap_floor: - case umap_real: - case umap_round: - return matrix; - case umap_imag: - return intNDArray (matrix.dims (), OCTAVE_INT_T ()); - case umap_isnan: - case umap_isna: - case umap_isinf: - return boolNDArray (matrix.dims (), false); - case umap_finite: - return boolNDArray (matrix.dims (), true); - - default: - { - octave_matrix m (array_value ()); - return m.map (umap); - } - } - } - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -class -OCTINTERP_API -OCTAVE_VALUE_INT_SCALAR_T - : public octave_base_int_scalar -{ -public: - - OCTAVE_VALUE_INT_SCALAR_T (void) - : octave_base_int_scalar () { } - - OCTAVE_VALUE_INT_SCALAR_T (const OCTAVE_INT_T& nda) - : octave_base_int_scalar (nda) { } - - ~OCTAVE_VALUE_INT_SCALAR_T (void) { } - - octave_base_value *clone (void) const - { return new OCTAVE_VALUE_INT_SCALAR_T (*this); } - - octave_base_value *empty_clone (void) const - { return new OCTAVE_VALUE_INT_MATRIX_T (); } - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false) - { - // FIXME -- this doesn't solve the problem of - // - // a = 1; a([1,1], [1,1], [1,1]) - // - // and similar constructions. Hmm... - - // FIXME -- using this constructor avoids narrowing the - // 1x1 matrix back to a scalar value. Need a better solution - // to this problem. - - octave_value tmp - (new OCTAVE_VALUE_INT_MATRIX_T - (OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION ())); - - return tmp.do_index_op (idx, resize_ok); - } - - bool OCTAVE_TYPE_PREDICATE_FUNCTION (void) const { return true; } - - bool is_integer_type (void) const { return true; } - - builtin_type_t builtin_type (void) const { return OCTAVE_INT_BTYP; } - -public: - - octave_int8 - int8_scalar_value (void) const { return octave_int8 (scalar); } - - octave_int16 - int16_scalar_value (void) const { return octave_int16 (scalar); } - - octave_int32 - int32_scalar_value (void) const { return octave_int32 (scalar); } - - octave_int64 - int64_scalar_value (void) const { return octave_int64 (scalar); } - - octave_uint8 - uint8_scalar_value (void) const { return octave_uint8 (scalar); } - - octave_uint16 - uint16_scalar_value (void) const { return octave_uint16 (scalar); } - - octave_uint32 - uint32_scalar_value (void) const { return octave_uint32 (scalar); } - - octave_uint64 - uint64_scalar_value (void) const { return octave_uint64 (scalar); } - - int8NDArray - int8_array_value (void) const - { return int8NDArray (dim_vector (1, 1), int8_scalar_value ()); } - - int16NDArray - int16_array_value (void) const - { return int16NDArray (dim_vector (1, 1), int16_scalar_value ()); } - - int32NDArray - int32_array_value (void) const - { return int32NDArray (dim_vector (1, 1), int32_scalar_value ()); } - - int64NDArray - int64_array_value (void) const - { return int64NDArray (dim_vector (1, 1), int64_scalar_value ()); } - - uint8NDArray - uint8_array_value (void) const - { return uint8NDArray (dim_vector (1, 1), uint8_scalar_value ()); } - - uint16NDArray - uint16_array_value (void) const - { return uint16NDArray (dim_vector (1, 1), uint16_scalar_value ()); } - - uint32NDArray - uint32_array_value (void) const - { return uint32NDArray (dim_vector (1, 1), uint32_scalar_value ()); } - - uint64NDArray - uint64_array_value (void) const - { return uint64NDArray (dim_vector (1, 1), uint64_scalar_value ()); } - - octave_value resize (const dim_vector& dv, bool fill = false) const - { - if (fill) - { - intNDArray retval (dv, 0); - if (dv.numel ()) - retval(0) = scalar; - return retval; - } - else - { - intNDArray retval (dv); - if (dv.numel ()) - retval(0) = scalar; - return retval; - } - } - - double double_value (bool = false) const { return scalar.double_value (); } - - float float_value (bool = false) const { return scalar.float_value (); } - - double scalar_value (bool = false) const { return scalar.double_value (); } - - float float_scalar_value (bool = false) const { return scalar.float_value (); } - - Matrix - matrix_value (bool = false) const - { - Matrix retval (1, 1); - retval(0,0) = scalar.double_value (); - return retval; - } - - FloatMatrix - float_matrix_value (bool = false) const - { - FloatMatrix retval (1, 1); - retval(0,0) = scalar.float_value (); - return retval; - } - - ComplexMatrix - complex_matrix_value (bool = false) const - { - ComplexMatrix retval (1, 1); - retval(0,0) = Complex (scalar.double_value ()); - return retval; - } - - FloatComplexMatrix - float_complex_matrix_value (bool = false) const - { - FloatComplexMatrix retval (1, 1); - retval(0,0) = FloatComplex (scalar.float_value ()); - return retval; - } - - NDArray - array_value (bool = false) const - { - NDArray retval (dim_vector (1, 1)); - retval(0) = scalar.double_value (); - return retval; - } - - FloatNDArray - float_array_value (bool = false) const - { - FloatNDArray retval (dim_vector (1, 1)); - retval(0) = scalar.float_value (); - return retval; - } - - ComplexNDArray - complex_array_value (bool = false) const - { - ComplexNDArray retval (dim_vector (1, 1)); - retval(0) = FloatComplex (scalar.double_value ()); - return retval; - } - - FloatComplexNDArray - float_complex_array_value (bool = false) const - { - FloatComplexNDArray retval (dim_vector (1, 1)); - retval(0) = FloatComplex (scalar.float_value ()); - return retval; - } - - bool bool_value (bool warn = false) const - { - if (warn && scalar != 0.0 && scalar != 1.0) - gripe_logical_conversion (); - - return scalar.bool_value (); - } - - boolNDArray - bool_array_value (bool warn = false) const - { - boolNDArray retval (dim_vector (1, 1)); - - if (warn && scalar != 0.0 && scalar != 1.0) - gripe_logical_conversion (); - - retval(0) = scalar.bool_value (); - - return retval; - } - - charNDArray - char_array_value (bool = false) const - { - charNDArray retval (dim_vector (1, 1)); - retval(0) = scalar.char_value (); - return retval; - } - - void increment (void) - { - scalar += OCTAVE_INT_T (1); - } - - void decrement (void) - { - scalar -= OCTAVE_INT_T (1); - } - - idx_vector index_vector (void) const { return idx_vector (scalar); } - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, octave_idx_type skip, - oct_mach_info::float_format flt_fmt) const - { - return os.write (OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION (), - block_size, output_type, skip, flt_fmt); - } - - // Unsafe. This function exists to support the MEX interface. - // You should not use it anywhere else. - void *mex_get_data (void) const { return scalar.mex_get_data (); } - - mxArray *as_mxArray (void) const - { - mxArray *retval = new mxArray (OCTAVE_INT_MX_CLASS, 1, 1, mxREAL); - - OCTAVE_INT_T::val_type *pr = static_cast (retval->get_data ()); - - pr[0] = scalar.value (); - - return retval; - } - - octave_value map (unary_mapper_t umap) const - { - switch (umap) - { - case umap_abs: - return scalar.abs (); - case umap_signum: - return scalar.signum (); - case umap_ceil: - case umap_conj: - case umap_fix: - case umap_floor: - case umap_real: - case umap_round: - return scalar; - case umap_imag: - return OCTAVE_INT_T (); - case umap_isnan: - case umap_isna: - case umap_isinf: - return false; - case umap_finite: - return true; - - default: - { - octave_scalar m (scalar_value ()); - return m.map (umap); - } - } - } - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; diff -r d02b229ce693 -r a132d206a36a src/ov-lazy-idx.cc --- a/src/ov-lazy-idx.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,197 +0,0 @@ -/* - -Copyright (C) 2010-2012 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "ov-lazy-idx.h" -#include "ops.h" -#include "ov-scalar.h" -#include "ls-oct-ascii.h" -#include "ls-oct-binary.h" - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_lazy_index, "lazy_index", "double"); - -static octave_base_value * -default_numeric_conversion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_lazy_index&); - - return v.full_value ().clone (); -} - -octave_base_value::type_conv_info -octave_lazy_index::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_conversion_function, - octave_matrix::static_type_id ()); -} - -octave_base_value * -octave_lazy_index::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - switch (index.length (0)) - { - case 1: - retval = new octave_scalar (static_cast (index(0) + 1)); - break; - - case 0: - retval = new octave_matrix (NDArray (index.orig_dimensions ())); - break; - - default: - break; - } - - return retval; -} - -octave_value -octave_lazy_index::reshape (const dim_vector& new_dims) const -{ - return idx_vector (index.as_array ().reshape (new_dims), - index.extent (0)); -} - -octave_value -octave_lazy_index::permute (const Array& vec, bool inv) const -{ - // If the conversion has already been made, forward the operation. - if (value.is_defined ()) - return value.permute (vec, inv); - else - return idx_vector (index.as_array ().permute (vec, inv), - index.extent (0)); -} - -octave_value -octave_lazy_index::squeeze (void) const -{ - return idx_vector (index.as_array ().squeeze (), - index.extent (0)); -} - -octave_value -octave_lazy_index::sort (octave_idx_type dim, sortmode mode) const -{ - const dim_vector odims = index.orig_dimensions (); - // index_vector can employ a more efficient sorting algorithm. - if (mode == ASCENDING && odims.length () == 2 - && (dim >= 0 && dim <= 1) && odims (1-dim) == 1) - return index_vector ().sorted (); - else - return idx_vector (index.as_array ().sort (dim, mode), - index.extent (0)); -} - -octave_value -octave_lazy_index::sort (Array &sidx, octave_idx_type dim, - sortmode mode) const -{ - const dim_vector odims = index.orig_dimensions (); - // index_vector can employ a more efficient sorting algorithm. - if (mode == ASCENDING && odims.length () == 2 - && (dim >= 0 && dim <= 1) && odims (1-dim) == 1) - return index_vector ().sorted (sidx); - else - return idx_vector (index.as_array ().sort (sidx, dim, mode), - index.extent (0)); -} - -sortmode -octave_lazy_index::is_sorted (sortmode mode) const -{ - if (index.is_range ()) - { - // Avoid the array conversion. - octave_idx_type inc = index.increment (); - if (inc == 0) - return (mode == UNSORTED ? ASCENDING : mode); - else if (inc > 0) - return (mode == DESCENDING ? UNSORTED : ASCENDING); - else - return (mode == ASCENDING ? UNSORTED : DESCENDING); - } - else - return index.as_array ().is_sorted (mode); -} - -Array -octave_lazy_index::sort_rows_idx (sortmode mode) const -{ - return index.as_array ().sort_rows_idx (mode); -} - -sortmode -octave_lazy_index::is_sorted_rows (sortmode mode) const -{ - return index.as_array ().is_sorted_rows (mode); -} - -static const std::string value_save_tag ("index_value"); - -bool octave_lazy_index::save_ascii (std::ostream& os) -{ - return save_ascii_data (os, make_value (), value_save_tag, false, 0); -} - -bool octave_lazy_index::load_ascii (std::istream& is) -{ - bool dummy; - - std::string nm = read_ascii_data (is, std::string (), dummy, value, 0); - - if (nm != value_save_tag) - error ("lazy_index: corrupted data on load"); - else - index = value.index_vector (); - - return ! error_state; -} - - -bool octave_lazy_index::save_binary (std::ostream& os, bool& save_as_floats) -{ - return save_binary_data (os, make_value (), value_save_tag, - std::string (), false, save_as_floats); -} - -bool octave_lazy_index::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - bool dummy; - std::string doc; - - std::string nm = read_binary_data (is, swap, fmt, std::string (), - dummy, value, doc); - - if (nm != value_save_tag) - error ("lazy_index: corrupted data on load"); - else - index = value.index_vector (); - - return ! error_state; -} diff -r d02b229ce693 -r a132d206a36a src/ov-lazy-idx.h --- a/src/ov-lazy-idx.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,250 +0,0 @@ -/* - -Copyright (C) 2010-2012 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_lazy_idx_h) -#define octave_lazy_idx_h 1 - -#include "ov-re-mat.h" - -// Lazy indices that stay in idx_vector form until the conversion to NDArray is -// actually needed. - -class -OCTINTERP_API -octave_lazy_index : public octave_base_value -{ -public: - - octave_lazy_index (void) - : octave_base_value (), index (), value () { } - - octave_lazy_index (const idx_vector& idx) - : octave_base_value (), index (idx), value () { } - - octave_lazy_index (const octave_lazy_index& i) - : octave_base_value (), index (i.index), value (i.value) { } - - ~octave_lazy_index (void) { } - - octave_base_value *clone (void) const { return new octave_lazy_index (*this); } - octave_base_value *empty_clone (void) const { return new octave_matrix (); } - - type_conv_info numeric_conversion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - size_t byte_size (void) const { return numel () * sizeof (octave_idx_type); } - - octave_value squeeze (void) const; - - octave_value full_value (void) const { return make_value (); } - - idx_vector index_vector (void) const - { return index; } - - builtin_type_t builtin_type (void) const { return btyp_double; } - - bool is_real_matrix (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - octave_value subsref (const std::string& type, - const std::list& idx) - { return make_value ().subsref (type, idx); } - - octave_value_list subsref (const std::string& type, - const std::list& idx, int) - { return subsref (type, idx); } - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false) - { return make_value ().do_index_op (idx, resize_ok); } - - dim_vector dims (void) const { return index.orig_dimensions (); } - - octave_idx_type numel (void) const { return index.length (0); } - - octave_idx_type nnz (void) const { return numel (); } - - octave_value reshape (const dim_vector& new_dims) const; - - octave_value permute (const Array& vec, bool inv = false) const; - - octave_value resize (const dim_vector& dv, bool fill = false) const - { return make_value ().resize (dv, fill); } - - octave_value all (int dim = 0) const { return make_value ().all (dim); } - octave_value any (int dim = 0) const { return make_value ().any (dim); } - - MatrixType matrix_type (void) const { return make_value ().matrix_type (); } - MatrixType matrix_type (const MatrixType& _typ) const - { return make_value ().matrix_type (_typ); } - - octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const; - - octave_value sort (Array &sidx, octave_idx_type dim = 0, - sortmode mode = ASCENDING) const; - - sortmode is_sorted (sortmode mode = UNSORTED) const; - - Array sort_rows_idx (sortmode mode = ASCENDING) const; - - sortmode is_sorted_rows (sortmode mode = UNSORTED) const; - - bool is_matrix_type (void) const { return true; } - - bool is_numeric_type (void) const { return true; } - - bool is_defined (void) const { return true; } - - bool is_constant (void) const { return true; } - - bool is_true (void) const - { return make_value ().is_true (); } - - bool print_as_scalar (void) const - { return make_value ().print_as_scalar (); } - - void print (std::ostream& os, bool pr_as_read_syntax = false) const - { make_value ().print (os, pr_as_read_syntax); } - - void print_info (std::ostream& os, const std::string& prefix) const - { make_value ().print_info (os, prefix); } - -#define FORWARD_VALUE_QUERY(TYPE,NAME) \ - TYPE \ - NAME (void) const { return make_value ().NAME (); } - - FORWARD_VALUE_QUERY (int8NDArray, int8_array_value) - FORWARD_VALUE_QUERY (int16NDArray, int16_array_value) - FORWARD_VALUE_QUERY (int32NDArray, int32_array_value) - FORWARD_VALUE_QUERY (int64NDArray, int64_array_value) - FORWARD_VALUE_QUERY (uint8NDArray, uint8_array_value) - FORWARD_VALUE_QUERY (uint16NDArray, uint16_array_value) - FORWARD_VALUE_QUERY (uint32NDArray, uint32_array_value) - FORWARD_VALUE_QUERY (uint64NDArray, uint64_array_value) - -#define FORWARD_VALUE_QUERY1(TYPE,NAME) \ - TYPE \ - NAME (bool flag = false) const { return make_value ().NAME (flag); } - - FORWARD_VALUE_QUERY1 (double, double_value) - - FORWARD_VALUE_QUERY1 (float, float_value) - - FORWARD_VALUE_QUERY1 (double, scalar_value) - - FORWARD_VALUE_QUERY1 (Matrix, matrix_value) - - FORWARD_VALUE_QUERY1 (FloatMatrix, float_matrix_value) - - FORWARD_VALUE_QUERY1 (Complex, complex_value) - - FORWARD_VALUE_QUERY1 (FloatComplex, float_complex_value) - - FORWARD_VALUE_QUERY1 (ComplexMatrix, complex_matrix_value) - - FORWARD_VALUE_QUERY1 (FloatComplexMatrix, float_complex_matrix_value) - - FORWARD_VALUE_QUERY1 (ComplexNDArray, complex_array_value) - - FORWARD_VALUE_QUERY1 (FloatComplexNDArray, float_complex_array_value) - - FORWARD_VALUE_QUERY1 (boolNDArray, bool_array_value) - - FORWARD_VALUE_QUERY1 (charNDArray, char_array_value) - - FORWARD_VALUE_QUERY1 (NDArray, array_value) - - FORWARD_VALUE_QUERY1 (FloatNDArray, float_array_value) - - FORWARD_VALUE_QUERY1 (SparseMatrix, sparse_matrix_value) - - FORWARD_VALUE_QUERY1 (SparseComplexMatrix, sparse_complex_matrix_value) - - octave_value diag (octave_idx_type k = 0) const - { return make_value ().diag (k); } - - octave_value convert_to_str_internal (bool pad, bool force, char type) const - { return make_value ().convert_to_str_internal (pad, force, type); } - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const - { return make_value ().print_raw (os, pr_as_read_syntax); } - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - - // HDF5 functions not defined. - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { return make_value ().write (os, block_size, output_type, skip, flt_fmt); } - - // Unsafe. This function exists to support the MEX interface. - // You should not use it anywhere else. - void *mex_get_data (void) const - { return make_value ().mex_get_data (); } - - mxArray *as_mxArray (void) const - { return make_value ().as_mxArray (); } - - octave_value map (unary_mapper_t umap) const - { return make_value ().map (umap); } - -private: - const octave_value& make_value (void) const - { - if (value.is_undefined ()) - value = octave_value (index, false); - - return value; - } - - octave_value& make_value (void) - { - if (value.is_undefined ()) - value = octave_value (index, false); - - return value; - } - - idx_vector index; - mutable octave_value value; - - static octave_base_value *numeric_conversion_function (const octave_base_value&); - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif - diff -r d02b229ce693 -r a132d206a36a src/ov-mex-fcn.cc --- a/src/ov-mex-fcn.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,162 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "oct-shlib.h" - -#include -#include "dynamic-ld.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "ov-mex-fcn.h" -#include "ov.h" -#include "profiler.h" -#include "toplev.h" -#include "unwind-prot.h" - -DEFINE_OCTAVE_ALLOCATOR (octave_mex_function); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_mex_function, - "mex function", "mex function"); - -octave_mex_function::octave_mex_function - (void *fptr, bool fmex, const octave_shlib& shl, - const std::string& nm) - : octave_function (nm), mex_fcn_ptr (fptr), exit_fcn_ptr (0), - have_fmex (fmex), sh_lib (shl) -{ - mark_fcn_file_up_to_date (time_parsed ()); - - std::string file_name = fcn_file_name (); - - system_fcn_file - = (! file_name.empty () - && Voct_file_dir == file_name.substr (0, Voct_file_dir.length ())); -} - -octave_mex_function::~octave_mex_function (void) -{ - if (exit_fcn_ptr) - (*exit_fcn_ptr) (); - - octave_dynamic_loader::remove_mex (my_name, sh_lib); -} - -std::string -octave_mex_function::fcn_file_name (void) const -{ - return sh_lib.file_name (); -} - -octave_time -octave_mex_function::time_parsed (void) const -{ - return sh_lib.time_loaded (); -} - -octave_value_list -octave_mex_function::subsref (const std::string& type, - const std::list& idx, - int nargout) -{ - octave_value_list retval; - - switch (type[0]) - { - case '(': - { - int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout; - - retval = do_multi_index_op (tmp_nargout, idx.front ()); - } - break; - - case '{': - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - // FIXME -- perhaps there should be an - // octave_value_list::next_subsref member function? See also - // octave_user_function::subsref. - // - // FIXME -- Note that if a function call returns multiple - // values, and there is further indexing to perform, then we are - // ignoring all but the first value. Is this really what we want to - // do? If it is not, then what should happen for stat("file").size, - // for exmaple? - - if (idx.size () > 1) - retval = retval(0).next_subsref (nargout, type, idx); - - return retval; -} - -// FIXME -- shouldn't this declaration be a header file somewhere? -extern octave_value_list -call_mex (bool have_fmex, void *f, const octave_value_list& args, - int nargout, octave_mex_function *curr_mex_fcn); - -octave_value_list -octave_mex_function::do_multi_index_op (int nargout, - const octave_value_list& args) -{ - octave_value_list retval; - - if (error_state) - return retval; - - if (args.has_magic_colon ()) - ::error ("invalid use of colon in function argument list"); - else - { - unwind_protect frame; - - octave_call_stack::push (this); - - frame.add_fcn (octave_call_stack::pop); - - try - { - BEGIN_PROFILER_BLOCK (profiler_name ()) - retval = call_mex (have_fmex, mex_fcn_ptr, args, nargout, this); - END_PROFILER_BLOCK - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/ov-mex-fcn.h --- a/src/ov-mex-fcn.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,122 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_mex_function_h) -#define octave_mex_function_h 1 - -#include - -#include "oct-shlib.h" - -#include "ov-fcn.h" -#include "ov-builtin.h" -#include "ov-typeinfo.h" - -class octave_shlib; - -class octave_value; -class octave_value_list; - -// Dynamically-linked functions. - -class -octave_mex_function : public octave_function -{ -public: - - octave_mex_function (void) - : mex_fcn_ptr (), exit_fcn_ptr (), have_fmex (), sh_lib (), - t_checked (), system_fcn_file () { } - - octave_mex_function (void *fptr, bool fmex, const octave_shlib& shl, - const std::string& nm = std::string ()); - - ~octave_mex_function (void); - - octave_value subsref (const std::string& type, - const std::list& idx) - { - octave_value_list tmp = subsref (type, idx, 1); - return tmp.length () > 0 ? tmp(0) : octave_value (); - } - - octave_value_list subsref (const std::string& type, - const std::list& idx, - int nargout); - - octave_function *function_value (bool = false) { return this; } - - const octave_function *function_value (bool = false) const { return this; } - - void mark_fcn_file_up_to_date (const octave_time& t) { t_checked = t; } - - std::string fcn_file_name (void) const; - - octave_time time_parsed (void) const; - - octave_time time_checked (void) const { return t_checked; } - - bool is_system_fcn_file (void) const { return system_fcn_file; } - - bool is_builtin_function (void) const { return false; } - - bool is_mex_function (void) const { return true; } - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& args); - - void atexit (void (*fcn) (void)) { exit_fcn_ptr = fcn; } - - octave_shlib get_shlib (void) const - { return sh_lib; } - -private: - - void *mex_fcn_ptr; - - void (*exit_fcn_ptr) (void); - - bool have_fmex; - - octave_shlib sh_lib; - - // The time the file was last checked to see if it needs to be - // parsed again. - mutable octave_time t_checked; - - // True if this function came from a file that is considered to be a - // system function. This affects whether we check the time stamp - // on the file to see if it has changed. - bool system_fcn_file; - - // No copying! - - octave_mex_function (const octave_mex_function& fn); - - octave_mex_function& operator = (const octave_mex_function& fn); - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-null-mat.cc --- a/src/ov-null-mat.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,133 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "ov-null-mat.h" -#include "ops.h" -#include "defun.h" - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_null_matrix, "null_matrix", "double"); - -const octave_value octave_null_matrix::instance (new octave_null_matrix ()); - -static octave_base_value * -default_null_matrix_numeric_conversion_function (const octave_base_value& a) -{ - // The cast is not necessary? - // CAST_CONV_ARG (const octave_null_matrix&); - - return a.empty_clone (); -} - -octave_base_value::type_conv_info -octave_null_matrix::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_null_matrix_numeric_conversion_function, - octave_matrix::static_type_id ()); -} - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_null_str, "null_string", "char"); - -const octave_value octave_null_str::instance (new octave_null_str ()); - -static octave_base_value * -default_null_str_numeric_conversion_function (const octave_base_value& a) -{ - // The cast is not necessary? - // CAST_CONV_ARG (const octave_null_str&); - - return a.empty_clone (); -} - -octave_base_value::type_conv_info -octave_null_str::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_null_str_numeric_conversion_function, - octave_char_matrix_str::static_type_id ()); -} - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_null_sq_str, "null_sq_string", "char"); - -const octave_value octave_null_sq_str::instance (new octave_null_sq_str ()); - -static octave_base_value * -default_null_sq_str_numeric_conversion_function (const octave_base_value& a) -{ - // The cast is not necessary? - // CAST_CONV_ARG (const octave_null_sq_str&); - - return a.empty_clone (); -} - -octave_base_value::type_conv_info -octave_null_sq_str::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_null_sq_str_numeric_conversion_function, - octave_char_matrix_sq_str::static_type_id ()); -} - -DEFUN (isnull, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isnull (@var{x})\n\ -Return true if @var{x} is a special null matrix, string, or single quoted\n\ -string. Indexed assignment with such a value on the right-hand side should\n\ -delete array elements. This function should be used when overloading\n\ -indexed assignment for user-defined classes instead of @code{isempty}, to\n\ -distinguish the cases:\n\ -\n\ -@table @asis\n\ -@item @code{A(I) = []}\n\ -This should delete elements if @code{I} is nonempty.\n\ -\n\ -@item @code{X = []; A(I) = X}\n\ -This should give an error if @code{I} is nonempty.\n\ -@end table\n\ -@seealso{isempty, isindex}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 && args(0).is_defined ()) - retval = args(0).is_null_value (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isnull ([]), true) -%!assert (isnull ([1]), false) -%!assert (isnull (zeros (0,3)), false) -%!assert (isnull (""), true) -%!assert (isnull ("A"), false) -%!assert (isnull (''), true) -%!assert (isnull ('A'), false) -%!test -%! x = []; -%! assert (isnull (x), false); -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-null-mat.h --- a/src/ov-null-mat.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,100 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_null_matrix_h) -#define octave_null_matrix_h 1 - -#include "ov.h" -#include "ov-re-mat.h" -#include "ov-str-mat.h" - -// Design rationale: -// The constructors are hidden. There is only one null matrix (or null string) object, -// that can have shallow copies. Cloning the object returns just a normal empty matrix, -// so all the shallow copies are, in fact, read-only. This conveniently ensures that any -// attempt to fiddle with the null matrix destroys its special status. - -// The special [] value. - -class -OCTINTERP_API -octave_null_matrix : public octave_matrix -{ - octave_null_matrix (void) : octave_matrix () { } - -public: - - static const octave_value instance; - - bool is_null_value (void) const { return true; } - - type_conv_info numeric_conversion_function (void) const; - -private: - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -// The special "" value - -class -OCTINTERP_API -octave_null_str : public octave_char_matrix_str -{ - octave_null_str (void) : octave_char_matrix_str () { } - -public: - - static const octave_value instance; - - bool is_null_value (void) const { return true; } - - type_conv_info numeric_conversion_function (void) const; - - -private: - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -// The special '' value - -class -OCTINTERP_API -octave_null_sq_str : public octave_char_matrix_sq_str -{ - octave_null_sq_str (void) : octave_char_matrix_sq_str () { } - -public: - - static const octave_value instance; - - bool is_null_value (void) const { return true; } - - type_conv_info numeric_conversion_function (void) const; - -private: - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-oncleanup.cc --- a/src/ov-oncleanup.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,225 +0,0 @@ -/* - -Copyright (C) 2010-2012 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "defun.h" -#include "ov-oncleanup.h" -#include "ov-fcn.h" -#include "ov-usr-fcn.h" -#include "pt-misc.h" -#include "toplev.h" - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_oncleanup, "onCleanup", - "onCleanup"); - -octave_oncleanup::octave_oncleanup (const octave_value& f) - : fcn (f) -{ - if (f.is_function_handle ()) - { - octave_function *fptr = f.function_value (true); - if (fptr) - { - octave_user_function *uptr - = dynamic_cast (fptr); - - if (uptr != 0) - { - tree_parameter_list *pl = uptr->parameter_list (); - - if (pl != 0 && pl->length () > 0) - warning ("onCleanup: cleanup action takes parameters"); - } - } - else - error ("onCleanup: no default dispatch for function handle"); - } - else - { - fcn = octave_value (); - error ("onCleanup: argument must be a function handle"); - } -} - -octave_oncleanup::~octave_oncleanup (void) -{ - if (fcn.is_undefined ()) - return; - - unwind_protect frame; - - // Clear interrupts. - frame.protect_var (octave_interrupt_state); - octave_interrupt_state = 0; - - // Disallow quit(). - frame.protect_var (quit_allowed); - quit_allowed = false; - - // Clear errors. - frame.protect_var (error_state); - error_state = 0; - - try - { - // Run the actual code. - fcn.do_multi_index_op (0, octave_value_list ()); - } - catch (octave_interrupt_exception) - { - // Swallow the interrupt. - warning ("onCleanup: interrupt occured in cleanup action"); - } - catch (std::bad_alloc) - { - // Swallow the exception. - warning ("onCleanup: out of memory occured in cleanup action"); - } - catch (...) // Yes, the black hole. We're in a d-tor. - { - // This shouldn't happen, in theory. - error ("onCleanup: internal error: unhandled exception in cleanup action"); - } - - // We don't want to ignore errors that occur in the cleanup code, so - // if an error is encountered there, leave error_state alone. - // Otherwise, set it back to what it was before. - if (error_state) - { - frame.discard_top (); - octave_call_stack::backtrace_error_message (); - } -} - -octave_scalar_map -octave_oncleanup::scalar_map_value (void) const -{ - octave_scalar_map retval; - retval.setfield ("task", fcn); - return retval; -} - -static void -warn_save_load (void) -{ - warning ("onCleanup: load and save not supported"); -} - -bool -octave_oncleanup::save_ascii (std::ostream& /* os */) -{ - warn_save_load (); - return true; -} - -bool -octave_oncleanup::load_ascii (std::istream& /* is */) -{ - warn_save_load (); - return true; -} - -bool -octave_oncleanup::save_binary (std::ostream& /* os */, bool& /* save_as_floats */) -{ - warn_save_load (); - return true; -} - -bool -octave_oncleanup::load_binary (std::istream& /* is */, bool /* swap */, - oct_mach_info::float_format /* fmt */) -{ - warn_save_load (); - return true; -} - -#if defined (HAVE_HDF5) -bool -octave_oncleanup::save_hdf5 (hid_t /* loc_id */, const char * /* name */, - bool /* save_as_floats */) -{ - warn_save_load (); - return true; -} - -bool -octave_oncleanup::load_hdf5 (hid_t /* loc_id */, const char * /* name */) -{ - warn_save_load (); - return true; -} -#endif - -void -octave_oncleanup::print (std::ostream& os, bool pr_as_read_syntax) const -{ - print_raw (os, pr_as_read_syntax); - newline (os); -} - -void -octave_oncleanup::print_raw (std::ostream& os, bool pr_as_read_syntax) const -{ - os << "onCleanup ("; - if (fcn.is_defined ()) - fcn.print_raw (os, pr_as_read_syntax); - os << ")"; -} - -DEFUN (onCleanup, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{c} =} onCleanup (@var{action})\n\ -Create a special object that executes a given function upon destruction.\n\ -If the object is copied to multiple variables (or cell or struct array\n\ -elements) or returned from a function, @var{action} will be executed after\n\ -clearing the last copy of the object. Note that if multiple local onCleanup\n\ -variables are created, the order in which they are called is unspecified.\n\ -For similar functionality @xref{The @code{unwind_protect} Statement}.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = octave_value (new octave_oncleanup (args(0))); - else - print_usage (); - - return retval; -} - -/* -%!test -%! old_wstate = warning ("query"); -%! unwind_protect -%! trigger = onCleanup (@() warning ("on", "__MY_WARNING__")); -%! warning ("off", "__MY_WARNING__"); -%! assert ((warning ("query", "__MY_WARNING__")).state, "off"); -%! clear trigger; -%! assert ((warning ("query", "__MY_WARNING__")).state, "on"); -%! unwind_protect_cleanup -%! warning (old_wstate); -%! end_unwind_protect -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-oncleanup.h --- a/src/ov-oncleanup.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,101 +0,0 @@ -/* - -Copyright (C) 2010-2012 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "ov-base.h" -#include "ov-struct.h" -#include "ov.h" - -static void -gripe_internal (void) -{ - error ("onCleanup: internal error: cloning nonempty object"); -} - -class octave_oncleanup : public octave_base_value -{ -public: - octave_oncleanup (void) : fcn () { } - - octave_oncleanup (const octave_value& fcn); - - octave_base_value *clone (void) const - { - if (fcn.is_defined ()) - gripe_internal (); - - return empty_clone (); - } - - octave_base_value *empty_clone (void) const - { - return new octave_oncleanup (); - } - - ~octave_oncleanup (void); - - bool is_defined (void) const { return true; } - - bool is_object (void) const { return true; } // do we want this? - - octave_map map_value (void) const { return scalar_map_value (); } - - octave_scalar_map scalar_map_value (void) const; - - dim_vector dims (void) const - { - static dim_vector dv (1, 1); - return dv; - } - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - -private: - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA - -protected: - - octave_value fcn; -}; diff -r d02b229ce693 -r a132d206a36a src/ov-perm.cc --- a/src/ov-perm.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,449 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "byte-swap.h" - -#include "ov-perm.h" -#include "ov-re-mat.h" -#include "ov-scalar.h" -#include "error.h" -#include "gripes.h" -#include "ops.h" -#include "pr-output.h" - -#include "ls-oct-ascii.h" - -octave_value -octave_perm_matrix::subsref (const std::string& type, - const std::list& idx) -{ - octave_value retval; - - switch (type[0]) - { - case '(': - retval = do_index_op (idx.front ()); - break; - - case '{': - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - return retval.next_subsref (type, idx); -} - -octave_value -octave_perm_matrix::do_index_op (const octave_value_list& idx, - bool resize_ok) -{ - octave_value retval; - octave_idx_type nidx = idx.length (); - idx_vector idx0, idx1; - if (nidx == 2) - { - idx0 = idx(0).index_vector (); - idx1 = idx(1).index_vector (); - } - - // This hack is to allow constructing permutation matrices using - // eye(n)(p,:), eye(n)(:,q) && eye(n)(p,q) where p & q are permutation - // vectors. - // Note that, for better consistency, eye(n)(:,:) still converts to a full - // matrix. - if (! error_state && nidx == 2) - { - bool left = idx0.is_permutation (matrix.rows ()); - bool right = idx1.is_permutation (matrix.cols ()); - - if (left && right) - { - if (idx0.is_colon ()) left = false; - if (idx1.is_colon ()) right = false; - if (left || right) - { - PermMatrix p = matrix; - if (left) - p = PermMatrix (idx0, false) * p; - if (right) - p = p * PermMatrix (idx1, true); - retval = p; - } - else - { - retval = this; - this->count++; - } - } - } - - // if error_state is set, we've already griped. - if (! error_state && ! retval.is_defined ()) - { - if (nidx == 2 && ! resize_ok && - idx0.is_scalar () && idx1.is_scalar ()) - { - retval = matrix.checkelem (idx0(0), idx1(0)); - } - else - retval = to_dense ().do_index_op (idx, resize_ok); - } - - return retval; -} - -bool -octave_perm_matrix::is_true (void) const -{ - return to_dense ().is_true (); -} - -double -octave_perm_matrix::double_value (bool) const -{ - double retval = lo_ieee_nan_value (); - - if (numel () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - type_name (), "real scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion (type_name (), "real scalar"); - - return retval; -} - -float -octave_perm_matrix::float_value (bool) const -{ - float retval = lo_ieee_float_nan_value (); - - if (numel () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - type_name (), "real scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion (type_name (), "real scalar"); - - return retval; -} - -Complex -octave_perm_matrix::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - type_name (), "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion (type_name (), "complex scalar"); - - return retval; -} - -FloatComplex -octave_perm_matrix::float_complex_value (bool) const -{ - float tmp = lo_ieee_float_nan_value (); - - FloatComplex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - type_name (), "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion (type_name (), "complex scalar"); - - return retval; -} - -#define FORWARD_MATRIX_VALUE(TYPE, PREFIX) \ -TYPE \ -octave_perm_matrix::PREFIX ## _value (bool frc_str_conv) const \ -{ \ - return to_dense ().PREFIX ## _value (frc_str_conv); \ -} - -SparseMatrix -octave_perm_matrix::sparse_matrix_value (bool) const -{ - return SparseMatrix (matrix); -} - -SparseBoolMatrix -octave_perm_matrix::sparse_bool_matrix_value (bool) const -{ - return SparseBoolMatrix (matrix); -} - -SparseComplexMatrix -octave_perm_matrix::sparse_complex_matrix_value (bool) const -{ - return SparseComplexMatrix (sparse_matrix_value ()); -} - -FORWARD_MATRIX_VALUE (Matrix, matrix) -FORWARD_MATRIX_VALUE (FloatMatrix, float_matrix) -FORWARD_MATRIX_VALUE (ComplexMatrix, complex_matrix) -FORWARD_MATRIX_VALUE (FloatComplexMatrix, float_complex_matrix) - -FORWARD_MATRIX_VALUE (NDArray, array) -FORWARD_MATRIX_VALUE (FloatNDArray, float_array) -FORWARD_MATRIX_VALUE (ComplexNDArray, complex_array) -FORWARD_MATRIX_VALUE (FloatComplexNDArray, float_complex_array) - -FORWARD_MATRIX_VALUE (boolNDArray, bool_array) -FORWARD_MATRIX_VALUE (charNDArray, char_array) - -idx_vector -octave_perm_matrix::index_vector (void) const -{ - return to_dense ().index_vector (); -} - -octave_value -octave_perm_matrix::convert_to_str_internal (bool pad, bool force, char type) const -{ - return to_dense ().convert_to_str_internal (pad, force, type); -} - -bool -octave_perm_matrix::save_ascii (std::ostream& os) -{ - typedef octave_int idx_int_type; - - os << "# size: " << matrix.rows () << "\n"; - os << "# orient: " << (matrix.is_col_perm () ? 'c' : 'r') << '\n'; - - Array pvec = matrix.pvec (); - octave_idx_type n = pvec.length (); - ColumnVector tmp (n); - for (octave_idx_type i = 0; i < n; i++) tmp(i) = pvec(i) + 1; - os << tmp; - - return true; -} - -bool -octave_perm_matrix::load_ascii (std::istream& is) -{ - typedef octave_int idx_int_type; - octave_idx_type n; - bool success = true; - char orient; - - if (extract_keyword (is, "size", n, true) - && extract_keyword (is, "orient", orient, true)) - { - bool colp = orient == 'c'; - ColumnVector tmp (n); - is >> tmp; - if (!is) - { - error ("load: failed to load permutation matrix constant"); - success = false; - } - else - { - Array pvec (dim_vector (n, 1)); - for (octave_idx_type i = 0; i < n; i++) pvec(i) = tmp(i) - 1; - matrix = PermMatrix (pvec, colp); - - // Invalidate cache. Probably not necessary, but safe. - dense_cache = octave_value (); - } - } - else - { - error ("load: failed to extract size & orientation"); - success = false; - } - - return success; -} - -bool -octave_perm_matrix::save_binary (std::ostream& os, bool&) -{ - - int32_t sz = matrix.rows (); - bool colp = matrix.is_col_perm (); - os.write (reinterpret_cast (&sz), 4); - os.write (reinterpret_cast (&colp), 1); - os.write (reinterpret_cast (matrix.data ()), matrix.byte_size ()); - - return true; -} - -bool -octave_perm_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format ) -{ - int32_t sz; - bool colp; - if (! (is.read (reinterpret_cast (&sz), 4) - && is.read (reinterpret_cast (&colp), 1))) - return false; - - MArray m (dim_vector (sz, 1)); - - if (! is.read (reinterpret_cast (m.fortran_vec ()), m.byte_size ())) - return false; - - if (swap) - { - int nel = m.numel (); - for (int i = 0; i < nel; i++) - switch (sizeof (octave_idx_type)) - { - case 8: - swap_bytes<8> (&m(i)); - break; - case 4: - swap_bytes<4> (&m(i)); - break; - case 2: - swap_bytes<2> (&m(i)); - break; - case 1: - default: - break; - } - } - - matrix = PermMatrix (m, colp); - return true; -} - -void -octave_perm_matrix::print_raw (std::ostream& os, - bool pr_as_read_syntax) const -{ - return octave_print_internal (os, matrix, pr_as_read_syntax, - current_print_indent_level ()); -} - -mxArray * -octave_perm_matrix::as_mxArray (void) const -{ - return to_dense ().as_mxArray (); -} - -bool -octave_perm_matrix::print_as_scalar (void) const -{ - dim_vector dv = dims (); - - return (dv.all_ones () || dv.any_zero ()); -} - -void -octave_perm_matrix::print (std::ostream& os, bool pr_as_read_syntax) const -{ - print_raw (os, pr_as_read_syntax); - newline (os); -} - -int -octave_perm_matrix::write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const -{ - return to_dense ().write (os, block_size, output_type, skip, flt_fmt); -} - -void -octave_perm_matrix::print_info (std::ostream& os, - const std::string& prefix) const -{ - matrix.print_info (os, prefix); -} - - -octave_value -octave_perm_matrix::to_dense (void) const -{ - if (! dense_cache.is_defined ()) - dense_cache = Matrix (matrix); - - return dense_cache; -} - -DEFINE_OCTAVE_ALLOCATOR (octave_perm_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_perm_matrix, - "permutation matrix", "double"); - -static octave_base_value * -default_numeric_conversion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_perm_matrix&); - - return new octave_matrix (v.matrix_value ()); -} - -octave_base_value::type_conv_info -octave_perm_matrix::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_conversion_function, - octave_matrix::static_type_id ()); -} - -octave_base_value * -octave_perm_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (matrix.nelem () == 1) - retval = new octave_scalar (matrix (0, 0)); - - return retval; -} - diff -r d02b229ce693 -r a132d206a36a src/ov-perm.h --- a/src/ov-perm.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,234 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_perm_matrix_h) -#define octave_perm_matrix_h 1 - -#include "mx-base.h" -#include "str-vec.h" - -#include "ov-base.h" -#include "ov-typeinfo.h" -#include "oct-obj.h" - -class -OCTINTERP_API -octave_perm_matrix : public octave_base_value -{ -public: - octave_perm_matrix (void) : matrix (), dense_cache () { } - - octave_perm_matrix (const PermMatrix& p) : matrix (p), dense_cache () { } - - octave_base_value *clone (void) const { return new octave_perm_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_perm_matrix (); } - - type_conv_info numeric_conversion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - size_t byte_size (void) const { return matrix.byte_size (); } - - octave_value squeeze (void) const { return matrix; } - - octave_value full_value (void) const { return to_dense (); } - - octave_value subsref (const std::string& type, - const std::list& idx); - - octave_value_list subsref (const std::string& type, - const std::list& idx, int) - { return subsref (type, idx); } - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - dim_vector dims (void) const { return matrix.dims (); } - - octave_idx_type nnz (void) const { return matrix.rows (); } - - octave_value reshape (const dim_vector& new_dims) const - { return to_dense ().reshape (new_dims); } - - octave_value permute (const Array& vec, bool inv = false) const - { return to_dense ().permute (vec, inv); } - - octave_value resize (const dim_vector& dv, bool fill = false) const - { return to_dense ().resize (dv, fill); } - - octave_value all (int dim = 0) const { return to_dense ().all (dim); } - octave_value any (int dim = 0) const { return to_dense ().any (dim); } - - MatrixType matrix_type (void) const { return MatrixType::Permuted_Diagonal; } - MatrixType matrix_type (const MatrixType&) const - { return matrix_type (); } - - octave_value diag (octave_idx_type k = 0) const - { return to_dense () .diag (k); } - - octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const - { return to_dense ().sort (dim, mode); } - octave_value sort (Array &sidx, octave_idx_type dim = 0, - sortmode mode = ASCENDING) const - { return to_dense ().sort (sidx, dim, mode); } - - sortmode is_sorted (sortmode mode = UNSORTED) const - { return to_dense ().is_sorted (mode); } - - Array sort_rows_idx (sortmode mode = ASCENDING) const - { return to_dense ().sort_rows_idx (mode); } - - sortmode is_sorted_rows (sortmode mode = UNSORTED) const - { return to_dense ().is_sorted_rows (mode); } - - builtin_type_t builtin_type (void) const { return btyp_double; } - - bool is_perm_matrix (void) const { return true; } - - bool is_matrix_type (void) const { return true; } - - bool is_numeric_type (void) const { return true; } - - bool is_defined (void) const { return true; } - - bool is_constant (void) const { return true; } - - bool is_real_matrix (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - bool is_true (void) const; - - double double_value (bool = false) const; - - float float_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - idx_vector index_vector (void) const; - - PermMatrix perm_matrix_value (void) const - { return matrix; } - - Matrix matrix_value (bool = false) const; - - FloatMatrix float_matrix_value (bool = false) const; - - Complex complex_value (bool = false) const; - - FloatComplex float_complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - FloatComplexMatrix float_complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const; - - FloatComplexNDArray float_complex_array_value (bool = false) const; - - boolNDArray bool_array_value (bool warn = false) const; - - charNDArray char_array_value (bool = false) const; - - NDArray array_value (bool = false) const; - - FloatNDArray float_array_value (bool = false) const; - - SparseMatrix sparse_matrix_value (bool = false) const; - - SparseBoolMatrix sparse_bool_matrix_value (bool = false) const; - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; - - int8NDArray - int8_array_value (void) const { return to_dense ().int8_array_value (); } - - int16NDArray - int16_array_value (void) const { return to_dense ().int16_array_value (); } - - int32NDArray - int32_array_value (void) const { return to_dense ().int32_array_value (); } - - int64NDArray - int64_array_value (void) const { return to_dense ().int64_array_value (); } - - uint8NDArray - uint8_array_value (void) const { return to_dense ().uint8_array_value (); } - - uint16NDArray - uint16_array_value (void) const { return to_dense ().uint16_array_value (); } - - uint32NDArray - uint32_array_value (void) const { return to_dense ().uint32_array_value (); } - - uint64NDArray - uint64_array_value (void) const { return to_dense ().uint64_array_value (); } - - octave_value convert_to_str_internal (bool pad, bool force, char type) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const; - - mxArray *as_mxArray (void) const; - - bool print_as_scalar (void) const; - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_info (std::ostream& os, const std::string& prefix) const; - - octave_value map (unary_mapper_t umap) const - { return to_dense ().map (umap); } - -protected: - - PermMatrix matrix; - - virtual octave_value to_dense (void) const; - - mutable octave_value dense_cache; - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-range.cc --- a/src/ov-range.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,691 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "lo-ieee.h" -#include "lo-utils.h" - -#include "defun.h" -#include "variables.h" -#include "gripes.h" -#include "ops.h" -#include "oct-obj.h" -#include "ov-range.h" -#include "ov-re-mat.h" -#include "ov-scalar.h" -#include "pr-output.h" - -#include "byte-swap.h" -#include "ls-ascii-helper.h" -#include "ls-hdf5.h" -#include "ls-utils.h" - -// If TRUE, allow ranges with non-integer elements as array indices. -bool Vallow_noninteger_range_as_index = false; - -DEFINE_OCTAVE_ALLOCATOR (octave_range); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_range, "range", "double"); - -static octave_base_value * -default_numeric_conversion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_range&); - - return new octave_matrix (v.matrix_value ()); -} - -octave_base_value::type_conv_info -octave_range::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_conversion_function, - octave_matrix::static_type_id ()); -} - -octave_base_value * -octave_range::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - switch (range.nelem ()) - { - case 1: - retval = new octave_scalar (range.base ()); - break; - - case 0: - retval = new octave_matrix (Matrix (1, 0)); - break; - - case -2: - retval = new octave_matrix (range.matrix_value ()); - break; - - default: - break; - } - - return retval; -} - -octave_value -octave_range::subsref (const std::string& type, - const std::list& idx) -{ - octave_value retval; - - switch (type[0]) - { - case '(': - retval = do_index_op (idx.front ()); - break; - - case '{': - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - return retval.next_subsref (type, idx); -} - -octave_value -octave_range::do_index_op (const octave_value_list& idx, bool resize_ok) -{ - if (idx.length () == 1 && ! resize_ok) - { - octave_value retval; - - // The range can handle a single subscript. - idx_vector i = idx(0).index_vector (); - if (! error_state) - { - if (i.is_scalar () && i(0) < range.nelem ()) - retval = range.elem (i(0)); - else - retval = range.index (i); - } - - return retval; - } - else - { - octave_value tmp (new octave_matrix (range.matrix_value ())); - - return tmp.do_index_op (idx, resize_ok); - } -} - -idx_vector -octave_range::index_vector (void) const -{ - if (idx_cache) - return *idx_cache; - else - { - if (! Vallow_noninteger_range_as_index - || range.all_elements_are_ints ()) - return set_idx_cache (idx_vector (range)); - else - { - warning_with_id ("Octave:noninteger-range-as-index", - "non-integer range used as index"); - - return octave_value (matrix_value ()).round ().index_vector (); - } - } -} - -double -octave_range::double_value (bool) const -{ - double retval = lo_ieee_nan_value (); - - octave_idx_type nel = range.nelem (); - - if (nel > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "range", "real scalar"); - - retval = range.base (); - } - else - gripe_invalid_conversion ("range", "real scalar"); - - return retval; -} - -float -octave_range::float_value (bool) const -{ - float retval = lo_ieee_float_nan_value (); - - octave_idx_type nel = range.nelem (); - - if (nel > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "range", "real scalar"); - - retval = range.base (); - } - else - gripe_invalid_conversion ("range", "real scalar"); - - return retval; -} - -charNDArray -octave_range::char_array_value (bool) const -{ - const Matrix matrix = range.matrix_value (); - charNDArray retval (dims ()); - - octave_idx_type nel = numel (); - - for (octave_idx_type i = 0; i < nel; i++) - retval.elem (i) = static_cast(matrix.elem (i)); - - return retval; -} - -octave_value -octave_range::all (int dim) const -{ - // FIXME -- this is a potential waste of memory. - - Matrix m = range.matrix_value (); - - return m.all (dim); -} - -octave_value -octave_range::any (int dim) const -{ - // FIXME -- this is a potential waste of memory. - - Matrix m = range.matrix_value (); - - return m.any (dim); -} - -octave_value -octave_range::diag (octave_idx_type k) const -{ - return (k == 0 - ? octave_value (DiagMatrix (DiagArray2 (range.matrix_value ()))) - : octave_value (range.diag (k))); -} - -octave_value -octave_range::diag (octave_idx_type m, octave_idx_type n) const -{ - Matrix mat = range.matrix_value (); - - return mat.diag (m, n); -} - -bool -octave_range::is_true (void) const -{ - bool retval = false; - - if (range.nelem () != 0) - { - // FIXME -- this is a potential waste of memory. - - Matrix m ((range.matrix_value () . all ()) . all ()); - - retval = (m.rows () == 1 && m.columns () == 1 && m (0, 0) != 0.0); - } - - return retval; -} - -Complex -octave_range::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - octave_idx_type nel = range.nelem (); - - if (nel > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "range", "complex scalar"); - - retval = range.base (); - } - else - gripe_invalid_conversion ("range", "complex scalar"); - - return retval; -} - -FloatComplex -octave_range::float_complex_value (bool) const -{ - float tmp = lo_ieee_float_nan_value (); - - FloatComplex retval (tmp, tmp); - - octave_idx_type nel = range.nelem (); - - if (nel > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "range", "complex scalar"); - - retval = range.base (); - } - else - gripe_invalid_conversion ("range", "complex scalar"); - - return retval; -} - -boolNDArray -octave_range::bool_array_value (bool warn) const -{ - Matrix m = range.matrix_value (); - - if (m.any_element_is_nan ()) - gripe_nan_to_logical_conversion (); - else if (warn && m.any_element_not_one_or_zero ()) - gripe_logical_conversion (); - - return boolNDArray (m); -} - -octave_value -octave_range::resize (const dim_vector& dv, bool fill) const -{ - NDArray retval = array_value (); - if (fill) - retval.resize (dv, 0); - else - retval.resize (dv); - return retval; -} - -octave_value -octave_range::convert_to_str_internal (bool pad, bool force, char type) const -{ - octave_value tmp (range.matrix_value ()); - return tmp.convert_to_str (pad, force, type); -} - -void -octave_range::print (std::ostream& os, bool pr_as_read_syntax) const -{ - print_raw (os, pr_as_read_syntax); - newline (os); -} - -void -octave_range::print_raw (std::ostream& os, bool pr_as_read_syntax) const -{ - octave_print_internal (os, range, pr_as_read_syntax, - current_print_indent_level ()); -} - -bool -octave_range::print_name_tag (std::ostream& os, const std::string& name) const -{ - bool retval = false; - - octave_idx_type n = range.nelem (); - - indent (os); - - if (n == 0 || n == 1) - os << name << " = "; - else - { - os << name << " ="; - newline (os); - if (! Vcompact_format) - newline (os); - - retval = true; - } - - return retval; -} - -// Skip white space and comments on stream IS. - -static void -skip_comments (std::istream& is) -{ - char c = '\0'; - while (is.get (c)) - { - if (c == ' ' || c == '\t' || c == '\n') - ; // Skip whitespace on way to beginning of next line. - else - break; - } - - skip_until_newline (is, false); -} - -bool -octave_range::save_ascii (std::ostream& os) -{ - Range r = range_value (); - double base = r.base (); - double limit = r.limit (); - double inc = r.inc (); - octave_idx_type len = r.nelem (); - - if (inc != 0) - os << "# base, limit, increment\n"; - else - os << "# base, length, increment\n"; - - octave_write_double (os, base); - os << " "; - if (inc != 0) - octave_write_double (os, limit); - else - os << len; - os << " "; - octave_write_double (os, inc); - os << "\n"; - - return true; -} - -bool -octave_range::load_ascii (std::istream& is) -{ - // # base, limit, range comment added by save (). - skip_comments (is); - - double base, limit, inc; - is >> base >> limit >> inc; - - if (!is) - { - error ("load: failed to load range constant"); - return false; - } - - if (inc != 0) - range = Range (base, limit, inc); - else - range = Range (base, inc, static_cast (limit)); - - return true; -} - -bool -octave_range::save_binary (std::ostream& os, bool& /* save_as_floats */) -{ - char tmp = LS_DOUBLE; - os.write (reinterpret_cast (&tmp), 1); - Range r = range_value (); - double bas = r.base (); - double lim = r.limit (); - double inc = r.inc (); - if (inc == 0) - lim = r.nelem (); - - os.write (reinterpret_cast (&bas), 8); - os.write (reinterpret_cast (&lim), 8); - os.write (reinterpret_cast (&inc), 8); - - return true; -} - -bool -octave_range::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format /* fmt */) -{ - char tmp; - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - double bas, lim, inc; - if (! is.read (reinterpret_cast (&bas), 8)) - return false; - if (swap) - swap_bytes<8> (&bas); - if (! is.read (reinterpret_cast (&lim), 8)) - return false; - if (swap) - swap_bytes<8> (&lim); - if (! is.read (reinterpret_cast (&inc), 8)) - return false; - if (swap) - swap_bytes<8> (&inc); - if (inc != 0) - range = Range (bas, lim, inc); - else - range = Range (bas, inc, static_cast (lim)); - - return true; -} - -#if defined (HAVE_HDF5) - -// The following subroutines creates an HDF5 representation of the way -// we will store Octave range types (triplets of floating-point numbers). -// NUM_TYPE is the HDF5 numeric type to use for storage (e.g. -// H5T_NATIVE_DOUBLE to save as 'double'). Note that any necessary -// conversions are handled automatically by HDF5. - -static hid_t -hdf5_make_range_type (hid_t num_type) -{ - hid_t type_id = H5Tcreate (H5T_COMPOUND, sizeof (double) * 3); - - H5Tinsert (type_id, "base", 0 * sizeof (double), num_type); - H5Tinsert (type_id, "limit", 1 * sizeof (double), num_type); - H5Tinsert (type_id, "increment", 2 * sizeof (double), num_type); - - return type_id; -} - -bool -octave_range::save_hdf5 (hid_t loc_id, const char *name, - bool /* save_as_floats */) -{ - hsize_t dimens[3]; - hid_t space_hid = -1, type_hid = -1, data_hid = -1; - bool retval = true; - - space_hid = H5Screate_simple (0, dimens, 0); - if (space_hid < 0) return false; - - type_hid = hdf5_make_range_type (H5T_NATIVE_DOUBLE); - if (type_hid < 0) - { - H5Sclose (space_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, type_hid, space_hid, H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Tclose (type_hid); - return false; - } - - Range r = range_value (); - double range_vals[3]; - range_vals[0] = r.base (); - range_vals[1] = r.inc () != 0 ? r.limit () : r.nelem (); - range_vals[2] = r.inc (); - - if (H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, H5P_DEFAULT, - range_vals) >= 0) - { - octave_idx_type nel = r.nelem (); - retval = hdf5_add_scalar_attr (data_hid, H5T_NATIVE_IDX, - "OCTAVE_RANGE_NELEM", &nel) >= 0; - } - else - retval = false; - - H5Dclose (data_hid); - H5Tclose (type_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_range::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; - -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t type_hid = H5Dget_type (data_hid); - - hid_t range_type = hdf5_make_range_type (H5T_NATIVE_DOUBLE); - - if (! hdf5_types_compatible (type_hid, range_type)) - { - H5Tclose (range_type); - H5Dclose (data_hid); - return false; - } - - hid_t space_hid = H5Dget_space (data_hid); - hsize_t rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Tclose (range_type); - H5Sclose (space_hid); - H5Dclose (data_hid); - return false; - } - - double rangevals[3]; - if (H5Dread (data_hid, range_type, H5S_ALL, H5S_ALL, H5P_DEFAULT, - rangevals) >= 0) - { - retval = true; - octave_idx_type nel; - if (hdf5_get_scalar_attr (data_hid, H5T_NATIVE_IDX, - "OCTAVE_RANGE_NELEM", &nel)) - range = Range (rangevals[0], rangevals[2], nel); - else - { - if (rangevals[2] != 0) - range = Range (rangevals[0], rangevals[1], rangevals[2]); - else - range = Range (rangevals[0], rangevals[2], - static_cast (rangevals[1])); - } - } - - H5Tclose (range_type); - H5Sclose (space_hid); - H5Dclose (data_hid); - - return retval; -} - -#endif - -mxArray * -octave_range::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxDOUBLE_CLASS, dims (), mxREAL); - - double *pr = static_cast (retval->get_data ()); - - mwSize nel = numel (); - - Matrix m = matrix_value (); - - const double *p = m.data (); - - for (mwSize i = 0; i < nel; i++) - pr[i] = p[i]; - - return retval; -} - -DEFUN (allow_noninteger_range_as_index, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} allow_noninteger_range_as_index ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} allow_noninteger_range_as_index (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} allow_noninteger_range_as_index (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether non-integer\n\ -ranges are allowed as indices. This might be useful for @sc{matlab}\n\ -compatibility; however, it is still not entirely compatible because\n\ -@sc{matlab} treats the range expression differently in different contexts.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (allow_noninteger_range_as_index); -} - -/* -%!test -%! x = 0:10; -%! save = allow_noninteger_range_as_index (); -%! warn_state = warning ("query", "Octave:noninteger-range-as-index"); -%! unwind_protect -%! allow_noninteger_range_as_index (false); -%! fail ("x(2.1:5)"); -%! assert (x(2:5), 1:4); -%! allow_noninteger_range_as_index (true); -%! warning ("off", "Octave:noninteger-range-as-index"); -%! assert (x(2.49:5), 1:3); -%! assert (x(2.5:5), 2:4); -%! assert (x(2.51:5), 2:4); -%! unwind_protect_cleanup -%! allow_noninteger_range_as_index (save); -%! warning (warn_state.state, warn_state.identifier); -%! end_unwind_protect -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-range.h --- a/src/ov-range.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,322 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_range_h) -#define octave_range_h 1 - -#include - -#include -#include - -#include "Range.h" - -#include "lo-mappers.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-stream.h" -#include "ov-base.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// Range values. - -class -octave_range : public octave_base_value -{ -public: - - octave_range (void) - : octave_base_value (), range (), idx_cache () { } - - octave_range (double base, double limit, double inc) - : octave_base_value (), range (base, limit, inc), idx_cache () - { - if (range.nelem () < 0) - ::error ("invalid range"); - } - - octave_range (const Range& r) - : octave_base_value (), range (r), idx_cache () - { - if (range.nelem () < 0 && range.nelem () != -2) - ::error ("invalid range"); - } - - octave_range (const octave_range& r) - : octave_base_value (), range (r.range), - idx_cache (r.idx_cache ? new idx_vector (*r.idx_cache) : 0) - { } - - octave_range (const Range& r, const idx_vector& cache) - : octave_base_value (), range (r), idx_cache () - { - set_idx_cache (cache); - } - - ~octave_range (void) { clear_cached_info (); } - - octave_base_value *clone (void) const { return new octave_range (*this); } - - // A range is really just a special kind of real matrix object. In - // the places where we need to call empty_clone, it makes more sense - // to create an empty matrix (0x0) instead of an empty range (1x0). - octave_base_value *empty_clone (void) const { return new octave_matrix (); } - - type_conv_info numeric_conversion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - octave_value subsref (const std::string& type, - const std::list& idx); - - octave_value_list subsref (const std::string& type, - const std::list& idx, int) - { return subsref (type, idx); } - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - idx_vector index_vector (void) const; - - dim_vector dims (void) const - { - octave_idx_type n = range.nelem (); - return dim_vector (n > 0, n); - } - - octave_value resize (const dim_vector& dv, bool fill = false) const; - - - size_t byte_size (void) const { return 3 * sizeof (double); } - - octave_value reshape (const dim_vector& new_dims) const - { return NDArray (array_value ().reshape (new_dims)); } - - octave_value permute (const Array& vec, bool inv = false) const - { return NDArray (array_value ().permute (vec, inv)); } - - octave_value squeeze (void) const { return range; } - - octave_value full_value (void) const { return range.matrix_value (); } - - bool is_defined (void) const { return true; } - - bool is_constant (void) const { return true; } - - bool is_range (void) const { return true; } - - octave_value all (int dim = 0) const; - - octave_value any (int dim = 0) const; - - octave_value diag (octave_idx_type k = 0) const; - - octave_value diag (octave_idx_type m, octave_idx_type n) const; - - octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const - { return range.sort (dim, mode); } - - octave_value sort (Array& sidx, octave_idx_type dim = 0, - sortmode mode = ASCENDING) const - { return range.sort (sidx, dim, mode); } - - sortmode is_sorted (sortmode mode = UNSORTED) const - { return range.is_sorted (mode); } - - Array sort_rows_idx (sortmode) const - { return Array (dim_vector (1, 0)); } - - sortmode is_sorted_rows (sortmode mode = UNSORTED) const - { return mode ? mode : ASCENDING; } - - builtin_type_t builtin_type (void) const { return btyp_double; } - - bool is_real_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - bool is_numeric_type (void) const { return true; } - - bool is_true (void) const; - - double double_value (bool = false) const; - - float float_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - float float_scalar_value (bool frc_str_conv = false) const - { return float_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const - { return range.matrix_value (); } - - FloatMatrix float_matrix_value (bool = false) const - { return range.matrix_value (); } - - NDArray array_value (bool = false) const - { return range.matrix_value (); } - - FloatNDArray float_array_value (bool = false) const - { return FloatMatrix (range.matrix_value ()); } - - charNDArray char_array_value (bool = false) const; - - // FIXME -- it would be better to have Range::intXNDArray_value - // functions to avoid the intermediate conversion to a matrix - // object. - - int8NDArray - int8_array_value (void) const { return int8NDArray (array_value ()); } - - int16NDArray - int16_array_value (void) const { return int16NDArray (array_value ()); } - - int32NDArray - int32_array_value (void) const { return int32NDArray (array_value ()); } - - int64NDArray - int64_array_value (void) const { return int64NDArray (array_value ()); } - - uint8NDArray - uint8_array_value (void) const { return uint8NDArray (array_value ()); } - - uint16NDArray - uint16_array_value (void) const { return uint16NDArray (array_value ()); } - - uint32NDArray - uint32_array_value (void) const { return uint32NDArray (array_value ()); } - - uint64NDArray - uint64_array_value (void) const { return uint64NDArray (array_value ()); } - - SparseMatrix sparse_matrix_value (bool = false) const - { return SparseMatrix (range.matrix_value ()); } - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const - { return SparseComplexMatrix (sparse_matrix_value ()); } - - Complex complex_value (bool = false) const; - - FloatComplex float_complex_value (bool = false) const; - - boolNDArray bool_array_value (bool warn = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const - { return ComplexMatrix (range.matrix_value ()); } - - FloatComplexMatrix float_complex_matrix_value (bool = false) const - { return FloatComplexMatrix (range.matrix_value ()); } - - ComplexNDArray complex_array_value (bool = false) const - { return ComplexMatrix (range.matrix_value ()); } - - FloatComplexNDArray float_complex_array_value (bool = false) const - { return FloatComplexMatrix (range.matrix_value ()); } - - Range range_value (void) const { return range; } - - octave_value convert_to_str_internal (bool pad, bool force, char type) const; - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool print_name_tag (std::ostream& os, const std::string& name) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { - // FIXME -- could be more memory efficient by having a - // special case of the octave_stream::write method for ranges. - - return os.write (matrix_value (), block_size, output_type, skip, - flt_fmt); - } - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const - { - octave_matrix m (matrix_value ()); - return m.map (umap); - } - -private: - - Range range; - - idx_vector set_idx_cache (const idx_vector& idx) const - { - delete idx_cache; - idx_cache = idx ? new idx_vector (idx) : 0; - return idx; - } - - void clear_cached_info (void) const - { - delete idx_cache; idx_cache = 0; - } - - mutable idx_vector *idx_cache; - - // No assignment. - - octave_range& operator = (const octave_range&); - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -// If TRUE, allow ranges with non-integer elements as array indices. -extern bool Vallow_noninteger_range_as_index; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-re-diag.cc --- a/src/ov-re-diag.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,244 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "byte-swap.h" - -#include "ov-re-diag.h" -#include "ov-flt-re-diag.h" -#include "ov-base-diag.cc" -#include "ov-scalar.h" -#include "ov-re-mat.h" -#include "ls-utils.h" - -template class octave_base_diag; - -DEFINE_OCTAVE_ALLOCATOR (octave_diag_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_diag_matrix, "diagonal matrix", "double"); - -static octave_base_value * -default_numeric_conversion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_diag_matrix&); - - return new octave_matrix (v.matrix_value ()); -} - -octave_base_value::type_conv_info -octave_diag_matrix::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_conversion_function, - octave_matrix::static_type_id ()); -} - -static octave_base_value * -default_numeric_demotion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_diag_matrix&); - - return new octave_float_diag_matrix (v.float_diag_matrix_value ()); -} - -octave_base_value::type_conv_info -octave_diag_matrix::numeric_demotion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_demotion_function, - octave_float_diag_matrix::static_type_id ()); -} - -octave_base_value * -octave_diag_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (matrix.nelem () == 1) - retval = new octave_scalar (matrix (0, 0)); - - return retval; -} - -octave_value -octave_diag_matrix::do_index_op (const octave_value_list& idx, - bool resize_ok) -{ - octave_value retval; - - // This hack is to allow constructing permutation matrices using - // eye(n)(p,:), eye(n)(:,q) && eye(n)(p,q) where p & q are permutation - // vectors. - if (! resize_ok && idx.length () == 2 && matrix.is_multiple_of_identity (1)) - { - idx_vector idx0 = idx(0).index_vector (); - idx_vector idx1 = idx(1).index_vector (); - - if (! error_state) - { - bool left = idx0.is_permutation (matrix.rows ()); - bool right = idx1.is_permutation (matrix.cols ()); - - if (left && right) - { - if (idx0.is_colon ()) left = false; - if (idx1.is_colon ()) right = false; - if (left && right) - retval = PermMatrix (idx0, false) * PermMatrix (idx1, true); - else if (left) - retval = PermMatrix (idx0, false); - else if (right) - retval = PermMatrix (idx1, true); - else - { - retval = this; - this->count++; - } - } - } - } - - // if error_state is set, we've already griped. - if (! error_state && retval.is_undefined ()) - retval = octave_base_diag::do_index_op (idx, resize_ok); - - return retval; -} - -DiagMatrix -octave_diag_matrix::diag_matrix_value (bool) const -{ - return matrix; -} - -FloatDiagMatrix -octave_diag_matrix::float_diag_matrix_value (bool) const -{ - return FloatDiagMatrix (matrix); -} - -ComplexDiagMatrix -octave_diag_matrix::complex_diag_matrix_value (bool) const -{ - return ComplexDiagMatrix (matrix); -} - -FloatComplexDiagMatrix -octave_diag_matrix::float_complex_diag_matrix_value (bool) const -{ - return FloatComplexDiagMatrix (matrix); -} - -octave_value -octave_diag_matrix::map (unary_mapper_t umap) const -{ - switch (umap) - { - case umap_abs: - return matrix.abs (); - case umap_real: - case umap_conj: - return matrix; - case umap_imag: - return DiagMatrix (matrix.rows (), matrix.cols (), 0.0); - case umap_sqrt: - { - ComplexColumnVector tmp = matrix.diag ().map (rc_sqrt); - ComplexDiagMatrix retval (tmp); - retval.resize (matrix.rows (), matrix.columns ()); - return retval; - } - default: - return to_dense ().map (umap); - } -} - -bool -octave_diag_matrix::save_binary (std::ostream& os, bool& save_as_floats) -{ - - int32_t r = matrix.rows (), c = matrix.cols (); - os.write (reinterpret_cast (&r), 4); - os.write (reinterpret_cast (&c), 4); - - Matrix m = Matrix (matrix.diag ()); - save_type st = LS_DOUBLE; - if (save_as_floats) - { - if (m.too_large_for_float ()) - { - warning ("save: some values too large to save as floats --"); - warning ("save: saving as doubles instead"); - } - else - st = LS_FLOAT; - } - else if (matrix.length () > 8192) // FIXME -- make this configurable. - { - double max_val, min_val; - if (m.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - } - - const double *mtmp = m.data (); - write_doubles (os, mtmp, st, m.numel ()); - - return true; -} - -bool -octave_diag_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - int32_t r, c; - char tmp; - if (! (is.read (reinterpret_cast (&r), 4) - && is.read (reinterpret_cast (&c), 4) - && is.read (reinterpret_cast (&tmp), 1))) - return false; - if (swap) - { - swap_bytes<4> (&r); - swap_bytes<4> (&c); - } - - DiagMatrix m (r, c); - double *re = m.fortran_vec (); - octave_idx_type len = m.length (); - read_doubles (is, re, static_cast (tmp), len, swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - - return true; -} - -bool -octave_diag_matrix::chk_valid_scalar (const octave_value& val, - double& x) const -{ - bool retval = val.is_real_scalar (); - if (retval) - x = val.double_value (); - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/ov-re-diag.h --- a/src/ov-re-diag.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,98 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_diag_matrix_h) -#define octave_diag_matrix_h 1 - -#include "ov-base.h" -#include "ov-base-diag.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" - -// Real diagonal matrix values. - -class -OCTINTERP_API -octave_diag_matrix - : public octave_base_diag -{ -public: - - octave_diag_matrix (void) - : octave_base_diag () { } - - octave_diag_matrix (const DiagMatrix& m) - : octave_base_diag (m) { } - - octave_diag_matrix (const octave_diag_matrix& m) - : octave_base_diag (m) { } - - ~octave_diag_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_diag_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_diag_matrix (); } - - type_conv_info numeric_conversion_function (void) const; - - type_conv_info numeric_demotion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - builtin_type_t builtin_type (void) const { return btyp_double; } - - bool is_real_matrix (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - DiagMatrix diag_matrix_value (bool = false) const; - - FloatDiagMatrix float_diag_matrix_value (bool = false) const; - - ComplexDiagMatrix complex_diag_matrix_value (bool = false) const; - - FloatComplexDiagMatrix float_complex_diag_matrix_value (bool = false) const; - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - - octave_value map (unary_mapper_t umap) const; - -private: - - bool chk_valid_scalar (const octave_value&, - double&) const; - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-re-mat.cc --- a/src/ov-re-mat.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1031 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "data-conv.h" -#include "lo-ieee.h" -#include "lo-utils.h" -#include "lo-specfun.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "mx-base.h" -#include "quit.h" -#include "oct-locbuf.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "oct-stream.h" -#include "ops.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-base-mat.cc" -#include "ov-scalar.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-complex.h" -#include "ov-cx-mat.h" -#include "ov-re-sparse.h" -#include "ov-re-diag.h" -#include "ov-cx-diag.h" -#include "ov-lazy-idx.h" -#include "ov-perm.h" -#include "ov-type-conv.h" -#include "pr-output.h" -#include "variables.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -#if ! defined (UCHAR_MAX) -#define UCHAR_MAX 255 -#endif - -template class octave_base_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_matrix, "matrix", "double"); - -static octave_base_value * -default_numeric_demotion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_matrix&); - - return new octave_float_matrix (v.float_array_value ()); -} - -octave_base_value::type_conv_info -octave_matrix::numeric_demotion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_demotion_function, - octave_float_matrix::static_type_id ()); -} - -octave_base_value * -octave_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (matrix.nelem () == 1) - retval = new octave_scalar (matrix (0)); - - return retval; -} - -double -octave_matrix::double_value (bool) const -{ - double retval = lo_ieee_nan_value (); - - if (numel () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "real matrix", "real scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("real matrix", "real scalar"); - - return retval; -} - -float -octave_matrix::float_value (bool) const -{ - float retval = lo_ieee_float_nan_value (); - - if (numel () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "real matrix", "real scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("real matrix", "real scalar"); - - return retval; -} - -// FIXME - -Matrix -octave_matrix::matrix_value (bool) const -{ - return matrix.matrix_value (); -} - -FloatMatrix -octave_matrix::float_matrix_value (bool) const -{ - return FloatMatrix (matrix.matrix_value ()); -} - -Complex -octave_matrix::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "real matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("real matrix", "complex scalar"); - - return retval; -} - -FloatComplex -octave_matrix::float_complex_value (bool) const -{ - float tmp = lo_ieee_float_nan_value (); - - FloatComplex retval (tmp, tmp); - - if (rows () > 0 && columns () > 0) - { - gripe_implicit_conversion ("Octave:array-to-scalar", - "real matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("real matrix", "complex scalar"); - - return retval; -} - -// FIXME - -ComplexMatrix -octave_matrix::complex_matrix_value (bool) const -{ - return ComplexMatrix (matrix.matrix_value ()); -} - -FloatComplexMatrix -octave_matrix::float_complex_matrix_value (bool) const -{ - return FloatComplexMatrix (matrix.matrix_value ()); -} - -ComplexNDArray -octave_matrix::complex_array_value (bool) const -{ - return ComplexNDArray (matrix); -} - -FloatComplexNDArray -octave_matrix::float_complex_array_value (bool) const -{ - return FloatComplexNDArray (matrix); -} - -boolNDArray -octave_matrix::bool_array_value (bool warn) const -{ - if (matrix.any_element_is_nan ()) - gripe_nan_to_logical_conversion (); - else if (warn && matrix.any_element_not_one_or_zero ()) - gripe_logical_conversion (); - - return boolNDArray (matrix); -} - -charNDArray -octave_matrix::char_array_value (bool) const -{ - charNDArray retval (dims ()); - - octave_idx_type nel = numel (); - - for (octave_idx_type i = 0; i < nel; i++) - retval.elem (i) = static_cast(matrix.elem (i)); - - return retval; -} - -SparseMatrix -octave_matrix::sparse_matrix_value (bool) const -{ - return SparseMatrix (matrix.matrix_value ()); -} - -SparseComplexMatrix -octave_matrix::sparse_complex_matrix_value (bool) const -{ - // FIXME Need a SparseComplexMatrix (Matrix) constructor to make - // this function more efficient. Then this should become - // return SparseComplexMatrix (matrix.matrix_value ()); - return SparseComplexMatrix (sparse_matrix_value ()); -} - -octave_value -octave_matrix::diag (octave_idx_type k) const -{ - octave_value retval; - if (k == 0 && matrix.ndims () == 2 - && (matrix.rows () == 1 || matrix.columns () == 1)) - retval = DiagMatrix (DiagArray2 (matrix)); - else - retval = octave_base_matrix::diag (k); - - return retval; -} - -octave_value -octave_matrix::diag (octave_idx_type m, octave_idx_type n) const -{ - octave_value retval; - - if (matrix.ndims () == 2 - && (matrix.rows () == 1 || matrix.columns () == 1)) - { - Matrix mat = matrix.matrix_value (); - - retval = mat.diag (m, n); - } - else - error ("diag: expecting vector argument"); - - return retval; -} - -// We override these two functions to allow reshaping both -// the matrix and the index cache. -octave_value -octave_matrix::reshape (const dim_vector& new_dims) const -{ - if (idx_cache) - { - return new octave_matrix (matrix.reshape (new_dims), - idx_vector (idx_cache->as_array ().reshape (new_dims), - idx_cache->extent (0))); - } - else - return octave_base_matrix::reshape (new_dims); -} - -octave_value -octave_matrix::squeeze (void) const -{ - if (idx_cache) - { - return new octave_matrix (matrix.squeeze (), - idx_vector (idx_cache->as_array ().squeeze (), - idx_cache->extent (0))); - } - else - return octave_base_matrix::squeeze (); -} - -octave_value -octave_matrix::sort (octave_idx_type dim, sortmode mode) const -{ - if (idx_cache) - { - // This is a valid index matrix, so sort via integers because it's - // generally more efficient. - return octave_lazy_index (*idx_cache).sort (dim, mode); - } - else - return octave_base_matrix::sort (dim, mode); -} - -octave_value -octave_matrix::sort (Array &sidx, octave_idx_type dim, - sortmode mode) const -{ - if (idx_cache) - { - // This is a valid index matrix, so sort via integers because it's - // generally more efficient. - return octave_lazy_index (*idx_cache).sort (sidx, dim, mode); - } - else - return octave_base_matrix::sort (sidx, dim, mode); -} - -sortmode -octave_matrix::is_sorted (sortmode mode) const -{ - if (idx_cache) - { - // This is a valid index matrix, so check via integers because it's - // generally more efficient. - return idx_cache->as_array ().is_sorted (mode); - } - else - return octave_base_matrix::is_sorted (mode); -} -Array -octave_matrix::sort_rows_idx (sortmode mode) const -{ - if (idx_cache) - { - // This is a valid index matrix, so sort via integers because it's - // generally more efficient. - return octave_lazy_index (*idx_cache).sort_rows_idx (mode); - } - else - return octave_base_matrix::sort_rows_idx (mode); -} - -sortmode -octave_matrix::is_sorted_rows (sortmode mode) const -{ - if (idx_cache) - { - // This is a valid index matrix, so check via integers because it's - // generally more efficient. - return idx_cache->as_array ().is_sorted_rows (mode); - } - else - return octave_base_matrix::is_sorted_rows (mode); -} - -octave_value -octave_matrix::convert_to_str_internal (bool, bool, char type) const -{ - octave_value retval; - dim_vector dv = dims (); - octave_idx_type nel = dv.numel (); - - charNDArray chm (dv); - - bool warned = false; - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_quit (); - - double d = matrix (i); - - if (xisnan (d)) - { - gripe_nan_to_character_conversion (); - return retval; - } - else - { - int ival = NINT (d); - - if (ival < 0 || ival > UCHAR_MAX) - { - // FIXME -- is there something - // better we could do? - - ival = 0; - - if (! warned) - { - ::warning ("range error for conversion to character value"); - warned = true; - } - } - - chm (i) = static_cast (ival); - } - } - - retval = octave_value (chm, type); - - return retval; -} - -bool -octave_matrix::save_ascii (std::ostream& os) -{ - dim_vector d = dims (); - - if (d.length () > 2) - { - NDArray tmp = array_value (); - - os << "# ndims: " << d.length () << "\n"; - - for (int i=0; i < d.length (); i++) - os << " " << d (i); - - os << "\n" << tmp; - } - else - { - // Keep this case, rather than use generic code above for backward - // compatiability. Makes load_ascii much more complex!! - os << "# rows: " << rows () << "\n" - << "# columns: " << columns () << "\n"; - - os << matrix_value (); - } - - return true; -} - -bool -octave_matrix::load_ascii (std::istream& is) -{ - bool success = true; - - string_vector keywords(2); - - keywords[0] = "ndims"; - keywords[1] = "rows"; - - std::string kw; - octave_idx_type val = 0; - - if (extract_keyword (is, keywords, kw, val, true)) - { - if (kw == "ndims") - { - int mdims = static_cast (val); - - if (mdims >= 0) - { - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - is >> dv(i); - - if (is) - { - NDArray tmp(dv); - - is >> tmp; - - if (is) - matrix = tmp; - else - { - error ("load: failed to load matrix constant"); - success = false; - } - } - else - { - error ("load: failed to read dimensions"); - success = false; - } - } - else - { - error ("load: failed to extract number of dimensions"); - success = false; - } - } - else if (kw == "rows") - { - octave_idx_type nr = val; - octave_idx_type nc = 0; - - if (nr >= 0 && extract_keyword (is, "columns", nc) && nc >= 0) - { - if (nr > 0 && nc > 0) - { - Matrix tmp (nr, nc); - is >> tmp; - if (is) - matrix = tmp; - else - { - error ("load: failed to load matrix constant"); - success = false; - } - } - else if (nr == 0 || nc == 0) - matrix = Matrix (nr, nc); - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - } - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - - return success; -} - -bool -octave_matrix::save_binary (std::ostream& os, bool& save_as_floats) -{ - - dim_vector d = dims (); - if (d.length () < 1) - return false; - - // Use negative value for ndims to differentiate with old format!! - int32_t tmp = - d.length (); - os.write (reinterpret_cast (&tmp), 4); - for (int i = 0; i < d.length (); i++) - { - tmp = d(i); - os.write (reinterpret_cast (&tmp), 4); - } - - NDArray m = array_value (); - save_type st = LS_DOUBLE; - if (save_as_floats) - { - if (m.too_large_for_float ()) - { - warning ("save: some values too large to save as floats --"); - warning ("save: saving as doubles instead"); - } - else - st = LS_FLOAT; - } - else if (d.numel () > 8192) // FIXME -- make this configurable. - { - double max_val, min_val; - if (m.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - } - - const double *mtmp = m.data (); - write_doubles (os, mtmp, st, d.numel ()); - - return true; -} - -bool -octave_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - char tmp; - int32_t mdims; - if (! is.read (reinterpret_cast (&mdims), 4)) - return false; - if (swap) - swap_bytes<4> (&mdims); - if (mdims < 0) - { - mdims = - mdims; - int32_t di; - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - { - if (! is.read (reinterpret_cast (&di), 4)) - return false; - if (swap) - swap_bytes<4> (&di); - dv(i) = di; - } - - // Convert an array with a single dimension to be a row vector. - // Octave should never write files like this, other software - // might. - - if (mdims == 1) - { - mdims = 2; - dv.resize (mdims); - dv(1) = dv(0); - dv(0) = 1; - } - - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - - NDArray m(dv); - double *re = m.fortran_vec (); - read_doubles (is, re, static_cast (tmp), dv.numel (), swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - } - else - { - int32_t nr, nc; - nr = mdims; - if (! is.read (reinterpret_cast (&nc), 4)) - return false; - if (swap) - swap_bytes<4> (&nc); - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - Matrix m (nr, nc); - double *re = m.fortran_vec (); - octave_idx_type len = nr * nc; - read_doubles (is, re, static_cast (tmp), len, swap, fmt); - if (error_state || ! is) - return false; - matrix = m; - } - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_matrix::save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) -{ - dim_vector dv = dims (); - int empty = save_hdf5_empty (loc_id, name, dv); - if (empty) - return (empty > 0); - - int rank = dv.length (); - hid_t space_hid = -1, data_hid = -1; - bool retval = true; - NDArray m = array_value (); - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - - // Octave uses column-major, while HDF5 uses row-major ordering - for (int i = 0; i < rank; i++) - hdims[i] = dv (rank-i-1); - - space_hid = H5Screate_simple (rank, hdims, 0); - - if (space_hid < 0) return false; - - hid_t save_type_hid = H5T_NATIVE_DOUBLE; - - if (save_as_floats) - { - if (m.too_large_for_float ()) - { - warning ("save: some values too large to save as floats --"); - warning ("save: saving as doubles instead"); - } - else - save_type_hid = H5T_NATIVE_FLOAT; - } -#if HAVE_HDF5_INT2FLOAT_CONVERSIONS - // hdf5 currently doesn't support float/integer conversions - else - { - double max_val, min_val; - - if (m.all_integers (max_val, min_val)) - save_type_hid - = save_type_to_hdf5 (get_save_type (max_val, min_val)); - } -#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, save_type_hid, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - return false; - } - - double *mtmp = m.fortran_vec (); - retval = H5Dwrite (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, - H5P_DEFAULT, mtmp) >= 0; - - H5Dclose (data_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_matrix::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; - - dim_vector dv; - int empty = load_hdf5_empty (loc_id, name, dv); - if (empty > 0) - matrix.resize (dv); - if (empty) - return (empty > 0); - -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t space_id = H5Dget_space (data_hid); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank < 1) - { - H5Sclose (space_id); - H5Dclose (data_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_id, hdims, maxdims); - - // Octave uses column-major, while HDF5 uses row-major ordering - if (rank == 1) - { - dv.resize (2); - dv(0) = 1; - dv(1) = hdims[0]; - } - else - { - dv.resize (rank); - for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) - dv(j) = hdims[i]; - } - - NDArray m (dv); - double *re = m.fortran_vec (); - if (H5Dread (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, - H5P_DEFAULT, re) >= 0) - { - retval = true; - matrix = m; - } - - H5Sclose (space_id); - H5Dclose (data_hid); - - return retval; -} - -#endif - -void -octave_matrix::print_raw (std::ostream& os, - bool pr_as_read_syntax) const -{ - octave_print_internal (os, matrix, pr_as_read_syntax, - current_print_indent_level ()); -} - -mxArray * -octave_matrix::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxDOUBLE_CLASS, dims (), mxREAL); - - double *pr = static_cast (retval->get_data ()); - - mwSize nel = numel (); - - const double *p = matrix.data (); - - for (mwIndex i = 0; i < nel; i++) - pr[i] = p[i]; - - return retval; -} - -// This uses a smarter strategy for doing the complex->real mappers. We -// allocate an array for a real result and keep filling it until a complex -// result is produced. -static octave_value -do_rc_map (const NDArray& a, Complex (&fcn) (double)) -{ - octave_idx_type n = a.numel (); - NoAlias rr (a.dims ()); - - for (octave_idx_type i = 0; i < n; i++) - { - octave_quit (); - - Complex tmp = fcn (a(i)); - if (tmp.imag () == 0.0) - rr(i) = tmp.real (); - else - { - NoAlias rc (a.dims ()); - - for (octave_idx_type j = 0; j < i; j++) - rc(j) = rr(j); - - rc(i) = tmp; - - for (octave_idx_type j = i+1; j < n; j++) - { - octave_quit (); - - rc(j) = fcn (a(j)); - } - - return new octave_complex_matrix (rc); - } - } - - return rr; -} - -octave_value -octave_matrix::map (unary_mapper_t umap) const -{ - switch (umap) - { - case umap_imag: - return NDArray (matrix.dims (), 0.0); - - case umap_real: - case umap_conj: - return matrix; - - // Mappers handled specially. -#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.FCN ()) - - ARRAY_METHOD_MAPPER (abs, abs); - ARRAY_METHOD_MAPPER (isnan, isnan); - ARRAY_METHOD_MAPPER (isinf, isinf); - ARRAY_METHOD_MAPPER (finite, isfinite); - -#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.map (FCN)) - -#define RC_ARRAY_MAPPER(UMAP, TYPE, FCN) \ - case umap_ ## UMAP: \ - return do_rc_map (matrix, FCN) - - RC_ARRAY_MAPPER (acos, Complex, rc_acos); - RC_ARRAY_MAPPER (acosh, Complex, rc_acosh); - ARRAY_MAPPER (angle, double, ::arg); - ARRAY_MAPPER (arg, double, ::arg); - RC_ARRAY_MAPPER (asin, Complex, rc_asin); - ARRAY_MAPPER (asinh, double, ::asinh); - ARRAY_MAPPER (atan, double, ::atan); - RC_ARRAY_MAPPER (atanh, Complex, rc_atanh); - ARRAY_MAPPER (erf, double, ::erf); - ARRAY_MAPPER (erfinv, double, ::erfinv); - ARRAY_MAPPER (erfcinv, double, ::erfcinv); - ARRAY_MAPPER (erfc, double, ::erfc); - ARRAY_MAPPER (erfcx, double, ::erfcx); - ARRAY_MAPPER (gamma, double, xgamma); - RC_ARRAY_MAPPER (lgamma, Complex, rc_lgamma); - ARRAY_MAPPER (cbrt, double, ::cbrt); - ARRAY_MAPPER (ceil, double, ::ceil); - ARRAY_MAPPER (cos, double, ::cos); - ARRAY_MAPPER (cosh, double, ::cosh); - ARRAY_MAPPER (exp, double, ::exp); - ARRAY_MAPPER (expm1, double, ::expm1); - ARRAY_MAPPER (fix, double, ::fix); - ARRAY_MAPPER (floor, double, ::floor); - RC_ARRAY_MAPPER (log, Complex, rc_log); - RC_ARRAY_MAPPER (log2, Complex, rc_log2); - RC_ARRAY_MAPPER (log10, Complex, rc_log10); - RC_ARRAY_MAPPER (log1p, Complex, rc_log1p); - ARRAY_MAPPER (round, double, xround); - ARRAY_MAPPER (roundb, double, xroundb); - ARRAY_MAPPER (signum, double, ::signum); - ARRAY_MAPPER (sin, double, ::sin); - ARRAY_MAPPER (sinh, double, ::sinh); - RC_ARRAY_MAPPER (sqrt, Complex, rc_sqrt); - ARRAY_MAPPER (tan, double, ::tan); - ARRAY_MAPPER (tanh, double, ::tanh); - ARRAY_MAPPER (isna, bool, octave_is_NA); - - default: - if (umap >= umap_xisalnum && umap <= umap_xtoupper) - { - octave_value str_conv = convert_to_str (true, true); - return error_state ? octave_value () : str_conv.map (umap); - } - else - return octave_base_value::map (umap); - } -} - -DEFUN (double, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} double (@var{x})\n\ -Convert @var{x} to double precision type.\n\ -@seealso{single}\n\ -@end deftypefn") -{ - // The OCTAVE_TYPE_CONV_BODY3 macro declares retval, so they go - // inside their own scopes, and we don't declare retval here to - // avoid a shadowed declaration warning. - - if (args.length () == 1) - { - if (args(0).is_perm_matrix ()) - { - OCTAVE_TYPE_CONV_BODY3 (double, octave_perm_matrix, octave_scalar); - } - else if (args(0).is_diag_matrix ()) - { - if (args(0).is_complex_type ()) - { - OCTAVE_TYPE_CONV_BODY3 (double, octave_complex_diag_matrix, octave_complex); - } - else - { - OCTAVE_TYPE_CONV_BODY3 (double, octave_diag_matrix, octave_scalar); - } - } - else if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - OCTAVE_TYPE_CONV_BODY3 (double, octave_sparse_complex_matrix, octave_complex); - } - else - { - OCTAVE_TYPE_CONV_BODY3 (double, octave_sparse_matrix, octave_scalar); - } - } - else if (args(0).is_complex_type ()) - { - OCTAVE_TYPE_CONV_BODY3 (double, octave_complex_matrix, octave_complex); - } - else - { - OCTAVE_TYPE_CONV_BODY3 (double, octave_matrix, octave_scalar); - } - } - else - print_usage (); - - return octave_value (); -} - -/* -%!assert (class (double (single (1))), "double") -%!assert (class (double (single (1 + i))), "double") -%!assert (class (double (int8 (1))), "double") -%!assert (class (double (uint8 (1))), "double") -%!assert (class (double (int16 (1))), "double") -%!assert (class (double (uint16 (1))), "double") -%!assert (class (double (int32 (1))), "double") -%!assert (class (double (uint32 (1))), "double") -%!assert (class (double (int64 (1))), "double") -%!assert (class (double (uint64 (1))), "double") -%!assert (class (double (true)), "double") -%!assert (class (double ("A")), "double") -%!test -%! x = sparse (logical ([1 0; 0 1])); -%! y = double (x); -%! assert (class (x), "logical"); -%! assert (class (y), "double"); -%! assert (issparse (y)); -%!test -%! x = diag (single ([1 3 2])); -%! y = double (x); -%! assert (class (x), "single"); -%! assert (class (y), "double"); -%!test -%! x = diag (single ([i 3 2])); -%! y = double (x); -%! assert (class (x), "single"); -%! assert (class (y), "double"); -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-re-mat.h --- a/src/ov-re-mat.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,242 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_matrix_h) -#define octave_matrix_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-stream.h" -#include "ov-base.h" -#include "ov-base-mat.h" -#include "ov-typeinfo.h" - -#include "MatrixType.h" - -class octave_value_list; - -class tree_walker; - -// Real matrix values. - -class -OCTINTERP_API -octave_matrix : public octave_base_matrix -{ -public: - - octave_matrix (void) - : octave_base_matrix () { } - - octave_matrix (const Matrix& m) - : octave_base_matrix (m) { } - - octave_matrix (const Matrix& m, const MatrixType& t) - : octave_base_matrix (m, t) { } - - octave_matrix (const NDArray& nda) - : octave_base_matrix (nda) { } - - octave_matrix (const Array& m) - : octave_base_matrix (NDArray (m)) { } - - octave_matrix (const DiagMatrix& d) - : octave_base_matrix (Matrix (d)) { } - - octave_matrix (const RowVector& v) - : octave_base_matrix (Matrix (v)) { } - - octave_matrix (const ColumnVector& v) - : octave_base_matrix (Matrix (v)) { } - - octave_matrix (const octave_matrix& m) - : octave_base_matrix (m) { } - - octave_matrix (const Array& idx, - bool zero_based = false, bool cache_index = false) - : octave_base_matrix (NDArray (idx, zero_based)) - { - // Auto-create cache to speed up subsequent indexing. - if (zero_based && cache_index) - set_idx_cache (idx_vector (idx)); - } - - octave_matrix (const NDArray& nda, const idx_vector& cache) - : octave_base_matrix (nda) - { - set_idx_cache (cache); - } - - ~octave_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_matrix (); } - - type_conv_info numeric_demotion_function (void) const; - - octave_base_value *try_narrowing_conversion (void); - - idx_vector index_vector (void) const - { return idx_cache ? *idx_cache : set_idx_cache (idx_vector (matrix)); } - - builtin_type_t builtin_type (void) const { return btyp_double; } - - bool is_real_matrix (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - int8NDArray - int8_array_value (void) const { return int8NDArray (matrix); } - - int16NDArray - int16_array_value (void) const { return int16NDArray (matrix); } - - int32NDArray - int32_array_value (void) const { return int32NDArray (matrix); } - - int64NDArray - int64_array_value (void) const { return int64NDArray (matrix); } - - uint8NDArray - uint8_array_value (void) const { return uint8NDArray (matrix); } - - uint16NDArray - uint16_array_value (void) const { return uint16NDArray (matrix); } - - uint32NDArray - uint32_array_value (void) const { return uint32NDArray (matrix); } - - uint64NDArray - uint64_array_value (void) const { return uint64NDArray (matrix); } - - double double_value (bool = false) const; - - float float_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const; - - FloatMatrix float_matrix_value (bool = false) const; - - Complex complex_value (bool = false) const; - - FloatComplex float_complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - FloatComplexMatrix float_complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const; - - FloatComplexNDArray float_complex_array_value (bool = false) const; - - boolNDArray bool_array_value (bool warn = false) const; - - charNDArray char_array_value (bool = false) const; - - NDArray array_value (bool = false) const { return matrix; } - - FloatNDArray float_array_value (bool = false) const { return matrix; } - - SparseMatrix sparse_matrix_value (bool = false) const; - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; - - octave_value diag (octave_idx_type k = 0) const; - - octave_value diag (octave_idx_type m, octave_idx_type n) const; - - octave_value reshape (const dim_vector& new_dims) const; - - octave_value squeeze (void) const; - - octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const; - octave_value sort (Array &sidx, octave_idx_type dim = 0, - sortmode mode = ASCENDING) const; - - sortmode is_sorted (sortmode mode = UNSORTED) const; - - Array sort_rows_idx (sortmode mode = ASCENDING) const; - - sortmode is_sorted_rows (sortmode mode = UNSORTED) const; - - // Use matrix_ref here to clear index cache. - void increment (void) { matrix_ref () += 1.0; } - - void decrement (void) { matrix_ref () -= 1.0; } - - void changesign (void) { matrix_ref ().changesign (); } - - octave_value convert_to_str_internal (bool pad, bool force, char type) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { return os.write (matrix, block_size, output_type, skip, flt_fmt); } - - // Unsafe. This function exists to support the MEX interface. - // You should not use it anywhere else. - void *mex_get_data (void) const { return matrix.mex_get_data (); } - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const; - -private: - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-re-sparse.cc --- a/src/ov-re-sparse.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,945 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "lo-specfun.h" -#include "lo-mappers.h" -#include "oct-locbuf.h" - -#include "ov-base.h" -#include "ov-scalar.h" -#include "gripes.h" - -#include "ls-hdf5.h" - -#include "ov-re-sparse.h" - -#include "ov-base-sparse.h" -#include "ov-base-sparse.cc" - -#include "ov-bool-sparse.h" - -template class OCTINTERP_API octave_base_sparse; - -DEFINE_OCTAVE_ALLOCATOR (octave_sparse_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_sparse_matrix, "sparse matrix", "double"); - -idx_vector -octave_sparse_matrix::index_vector (void) const -{ - if (matrix.numel () == matrix.nnz ()) - return idx_vector (array_value ()); - else - { - std::string nm = type_name (); - error ("%s type invalid as index value", nm.c_str ()); - return idx_vector (); - } -} - -octave_base_value * -octave_sparse_matrix::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (Vsparse_auto_mutate) - { - // Don't use numel, since it can overflow for very large matrices - // Note that for the second test, this means it becomes approximative - // since it involves a cast to double to avoid issues of overflow - if (matrix.rows () == 1 && matrix.cols () == 1) - { - // Const copy of the matrix, so the right version of () operator used - const SparseMatrix tmp (matrix); - - retval = new octave_scalar (tmp (0)); - } - else if (matrix.cols () > 0 && matrix.rows () > 0 - && (double (matrix.byte_size ()) > double (matrix.rows ()) - * double (matrix.cols ()) * sizeof (double))) - retval = new octave_matrix (matrix.matrix_value ()); - } - - return retval; -} - -double -octave_sparse_matrix::double_value (bool) const -{ - double retval = lo_ieee_nan_value (); - - if (numel () > 0) - { - if (numel () > 1) - gripe_implicit_conversion ("Octave:array-to-scalar", - "real sparse matrix", "real scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("real sparse matrix", "real scalar"); - - return retval; -} - -Complex -octave_sparse_matrix::complex_value (bool) const -{ - double tmp = lo_ieee_nan_value (); - - Complex retval (tmp, tmp); - - // FIXME -- maybe this should be a function, valid_as_scalar() - if (rows () > 0 && columns () > 0) - { - if (numel () > 1) - gripe_implicit_conversion ("Octave:array-to-scalar", - "real sparse matrix", "complex scalar"); - - retval = matrix (0, 0); - } - else - gripe_invalid_conversion ("real sparse matrix", "complex scalar"); - - return retval; -} - -Matrix -octave_sparse_matrix::matrix_value (bool) const -{ - return matrix.matrix_value (); -} - -boolNDArray -octave_sparse_matrix::bool_array_value (bool warn) const -{ - NDArray m = matrix.matrix_value (); - - if (m.any_element_is_nan ()) - gripe_nan_to_logical_conversion (); - else if (warn && m.any_element_not_one_or_zero ()) - gripe_logical_conversion (); - - return boolNDArray (m); -} - -charNDArray -octave_sparse_matrix::char_array_value (bool) const -{ - charNDArray retval (dims (), 0); - octave_idx_type nc = matrix.cols (); - octave_idx_type nr = matrix.rows (); - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = matrix.cidx (j); i < matrix.cidx (j+1); i++) - retval(matrix.ridx (i) + nr * j) = static_cast(matrix.data (i)); - - return retval; -} - -ComplexMatrix -octave_sparse_matrix::complex_matrix_value (bool) const -{ - return ComplexMatrix (matrix.matrix_value ()); -} - -ComplexNDArray -octave_sparse_matrix::complex_array_value (bool) const -{ - return ComplexNDArray (ComplexMatrix (matrix.matrix_value ())); -} - -NDArray -octave_sparse_matrix::array_value (bool) const -{ - return NDArray (matrix.matrix_value ()); -} - -SparseBoolMatrix -octave_sparse_matrix::sparse_bool_matrix_value (bool warn) const -{ - if (matrix.any_element_is_nan ()) - gripe_nan_to_logical_conversion (); - else if (warn && matrix.any_element_not_one_or_zero ()) - gripe_logical_conversion (); - - return mx_el_ne (matrix, 0.0); -} - -octave_value -octave_sparse_matrix::convert_to_str_internal (bool, bool, char type) const -{ - octave_value retval; - dim_vector dv = dims (); - octave_idx_type nel = dv.numel (); - - if (nel == 0) - { - char s = '\0'; - retval = octave_value (&s, type); - } - else - { - octave_idx_type nr = matrix.rows (); - octave_idx_type nc = matrix.cols (); - charNDArray chm (dv, static_cast (0)); - - bool warned = false; - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = matrix.cidx (j); - i < matrix.cidx (j+1); i++) - { - octave_quit (); - - double d = matrix.data (i); - - if (xisnan (d)) - { - gripe_nan_to_character_conversion (); - return retval; - } - else - { - int ival = NINT (d); - - if (ival < 0 || ival > UCHAR_MAX) - { - // FIXME -- is there something - // better we could do? - - ival = 0; - - if (! warned) - { - ::warning ("range error for conversion to character value"); - warned = true; - } - } - - chm (matrix.ridx (i) + j * nr) = - static_cast (ival); - } - } - - retval = octave_value (chm, type); - } - - return retval; -} - -bool -octave_sparse_matrix::save_binary (std::ostream& os, bool&save_as_floats) -{ - dim_vector d = this->dims (); - if (d.length () < 1) - return false; - - // Ensure that additional memory is deallocated - matrix.maybe_compress (); - - int nr = d(0); - int nc = d(1); - int nz = nnz (); - - int32_t itmp; - // Use negative value for ndims to be consistent with other formats - itmp= -2; - os.write (reinterpret_cast (&itmp), 4); - - itmp= nr; - os.write (reinterpret_cast (&itmp), 4); - - itmp= nc; - os.write (reinterpret_cast (&itmp), 4); - - itmp= nz; - os.write (reinterpret_cast (&itmp), 4); - - save_type st = LS_DOUBLE; - if (save_as_floats) - { - if (matrix.too_large_for_float ()) - { - warning ("save: some values too large to save as floats --"); - warning ("save: saving as doubles instead"); - } - else - st = LS_FLOAT; - } - else if (matrix.nnz () > 8192) // FIXME -- make this configurable. - { - double max_val, min_val; - if (matrix.all_integers (max_val, min_val)) - st = get_save_type (max_val, min_val); - } - - // add one to the printed indices to go from - // zero-based to one-based arrays - for (int i = 0; i < nc+1; i++) - { - octave_quit (); - itmp = matrix.cidx (i); - os.write (reinterpret_cast (&itmp), 4); - } - - for (int i = 0; i < nz; i++) - { - octave_quit (); - itmp = matrix.ridx (i); - os.write (reinterpret_cast (&itmp), 4); - } - - write_doubles (os, matrix.data (), st, nz); - - return true; -} - -bool -octave_sparse_matrix::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - int32_t nz, nc, nr, tmp; - char ctmp; - - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - - if (swap) - swap_bytes<4> (&tmp); - - if (tmp != -2) { - error ("load: only 2D sparse matrices are supported"); - return false; - } - - if (! is.read (reinterpret_cast (&nr), 4)) - return false; - if (! is.read (reinterpret_cast (&nc), 4)) - return false; - if (! is.read (reinterpret_cast (&nz), 4)) - return false; - - if (swap) - { - swap_bytes<4> (&nr); - swap_bytes<4> (&nc); - swap_bytes<4> (&nz); - } - - SparseMatrix m (static_cast (nr), - static_cast (nc), - static_cast (nz)); - - for (int i = 0; i < nc+1; i++) - { - octave_quit (); - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - if (swap) - swap_bytes<4> (&tmp); - m.xcidx (i) = tmp; - } - - for (int i = 0; i < nz; i++) - { - octave_quit (); - if (! is.read (reinterpret_cast (&tmp), 4)) - return false; - if (swap) - swap_bytes<4> (&tmp); - m.xridx (i) = tmp; - } - - if (! is.read (reinterpret_cast (&ctmp), 1)) - return false; - - read_doubles (is, m.xdata (), static_cast (ctmp), nz, swap, fmt); - - if (error_state || ! is) - return false; - - if (! m.indices_ok ()) - return false; - - matrix = m; - - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_sparse_matrix::save_hdf5 (hid_t loc_id, const char *name, - bool save_as_floats) -{ - dim_vector dv = dims (); - int empty = save_hdf5_empty (loc_id, name, dv); - if (empty) - return (empty > 0); - - // Ensure that additional memory is deallocated - matrix.maybe_compress (); - -#if HAVE_HDF5_18 - hid_t group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - hid_t group_hid = H5Gcreate (loc_id, name, 0); -#endif - if (group_hid < 0) - return false; - - hid_t space_hid = -1, data_hid = -1; - bool retval = true; - SparseMatrix m = sparse_matrix_value (); - octave_idx_type tmp; - hsize_t hdims[2]; - - space_hid = H5Screate_simple (0, hdims, 0); - if (space_hid < 0) - { - H5Gclose (group_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "nr", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - tmp = m.rows (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, - &tmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "nc", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - tmp = m.cols (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, - &tmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "nz", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - tmp = m.nnz (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, - &tmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - - hdims[0] = m.cols () + 1; - hdims[1] = 1; - - space_hid = H5Screate_simple (2, hdims, 0); - - if (space_hid < 0) - { - H5Gclose (group_hid); - return false; - } - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "cidx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - octave_idx_type * itmp = m.xcidx (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, - itmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - - hdims[0] = m.nnz (); - hdims[1] = 1; - - space_hid = H5Screate_simple (2, hdims, 0); - - if (space_hid < 0) - { - H5Gclose (group_hid); - return false; - } -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "ridx", H5T_NATIVE_IDX, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - itmp = m.xridx (); - retval = H5Dwrite (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, H5P_DEFAULT, - itmp) >= 0; - H5Dclose (data_hid); - if (!retval) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - hid_t save_type_hid = H5T_NATIVE_DOUBLE; - - if (save_as_floats) - { - if (m.too_large_for_float ()) - { - warning ("save: some values too large to save as floats --"); - warning ("save: saving as doubles instead"); - } - else - save_type_hid = H5T_NATIVE_FLOAT; - } -#if HAVE_HDF5_INT2FLOAT_CONVERSIONS - // hdf5 currently doesn't support float/integer conversions - else - { - double max_val, min_val; - - if (m.all_integers (max_val, min_val)) - save_type_hid - = save_type_to_hdf5 (get_save_type (max_val, min_val)); - } -#endif /* HAVE_HDF5_INT2FLOAT_CONVERSIONS */ - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (group_hid, "data", save_type_hid, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (group_hid, "data", save_type_hid, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - H5Gclose (group_hid); - return false; - } - - double * dtmp = m.xdata (); - retval = H5Dwrite (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, - H5P_DEFAULT, dtmp) >= 0; - H5Dclose (data_hid); - H5Sclose (space_hid); - H5Gclose (group_hid); - - return retval; -} - -bool -octave_sparse_matrix::load_hdf5 (hid_t loc_id, const char *name) -{ - octave_idx_type nr, nc, nz; - hid_t group_hid, data_hid, space_hid; - hsize_t rank; - - dim_vector dv; - int empty = load_hdf5_empty (loc_id, name, dv); - if (empty > 0) - matrix.resize (dv); - if (empty) - return (empty > 0); - -#if HAVE_HDF5_18 - group_hid = H5Gopen (loc_id, name, H5P_DEFAULT); -#else - group_hid = H5Gopen (loc_id, name); -#endif - if (group_hid < 0) return false; - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "nr", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "nr"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &nr) < 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "nc", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "nc"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &nc) < 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "nz", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "nz"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &nz) < 0) - { - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Dclose (data_hid); - - SparseMatrix m (static_cast (nr), - static_cast (nc), - static_cast (nz)); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "cidx", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "cidx"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 2) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - if (static_cast (hdims[0]) != nc + 1 - || static_cast (hdims[1]) != 1) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - octave_idx_type *itmp = m.xcidx (); - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, itmp) < 0) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "ridx", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "ridx"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 2) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - if (static_cast (hdims[0]) != nz || static_cast (hdims[1]) != 1) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - itmp = m.xridx (); - if (H5Dread (data_hid, H5T_NATIVE_IDX, H5S_ALL, H5S_ALL, - H5P_DEFAULT, itmp) < 0) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sclose (space_hid); - H5Dclose (data_hid); - -#if HAVE_HDF5_18 - data_hid = H5Dopen (group_hid, "data", H5P_DEFAULT); -#else - data_hid = H5Dopen (group_hid, "data"); -#endif - space_hid = H5Dget_space (data_hid); - rank = H5Sget_simple_extent_ndims (space_hid); - - if (rank != 2) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - if (static_cast (hdims[0]) != nz || static_cast (hdims[1]) != 1) - { - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - return false; - } - - double *dtmp = m.xdata (); - bool retval = false; - if (H5Dread (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, - H5P_DEFAULT, dtmp) >= 0 - && m.indices_ok ()) - { - retval = true; - matrix = m; - } - - H5Sclose (space_hid); - H5Dclose (data_hid); - H5Gclose (group_hid); - - return retval; -} - -#endif - -mxArray * -octave_sparse_matrix::as_mxArray (void) const -{ - mwSize nz = nzmax (); - mwSize nr = rows (); - mwSize nc = columns (); - mxArray *retval = new mxArray (mxDOUBLE_CLASS, nr, nc, nz, mxREAL); - double *pr = static_cast (retval->get_data ()); - mwIndex *ir = retval->get_ir (); - mwIndex *jc = retval->get_jc (); - - for (mwIndex i = 0; i < nz; i++) - { - pr[i] = matrix.data (i); - ir[i] = matrix.ridx (i); - } - - for (mwIndex i = 0; i < nc + 1; i++) - jc[i] = matrix.cidx (i); - - return retval; -} - -octave_value -octave_sparse_matrix::map (unary_mapper_t umap) const -{ - switch (umap) - { - case umap_imag: - return SparseMatrix (matrix.rows (), matrix.cols (), 0.0); - - case umap_real: - case umap_conj: - return matrix; - - // Mappers handled specially. -#define ARRAY_METHOD_MAPPER(UMAP, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.FCN ()) - - ARRAY_METHOD_MAPPER (abs, abs); - -#define ARRAY_MAPPER(UMAP, TYPE, FCN) \ - case umap_ ## UMAP: \ - return octave_value (matrix.map (FCN)) - - ARRAY_MAPPER (acos, Complex, rc_acos); - ARRAY_MAPPER (acosh, Complex, rc_acosh); - ARRAY_MAPPER (angle, double, ::arg); - ARRAY_MAPPER (arg, double, ::arg); - ARRAY_MAPPER (asin, Complex, rc_asin); - ARRAY_MAPPER (asinh, double, ::asinh); - ARRAY_MAPPER (atan, double, ::atan); - ARRAY_MAPPER (atanh, Complex, rc_atanh); - ARRAY_MAPPER (erf, double, ::erf); - ARRAY_MAPPER (erfinv, double, ::erfinv); - ARRAY_MAPPER (erfcinv, double, ::erfcinv); - ARRAY_MAPPER (erfc, double, ::erfc); - ARRAY_MAPPER (gamma, double, xgamma); - ARRAY_MAPPER (lgamma, Complex, rc_lgamma); - ARRAY_MAPPER (cbrt, double, ::cbrt); - ARRAY_MAPPER (ceil, double, ::ceil); - ARRAY_MAPPER (cos, double, ::cos); - ARRAY_MAPPER (cosh, double, ::cosh); - ARRAY_MAPPER (exp, double, ::exp); - ARRAY_MAPPER (expm1, double, ::expm1); - ARRAY_MAPPER (fix, double, ::fix); - ARRAY_MAPPER (floor, double, ::floor); - ARRAY_MAPPER (log, Complex, rc_log); - ARRAY_MAPPER (log2, Complex, rc_log2); - ARRAY_MAPPER (log10, Complex, rc_log10); - ARRAY_MAPPER (log1p, Complex, rc_log1p); - ARRAY_MAPPER (round, double, xround); - ARRAY_MAPPER (roundb, double, xroundb); - ARRAY_MAPPER (signum, double, ::signum); - ARRAY_MAPPER (sin, double, ::sin); - ARRAY_MAPPER (sinh, double, ::sinh); - ARRAY_MAPPER (sqrt, Complex, rc_sqrt); - ARRAY_MAPPER (tan, double, ::tan); - ARRAY_MAPPER (tanh, double, ::tanh); - ARRAY_MAPPER (isnan, bool, xisnan); - ARRAY_MAPPER (isna, bool, octave_is_NA); - ARRAY_MAPPER (isinf, bool, xisinf); - ARRAY_MAPPER (finite, bool, xfinite); - - default: // Attempt to go via dense matrix. - return octave_base_sparse::map (umap); - } -} diff -r d02b229ce693 -r a132d206a36a src/ov-re-sparse.h --- a/src/ov-re-sparse.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,164 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_sparse_matrix_h) -#define octave_sparse_matrix_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-stream.h" -#include "ov-base.h" -#include "ov-typeinfo.h" - -#include "dSparse.h" -#include "MatrixType.h" -#include "ov-base-sparse.h" -#include "ov-cx-sparse.h" - -class octave_value_list; - -class tree_walker; - -class -OCTINTERP_API -octave_sparse_matrix : public octave_base_sparse -{ -public: - - octave_sparse_matrix (void) - : octave_base_sparse () { } - - octave_sparse_matrix (const Matrix& m) - : octave_base_sparse (SparseMatrix (m)) { } - - octave_sparse_matrix (const NDArray& m) - : octave_base_sparse (SparseMatrix (m)) { } - - octave_sparse_matrix (const SparseMatrix& m) - : octave_base_sparse (m) { } - - octave_sparse_matrix (const SparseMatrix& m, const MatrixType& t) - : octave_base_sparse (m, t) { } - - octave_sparse_matrix (const MSparse& m) - : octave_base_sparse (m) { } - - octave_sparse_matrix (const MSparse& m, const MatrixType& t) - : octave_base_sparse (m, t) { } - - octave_sparse_matrix (const Sparse& m) - : octave_base_sparse (SparseMatrix (m)) { } - - octave_sparse_matrix (const Sparse& m, const MatrixType& t) - : octave_base_sparse (SparseMatrix (m), t) { } - - octave_sparse_matrix (const octave_sparse_matrix& m) - : octave_base_sparse (m) { } - - ~octave_sparse_matrix (void) { } - - octave_base_value *clone (void) const { return new octave_sparse_matrix (*this); } - octave_base_value *empty_clone (void) const { return new octave_sparse_matrix (); } - - octave_base_value *try_narrowing_conversion (void); - - idx_vector index_vector (void) const; - - builtin_type_t builtin_type (void) const { return btyp_double; } - - bool is_real_matrix (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - double double_value (bool = false) const; - - double scalar_value (bool frc_str_conv = false) const - { return double_value (frc_str_conv); } - - Matrix matrix_value (bool = false) const; - - Complex complex_value (bool = false) const; - - boolNDArray bool_array_value (bool warn = false) const; - - charNDArray char_array_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const; - - NDArray array_value (bool = false) const; - - SparseMatrix sparse_matrix_value (bool = false) const - { return matrix; } - - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const - { return SparseComplexMatrix (matrix); } - - SparseBoolMatrix sparse_bool_matrix_value (bool warn = false) const; - - octave_value convert_to_str_internal (bool pad, bool force, char type) const; - -#if 0 - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { return os.write (matrix, block_size, output_type, skip, flt_fmt); } -#endif - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const; - -private: - octave_value map (double (*fcn) (double)) const; - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-scalar.cc --- a/src/ov-scalar.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,368 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "data-conv.h" -#include "mach-info.h" -#include "lo-specfun.h" -#include "lo-mappers.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-stream.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-base.h" -#include "ov-base-scalar.h" -#include "ov-base-scalar.cc" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" -#include "pr-output.h" -#include "xdiv.h" -#include "xpow.h" -#include "ops.h" - -#include "ls-oct-ascii.h" -#include "ls-hdf5.h" - -template class octave_base_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_scalar); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_scalar, "scalar", "double"); - -static octave_base_value * -default_numeric_demotion_function (const octave_base_value& a) -{ - CAST_CONV_ARG (const octave_scalar&); - - return new octave_float_scalar (v.float_value ()); -} - -octave_base_value::type_conv_info -octave_scalar::numeric_demotion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_demotion_function, - octave_float_scalar::static_type_id ()); -} - -octave_value -octave_scalar::do_index_op (const octave_value_list& idx, bool resize_ok) -{ - // FIXME -- this doesn't solve the problem of - // - // a = 1; a([1,1], [1,1], [1,1]) - // - // and similar constructions. Hmm... - - // FIXME -- using this constructor avoids narrowing the - // 1x1 matrix back to a scalar value. Need a better solution - // to this problem. - - octave_value tmp (new octave_matrix (matrix_value ())); - - return tmp.do_index_op (idx, resize_ok); -} - -octave_value -octave_scalar::resize (const dim_vector& dv, bool fill) const -{ - if (fill) - { - NDArray retval (dv, 0); - - if (dv.numel ()) - retval(0) = scalar; - - return retval; - } - else - { - NDArray retval (dv); - - if (dv.numel ()) - retval(0) = scalar; - - return retval; - } -} - -octave_value -octave_scalar::diag (octave_idx_type m, octave_idx_type n) const -{ - return DiagMatrix (Array (dim_vector (1, 1), scalar), m, n); -} - -octave_value -octave_scalar::convert_to_str_internal (bool, bool, char type) const -{ - octave_value retval; - - if (xisnan (scalar)) - gripe_nan_to_character_conversion (); - else - { - int ival = NINT (scalar); - - if (ival < 0 || ival > UCHAR_MAX) - { - // FIXME -- is there something better we could do? - - ival = 0; - - ::warning ("range error for conversion to character value"); - } - - retval = octave_value (std::string (1, static_cast (ival)), type); - } - - return retval; -} - -bool -octave_scalar::save_ascii (std::ostream& os) -{ - double d = double_value (); - - octave_write_double (os, d); - - os << "\n"; - - return true; -} - -bool -octave_scalar::load_ascii (std::istream& is) -{ - scalar = octave_read_value (is); - if (!is) - { - error ("load: failed to load scalar constant"); - return false; - } - - return true; -} - -bool -octave_scalar::save_binary (std::ostream& os, bool& /* save_as_floats */) -{ - char tmp = LS_DOUBLE; - os.write (reinterpret_cast (&tmp), 1); - double dtmp = double_value (); - os.write (reinterpret_cast (&dtmp), 8); - - return true; -} - -bool -octave_scalar::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - char tmp; - if (! is.read (reinterpret_cast (&tmp), 1)) - return false; - - double dtmp; - read_doubles (is, &dtmp, static_cast (tmp), 1, swap, fmt); - if (error_state || ! is) - return false; - - scalar = dtmp; - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_scalar::save_hdf5 (hid_t loc_id, const char *name, - bool /* save_as_floats */) -{ - hsize_t dimens[3]; - hid_t space_hid = -1, data_hid = -1; - bool retval = true; - - space_hid = H5Screate_simple (0, dimens, 0); - if (space_hid < 0) return false; - -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_DOUBLE, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_DOUBLE, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - return false; - } - - double tmp = double_value (); - retval = H5Dwrite (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &tmp) >= 0; - - H5Dclose (data_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_scalar::load_hdf5 (hid_t loc_id, const char *name) -{ -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t space_id = H5Dget_space (data_hid); - - hsize_t rank = H5Sget_simple_extent_ndims (space_id); - - if (rank != 0) - { - H5Dclose (data_hid); - return false; - } - - double dtmp; - if (H5Dread (data_hid, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, - H5P_DEFAULT, &dtmp) < 0) - { - H5Dclose (data_hid); - return false; - } - - scalar = dtmp; - - H5Dclose (data_hid); - - return true; -} - -#endif - -mxArray * -octave_scalar::as_mxArray (void) const -{ - mxArray *retval = new mxArray (mxDOUBLE_CLASS, 1, 1, mxREAL); - - double *pr = static_cast (retval->get_data ()); - - pr[0] = scalar; - - return retval; -} - -octave_value -octave_scalar::map (unary_mapper_t umap) const -{ - switch (umap) - { - case umap_imag: - return 0.0; - - case umap_real: - case umap_conj: - return scalar; - -#define SCALAR_MAPPER(UMAP, FCN) \ - case umap_ ## UMAP: \ - return octave_value (FCN (scalar)) - - SCALAR_MAPPER (abs, ::fabs); - SCALAR_MAPPER (acos, rc_acos); - SCALAR_MAPPER (acosh, rc_acosh); - SCALAR_MAPPER (angle, ::arg); - SCALAR_MAPPER (arg, ::arg); - SCALAR_MAPPER (asin, rc_asin); - SCALAR_MAPPER (asinh, ::asinh); - SCALAR_MAPPER (atan, ::atan); - SCALAR_MAPPER (atanh, rc_atanh); - SCALAR_MAPPER (erf, ::erf); - SCALAR_MAPPER (erfinv, ::erfinv); - SCALAR_MAPPER (erfcinv, ::erfcinv); - SCALAR_MAPPER (erfc, ::erfc); - SCALAR_MAPPER (erfcx, ::erfcx); - SCALAR_MAPPER (gamma, xgamma); - SCALAR_MAPPER (lgamma, rc_lgamma); - SCALAR_MAPPER (cbrt, ::cbrt); - SCALAR_MAPPER (ceil, ::ceil); - SCALAR_MAPPER (cos, ::cos); - SCALAR_MAPPER (cosh, ::cosh); - SCALAR_MAPPER (exp, ::exp); - SCALAR_MAPPER (expm1, ::expm1); - SCALAR_MAPPER (fix, ::fix); - SCALAR_MAPPER (floor, gnulib::floor); - SCALAR_MAPPER (log, rc_log); - SCALAR_MAPPER (log2, rc_log2); - SCALAR_MAPPER (log10, rc_log10); - SCALAR_MAPPER (log1p, rc_log1p); - SCALAR_MAPPER (round, xround); - SCALAR_MAPPER (roundb, xroundb); - SCALAR_MAPPER (signum, ::signum); - SCALAR_MAPPER (sin, ::sin); - SCALAR_MAPPER (sinh, ::sinh); - SCALAR_MAPPER (sqrt, rc_sqrt); - SCALAR_MAPPER (tan, ::tan); - SCALAR_MAPPER (tanh, ::tanh); - SCALAR_MAPPER (finite, xfinite); - SCALAR_MAPPER (isinf, xisinf); - SCALAR_MAPPER (isna, octave_is_NA); - SCALAR_MAPPER (isnan, xisnan); - - default: - if (umap >= umap_xisalnum && umap <= umap_xtoupper) - { - octave_value str_conv = convert_to_str (true, true); - return error_state ? octave_value () : str_conv.map (umap); - } - else - return octave_base_value::map (umap); - } -} - -bool -octave_scalar::fast_elem_insert_self (void *where, builtin_type_t btyp) const -{ - - // Support inline real->complex conversion. - if (btyp == btyp_double) - { - *(reinterpret_cast(where)) = scalar; - return true; - } - else if (btyp == btyp_complex) - { - *(reinterpret_cast(where)) = scalar; - return true; - } - else - return false; -} diff -r d02b229ce693 -r a132d206a36a src/ov-scalar.h --- a/src/ov-scalar.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,259 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_scalar_h) -#define octave_scalar_h 1 - -#include - -#include -#include - -#include "lo-ieee.h" -#include "lo-mappers.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "oct-alloc.h" -#include "str-vec.h" - -#include "gripes.h" -#include "ov-base.h" -#include "ov-re-mat.h" -#include "ov-base-scalar.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// Real scalar values. - -class -OCTINTERP_API -octave_scalar : public octave_base_scalar -{ -public: - - octave_scalar (void) - : octave_base_scalar (0.0) { } - - octave_scalar (double d) - : octave_base_scalar (d) { } - - octave_scalar (const octave_scalar& s) - : octave_base_scalar (s) { } - - ~octave_scalar (void) { } - - octave_base_value *clone (void) const { return new octave_scalar (*this); } - - // We return an octave_matrix here instead of an octave_scalar so - // that in expressions like A(2,2,2) = 2 (for A previously - // undefined), A will be empty instead of a 1x1 object. - octave_base_value *empty_clone (void) const { return new octave_matrix (); } - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - type_conv_info numeric_demotion_function (void) const; - - idx_vector index_vector (void) const { return idx_vector (scalar); } - - octave_value any (int = 0) const - { return (scalar != 0 && ! lo_ieee_isnan (scalar)); } - - builtin_type_t builtin_type (void) const { return btyp_double; } - - bool is_real_scalar (void) const { return true; } - - bool is_real_type (void) const { return true; } - - bool is_double_type (void) const { return true; } - - bool is_float_type (void) const { return true; } - - int8NDArray - int8_array_value (void) const - { return int8NDArray (dim_vector (1, 1), scalar); } - - int16NDArray - int16_array_value (void) const - { return int16NDArray (dim_vector (1, 1), scalar); } - - int32NDArray - int32_array_value (void) const - { return int32NDArray (dim_vector (1, 1), scalar); } - - int64NDArray - int64_array_value (void) const - { return int64NDArray (dim_vector (1, 1), scalar); } - - uint8NDArray - uint8_array_value (void) const - { return uint8NDArray (dim_vector (1, 1), scalar); } - - uint16NDArray - uint16_array_value (void) const - { return uint16NDArray (dim_vector (1, 1), scalar); } - - uint32NDArray - uint32_array_value (void) const - { return uint32NDArray (dim_vector (1, 1), scalar); } - - uint64NDArray - uint64_array_value (void) const - { return uint64NDArray (dim_vector (1, 1), scalar); } - -#define DEFINE_INT_SCALAR_VALUE(TYPE) \ - octave_ ## TYPE \ - TYPE ## _scalar_value (void) const \ - { return octave_ ## TYPE (scalar); } - - DEFINE_INT_SCALAR_VALUE (int8) - DEFINE_INT_SCALAR_VALUE (int16) - DEFINE_INT_SCALAR_VALUE (int32) - DEFINE_INT_SCALAR_VALUE (int64) - DEFINE_INT_SCALAR_VALUE (uint8) - DEFINE_INT_SCALAR_VALUE (uint16) - DEFINE_INT_SCALAR_VALUE (uint32) - DEFINE_INT_SCALAR_VALUE (uint64) - -#undef DEFINE_INT_SCALAR_VALUE - - double double_value (bool = false) const { return scalar; } - - float float_value (bool = false) const { return static_cast (scalar); } - - double scalar_value (bool = false) const { return scalar; } - - float float_scalar_value (bool = false) const { return static_cast (scalar); } - - Matrix matrix_value (bool = false) const - { return Matrix (1, 1, scalar); } - - FloatMatrix float_matrix_value (bool = false) const - { return FloatMatrix (1, 1, scalar); } - - NDArray array_value (bool = false) const - { return NDArray (dim_vector (1, 1), scalar); } - - FloatNDArray float_array_value (bool = false) const - { return FloatNDArray (dim_vector (1, 1), scalar); } - - SparseMatrix sparse_matrix_value (bool = false) const - { return SparseMatrix (Matrix (1, 1, scalar)); } - - // FIXME Need SparseComplexMatrix (Matrix) constructor!!! - SparseComplexMatrix sparse_complex_matrix_value (bool = false) const - { return SparseComplexMatrix (sparse_matrix_value ()); } - - octave_value resize (const dim_vector& dv, bool fill = false) const; - - Complex complex_value (bool = false) const { return scalar; } - - FloatComplex float_complex_value (bool = false) const { return scalar; } - - ComplexMatrix complex_matrix_value (bool = false) const - { return ComplexMatrix (1, 1, Complex (scalar)); } - - FloatComplexMatrix float_complex_matrix_value (bool = false) const - { return FloatComplexMatrix (1, 1, FloatComplex (scalar)); } - - ComplexNDArray complex_array_value (bool = false) const - { return ComplexNDArray (dim_vector (1, 1), Complex (scalar)); } - - FloatComplexNDArray float_complex_array_value (bool = false) const - { return FloatComplexNDArray (dim_vector (1, 1), FloatComplex (scalar)); } - - charNDArray - char_array_value (bool = false) const - { - charNDArray retval (dim_vector (1, 1)); - retval(0) = static_cast (scalar); - return retval; - } - - bool bool_value (bool warn = false) const - { - if (xisnan (scalar)) - gripe_nan_to_logical_conversion (); - else if (warn && scalar != 0 && scalar != 1) - gripe_logical_conversion (); - - return scalar; - } - - boolNDArray bool_array_value (bool warn = false) const - { - if (xisnan (scalar)) - gripe_nan_to_logical_conversion (); - else if (warn && scalar != 0 && scalar != 1) - gripe_logical_conversion (); - - return boolNDArray (dim_vector (1, 1), scalar); - } - - octave_value diag (octave_idx_type m, octave_idx_type n) const; - - octave_value convert_to_str_internal (bool pad, bool force, char type) const; - - void increment (void) { ++scalar; } - - void decrement (void) { --scalar; } - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { - return os.write (array_value (), block_size, output_type, - skip, flt_fmt); - } - - mxArray *as_mxArray (void) const; - - octave_value map (unary_mapper_t umap) const; - - bool fast_elem_insert_self (void *where, builtin_type_t btyp) const; - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-str-mat.cc --- a/src/ov-str-mat.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,777 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "data-conv.h" -#include "lo-ieee.h" -#include "mach-info.h" -#include "mx-base.h" -#include "oct-locbuf.h" - -#include "byte-swap.h" -#include "defun.h" -#include "gripes.h" -#include "ls-ascii-helper.h" -#include "ls-hdf5.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "oct-obj.h" -#include "oct-stream.h" -#include "ops.h" -#include "ov-scalar.h" -#include "ov-re-mat.h" -#include "ov-str-mat.h" -#include "pr-output.h" -#include "pt-mat.h" -#include "utils.h" - -DEFINE_OCTAVE_ALLOCATOR (octave_char_matrix_str); -DEFINE_OCTAVE_ALLOCATOR (octave_char_matrix_sq_str); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_char_matrix_str, "string", "char"); -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_char_matrix_sq_str, "sq_string", "char"); - -static octave_base_value * -default_numeric_conversion_function (const octave_base_value& a) -{ - octave_base_value *retval = 0; - - CAST_CONV_ARG (const octave_char_matrix_str&); - - NDArray nda = v.array_value (true); - - if (! error_state) - { - if (nda.numel () == 1) - retval = new octave_scalar (nda(0)); - else - retval = new octave_matrix (nda); - } - - return retval; -} - -octave_base_value::type_conv_info -octave_char_matrix_str::numeric_conversion_function (void) const -{ - return octave_base_value::type_conv_info (default_numeric_conversion_function, - octave_matrix::static_type_id ()); -} - -octave_value -octave_char_matrix_str::do_index_op_internal (const octave_value_list& idx, - bool resize_ok, char type) -{ - octave_value retval; - - octave_idx_type len = idx.length (); - - switch (len) - { - case 0: - retval = octave_value (matrix, type); - break; - - case 1: - { - idx_vector i = idx (0).index_vector (); - - if (! error_state) - retval = octave_value (charNDArray (matrix.index (i, resize_ok)), - type); - } - break; - - case 2: - { - idx_vector i = idx (0).index_vector (); - idx_vector j = idx (1).index_vector (); - - if (! error_state) - retval = octave_value (charNDArray (matrix.index (i, j, resize_ok)), - type); - } - break; - - default: - { - Array idx_vec (dim_vector (len, 1)); - - for (octave_idx_type i = 0; i < len; i++) - idx_vec(i) = idx(i).index_vector (); - - if (! error_state) - retval = octave_value (charNDArray (matrix.index (idx_vec, resize_ok)), - type); - } - break; - } - - return retval; -} - -octave_value -octave_char_matrix_str::resize (const dim_vector& dv, bool fill) const -{ - charNDArray retval (matrix); - if (fill) - retval.resize (dv, 0); - else - retval.resize (dv); - return octave_value (retval, is_sq_string () ? '\'' : '"'); -} - -#define CHAR_MATRIX_CONV(T, INIT, TNAME, FCN) \ - T retval INIT; \ - \ - if (! force_string_conv) \ - gripe_invalid_conversion ("string", TNAME); \ - else \ - { \ - warning_with_id ("Octave:str-to-num", \ - "implicit conversion from %s to %s", \ - "string", TNAME); \ - \ - retval = octave_char_matrix::FCN (); \ - } \ - \ - return retval - -double -octave_char_matrix_str::double_value (bool force_string_conv) const -{ - CHAR_MATRIX_CONV (double, = 0, "real scalar", double_value); -} - -Complex -octave_char_matrix_str::complex_value (bool force_string_conv) const -{ - CHAR_MATRIX_CONV (Complex, = 0, "complex scalar", complex_value); -} - -Matrix -octave_char_matrix_str::matrix_value (bool force_string_conv) const -{ - CHAR_MATRIX_CONV (Matrix, , "real matrix", matrix_value); -} - -ComplexMatrix -octave_char_matrix_str::complex_matrix_value (bool force_string_conv) const -{ - CHAR_MATRIX_CONV (ComplexMatrix, , "complex matrix", complex_matrix_value); -} - -NDArray -octave_char_matrix_str::array_value (bool force_string_conv) const -{ - CHAR_MATRIX_CONV (NDArray, , "real N-d array", array_value); -} - -ComplexNDArray -octave_char_matrix_str::complex_array_value (bool force_string_conv) const -{ - CHAR_MATRIX_CONV (ComplexNDArray, , "complex N-d array", - complex_array_value); -} - -string_vector -octave_char_matrix_str::all_strings (bool) const -{ - string_vector retval; - - if (matrix.ndims () == 2) - { - charMatrix chm = matrix.matrix_value (); - - octave_idx_type n = chm.rows (); - - retval.resize (n); - - for (octave_idx_type i = 0; i < n; i++) - retval[i] = chm.row_as_string (i); - } - else - error ("invalid conversion of charNDArray to string_vector"); - - return retval; -} - -std::string -octave_char_matrix_str::string_value (bool) const -{ - std::string retval; - - if (matrix.ndims () == 2) - { - charMatrix chm = matrix.matrix_value (); - - retval = chm.row_as_string (0); // FIXME??? - } - else - error ("invalid conversion of charNDArray to string"); - - return retval; -} - -Array -octave_char_matrix_str::cellstr_value (void) const -{ - Array retval; - - if (matrix.ndims () == 2) - { - const charMatrix chm = matrix.matrix_value (); - octave_idx_type nr = chm.rows (); - retval.clear (nr, 1); - for (octave_idx_type i = 0; i < nr; i++) - retval.xelem (i) = chm.row_as_string (i); - } - else - error ("cellstr: cannot convert multidimensional arrays"); - - return retval; -} - -void -octave_char_matrix_str::print_raw (std::ostream& os, bool pr_as_read_syntax) const -{ - octave_print_internal (os, matrix, pr_as_read_syntax, - current_print_indent_level (), true); -} - -bool -octave_char_matrix_str::save_ascii (std::ostream& os) -{ - dim_vector d = dims (); - if (d.length () > 2) - { - charNDArray tmp = char_array_value (); - os << "# ndims: " << d.length () << "\n"; - for (int i=0; i < d.length (); i++) - os << " " << d (i); - os << "\n"; - os.write (tmp.fortran_vec (), d.numel ()); - os << "\n"; - } - else - { - // Keep this case, rather than use generic code above for - // backward compatiability. Makes load_ascii much more complex!! - charMatrix chm = char_matrix_value (); - octave_idx_type elements = chm.rows (); - os << "# elements: " << elements << "\n"; - for (octave_idx_type i = 0; i < elements; i++) - { - unsigned len = chm.cols (); - os << "# length: " << len << "\n"; - std::string tstr = chm.row_as_string (i); - const char *tmp = tstr.data (); - if (tstr.length () > len) - panic_impossible (); - os.write (tmp, len); - os << "\n"; - } - } - - return true; -} - -bool -octave_char_matrix_str::load_ascii (std::istream& is) -{ - bool success = true; - - string_vector keywords(3); - - keywords[0] = "ndims"; - keywords[1] = "elements"; - keywords[2] = "length"; - - std::string kw; - int val = 0; - - if (extract_keyword (is, keywords, kw, val, true)) - { - if (kw == "ndims") - { - int mdims = val; - - if (mdims >= 0) - { - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - is >> dv(i); - - if (is) - { - charNDArray tmp(dv); - - if (tmp.is_empty ()) - matrix = tmp; - else - { - char *ftmp = tmp.fortran_vec (); - - skip_preceeding_newline (is); - - if (! is.read (ftmp, dv.numel ()) || !is) - { - error ("load: failed to load string constant"); - success = false; - } - else - matrix = tmp; - } - } - else - { - error ("load: failed to read dimensions"); - success = false; - } - } - else - { - error ("load: failed to extract matrix size"); - success = false; - } - } - else if (kw == "elements") - { - int elements = val; - - if (elements >= 0) - { - // FIXME -- need to be able to get max length - // before doing anything. - - charMatrix chm (elements, 0); - int max_len = 0; - for (int i = 0; i < elements; i++) - { - int len; - if (extract_keyword (is, "length", len) && len >= 0) - { - // Use this instead of a C-style character - // buffer so that we can properly handle - // embedded NUL characters. - charMatrix tmp (1, len); - char *ptmp = tmp.fortran_vec (); - - if (len > 0 && ! is.read (ptmp, len)) - { - error ("load: failed to load string constant"); - success = false; - break; - } - else - { - if (len > max_len) - { - max_len = len; - chm.resize (elements, max_len, 0); - } - - chm.insert (tmp, i, 0); - } - } - else - { - error ("load: failed to extract string length for element %d", - i+1); - success = false; - } - } - - if (! error_state) - matrix = chm; - } - else - { - error ("load: failed to extract number of string elements"); - success = false; - } - } - else if (kw == "length") - { - int len = val; - - if (len >= 0) - { - // This is cruft for backward compatiability, - // but relatively harmless. - - // Use this instead of a C-style character buffer so - // that we can properly handle embedded NUL characters. - charMatrix tmp (1, len); - char *ptmp = tmp.fortran_vec (); - - if (len > 0 && ! is.read (ptmp, len)) - { - error ("load: failed to load string constant"); - } - else - { - if (is) - matrix = tmp; - else - error ("load: failed to load string constant"); - } - } - } - else - panic_impossible (); - } - else - { - error ("load: failed to extract number of rows and columns"); - success = false; - } - - return success; -} - -bool -octave_char_matrix_str::save_binary (std::ostream& os, - bool& /* save_as_floats */) -{ - dim_vector d = dims (); - if (d.length () < 1) - return false; - - // Use negative value for ndims to differentiate with old format!! - int32_t tmp = - d.length (); - os.write (reinterpret_cast (&tmp), 4); - for (int i=0; i < d.length (); i++) - { - tmp = d(i); - os.write (reinterpret_cast (&tmp), 4); - } - - charNDArray m = char_array_value (); - os.write (m.fortran_vec (), d.numel ()); - return true; -} - -bool -octave_char_matrix_str::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format /* fmt */) -{ - int32_t elements; - if (! is.read (reinterpret_cast (&elements), 4)) - return false; - if (swap) - swap_bytes<4> (&elements); - - if (elements < 0) - { - int32_t mdims = - elements; - int32_t di; - dim_vector dv; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - { - if (! is.read (reinterpret_cast (&di), 4)) - return false; - if (swap) - swap_bytes<4> (&di); - dv(i) = di; - } - - // Convert an array with a single dimension to be a row vector. - // Octave should never write files like this, other software - // might. - - if (mdims == 1) - { - mdims = 2; - dv.resize (mdims); - dv(1) = dv(0); - dv(0) = 1; - } - - charNDArray m(dv); - char *tmp = m.fortran_vec (); - is.read (tmp, dv.numel ()); - - if (error_state || ! is) - return false; - matrix = m; - } - else - { - charMatrix chm (elements, 0); - int max_len = 0; - for (int i = 0; i < elements; i++) - { - int32_t len; - if (! is.read (reinterpret_cast (&len), 4)) - return false; - if (swap) - swap_bytes<4> (&len); - charMatrix btmp (1, len); - char *pbtmp = btmp.fortran_vec (); - if (! is.read (pbtmp, len)) - return false; - if (len > max_len) - { - max_len = len; - chm.resize (elements, max_len, 0); - } - chm.insert (btmp, i, 0); - } - matrix = chm; - } - return true; -} - -#if defined (HAVE_HDF5) - -bool -octave_char_matrix_str::save_hdf5 (hid_t loc_id, const char *name, - bool /* save_as_floats */) -{ - dim_vector dv = dims (); - int empty = save_hdf5_empty (loc_id, name, dv); - if (empty) - return (empty > 0); - - int rank = dv.length (); - hid_t space_hid = -1, data_hid = -1; - bool retval = true; - charNDArray m = char_array_value (); - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - - // Octave uses column-major, while HDF5 uses row-major ordering - for (int i = 0; i < rank; i++) - hdims[i] = dv (rank-i-1); - - space_hid = H5Screate_simple (rank, hdims, 0); - if (space_hid < 0) - return false; -#if HAVE_HDF5_18 - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_CHAR, space_hid, - H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Dcreate (loc_id, name, H5T_NATIVE_CHAR, space_hid, - H5P_DEFAULT); -#endif - if (data_hid < 0) - { - H5Sclose (space_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (char, s, dv.numel ()); - - for (int i = 0; i < dv.numel (); ++i) - s[i] = m(i); - - retval = H5Dwrite (data_hid, H5T_NATIVE_CHAR, H5S_ALL, H5S_ALL, - H5P_DEFAULT, s) >= 0; - - H5Dclose (data_hid); - H5Sclose (space_hid); - - return retval; -} - -bool -octave_char_matrix_str::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; - - dim_vector dv; - int empty = load_hdf5_empty (loc_id, name, dv); - if (empty > 0) - matrix.resize (dv); - if (empty) - return (empty > 0); - -#if HAVE_HDF5_18 - hid_t data_hid = H5Dopen (loc_id, name, H5P_DEFAULT); -#else - hid_t data_hid = H5Dopen (loc_id, name); -#endif - hid_t space_hid = H5Dget_space (data_hid); - hsize_t rank = H5Sget_simple_extent_ndims (space_hid); - hid_t type_hid = H5Dget_type (data_hid); - hid_t type_class_hid = H5Tget_class (type_hid); - - if (type_class_hid == H5T_INTEGER) - { - if (rank < 1) - { - H5Tclose (type_hid); - H5Sclose (space_hid); - H5Dclose (data_hid); - return false; - } - - OCTAVE_LOCAL_BUFFER (hsize_t, hdims, rank); - OCTAVE_LOCAL_BUFFER (hsize_t, maxdims, rank); - - H5Sget_simple_extent_dims (space_hid, hdims, maxdims); - - // Octave uses column-major, while HDF5 uses row-major ordering - if (rank == 1) - { - dv.resize (2); - dv(0) = 1; - dv(1) = hdims[0]; - } - else - { - dv.resize (rank); - for (hsize_t i = 0, j = rank - 1; i < rank; i++, j--) - dv(j) = hdims[i]; - } - - charNDArray m (dv); - char *str = m.fortran_vec (); - if (H5Dread (data_hid, H5T_NATIVE_CHAR, H5S_ALL, H5S_ALL, - H5P_DEFAULT, str) >= 0) - { - retval = true; - matrix = m; - } - - H5Tclose (type_hid); - H5Sclose (space_hid); - H5Dclose (data_hid); - return true; - } - else - { - // This is cruft for backward compatiability and easy data - // importation - if (rank == 0) - { - // a single string: - int slen = H5Tget_size (type_hid); - if (slen < 0) - { - H5Tclose (type_hid); - H5Sclose (space_hid); - H5Dclose (data_hid); - return false; - } - else - { - OCTAVE_LOCAL_BUFFER (char, s, slen); - // create datatype for (null-terminated) string - // to read into: - hid_t st_id = H5Tcopy (H5T_C_S1); - H5Tset_size (st_id, slen); - if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, s) < 0) - { - H5Tclose (st_id); - H5Tclose (type_hid); - H5Sclose (space_hid); - H5Dclose (data_hid); - return false; - } - - matrix = charMatrix (s); - - H5Tclose (st_id); - H5Tclose (type_hid); - H5Sclose (space_hid); - H5Dclose (data_hid); - return true; - } - } - else if (rank == 1) - { - // string vector - hsize_t elements, maxdim; - H5Sget_simple_extent_dims (space_hid, &elements, &maxdim); - int slen = H5Tget_size (type_hid); - if (slen < 0) - { - H5Tclose (type_hid); - H5Sclose (space_hid); - H5Dclose (data_hid); - return false; - } - else - { - // hdf5 string arrays store strings of all the - // same physical length (I think), which is - // slightly wasteful, but oh well. - - OCTAVE_LOCAL_BUFFER (char, s, elements * slen); - - // create datatype for (null-terminated) string - // to read into: - hid_t st_id = H5Tcopy (H5T_C_S1); - H5Tset_size (st_id, slen); - - if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, s) < 0) - { - H5Tclose (st_id); - H5Tclose (type_hid); - H5Sclose (space_hid); - H5Dclose (data_hid); - return false; - } - - charMatrix chm (elements, slen - 1); - for (hsize_t i = 0; i < elements; ++i) - { - chm.insert (s + i*slen, i, 0); - } - - matrix = chm; - - H5Tclose (st_id); - H5Tclose (type_hid); - H5Sclose (space_hid); - H5Dclose (data_hid); - return true; - } - } - else - { - H5Tclose (type_hid); - H5Sclose (space_hid); - H5Dclose (data_hid); - return false; - } - } - - return retval; -} - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-str-mat.h --- a/src/ov-str-mat.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,257 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_char_matrix_str_h) -#define octave_char_matrix_str_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-stream.h" -#include "ov.h" -#include "ov-ch-mat.h" -#include "ov-re-mat.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// Character matrix values with special properties for use as -// strings. - -class -OCTINTERP_API -octave_char_matrix_str : public octave_char_matrix -{ -public: - - octave_char_matrix_str (void) - : octave_char_matrix () { } - - octave_char_matrix_str (const charMatrix& chm) - : octave_char_matrix (chm) { } - - octave_char_matrix_str (const charNDArray& chm) - : octave_char_matrix (chm) { } - - octave_char_matrix_str (const Array& chm) - : octave_char_matrix (chm) { } - - octave_char_matrix_str (char c) - : octave_char_matrix (c) { } - - octave_char_matrix_str (const char *s) - : octave_char_matrix (s) { } - - octave_char_matrix_str (const std::string& s) - : octave_char_matrix (s) { } - - octave_char_matrix_str (const string_vector& s) - : octave_char_matrix (s) { } - - octave_char_matrix_str (const octave_char_matrix& chm) - : octave_char_matrix (chm) { } - - octave_char_matrix_str (const octave_char_matrix_str& chms) - : octave_char_matrix (chms) { } - - ~octave_char_matrix_str (void) { } - - octave_base_value *clone (void) const { return new octave_char_matrix_str (*this); } - octave_base_value *empty_clone (void) const { return new octave_char_matrix_str (); } - - type_conv_info numeric_conversion_function (void) const; - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false) - { return do_index_op_internal (idx, resize_ok); } - - octave_value squeeze (void) const - { return octave_value (charNDArray (matrix.squeeze ())); } - - octave_value reshape (const dim_vector& new_dims) const - { return octave_value (charNDArray (matrix.reshape (new_dims))); } - - octave_value permute (const Array& vec, bool inv = false) const - { return octave_value (charNDArray (matrix.permute (vec, inv))); } - - octave_value resize (const dim_vector& dv, bool fill = false) const; - - octave_value diag (octave_idx_type k = 0) const - { return octave_value (matrix.diag (k)); } - - bool is_string (void) const { return true; } - - bool is_numeric_type (void) const { return false; } - - double double_value (bool = false) const; - - Matrix matrix_value (bool = false) const; - - NDArray array_value (bool = false) const; - - Complex complex_value (bool = false) const; - - ComplexMatrix complex_matrix_value (bool = false) const; - - ComplexNDArray complex_array_value (bool = false) const; - - string_vector all_strings (bool pad = false) const; - - std::string string_value (bool force = false) const; - - Array cellstr_value (void) const; - - octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const - { return octave_value (matrix.sort (dim, mode)); } - - octave_value sort (Array &sidx, octave_idx_type dim = 0, - sortmode mode = ASCENDING) const - { return octave_value (matrix.sort (sidx, dim, mode)); } - - bool print_as_scalar (void) const { return (rows () <= 1); } - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const - { return os.write (matrix, block_size, output_type, skip, flt_fmt); } - -protected: - - octave_value do_index_op_internal (const octave_value_list& idx, - bool resize_ok, char type = '"'); - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -typedef octave_char_matrix_str octave_char_matrix_dq_str; - -class -octave_char_matrix_sq_str : public octave_char_matrix_str -{ -public: - - octave_char_matrix_sq_str (void) - : octave_char_matrix_str () { } - - octave_char_matrix_sq_str (const charMatrix& chm) - : octave_char_matrix_str (chm) { } - - octave_char_matrix_sq_str (const charNDArray& chm) - : octave_char_matrix_str (chm) { } - - octave_char_matrix_sq_str (const Array& chm) - : octave_char_matrix_str (chm) { } - - octave_char_matrix_sq_str (char c) - : octave_char_matrix_str (c) { } - - octave_char_matrix_sq_str (const char *s) - : octave_char_matrix_str (s) { } - - octave_char_matrix_sq_str (const std::string& s) - : octave_char_matrix_str (s) { } - - octave_char_matrix_sq_str (const string_vector& s) - : octave_char_matrix_str (s) { } - - octave_char_matrix_sq_str (const octave_char_matrix_str& chm) - : octave_char_matrix_str (chm) { } - - octave_char_matrix_sq_str (const octave_char_matrix_sq_str& chms) - : octave_char_matrix_str (chms) { } - - ~octave_char_matrix_sq_str (void) { } - - octave_base_value *clone (void) const { return new octave_char_matrix_sq_str (*this); } - octave_base_value *empty_clone (void) const { return new octave_char_matrix_sq_str (); } - - octave_value squeeze (void) const - { return octave_value (charNDArray (matrix.squeeze ()), '\''); } - - octave_value reshape (const dim_vector& new_dims) const - { return octave_value (charNDArray (matrix.reshape (new_dims)), '\''); } - - octave_value permute (const Array& vec, bool inv = false) const - { return octave_value (charNDArray (matrix.permute (vec, inv)), '\''); } - - octave_value resize (const dim_vector& dv, bool = false) const - { - charNDArray retval (matrix); - retval.resize (dv); - return octave_value (retval, '\''); - } - - octave_value diag (octave_idx_type k = 0) const - { return octave_value (matrix.diag (k), '\''); } - - bool is_sq_string (void) const { return true; } - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false) - { return do_index_op_internal (idx, resize_ok, '\''); } - - - octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const - { return octave_value (matrix.sort (dim, mode), '\''); } - - octave_value sort (Array &sidx, octave_idx_type dim = 0, - sortmode mode = ASCENDING) const - { return octave_value (matrix.sort (sidx, dim, mode), '\''); } - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-struct.cc --- a/src/ov-struct.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2235 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "oct-lvalue.h" -#include "ov-struct.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -#include "Array-util.h" -#include "oct-locbuf.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-oct-binary.h" -#include "ls-hdf5.h" -#include "ls-utils.h" -#include "pr-output.h" - -DEFINE_OCTAVE_ALLOCATOR(octave_struct); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA(octave_struct, "struct", "struct"); - -// How many levels of structure elements should we print? -static int Vstruct_levels_to_print = 2; - -// TRUE means print struct array contents, up to the number of levels -// specified by struct_levels_to_print. -static bool Vprint_struct_array_contents = false; - -octave_base_value * -octave_struct::try_narrowing_conversion (void) -{ - octave_base_value *retval = 0; - - if (numel () == 1) - retval = new octave_scalar_struct (map.checkelem (0)); - - return retval; -} - -Cell -octave_struct::dotref (const octave_value_list& idx, bool auto_add) -{ - Cell retval; - - assert (idx.length () == 1); - - std::string nm = idx(0).string_value (); - - octave_map::const_iterator p = map.seek (nm); - - if (p != map.end ()) - retval = map.contents (p); - else if (auto_add) - retval = (numel () == 0) ? Cell (dim_vector (1, 1)) : Cell (dims ()); - else - error ("structure has no member `%s'", nm.c_str ()); - - return retval; -} - -#if 0 -static void -gripe_invalid_index1 (void) -{ - error ("invalid index for structure array"); -} -#endif - -static void -gripe_invalid_index_for_assignment (void) -{ - error ("invalid index for structure array assignment"); -} - -static void -gripe_invalid_index_type (const std::string& nm, char t) -{ - error ("%s cannot be indexed with %c", nm.c_str (), t); -} - -static void -gripe_failed_assignment (void) -{ - error ("assignment to structure element failed"); -} - -octave_value_list -octave_struct::subsref (const std::string& type, - const std::list& idx, - int nargout) -{ - octave_value_list retval; - - int skip = 1; - - switch (type[0]) - { - case '(': - { - if (type.length () > 1 && type[1] == '.') - { - std::list::const_iterator p = idx.begin (); - octave_value_list key_idx = *++p; - - const Cell tmp = dotref (key_idx); - - if (! error_state) - { - const Cell t = tmp.index (idx.front ()); - - retval(0) = (t.length () == 1) ? t(0) : octave_value (t, true); - - // We handled two index elements, so tell - // next_subsref to skip both of them. - - skip++; - } - } - else - retval(0) = do_index_op (idx.front ()); - } - break; - - case '.': - { - if (map.numel () > 0) - { - const Cell t = dotref (idx.front ()); - - retval(0) = (t.length () == 1) ? t(0) : octave_value (t, true); - } - } - break; - - case '{': - gripe_invalid_index_type (type_name (), type[0]); - break; - - default: - panic_impossible (); - } - - // FIXME -- perhaps there should be an - // octave_value_list::next_subsref member function? See also - // octave_user_function::subsref. - - if (idx.size () > 1) - retval = retval(0).next_subsref (nargout, type, idx, skip); - - return retval; -} - -octave_value -octave_struct::subsref (const std::string& type, - const std::list& idx, - bool auto_add) -{ - octave_value retval; - - int skip = 1; - - switch (type[0]) - { - case '(': - { - if (type.length () > 1 && type[1] == '.') - { - std::list::const_iterator p = idx.begin (); - octave_value_list key_idx = *++p; - - const Cell tmp = dotref (key_idx, auto_add); - - if (! error_state) - { - const Cell t = tmp.index (idx.front (), auto_add); - - retval = (t.length () == 1) ? t(0) : octave_value (t, true); - - // We handled two index elements, so tell - // next_subsref to skip both of them. - - skip++; - } - } - else - retval = do_index_op (idx.front (), auto_add); - } - break; - - case '.': - { - if (map.numel () > 0) - { - const Cell t = dotref (idx.front (), auto_add); - - retval = (t.length () == 1) ? t(0) : octave_value (t, true); - } - } - break; - - case '{': - gripe_invalid_index_type (type_name (), type[0]); - break; - - default: - panic_impossible (); - } - - // FIXME -- perhaps there should be an - // octave_value_list::next_subsref member function? See also - // octave_user_function::subsref. - - if (idx.size () > 1) - retval = retval.next_subsref (auto_add, type, idx, skip); - - return retval; -} - -/* -%!test -%! x(1).a.a = 1; -%! x(2).a.a = 2; -%! assert (size (x), [1, 2]); -%! assert (x(1).a.a, 1); -%! assert (x(2).a.a, 2); -*/ - -octave_value -octave_struct::numeric_conv (const octave_value& val, - const std::string& type) -{ - octave_value retval; - - if (type.length () > 0 && type[0] == '.' && ! val.is_map ()) - retval = octave_map (); - else - retval = val; - - return retval; -} - -octave_value -octave_struct::subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - octave_value retval; - - int n = type.length (); - - octave_value t_rhs = rhs; - - if (idx.front ().empty ()) - { - error ("missing index in indexed assignment"); - return retval; - } - - if (n > 1 && ! (type.length () == 2 && type[0] == '(' && type[1] == '.')) - { - switch (type[0]) - { - case '(': - { - if (type.length () > 1 && type[1] == '.') - { - std::list::const_iterator p = idx.begin (); - octave_value_list t_idx = *p; - - octave_value_list key_idx = *++p; - - assert (key_idx.length () == 1); - - std::string key = key_idx(0).string_value (); - - std::list next_idx (idx); - - // We handled two index elements, so subsasgn to - // needs to skip both of them. - - next_idx.erase (next_idx.begin ()); - next_idx.erase (next_idx.begin ()); - - std::string next_type = type.substr (2); - - Cell tmpc (1, 1); - octave_map::iterator pkey = map.seek (key); - if (pkey != map.end ()) - { - map.contents (pkey).make_unique (); - tmpc = map.contents (pkey).index (idx.front (), true); - } - - // FIXME: better code reuse? cf. octave_cell::subsasgn and the case below. - if (! error_state) - { - if (tmpc.numel () == 1) - { - octave_value& tmp = tmpc(0); - - bool orig_undefined = tmp.is_undefined (); - - if (orig_undefined || tmp.is_zero_by_zero ()) - { - tmp = octave_value::empty_conv (next_type, rhs); - tmp.make_unique (); // probably a no-op. - } - else - // optimization: ignore the copy still stored inside our map. - tmp.make_unique (1); - - if (! error_state) - t_rhs = (orig_undefined - ? tmp.undef_subsasgn (next_type, next_idx, rhs) - : tmp.subsasgn (next_type, next_idx, rhs)); - } - else - gripe_indexed_cs_list (); - } - } - else - gripe_invalid_index_for_assignment (); - } - break; - - case '.': - { - octave_value_list key_idx = idx.front (); - - assert (key_idx.length () == 1); - - std::string key = key_idx(0).string_value (); - - std::list next_idx (idx); - - next_idx.erase (next_idx.begin ()); - - std::string next_type = type.substr (1); - - Cell tmpc (1, 1); - octave_map::iterator pkey = map.seek (key); - if (pkey != map.end ()) - { - map.contents (pkey).make_unique (); - tmpc = map.contents (pkey); - } - - // FIXME: better code reuse? - if (! error_state) - { - if (tmpc.numel () == 1) - { - octave_value& tmp = tmpc(0); - - bool orig_undefined = tmp.is_undefined (); - - if (orig_undefined || tmp.is_zero_by_zero ()) - { - tmp = octave_value::empty_conv (next_type, rhs); - tmp.make_unique (); // probably a no-op. - } - else - // optimization: ignore the copy still stored inside our map. - tmp.make_unique (1); - - if (! error_state) - t_rhs = (orig_undefined - ? tmp.undef_subsasgn (next_type, next_idx, rhs) - : tmp.subsasgn (next_type, next_idx, rhs)); - } - else - gripe_indexed_cs_list (); - } - } - break; - - case '{': - gripe_invalid_index_type (type_name (), type[0]); - break; - - default: - panic_impossible (); - } - } - - if (! error_state) - { - switch (type[0]) - { - case '(': - { - if (n > 1 && type[1] == '.') - { - std::list::const_iterator p = idx.begin (); - octave_value_list key_idx = *++p; - octave_value_list idxf = idx.front (); - - assert (key_idx.length () == 1); - - std::string key = key_idx(0).string_value (); - - if (! error_state) - { - if (t_rhs.is_cs_list ()) - { - Cell tmp_cell = Cell (t_rhs.list_value ()); - - // Inquire the proper shape of the RHS. - - dim_vector didx = dims ().redim (idxf.length ()); - for (octave_idx_type k = 0; k < idxf.length (); k++) - if (! idxf(k).is_magic_colon ()) didx(k) = idxf(k).numel (); - - if (didx.numel () == tmp_cell.numel ()) - tmp_cell = tmp_cell.reshape (didx); - - - map.assign (idxf, key, tmp_cell); - - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - else - { - const octave_map& cmap = const_cast (map); - // cast map to const reference to avoid forced key insertion. - if (idxf.all_scalars () - || cmap.contents (key).index (idxf, true).numel () == 1) - { - map.assign (idxf, key, Cell (t_rhs.storable_value ())); - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - else if (! error_state) - gripe_nonbraced_cs_list_assignment (); - } - } - else - gripe_failed_assignment (); - } - else - { - if (t_rhs.is_map () || t_rhs.is_object ()) - { - octave_map rhs_map = t_rhs.map_value (); - - if (! error_state) - { - map.assign (idx.front (), rhs_map); - - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - else - error ("invalid structure assignment"); - } - else - { - if (t_rhs.is_null_value ()) - { - map.delete_elements (idx.front ()); - - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - else - error ("invalid structure assignment"); - } - } - } - break; - - case '.': - { - octave_value_list key_idx = idx.front (); - - assert (key_idx.length () == 1); - - std::string key = key_idx(0).string_value (); - - if (t_rhs.is_cs_list ()) - { - Cell tmp_cell = Cell (t_rhs.list_value ()); - - // The shape of the RHS is irrelevant, we just want - // the number of elements to agree and to preserve the - // shape of the left hand side of the assignment. - - if (numel () == tmp_cell.numel ()) - tmp_cell = tmp_cell.reshape (dims ()); - - map.setfield (key, tmp_cell); - } - else - { - Cell tmp_cell(1, 1); - tmp_cell(0) = t_rhs.storable_value (); - map.setfield (key, tmp_cell); - } - - if (! error_state) - { - count++; - retval = octave_value (this); - } - else - gripe_failed_assignment (); - } - break; - - case '{': - gripe_invalid_index_type (type_name (), type[0]); - break; - - default: - panic_impossible (); - } - } - else - gripe_failed_assignment (); - - retval.maybe_mutate (); - - return retval; -} - -octave_value -octave_struct::do_index_op (const octave_value_list& idx, bool resize_ok) -{ - // octave_map handles indexing itself. - return map.index (idx, resize_ok); -} - -size_t -octave_struct::byte_size (void) const -{ - // Neglect the size of the fieldnames. - - size_t retval = 0; - - for (octave_map::const_iterator p = map.begin (); p != map.end (); p++) - { - std::string key = map.key (p); - - octave_value val = octave_value (map.contents (p)); - - retval += val.byte_size (); - } - - return retval; -} - -void -octave_struct::print (std::ostream& os, bool) const -{ - print_raw (os); -} - -void -octave_struct::print_raw (std::ostream& os, bool) const -{ - unwind_protect frame; - - frame.protect_var (Vstruct_levels_to_print); - - if (Vstruct_levels_to_print >= 0) - { - bool max_depth_reached = Vstruct_levels_to_print-- == 0; - - bool print_fieldnames_only - = (max_depth_reached || ! Vprint_struct_array_contents); - - increment_indent_level (); - - newline (os); - indent (os); - dim_vector dv = dims (); - os << dv.str () << " struct array containing the fields:"; - newline (os); - - increment_indent_level (); - - string_vector key_list = map.fieldnames (); - - for (octave_idx_type i = 0; i < key_list.length (); i++) - { - std::string key = key_list[i]; - - Cell val = map.contents (key); - - newline (os); - - if (print_fieldnames_only) - { - indent (os); - os << key; - } - else - { - octave_value tmp (val); - tmp.print_with_name (os, key); - } - } - - if (print_fieldnames_only) - newline (os); - - decrement_indent_level (); - decrement_indent_level (); - } - else - { - indent (os); - os << ""; - newline (os); - } -} - -bool -octave_struct::print_name_tag (std::ostream& os, const std::string& name) const -{ - bool retval = false; - - indent (os); - - if (Vstruct_levels_to_print < 0) - os << name << " = "; - else - { - os << name << " ="; - newline (os); - retval = true; - } - - return retval; -} - -static bool -scalar (const dim_vector& dims) -{ - return dims.length () == 2 && dims (0) == 1 && dims (1) == 1; -} - - -bool -octave_struct::save_ascii (std::ostream& os) -{ - octave_map m = map_value (); - - octave_idx_type nf = m.nfields (); - - const dim_vector dv = dims (); - - os << "# ndims: " << dv.length () << "\n"; - - for (int i = 0; i < dv.length (); i++) - os << " " << dv (i); - os << "\n"; - - os << "# length: " << nf << "\n"; - - // Iterating over the list of keys will preserve the order of the - // fields. - string_vector keys = m.fieldnames (); - - for (octave_idx_type i = 0; i < nf; i++) - { - std::string key = keys(i); - - octave_value val = map.contents (key); - - bool b = save_ascii_data (os, val, key, false, 0); - - if (! b) - return os; - } - - return true; -} - -bool -octave_struct::load_ascii (std::istream& is) -{ - octave_idx_type len = 0; - dim_vector dv (1, 1); - bool success = true; - - // KLUGE: earlier Octave versions did not save extra dimensions with struct, - // and as a result did not preserve dimensions for empty structs. - // The default dimensions were 1x1, which we want to preserve. - string_vector keywords(2); - - keywords[0] = "ndims"; - keywords[1] = "length"; - - std::string kw; - - if (extract_keyword (is, keywords, kw, len, true)) - { - if (kw == keywords[0]) - { - int mdims = std::max (static_cast (len), 2); - dv.resize (mdims); - for (int i = 0; i < mdims; i++) - is >> dv(i); - - success = extract_keyword (is, keywords[1], len); - } - } - else - success = false; - - if (success && len >= 0) - { - if (len > 0) - { - octave_map m (dv); - - for (octave_idx_type j = 0; j < len; j++) - { - octave_value t2; - bool dummy; - - // recurse to read cell elements - std::string nm - = read_ascii_data (is, std::string (), dummy, t2, j); - - if (!is) - break; - - Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); - - if (error_state) - { - error ("load: internal error loading struct elements"); - return false; - } - - m.setfield (nm, tcell); - } - - if (is) - map = m; - else - { - error ("load: failed to load structure"); - success = false; - } - } - else if (len == 0 ) - map = octave_map (dv); - else - panic_impossible (); - } - else { - error ("load: failed to extract number of elements in structure"); - success = false; - } - - return success; -} - -bool -octave_struct::save_binary (std::ostream& os, bool& save_as_floats) -{ - octave_map m = map_value (); - - octave_idx_type nf = m.nfields (); - - dim_vector d = dims (); - if (d.length () < 1) - return false; - - // Use negative value for ndims - int32_t di = - d.length (); - os.write (reinterpret_cast (&di), 4); - for (int i = 0; i < d.length (); i++) - { - di = d(i); - os.write (reinterpret_cast (&di), 4); - } - - int32_t len = nf; - os.write (reinterpret_cast (&len), 4); - - // Iterating over the list of keys will preserve the order of the - // fields. - string_vector keys = m.fieldnames (); - - for (octave_idx_type i = 0; i < nf; i++) - { - std::string key = keys(i); - - octave_value val = map.contents (key); - - bool b = save_binary_data (os, val, key, "", 0, save_as_floats); - - if (! b) - return os; - } - - return true; -} - -bool -octave_struct::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - bool success = true; - int32_t len; - if (! is.read (reinterpret_cast (&len), 4)) - return false; - if (swap) - swap_bytes<4> (&len); - - dim_vector dv (1, 1); - - if (len < 0) - { - // We have explicit dimensions. - int mdims = -len; - - int32_t di; - dv.resize (mdims); - - for (int i = 0; i < mdims; i++) - { - if (! is.read (reinterpret_cast (&di), 4)) - return false; - if (swap) - swap_bytes<4> (&di); - dv(i) = di; - } - - if (! is.read (reinterpret_cast (&len), 4)) - return false; - if (swap) - swap_bytes<4> (&len); - } - - if (len > 0) - { - octave_map m (dv); - - for (octave_idx_type j = 0; j < len; j++) - { - octave_value t2; - bool dummy; - std::string doc; - - // recurse to read cell elements - std::string nm = read_binary_data (is, swap, fmt, std::string (), - dummy, t2, doc); - - if (!is) - break; - - Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); - - if (error_state) - { - error ("load: internal error loading struct elements"); - return false; - } - - m.setfield (nm, tcell); - } - - if (is) - map = m; - else - { - error ("load: failed to load structure"); - success = false; - } - } - else if (len == 0) - map = octave_map (dv); - else - success = false; - - return success; -} - -#if defined (HAVE_HDF5) - -bool -octave_struct::save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) -{ - hid_t data_hid = -1; - -#if HAVE_HDF5_18 - data_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Gcreate (loc_id, name, 0); -#endif - if (data_hid < 0) return false; - - // recursively add each element of the structure to this group - octave_map m = map_value (); - - octave_idx_type nf = m.nfields (); - - // Iterating over the list of keys will preserve the order of the - // fields. - string_vector keys = m.fieldnames (); - - for (octave_idx_type i = 0; i < nf; i++) - { - std::string key = keys(i); - - octave_value val = map.contents (key); - - bool retval2 = add_hdf5_data (data_hid, val, key, "", false, - save_as_floats); - - if (! retval2) - break; - } - - H5Gclose (data_hid); - - return true; -} - -bool -octave_struct::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; - - hdf5_callback_data dsub; - - herr_t retval2 = 0; - octave_map m (dim_vector (1, 1)); - int current_item = 0; - hsize_t num_obj = 0; -#if HAVE_HDF5_18 - hid_t group_id = H5Gopen (loc_id, name, H5P_DEFAULT); -#else - hid_t group_id = H5Gopen (loc_id, name); -#endif - H5Gget_num_objs (group_id, &num_obj); - H5Gclose (group_id); - - // FIXME -- fields appear to be sorted alphabetically on loading. - // Why is that happening? - - while (current_item < static_cast (num_obj) - && (retval2 = H5Giterate (loc_id, name, ¤t_item, - hdf5_read_next_data, &dsub)) > 0) - { - octave_value t2 = dsub.tc; - - Cell tcell = t2.is_cell () ? t2.cell_value () : Cell (t2); - - if (error_state) - { - error ("load: internal error loading struct elements"); - return false; - } - - m.setfield (dsub.name, tcell); - - } - - if (retval2 >= 0) - { - map = m; - retval = true; - } - - return retval; -} - -#endif - -mxArray * -octave_struct::as_mxArray (void) const -{ - int nf = nfields (); - string_vector kv = map_keys (); - - OCTAVE_LOCAL_BUFFER (const char *, f, nf); - - for (int i = 0; i < nf; i++) - f[i] = kv[i].c_str (); - - mxArray *retval = new mxArray (dims (), nf, f); - - mxArray **elts = static_cast (retval->get_data ()); - - mwSize nel = numel (); - - mwSize ntot = nf * nel; - - for (int i = 0; i < nf; i++) - { - Cell c = map.contents (kv[i]); - - const octave_value *p = c.data (); - - mwIndex k = 0; - for (mwIndex j = i; j < ntot; j += nf) - elts[j] = new mxArray (p[k++]); - } - - return retval; -} - -octave_value -octave_struct::fast_elem_extract (octave_idx_type n) const -{ - if (n < map.numel ()) - return map.checkelem (n); - else - return octave_value (); -} - -bool -octave_struct::fast_elem_insert (octave_idx_type n, - const octave_value& x) -{ - bool retval = false; - - if (n < map.numel ()) - { - // To avoid copying the scalar struct, it just stores a pointer to - // itself. - const octave_scalar_map *sm_ptr; - void *here = reinterpret_cast(&sm_ptr); - return (x.get_rep ().fast_elem_insert_self (here, btyp_struct) - && map.fast_elem_insert (n, *sm_ptr)); - } - - return retval; -} -DEFINE_OCTAVE_ALLOCATOR(octave_scalar_struct); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA(octave_scalar_struct, "scalar struct", "struct"); - -octave_value -octave_scalar_struct::dotref (const octave_value_list& idx, bool auto_add) -{ - assert (idx.length () == 1); - - std::string nm = idx(0).string_value (); - - octave_value retval = map.getfield (nm); - - if (! auto_add && retval.is_undefined ()) - error ("structure has no member `%s'", nm.c_str ()); - - return retval; -} - -octave_value -octave_scalar_struct::subsref (const std::string& type, - const std::list& idx) -{ - octave_value retval; - - if (type[0] == '.') - { - int skip = 1; - - retval = dotref (idx.front ()); - - if (idx.size () > 1) - retval = retval.next_subsref (type, idx, skip); - } - else - retval = to_array ().subsref (type, idx); - - return retval; -} - -octave_value_list -octave_scalar_struct::subsref (const std::string& type, - const std::list& idx, - int nargout) -{ - octave_value_list retval; - - if (type[0] == '.') - { - int skip = 1; - - retval(0) = dotref (idx.front ()); - - if (idx.size () > 1) - retval = retval(0).next_subsref (nargout, type, idx, skip); - } - else - retval = to_array ().subsref (type, idx, nargout); - - return retval; -} - -octave_value -octave_scalar_struct::subsref (const std::string& type, - const std::list& idx, - bool auto_add) -{ - octave_value retval; - - if (type[0] == '.') - { - int skip = 1; - - retval = dotref (idx.front (), auto_add); - - if (idx.size () > 1) - retval = retval.next_subsref (auto_add, type, idx, skip); - } - else - retval = to_array ().subsref (type, idx, auto_add); - - return retval; -} - -/* -%!test -%! x(1).a.a = 1; -%! x(2).a.a = 2; -%! assert (size (x), [1, 2]); -%! assert (x(1).a.a, 1); -%! assert (x(2).a.a, 2); -*/ - -octave_value -octave_scalar_struct::numeric_conv (const octave_value& val, - const std::string& type) -{ - octave_value retval; - - if (type.length () > 0 && type[0] == '.' && ! val.is_map ()) - retval = octave_map (); - else - retval = val; - - return retval; -} - -octave_value -octave_scalar_struct::subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - octave_value retval; - - if (idx.front ().empty ()) - { - error ("missing index in indexed assignment"); - return retval; - } - - if (type[0] == '.') - { - int n = type.length (); - - octave_value t_rhs = rhs; - - octave_value_list key_idx = idx.front (); - - assert (key_idx.length () == 1); - - std::string key = key_idx(0).string_value (); - - if (n > 1) - { - std::list next_idx (idx); - - next_idx.erase (next_idx.begin ()); - - std::string next_type = type.substr (1); - - octave_value tmp; - octave_map::iterator pkey = map.seek (key); - if (pkey != map.end ()) - { - map.contents (pkey).make_unique (); - tmp = map.contents (pkey); - } - - if (! error_state) - { - bool orig_undefined = tmp.is_undefined (); - - if (orig_undefined || tmp.is_zero_by_zero ()) - { - tmp = octave_value::empty_conv (next_type, rhs); - tmp.make_unique (); // probably a no-op. - } - else - // optimization: ignore the copy still stored inside our map. - tmp.make_unique (1); - - if (! error_state) - t_rhs = (orig_undefined - ? tmp.undef_subsasgn (next_type, next_idx, rhs) - : tmp.subsasgn (next_type, next_idx, rhs)); - } - } - - if (! error_state) - map.setfield (key, t_rhs.storable_value ()); - else - gripe_failed_assignment (); - - count++; - retval = this; - } - else - { - // Forward this case to octave_struct. - octave_value tmp (new octave_struct (octave_map (map))); - retval = tmp.subsasgn (type, idx, rhs); - } - - return retval; -} - -octave_value -octave_scalar_struct::do_index_op (const octave_value_list& idx, bool resize_ok) -{ - // octave_map handles indexing itself. - return octave_map (map).index (idx, resize_ok); -} - -size_t -octave_scalar_struct::byte_size (void) const -{ - // Neglect the size of the fieldnames. - - size_t retval = 0; - - for (octave_map::const_iterator p = map.begin (); p != map.end (); p++) - { - std::string key = map.key (p); - - octave_value val = octave_value (map.contents (p)); - - retval += val.byte_size (); - } - - return retval; -} - -void -octave_scalar_struct::print (std::ostream& os, bool) const -{ - print_raw (os); -} - -void -octave_scalar_struct::print_raw (std::ostream& os, bool) const -{ - unwind_protect frame; - - frame.protect_var (Vstruct_levels_to_print); - - if (Vstruct_levels_to_print >= 0) - { - bool max_depth_reached = Vstruct_levels_to_print-- == 0; - - bool print_fieldnames_only = max_depth_reached; - - increment_indent_level (); - - if (! Vcompact_format) - newline (os); - - indent (os); - os << "scalar structure containing the fields:"; - newline (os); - if (! Vcompact_format) - newline (os); - - increment_indent_level (); - - string_vector key_list = map.fieldnames (); - - for (octave_idx_type i = 0; i < key_list.length (); i++) - { - std::string key = key_list[i]; - - octave_value val = map.contents (key); - - if (print_fieldnames_only) - { - indent (os); - os << key; - dim_vector dv = val.dims (); - os << ": " << dv.str () << " " << val.type_name (); - newline (os); - } - else - val.print_with_name (os, key); - } - - decrement_indent_level (); - decrement_indent_level (); - } - else - { - indent (os); - os << ""; - newline (os); - } -} - -bool -octave_scalar_struct::print_name_tag (std::ostream& os, const std::string& name) const -{ - bool retval = false; - - indent (os); - - if (Vstruct_levels_to_print < 0) - os << name << " = "; - else - { - os << name << " ="; - newline (os); - retval = true; - } - - return retval; -} - -bool -octave_scalar_struct::save_ascii (std::ostream& os) -{ - octave_map m = map_value (); - - octave_idx_type nf = m.nfields (); - - const dim_vector dv = dims (); - - os << "# ndims: " << dv.length () << "\n"; - - for (int i = 0; i < dv.length (); i++) - os << " " << dv (i); - os << "\n"; - - os << "# length: " << nf << "\n"; - - // Iterating over the list of keys will preserve the order of the - // fields. - string_vector keys = m.fieldnames (); - - for (octave_idx_type i = 0; i < nf; i++) - { - std::string key = keys(i); - - octave_value val = map.contents (key); - - bool b = save_ascii_data (os, val, key, false, 0); - - if (! b) - return os; - } - - return true; -} - -bool -octave_scalar_struct::load_ascii (std::istream& is) -{ - bool success = true; - octave_idx_type len = 0; - - if (extract_keyword (is, "length", len) && len >= 0) - { - if (len > 0) - { - octave_scalar_map m; - - for (octave_idx_type j = 0; j < len; j++) - { - octave_value t2; - bool dummy; - - // recurse to read cell elements - std::string nm - = read_ascii_data (is, std::string (), dummy, t2, j); - - if (!is) - break; - - if (error_state) - { - error ("load: internal error loading struct elements"); - return false; - } - - m.setfield (nm, t2); - } - - if (is) - map = m; - else - { - error ("load: failed to load structure"); - success = false; - } - } - else if (len == 0) - map = octave_scalar_map (); - else - panic_impossible (); - } - else { - error ("load: failed to extract number of elements in structure"); - success = false; - } - - return success; -} - -bool -octave_scalar_struct::save_binary (std::ostream& os, bool& save_as_floats) -{ - octave_map m = map_value (); - - octave_idx_type nf = m.nfields (); - - int32_t len = nf; - os.write (reinterpret_cast (&len), 4); - - // Iterating over the list of keys will preserve the order of the - // fields. - string_vector keys = m.fieldnames (); - - for (octave_idx_type i = 0; i < nf; i++) - { - std::string key = keys(i); - - octave_value val = map.contents (key); - - bool b = save_binary_data (os, val, key, "", 0, save_as_floats); - - if (! b) - return os; - } - - return true; -} - -bool -octave_scalar_struct::load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) -{ - bool success = true; - int32_t len; - if (! is.read (reinterpret_cast (&len), 4)) - return false; - if (swap) - swap_bytes<4> (&len); - - dim_vector dv (1, 1); - - if (len > 0) - { - octave_scalar_map m; - - for (octave_idx_type j = 0; j < len; j++) - { - octave_value t2; - bool dummy; - std::string doc; - - // recurse to read cell elements - std::string nm = read_binary_data (is, swap, fmt, std::string (), - dummy, t2, doc); - - if (!is) - break; - - if (error_state) - { - error ("load: internal error loading struct elements"); - return false; - } - - m.setfield (nm, t2); - } - - if (is) - map = m; - else - { - error ("load: failed to load structure"); - success = false; - } - } - else if (len == 0) - map = octave_scalar_map (); - else - success = false; - - return success; -} - -#if defined (HAVE_HDF5) - -bool -octave_scalar_struct::save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) -{ - hid_t data_hid = -1; - -#if HAVE_HDF5_18 - data_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT); -#else - data_hid = H5Gcreate (loc_id, name, 0); -#endif - if (data_hid < 0) return false; - - // recursively add each element of the structure to this group - octave_scalar_map m = scalar_map_value (); - - octave_idx_type nf = m.nfields (); - - // Iterating over the list of keys will preserve the order of the - // fields. - string_vector keys = m.fieldnames (); - - for (octave_idx_type i = 0; i < nf; i++) - { - std::string key = keys(i); - - octave_value val = map.contents (key); - - bool retval2 = add_hdf5_data (data_hid, val, key, "", false, - save_as_floats); - - if (! retval2) - break; - } - - H5Gclose (data_hid); - - return true; -} - -bool -octave_scalar_struct::load_hdf5 (hid_t loc_id, const char *name) -{ - bool retval = false; - - hdf5_callback_data dsub; - - herr_t retval2 = 0; - octave_scalar_map m; - int current_item = 0; - hsize_t num_obj = 0; -#if HAVE_HDF5_18 - hid_t group_id = H5Gopen (loc_id, name, H5P_DEFAULT); -#else - hid_t group_id = H5Gopen (loc_id, name); -#endif - H5Gget_num_objs (group_id, &num_obj); - H5Gclose (group_id); - - // FIXME -- fields appear to be sorted alphabetically on loading. - // Why is that happening? - - while (current_item < static_cast (num_obj) - && (retval2 = H5Giterate (loc_id, name, ¤t_item, - hdf5_read_next_data, &dsub)) > 0) - { - octave_value t2 = dsub.tc; - - if (error_state) - { - error ("load: internal error loading struct elements"); - return false; - } - - m.setfield (dsub.name, t2); - - } - - if (retval2 >= 0) - { - map = m; - retval = true; - } - - return retval; -} - -#endif - -mxArray * -octave_scalar_struct::as_mxArray (void) const -{ - int nf = nfields (); - string_vector kv = map_keys (); - - OCTAVE_LOCAL_BUFFER (const char *, f, nf); - - for (int i = 0; i < nf; i++) - f[i] = kv[i].c_str (); - - mxArray *retval = new mxArray (dims (), nf, f); - - mxArray **elts = static_cast (retval->get_data ()); - - mwSize nel = numel (); - - mwSize ntot = nf * nel; - - for (int i = 0; i < nf; i++) - { - Cell c = map.contents (kv[i]); - - const octave_value *p = c.data (); - - mwIndex k = 0; - for (mwIndex j = i; j < ntot; j += nf) - elts[j] = new mxArray (p[k++]); - } - - return retval; -} - - -octave_value -octave_scalar_struct::to_array (void) -{ - return new octave_struct (octave_map (map)); -} - -bool -octave_scalar_struct::fast_elem_insert_self (void *where, builtin_type_t btyp) const -{ - - if (btyp == btyp_struct) - { - *(reinterpret_cast(where)) = ↦ - return true; - } - else - return false; -} - -DEFUN (struct, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} struct (\"field\", @var{value}, \"field\", @var{value}, @dots{})\n\ -\n\ -Create a structure and initialize its value.\n\ -\n\ -If the values are cell arrays, create a structure array and initialize\n\ -its values. The dimensions of each cell array of values must match.\n\ -Singleton cells and non-cell values are repeated so that they fill\n\ -the entire array. If the cells are empty, create an empty structure\n\ -array with the specified field names.\n\ -\n\ -If the argument is an object, return the underlying struct.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - // struct ([]) returns an empty struct. - - // struct (empty_matrix) returns an empty struct with the same - // dimensions as the empty matrix. - - // Note that struct () creates a 1x1 struct with no fields for - // compatibility with Matlab. - - if (nargin == 1 && args(0).is_map ()) - return args(0); - - if (nargin == 1 && args(0).is_object ()) - { - retval = args(0).map_value (); - - return retval; - } - - if ((nargin == 1 || nargin == 2) - && args(0).is_empty () && args(0).is_real_matrix ()) - { - Cell fields; - - if (nargin == 2) - { - if (args(1).is_cellstr ()) - retval = octave_map (args(0).dims (), args(1).cellstr_value ()); - else - error ("struct: expecting cell array of field names as second argument"); - } - else - retval = octave_map (args(0).dims ()); - - return retval; - } - - // Check for "field", VALUE pairs. - - for (int i = 0; i < nargin; i += 2) - { - if (! args(i).is_string () || i + 1 >= nargin) - { - error ("struct: expecting alternating \"field\", VALUE pairs"); - return retval; - } - } - - // Check that the dimensions of the values correspond. - - dim_vector dims (1, 1); - - int first_dimensioned_value = 0; - - for (int i = 1; i < nargin; i += 2) - { - if (args(i).is_cell ()) - { - dim_vector argdims (args(i).dims ()); - - if (! scalar (argdims)) - { - if (! first_dimensioned_value) - { - dims = argdims; - first_dimensioned_value = i + 1; - } - else if (dims != argdims) - { - error ("struct: dimensions of parameter %d do not match those of parameter %d", - first_dimensioned_value, i+1); - return retval; - } - } - } - } - - // Create the return value. - - octave_map map (dims); - - for (int i = 0; i < nargin; i+= 2) - { - // Get key. - - std::string key (args(i).string_value ()); - - if (error_state) - return retval; - - if (! valid_identifier (key)) - { - error ("struct: invalid structure field name `%s'", key.c_str ()); - return retval; - } - - // Value may be v, { v }, or { v1, v2, ... } - // In the first two cases, we need to create a cell array of - // the appropriate dimensions filled with v. In the last case, - // the cell array has already been determined to be of the - // correct dimensions. - - if (args(i+1).is_cell ()) - { - const Cell c (args(i+1).cell_value ()); - - if (error_state) - return retval; - - if (scalar (c.dims ())) - map.setfield (key, Cell (dims, c(0))); - else - map.setfield (key, c); - } - else - map.setfield (key, Cell (dims, args(i+1))); - - if (error_state) - return retval; - } - - return octave_value (map); -} - -/* -%!shared x -%! x(1).a=1; x(2).a=2; x(1).b=3; x(2).b=3; -%!assert (struct ("a",1, "b",3), x(1)) -%!assert (isempty (x([]))) -%!assert (isempty (struct ("a",{}, "b",{}))) -%!assert (struct ("a",{1,2}, "b",{3,3}), x) -%!assert (struct ("a",{1,2}, "b",3), x) -%!assert (struct ("a",{1,2}, "b",{3}), x) -%!assert (struct ("b",3, "a",{1,2}), x) -%!assert (struct ("b",{3}, "a",{1,2}), x) -%!test x = struct ([]); -%!assert (size (x), [0,0]) -%!assert (isstruct (x)) -%!assert (isempty (fieldnames (x))) -%!fail ('struct ("a",{1,2},"b",{1,2,3})', 'dimensions of parameter 2 do not match those of parameter 4') -%!fail ('struct (1,2,3,4)', 'struct: expecting alternating "field", VALUE pairs') -%!fail ('struct ("1",2,"3")', 'struct: expecting alternating "field", VALUE pairs') -*/ - -DEFUN (isstruct, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isstruct (@var{x})\n\ -Return true if @var{x} is a structure or a structure array.\n\ -@seealso{ismatrix, iscell, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_map (); - else - print_usage (); - - return retval; -} - -DEFUN (fieldnames, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fieldnames (@var{struct})\n\ -Return a cell array of strings naming the elements of the structure\n\ -@var{struct}. It is an error to call @code{fieldnames} with an\n\ -argument that is not a structure.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value arg = args(0); - - if (arg.is_map () || arg.is_object ()) - { - octave_map m = arg.map_value (); - - string_vector keys = m.fieldnames (); - - if (keys.length () == 0) - retval = Cell (0, 1); - else - retval = Cell (keys); - } - else - gripe_wrong_type_arg ("fieldnames", args(0)); - } - else - print_usage (); - - return retval; -} - -/* -## test preservation of fieldname order -%!test -%! x(3).d=1; x(2).a=2; x(1).b=3; x(2).c=3; -%! assert (fieldnames (x), {"d"; "a"; "b"; "c"}); -*/ - -DEFUN (isfield, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isfield (@var{x}, @var{name})\n\ -Return true if the @var{x} is a structure and it\n\ -includes an element named @var{name}. If @var{name} is a cell\n\ -array of strings then a logical array of equal dimension is returned.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - retval = false; - - if (args(0).is_map ()) - { - octave_map m = args(0).map_value (); - - // FIXME -- should this work for all types that can do - // structure reference operations? - - if (args(1).is_string ()) - { - std::string key = args(1).string_value (); - - retval = m.isfield (key); - } - else if (args(1).is_cell ()) - { - Cell c = args(1).cell_value (); - boolNDArray bm (c.dims ()); - octave_idx_type n = bm.numel (); - - for (octave_idx_type i = 0; i < n; i++) - { - if (c(i).is_string ()) - { - std::string key = c(i).string_value (); - - bm(i) = m.isfield (key); - } - else - bm(i) = false; - } - - retval = bm; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (nfields, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} nfields (@var{s})\n\ -Return the number of fields of the structure @var{s}.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 && args(0).is_map ()) - { - retval = static_cast (args(0).nfields ()); - } - else - print_usage (); - - return retval; -} - -/* -## test isfield -%!test -%! x(3).d=1; x(2).a=2; x(1).b=3; x(2).c=3; -%! assert (isfield (x, "b")); -%!assert (isfield (struct ("a", "1"), "a")) -%!assert (isfield ({1}, "c"), false) -%!assert (isfield (struct ("a", "1"), 10), false) -%!assert (isfield (struct ("a", "b"), "a "), false) -%!assert (isfield (struct ("a", 1, "b", 2), {"a", "c"}), [true, false]) -*/ - -DEFUN (cell2struct, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cell2struct (@var{cell}, @var{fields}, @var{dim})\n\ -Convert @var{cell} to a structure. The number of fields in @var{fields}\n\ -must match the number of elements in @var{cell} along dimension @var{dim},\n\ -that is @code{numel (@var{fields}) == size (@var{cell}, @var{dim})}.\n\ -If @var{dim} is omitted, a value of 1 is assumed.\n\ -\n\ -@example\n\ -@group\n\ -A = cell2struct (@{\"Peter\", \"Hannah\", \"Robert\";\n\ - 185, 170, 168@},\n\ - @{\"Name\",\"Height\"@}, 1);\n\ -A(1)\n\ - @result{}\n\ - @{\n\ - Name = Peter\n\ - Height = 185\n\ - @}\n\ -\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - if (! args(0).is_cell ()) - { - error ("cell2struct: argument CELL must be of type cell"); - return retval; - } - - if (! (args(1).is_cellstr () || args(1).is_char_matrix ())) - { - error ("cell2struct: FIELDS must be a cell array of strings or a character matrix"); - return retval; - } - - const Cell vals = args(0).cell_value (); - const Array fields = args(1).cellstr_value (); - - octave_idx_type ext = 0; - - int dim = 0; - - if (nargin == 3) - { - if (args(2).is_real_scalar ()) - { - dim = nargin == 2 ? 0 : args(2).int_value () - 1; - - if (error_state) - return retval; - } - else - { - error ("cell2struct: DIM must be a real scalar"); - return retval; - } - } - - if (dim < 0) - { - error ("cell2struct: DIM must be a valid dimension"); - return retval; - } - - ext = vals.ndims () > dim ? vals.dims ()(dim) : 1; - - if (ext != fields.numel ()) - { - error ("cell2struct: number of FIELDS does not match dimension"); - return retval; - } - - int nd = std::max (dim+1, vals.ndims ()); - // result dimensions. - dim_vector rdv = vals.dims ().redim (nd); - - assert (ext == rdv(dim)); - if (nd == 2) - { - rdv(0) = rdv(1-dim); - rdv(1) = 1; - } - else - { - for (int i = dim + 1; i < nd; i++) - rdv(i-1) = rdv(i); - - rdv.resize (nd-1); - } - - octave_map map (rdv); - Array ia (dim_vector (nd, 1), idx_vector::colon); - - for (octave_idx_type i = 0; i < ext; i++) - { - ia(dim) = i; - map.setfield (fields(i), vals.index (ia).reshape (rdv)); - } - - retval = map; - } - else - print_usage (); - - return retval; -} - -/* -## test cell2struct versus struct2cell -%!test -%! keys = cellstr (char (floor (rand (100,10)*24+65)))'; -%! vals = mat2cell (rand (100,1), ones (100,1), 1)'; -%! s = struct ([keys; vals]{:}); -%! t = cell2struct (vals, keys, 2); -%! assert (s, t); -%! assert (struct2cell (s), vals'); -%! assert (fieldnames (s), keys'); - -%!assert (cell2struct ({1; 2}, {"a"; "b"}), struct ("a", 1, "b", 2)); - -%!assert (cell2struct ({}, {"f"}, 3), struct ("f", {})); -*/ - - -// So we can call Fcellstr directly. -extern octave_value_list Fcellstr (const octave_value_list& args, int); - -DEFUN (rmfield, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rmfield (@var{s}, @var{f})\n\ -Return a copy of the structure (array) @var{s} with the field @var{f}\n\ -removed. If @var{f} is a cell array of strings or a character array, remove\n\ -the named fields.\n\ -@seealso{cellstr, iscellstr, setfield}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - octave_map m = args(0).map_value (); - - octave_value_list fval = Fcellstr (args(1), 1); - - if (! error_state) - { - Cell fcell = fval(0).cell_value (); - - for (int i = 0; i < fcell.numel (); i++) - { - std::string key = fcell(i).string_value (); - - if (m.isfield (key)) - m.rmfield (key); - else - { - error ("rmfield: structure does not contain field %s", - key.c_str ()); - - break; - } - } - - if (! error_state) - retval = m; - } - } - else - print_usage (); - - return retval; -} - -/* -## test rmfield -%!test -%! x(3).d=1; x(2).a=2; x(1).b=3; x(2).c=3; x(6).f="abc123"; -%! y = rmfield (x, {"a", "f"}); -%! assert (fieldnames (y), {"d"; "b"; "c"}); -%! assert (size (y), [1, 6]); -*/ - -DEFUN (struct_levels_to_print, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} struct_levels_to_print ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} struct_levels_to_print (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} struct_levels_to_print (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the number of\n\ -structure levels to display.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE_WITH_LIMITS (struct_levels_to_print, - -1, INT_MAX); -} - -DEFUN (print_struct_array_contents, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} print_struct_array_contents ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} print_struct_array_contents (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} print_struct_array_contents (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies whether to print struct\n\ -array contents. If true, values of struct array elements are printed.\n\ -This variable does not affect scalar structures. Their elements\n\ -are always printed. In both cases, however, printing will be limited to\n\ -the number of levels specified by @var{struct_levels_to_print}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (print_struct_array_contents); -} diff -r d02b229ce693 -r a132d206a36a src/ov-struct.h --- a/src/ov-struct.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,289 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_struct_h) -#define octave_struct_h 1 - -#include - -#include -#include - -#include "mx-base.h" -#include "str-vec.h" - -#include "error.h" -#include "oct-alloc.h" -#include "oct-map.h" -#include "ov-base.h" -#include "ov-typeinfo.h" - -class octave_value_list; - -class tree_walker; - -// Data structures. - -class -octave_struct : public octave_base_value -{ -public: - - octave_struct (void) - : octave_base_value (), map () { } - - octave_struct (const octave_map& m) - : octave_base_value (), map (m) { } - - octave_struct (const octave_struct& s) - : octave_base_value (), map (s.map) { } - - ~octave_struct (void) { } - - octave_base_value *clone (void) const { return new octave_struct (*this); } - octave_base_value *empty_clone (void) const { return new octave_struct (); } - - octave_base_value *try_narrowing_conversion (void); - - Cell dotref (const octave_value_list& idx, bool auto_add = false); - - octave_value subsref (const std::string& type, - const std::list& idx) - { - octave_value_list tmp = subsref (type, idx, 1); - return tmp.length () > 0 ? tmp(0) : octave_value (); - } - - octave_value_list subsref (const std::string&, - const std::list&, int); - - octave_value subsref (const std::string& type, - const std::list& idx, - bool auto_add); - - static octave_value numeric_conv (const octave_value& val, - const std::string& type); - - octave_value subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - octave_value squeeze (void) const { return map.squeeze (); } - - octave_value permute (const Array& vec, bool inv = false) const - { return map.permute (vec, inv); } - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - dim_vector dims (void) const { return map.dims (); } - - size_t byte_size (void) const; - - // This is the number of elements in each field. The total number - // of elements is numel () * nfields (). - octave_idx_type numel (void) const - { - return map.numel (); - } - - octave_idx_type nfields (void) const { return map.nfields (); } - - octave_value reshape (const dim_vector& new_dims) const - { return map.reshape (new_dims); } - - octave_value resize (const dim_vector& dv, bool fill = false) const - { octave_map tmap = map; tmap.resize (dv, fill); return tmap; } - - bool is_defined (void) const { return true; } - - bool is_constant (void) const { return true; } - - bool is_map (void) const { return true; } - - builtin_type_t builtin_type (void) const { return btyp_struct; } - - octave_map map_value (void) const { return map; } - - string_vector map_keys (void) const { return map.fieldnames (); } - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool print_name_tag (std::ostream& os, const std::string& name) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - mxArray *as_mxArray (void) const; - - octave_value - fast_elem_extract (octave_idx_type n) const; - - bool - fast_elem_insert (octave_idx_type n, const octave_value& x); - -protected: - - // The associative array used to manage the structure data. - octave_map map; - -private: - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -class -octave_scalar_struct : public octave_base_value -{ -public: - - octave_scalar_struct (void) - : octave_base_value (), map () { } - - octave_scalar_struct (const octave_scalar_map& m) - : octave_base_value (), map (m) { } - - octave_scalar_struct (const octave_scalar_struct& s) - : octave_base_value (), map (s.map) { } - - ~octave_scalar_struct (void) { } - - octave_base_value *clone (void) const { return new octave_scalar_struct (*this); } - octave_base_value *empty_clone (void) const { return new octave_scalar_struct (); } - - octave_value dotref (const octave_value_list& idx, bool auto_add = false); - - octave_value subsref (const std::string& type, - const std::list& idx); - - octave_value_list subsref (const std::string& type, - const std::list& idx, int); - - - octave_value subsref (const std::string& type, - const std::list& idx, - bool auto_add); - - static octave_value numeric_conv (const octave_value& val, - const std::string& type); - - octave_value subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - octave_value squeeze (void) const { return map; } - - octave_value permute (const Array& vec, bool inv = false) const - { return octave_map (map).permute (vec, inv); } - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false); - - dim_vector dims (void) const { static dim_vector dv (1, 1); return dv; } - - size_t byte_size (void) const; - - // This is the number of elements in each field. The total number - // of elements is numel () * nfields (). - octave_idx_type numel (void) const - { - return 1; - } - - octave_idx_type nfields (void) const { return map.nfields (); } - - octave_value reshape (const dim_vector& new_dims) const - { return octave_map (map).reshape (new_dims); } - - octave_value resize (const dim_vector& dv, bool fill = false) const - { octave_map tmap = map; tmap.resize (dv, fill); return tmap; } - - bool is_defined (void) const { return true; } - - bool is_constant (void) const { return true; } - - bool is_map (void) const { return true; } - - builtin_type_t builtin_type (void) const { return btyp_struct; } - - octave_map map_value (void) const { return map; } - - octave_scalar_map scalar_map_value (void) const { return map; } - - string_vector map_keys (void) const { return map.fieldnames (); } - - void print (std::ostream& os, bool pr_as_read_syntax = false) const; - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const; - - bool print_name_tag (std::ostream& os, const std::string& name) const; - - bool save_ascii (std::ostream& os); - - bool load_ascii (std::istream& is); - - bool save_binary (std::ostream& os, bool& save_as_floats); - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt); - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats); - - bool load_hdf5 (hid_t loc_id, const char *name); -#endif - - mxArray *as_mxArray (void) const; - - bool fast_elem_insert_self (void *where, builtin_type_t btyp) const; - -protected: - - // The associative array used to manage the structure data. - octave_scalar_map map; - -private: - - octave_value to_array (void); - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-type-conv.h --- a/src/ov-type-conv.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,109 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_ov_type_conv_h) -#define octave_ov_type_conv_h 1 - -static -octave_value -octave_type_conv_body (const octave_value &arg, const std::string& name, int t_result) -{ - int t_arg = arg.type_id (); - octave_value retval; - - if (t_arg == t_result || arg.class_name () == name) - { - retval = arg; - } - else - { - octave_base_value::type_conv_fcn cf1 - = octave_value_typeinfo::lookup_type_conv_op (t_arg, t_result); - - if (cf1) - { - octave_base_value *tmp (cf1 (*(arg.internal_rep ()))); - - if (tmp) - { - retval = octave_value (tmp); - - retval.maybe_mutate (); - } - } - else - { - octave_base_value::type_conv_fcn cf2 - = arg.numeric_conversion_function (); - - if (cf2) - { - octave_base_value *tmp (cf2 (*(arg.internal_rep ()))); - - if (tmp) - { - octave_value xarg (tmp); - - retval = octave_type_conv_body (xarg, name, t_result); - } - } - } - } - - return retval; -} - - -#define OCTAVE_TYPE_CONV_BODY3(NAME, MATRIX_RESULT_T, SCALAR_RESULT_T) \ - \ - octave_value retval; \ - \ - int nargin = args.length (); \ - \ - if (nargin == 1) \ - { \ - const octave_value arg = args(0); \ - \ - int t_result = MATRIX_RESULT_T::static_type_id (); \ - \ - retval = octave_type_conv_body (arg, #NAME, t_result); \ - if (retval.is_undefined ()) \ - { \ - std::string arg_tname = arg.type_name (); \ - \ - std::string result_tname = arg.numel () == 1 \ - ? SCALAR_RESULT_T::static_type_name () \ - : MATRIX_RESULT_T::static_type_name (); \ - \ - gripe_invalid_conversion (arg_tname, result_tname); \ - } \ - } \ - else \ - print_usage (); \ - \ - return retval - -#define OCTAVE_TYPE_CONV_BODY(NAME) \ - OCTAVE_TYPE_CONV_BODY3 (NAME, octave_ ## NAME ## _matrix, \ - octave_ ## NAME ## _scalar) - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-typeinfo.cc --- a/src/ov-typeinfo.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,707 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "Array.h" -#include "singleton-cleanup.h" - -#include "defun.h" -#include "error.h" -#include "ov-typeinfo.h" - -const int -octave_value_typeinfo::init_tab_sz (16); - -octave_value_typeinfo * -octave_value_typeinfo::instance (0); - -bool -octave_value_typeinfo::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_value_typeinfo (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create value type info object!"); - - retval = false; - } - - return retval; -} - -int -octave_value_typeinfo::register_type (const std::string& t_name, - const std::string& c_name, - const octave_value& val) -{ - return (instance_ok ()) - ? instance->do_register_type (t_name, c_name, val) : -1; -} - -bool -octave_value_typeinfo::register_unary_class_op (octave_value::unary_op op, - octave_value_typeinfo::unary_class_op_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_unary_class_op (op, f) : false; -} - -bool -octave_value_typeinfo::register_unary_op (octave_value::unary_op op, - int t, octave_value_typeinfo::unary_op_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_unary_op (op, t, f) : false; -} - -bool -octave_value_typeinfo::register_non_const_unary_op (octave_value::unary_op op, - int t, - octave_value_typeinfo::non_const_unary_op_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_non_const_unary_op (op, t, f) : false; -} - -bool -octave_value_typeinfo::register_binary_class_op (octave_value::binary_op op, - octave_value_typeinfo::binary_class_op_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_binary_class_op (op, f) : false; -} - -bool -octave_value_typeinfo::register_binary_op (octave_value::binary_op op, - int t1, int t2, - octave_value_typeinfo::binary_op_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_binary_op (op, t1, t2, f) : false; -} - -bool -octave_value_typeinfo::register_binary_class_op (octave_value::compound_binary_op op, - octave_value_typeinfo::binary_class_op_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_binary_class_op (op, f) : false; -} - -bool -octave_value_typeinfo::register_binary_op (octave_value::compound_binary_op op, - int t1, int t2, - octave_value_typeinfo::binary_op_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_binary_op (op, t1, t2, f) : false; -} - -bool -octave_value_typeinfo::register_cat_op (int t1, int t2, octave_value_typeinfo::cat_op_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_cat_op (t1, t2, f) : false; -} - -bool -octave_value_typeinfo::register_assign_op (octave_value::assign_op op, - int t_lhs, int t_rhs, - octave_value_typeinfo::assign_op_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_assign_op (op, t_lhs, t_rhs, f) : -1; -} - -bool -octave_value_typeinfo::register_assignany_op (octave_value::assign_op op, - int t_lhs, octave_value_typeinfo::assignany_op_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_assignany_op (op, t_lhs, f) : -1; -} - -bool -octave_value_typeinfo::register_pref_assign_conv (int t_lhs, int t_rhs, - int t_result) -{ - return (instance_ok ()) - ? instance->do_register_pref_assign_conv (t_lhs, t_rhs, t_result) : false; -} - -bool -octave_value_typeinfo::register_type_conv_op (int t, int t_result, - octave_base_value::type_conv_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_type_conv_op (t, t_result, f) : false; -} - -bool -octave_value_typeinfo::register_widening_op (int t, int t_result, - octave_base_value::type_conv_fcn f) -{ - return (instance_ok ()) - ? instance->do_register_widening_op (t, t_result, f) : false; -} - -// FIXME -- we should also store all class names and provide a -// way to list them (calling class with nargin == 0?). - -int -octave_value_typeinfo::do_register_type (const std::string& t_name, - const std::string& /* c_name */, - const octave_value& val) -{ - int i = 0; - - for (i = 0; i < num_types; i++) - if (t_name == types (i)) - return i; - - int len = types.length (); - - if (i == len) - { - len *= 2; - - types.resize (dim_vector (len, 1), std::string ()); - - vals.resize (dim_vector (len, 1), octave_value ()); - - unary_ops.resize (dim_vector (octave_value::num_unary_ops, len), 0); - - non_const_unary_ops.resize - (dim_vector (octave_value::num_unary_ops, len), 0); - - binary_ops.resize - (dim_vector (octave_value::num_binary_ops, len, len), 0); - - compound_binary_ops.resize - (dim_vector (octave_value::num_compound_binary_ops, len, len), 0); - - cat_ops.resize (dim_vector (len, len), 0); - - assign_ops.resize - (dim_vector (octave_value::num_assign_ops, len, len), 0); - - assignany_ops.resize - (dim_vector (octave_value::num_assign_ops, len), 0); - - pref_assign_conv.resize (dim_vector (len, len), -1); - - type_conv_ops.resize (dim_vector (len, len), 0); - - widening_ops.resize (dim_vector (len, len), 0); - } - - types (i) = t_name; - - vals (i) = val; - - num_types++; - - return i; -} - -bool -octave_value_typeinfo::do_register_unary_class_op (octave_value::unary_op op, - octave_value_typeinfo::unary_class_op_fcn f) -{ - if (lookup_unary_class_op (op)) - { - std::string op_name = octave_value::unary_op_as_string (op); - - warning ("duplicate unary operator `%s' for class dispatch", - op_name.c_str ()); - } - - unary_class_ops.checkelem (static_cast (op)) = reinterpret_cast (f); - - return false; -} - -bool -octave_value_typeinfo::do_register_unary_op (octave_value::unary_op op, - int t, octave_value_typeinfo::unary_op_fcn f) -{ - if (lookup_unary_op (op, t)) - { - std::string op_name = octave_value::unary_op_as_string (op); - std::string type_name = types(t); - - warning ("duplicate unary operator `%s' for type `%s'", - op_name.c_str (), type_name.c_str ()); - } - - unary_ops.checkelem (static_cast (op), t) = reinterpret_cast (f); - - return false; -} - -bool -octave_value_typeinfo::do_register_non_const_unary_op - (octave_value::unary_op op, int t, octave_value_typeinfo::non_const_unary_op_fcn f) -{ - if (lookup_non_const_unary_op (op, t)) - { - std::string op_name = octave_value::unary_op_as_string (op); - std::string type_name = types(t); - - warning ("duplicate unary operator `%s' for type `%s'", - op_name.c_str (), type_name.c_str ()); - } - - non_const_unary_ops.checkelem (static_cast (op), t) = reinterpret_cast (f); - - return false; -} - -bool -octave_value_typeinfo::do_register_binary_class_op (octave_value::binary_op op, - octave_value_typeinfo::binary_class_op_fcn f) -{ - if (lookup_binary_class_op (op)) - { - std::string op_name = octave_value::binary_op_as_string (op); - - warning ("duplicate binary operator `%s' for class dispatch", - op_name.c_str ()); - } - - binary_class_ops.checkelem (static_cast (op)) = reinterpret_cast (f); - - return false; -} - -bool -octave_value_typeinfo::do_register_binary_op (octave_value::binary_op op, - int t1, int t2, - octave_value_typeinfo::binary_op_fcn f) -{ - if (lookup_binary_op (op, t1, t2)) - { - std::string op_name = octave_value::binary_op_as_string (op); - std::string t1_name = types(t1); - std::string t2_name = types(t2); - - warning ("duplicate binary operator `%s' for types `%s' and `%s'", - op_name.c_str (), t1_name.c_str (), t1_name.c_str ()); - } - - binary_ops.checkelem (static_cast (op), t1, t2) = reinterpret_cast (f); - - return false; -} - -bool -octave_value_typeinfo::do_register_binary_class_op (octave_value::compound_binary_op op, - octave_value_typeinfo::binary_class_op_fcn f) -{ - if (lookup_binary_class_op (op)) - { - std::string op_name = octave_value::binary_op_fcn_name (op); - - warning ("duplicate compound binary operator `%s' for class dispatch", - op_name.c_str ()); - } - - compound_binary_class_ops.checkelem (static_cast (op)) = reinterpret_cast (f); - - return false; -} - -bool -octave_value_typeinfo::do_register_binary_op (octave_value::compound_binary_op op, - int t1, int t2, - octave_value_typeinfo::binary_op_fcn f) -{ - if (lookup_binary_op (op, t1, t2)) - { - std::string op_name = octave_value::binary_op_fcn_name (op); - std::string t1_name = types(t1); - std::string t2_name = types(t2); - - warning ("duplicate compound binary operator `%s' for types `%s' and `%s'", - op_name.c_str (), t1_name.c_str (), t1_name.c_str ()); - } - - compound_binary_ops.checkelem (static_cast (op), t1, t2) = reinterpret_cast (f); - - return false; -} - -bool -octave_value_typeinfo::do_register_cat_op (int t1, int t2, octave_value_typeinfo::cat_op_fcn f) -{ - if (lookup_cat_op (t1, t2)) - { - std::string t1_name = types(t1); - std::string t2_name = types(t2); - - warning ("duplicate concatenation operator for types `%s' and `%s'", - t1_name.c_str (), t1_name.c_str ()); - } - - cat_ops.checkelem (t1, t2) = reinterpret_cast (f); - - return false; -} - -bool -octave_value_typeinfo::do_register_assign_op (octave_value::assign_op op, - int t_lhs, int t_rhs, - octave_value_typeinfo::assign_op_fcn f) -{ - if (lookup_assign_op (op, t_lhs, t_rhs)) - { - std::string op_name = octave_value::assign_op_as_string (op); - std::string t_lhs_name = types(t_lhs); - std::string t_rhs_name = types(t_rhs); - - warning ("duplicate assignment operator `%s' for types `%s' and `%s'", - op_name.c_str (), t_lhs_name.c_str (), t_rhs_name.c_str ()); - } - - assign_ops.checkelem (static_cast (op), t_lhs, t_rhs) = reinterpret_cast (f); - - return false; -} - -bool -octave_value_typeinfo::do_register_assignany_op (octave_value::assign_op op, - int t_lhs, octave_value_typeinfo::assignany_op_fcn f) -{ - if (lookup_assignany_op (op, t_lhs)) - { - std::string op_name = octave_value::assign_op_as_string (op); - std::string t_lhs_name = types(t_lhs); - - warning ("duplicate assignment operator `%s' for types `%s'", - op_name.c_str (), t_lhs_name.c_str ()); - } - - assignany_ops.checkelem (static_cast (op), t_lhs) = reinterpret_cast (f); - - return false; -} - -bool -octave_value_typeinfo::do_register_pref_assign_conv (int t_lhs, int t_rhs, - int t_result) -{ - if (lookup_pref_assign_conv (t_lhs, t_rhs) >= 0) - { - std::string t_lhs_name = types(t_lhs); - std::string t_rhs_name = types(t_rhs); - - warning ("overriding assignment conversion for types `%s' and `%s'", - t_lhs_name.c_str (), t_rhs_name.c_str ()); - } - - pref_assign_conv.checkelem (t_lhs, t_rhs) = t_result; - - return false; -} - -bool -octave_value_typeinfo::do_register_type_conv_op - (int t, int t_result, octave_base_value::type_conv_fcn f) -{ - if (lookup_type_conv_op (t, t_result)) - { - std::string t_name = types(t); - std::string t_result_name = types(t_result); - - warning ("overriding type conversion op for `%s' to `%s'", - t_name.c_str (), t_result_name.c_str ()); - } - - type_conv_ops.checkelem (t, t_result) = reinterpret_cast (f); - - return false; -} - -bool -octave_value_typeinfo::do_register_widening_op - (int t, int t_result, octave_base_value::type_conv_fcn f) -{ - if (lookup_widening_op (t, t_result)) - { - std::string t_name = types(t); - std::string t_result_name = types(t_result); - - warning ("overriding widening op for `%s' to `%s'", - t_name.c_str (), t_result_name.c_str ()); - } - - widening_ops.checkelem (t, t_result) = reinterpret_cast (f); - - return false; -} - -octave_value -octave_value_typeinfo::do_lookup_type (const std::string& nm) -{ - octave_value retval; - - for (int i = 0; i < num_types; i++) - { - if (nm == types(i)) - { - retval = vals(i); - retval.make_unique (); - break; - } - } - - return retval; -} - -octave_value_typeinfo::unary_class_op_fcn -octave_value_typeinfo::do_lookup_unary_class_op (octave_value::unary_op op) -{ - void *f = unary_class_ops.checkelem (static_cast (op)); - return reinterpret_cast (f); -} - -octave_value_typeinfo::unary_op_fcn -octave_value_typeinfo::do_lookup_unary_op (octave_value::unary_op op, int t) -{ - void *f = unary_ops.checkelem (static_cast (op), t); - return reinterpret_cast (f); -} - -octave_value_typeinfo::non_const_unary_op_fcn -octave_value_typeinfo::do_lookup_non_const_unary_op - (octave_value::unary_op op, int t) -{ - void *f = non_const_unary_ops.checkelem (static_cast (op), t); - return reinterpret_cast (f); -} - -octave_value_typeinfo::binary_class_op_fcn -octave_value_typeinfo::do_lookup_binary_class_op (octave_value::binary_op op) -{ - void *f = binary_class_ops.checkelem (static_cast (op)); - return reinterpret_cast (f); -} - -octave_value_typeinfo::binary_op_fcn -octave_value_typeinfo::do_lookup_binary_op (octave_value::binary_op op, - int t1, int t2) -{ - void *f = binary_ops.checkelem (static_cast (op), t1, t2); - return reinterpret_cast (f); -} - -octave_value_typeinfo::binary_class_op_fcn -octave_value_typeinfo::do_lookup_binary_class_op (octave_value::compound_binary_op op) -{ - void *f = compound_binary_class_ops.checkelem (static_cast (op)); - return reinterpret_cast (f); -} - -octave_value_typeinfo::binary_op_fcn -octave_value_typeinfo::do_lookup_binary_op (octave_value::compound_binary_op op, - int t1, int t2) -{ - void *f = compound_binary_ops.checkelem (static_cast (op), t1, t2); - return reinterpret_cast (f); -} - -octave_value_typeinfo::cat_op_fcn -octave_value_typeinfo::do_lookup_cat_op (int t1, int t2) -{ - void *f = cat_ops.checkelem (t1, t2); - return reinterpret_cast (f); -} - -octave_value_typeinfo::assign_op_fcn -octave_value_typeinfo::do_lookup_assign_op (octave_value::assign_op op, - int t_lhs, int t_rhs) -{ - void *f = assign_ops.checkelem (static_cast (op), t_lhs, t_rhs); - return reinterpret_cast (f); -} - -octave_value_typeinfo::assignany_op_fcn -octave_value_typeinfo::do_lookup_assignany_op (octave_value::assign_op op, - int t_lhs) -{ - void *f = assignany_ops.checkelem (static_cast (op), t_lhs); - return reinterpret_cast (f); -} - -int -octave_value_typeinfo::do_lookup_pref_assign_conv (int t_lhs, int t_rhs) -{ - return pref_assign_conv.checkelem (t_lhs, t_rhs); -} - -octave_base_value::type_conv_fcn -octave_value_typeinfo::do_lookup_type_conv_op (int t, int t_result) -{ - void *f = type_conv_ops.checkelem (t, t_result); - return reinterpret_cast (f); -} - -octave_base_value::type_conv_fcn -octave_value_typeinfo::do_lookup_widening_op (int t, int t_result) -{ - void *f = widening_ops.checkelem (t, t_result); - return reinterpret_cast (f); -} - -string_vector -octave_value_typeinfo::do_installed_type_names (void) -{ - string_vector retval (num_types); - - for (int i = 0; i < num_types; i++) - retval(i) = types(i); - - return retval; -} - -DEFUN (typeinfo, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} typeinfo ()\n\ -@deftypefnx {Built-in Function} {} typeinfo (@var{expr})\n\ -\n\ -Return the type of the expression @var{expr}, as a string. If\n\ -@var{expr} is omitted, return an cell array of strings containing all the\n\ -currently installed data types.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = Cell (octave_value_typeinfo::installed_type_names ()); - else if (nargin == 1) - retval = args(0).type_name (); - else - print_usage (); - - return retval; -} - -/* -%!assert (iscellstr (typeinfo ())) - -%!assert (typeinfo ({"cell"}), "cell") - -%!assert (typeinfo (1), "scalar") -%!assert (typeinfo (double (1)), "scalar") -%!assert (typeinfo (i), "complex scalar") - -%!assert (typeinfo ([1, 2]), "matrix") -%!assert (typeinfo (double ([1, 2])), "matrix") -%!assert (typeinfo (diag ([1, 2])), "diagonal matrix") -%!assert (typeinfo ([i, 2]), "complex matrix") -%!assert (typeinfo (diag ([i, 2])), "complex diagonal matrix") - -%!assert (typeinfo (1:2), "range") - -%!assert (typeinfo (false), "bool") -%!assert (typeinfo ([true, false]), "bool matrix") - -%!assert (typeinfo ("string"), "string") -%!assert (typeinfo ('string'), "sq_string") - -%!assert (typeinfo (int8 (1)), "int8 scalar") -%!assert (typeinfo (int16 (1)), "int16 scalar") -%!assert (typeinfo (int32 (1)), "int32 scalar") -%!assert (typeinfo (int64 (1)), "int64 scalar") -%!assert (typeinfo (uint8 (1)), "uint8 scalar") -%!assert (typeinfo (uint16 (1)), "uint16 scalar") -%!assert (typeinfo (uint32 (1)), "uint32 scalar") -%!assert (typeinfo (uint64 (1)), "uint64 scalar") - -%!assert (typeinfo (int8 ([1,2])), "int8 matrix") -%!assert (typeinfo (int16 ([1,2])), "int16 matrix") -%!assert (typeinfo (int32 ([1,2])), "int32 matrix") -%!assert (typeinfo (int64 ([1,2])), "int64 matrix") -%!assert (typeinfo (uint8 ([1,2])), "uint8 matrix") -%!assert (typeinfo (uint16 ([1,2])), "uint16 matrix") -%!assert (typeinfo (uint32 ([1,2])), "uint32 matrix") -%!assert (typeinfo (uint64 ([1,2])), "uint64 matrix") - -%!assert (typeinfo (sparse ([true, false])), "sparse bool matrix") -%!assert (typeinfo (logical (sparse (i * eye (10)))), "sparse bool matrix") -%!assert (typeinfo (sparse ([1,2])), "sparse matrix") -%!assert (typeinfo (sparse (eye (10))), "sparse matrix") -%!assert (typeinfo (sparse ([i,2])), "sparse complex matrix") -%!assert (typeinfo (sparse (i * eye (10))), "sparse complex matrix") - -%!test -%! s(2).a = 1; -%! assert (typeinfo (s), "struct"); - -%!test -%! s.a = 1; -%! assert (typeinfo (s), "scalar struct"); - -## FIXME: This doesn't work as a test for comma-separated list -%!#test -%! clist = {1, 2, 3}; -%! assert (typeinfo (clist{:}), "cs-list"); - -%!assert (typeinfo (@sin), "function handle") -%!assert (typeinfo (@(x) x), "function handle") - -%!assert (typeinfo (inline ("x^2")), "inline function") - -%!assert (typeinfo (single (1)), "float scalar") -%!assert (typeinfo (single (i)), "float complex scalar") -%!assert (typeinfo (single ([1, 2])), "float matrix") - -%!assert (typeinfo (single (diag ([1, 2]))), "float diagonal matrix") -%!assert (typeinfo (diag (single ([1, 2]))), "float diagonal matrix") -%!assert (typeinfo (single (diag ([i, 2]))), "float complex diagonal matrix") -%!assert (typeinfo (diag (single ([i, 2]))), "float complex diagonal matrix") - -%!assert (typeinfo (eye(3)(:,[1 3 2])), "permutation matrix") -%!test -%! [l, u, p] = lu (rand (3)); -%! assert (typeinfo (p), "permutation matrix"); - -%!assert (typeinfo ([]), "null_matrix") -%!assert (typeinfo (""), "null_string") -%!assert (typeinfo (''), "null_sq_string") - -%!error typeinfo ("foo", 1) -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-typeinfo.h --- a/src/ov-typeinfo.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,327 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_value_typeinfo_h) -#define octave_value_typeinfo_h 1 - -#include - -#include "Array.h" - -#include "ov.h" - -class string_vector; - -class -OCTINTERP_API -octave_value_typeinfo -{ -public: - - typedef octave_value (*unary_class_op_fcn) (const octave_value&); - - typedef octave_value (*unary_op_fcn) (const octave_base_value&); - - typedef void (*non_const_unary_op_fcn) (octave_base_value&); - - typedef octave_value (*binary_class_op_fcn) - (const octave_value&, const octave_value&); - - typedef octave_value (*binary_op_fcn) - (const octave_base_value&, const octave_base_value&); - - typedef octave_value (*cat_op_fcn) - (octave_base_value&, const octave_base_value&, - const Array& ra_idx); - - typedef octave_value (*assign_op_fcn) - (octave_base_value&, const octave_value_list&, const octave_base_value&); - - typedef octave_value (*assignany_op_fcn) - (octave_base_value&, const octave_value_list&, const octave_value&); - - static bool instance_ok (void); - - static int register_type (const std::string&, const std::string&, - const octave_value&); - - static bool register_unary_class_op (octave_value::unary_op, - unary_class_op_fcn); - - static bool register_unary_op (octave_value::unary_op, int, unary_op_fcn); - - static bool register_non_const_unary_op (octave_value::unary_op, int, - non_const_unary_op_fcn); - - static bool register_binary_class_op (octave_value::binary_op, - binary_class_op_fcn); - - static bool register_binary_op (octave_value::binary_op, int, int, - binary_op_fcn); - - static bool register_binary_class_op (octave_value::compound_binary_op, - binary_class_op_fcn); - - static bool register_binary_op (octave_value::compound_binary_op, int, int, - binary_op_fcn); - - static bool register_cat_op (int, int, cat_op_fcn); - - static bool register_assign_op (octave_value::assign_op, int, int, - assign_op_fcn); - - static bool register_assignany_op (octave_value::assign_op, int, - assignany_op_fcn); - - static bool register_pref_assign_conv (int, int, int); - - static bool - register_type_conv_op (int, int, octave_base_value::type_conv_fcn); - - static bool - register_widening_op (int, int, octave_base_value::type_conv_fcn); - - static octave_value - lookup_type (const std::string& nm) - { - return instance->do_lookup_type (nm); - } - - static unary_class_op_fcn - lookup_unary_class_op (octave_value::unary_op op) - { - return instance->do_lookup_unary_class_op (op); - } - - static unary_op_fcn - lookup_unary_op (octave_value::unary_op op, int t) - { - return instance->do_lookup_unary_op (op, t); - } - - static non_const_unary_op_fcn - lookup_non_const_unary_op (octave_value::unary_op op, int t) - { - return instance->do_lookup_non_const_unary_op (op, t); - } - - static binary_class_op_fcn - lookup_binary_class_op (octave_value::binary_op op) - { - return instance->do_lookup_binary_class_op (op); - } - - static binary_op_fcn - lookup_binary_op (octave_value::binary_op op, int t1, int t2) - { - return instance->do_lookup_binary_op (op, t1, t2); - } - - static binary_class_op_fcn - lookup_binary_class_op (octave_value::compound_binary_op op) - { - return instance->do_lookup_binary_class_op (op); - } - - static binary_op_fcn - lookup_binary_op (octave_value::compound_binary_op op, int t1, int t2) - { - return instance->do_lookup_binary_op (op, t1, t2); - } - - static cat_op_fcn - lookup_cat_op (int t1, int t2) - { - return instance->do_lookup_cat_op (t1, t2); - } - - static assign_op_fcn - lookup_assign_op (octave_value::assign_op op, int t_lhs, int t_rhs) - { - return instance->do_lookup_assign_op (op, t_lhs, t_rhs); - } - - static assignany_op_fcn - lookup_assignany_op (octave_value::assign_op op, int t_lhs) - { - return instance->do_lookup_assignany_op (op, t_lhs); - } - - static int - lookup_pref_assign_conv (int t_lhs, int t_rhs) - { - return instance->do_lookup_pref_assign_conv (t_lhs, t_rhs); - } - - static octave_base_value::type_conv_fcn - lookup_type_conv_op (int t, int t_result) - { - return instance->do_lookup_type_conv_op (t, t_result); - } - - static octave_base_value::type_conv_fcn - lookup_widening_op (int t, int t_result) - { - return instance->do_lookup_widening_op (t, t_result); - } - - static string_vector installed_type_names (void) - { - return instance->do_installed_type_names (); - } - -protected: - - octave_value_typeinfo (void) - : num_types (0), types (dim_vector (init_tab_sz, 1), std::string ()), - vals (dim_vector (init_tab_sz, 1)), - unary_class_ops (dim_vector (octave_value::num_unary_ops, 1), 0), - unary_ops (dim_vector (octave_value::num_unary_ops, init_tab_sz), 0), - non_const_unary_ops (dim_vector (octave_value::num_unary_ops, init_tab_sz), 0), - binary_class_ops (dim_vector (octave_value::num_binary_ops, 1), 0), - binary_ops (dim_vector (octave_value::num_binary_ops, init_tab_sz, init_tab_sz), 0), - compound_binary_class_ops (dim_vector (octave_value::num_compound_binary_ops, 1), 0), - compound_binary_ops (dim_vector (octave_value::num_compound_binary_ops, init_tab_sz, init_tab_sz), 0), - cat_ops (dim_vector (init_tab_sz, init_tab_sz), 0), - assign_ops (dim_vector (octave_value::num_assign_ops, init_tab_sz, init_tab_sz), 0), - assignany_ops (dim_vector (octave_value::num_assign_ops, init_tab_sz), 0), - pref_assign_conv (dim_vector (init_tab_sz, init_tab_sz), -1), - type_conv_ops (dim_vector (init_tab_sz, init_tab_sz), 0), - widening_ops (dim_vector (init_tab_sz, init_tab_sz), 0) { } - - ~octave_value_typeinfo (void) { } - -private: - - static const int init_tab_sz; - - static octave_value_typeinfo *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - int num_types; - - Array types; - - Array vals; - - Array unary_class_ops; - - Array unary_ops; - - Array non_const_unary_ops; - - Array binary_class_ops; - - Array binary_ops; - - Array compound_binary_class_ops; - - Array compound_binary_ops; - - Array cat_ops; - - Array assign_ops; - - Array assignany_ops; - - Array pref_assign_conv; - - Array type_conv_ops; - - Array widening_ops; - - int do_register_type (const std::string&, const std::string&, - const octave_value&); - - bool do_register_unary_class_op (octave_value::unary_op, unary_class_op_fcn); - - bool do_register_unary_op (octave_value::unary_op, int, unary_op_fcn); - - bool do_register_non_const_unary_op (octave_value::unary_op, int, - non_const_unary_op_fcn); - - bool do_register_binary_class_op (octave_value::binary_op, - binary_class_op_fcn); - - bool do_register_binary_op (octave_value::binary_op, int, int, - binary_op_fcn); - - bool do_register_binary_class_op (octave_value::compound_binary_op, - binary_class_op_fcn); - - bool do_register_binary_op (octave_value::compound_binary_op, int, int, - binary_op_fcn); - - bool do_register_cat_op (int, int, cat_op_fcn); - - bool do_register_assign_op (octave_value::assign_op, int, int, - assign_op_fcn); - - bool do_register_assignany_op (octave_value::assign_op, int, - assignany_op_fcn); - - bool do_register_pref_assign_conv (int, int, int); - - bool do_register_type_conv_op (int, int, octave_base_value::type_conv_fcn); - - bool do_register_widening_op (int, int, octave_base_value::type_conv_fcn); - - octave_value do_lookup_type (const std::string& nm); - - unary_class_op_fcn do_lookup_unary_class_op (octave_value::unary_op); - - unary_op_fcn do_lookup_unary_op (octave_value::unary_op, int); - - non_const_unary_op_fcn do_lookup_non_const_unary_op - (octave_value::unary_op, int); - - binary_class_op_fcn do_lookup_binary_class_op (octave_value::binary_op); - - binary_op_fcn do_lookup_binary_op (octave_value::binary_op, int, int); - - binary_class_op_fcn do_lookup_binary_class_op (octave_value::compound_binary_op); - - binary_op_fcn do_lookup_binary_op (octave_value::compound_binary_op, int, int); - - cat_op_fcn do_lookup_cat_op (int, int); - - assign_op_fcn do_lookup_assign_op (octave_value::assign_op, int, int); - - assignany_op_fcn do_lookup_assignany_op (octave_value::assign_op, int); - - int do_lookup_pref_assign_conv (int, int); - - octave_base_value::type_conv_fcn do_lookup_type_conv_op (int, int); - - octave_base_value::type_conv_fcn do_lookup_widening_op (int, int); - - string_vector do_installed_type_names (void); - - // No copying! - - octave_value_typeinfo (const octave_value_typeinfo&); - - octave_value_typeinfo& operator = (const octave_value_typeinfo&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-uint16.cc --- a/src/ov-uint16.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "lo-ieee.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "quit.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "ops.h" -#include "ov-base.h" - -#ifdef HAVE_HDF5 -#define HDF5_SAVE_TYPE H5T_NATIVE_UINT16 -#endif - -#include "ov-base-int.h" -#include "ov-base-int.cc" -#include "ov-uint16.h" -#include "ov-type-conv.h" -#include "pr-output.h" -#include "variables.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -template class octave_base_matrix; - -template class octave_base_int_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_uint16_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint16_matrix, - "uint16 matrix", "uint16"); - -template class octave_base_scalar; - -template class octave_base_int_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_uint16_scalar); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint16_scalar, - "uint16 scalar", "uint16"); - -DEFUN (uint16, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} uint16 (@var{x})\n\ -Convert @var{x} to unsigned 16-bit integer type.\n\ -@end deftypefn") -{ - OCTAVE_TYPE_CONV_BODY (uint16); -} - -/* -%!assert (class (uint16 (1)), "uint16") -%!assert (uint16 (1.25), uint16 (1)) -%!assert (uint16 (1.5), uint16 (2)) -%!assert (uint16 (-1.5), uint16 (0)) -%!assert (uint16 (2^17), uint16 (2^16-1)) -%!assert (uint16 (-2^17), uint16 (0)) -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-uint16.h --- a/src/ov-uint16.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_uint16_h) -#define octave_uint16_h 1 - -#define OCTAVE_INT_T octave_uint16 - -#define OCTAVE_VALUE_INT_MATRIX_T octave_uint16_matrix -#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION uint16_array_value - -#define OCTAVE_VALUE_INT_SCALAR_T octave_uint16_scalar -#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION uint16_scalar_value - -#define OCTAVE_TYPE_PREDICATE_FUNCTION is_uint16_type - -#define OCTAVE_INT_MX_CLASS mxUINT16_CLASS - -#define OCTAVE_INT_BTYP btyp_uint16 - -#include "ov-intx.h" - -#undef OCTAVE_INT_T - -#undef OCTAVE_VALUE_INT_MATRIX_T -#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION - -#undef OCTAVE_VALUE_INT_SCALAR_T -#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION - -#undef OCTAVE_TYPE_PREDICATE_FUNCTION - -#undef OCTAVE_INT_MX_CLASS - -#undef OCTAVE_INT_BTYP - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-uint32.cc --- a/src/ov-uint32.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "lo-ieee.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "quit.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "ops.h" -#include "ov-base.h" - -#ifdef HAVE_HDF5 -#define HDF5_SAVE_TYPE H5T_NATIVE_UINT32 -#endif - -#include "ov-base-int.h" -#include "ov-base-int.cc" -#include "ov-uint32.h" -#include "ov-type-conv.h" -#include "pr-output.h" -#include "variables.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -template class octave_base_matrix; - -template class octave_base_int_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_uint32_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint32_matrix, - "uint32 matrix", "uint32"); - -template class octave_base_scalar; - -template class octave_base_int_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_uint32_scalar); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint32_scalar, - "uint32 scalar", "uint32"); - -DEFUN (uint32, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} uint32 (@var{x})\n\ -Convert @var{x} to unsigned 32-bit integer type.\n\ -@end deftypefn") -{ - OCTAVE_TYPE_CONV_BODY (uint32); -} - -/* -%!assert (class (uint32 (1)), "uint32") -%!assert (uint32 (1.25), uint32 (1)) -%!assert (uint32 (1.5), uint32 (2)) -%!assert (uint32 (-1.5), uint32 (0)) -%!assert (uint32 (2^33), uint32 (2^32-1)) -%!assert (uint32 (-2^33), uint32 (0)) -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-uint32.h --- a/src/ov-uint32.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_uint32_h) -#define octave_uint32_h 1 - -#define OCTAVE_INT_T octave_uint32 - -#define OCTAVE_VALUE_INT_MATRIX_T octave_uint32_matrix -#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION uint32_array_value - -#define OCTAVE_VALUE_INT_SCALAR_T octave_uint32_scalar -#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION uint32_scalar_value - -#define OCTAVE_TYPE_PREDICATE_FUNCTION is_uint32_type - -#define OCTAVE_INT_MX_CLASS mxUINT32_CLASS - -#define OCTAVE_INT_BTYP btyp_uint32 - -#include "ov-intx.h" - -#undef OCTAVE_INT_T - -#undef OCTAVE_VALUE_INT_MATRIX_T -#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION - -#undef OCTAVE_VALUE_INT_SCALAR_T -#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION - -#undef OCTAVE_TYPE_PREDICATE_FUNCTION - -#undef OCTAVE_INT_MX_CLASS - -#undef OCTAVE_INT_BTYP - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-uint64.cc --- a/src/ov-uint64.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "lo-ieee.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "quit.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "ops.h" -#include "ov-base.h" - -#ifdef HAVE_HDF5 -#define HDF5_SAVE_TYPE H5T_NATIVE_UINT64 -#endif - -#include "ov-base-int.h" -#include "ov-base-int.cc" -#include "ov-uint64.h" -#include "ov-type-conv.h" -#include "pr-output.h" -#include "variables.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -template class octave_base_matrix; - -template class octave_base_int_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_uint64_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint64_matrix, - "uint64 matrix", "uint64"); - -template class octave_base_scalar; - -template class octave_base_int_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_uint64_scalar); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint64_scalar, - "uint64 scalar", "uint64"); - -DEFUN (uint64, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} uint64 (@var{x})\n\ -Convert @var{x} to unsigned 64-bit integer type.\n\ -@end deftypefn") -{ - OCTAVE_TYPE_CONV_BODY (uint64); -} - -/* -%!assert (class (uint64 (1)), "uint64") -%!assert (uint64 (1.25), uint64 (1)) -%!assert (uint64 (1.5), uint64 (2)) -%!assert (uint64 (-1.5), uint64 (0)) -%!assert (uint64 (2^65), uint64 (2^64-1)) -%!assert (uint64 (-2^65), uint64 (0)) -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-uint64.h --- a/src/ov-uint64.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_uint64_h) -#define octave_uint64_h 1 - -#define OCTAVE_INT_T octave_uint64 - -#define OCTAVE_VALUE_INT_MATRIX_T octave_uint64_matrix -#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION uint64_array_value - -#define OCTAVE_VALUE_INT_SCALAR_T octave_uint64_scalar -#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION uint64_scalar_value - -#define OCTAVE_TYPE_PREDICATE_FUNCTION is_uint64_type - -#define OCTAVE_INT_MX_CLASS mxUINT64_CLASS - -#define OCTAVE_INT_BTYP btyp_uint64 - -#include "ov-intx.h" - -#undef OCTAVE_INT_T - -#undef OCTAVE_VALUE_INT_MATRIX_T -#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION - -#undef OCTAVE_VALUE_INT_SCALAR_T -#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION - -#undef OCTAVE_TYPE_PREDICATE_FUNCTION - -#undef OCTAVE_INT_MX_CLASS - -#undef OCTAVE_INT_BTYP - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-uint8.cc --- a/src/ov-uint8.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,93 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "lo-ieee.h" -#include "lo-utils.h" -#include "mx-base.h" -#include "quit.h" - -#include "defun.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "ops.h" -#include "ov-base.h" - -#ifdef HAVE_HDF5 -#define HDF5_SAVE_TYPE H5T_NATIVE_UINT8 -#endif - -#include "ov-base-int.h" -#include "ov-base-int.cc" -#include "ov-uint8.h" -#include "ov-type-conv.h" -#include "pr-output.h" -#include "variables.h" - -#include "byte-swap.h" -#include "ls-oct-ascii.h" -#include "ls-utils.h" -#include "ls-hdf5.h" - -template class octave_base_matrix; - -template class octave_base_int_matrix; - -DEFINE_OCTAVE_ALLOCATOR (octave_uint8_matrix); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint8_matrix, - "uint8 matrix", "uint8"); - -template class octave_base_scalar; - -template class octave_base_int_scalar; - -DEFINE_OCTAVE_ALLOCATOR (octave_uint8_scalar); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_uint8_scalar, - "uint8 scalar", "uint8"); - -DEFUN (uint8, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} uint8 (@var{x})\n\ -Convert @var{x} to unsigned 8-bit integer type.\n\ -@end deftypefn") -{ - OCTAVE_TYPE_CONV_BODY (uint8); -} - -/* -%!assert (class (uint8 (1)), "uint8") -%!assert (uint8 (1.25), uint8 (1)) -%!assert (uint8 (1.5), uint8 (2)) -%!assert (uint8 (-1.5), uint8 (0)) -%!assert (uint8 (2^9), uint8 (2^8-1)) -%!assert (uint8 (-2^9), uint8 (0)) -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-uint8.h --- a/src/ov-uint8.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ -/* - -Copyright (C) 2004-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_uint8_h) -#define octave_uint8_h 1 - -#define OCTAVE_INT_T octave_uint8 - -#define OCTAVE_VALUE_INT_MATRIX_T octave_uint8_matrix -#define OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION uint8_array_value - -#define OCTAVE_VALUE_INT_SCALAR_T octave_uint8_scalar -#define OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION uint8_scalar_value - -#define OCTAVE_TYPE_PREDICATE_FUNCTION is_uint8_type - -#define OCTAVE_INT_MX_CLASS mxUINT8_CLASS - -#define OCTAVE_INT_BTYP btyp_uint8 - -#include "ov-intx.h" - -#undef OCTAVE_INT_T - -#undef OCTAVE_VALUE_INT_MATRIX_T -#undef OCTAVE_VALUE_INT_NDARRAY_EXTRACTOR_FUNCTION - -#undef OCTAVE_VALUE_INT_SCALAR_T -#undef OCTAVE_VALUE_INT_SCALAR_EXTRACTOR_FUNCTION - -#undef OCTAVE_TYPE_PREDICATE_FUNCTION - -#undef OCTAVE_INT_MX_CLASS - -#undef OCTAVE_INT_BTYP - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov-usr-fcn.cc --- a/src/ov-usr-fcn.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,966 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "str-vec.h" - -#include -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "oct-obj.h" -#include "ov-usr-fcn.h" -#include "ov.h" -#include "pager.h" -#include "pt-eval.h" -#include "pt-jump.h" -#include "pt-misc.h" -#include "pt-pr-code.h" -#include "pt-stmt.h" -#include "pt-walk.h" -#include "symtab.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "parse.h" -#include "profiler.h" -#include "variables.h" -#include "ov-fcn-handle.h" - -// Whether to optimize subsasgn method calls. -static bool Voptimize_subsasgn_calls = true; - -// User defined scripts. - -DEFINE_OCTAVE_ALLOCATOR (octave_user_script); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_user_script, - "user-defined script", - "user-defined script"); - -octave_user_script::octave_user_script (void) - : octave_user_code (), cmd_list (0), file_name (), - t_parsed (static_cast (0)), - t_checked (static_cast (0)), - call_depth (-1) -{ } - -octave_user_script::octave_user_script (const std::string& fnm, - const std::string& nm, - tree_statement_list *cmds, - const std::string& ds) - : octave_user_code (nm, ds), cmd_list (cmds), file_name (fnm), - t_parsed (static_cast (0)), - t_checked (static_cast (0)), - call_depth (-1) -{ - if (cmd_list) - cmd_list->mark_as_script_body (); -} - -octave_user_script::octave_user_script (const std::string& fnm, - const std::string& nm, - const std::string& ds) - : octave_user_code (nm, ds), cmd_list (0), file_name (fnm), - t_parsed (static_cast (0)), - t_checked (static_cast (0)), - call_depth (-1) -{ } - -octave_user_script::~octave_user_script (void) -{ - delete cmd_list; -} - -octave_value_list -octave_user_script::subsref (const std::string&, - const std::list&, int) -{ - octave_value_list retval; - - ::error ("invalid use of script %s in index expression", file_name.c_str ()); - - return retval; -} - -octave_value_list -octave_user_script::do_multi_index_op (int nargout, - const octave_value_list& args) -{ - octave_value_list retval; - - unwind_protect frame; - - if (! error_state) - { - if (args.length () == 0 && nargout == 0) - { - if (cmd_list) - { - frame.protect_var (call_depth); - call_depth++; - - if (call_depth < Vmax_recursion_depth) - { - octave_call_stack::push (this); - - frame.add_fcn (octave_call_stack::pop); - - frame.protect_var (tree_evaluator::statement_context); - tree_evaluator::statement_context = tree_evaluator::script; - - BEGIN_PROFILER_BLOCK (profiler_name ()) - cmd_list->accept (*current_evaluator); - END_PROFILER_BLOCK - - if (tree_return_command::returning) - tree_return_command::returning = 0; - - if (tree_break_command::breaking) - tree_break_command::breaking--; - - if (error_state) - octave_call_stack::backtrace_error_message (); - } - else - ::error ("max_recursion_depth exceeded"); - } - } - else - error ("invalid call to script %s", file_name.c_str ()); - } - - return retval; -} - -void -octave_user_script::accept (tree_walker& tw) -{ - tw.visit_octave_user_script (*this); -} - -// User defined functions. - -DEFINE_OCTAVE_ALLOCATOR (octave_user_function); - -DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_user_function, - "user-defined function", - "user-defined function"); - -// Ugh. This really needs to be simplified (code/data? -// extrinsic/intrinsic state?). - -octave_user_function::octave_user_function - (symbol_table::scope_id sid, tree_parameter_list *pl, - tree_parameter_list *rl, tree_statement_list *cl) - : octave_user_code (std::string (), std::string ()), - param_list (pl), ret_list (rl), cmd_list (cl), - lead_comm (), trail_comm (), file_name (), - location_line (0), location_column (0), - parent_name (), t_parsed (static_cast (0)), - t_checked (static_cast (0)), - system_fcn_file (false), call_depth (-1), - num_named_args (param_list ? param_list->length () : 0), - subfunction (false), inline_function (false), - anonymous_function (false), nested_function (false), - class_constructor (false), class_method (false), - parent_scope (-1), local_scope (sid), - curr_unwind_protect_frame (0) -{ - if (cmd_list) - cmd_list->mark_as_function_body (); - - if (local_scope >= 0) - symbol_table::set_curr_fcn (this, local_scope); -} - -octave_user_function::~octave_user_function (void) -{ - delete param_list; - delete ret_list; - delete cmd_list; - delete lead_comm; - delete trail_comm; - - symbol_table::erase_scope (local_scope); -} - -octave_user_function * -octave_user_function::define_ret_list (tree_parameter_list *t) -{ - ret_list = t; - - return this; -} - -void -octave_user_function::stash_fcn_file_name (const std::string& nm) -{ - file_name = nm; -} - -std::string -octave_user_function::profiler_name (void) const -{ - std::ostringstream result; - - if (is_inline_function ()) - result << "inline@" << fcn_file_name () - << ":" << location_line << ":" << location_column; - else if (is_anonymous_function ()) - result << "anonymous@" << fcn_file_name () - << ":" << location_line << ":" << location_column; - else if (is_subfunction ()) - result << parent_fcn_name () << ">" << name (); - else - result << name (); - - return result.str (); -} - -void -octave_user_function::mark_as_system_fcn_file (void) -{ - if (! file_name.empty ()) - { - // We really should stash the whole path to the file we found, - // when we looked it up, to avoid possible race conditions... - // FIXME - // - // We probably also don't need to get the library directory - // every time, but since this function is only called when the - // function file is parsed, it probably doesn't matter that - // much. - - std::string ff_name = fcn_file_in_path (file_name); - - if (Vfcn_file_dir == ff_name.substr (0, Vfcn_file_dir.length ())) - system_fcn_file = true; - } - else - system_fcn_file = false; -} - -bool -octave_user_function::takes_varargs (void) const -{ - return (param_list && param_list->takes_varargs ()); -} - -bool -octave_user_function::takes_var_return (void) const -{ - return (ret_list && ret_list->takes_varargs ()); -} - -void -octave_user_function::lock_subfunctions (void) -{ - symbol_table::lock_subfunctions (local_scope); -} - -void -octave_user_function::unlock_subfunctions (void) -{ - symbol_table::unlock_subfunctions (local_scope); -} - -octave_value_list -octave_user_function::all_va_args (const octave_value_list& args) -{ - octave_value_list retval; - - octave_idx_type n = args.length () - num_named_args; - - if (n > 0) - retval = args.slice (num_named_args, n); - - return retval; -} - -octave_value_list -octave_user_function::subsref (const std::string& type, - const std::list& idx, - int nargout) -{ - return octave_user_function::subsref (type, idx, nargout, 0); -} - -octave_value_list -octave_user_function::subsref (const std::string& type, - const std::list& idx, - int nargout, const std::list* lvalue_list) -{ - octave_value_list retval; - - switch (type[0]) - { - case '(': - { - int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout; - - retval = do_multi_index_op (tmp_nargout, idx.front (), - idx.size () == 1 ? lvalue_list : 0); - } - break; - - case '{': - case '.': - { - std::string nm = type_name (); - error ("%s cannot be indexed with %c", nm.c_str (), type[0]); - } - break; - - default: - panic_impossible (); - } - - // FIXME -- perhaps there should be an - // octave_value_list::next_subsref member function? See also - // octave_builtin::subsref. - - if (idx.size () > 1) - retval = retval(0).next_subsref (nargout, type, idx); - - return retval; -} - -octave_value_list -octave_user_function::do_multi_index_op (int nargout, - const octave_value_list& args) -{ - return do_multi_index_op (nargout, args, 0); -} - -octave_value_list -octave_user_function::do_multi_index_op (int nargout, - const octave_value_list& args, - const std::list* lvalue_list) -{ - octave_value_list retval; - - if (error_state) - return retval; - - if (! cmd_list) - return retval; - - int nargin = args.length (); - - unwind_protect frame; - - frame.protect_var (call_depth); - call_depth++; - - if (call_depth >= Vmax_recursion_depth) - { - ::error ("max_recursion_depth exceeded"); - return retval; - } - - // Save old and set current symbol table context, for - // eval_undefined_error(). - - int context = active_context (); - - octave_call_stack::push (this, local_scope, context); - frame.add_fcn (octave_call_stack::pop); - - if (call_depth > 0 && ! is_anonymous_function ()) - { - symbol_table::push_context (); - - frame.add_fcn (symbol_table::pop_context); - } - - string_vector arg_names = args.name_tags (); - - if (param_list && ! param_list->varargs_only ()) - { - param_list->define_from_arg_vector (args); - if (error_state) - return retval; - } - - // Force parameter list to be undefined when this function exits. - // Doing so decrements the reference counts on the values of local - // variables that are also named function parameters. - - if (param_list) - frame.add_method (param_list, &tree_parameter_list::undefine); - - // Force return list to be undefined when this function exits. - // Doing so decrements the reference counts on the values of local - // variables that are also named values returned by this function. - - if (ret_list) - frame.add_method (ret_list, &tree_parameter_list::undefine); - - if (call_depth == 0) - { - // Force symbols to be undefined again when this function - // exits. - // - // This cleanup function is added to the unwind_protect stack - // after the calls to clear the parameter lists so that local - // variables will be cleared before the parameter lists are - // cleared. That way, any function parameters that have been - // declared global will be unmarked as global before they are - // undefined by the clear_param_list cleanup function. - - frame.add_fcn (symbol_table::clear_variables); - } - - bind_automatic_vars (arg_names, nargin, nargout, all_va_args (args), - lvalue_list); - - bool echo_commands = (Vecho_executing_commands & ECHO_FUNCTIONS); - - if (echo_commands) - print_code_function_header (); - - // Set pointer to the current unwind_protect frame to allow - // certain builtins register simple cleanup in a very optimized manner. - // This is *not* intended as a general-purpose on-cleanup mechanism, - frame.protect_var (curr_unwind_protect_frame); - curr_unwind_protect_frame = &frame; - - // Evaluate the commands that make up the function. - - frame.protect_var (tree_evaluator::statement_context); - tree_evaluator::statement_context = tree_evaluator::function; - - bool special_expr = (is_inline_function () || is_anonymous_function ()); - - BEGIN_PROFILER_BLOCK (profiler_name ()) - - if (special_expr) - { - assert (cmd_list->length () == 1); - - tree_statement *stmt = 0; - - if ((stmt = cmd_list->front ()) - && stmt->is_expression ()) - { - tree_expression *expr = stmt->expression (); - - retval = expr->rvalue (nargout); - } - } - else - cmd_list->accept (*current_evaluator); - - END_PROFILER_BLOCK - - if (echo_commands) - print_code_function_trailer (); - - if (tree_return_command::returning) - tree_return_command::returning = 0; - - if (tree_break_command::breaking) - tree_break_command::breaking--; - - if (error_state) - { - octave_call_stack::backtrace_error_message (); - return retval; - } - - // Copy return values out. - - if (ret_list && ! special_expr) - { - ret_list->initialize_undefined_elements (my_name, nargout, Matrix ()); - - Cell varargout; - - if (ret_list->takes_varargs ()) - { - octave_value varargout_varval = symbol_table::varval ("varargout"); - - if (varargout_varval.is_defined ()) - { - varargout = varargout_varval.cell_value (); - - if (error_state) - error ("expecting varargout to be a cell array object"); - } - } - - if (! error_state) - retval = ret_list->convert_to_const_vector (nargout, varargout); - } - - return retval; -} - -void -octave_user_function::accept (tree_walker& tw) -{ - tw.visit_octave_user_function (*this); -} - -bool -octave_user_function::subsasgn_optimization_ok (void) -{ - bool retval = false; - if (Voptimize_subsasgn_calls - && param_list->length () > 0 && ! param_list->varargs_only () - && ret_list->length () == 1 && ! ret_list->takes_varargs ()) - { - tree_identifier *par1 = param_list->front ()->ident (); - tree_identifier *ret1 = ret_list->front ()->ident (); - retval = par1->name () == ret1->name (); - } - - return retval; -} - -#if 0 -void -octave_user_function::print_symtab_info (std::ostream& os) const -{ - symbol_table::print_info (os, local_scope); -} -#endif - -void -octave_user_function::print_code_function_header (void) -{ - tree_print_code tpc (octave_stdout, VPS4); - - tpc.visit_octave_user_function_header (*this); -} - -void -octave_user_function::print_code_function_trailer (void) -{ - tree_print_code tpc (octave_stdout, VPS4); - - tpc.visit_octave_user_function_trailer (*this); -} - -void -octave_user_function::bind_automatic_vars - (const string_vector& arg_names, int nargin, int nargout, - const octave_value_list& va_args, const std::list *lvalue_list) -{ - if (! arg_names.empty ()) - { - // It is better to save this in the hidden variable .argn. and - // then use that in the inputname function instead of using argn, - // which might be redefined in a function. Keep the old argn name - // for backward compatibility of functions that use it directly. - - symbol_table::varref ("argn") = arg_names; - symbol_table::varref (".argn.") = Cell (arg_names); - - symbol_table::mark_hidden (".argn."); - - symbol_table::mark_automatic ("argn"); - symbol_table::mark_automatic (".argn."); - } - - symbol_table::varref (".nargin.") = nargin; - symbol_table::varref (".nargout.") = nargout; - - symbol_table::mark_hidden (".nargin."); - symbol_table::mark_hidden (".nargout."); - - symbol_table::mark_automatic (".nargin."); - symbol_table::mark_automatic (".nargout."); - - if (takes_varargs ()) - symbol_table::varref ("varargin") = va_args.cell_value (); - - // Force .ignored. variable to be undefined by default. - symbol_table::varref (".ignored.") = octave_value (); - - if (lvalue_list) - { - octave_idx_type nbh = 0; - for (std::list::const_iterator p = lvalue_list->begin (); - p != lvalue_list->end (); p++) - nbh += p->is_black_hole (); - - if (nbh > 0) - { - // Only assign the hidden variable if black holes actually present. - Matrix bh (1, nbh); - octave_idx_type k = 0, l = 0; - for (std::list::const_iterator p = lvalue_list->begin (); - p != lvalue_list->end (); p++) - { - if (p->is_black_hole ()) - bh(l++) = k+1; - k += p->numel (); - } - - symbol_table::varref (".ignored.") = bh; - } - } - - symbol_table::mark_hidden (".ignored."); - symbol_table::mark_automatic (".ignored."); -} - -DEFUN (nargin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} nargin ()\n\ -@deftypefnx {Built-in Function} {} nargin (@var{fcn})\n\ -Within a function, return the number of arguments passed to the function.\n\ -At the top level, return the number of command line arguments passed to\n\ -Octave.\n\ -\n\ -If called with the optional argument @var{fcn}, a function name or handle,\n\ -return the declared number of arguments that the function can accept.\n\ -If the last argument is @var{varargin} the returned value is negative.\n\ -This feature does not work on builtin functions.\n\ -@seealso{nargout, varargin, isargout, varargout, nthargout}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value func = args(0); - - if (func.is_string ()) - { - std::string name = func.string_value (); - func = symbol_table::find_function (name); - if (func.is_undefined ()) - error ("nargout: invalid function name: %s", name.c_str ()); - } - - octave_function *fcn_val = func.function_value (); - if (fcn_val) - { - octave_user_function *fcn = fcn_val->user_function_value (true); - - if (fcn) - { - tree_parameter_list *param_list = fcn->parameter_list (); - - retval = param_list ? param_list->length () : 0; - if (fcn->takes_varargs ()) - retval = -1 - retval; - } - else - { - // Matlab gives up for histc, so maybe it's ok we give up somtimes too. - error ("nargin: nargin information not available for builtin functions"); - } - } - else - error ("nargin: FCN must be a string or function handle"); - } - else if (nargin == 0) - { - retval = symbol_table::varval (".nargin."); - - if (retval.is_undefined ()) - retval = 0; - } - else - print_usage (); - - return retval; -} - -DEFUN (nargout, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} nargout ()\n\ -@deftypefnx {Built-in Function} {} nargout (@var{fcn})\n\ -Within a function, return the number of values the caller expects to\n\ -receive. If called with the optional argument @var{fcn}, a function\n\ -name or handle, return the number of declared output values that the\n\ -function can produce. If the final output argument is @var{varargout}\n\ -the returned value is negative.\n\ -\n\ -For example,\n\ -\n\ -@example\n\ -f ()\n\ -@end example\n\ -\n\ -@noindent\n\ -will cause @code{nargout} to return 0 inside the function @code{f} and\n\ -\n\ -@example\n\ -[s, t] = f ()\n\ -@end example\n\ -\n\ -@noindent\n\ -will cause @code{nargout} to return 2 inside the function\n\ -@code{f}.\n\ -\n\ -In the second usage,\n\ -\n\ -@example\n\ -nargout (@@histc) \% or nargout ('histc')\n\ -@end example\n\ -\n\ -@noindent\n\ -will return 2, because @code{histc} has two outputs, whereas\n\ -\n\ -@example\n\ -nargout (@@deal)\n\ -@end example\n\ -\n\ -@noindent\n\ -will return -1, because @code{deal} has a variable number of outputs.\n\ -\n\ -At the top level, @code{nargout} with no argument is undefined.\n\ -@code{nargout} does not work on builtin functions.\n\ -@code{nargout} returns -1 for all anonymous functions.\n\ -@seealso{nargin, varargin, isargout, varargout, nthargout}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value func = args(0); - - if (func.is_string ()) - { - std::string name = func.string_value (); - func = symbol_table::find_function (name); - if (func.is_undefined ()) - error ("nargout: invalid function name: %s", name.c_str ()); - } - - if (func.is_inline_function ()) - { - retval = 1; - return retval; - } - - if (func.is_function_handle ()) - { - octave_fcn_handle *fh = func.fcn_handle_value (); - std::string fh_nm = fh->fcn_name (); - - if (fh_nm == octave_fcn_handle::anonymous) - { - retval = -1; - return retval; - } - } - - octave_function *fcn_val = func.function_value (); - if (fcn_val) - { - octave_user_function *fcn = fcn_val->user_function_value (true); - - if (fcn) - { - tree_parameter_list *ret_list = fcn->return_list (); - - retval = ret_list ? ret_list->length () : 0; - - if (fcn->takes_var_return ()) - retval = -1 - retval; - } - else - { - // JWE said this information is not available (currently, 2011-03-10) - // without making intrusive changes to Octave. - // Matlab gives up for histc, so maybe it's ok we give up somtimes too. - error ("nargout: nargout information not available for builtin functions."); - } - } - else - error ("nargout: FCN must be a string or function handle"); - } - else if (nargin == 0) - { - if (! symbol_table::at_top_level ()) - { - retval = symbol_table::varval (".nargout."); - - if (retval.is_undefined ()) - retval = 0; - } - else - error ("nargout: invalid call at top level"); - } - else - print_usage (); - - return retval; -} - -DEFUN (optimize_subsasgn_calls, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} optimize_subsasgn_calls ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} optimize_subsasgn_calls (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} optimize_subsasgn_calls (@var{new_val}, \"local\")\n\ -Query or set the internal flag for subsasgn method call optimizations.\n\ -If true, Octave will attempt to eliminate the redundant copying when calling\n\ -subsasgn method of a user-defined class.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (optimize_subsasgn_calls); -} - -static bool val_in_table (const Matrix& table, double val) -{ - if (table.is_empty ()) - return false; - - octave_idx_type i = table.lookup (val, ASCENDING); - return (i > 0 && table(i-1) == val); -} - -static bool isargout1 (int nargout, const Matrix& ignored, double k) -{ - if (k != xround (k) || k <= 0) - { - error ("isargout: K must be a positive integer"); - return false; - } - else - return (k == 1 || k <= nargout) && ! val_in_table (ignored, k); -} - -DEFUN (isargout, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isargout (@var{k})\n\ -Within a function, return a logical value indicating whether the argument\n\ -@var{k} will be assigned on output to a variable. If the result is false,\n\ -the argument has been ignored during the function call through the use of\n\ -the tilde (~) special output argument. Functions can use @code{isargout} to\n\ -avoid performing unnecessary calculations for outputs which are unwanted.\n\ -\n\ -If @var{k} is outside the range @code{1:max (nargout)}, the function returns\n\ -false. @var{k} can also be an array, in which case the function works\n\ -element-by-element and a logical array is returned. At the top level,\n\ -@code{isargout} returns an error.\n\ -@seealso{nargout, nargin, varargin, varargout, nthargout}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - if (! symbol_table::at_top_level ()) - { - int nargout1 = symbol_table::varval (".nargout.").int_value (); - if (error_state) - { - error ("isargout: internal error"); - return retval; - } - - Matrix ignored; - octave_value tmp = symbol_table::varval (".ignored."); - if (tmp.is_defined ()) - ignored = tmp.matrix_value (); - - if (args(0).is_scalar_type ()) - { - double k = args(0).double_value (); - if (! error_state) - retval = isargout1 (nargout1, ignored, k); - } - else if (args(0).is_numeric_type ()) - { - const NDArray ka = args(0).array_value (); - if (! error_state) - { - boolNDArray r (ka.dims ()); - for (octave_idx_type i = 0; i < ka.numel () && ! error_state; i++) - r(i) = isargout1 (nargout1, ignored, ka(i)); - - retval = r; - } - } - else - gripe_wrong_type_arg ("isargout", args(0)); - } - else - error ("isargout: invalid call at top level"); - } - else - print_usage (); - - return retval; -} - -/* -%!function [x, y] = try_isargout () -%! if (isargout (1)) -%! if (isargout (2)) -%! x = 1; y = 2; -%! else -%! x = -1; -%! endif -%! else -%! if (isargout (2)) -%! y = -2; -%! else -%! error ("no outputs requested"); -%! endif -%! endif -%!endfunction -%! -%!test -%! [x, y] = try_isargout (); -%! assert ([x, y], [1, 2]); -%! -%!test -%! [x, ~] = try_isargout (); -%! assert (x, -1); -%! -%!test -%! [~, y] = try_isargout (); -%! assert (y, -2); -%! -%!error [~, ~] = try_isargout (); -%! -%% Check to see that isargout isn't sticky: -%!test -%! [x, y] = try_isargout (); -%! assert ([x, y], [1, 2]); -*/ diff -r d02b229ce693 -r a132d206a36a src/ov-usr-fcn.h --- a/src/ov-usr-fcn.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,463 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_user_function_h) -#define octave_user_function_h 1 - -#include - -#include -#include - -#include "comment-list.h" -#include "oct-obj.h" -#include "ov-fcn.h" -#include "ov-typeinfo.h" -#include "symtab.h" -#include "unwind-prot.h" - -class string_vector; - -class octave_value; -class tree_parameter_list; -class tree_statement_list; -class tree_va_return_list; -class tree_walker; - -class -octave_user_code : public octave_function -{ -public: - octave_user_code (void) - : octave_function () { } - - ~octave_user_code (void) { } - - bool is_user_code (void) const { return true; } - - virtual tree_statement_list *body (void) = 0; - -protected: - - octave_user_code (const std::string& nm, - const std::string& ds = std::string ()) - : octave_function (nm, ds) { } - -private: - - // No copying! - - octave_user_code (const octave_user_code& f); - - octave_user_code& operator = (const octave_user_code& f); -}; - -// Scripts. - -class -octave_user_script : public octave_user_code -{ -public: - - octave_user_script (void); - - octave_user_script (const std::string& fnm, const std::string& nm, - tree_statement_list *cmds, - const std::string& ds = std::string ()); - - octave_user_script (const std::string& fnm, const std::string& nm, - const std::string& ds = std::string ()); - - ~octave_user_script (void); - - octave_function *function_value (bool = false) { return this; } - - octave_user_script *user_script_value (bool = false) { return this; } - - octave_user_code *user_code_value (bool = false) { return this; } - - // Scripts and user functions are both considered "scripts" because - // they are written in Octave's scripting language. - - bool is_user_script (void) const { return true; } - - void stash_fcn_file_name (const std::string& nm) { file_name = nm; } - - void mark_fcn_file_up_to_date (const octave_time& t) { t_checked = t; } - - void stash_fcn_file_time (const octave_time& t) - { - t_parsed = t; - mark_fcn_file_up_to_date (t); - } - - std::string fcn_file_name (void) const { return file_name; } - - octave_time time_parsed (void) const { return t_parsed; } - - octave_time time_checked (void) const { return t_checked; } - - octave_value subsref (const std::string& type, - const std::list& idx) - { - octave_value_list tmp = subsref (type, idx, 1); - return tmp.length () > 0 ? tmp(0) : octave_value (); - } - - octave_value_list subsref (const std::string& type, - const std::list& idx, - int nargout); - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& args); - - tree_statement_list *body (void) { return cmd_list; } - - void accept (tree_walker& tw); - -private: - - // The list of commands that make up the body of this function. - tree_statement_list *cmd_list; - - // The name of the file we parsed. - std::string file_name; - - // The time the file was parsed. - octave_time t_parsed; - - // The time the file was last checked to see if it needs to be - // parsed again. - octave_time t_checked; - - // Used to keep track of recursion depth. - int call_depth; - - // No copying! - - octave_user_script (const octave_user_script& f); - - octave_user_script& operator = (const octave_user_script& f); - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -// User-defined functions. - -class -octave_user_function : public octave_user_code -{ -public: - - octave_user_function (symbol_table::scope_id sid = -1, - tree_parameter_list *pl = 0, - tree_parameter_list *rl = 0, - tree_statement_list *cl = 0); - - ~octave_user_function (void); - - symbol_table::context_id active_context () const - { - return is_anonymous_function () - ? 0 : static_cast(call_depth); - } - - octave_function *function_value (bool = false) { return this; } - - octave_user_function *user_function_value (bool = false) { return this; } - - octave_user_code *user_code_value (bool = false) { return this; } - - octave_user_function *define_param_list (tree_parameter_list *t); - - octave_user_function *define_ret_list (tree_parameter_list *t); - - void stash_fcn_file_name (const std::string& nm); - - void stash_fcn_location (int line, int col) - { - location_line = line; - location_column = col; - } - - void stash_parent_fcn_name (const std::string& p) { parent_name = p; } - - void stash_parent_fcn_scope (symbol_table::scope_id ps) { parent_scope = ps; } - - void stash_leading_comment (octave_comment_list *lc) { lead_comm = lc; } - - void stash_trailing_comment (octave_comment_list *tc) { trail_comm = tc; } - - void mark_fcn_file_up_to_date (const octave_time& t) { t_checked = t; } - - void stash_fcn_file_time (const octave_time& t) - { - t_parsed = t; - mark_fcn_file_up_to_date (t); - } - - std::string fcn_file_name (void) const { return file_name; } - - std::string profiler_name (void) const; - - std::string parent_fcn_name (void) const { return parent_name; } - - symbol_table::scope_id parent_fcn_scope (void) const { return parent_scope; } - - symbol_table::scope_id scope (void) { return local_scope; } - - octave_time time_parsed (void) const { return t_parsed; } - - octave_time time_checked (void) const { return t_checked; } - - void mark_as_system_fcn_file (void); - - bool is_system_fcn_file (void) const { return system_fcn_file; } - - bool is_user_function (void) const { return true; } - - void erase_subfunctions (void) - { - symbol_table::erase_subfunctions_in_scope (local_scope); - } - - bool takes_varargs (void) const; - - bool takes_var_return (void) const; - - void mark_as_private_function (const std::string& cname = std::string ()) - { - symbol_table::mark_subfunctions_in_scope_as_private (local_scope, cname); - - octave_function::mark_as_private_function (cname); - } - - void lock_subfunctions (void); - - void unlock_subfunctions (void); - - octave_value_list all_va_args (const octave_value_list& args); - - void stash_function_name (const std::string& s) { my_name = s; } - - void mark_as_subfunction (void) { subfunction = true; } - - bool is_subfunction (void) const { return subfunction; } - - void mark_as_inline_function (void) { inline_function = true; } - - bool is_inline_function (void) const { return inline_function; } - - void mark_as_anonymous_function (void) { anonymous_function = true; } - - bool is_anonymous_function (void) const { return anonymous_function; } - - bool is_anonymous_function_of_class - (const std::string& cname = std::string ()) const - { - return anonymous_function - ? (cname.empty () - ? (! dispatch_class ().empty ()) - : cname == dispatch_class ()) - : false; - } - - bool is_nested_function (void) const { return nested_function; } - - void mark_as_nested_function (void) { nested_function = true; } - - void mark_as_class_constructor (void) { class_constructor = true; } - - bool is_class_constructor (const std::string& cname = std::string ()) const - { - return class_constructor - ? (cname.empty () ? true : cname == dispatch_class ()) : false; - } - - void mark_as_class_method (void) { class_method = true; } - - bool is_class_method (const std::string& cname = std::string ()) const - { - return class_method - ? (cname.empty () ? true : cname == dispatch_class ()) : false; - } - - octave_value subsref (const std::string& type, - const std::list& idx) - { - octave_value_list tmp = subsref (type, idx, 1); - return tmp.length () > 0 ? tmp(0) : octave_value (); - } - - octave_value_list subsref (const std::string& type, - const std::list& idx, - int nargout); - - octave_value_list subsref (const std::string& type, - const std::list& idx, - int nargout, const std::list* lvalue_list); - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& args); - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& args, - const std::list* lvalue_list); - - tree_parameter_list *parameter_list (void) { return param_list; } - - tree_parameter_list *return_list (void) { return ret_list; } - - tree_statement_list *body (void) { return cmd_list; } - - octave_comment_list *leading_comment (void) { return lead_comm; } - - octave_comment_list *trailing_comment (void) { return trail_comm; } - - bool subsasgn_optimization_ok (void); - - void accept (tree_walker& tw); - - template - bool local_protect (T& variable) - { - if (curr_unwind_protect_frame) - { - curr_unwind_protect_frame->protect_var (variable); - return true; - } - else - return false; - } - -#if 0 - void print_symtab_info (std::ostream& os) const; -#endif - -private: - - // List of arguments for this function. These are local variables. - tree_parameter_list *param_list; - - // List of parameters we return. These are also local variables in - // this function. - tree_parameter_list *ret_list; - - // The list of commands that make up the body of this function. - tree_statement_list *cmd_list; - - // The comments preceding the FUNCTION token. - octave_comment_list *lead_comm; - - // The comments preceding the ENDFUNCTION token. - octave_comment_list *trail_comm; - - // The name of the file we parsed. - std::string file_name; - - // Location where this function was defined. - int location_line; - int location_column; - - // The name of the parent function, if any. - std::string parent_name; - - // The time the file was parsed. - octave_time t_parsed; - - // The time the file was last checked to see if it needs to be - // parsed again. - octave_time t_checked; - - // True if this function came from a file that is considered to be a - // system function. This affects whether we check the time stamp - // on the file to see if it has changed. - bool system_fcn_file; - - // Used to keep track of recursion depth. - int call_depth; - - // The number of arguments that have names. - int num_named_args; - - // TRUE means this subfunction of a primary function. - bool subfunction; - - // TRUE means this is an inline function. - bool inline_function; - - // TRUE means this is an anonymous function. - bool anonymous_function; - - // TRUE means this is a nested function. (either a child or parent) - bool nested_function; - - // TRUE means this function is the constructor for class object. - bool class_constructor; - - // TRUE means this function is a method for a class. - bool class_method; - - // The scope of the parent function, if any. - symbol_table::scope_id parent_scope; - - symbol_table::scope_id local_scope; - - // pointer to the current unwind_protect frame of this function. - unwind_protect *curr_unwind_protect_frame; - -#if 0 - // The symbol record for argn in the local symbol table. - octave_value& argn_varref; - - // The symbol record for nargin in the local symbol table. - octave_value& nargin_varref; - - // The symbol record for nargout in the local symbol table. - octave_value& nargout_varref; - - // The symbol record for varargin in the local symbol table. - octave_value& varargin_varref; -#endif - - void print_code_function_header (void); - - void print_code_function_trailer (void); - - void bind_automatic_vars (const string_vector& arg_names, int nargin, - int nargout, const octave_value_list& va_args, - const std::list *lvalue_list); - - // No copying! - - octave_user_function (const octave_user_function& fn); - - octave_user_function& operator = (const octave_user_function& fn); - - DECLARE_OCTAVE_ALLOCATOR - - DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/ov.cc --- a/src/ov.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3046 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "data-conv.h" -#include "quit.h" -#include "str-vec.h" - -#include "oct-obj.h" -#include "oct-stream.h" -#include "ov.h" -#include "ov-base.h" -#include "ov-bool.h" -#include "ov-bool-mat.h" -#include "ov-cell.h" -#include "ov-scalar.h" -#include "ov-float.h" -#include "ov-re-mat.h" -#include "ov-flt-re-mat.h" -#include "ov-re-diag.h" -#include "ov-flt-re-diag.h" -#include "ov-perm.h" -#include "ov-bool-sparse.h" -#include "ov-cx-sparse.h" -#include "ov-re-sparse.h" -#include "ov-int8.h" -#include "ov-int16.h" -#include "ov-int32.h" -#include "ov-int64.h" -#include "ov-uint8.h" -#include "ov-uint16.h" -#include "ov-uint32.h" -#include "ov-uint64.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-cx-diag.h" -#include "ov-flt-cx-diag.h" -#include "ov-ch-mat.h" -#include "ov-str-mat.h" -#include "ov-range.h" -#include "ov-struct.h" -#include "ov-class.h" -#include "ov-oncleanup.h" -#include "ov-cs-list.h" -#include "ov-colon.h" -#include "ov-builtin.h" -#include "ov-dld-fcn.h" -#include "ov-usr-fcn.h" -#include "ov-fcn-handle.h" -#include "ov-fcn-inline.h" -#include "ov-typeinfo.h" -#include "ov-null-mat.h" -#include "ov-lazy-idx.h" - -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "pager.h" -#include "parse.h" -#include "pr-output.h" -#include "symtab.h" -#include "utils.h" -#include "variables.h" - -// We are likely to have a lot of octave_value objects to allocate, so -// make the grow_size large. -DEFINE_OCTAVE_ALLOCATOR2(octave_value, 1024); - -// FIXME - -// Octave's value type. - -std::string -octave_value::unary_op_as_string (unary_op op) -{ - std::string retval; - - switch (op) - { - case op_not: - retval = "!"; - break; - - case op_uplus: - retval = "+"; - break; - - case op_uminus: - retval = "-"; - break; - - case op_transpose: - retval = ".'"; - break; - - case op_hermitian: - retval = "'"; - break; - - case op_incr: - retval = "++"; - break; - - case op_decr: - retval = "--"; - break; - - default: - retval = ""; - } - - return retval; -} - -std::string -octave_value::unary_op_fcn_name (unary_op op) -{ - std::string retval; - - switch (op) - { - case op_not: - retval = "not"; - break; - - case op_uplus: - retval = "uplus"; - break; - - case op_uminus: - retval = "uminus"; - break; - - case op_transpose: - retval = "transpose"; - break; - - case op_hermitian: - retval = "ctranspose"; - break; - - default: - break; - } - - return retval; -} - -std::string -octave_value::binary_op_as_string (binary_op op) -{ - std::string retval; - - switch (op) - { - case op_add: - retval = "+"; - break; - - case op_sub: - retval = "-"; - break; - - case op_mul: - retval = "*"; - break; - - case op_div: - retval = "/"; - break; - - case op_pow: - retval = "^"; - break; - - case op_ldiv: - retval = "\\"; - break; - - case op_lshift: - retval = "<<"; - break; - - case op_rshift: - retval = ">>"; - break; - - case op_lt: - retval = "<"; - break; - - case op_le: - retval = "<="; - break; - - case op_eq: - retval = "=="; - break; - - case op_ge: - retval = ">="; - break; - - case op_gt: - retval = ">"; - break; - - case op_ne: - retval = "!="; - break; - - case op_el_mul: - retval = ".*"; - break; - - case op_el_div: - retval = "./"; - break; - - case op_el_pow: - retval = ".^"; - break; - - case op_el_ldiv: - retval = ".\\"; - break; - - case op_el_and: - retval = "&"; - break; - - case op_el_or: - retval = "|"; - break; - - case op_struct_ref: - retval = "."; - break; - - default: - retval = ""; - } - - return retval; -} - -std::string -octave_value::binary_op_fcn_name (binary_op op) -{ - std::string retval; - - switch (op) - { - case op_add: - retval = "plus"; - break; - - case op_sub: - retval = "minus"; - break; - - case op_mul: - retval = "mtimes"; - break; - - case op_div: - retval = "mrdivide"; - break; - - case op_pow: - retval = "mpower"; - break; - - case op_ldiv: - retval = "mldivide"; - break; - - case op_lt: - retval = "lt"; - break; - - case op_le: - retval = "le"; - break; - - case op_eq: - retval = "eq"; - break; - - case op_ge: - retval = "ge"; - break; - - case op_gt: - retval = "gt"; - break; - - case op_ne: - retval = "ne"; - break; - - case op_el_mul: - retval = "times"; - break; - - case op_el_div: - retval = "rdivide"; - break; - - case op_el_pow: - retval = "power"; - break; - - case op_el_ldiv: - retval = "ldivide"; - break; - - case op_el_and: - retval = "and"; - break; - - case op_el_or: - retval = "or"; - break; - - default: - break; - } - - return retval; -} - -std::string -octave_value::binary_op_fcn_name (compound_binary_op op) -{ - std::string retval; - - switch (op) - { - case op_trans_mul: - retval = "transtimes"; - break; - - case op_mul_trans: - retval = "timestrans"; - break; - - case op_herm_mul: - retval = "hermtimes"; - break; - - case op_mul_herm: - retval = "timesherm"; - break; - - case op_trans_ldiv: - retval = "transldiv"; - break; - - case op_herm_ldiv: - retval = "hermldiv"; - break; - - case op_el_and_not: - retval = "andnot"; - break; - - case op_el_or_not: - retval = "ornot"; - break; - - case op_el_not_and: - retval = "notand"; - break; - - case op_el_not_or: - retval = "notor"; - break; - - default: - break; - } - - return retval; -} - -std::string -octave_value::assign_op_as_string (assign_op op) -{ - std::string retval; - - switch (op) - { - case op_asn_eq: - retval = "="; - break; - - case op_add_eq: - retval = "+="; - break; - - case op_sub_eq: - retval = "-="; - break; - - case op_mul_eq: - retval = "*="; - break; - - case op_div_eq: - retval = "/="; - break; - - case op_ldiv_eq: - retval = "\\="; - break; - - case op_pow_eq: - retval = "^="; - break; - - case op_lshift_eq: - retval = "<<="; - break; - - case op_rshift_eq: - retval = ">>="; - break; - - case op_el_mul_eq: - retval = ".*="; - break; - - case op_el_div_eq: - retval = "./="; - break; - - case op_el_ldiv_eq: - retval = ".\\="; - break; - - case op_el_pow_eq: - retval = ".^="; - break; - - case op_el_and_eq: - retval = "&="; - break; - - case op_el_or_eq: - retval = "|="; - break; - - default: - retval = ""; - } - - return retval; -} - -octave_value::assign_op -octave_value::binary_op_to_assign_op (binary_op op) -{ - assign_op retval; - - switch (op) - { - case op_add: - retval = op_add_eq; - break; - case op_sub: - retval = op_sub_eq; - break; - case op_mul: - retval = op_mul_eq; - break; - case op_div: - retval = op_div_eq; - break; - case op_el_mul: - retval = op_el_mul_eq; - break; - case op_el_div: - retval = op_el_div_eq; - break; - case op_el_and: - retval = op_el_and_eq; - break; - case op_el_or: - retval = op_el_or_eq; - break; - default: - retval = unknown_assign_op; - } - - return retval; -} - -octave_value::octave_value (short int i) - : rep (new octave_scalar (i)) -{ -} - -octave_value::octave_value (unsigned short int i) - : rep (new octave_scalar (i)) -{ -} - -octave_value::octave_value (int i) - : rep (new octave_scalar (i)) -{ -} - -octave_value::octave_value (unsigned int i) - : rep (new octave_scalar (i)) -{ -} - -octave_value::octave_value (long int i) - : rep (new octave_scalar (i)) -{ -} - -octave_value::octave_value (unsigned long int i) - : rep (new octave_scalar (i)) -{ -} - -#if defined (HAVE_LONG_LONG_INT) -octave_value::octave_value (long long int i) - : rep (new octave_scalar (i)) -{ -} -#endif - -#if defined (HAVE_UNSIGNED_LONG_LONG_INT) -octave_value::octave_value (unsigned long long int i) - : rep (new octave_scalar (i)) -{ -} -#endif - -octave_value::octave_value (octave_time t) - : rep (new octave_scalar (t.double_value ())) -{ -} - -octave_value::octave_value (double d) - : rep (new octave_scalar (d)) -{ -} - -octave_value::octave_value (float d) - : rep (new octave_float_scalar (d)) -{ -} - -octave_value::octave_value (const Cell& c, bool is_csl) - : rep (is_csl - ? dynamic_cast (new octave_cs_list (c)) - : dynamic_cast (new octave_cell (c))) -{ -} - -octave_value::octave_value (const Array& a, bool is_csl) - : rep (is_csl - ? dynamic_cast (new octave_cs_list (Cell (a))) - : dynamic_cast (new octave_cell (Cell (a)))) -{ -} - -octave_value::octave_value (const Matrix& m, const MatrixType& t) - : rep (new octave_matrix (m, t)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const FloatMatrix& m, const MatrixType& t) - : rep (new octave_float_matrix (m, t)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const NDArray& a) - : rep (new octave_matrix (a)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const FloatNDArray& a) - : rep (new octave_float_matrix (a)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& a) - : rep (new octave_matrix (a)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& a) - : rep (new octave_float_matrix (a)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const DiagMatrix& d) - : rep (new octave_diag_matrix (d)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const FloatDiagMatrix& d) - : rep (new octave_float_diag_matrix (d)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const RowVector& v) - : rep (new octave_matrix (v)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const FloatRowVector& v) - : rep (new octave_float_matrix (v)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const ColumnVector& v) - : rep (new octave_matrix (v)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const FloatColumnVector& v) - : rep (new octave_float_matrix (v)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Complex& C) - : rep (new octave_complex (C)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const FloatComplex& C) - : rep (new octave_float_complex (C)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const ComplexMatrix& m, const MatrixType& t) - : rep (new octave_complex_matrix (m, t)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const FloatComplexMatrix& m, const MatrixType& t) - : rep (new octave_float_complex_matrix (m, t)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const ComplexNDArray& a) - : rep (new octave_complex_matrix (a)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const FloatComplexNDArray& a) - : rep (new octave_float_complex_matrix (a)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& a) - : rep (new octave_complex_matrix (a)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& a) - : rep (new octave_float_complex_matrix (a)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const ComplexDiagMatrix& d) - : rep (new octave_complex_diag_matrix (d)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const FloatComplexDiagMatrix& d) - : rep (new octave_float_complex_diag_matrix (d)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const ComplexRowVector& v) - : rep (new octave_complex_matrix (v)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const FloatComplexRowVector& v) - : rep (new octave_float_complex_matrix (v)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const ComplexColumnVector& v) - : rep (new octave_complex_matrix (v)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const FloatComplexColumnVector& v) - : rep (new octave_float_complex_matrix (v)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const PermMatrix& p) - : rep (new octave_perm_matrix (p)) -{ - maybe_mutate (); -} - -octave_value::octave_value (bool b) - : rep (new octave_bool (b)) -{ -} - -octave_value::octave_value (const boolMatrix& bm, const MatrixType& t) - : rep (new octave_bool_matrix (bm, t)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const boolNDArray& bnda) - : rep (new octave_bool_matrix (bnda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& bnda) - : rep (new octave_bool_matrix (bnda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (char c, char type) - : rep (type == '"' - ? new octave_char_matrix_dq_str (c) - : new octave_char_matrix_sq_str (c)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const char *s, char type) - : rep (type == '"' - ? new octave_char_matrix_dq_str (s) - : new octave_char_matrix_sq_str (s)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const std::string& s, char type) - : rep (type == '"' - ? new octave_char_matrix_dq_str (s) - : new octave_char_matrix_sq_str (s)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const string_vector& s, char type) - : rep (type == '"' - ? new octave_char_matrix_dq_str (s) - : new octave_char_matrix_sq_str (s)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const charMatrix& chm, char type) - : rep (type == '"' - ? new octave_char_matrix_dq_str (chm) - : new octave_char_matrix_sq_str (chm)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const charNDArray& chm, char type) - : rep (type == '"' - ? new octave_char_matrix_dq_str (chm) - : new octave_char_matrix_sq_str (chm)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& chm, char type) - : rep (type == '"' - ? new octave_char_matrix_dq_str (chm) - : new octave_char_matrix_sq_str (chm)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const charMatrix& chm, bool, char type) - : rep (type == '"' - ? new octave_char_matrix_dq_str (chm) - : new octave_char_matrix_sq_str (chm)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const charNDArray& chm, bool, char type) - : rep (type == '"' - ? new octave_char_matrix_dq_str (chm) - : new octave_char_matrix_sq_str (chm)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& chm, bool, char type) - : rep (type == '"' - ? new octave_char_matrix_dq_str (chm) - : new octave_char_matrix_sq_str (chm)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const SparseMatrix& m, const MatrixType &t) - : rep (new octave_sparse_matrix (m, t)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Sparse& m, const MatrixType &t) - : rep (new octave_sparse_matrix (m, t)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const SparseComplexMatrix& m, const MatrixType &t) - : rep (new octave_sparse_complex_matrix (m, t)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Sparse& m, const MatrixType &t) - : rep (new octave_sparse_complex_matrix (m, t)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const SparseBoolMatrix& bm, const MatrixType &t) - : rep (new octave_sparse_bool_matrix (bm, t)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Sparse& bm, const MatrixType &t) - : rep (new octave_sparse_bool_matrix (bm, t)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const octave_int8& i) - : rep (new octave_int8_scalar (i)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const octave_uint8& i) - : rep (new octave_uint8_scalar (i)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const octave_int16& i) - : rep (new octave_int16_scalar (i)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const octave_uint16& i) - : rep (new octave_uint16_scalar (i)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const octave_int32& i) - : rep (new octave_int32_scalar (i)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const octave_uint32& i) - : rep (new octave_uint32_scalar (i)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const octave_int64& i) - : rep (new octave_int64_scalar (i)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const octave_uint64& i) - : rep (new octave_uint64_scalar (i)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const int8NDArray& inda) - : rep (new octave_int8_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& inda) - : rep (new octave_int8_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const uint8NDArray& inda) - : rep (new octave_uint8_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& inda) - : rep (new octave_uint8_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const int16NDArray& inda) - : rep (new octave_int16_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& inda) - : rep (new octave_int16_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const uint16NDArray& inda) - : rep (new octave_uint16_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& inda) - : rep (new octave_uint16_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const int32NDArray& inda) - : rep (new octave_int32_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& inda) - : rep (new octave_int32_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const uint32NDArray& inda) - : rep (new octave_uint32_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& inda) - : rep (new octave_uint32_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const int64NDArray& inda) - : rep (new octave_int64_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& inda) - : rep (new octave_int64_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const uint64NDArray& inda) - : rep (new octave_uint64_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& inda) - : rep (new octave_uint64_matrix (inda)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Array& inda, bool zero_based, - bool cache_index) - : rep (new octave_matrix (inda, zero_based, cache_index)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const idx_vector& idx, bool lazy) - : rep () -{ - double scalar; - Range range; - NDArray array; - boolNDArray mask; - idx_vector::idx_class_type idx_class; - - if (lazy) - { - // Only make lazy indices out of ranges and index vectors. - switch (idx.idx_class ()) - { - case idx_vector::class_range: - case idx_vector::class_vector: - rep = new octave_lazy_index (idx); - maybe_mutate (); - return; - default: - break; - } - } - - idx.unconvert (idx_class, scalar, range, array, mask); - - switch (idx_class) - { - case idx_vector::class_colon: - rep = new octave_magic_colon (); - break; - case idx_vector::class_range: - rep = new octave_range (range, idx); - break; - case idx_vector::class_scalar: - rep = new octave_scalar (scalar); - break; - case idx_vector::class_vector: - rep = new octave_matrix (array, idx); - break; - case idx_vector::class_mask: - rep = new octave_bool_matrix (mask, idx); - break; - default: - assert (false); - break; - } - - // FIXME: needed? - maybe_mutate (); -} - -octave_value::octave_value (const Array& cellstr) - : rep (new octave_cell (cellstr)) -{ - maybe_mutate (); -} - -octave_value::octave_value (double base, double limit, double inc) - : rep (new octave_range (base, limit, inc)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Range& r) - : rep (new octave_range (r)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const octave_map& m) - : rep (new octave_struct (m)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const octave_scalar_map& m) - : rep (new octave_scalar_struct (m)) -{ -} - -octave_value::octave_value (const Octave_map& m) - : rep (new octave_struct (m)) -{ - maybe_mutate (); -} - -octave_value::octave_value (const Octave_map& m, const std::string& id, - const std::list& plist) - : rep (new octave_class (m, id, plist)) -{ -} - -octave_value::octave_value (const octave_value_list& l, bool) - : rep (new octave_cs_list (l)) -{ -} - -octave_value::octave_value (octave_value::magic_colon) - : rep (new octave_magic_colon ()) -{ -} - -octave_value::octave_value (octave_base_value *new_rep, bool borrow) - : rep (new_rep) -{ - if (borrow) - rep->count++; -} - -octave_value::octave_value (octave_base_value *new_rep, int xcount) - : rep (new_rep) -{ - rep->count = xcount; -} - -octave_base_value * -octave_value::clone (void) const -{ - return rep->clone (); -} - -void -octave_value::maybe_mutate (void) -{ - octave_base_value *tmp = rep->try_narrowing_conversion (); - - if (tmp && tmp != rep) - { - if (--rep->count == 0) - delete rep; - - rep = tmp; - } -} - -octave_value -octave_value::single_subsref (const std::string& type, - const octave_value_list& idx) -{ - std::list i; - - i.push_back (idx); - - return rep->subsref (type, i); -} - -octave_value_list -octave_value::subsref (const std::string& type, - const std::list& idx, int nargout) -{ - if (nargout == 1) - return rep->subsref (type, idx); - else - return rep->subsref (type, idx, nargout); -} - -octave_value_list -octave_value::subsref (const std::string& type, - const std::list& idx, int nargout, - const std::list *lvalue_list) -{ - if (lvalue_list) - return rep->subsref (type, idx, nargout, lvalue_list); - else - return subsref (type, idx, nargout); -} - -octave_value -octave_value::next_subsref (const std::string& type, - const std::list& idx, - size_t skip) -{ - if (! error_state && idx.size () > skip) - { - std::list new_idx (idx); - for (size_t i = 0; i < skip; i++) - new_idx.erase (new_idx.begin ()); - return subsref (type.substr (skip), new_idx); - } - else - return *this; -} - -octave_value_list -octave_value::next_subsref (int nargout, const std::string& type, - const std::list& idx, - size_t skip) -{ - if (! error_state && idx.size () > skip) - { - std::list new_idx (idx); - for (size_t i = 0; i < skip; i++) - new_idx.erase (new_idx.begin ()); - return subsref (type.substr (skip), new_idx, nargout); - } - else - return *this; -} - -octave_value -octave_value::next_subsref (bool auto_add, const std::string& type, - const std::list& idx, - size_t skip) -{ - if (! error_state && idx.size () > skip) - { - std::list new_idx (idx); - for (size_t i = 0; i < skip; i++) - new_idx.erase (new_idx.begin ()); - return subsref (type.substr (skip), new_idx, auto_add); - } - else - return *this; -} - -octave_value_list -octave_value::do_multi_index_op (int nargout, const octave_value_list& idx) -{ - return rep->do_multi_index_op (nargout, idx); -} - -octave_value_list -octave_value::do_multi_index_op (int nargout, const octave_value_list& idx, - const std::list *lvalue_list) -{ - return rep->do_multi_index_op (nargout, idx, lvalue_list); -} - -#if 0 -static void -gripe_assign_failed (const std::string& on, const std::string& tn1, - const std::string& tn2) -{ - error ("assignment failed for `%s %s %s'", - tn1.c_str (), on.c_str (), tn2.c_str ()); -} -#endif - -static void -gripe_assign_failed_or_no_method (const std::string& on, - const std::string& tn1, - const std::string& tn2) -{ - error ("assignment failed, or no method for `%s %s %s'", - tn1.c_str (), on.c_str (), tn2.c_str ()); -} - -octave_value -octave_value::subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - return rep->subsasgn (type, idx, rhs); -} - -octave_value -octave_value::undef_subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - return rep->undef_subsasgn (type, idx, rhs); -} - -octave_value& -octave_value::assign (assign_op op, const std::string& type, - const std::list& idx, - const octave_value& rhs) -{ - octave_value retval; - - make_unique (); - - octave_value t_rhs = rhs; - - if (op != op_asn_eq) - { - if (is_defined ()) - { - octave_value t = subsref (type, idx); - - if (! error_state) - { - binary_op binop = op_eq_to_binary_op (op); - - if (! error_state) - t_rhs = do_binary_op (binop, t, rhs); - } - } - else - error ("in computed assignment A(index) OP= X, A must be defined first"); - } - - if (! error_state) - { - octave_value tmp = subsasgn (type, idx, t_rhs); - - if (error_state) - gripe_assign_failed_or_no_method (assign_op_as_string (op_asn_eq), - type_name (), rhs.type_name ()); - else - *this = tmp; - } - - return *this; -} - -octave_value& -octave_value::assign (assign_op op, const octave_value& rhs) -{ - if (op == op_asn_eq) - // Regularize a null matrix if stored into a variable. - operator = (rhs.storable_value ()); - else if (is_defined ()) - { - octave_value_typeinfo::assign_op_fcn f = 0; - - // Only attempt to operate in-place if this variable is unshared. - if (rep->count == 1) - { - int tthis = this->type_id (); - int trhs = rhs.type_id (); - - f = octave_value_typeinfo::lookup_assign_op (op, tthis, trhs); - } - - if (f) - { - try - { - f (*rep, octave_value_list (), *rhs.rep); - maybe_mutate (); // Usually unnecessary, but may be needed (complex arrays). - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - else - { - - binary_op binop = op_eq_to_binary_op (op); - - if (! error_state) - { - octave_value t = do_binary_op (binop, *this, rhs); - - if (! error_state) - operator = (t); - } - } - } - else - error ("in computed assignment A OP= X, A must be defined first"); - - return *this; -} - -octave_idx_type -octave_value::length (void) const -{ - octave_idx_type retval = 0; - - const dim_vector dv = dims (); - - for (int i = 0; i < dv.length (); i++) - { - if (dv(i) == 0) - { - retval = 0; - break; - } - - if (dv(i) > retval) - retval = dv(i); - } - - return retval; -} - -bool -octave_value::is_equal (const octave_value& test) const -{ - bool retval = false; - - // If there is no op_eq for these types, we can't compare values. - - if (rows () == test.rows () && columns () == test.columns ()) - { - octave_value tmp = do_binary_op (octave_value::op_eq, *this, test); - - // Empty array also means a match. - if (! error_state && tmp.is_defined ()) - retval = tmp.is_true () || tmp.is_empty (); - } - - return retval; -} - -Cell -octave_value::cell_value (void) const -{ - return rep->cell_value (); -} - -// Define the idx_type_value function here instead of in ov.h to avoid -// needing definitions for the SIZEOF_X macros in ov.h. - -octave_idx_type -octave_value::idx_type_value (bool req_int, bool frc_str_conv) const -{ -#if SIZEOF_OCTAVE_IDX_TYPE == SIZEOF_LONG - return long_value (req_int, frc_str_conv); -#elif SIZEOF_OCTAVE_IDX_TYPE == SIZEOF_INT - return int_value (req_int, frc_str_conv); -#else -#error "no octave_value extractor for octave_idx_type" -#endif -} - -octave_map -octave_value::map_value (void) const -{ - return rep->map_value (); -} - -octave_scalar_map -octave_value::scalar_map_value (void) const -{ - return rep->scalar_map_value (); -} - -octave_function * -octave_value::function_value (bool silent) const -{ - return rep->function_value (silent); -} - -octave_user_function * -octave_value::user_function_value (bool silent) const -{ - return rep->user_function_value (silent); -} - -octave_user_script * -octave_value::user_script_value (bool silent) const -{ - return rep->user_script_value (silent); -} - -octave_user_code * -octave_value::user_code_value (bool silent) const -{ - return rep->user_code_value (silent); -} - -octave_fcn_handle * -octave_value::fcn_handle_value (bool silent) const -{ - return rep->fcn_handle_value (silent); -} - -octave_fcn_inline * -octave_value::fcn_inline_value (bool silent) const -{ - return rep->fcn_inline_value (silent); -} - -octave_value_list -octave_value::list_value (void) const -{ - return rep->list_value (); -} - -static dim_vector -make_vector_dims (const dim_vector& dv, bool force_vector_conversion, - const std::string& my_type, const std::string& wanted_type) -{ - dim_vector retval (dv); - retval.chop_trailing_singletons (); - octave_idx_type nel = dv.numel (); - - if (retval.length () > 2 || (retval(0) != 1 && retval(1) != 1)) - { - if (!force_vector_conversion) - gripe_implicit_conversion ("Octave:array-to-vector", - my_type.c_str (), wanted_type.c_str ()); - retval = dim_vector (nel, 1); - } - - return retval; -} - -ColumnVector -octave_value::column_vector_value (bool force_string_conv, - bool frc_vec_conv) const -{ - return ColumnVector (vector_value (force_string_conv, - frc_vec_conv)); -} - -ComplexColumnVector -octave_value::complex_column_vector_value (bool force_string_conv, - bool frc_vec_conv) const -{ - return ComplexColumnVector (complex_vector_value (force_string_conv, - frc_vec_conv)); -} - -RowVector -octave_value::row_vector_value (bool force_string_conv, - bool frc_vec_conv) const -{ - return RowVector (vector_value (force_string_conv, - frc_vec_conv)); -} - -ComplexRowVector -octave_value::complex_row_vector_value (bool force_string_conv, - bool frc_vec_conv) const -{ - return ComplexRowVector (complex_vector_value (force_string_conv, - frc_vec_conv)); -} - -Array -octave_value::vector_value (bool force_string_conv, - bool force_vector_conversion) const -{ - Array retval = array_value (force_string_conv); - - if (error_state) - return retval; - else - return retval.reshape (make_vector_dims (retval.dims (), - force_vector_conversion, - type_name (), "real vector")); -} - -template -static Array -convert_to_int_array (const Array >& A) -{ - Array retval (A.dims ()); - octave_idx_type n = A.numel (); - - for (octave_idx_type i = 0; i < n; i++) - retval.xelem (i) = octave_int (A.xelem (i)); - - return retval; -} - -Array -octave_value::int_vector_value (bool force_string_conv, bool require_int, - bool force_vector_conversion) const -{ - Array retval; - - if (is_integer_type ()) - { - if (is_int32_type ()) - retval = convert_to_int_array (int32_array_value ()); - else if (is_int64_type ()) - retval = convert_to_int_array (int64_array_value ()); - else if (is_int16_type ()) - retval = convert_to_int_array (int16_array_value ()); - else if (is_int8_type ()) - retval = convert_to_int_array (int8_array_value ()); - else if (is_uint32_type ()) - retval = convert_to_int_array (uint32_array_value ()); - else if (is_uint64_type ()) - retval = convert_to_int_array (uint64_array_value ()); - else if (is_uint16_type ()) - retval = convert_to_int_array (uint16_array_value ()); - else if (is_uint8_type ()) - retval = convert_to_int_array (uint8_array_value ()); - else - retval = array_value (force_string_conv); - } - else - { - const NDArray a = array_value (force_string_conv); - if (! error_state) - { - if (require_int) - { - retval.resize (a.dims ()); - for (octave_idx_type i = 0; i < a.numel (); i++) - { - double ai = a.elem (i); - int v = static_cast (ai); - if (ai == v) - retval.xelem (i) = v; - else - { - error_with_cfn ("conversion to integer value failed"); - break; - } - } - } - else - retval = Array (a); - } - } - - - if (error_state) - return retval; - else - return retval.reshape (make_vector_dims (retval.dims (), - force_vector_conversion, - type_name (), "integer vector")); -} - -template -static Array -convert_to_octave_idx_type_array (const Array >& A) -{ - Array retval (A.dims ()); - octave_idx_type n = A.numel (); - - for (octave_idx_type i = 0; i < n; i++) - retval.xelem (i) = octave_int (A.xelem (i)); - - return retval; -} - -Array -octave_value::octave_idx_type_vector_value (bool require_int, - bool force_string_conv, - bool force_vector_conversion) const -{ - Array retval; - - if (is_integer_type ()) - { - if (is_int32_type ()) - retval = convert_to_octave_idx_type_array (int32_array_value ()); - else if (is_int64_type ()) - retval = convert_to_octave_idx_type_array (int64_array_value ()); - else if (is_int16_type ()) - retval = convert_to_octave_idx_type_array (int16_array_value ()); - else if (is_int8_type ()) - retval = convert_to_octave_idx_type_array (int8_array_value ()); - else if (is_uint32_type ()) - retval = convert_to_octave_idx_type_array (uint32_array_value ()); - else if (is_uint64_type ()) - retval = convert_to_octave_idx_type_array (uint64_array_value ()); - else if (is_uint16_type ()) - retval = convert_to_octave_idx_type_array (uint16_array_value ()); - else if (is_uint8_type ()) - retval = convert_to_octave_idx_type_array (uint8_array_value ()); - else - retval = array_value (force_string_conv); - } - else - { - const NDArray a = array_value (force_string_conv); - if (! error_state) - { - if (require_int) - { - retval.resize (a.dims ()); - for (octave_idx_type i = 0; i < a.numel (); i++) - { - double ai = a.elem (i); - octave_idx_type v = static_cast (ai); - if (ai == v) - retval.xelem (i) = v; - else - { - error_with_cfn ("conversion to integer value failed"); - break; - } - } - } - else - retval = Array (a); - } - } - - - if (error_state) - return retval; - else - return retval.reshape (make_vector_dims (retval.dims (), - force_vector_conversion, - type_name (), "integer vector")); -} - -Array -octave_value::complex_vector_value (bool force_string_conv, - bool force_vector_conversion) const -{ - Array retval = complex_array_value (force_string_conv); - - if (error_state) - return retval; - else - return retval.reshape (make_vector_dims (retval.dims (), - force_vector_conversion, - type_name (), "complex vector")); -} - -FloatColumnVector -octave_value::float_column_vector_value (bool force_string_conv, - bool frc_vec_conv) const -{ - return FloatColumnVector (float_vector_value (force_string_conv, - frc_vec_conv)); -} - -FloatComplexColumnVector -octave_value::float_complex_column_vector_value (bool force_string_conv, - bool frc_vec_conv) const -{ - return FloatComplexColumnVector (float_complex_vector_value (force_string_conv, - frc_vec_conv)); -} - -FloatRowVector -octave_value::float_row_vector_value (bool force_string_conv, - bool frc_vec_conv) const -{ - return FloatRowVector (float_vector_value (force_string_conv, - frc_vec_conv)); -} - -FloatComplexRowVector -octave_value::float_complex_row_vector_value (bool force_string_conv, - bool frc_vec_conv) const -{ - return FloatComplexRowVector (float_complex_vector_value (force_string_conv, - frc_vec_conv)); -} - -Array -octave_value::float_vector_value (bool force_string_conv, - bool force_vector_conversion) const -{ - Array retval = float_array_value (force_string_conv); - - if (error_state) - return retval; - else - return retval.reshape (make_vector_dims (retval.dims (), - force_vector_conversion, - type_name (), "real vector")); -} - -Array -octave_value::float_complex_vector_value (bool force_string_conv, - bool force_vector_conversion) const -{ - Array retval = float_complex_array_value (force_string_conv); - - if (error_state) - return retval; - else - return retval.reshape (make_vector_dims (retval.dims (), - force_vector_conversion, - type_name (), "complex vector")); -} - -octave_value -octave_value::storable_value (void) const -{ - octave_value retval = *this; - if (is_null_value ()) - retval = octave_value (rep->empty_clone ()); - else - retval.maybe_economize (); - - return retval; -} - -void -octave_value::make_storable_value (void) -{ - if (is_null_value ()) - { - octave_base_value *rc = rep->empty_clone (); - if (--rep->count == 0) - delete rep; - rep = rc; - } - else - maybe_economize (); -} - -int -octave_value::write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const -{ - return rep->write (os, block_size, output_type, skip, flt_fmt); -} - -static void -gripe_binary_op (const std::string& on, const std::string& tn1, - const std::string& tn2) -{ - error ("binary operator `%s' not implemented for `%s' by `%s' operations", - on.c_str (), tn1.c_str (), tn2.c_str ()); -} - -static void -gripe_binary_op_conv (const std::string& on) -{ - error ("type conversion failed for binary operator `%s'", on.c_str ()); -} - -octave_value -do_binary_op (octave_value::binary_op op, - const octave_value& v1, const octave_value& v2) -{ - octave_value retval; - - int t1 = v1.type_id (); - int t2 = v2.type_id (); - - if (t1 == octave_class::static_type_id () - || t2 == octave_class::static_type_id ()) - { - octave_value_typeinfo::binary_class_op_fcn f - = octave_value_typeinfo::lookup_binary_class_op (op); - - if (f) - { - try - { - retval = f (v1, v2); - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - else - gripe_binary_op (octave_value::binary_op_as_string (op), - v1.class_name (), v2.class_name ()); - } - else - { - // FIXME -- we need to handle overloading operators for built-in - // classes (double, char, int8, etc.) - - octave_value_typeinfo::binary_op_fcn f - = octave_value_typeinfo::lookup_binary_op (op, t1, t2); - - if (f) - { - try - { - retval = f (*v1.rep, *v2.rep); - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - else - { - octave_value tv1; - octave_base_value::type_conv_info cf1 = v1.numeric_conversion_function (); - - octave_value tv2; - octave_base_value::type_conv_info cf2 = v2.numeric_conversion_function (); - - // Try biased (one-sided) conversions first. - if (cf2.type_id () >= 0 && - octave_value_typeinfo::lookup_binary_op (op, t1, cf2.type_id ())) - cf1 = 0; - else if (cf1.type_id () >= 0 && - octave_value_typeinfo::lookup_binary_op (op, cf1.type_id (), t2)) - cf2 = 0; - - if (cf1) - { - octave_base_value *tmp = cf1 (*v1.rep); - - if (tmp) - { - tv1 = octave_value (tmp); - t1 = tv1.type_id (); - } - else - { - gripe_binary_op_conv (octave_value::binary_op_as_string (op)); - return retval; - } - } - else - tv1 = v1; - - if (cf2) - { - octave_base_value *tmp = cf2 (*v2.rep); - - if (tmp) - { - tv2 = octave_value (tmp); - t2 = tv2.type_id (); - } - else - { - gripe_binary_op_conv (octave_value::binary_op_as_string (op)); - return retval; - } - } - else - tv2 = v2; - - if (cf1 || cf2) - { - retval = do_binary_op (op, tv1, tv2); - } - else - { - //demote double -> single and try again - cf1 = tv1.numeric_demotion_function (); - - cf2 = tv2.numeric_demotion_function (); - - // Try biased (one-sided) conversions first. - if (cf2.type_id () >= 0 - && octave_value_typeinfo::lookup_binary_op (op, t1, cf2.type_id ())) - cf1 = 0; - else if (cf1.type_id () >= 0 - && octave_value_typeinfo::lookup_binary_op (op, cf1.type_id (), t2)) - cf2 = 0; - - if (cf1) - { - octave_base_value *tmp = cf1 (*tv1.rep); - - if (tmp) - { - tv1 = octave_value (tmp); - t1 = tv1.type_id (); - } - else - { - gripe_binary_op_conv (octave_value::binary_op_as_string (op)); - return retval; - } - } - - if (cf2) - { - octave_base_value *tmp = cf2 (*tv2.rep); - - if (tmp) - { - tv2 = octave_value (tmp); - t2 = tv2.type_id (); - } - else - { - gripe_binary_op_conv (octave_value::binary_op_as_string (op)); - return retval; - } - } - - if (cf1 || cf2) - { - f = octave_value_typeinfo::lookup_binary_op (op, t1, t2); - - if (f) - { - try - { - retval = f (*tv1.rep, *tv2.rep); - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - else - gripe_binary_op (octave_value::binary_op_as_string (op), - v1.type_name (), v2.type_name ()); - } - else - gripe_binary_op (octave_value::binary_op_as_string (op), - v1.type_name (), v2.type_name ()); - } - } - } - - return retval; -} - -static octave_value -decompose_binary_op (octave_value::compound_binary_op op, - const octave_value& v1, const octave_value& v2) -{ - octave_value retval; - - switch (op) - { - case octave_value::op_trans_mul: - retval = do_binary_op (octave_value::op_mul, - do_unary_op (octave_value::op_transpose, v1), - v2); - break; - case octave_value::op_mul_trans: - retval = do_binary_op (octave_value::op_mul, - v1, - do_unary_op (octave_value::op_transpose, v2)); - break; - case octave_value::op_herm_mul: - retval = do_binary_op (octave_value::op_mul, - do_unary_op (octave_value::op_hermitian, v1), - v2); - break; - case octave_value::op_mul_herm: - retval = do_binary_op (octave_value::op_mul, - v1, - do_unary_op (octave_value::op_hermitian, v2)); - break; - case octave_value::op_trans_ldiv: - retval = do_binary_op (octave_value::op_ldiv, - do_unary_op (octave_value::op_transpose, v1), - v2); - break; - case octave_value::op_herm_ldiv: - retval = do_binary_op (octave_value::op_ldiv, - do_unary_op (octave_value::op_hermitian, v1), - v2); - break; - case octave_value::op_el_not_and: - retval = do_binary_op (octave_value::op_el_and, - do_unary_op (octave_value::op_not, v1), - v2); - break; - case octave_value::op_el_not_or: - retval = do_binary_op (octave_value::op_el_or, - do_unary_op (octave_value::op_not, v1), - v2); - break; - case octave_value::op_el_and_not: - retval = do_binary_op (octave_value::op_el_and, - v1, - do_unary_op (octave_value::op_not, v2)); - break; - case octave_value::op_el_or_not: - retval = do_binary_op (octave_value::op_el_or, - v1, - do_unary_op (octave_value::op_not, v2)); - break; - default: - error ("invalid compound operator"); - break; - } - - return retval; -} - -octave_value -do_binary_op (octave_value::compound_binary_op op, - const octave_value& v1, const octave_value& v2) -{ - octave_value retval; - - int t1 = v1.type_id (); - int t2 = v2.type_id (); - - if (t1 == octave_class::static_type_id () - || t2 == octave_class::static_type_id ()) - { - octave_value_typeinfo::binary_class_op_fcn f - = octave_value_typeinfo::lookup_binary_class_op (op); - - if (f) - { - try - { - retval = f (v1, v2); - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - else - retval = decompose_binary_op (op, v1, v2); - } - else - { - octave_value_typeinfo::binary_op_fcn f - = octave_value_typeinfo::lookup_binary_op (op, t1, t2); - - if (f) - { - try - { - retval = f (*v1.rep, *v2.rep); - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - else - retval = decompose_binary_op (op, v1, v2); - } - - return retval; -} - -static void -gripe_cat_op (const std::string& tn1, const std::string& tn2) -{ - error ("concatenation operator not implemented for `%s' by `%s' operations", - tn1.c_str (), tn2.c_str ()); -} - -static void -gripe_cat_op_conv (void) -{ - error ("type conversion failed for concatenation operator"); -} - -octave_value -do_cat_op (const octave_value& v1, const octave_value& v2, - const Array& ra_idx) -{ - octave_value retval; - - // Can't rapid return for concatenation with an empty object here as - // something like cat(1,[],single([]) must return the correct type. - - int t1 = v1.type_id (); - int t2 = v2.type_id (); - - octave_value_typeinfo::cat_op_fcn f - = octave_value_typeinfo::lookup_cat_op (t1, t2); - - if (f) - { - try - { - retval = f (*v1.rep, *v2.rep, ra_idx); - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - else - { - octave_value tv1; - octave_base_value::type_conv_info cf1 = v1.numeric_conversion_function (); - - octave_value tv2; - octave_base_value::type_conv_info cf2 = v2.numeric_conversion_function (); - - // Try biased (one-sided) conversions first. - if (cf2.type_id () >= 0 - && octave_value_typeinfo::lookup_cat_op (t1, cf2.type_id ())) - cf1 = 0; - else if (cf1.type_id () >= 0 - && octave_value_typeinfo::lookup_cat_op (cf1.type_id (), t2)) - cf2 = 0; - - if (cf1) - { - octave_base_value *tmp = cf1 (*v1.rep); - - if (tmp) - { - tv1 = octave_value (tmp); - t1 = tv1.type_id (); - } - else - { - gripe_cat_op_conv (); - return retval; - } - } - else - tv1 = v1; - - if (cf2) - { - octave_base_value *tmp = cf2 (*v2.rep); - - if (tmp) - { - tv2 = octave_value (tmp); - t2 = tv2.type_id (); - } - else - { - gripe_cat_op_conv (); - return retval; - } - } - else - tv2 = v2; - - if (cf1 || cf2) - { - retval = do_cat_op (tv1, tv2, ra_idx); - } - else - gripe_cat_op (v1.type_name (), v2.type_name ()); - } - - return retval; -} - -void -octave_value::print_info (std::ostream& os, const std::string& prefix) const -{ - os << prefix << "type_name: " << type_name () << "\n" - << prefix << "count: " << get_count () << "\n" - << prefix << "rep info: "; - - rep->print_info (os, prefix + " "); -} - -static void -gripe_unary_op (const std::string& on, const std::string& tn) -{ - error ("unary operator `%s' not implemented for `%s' operands", - on.c_str (), tn.c_str ()); -} - -static void -gripe_unary_op_conv (const std::string& on) -{ - error ("type conversion failed for unary operator `%s'", on.c_str ()); -} - -octave_value -do_unary_op (octave_value::unary_op op, const octave_value& v) -{ - octave_value retval; - - int t = v.type_id (); - - if (t == octave_class::static_type_id ()) - { - octave_value_typeinfo::unary_class_op_fcn f - = octave_value_typeinfo::lookup_unary_class_op (op); - - if (f) - { - try - { - retval = f (v); - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - else - gripe_unary_op (octave_value::unary_op_as_string (op), - v.class_name ()); - } - else - { - // FIXME -- we need to handle overloading operators for built-in - // classes (double, char, int8, etc.) - - octave_value_typeinfo::unary_op_fcn f - = octave_value_typeinfo::lookup_unary_op (op, t); - - if (f) - { - try - { - retval = f (*v.rep); - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - else - { - octave_value tv; - octave_base_value::type_conv_fcn cf - = v.numeric_conversion_function (); - - if (cf) - { - octave_base_value *tmp = cf (*v.rep); - - if (tmp) - { - tv = octave_value (tmp); - retval = do_unary_op (op, tv); - } - else - gripe_unary_op_conv (octave_value::unary_op_as_string (op)); - } - else - gripe_unary_op (octave_value::unary_op_as_string (op), - v.type_name ()); - } - } - - return retval; -} - -static void -gripe_unary_op_conversion_failed (const std::string& op, - const std::string& tn) -{ - error ("operator %s: type conversion for `%s' failed", - op.c_str (), tn.c_str ()); -} - -octave_value& -octave_value::do_non_const_unary_op (unary_op op) -{ - if (op == op_incr || op == op_decr) - { - // We want the gripe just here, because in the other branch this should - // not happen, and if it did anyway (internal error), the message would - // be confusing. - if (is_undefined ()) - { - std::string op_str = unary_op_as_string (op); - error ("in x%s or %sx, x must be defined first", - op_str.c_str (), op_str.c_str ()); - return *this; - } - - // Genuine. - int t = type_id (); - - octave_value_typeinfo::non_const_unary_op_fcn f - = octave_value_typeinfo::lookup_non_const_unary_op (op, t); - - if (f) - { - make_unique (); - - try - { - f (*rep); - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - else - { - octave_base_value::type_conv_fcn cf = numeric_conversion_function (); - - if (cf) - { - octave_base_value *tmp = cf (*rep); - - if (tmp) - { - octave_base_value *old_rep = rep; - rep = tmp; - - t = type_id (); - - f = octave_value_typeinfo::lookup_non_const_unary_op (op, t); - - if (f) - { - try - { - f (*rep); - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - - if (old_rep && --old_rep->count == 0) - delete old_rep; - } - else - { - if (old_rep) - { - if (--rep->count == 0) - delete rep; - - rep = old_rep; - } - - gripe_unary_op (octave_value::unary_op_as_string (op), - type_name ()); - } - } - else - gripe_unary_op_conversion_failed - (octave_value::unary_op_as_string (op), type_name ()); - } - else - gripe_unary_op (octave_value::unary_op_as_string (op), type_name ()); - } - } - else - { - // Non-genuine. - int t = type_id (); - - octave_value_typeinfo::non_const_unary_op_fcn f = 0; - - // Only attempt to operate in-place if this variable is unshared. - if (rep->count == 1) - f = octave_value_typeinfo::lookup_non_const_unary_op (op, t); - - if (f) - { - try - { - f (*rep); - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } - else - *this = do_unary_op (op, *this); - } - - return *this; -} - -octave_value& -octave_value::do_non_const_unary_op (unary_op op, const std::string& type, - const std::list& idx) -{ - if (idx.empty ()) - do_non_const_unary_op (op); - else - { - // FIXME -- only do the following stuff if we can't find a - // specific function to call to handle the op= operation for the - // types we have. - - assign_op assop = unary_op_to_assign_op (op); - - assign (assop, type, idx, 1.0); - } - - return *this; -} - -octave_value::assign_op -octave_value::unary_op_to_assign_op (unary_op op) -{ - assign_op binop = unknown_assign_op; - - switch (op) - { - case op_incr: - binop = op_add_eq; - break; - - case op_decr: - binop = op_sub_eq; - break; - - default: - { - std::string on = unary_op_as_string (op); - error ("operator %s: no assign operator found", on.c_str ()); - } - } - - return binop; -} - -octave_value::binary_op -octave_value::op_eq_to_binary_op (assign_op op) -{ - binary_op binop = unknown_binary_op; - - switch (op) - { - case op_add_eq: - binop = op_add; - break; - - case op_sub_eq: - binop = op_sub; - break; - - case op_mul_eq: - binop = op_mul; - break; - - case op_div_eq: - binop = op_div; - break; - - case op_ldiv_eq: - binop = op_ldiv; - break; - - case op_pow_eq: - binop = op_pow; - break; - - case op_lshift_eq: - binop = op_lshift; - break; - - case op_rshift_eq: - binop = op_rshift; - break; - - case op_el_mul_eq: - binop = op_el_mul; - break; - - case op_el_div_eq: - binop = op_el_div; - break; - - case op_el_ldiv_eq: - binop = op_el_ldiv; - break; - - case op_el_pow_eq: - binop = op_el_pow; - break; - - case op_el_and_eq: - binop = op_el_and; - break; - - case op_el_or_eq: - binop = op_el_or; - break; - - default: - { - std::string on = assign_op_as_string (op); - error ("operator %s: no binary operator found", on.c_str ()); - } - } - - return binop; -} - -octave_value -octave_value::empty_conv (const std::string& type, const octave_value& rhs) -{ - octave_value retval; - - if (type.length () > 0) - { - switch (type[0]) - { - case '(': - { - if (type.length () > 1 && type[1] == '.') - retval = octave_map (); - else - retval = octave_value (rhs.empty_clone ()); - } - break; - - case '{': - retval = Cell (); - break; - - case '.': - retval = octave_scalar_map (); - break; - - default: - panic_impossible (); - } - } - else - retval = octave_value (rhs.empty_clone ()); - - return retval; -} - -void -install_types (void) -{ - octave_base_value::register_type (); - octave_cell::register_type (); - octave_scalar::register_type (); - octave_complex::register_type (); - octave_matrix::register_type (); - octave_diag_matrix::register_type (); - octave_complex_matrix::register_type (); - octave_complex_diag_matrix::register_type (); - octave_range::register_type (); - octave_bool::register_type (); - octave_bool_matrix::register_type (); - octave_char_matrix_str::register_type (); - octave_char_matrix_sq_str::register_type (); - octave_int8_scalar::register_type (); - octave_int16_scalar::register_type (); - octave_int32_scalar::register_type (); - octave_int64_scalar::register_type (); - octave_uint8_scalar::register_type (); - octave_uint16_scalar::register_type (); - octave_uint32_scalar::register_type (); - octave_uint64_scalar::register_type (); - octave_int8_matrix::register_type (); - octave_int16_matrix::register_type (); - octave_int32_matrix::register_type (); - octave_int64_matrix::register_type (); - octave_uint8_matrix::register_type (); - octave_uint16_matrix::register_type (); - octave_uint32_matrix::register_type (); - octave_uint64_matrix::register_type (); - octave_sparse_bool_matrix::register_type (); - octave_sparse_matrix::register_type (); - octave_sparse_complex_matrix::register_type (); - octave_struct::register_type (); - octave_scalar_struct::register_type (); - octave_class::register_type (); - octave_cs_list::register_type (); - octave_magic_colon::register_type (); - octave_builtin::register_type (); - octave_user_function::register_type (); - octave_dld_function::register_type (); - octave_fcn_handle::register_type (); - octave_fcn_inline::register_type (); - octave_float_scalar::register_type (); - octave_float_complex::register_type (); - octave_float_matrix::register_type (); - octave_float_diag_matrix::register_type (); - octave_float_complex_matrix::register_type (); - octave_float_complex_diag_matrix::register_type (); - octave_perm_matrix::register_type (); - octave_null_matrix::register_type (); - octave_null_str::register_type (); - octave_null_sq_str::register_type (); - octave_lazy_index::register_type (); - octave_oncleanup::register_type (); -} - -DEFUN (sizeof, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sizeof (@var{val})\n\ -Return the size of @var{val} in bytes.\n\ -@seealso{whos}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).byte_size (); - else - print_usage (); - - return retval; -} - -/* -%!assert (sizeof (uint64 (ones (3))), 72) -%!assert (sizeof (double (zeros (2,4))), 64) -%!assert (sizeof ({"foo", "bar", "baaz"}), 10) -*/ - -static void -decode_subscripts (const char* name, const octave_value& arg, - std::string& type_string, - std::list& idx) -{ - const octave_map m = arg.map_value (); - - if (! error_state - && m.nfields () == 2 && m.contains ("type") && m.contains ("subs")) - { - octave_idx_type nel = m.numel (); - - type_string = std::string (nel, '\0'); - idx = std::list (); - - if (nel == 0) - return; - - const Cell type = m.contents ("type"); - const Cell subs = m.contents ("subs"); - - for (int k = 0; k < nel; k++) - { - std::string item = type(k).string_value (); - - if (! error_state) - { - if (item == "{}") - type_string[k] = '{'; - else if (item == "()") - type_string[k] = '('; - else if (item == ".") - type_string[k] = '.'; - else - { - error ("%s: invalid indexing type `%s'", name, item.c_str ()); - return; - } - } - else - { - error ("%s: expecting type(%d) to be a character string", - name, k+1); - return; - } - - octave_value_list idx_item; - - if (subs(k).is_string ()) - idx_item(0) = subs(k); - else if (subs(k).is_cell ()) - { - Cell subs_cell = subs(k).cell_value (); - - for (int n = 0; n < subs_cell.length (); n++) - { - if (subs_cell(n).is_string () - && subs_cell(n).string_value () == ":") - idx_item(n) = octave_value(octave_value::magic_colon_t); - else - idx_item(n) = subs_cell(n); - } - } - else - { - error ("%s: expecting subs(%d) to be a character string or cell array", - name, k+1); - return; - } - - idx.push_back (idx_item); - } - } - else - error ("%s: second argument must be a structure with fields `type' and `subs'", name); -} - -DEFUN (subsref, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} subsref (@var{val}, @var{idx})\n\ -Perform the subscripted element selection operation according to\n\ -the subscript specified by @var{idx}.\n\ -\n\ -The subscript @var{idx} is expected to be a structure array with\n\ -fields @samp{type} and @samp{subs}. Valid values for @samp{type}\n\ -are @samp{\"()\"}, @samp{\"@{@}\"}, and @samp{\".\"}.\n\ -The @samp{subs} field may be either @samp{\":\"} or a cell array\n\ -of index values.\n\ -\n\ -The following example shows how to extract the two first columns of\n\ -a matrix\n\ -\n\ -@example\n\ -@group\n\ -val = magic (3)\n\ - @result{} val = [ 8 1 6\n\ - 3 5 7\n\ - 4 9 2 ]\n\ -idx.type = \"()\";\n\ -idx.subs = @{\":\", 1:2@};\n\ -subsref (val, idx)\n\ - @result{} [ 8 1\n\ - 3 5\n\ - 4 9 ]\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Note that this is the same as writing @code{val(:,1:2)}.\n\ -\n\ -If @var{idx} is an empty structure array with fields @samp{type}\n\ -and @samp{subs}, return @var{val}.\n\ -@seealso{subsasgn, substruct}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 2) - { - std::string type; - std::list idx; - - decode_subscripts ("subsref", args(1), type, idx); - - if (! error_state) - { - octave_value arg0 = args(0); - - if (type.empty ()) - retval = arg0; - else - retval = arg0.subsref (type, idx, nargout); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (subsasgn, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} subsasgn (@var{val}, @var{idx}, @var{rhs})\n\ -Perform the subscripted assignment operation according to\n\ -the subscript specified by @var{idx}.\n\ -\n\ -The subscript @var{idx} is expected to be a structure array with\n\ -fields @samp{type} and @samp{subs}. Valid values for @samp{type}\n\ -are @samp{\"()\"}, @samp{\"@{@}\"}, and @samp{\".\"}.\n\ -The @samp{subs} field may be either @samp{\":\"} or a cell array\n\ -of index values.\n\ -\n\ -The following example shows how to set the two first columns of a\n\ -3-by-3 matrix to zero.\n\ -\n\ -@example\n\ -@group\n\ -val = magic (3);\n\ -idx.type = \"()\";\n\ -idx.subs = @{\":\", 1:2@};\n\ -subsasgn (val, idx, 0)\n\ - @result{} [ 0 0 6\n\ - 0 0 7\n\ - 0 0 2 ]\n\ -@end group\n\ -@end example\n\ -\n\ -Note that this is the same as writing @code{val(:,1:2) = 0}.\n\ -\n\ -If @var{idx} is an empty structure array with fields @samp{type}\n\ -and @samp{subs}, return @var{rhs}.\n\ -@seealso{subsref, substruct}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 3) - { - std::string type; - std::list idx; - - decode_subscripts ("subsasgn", args(1), type, idx); - - if (! error_state) - { - if (type.empty ()) - { - // Regularize a null matrix if stored into a variable. - - retval = args(2).storable_value (); - } - else - { - octave_value arg0 = args(0); - - arg0.make_unique (); - - if (! error_state) - retval= arg0.subsasgn (type, idx, args(2)); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = reshape ([1:25], 5,5); -%! idx1 = substruct ("()", {3, 3}); -%! idx2 = substruct ("()", {2:2:5, 2:2:5}); -%! idx3 = substruct ("()", {":", [1,5]}); -%! idx4 = struct ("type", {}, "subs", {}); -%! assert (subsref (a, idx1), 13); -%! assert (subsref (a, idx2), [7 17; 9 19]); -%! assert (subsref (a, idx3), [1:5; 21:25]'); -%! assert (subsref (a, idx4), a); -%! a = subsasgn (a, idx1, 0); -%! a = subsasgn (a, idx2, 0); -%! a = subsasgn (a, idx3, 0); -%!# a = subsasgn (a, idx4, 0); -%! b = [0 6 11 16 0 -%! 0 0 12 0 0 -%! 0 8 0 18 0 -%! 0 0 14 0 0 -%! 0 10 15 20 0]; -%! assert (a, b); - -%!test -%! c = num2cell (reshape ([1:25],5,5)); -%! idx1 = substruct ("{}", {3, 3}); -%! idx2 = substruct ("()", {2:2:5, 2:2:5}); -%! idx3 = substruct ("()", {":", [1,5]}); -%! idx2p = substruct ("{}", {2:2:5, 2:2:5}); -%! idx3p = substruct ("{}", {":", [1,5]}); -%! idx4 = struct ("type", {}, "subs", {}); -%! assert ({ subsref(c, idx1) }, {13}); -%! assert ({ subsref(c, idx2p) }, {7 9 17 19}); -%! assert ({ subsref(c, idx3p) }, num2cell ([1:5, 21:25])); -%! assert (subsref (c, idx4), c); -%! c = subsasgn (c, idx1, 0); -%! c = subsasgn (c, idx2, 0); -%! c = subsasgn (c, idx3, 0); -%!# c = subsasgn (c, idx4, 0); -%! d = {0 6 11 16 0 -%! 0 0 12 0 0 -%! 0 8 0 18 0 -%! 0 0 14 0 0 -%! 0 10 15 20 0}; -%! assert (c, d); - -%!test -%! s.a = "ohai"; -%! s.b = "dere"; -%! s.c = 42; -%! idx1 = substruct (".", "a"); -%! idx2 = substruct (".", "b"); -%! idx3 = substruct (".", "c"); -%! idx4 = struct ("type", {}, "subs", {}); -%! assert (subsref (s, idx1), "ohai"); -%! assert (subsref (s, idx2), "dere"); -%! assert (subsref (s, idx3), 42); -%! assert (subsref (s, idx4), s); -%! s = subsasgn (s, idx1, "Hello"); -%! s = subsasgn (s, idx2, "There"); -%! s = subsasgn (s, idx3, 163); -%!# s = subsasgn (s, idx4, 163); -%! t.a = "Hello"; -%! t.b = "There"; -%! t.c = 163; -%! assert (s, t); -*/ - -DEFUN (is_sq_string, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} is_sq_string (@var{x})\n\ -Return true if @var{x} is a single-quoted character string.\n\ -@seealso{is_dq_string, ischar}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_sq_string (); - else - print_usage (); - - return retval; -} - -/* -%!assert (is_sq_string ('foo'), true) -%!assert (is_sq_string ("foo"), false) -%!assert (is_sq_string (1.0), false) -%!assert (is_sq_string ({2.0}), false) - -%!error is_sq_string () -%!error is_sq_string ('foo', 2) -*/ - -DEFUN (is_dq_string, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} is_dq_string (@var{x})\n\ -Return true if @var{x} is a double-quoted character string.\n\ -@seealso{is_sq_string, ischar}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_dq_string (); - else - print_usage (); - - return retval; -} - -/* -%!assert (is_dq_string ("foo"), true) -%!assert (is_dq_string ('foo'), false) -%!assert (is_dq_string (1.0), false) -%!assert (is_dq_string ({2.0}), false) - -%!error is_dq_string () -%!error is_dq_string ("foo", 2) -*/ diff -r d02b229ce693 -r a132d206a36a src/ov.h --- a/src/ov.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1394 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_value_h) -#define octave_value_h 1 - -#include - -#include -#include -#include - -#include "Range.h" -#include "data-conv.h" -#include "idx-vector.h" -#include "mach-info.h" -#include "mxarray.h" -#include "mx-base.h" -#include "oct-alloc.h" -#include "oct-time.h" -#include "str-vec.h" - -#include "oct-hdf5.h" -#include "oct-sort.h" - -class Cell; -class octave_map; -class octave_scalar_map; -class Octave_map; -class octave_stream; -class octave_function; -class octave_user_function; -class octave_fcn_handle; -class octave_fcn_inline; -class octave_value_list; -class octave_lvalue; - -#include "ov-base.h" - -// Constants. - -class octave_value; - -class -OCTINTERP_API -octave_value -{ -public: - - enum unary_op - { - op_not, // not - op_uplus, // uplus - op_uminus, // uminus - op_transpose, // transpose - op_hermitian, // ctranspose - op_incr, - op_decr, - num_unary_ops, - unknown_unary_op - }; - - enum binary_op - { - op_add, // plus - op_sub, // minus - op_mul, // mtimes - op_div, // mrdivide - op_pow, // mpower - op_ldiv, // mldivide - op_lshift, - op_rshift, - op_lt, // lt - op_le, // le - op_eq, // eq - op_ge, // ge - op_gt, // gt - op_ne, // ne - op_el_mul, // times - op_el_div, // rdivide - op_el_pow, // power - op_el_ldiv, // ldivide - op_el_and, // and - op_el_or, // or - op_struct_ref, - num_binary_ops, - unknown_binary_op - }; - - enum compound_binary_op - { - // ** compound operations ** - op_trans_mul, - op_mul_trans, - op_herm_mul, - op_mul_herm, - op_trans_ldiv, - op_herm_ldiv, - op_el_not_and, - op_el_not_or, - op_el_and_not, - op_el_or_not, - num_compound_binary_ops, - unknown_compound_binary_op - }; - - enum assign_op - { - op_asn_eq, - op_add_eq, - op_sub_eq, - op_mul_eq, - op_div_eq, - op_ldiv_eq, - op_pow_eq, - op_lshift_eq, - op_rshift_eq, - op_el_mul_eq, - op_el_div_eq, - op_el_ldiv_eq, - op_el_pow_eq, - op_el_and_eq, - op_el_or_eq, - num_assign_ops, - unknown_assign_op - }; - - static assign_op binary_op_to_assign_op (binary_op); - - static std::string unary_op_as_string (unary_op); - static std::string unary_op_fcn_name (unary_op); - - static std::string binary_op_as_string (binary_op); - static std::string binary_op_fcn_name (binary_op); - - static std::string binary_op_fcn_name (compound_binary_op); - - static std::string assign_op_as_string (assign_op); - - static octave_value empty_conv (const std::string& type, - const octave_value& rhs = octave_value ()); - - enum magic_colon { magic_colon_t }; - - octave_value (void) - { - static octave_base_value nil_rep; - rep = &nil_rep; - rep->count++; - } - - octave_value (short int i); - octave_value (unsigned short int i); - octave_value (int i); - octave_value (unsigned int i); - octave_value (long int i); - octave_value (unsigned long int i); - - // FIXME -- these are kluges. They turn into doubles - // internally, which will break for very large values. We just use - // them to store things like 64-bit ino_t, etc, and hope that those - // values are never actually larger than can be represented exactly - // in a double. - -#if defined (HAVE_LONG_LONG_INT) - octave_value (long long int i); -#endif -#if defined (HAVE_UNSIGNED_LONG_LONG_INT) - octave_value (unsigned long long int i); -#endif - - octave_value (octave_time t); - octave_value (double d); - octave_value (float d); - octave_value (const Array& a, bool is_cs_list = false); - octave_value (const Cell& c, bool is_cs_list = false); - octave_value (const Matrix& m, const MatrixType& t = MatrixType ()); - octave_value (const FloatMatrix& m, const MatrixType& t = MatrixType ()); - octave_value (const NDArray& nda); - octave_value (const FloatNDArray& nda); - octave_value (const Array& m); - octave_value (const Array& m); - octave_value (const DiagMatrix& d); - octave_value (const FloatDiagMatrix& d); - octave_value (const RowVector& v); - octave_value (const FloatRowVector& v); - octave_value (const ColumnVector& v); - octave_value (const FloatColumnVector& v); - octave_value (const Complex& C); - octave_value (const FloatComplex& C); - octave_value (const ComplexMatrix& m, const MatrixType& t = MatrixType ()); - octave_value (const FloatComplexMatrix& m, const MatrixType& t = MatrixType ()); - octave_value (const ComplexNDArray& cnda); - octave_value (const FloatComplexNDArray& cnda); - octave_value (const Array& m); - octave_value (const Array& m); - octave_value (const ComplexDiagMatrix& d); - octave_value (const FloatComplexDiagMatrix& d); - octave_value (const ComplexRowVector& v); - octave_value (const FloatComplexRowVector& v); - octave_value (const ComplexColumnVector& v); - octave_value (const FloatComplexColumnVector& v); - octave_value (const PermMatrix& p); - octave_value (bool b); - octave_value (const boolMatrix& bm, const MatrixType& t = MatrixType ()); - octave_value (const boolNDArray& bnda); - octave_value (const Array& bnda); - octave_value (char c, char type = '\''); - octave_value (const char *s, char type = '\''); - octave_value (const std::string& s, char type = '\''); - octave_value (const string_vector& s, char type = '\''); - octave_value (const charMatrix& chm, char type = '\''); - octave_value (const charNDArray& chnda, char type = '\''); - octave_value (const Array& chnda, char type = '\''); - octave_value (const charMatrix& chm, bool is_string, - char type = '\'') GCC_ATTR_DEPRECATED; - octave_value (const charNDArray& chnda, bool is_string, - char type = '\'') GCC_ATTR_DEPRECATED; - octave_value (const Array& chnda, bool is_string, - char type = '\'') GCC_ATTR_DEPRECATED; - octave_value (const SparseMatrix& m, const MatrixType& t = MatrixType ()); - octave_value (const Sparse& m, const MatrixType& t = MatrixType ()); - octave_value (const SparseComplexMatrix& m, - const MatrixType& t = MatrixType ()); - octave_value (const Sparse& m, const MatrixType& t = MatrixType ()); - octave_value (const SparseBoolMatrix& bm, - const MatrixType& t = MatrixType ()); - octave_value (const Sparse& m, const MatrixType& t = MatrixType ()); - octave_value (const octave_int8& i); - octave_value (const octave_int16& i); - octave_value (const octave_int32& i); - octave_value (const octave_int64& i); - octave_value (const octave_uint8& i); - octave_value (const octave_uint16& i); - octave_value (const octave_uint32& i); - octave_value (const octave_uint64& i); - octave_value (const int8NDArray& inda); - octave_value (const Array& inda); - octave_value (const int16NDArray& inda); - octave_value (const Array& inda); - octave_value (const int32NDArray& inda); - octave_value (const Array& inda); - octave_value (const int64NDArray& inda); - octave_value (const Array& inda); - octave_value (const uint8NDArray& inda); - octave_value (const Array& inda); - octave_value (const uint16NDArray& inda); - octave_value (const Array& inda); - octave_value (const uint32NDArray& inda); - octave_value (const Array& inda); - octave_value (const uint64NDArray& inda); - octave_value (const Array& inda); - octave_value (const Array& inda, - bool zero_based = false, bool cache_index = false); - octave_value (const Array& cellstr); - octave_value (const idx_vector& idx, bool lazy = true); - octave_value (double base, double limit, double inc); - octave_value (const Range& r); - octave_value (const octave_map& m); - octave_value (const octave_scalar_map& m); - octave_value (const Octave_map& m); - octave_value (const Octave_map& m, const std::string& id, - const std::list& plist); - octave_value (const octave_value_list& m, bool = false); - octave_value (octave_value::magic_colon); - - octave_value (octave_base_value *new_rep, bool borrow = false); - octave_value (octave_base_value *new_rep, int xcount) GCC_ATTR_DEPRECATED; - - // Copy constructor. - - octave_value (const octave_value& a) - { - rep = a.rep; - rep->count++; - } - - // This should only be called for derived types. - - octave_base_value *clone (void) const; - - octave_base_value *empty_clone (void) const - { return rep->empty_clone (); } - - // Delete the representation of this constant if the count drops to - // zero. - - ~octave_value (void) - { - if (--rep->count == 0) - delete rep; - } - - void make_unique (void) - { - if (rep->count > 1) - { - octave_base_value *r = rep->unique_clone (); - - if (--rep->count == 0) - delete rep; - - rep = r; - } - } - - // This uniquifies the value if it is referenced by more than a certain - // number of shallow copies. This is useful for optimizations where we - // know a certain copy, typically within a cell array, to be obsolete. - void make_unique (int obsolete_copies) - { - if (rep->count > obsolete_copies + 1) - { - octave_base_value *r = rep->unique_clone (); - - if (--rep->count == 0) - delete rep; - - rep = r; - } - } - - // Simple assignment. - - octave_value& operator = (const octave_value& a) - { - if (rep != a.rep) - { - if (--rep->count == 0) - delete rep; - - rep = a.rep; - rep->count++; - } - - return *this; - } - - octave_idx_type get_count (void) const { return rep->count; } - - octave_base_value::type_conv_info numeric_conversion_function (void) const - { return rep->numeric_conversion_function (); } - - octave_base_value::type_conv_info numeric_demotion_function (void) const - { return rep->numeric_demotion_function (); } - - void maybe_mutate (void); - - octave_value squeeze (void) const - { return rep->squeeze (); } - - // The result of full(). - octave_value full_value (void) const - { return rep->full_value (); } - - octave_base_value *try_narrowing_conversion (void) - { return rep->try_narrowing_conversion (); } - - // Close to dims (), but can be overloaded for classes. - Matrix size (void) - { return rep->size (); } - - octave_idx_type numel (const octave_value_list& idx) - { return rep->numel (idx); } - - octave_value single_subsref (const std::string& type, - const octave_value_list& idx); - - octave_value subsref (const std::string& type, - const std::list& idx) - { return rep->subsref (type, idx); } - - octave_value subsref (const std::string& type, - const std::list& idx, - bool auto_add) - { return rep->subsref (type, idx, auto_add); } - - octave_value_list subsref (const std::string& type, - const std::list& idx, - int nargout); - - octave_value_list subsref (const std::string& type, - const std::list& idx, - int nargout, - const std::list *lvalue_list); - - octave_value next_subsref (const std::string& type, const - std::list& idx, - size_t skip = 1); - - octave_value_list next_subsref (int nargout, - const std::string& type, const - std::list& idx, - size_t skip = 1); - - octave_value next_subsref (bool auto_add, const std::string& type, const - std::list& idx, - size_t skip = 1); - - octave_value do_index_op (const octave_value_list& idx, - bool resize_ok = false) - { return rep->do_index_op (idx, resize_ok); } - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& idx); - - octave_value_list - do_multi_index_op (int nargout, const octave_value_list& idx, - const std::list *lvalue_list); - - octave_value subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - octave_value undef_subsasgn (const std::string& type, - const std::list& idx, - const octave_value& rhs); - - octave_value& assign (assign_op op, const std::string& type, - const std::list& idx, - const octave_value& rhs); - - octave_value& assign (assign_op, const octave_value& rhs); - - idx_vector index_vector (void) const - { return rep->index_vector (); } - - // Size. - - dim_vector dims (void) const - { return rep->dims (); } - - octave_idx_type rows (void) const { return rep->rows (); } - - octave_idx_type columns (void) const { return rep->columns (); } - - octave_idx_type length (void) const; - - int ndims (void) const { return rep->ndims (); } - - bool all_zero_dims (void) const { return dims ().all_zero (); } - - octave_idx_type numel (void) const - { return rep->numel (); } - - octave_idx_type capacity (void) const - { return rep->capacity (); } - - size_t byte_size (void) const - { return rep->byte_size (); } - - octave_idx_type nnz (void) const { return rep->nnz (); } - - octave_idx_type nzmax (void) const { return rep->nzmax (); } - - octave_idx_type nfields (void) const { return rep->nfields (); } - - octave_value reshape (const dim_vector& dv) const - { return rep->reshape (dv); } - - octave_value permute (const Array& vec, bool inv = false) const - { return rep->permute (vec, inv); } - - octave_value ipermute (const Array& vec) const - { return rep->permute (vec, true); } - - octave_value resize (const dim_vector& dv, bool fill = false) const - { return rep->resize (dv, fill);} - - MatrixType matrix_type (void) const - { return rep->matrix_type (); } - - MatrixType matrix_type (const MatrixType& typ) const - { return rep->matrix_type (typ); } - - // 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(). - - bool is_defined (void) const - { return rep->is_defined (); } - - bool is_undefined (void) const - { return ! is_defined (); } - - bool is_empty (void) const - { return rep->is_empty (); } - - bool is_cell (void) const - { return rep->is_cell (); } - - bool is_cellstr (void) const - { return rep->is_cellstr (); } - - bool is_real_scalar (void) const - { return rep->is_real_scalar (); } - - bool is_real_matrix (void) const - { return rep->is_real_matrix (); } - - bool is_real_nd_array (void) const - { return rep->is_real_nd_array (); } - - bool is_complex_scalar (void) const - { return rep->is_complex_scalar (); } - - bool is_complex_matrix (void) const - { return rep->is_complex_matrix (); } - - bool is_bool_scalar (void) const - { return rep->is_bool_scalar (); } - - bool is_bool_matrix (void) const - { return rep->is_bool_matrix (); } - - bool is_char_matrix (void) const - { return rep->is_char_matrix (); } - - bool is_diag_matrix (void) const - { return rep->is_diag_matrix (); } - - bool is_perm_matrix (void) const - { return rep->is_perm_matrix (); } - - bool is_string (void) const - { return rep->is_string (); } - - bool is_sq_string (void) const - { return rep->is_sq_string (); } - - bool is_dq_string (void) const - { return rep->is_string () && ! rep->is_sq_string (); } - - bool is_range (void) const - { return rep->is_range (); } - - bool is_map (void) const - { return rep->is_map (); } - - bool is_object (void) const - { return rep->is_object (); } - - bool is_cs_list (void) const - { return rep->is_cs_list (); } - - bool is_magic_colon (void) const - { return rep->is_magic_colon (); } - - bool is_null_value (void) const - { return rep->is_null_value (); } - - // Are any or all of the elements in this constant nonzero? - - octave_value all (int dim = 0) const - { return rep->all (dim); } - - octave_value any (int dim = 0) const - { return rep->any (dim); } - - builtin_type_t builtin_type (void) const - { return rep->builtin_type (); } - - // Floating point types. - - bool is_double_type (void) const - { return rep->is_double_type (); } - - bool is_single_type (void) const - { return rep->is_single_type (); } - - bool is_float_type (void) const - { return rep->is_float_type (); } - - // Integer types. - - bool is_int8_type (void) const - { return rep->is_int8_type (); } - - bool is_int16_type (void) const - { return rep->is_int16_type (); } - - bool is_int32_type (void) const - { return rep->is_int32_type (); } - - bool is_int64_type (void) const - { return rep->is_int64_type (); } - - bool is_uint8_type (void) const - { return rep->is_uint8_type (); } - - bool is_uint16_type (void) const - { return rep->is_uint16_type (); } - - bool is_uint32_type (void) const - { return rep->is_uint32_type (); } - - bool is_uint64_type (void) const - { return rep->is_uint64_type (); } - - // Other type stuff. - - bool is_bool_type (void) const - { return rep->is_bool_type (); } - - bool is_integer_type (void) const - { return rep->is_integer_type (); } - - bool is_real_type (void) const - { return rep->is_real_type (); } - - bool is_complex_type (void) const - { return rep->is_complex_type (); } - - bool is_scalar_type (void) const - { return rep->is_scalar_type (); } - - bool is_matrix_type (void) const - { return rep->is_matrix_type (); } - - bool is_numeric_type (void) const - { return rep->is_numeric_type (); } - - bool is_sparse_type (void) const - { return rep->is_sparse_type (); } - - // Does this constant correspond to a truth value? - - bool is_true (void) const - { return rep->is_true (); } - - // Do two constants match (in a switch statement)? - - bool is_equal (const octave_value&) const; - - // Are the dimensions of this constant zero by zero? - - bool is_zero_by_zero (void) const - { return (rows () == 0 && columns () == 0); } - - bool is_constant (void) const - { return rep->is_constant (); } - - bool is_function_handle (void) const - { return rep->is_function_handle (); } - - bool is_anonymous_function (void) const - { return rep->is_anonymous_function (); } - - bool is_inline_function (void) const - { return rep->is_inline_function (); } - - bool is_function (void) const - { return rep->is_function (); } - - bool is_user_script (void) const - { return rep->is_user_script (); } - - bool is_user_function (void) const - { return rep->is_user_function (); } - - bool is_user_code (void) const - { return rep->is_user_code (); } - - bool is_builtin_function (void) const - { return rep->is_builtin_function (); } - - bool is_dld_function (void) const - { return rep->is_dld_function (); } - - bool is_mex_function (void) const - { return rep->is_mex_function (); } - - void erase_subfunctions (void) { rep->erase_subfunctions (); } - - // Values. - - octave_value eval (void) { return *this; } - - short int - short_value (bool req_int = false, bool frc_str_conv = false) const - { return rep->short_value (req_int, frc_str_conv); } - - unsigned short int - ushort_value (bool req_int = false, bool frc_str_conv = false) const - { return rep->ushort_value (req_int, frc_str_conv); } - - int int_value (bool req_int = false, bool frc_str_conv = false) const - { return rep->int_value (req_int, frc_str_conv); } - - unsigned int - uint_value (bool req_int = false, bool frc_str_conv = false) const - { return rep->uint_value (req_int, frc_str_conv); } - - int nint_value (bool frc_str_conv = false) const - { return rep->nint_value (frc_str_conv); } - - long int - long_value (bool req_int = false, bool frc_str_conv = false) const - { return rep->long_value (req_int, frc_str_conv); } - - unsigned long int - ulong_value (bool req_int = false, bool frc_str_conv = false) const - { return rep->ulong_value (req_int, frc_str_conv); } - - octave_idx_type - idx_type_value (bool req_int = false, bool frc_str_conv = false) const; - - double double_value (bool frc_str_conv = false) const - { return rep->double_value (frc_str_conv); } - - float float_value (bool frc_str_conv = false) const - { return rep->float_value (frc_str_conv); } - - double scalar_value (bool frc_str_conv = false) const - { return rep->scalar_value (frc_str_conv); } - - float float_scalar_value (bool frc_str_conv = false) const - { return rep->float_scalar_value (frc_str_conv); } - - Cell cell_value (void) const; - - Matrix matrix_value (bool frc_str_conv = false) const - { return rep->matrix_value (frc_str_conv); } - - FloatMatrix float_matrix_value (bool frc_str_conv = false) const - { return rep->float_matrix_value (frc_str_conv); } - - NDArray array_value (bool frc_str_conv = false) const - { return rep->array_value (frc_str_conv); } - - FloatNDArray float_array_value (bool frc_str_conv = false) const - { return rep->float_array_value (frc_str_conv); } - - Complex complex_value (bool frc_str_conv = false) const - { return rep->complex_value (frc_str_conv); } - - FloatComplex float_complex_value (bool frc_str_conv = false) const - { return rep->float_complex_value (frc_str_conv); } - - ComplexMatrix complex_matrix_value (bool frc_str_conv = false) const - { return rep->complex_matrix_value (frc_str_conv); } - - FloatComplexMatrix float_complex_matrix_value (bool frc_str_conv = false) const - { return rep->float_complex_matrix_value (frc_str_conv); } - - ComplexNDArray complex_array_value (bool frc_str_conv = false) const - { return rep->complex_array_value (frc_str_conv); } - - FloatComplexNDArray float_complex_array_value (bool frc_str_conv = false) const - { return rep->float_complex_array_value (frc_str_conv); } - - bool bool_value (bool warn = false) const - { return rep->bool_value (warn); } - - boolMatrix bool_matrix_value (bool warn = false) const - { return rep->bool_matrix_value (warn); } - - boolNDArray bool_array_value (bool warn = false) const - { return rep->bool_array_value (warn); } - - charMatrix char_matrix_value (bool frc_str_conv = false) const - { return rep->char_matrix_value (frc_str_conv); } - - charNDArray char_array_value (bool frc_str_conv = false) const - { return rep->char_array_value (frc_str_conv); } - - SparseMatrix sparse_matrix_value (bool frc_str_conv = false) const - { return rep->sparse_matrix_value (frc_str_conv); } - - SparseComplexMatrix sparse_complex_matrix_value (bool frc_str_conv = false) const - { return rep->sparse_complex_matrix_value (frc_str_conv); } - - SparseBoolMatrix sparse_bool_matrix_value (bool warn = false) const - { return rep->sparse_bool_matrix_value (warn); } - - DiagMatrix diag_matrix_value (bool force = false) const - { return rep->diag_matrix_value (force); } - - FloatDiagMatrix float_diag_matrix_value (bool force = false) const - { return rep->float_diag_matrix_value (force); } - - ComplexDiagMatrix complex_diag_matrix_value (bool force = false) const - { return rep->complex_diag_matrix_value (force); } - - FloatComplexDiagMatrix float_complex_diag_matrix_value (bool force = false) const - { return rep->float_complex_diag_matrix_value (force); } - - PermMatrix perm_matrix_value (void) const - { return rep->perm_matrix_value (); } - - octave_int8 int8_scalar_value (void) const - { return rep->int8_scalar_value (); } - - octave_int16 int16_scalar_value (void) const - { return rep->int16_scalar_value (); } - - octave_int32 int32_scalar_value (void) const - { return rep->int32_scalar_value (); } - - octave_int64 int64_scalar_value (void) const - { return rep->int64_scalar_value (); } - - octave_uint8 uint8_scalar_value (void) const - { return rep->uint8_scalar_value (); } - - octave_uint16 uint16_scalar_value (void) const - { return rep->uint16_scalar_value (); } - - octave_uint32 uint32_scalar_value (void) const - { return rep->uint32_scalar_value (); } - - octave_uint64 uint64_scalar_value (void) const - { return rep->uint64_scalar_value (); } - - int8NDArray int8_array_value (void) const - { return rep->int8_array_value (); } - - int16NDArray int16_array_value (void) const - { return rep->int16_array_value (); } - - int32NDArray int32_array_value (void) const - { return rep->int32_array_value (); } - - int64NDArray int64_array_value (void) const - { return rep->int64_array_value (); } - - uint8NDArray uint8_array_value (void) const - { return rep->uint8_array_value (); } - - uint16NDArray uint16_array_value (void) const - { return rep->uint16_array_value (); } - - uint32NDArray uint32_array_value (void) const - { return rep->uint32_array_value (); } - - uint64NDArray uint64_array_value (void) const - { return rep->uint64_array_value (); } - - string_vector all_strings (bool pad = false) const - { return rep->all_strings (pad); } - - std::string string_value (bool force = false) const - { return rep->string_value (force); } - - Array cellstr_value (void) const - { return rep->cellstr_value (); } - - Range range_value (void) const - { return rep->range_value (); } - - octave_map map_value (void) const; - - octave_scalar_map scalar_map_value (void) const; - - string_vector map_keys (void) const - { return rep->map_keys (); } - - size_t nparents (void) const - { return rep->nparents (); } - - std::list parent_class_name_list (void) const - { return rep->parent_class_name_list (); } - - string_vector parent_class_names (void) const - { return rep->parent_class_names (); } - - octave_base_value * - find_parent_class (const std::string& parent_class_name) - { return rep->find_parent_class (parent_class_name); } - - octave_function *function_value (bool silent = false) const; - - octave_user_function *user_function_value (bool silent = false) const; - - octave_user_script *user_script_value (bool silent = false) const; - - octave_user_code *user_code_value (bool silent = false) const; - - octave_fcn_handle *fcn_handle_value (bool silent = false) const; - - octave_fcn_inline *fcn_inline_value (bool silent = false) const; - - octave_value_list list_value (void) const; - - ColumnVector column_vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - ComplexColumnVector - complex_column_vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - RowVector row_vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - ComplexRowVector - complex_row_vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - - FloatColumnVector float_column_vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - FloatComplexColumnVector - float_complex_column_vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - FloatRowVector float_row_vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - FloatComplexRowVector - float_complex_row_vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - - - - Array int_vector_value (bool req_int = false, - bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - Array - octave_idx_type_vector_value (bool req_int = false, - bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - Array vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - Array complex_vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - Array float_vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - Array float_complex_vector_value (bool frc_str_conv = false, - bool frc_vec_conv = false) const; - - // Possibly economize a lazy-indexed value. - - void maybe_economize (void) - { rep->maybe_economize (); } - - // The following two hook conversions are called on any octave_value prior to - // storing it to a "permanent" location, like a named variable, a cell or a - // struct component, or a return value of a function. - - octave_value storable_value (void) const; - - // Ditto, but in place, i.e. equivalent to *this = this->storable_value (), - // but possibly more efficient. - - void make_storable_value (void); - - // 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. - - octave_value convert_to_str (bool pad = false, bool force = false, - char type = '\'') const - { return rep->convert_to_str (pad, force, type); } - - octave_value - convert_to_str_internal (bool pad, bool force, char type) const - { return rep->convert_to_str_internal (pad, force, type); } - - void convert_to_row_or_column_vector (void) - { rep->convert_to_row_or_column_vector (); } - - bool print_as_scalar (void) const - { return rep->print_as_scalar (); } - - void print (std::ostream& os, bool pr_as_read_syntax = false) const - { rep->print (os, pr_as_read_syntax); } - - void print_raw (std::ostream& os, - bool pr_as_read_syntax = false) const - { rep->print_raw (os, pr_as_read_syntax); } - - bool print_name_tag (std::ostream& os, const std::string& name) const - { return rep->print_name_tag (os, name); } - - void print_with_name (std::ostream& os, const std::string& name) const - { rep->print_with_name (os, name, true); } - - int type_id (void) const { return rep->type_id (); } - - std::string type_name (void) const { return rep->type_name (); } - - std::string class_name (void) const { return rep->class_name (); } - - // Unary and binary operations. - - friend OCTINTERP_API octave_value do_unary_op (unary_op op, - const octave_value& a); - - octave_value& do_non_const_unary_op (unary_op op); - - octave_value& do_non_const_unary_op (unary_op op, const std::string& type, - const std::list& idx); - - friend OCTINTERP_API octave_value do_binary_op (binary_op op, - const octave_value& a, - const octave_value& b); - - friend OCTINTERP_API octave_value do_binary_op (compound_binary_op op, - const octave_value& a, - const octave_value& b); - - friend OCTINTERP_API octave_value do_cat_op (const octave_value& a, - const octave_value& b, - const Array& ra_idx); - - const octave_base_value& get_rep (void) const { return *rep; } - - bool is_copy_of (const octave_value &val) const { return rep == val.rep; } - - void print_info (std::ostream& os, - const std::string& prefix = std::string ()) const; - - bool save_ascii (std::ostream& os) { return rep->save_ascii (os); } - - bool load_ascii (std::istream& is) { return rep->load_ascii (is); } - - bool save_binary (std::ostream& os, bool& save_as_floats) - { return rep->save_binary (os, save_as_floats); } - - bool load_binary (std::istream& is, bool swap, - oct_mach_info::float_format fmt) - { return rep->load_binary (is, swap, fmt); } - -#if defined (HAVE_HDF5) - bool save_hdf5 (hid_t loc_id, const char *name, bool save_as_floats) - { return rep->save_hdf5 (loc_id, name, save_as_floats); } - - bool load_hdf5 (hid_t loc_id, const char *name) - { return rep->load_hdf5 (loc_id, name); } -#endif - - int write (octave_stream& os, int block_size, - oct_data_conv::data_type output_type, int skip, - oct_mach_info::float_format flt_fmt) const; - - octave_base_value *internal_rep (void) const { return rep; } - - // Unsafe. These functions exist to support the MEX interface. - // You should not use them anywhere else. - void *mex_get_data (void) const { return rep->mex_get_data (); } - - octave_idx_type *mex_get_ir (void) const { return rep->mex_get_ir (); } - - octave_idx_type *mex_get_jc (void) const { return rep->mex_get_jc (); } - - mxArray *as_mxArray (void) const { return rep->as_mxArray (); } - - octave_value diag (octave_idx_type k = 0) const - { return rep->diag (k); } - - octave_value diag (octave_idx_type m, octave_idx_type n) const - { return rep->diag (m, n); } - - octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const - { return rep->sort (dim, mode); } - octave_value sort (Array &sidx, octave_idx_type dim = 0, - sortmode mode = ASCENDING) const - { return rep->sort (sidx, dim, mode); } - - sortmode is_sorted (sortmode mode = UNSORTED) const - { return rep->is_sorted (mode); } - - Array sort_rows_idx (sortmode mode = ASCENDING) const - { return rep->sort_rows_idx (mode); } - - sortmode is_sorted_rows (sortmode mode = UNSORTED) const - { return rep->is_sorted_rows (mode); } - - void lock (void) { rep->lock (); } - - void unlock (void) { rep->unlock (); } - - bool islocked (void) const { return rep->islocked (); } - - void dump (std::ostream& os) const { rep->dump (os); } - -#define MAPPER_FORWARD(F) \ - octave_value F (void) const { return rep->map (octave_base_value::umap_ ## F); } - - MAPPER_FORWARD (abs) - MAPPER_FORWARD (acos) - MAPPER_FORWARD (acosh) - MAPPER_FORWARD (angle) - MAPPER_FORWARD (arg) - MAPPER_FORWARD (asin) - MAPPER_FORWARD (asinh) - MAPPER_FORWARD (atan) - MAPPER_FORWARD (atanh) - MAPPER_FORWARD (cbrt) - MAPPER_FORWARD (ceil) - MAPPER_FORWARD (conj) - MAPPER_FORWARD (cos) - MAPPER_FORWARD (cosh) - MAPPER_FORWARD (erf) - MAPPER_FORWARD (erfinv) - MAPPER_FORWARD (erfcinv) - MAPPER_FORWARD (erfc) - MAPPER_FORWARD (erfcx) - MAPPER_FORWARD (exp) - MAPPER_FORWARD (expm1) - MAPPER_FORWARD (finite) - MAPPER_FORWARD (fix) - MAPPER_FORWARD (floor) - MAPPER_FORWARD (gamma) - MAPPER_FORWARD (imag) - MAPPER_FORWARD (isinf) - MAPPER_FORWARD (isna) - MAPPER_FORWARD (isnan) - MAPPER_FORWARD (lgamma) - MAPPER_FORWARD (log) - MAPPER_FORWARD (log2) - MAPPER_FORWARD (log10) - MAPPER_FORWARD (log1p) - MAPPER_FORWARD (real) - MAPPER_FORWARD (round) - MAPPER_FORWARD (roundb) - MAPPER_FORWARD (signum) - MAPPER_FORWARD (sin) - MAPPER_FORWARD (sinh) - MAPPER_FORWARD (sqrt) - MAPPER_FORWARD (tan) - MAPPER_FORWARD (tanh) - - // These functions are prefixed with X to avoid potential macro - // conflicts. - - MAPPER_FORWARD (xisalnum) - MAPPER_FORWARD (xisalpha) - MAPPER_FORWARD (xisascii) - MAPPER_FORWARD (xiscntrl) - MAPPER_FORWARD (xisdigit) - MAPPER_FORWARD (xisgraph) - MAPPER_FORWARD (xislower) - MAPPER_FORWARD (xisprint) - MAPPER_FORWARD (xispunct) - MAPPER_FORWARD (xisspace) - MAPPER_FORWARD (xisupper) - MAPPER_FORWARD (xisxdigit) - MAPPER_FORWARD (xtoascii) - MAPPER_FORWARD (xtolower) - MAPPER_FORWARD (xtoupper) - -#undef MAPPER_FORWARD - - octave_value map (octave_base_value::unary_mapper_t umap) const - { return rep->map (umap); } - - // Extract the n-th element, aka val(n). Result is undefined if val is not an - // array type or n is out of range. Never error. - octave_value - fast_elem_extract (octave_idx_type n) const - { return rep->fast_elem_extract (n); } - - // Assign the n-th element, aka val(n) = x. Returns false if val is not an - // array type, x is not a matching scalar type, or n is out of range. - // Never error. - virtual bool - fast_elem_insert (octave_idx_type n, const octave_value& x) - { - make_unique (); - return rep->fast_elem_insert (n, x); - } - -protected: - - // The real representation. - octave_base_value *rep; - -private: - - assign_op unary_op_to_assign_op (unary_op op); - - binary_op op_eq_to_binary_op (assign_op op); - - // This declaration protects against constructing octave_value from - // const octave_base_value* which actually silently calls octave_value (bool). - octave_value (const octave_base_value *); - - DECLARE_OCTAVE_ALLOCATOR -}; - -// Publish externally used friend functions. - -extern OCTINTERP_API octave_value -do_unary_op (octave_value::unary_op op, const octave_value& a); - -extern OCTINTERP_API octave_value -do_binary_op (octave_value::binary_op op, - const octave_value& a, const octave_value& b); - -extern OCTINTERP_API octave_value -do_binary_op (octave_value::compound_binary_op op, - const octave_value& a, const octave_value& b); - -#define OV_UNOP_FN(name) \ - inline octave_value \ - name (const octave_value& a) \ - { \ - return do_unary_op (octave_value::name, a); \ - } - -#define OV_UNOP_OP(name, op) \ - inline octave_value \ - operator op (const octave_value& a) \ - { \ - return name (a); \ - } - -#define OV_UNOP_FN_OP(name, op) \ - OV_UNOP_FN (name) \ - OV_UNOP_OP (name, op) - -OV_UNOP_FN_OP (op_not, !) -OV_UNOP_FN_OP (op_uplus, +) -OV_UNOP_FN_OP (op_uminus, -) - -OV_UNOP_FN (op_transpose) -OV_UNOP_FN (op_hermitian) - -// No simple way to define these for prefix and suffix ops? -// -// incr -// decr - -#define OV_BINOP_FN(name) \ - inline octave_value \ - name (const octave_value& a1, const octave_value& a2) \ - { \ - return do_binary_op (octave_value::name, a1, a2); \ - } - -#define OV_BINOP_OP(name, op) \ - inline octave_value \ - operator op (const octave_value& a1, const octave_value& a2) \ - { \ - return name (a1, a2); \ - } - -#define OV_BINOP_FN_OP(name, op) \ - OV_BINOP_FN (name) \ - OV_BINOP_OP (name, op) - -OV_BINOP_FN_OP (op_add, +) -OV_BINOP_FN_OP (op_sub, -) -OV_BINOP_FN_OP (op_mul, *) -OV_BINOP_FN_OP (op_div, /) - -OV_BINOP_FN (op_pow) -OV_BINOP_FN (op_ldiv) -OV_BINOP_FN (op_lshift) -OV_BINOP_FN (op_rshift) - -OV_BINOP_FN_OP (op_lt, <) -OV_BINOP_FN_OP (op_le, <=) -OV_BINOP_FN_OP (op_eq, ==) -OV_BINOP_FN_OP (op_ge, >=) -OV_BINOP_FN_OP (op_gt, >) -OV_BINOP_FN_OP (op_ne, !=) - -OV_BINOP_FN (op_el_mul) -OV_BINOP_FN (op_el_div) -OV_BINOP_FN (op_el_pow) -OV_BINOP_FN (op_el_ldiv) -OV_BINOP_FN (op_el_and) -OV_BINOP_FN (op_el_or) - -OV_BINOP_FN (op_struct_ref) - -#define OV_COMP_BINOP_FN(name) \ - inline octave_value \ - name (const octave_value& a1, const octave_value& a2) \ - { \ - return do_binary_op (octave_value::name, a1, a2); \ - } - -OV_COMP_BINOP_FN (op_trans_mul) -OV_COMP_BINOP_FN (op_mul_trans) -OV_COMP_BINOP_FN (op_herm_mul) -OV_COMP_BINOP_FN (op_mul_herm) - -extern OCTINTERP_API void install_types (void); - -// This will eventually go away, but for now it can be used to -// simplify the transition to the new octave_value class hierarchy, -// which uses octave_base_value instead of octave_value for the type -// of octave_value::rep. -#define OV_REP_TYPE octave_base_value - -// Templated value extractors. -template -inline Value octave_value_extract (const octave_value&) - { assert (false); } - -#define DEF_VALUE_EXTRACTOR(VALUE,MPREFIX) \ -template<> \ -inline VALUE octave_value_extract (const octave_value& v) \ - { return v.MPREFIX ## _value (); } - -DEF_VALUE_EXTRACTOR (double, scalar) -DEF_VALUE_EXTRACTOR (float, float_scalar) -DEF_VALUE_EXTRACTOR (Complex, complex) -DEF_VALUE_EXTRACTOR (FloatComplex, float_complex) -DEF_VALUE_EXTRACTOR (bool, bool) - -DEF_VALUE_EXTRACTOR (octave_int8, int8_scalar) -DEF_VALUE_EXTRACTOR (octave_int16, int16_scalar) -DEF_VALUE_EXTRACTOR (octave_int32, int32_scalar) -DEF_VALUE_EXTRACTOR (octave_int64, int64_scalar) -DEF_VALUE_EXTRACTOR (octave_uint8, uint8_scalar) -DEF_VALUE_EXTRACTOR (octave_uint16, uint16_scalar) -DEF_VALUE_EXTRACTOR (octave_uint32, uint32_scalar) -DEF_VALUE_EXTRACTOR (octave_uint64, uint64_scalar) - - -DEF_VALUE_EXTRACTOR (NDArray, array) -DEF_VALUE_EXTRACTOR (FloatNDArray, float_array) -DEF_VALUE_EXTRACTOR (ComplexNDArray, complex_array) -DEF_VALUE_EXTRACTOR (FloatComplexNDArray, float_complex_array) -DEF_VALUE_EXTRACTOR (boolNDArray, bool_array) - -DEF_VALUE_EXTRACTOR (charNDArray, char_array) -DEF_VALUE_EXTRACTOR (int8NDArray, int8_array) -DEF_VALUE_EXTRACTOR (int16NDArray, int16_array) -DEF_VALUE_EXTRACTOR (int32NDArray, int32_array) -DEF_VALUE_EXTRACTOR (int64NDArray, int64_array) -DEF_VALUE_EXTRACTOR (uint8NDArray, uint8_array) -DEF_VALUE_EXTRACTOR (uint16NDArray, uint16_array) -DEF_VALUE_EXTRACTOR (uint32NDArray, uint32_array) -DEF_VALUE_EXTRACTOR (uint64NDArray, uint64_array) - -DEF_VALUE_EXTRACTOR (Matrix, matrix) -DEF_VALUE_EXTRACTOR (FloatMatrix, float_matrix) -DEF_VALUE_EXTRACTOR (ComplexMatrix, complex_matrix) -DEF_VALUE_EXTRACTOR (FloatComplexMatrix, float_complex_matrix) -DEF_VALUE_EXTRACTOR (boolMatrix, bool_matrix) - -DEF_VALUE_EXTRACTOR (ColumnVector, column_vector) -DEF_VALUE_EXTRACTOR (FloatColumnVector, float_column_vector) -DEF_VALUE_EXTRACTOR (ComplexColumnVector, complex_column_vector) -DEF_VALUE_EXTRACTOR (FloatComplexColumnVector, float_complex_column_vector) - -DEF_VALUE_EXTRACTOR (RowVector, row_vector) -DEF_VALUE_EXTRACTOR (FloatRowVector, float_row_vector) -DEF_VALUE_EXTRACTOR (ComplexRowVector, complex_row_vector) -DEF_VALUE_EXTRACTOR (FloatComplexRowVector, float_complex_row_vector) - -DEF_VALUE_EXTRACTOR (DiagMatrix, diag_matrix) -DEF_VALUE_EXTRACTOR (FloatDiagMatrix, float_diag_matrix) -DEF_VALUE_EXTRACTOR (ComplexDiagMatrix, complex_diag_matrix) -DEF_VALUE_EXTRACTOR (FloatComplexDiagMatrix, float_complex_diag_matrix) -DEF_VALUE_EXTRACTOR (PermMatrix, perm_matrix) - -DEF_VALUE_EXTRACTOR (SparseMatrix, sparse_matrix) -DEF_VALUE_EXTRACTOR (SparseComplexMatrix, sparse_complex_matrix) -DEF_VALUE_EXTRACTOR (SparseBoolMatrix, sparse_bool_matrix) -#undef DEF_VALUE_EXTRACTOR - -#define DEF_DUMMY_VALUE_EXTRACTOR(VALUE,DEFVAL) \ -template<> \ -inline VALUE octave_value_extract (const octave_value&) \ - { assert (false); return DEFVAL; } - -DEF_DUMMY_VALUE_EXTRACTOR (char, 0) -DEF_DUMMY_VALUE_EXTRACTOR (octave_value, octave_value ()) -#undef DEF_DUMMY_VALUE_EXTRACTOR - -#endif diff -r d02b229ce693 -r a132d206a36a src/pager.cc --- a/src/pager.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,715 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "cmd-edit.h" -#include "oct-env.h" -#include "singleton-cleanup.h" - -#include "defaults.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "oct-obj.h" -#include "pager.h" -#include "procstream.h" -#include "sighandlers.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Our actual connection to the external pager. -static oprocstream *external_pager = 0; - -// TRUE means we write to the diary file. -static bool write_to_diary_file = false; - -// The name of the current diary file. -static std::string diary_file; - -// The diary file. -static std::ofstream external_diary_file; - -static std::string -default_pager (void) -{ - std::string pager_binary = octave_env::getenv ("PAGER"); - -#ifdef OCTAVE_DEFAULT_PAGER - if (pager_binary.empty ()) - pager_binary = OCTAVE_DEFAULT_PAGER; -#endif - - return pager_binary; -} - -// The shell command to run as the pager. -static std::string VPAGER = default_pager (); - -// The options to pass to the pager. -static std::string VPAGER_FLAGS; - -// TRUE means that if output is going to the pager, it is sent as soon -// as it is available. Otherwise, it is buffered and only sent to the -// pager when it is time to print another prompt. -static bool Vpage_output_immediately = false; - -// TRUE means all output intended for the screen should be passed -// through the pager. -static bool Vpage_screen_output = true; - -static bool really_flush_to_pager = false; - -static bool flushing_output_to_pager = false; - -static void -clear_external_pager (void) -{ - if (external_pager) - { - octave_child_list::remove (external_pager->pid ()); - - delete external_pager; - external_pager = 0; - } -} - -static bool -pager_event_handler (pid_t pid, int status) -{ - bool retval = false; - - if (pid > 0) - { - if (WIFEXITED (status) || WIFSIGNALLED (status)) - { - // Avoid warning() since that will put us back in the pager, - // which would be bad news. - - std::cerr << "warning: connection to external pager lost (pid = " - << pid << ")" << std::endl; - std::cerr << "warning: flushing pending output (please wait)" - << std::endl; - - // Request removal of this PID from the list of child - // processes. - - retval = true; - } - } - - return retval; -} - -static std::string -pager_command (void) -{ - std::string cmd = VPAGER; - - if (! (cmd.empty () || VPAGER_FLAGS.empty ())) - cmd += " " + VPAGER_FLAGS; - - return cmd; -} - -static void -do_sync (const char *msg, int len, bool bypass_pager) -{ - if (msg && len > 0) - { - if (bypass_pager) - { - std::cout.write (msg, len); - std::cout.flush (); - } - else - { - if (! external_pager) - { - std::string pgr = pager_command (); - - if (! pgr.empty ()) - { - external_pager = new oprocstream (pgr.c_str ()); - - if (external_pager) - octave_child_list::insert (external_pager->pid (), - pager_event_handler); - } - } - - if (external_pager) - { - if (external_pager->good ()) - { - external_pager->write (msg, len); - - external_pager->flush (); - -#if defined (EPIPE) - if (errno == EPIPE) - external_pager->setstate (std::ios::failbit); -#endif - } - else - { - // FIXME -- omething is not right with the - // pager. If it died then we should receive a - // signal for that. If there is some other problem, - // then what? - } - } - else - { - std::cout.write (msg, len); - std::cout.flush (); - } - } - } -} - -// Assume our terminal wraps long lines. - -static bool -more_than_a_screenful (const char *s, int len) -{ - if (s) - { - int available_rows = command_editor::terminal_rows () - 2; - - int cols = command_editor::terminal_cols (); - - int count = 0; - - int chars_this_line = 0; - - for (int i = 0; i < len; i++) - { - if (*s++ == '\n') - { - count += chars_this_line / cols + 1; - chars_this_line = 0; - } - else - chars_this_line++; - } - - if (count > available_rows) - return true; - } - - return false; -} - -int -octave_pager_buf::sync (void) -{ - if (! interactive - || really_flush_to_pager - || (Vpage_screen_output && Vpage_output_immediately) - || ! Vpage_screen_output) - { - char *buf = eback (); - - int len = pptr () - buf; - - bool bypass_pager = (! interactive - || ! Vpage_screen_output - || (really_flush_to_pager - && Vpage_screen_output - && ! Vpage_output_immediately - && ! more_than_a_screenful (buf, len))); - - if (len > 0) - { - do_sync (buf, len, bypass_pager); - - flush_current_contents_to_diary (); - - seekoff (0, std::ios::beg); - } - } - - return 0; -} - -void -octave_pager_buf::flush_current_contents_to_diary (void) -{ - char *buf = eback () + diary_skip; - - size_t len = pptr () - buf; - - octave_diary.write (buf, len); - - diary_skip = 0; -} - -void -octave_pager_buf::set_diary_skip (void) -{ - diary_skip = pptr () - eback (); -} - -int -octave_diary_buf::sync (void) -{ - if (write_to_diary_file && external_diary_file) - { - char *buf = eback (); - - int len = pptr () - buf; - - if (len > 0) - external_diary_file.write (buf, len); - } - - seekoff (0, std::ios::beg); - - return 0; -} - -octave_pager_stream *octave_pager_stream::instance = 0; - -octave_pager_stream::octave_pager_stream (void) : std::ostream (0), pb (0) -{ - pb = new octave_pager_buf (); - rdbuf (pb); - setf (unitbuf); -} - -octave_pager_stream::~octave_pager_stream (void) -{ - flush (); - delete pb; -} - -std::ostream& -octave_pager_stream::stream (void) -{ - return instance_ok () ? *instance : std::cout; -} - -void -octave_pager_stream::flush_current_contents_to_diary (void) -{ - if (instance_ok ()) - instance->do_flush_current_contents_to_diary (); -} - -void -octave_pager_stream::set_diary_skip (void) -{ - if (instance_ok ()) - instance->do_set_diary_skip (); -} - -// Reinitialize the pager buffer to avoid hanging on to large internal -// buffers when they might not be needed. This function should only be -// called when the pager is not in use. For example, just before -// getting command-line input. - -void -octave_pager_stream::reset (void) -{ - if (instance_ok ()) - instance->do_reset (); -} - -void -octave_pager_stream::do_flush_current_contents_to_diary (void) -{ - if (pb) - pb->flush_current_contents_to_diary (); -} - -void -octave_pager_stream::do_set_diary_skip (void) -{ - if (pb) - pb->set_diary_skip (); -} - -void -octave_pager_stream::do_reset (void) -{ - delete pb; - pb = new octave_pager_buf (); - rdbuf (pb); - setf (unitbuf); -} - -bool -octave_pager_stream::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_pager_stream (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create pager_stream object!"); - - retval = false; - } - - return retval; -} - -octave_diary_stream *octave_diary_stream::instance = 0; - -octave_diary_stream::octave_diary_stream (void) : std::ostream (0), db (0) -{ - db = new octave_diary_buf (); - rdbuf (db); - setf (unitbuf); -} - -octave_diary_stream::~octave_diary_stream (void) -{ - flush (); - delete db; -} - -std::ostream& -octave_diary_stream::stream (void) -{ - return instance_ok () ? *instance : std::cout; -} - -// Reinitialize the diary buffer to avoid hanging on to large internal -// buffers when they might not be needed. This function should only be -// called when the pager is not in use. For example, just before -// getting command-line input. - -void -octave_diary_stream::reset (void) -{ - if (instance_ok ()) - instance->do_reset (); -} - -void -octave_diary_stream::do_reset (void) -{ - delete db; - db = new octave_diary_buf (); - rdbuf (db); - setf (unitbuf); -} - -bool -octave_diary_stream::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_diary_stream (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create diary_stream object!"); - - retval = false; - } - - return retval; -} - -void -flush_octave_stdout (void) -{ - if (! flushing_output_to_pager) - { - unwind_protect frame; - - frame.protect_var (really_flush_to_pager); - frame.protect_var (flushing_output_to_pager); - - really_flush_to_pager = true; - flushing_output_to_pager = true; - - octave_stdout.flush (); - - clear_external_pager (); - } -} - -static void -close_diary_file (void) -{ - // Try to flush the current buffer to the diary now, so that things - // like - // - // function foo () - // diary on; - // ... - // diary off; - // endfunction - // - // will do the right thing. - - octave_pager_stream::flush_current_contents_to_diary (); - - if (external_diary_file.is_open ()) - { - octave_diary.flush (); - external_diary_file.close (); - } -} - -static void -open_diary_file (void) -{ - close_diary_file (); - - // If there is pending output in the pager buf, it should not go - // into the diary file. - - octave_pager_stream::set_diary_skip (); - - external_diary_file.open (diary_file.c_str (), std::ios::app); - - if (! external_diary_file) - error ("diary: can't open diary file `%s'", diary_file.c_str ()); -} - -DEFUN (diary, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} diary options\n\ -Record a list of all commands @emph{and} the output they produce, mixed\n\ -together just as you see them on your terminal. Valid options are:\n\ -\n\ -@table @code\n\ -@item on\n\ -Start recording your session in a file called @file{diary} in your\n\ -current working directory.\n\ -\n\ -@item off\n\ -Stop recording your session in the diary file.\n\ -\n\ -@item @var{file}\n\ -Record your session in the file named @var{file}.\n\ -@end table\n\ -\n\ -With no arguments, @code{diary} toggles the current diary state.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("diary"); - - if (error_state) - return retval; - - if (diary_file.empty ()) - diary_file = "diary"; - - switch (argc) - { - case 1: - write_to_diary_file = ! write_to_diary_file; - open_diary_file (); - break; - - case 2: - { - std::string arg = argv[1]; - - if (arg == "on") - { - write_to_diary_file = true; - open_diary_file (); - } - else if (arg == "off") - { - close_diary_file (); - write_to_diary_file = false; - } - else - { - diary_file = arg; - write_to_diary_file = true; - open_diary_file (); - } - } - break; - - default: - print_usage (); - break; - } - - return retval; -} - -DEFUN (more, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} more\n\ -@deftypefnx {Command} {} more on\n\ -@deftypefnx {Command} {} more off\n\ -Turn output pagination on or off. Without an argument, @code{more}\n\ -toggles the current state.\n\ -The current state can be determined via @code{page_screen_output}.\n\ -@seealso{page_screen_output, page_output_immediately, PAGER, PAGER_FLAGS}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("more"); - - if (error_state) - return retval; - - if (argc == 2) - { - std::string arg = argv[1]; - - if (arg == "on") - Vpage_screen_output = true; - else if (arg == "off") - Vpage_screen_output = false; - else - error ("more: unrecognized argument `%s'", arg.c_str ()); - } - else if (argc == 1) - Vpage_screen_output = ! Vpage_screen_output; - else - print_usage (); - - return retval; -} - -DEFUN (terminal_size, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} terminal_size ()\n\ -Return a two-element row vector containing the current size of the\n\ -terminal window in characters (rows and columns).\n\ -@seealso{list_in_columns}\n\ -@end deftypefn") -{ - RowVector size (2, 0.0); - - size(0) = command_editor::terminal_rows (); - size(1) = command_editor::terminal_cols (); - - return octave_value (size); -} - -DEFUN (page_output_immediately, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} page_output_immediately ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} page_output_immediately (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} page_output_immediately (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave sends\n\ -output to the pager as soon as it is available. Otherwise, Octave\n\ -buffers its output and waits until just before the prompt is printed to\n\ -flush it to the pager.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{page_screen_output, more, PAGER, PAGER_FLAGS}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (page_output_immediately); -} - -DEFUN (page_screen_output, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} page_screen_output ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} page_screen_output (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} page_screen_output (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether output intended\n\ -for the terminal window that is longer than one page is sent through a\n\ -pager. This allows you to view one screenful at a time. Some pagers\n\ -(such as @code{less}---see @ref{Installation}) are also capable of moving\n\ -backward on the output.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{more, page_output_immediately, PAGER, PAGER_FLAGS}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (page_screen_output); -} - -DEFUN (PAGER, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PAGER ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PAGER (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PAGER (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the program to use\n\ -to display terminal output on your system. The default value is\n\ -normally @code{\"less\"}, @code{\"more\"}, or\n\ -@code{\"pg\"}, depending on what programs are installed on your system.\n\ -@xref{Installation}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PAGER_FLAGS, page_output_immediately, more, page_screen_output}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER); -} - -DEFUN (PAGER_FLAGS, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PAGER_FLAGS ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PAGER_FLAGS (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PAGER_FLAGS (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the options to pass\n\ -to the pager.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PAGER, more, page_screen_output, page_output_immediately}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER_FLAGS); -} diff -r d02b229ce693 -r a132d206a36a src/pager.h --- a/src/pager.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,150 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_pager_h) -#define octave_pager_h 1 - -#include -#include -#include - -#include - -class -OCTINTERP_API -octave_pager_buf : public std::stringbuf -{ -public: - - octave_pager_buf (void) : std::stringbuf (), diary_skip (0) { } - - void flush_current_contents_to_diary (void); - - void set_diary_skip (void); - -protected: - - int sync (void); - -private: - - size_t diary_skip; -}; - -class -OCTINTERP_API -octave_pager_stream : public std::ostream -{ -protected: - - octave_pager_stream (void); - -public: - - ~octave_pager_stream (void); - - static void flush_current_contents_to_diary (void); - - static void set_diary_skip (void); - - static std::ostream& stream (void); - - static void reset (void); - -private: - - void do_flush_current_contents_to_diary (void); - - void do_set_diary_skip (void); - - void do_reset (void); - - static octave_pager_stream *instance; - - static bool instance_ok (void); - - static void cleanup_instance (void) { delete instance; instance = 0; } - - octave_pager_buf *pb; - - // No copying! - - octave_pager_stream (const octave_pager_stream&); - - octave_pager_stream& operator = (const octave_pager_stream&); -}; - -class -OCTINTERP_API -octave_diary_buf : public std::stringbuf -{ -public: - - octave_diary_buf (void) : std::stringbuf () { } - -protected: - - int sync (void); -}; - -class -OCTINTERP_API -octave_diary_stream : public std::ostream -{ -protected: - - octave_diary_stream (void); - -public: - - ~octave_diary_stream (void); - - static std::ostream& stream (void); - - static void reset (void); - -private: - - void do_reset (void); - - static octave_diary_stream *instance; - - static bool instance_ok (void); - - static void cleanup_instance (void) { delete instance; instance = 0; } - - octave_diary_buf *db; - - // No copying! - - octave_diary_stream (const octave_diary_stream&); - - octave_diary_stream& operator = (const octave_diary_stream&); -}; - -#define octave_stdout (octave_pager_stream::stream ()) - -#define octave_diary (octave_diary_stream::stream ()) - -extern OCTINTERP_API void flush_octave_stdout (void); - -#endif diff -r d02b229ce693 -r a132d206a36a src/parse-private.h --- a/src/parse-private.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,96 +0,0 @@ -/* - -Copyright (C) 2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_parse_private_h) -#define octave_parse_private_h 1 - -#include - -#include "symtab.h" - -// Keep track of symbol table information when parsing functions. -class symtab_context -{ -private: - - class frame - { - public: - frame (symbol_table::scope_id s, symbol_table::scope_id c) - : m_scope (s), m_context (c) { } - - frame (const frame& f) : m_scope (f.m_scope), m_context (f.m_context) { } - - frame& operator = (const frame& f) - { - if (&f != this) - { - m_scope = f.m_scope; - m_context = f.m_context; - } - - return *this; - } - - ~frame (void) { } - - symbol_table::scope_id scope (void) const { return m_scope; } - symbol_table::scope_id context (void) const { return m_context; } - - private: - - symbol_table::scope_id m_scope; - symbol_table::scope_id m_context; - }; - - std::stack frame_stack; - -public: - symtab_context (void) : frame_stack () { } - - void clear (void) - { - while (! frame_stack.empty ()) - frame_stack.pop (); - } - - bool empty (void) const { return frame_stack.empty (); } - - void pop (void) - { - frame tmp = frame_stack.top (); - - symbol_table::set_scope_and_context (tmp.scope (), tmp.context ()); - - frame_stack.pop (); - } - - void push (void) - { - frame_stack.push (frame (symbol_table::current_scope (), - symbol_table::current_context ())); - } -}; - -extern symtab_context parser_symtab_context; - -#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/lex.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/lex.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,200 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_lex_h) +#define octave_lex_h 1 + +#include +#include + +// FIXME -- these input buffer things should be members of a +// parser input stream class. + +typedef struct yy_buffer_state *YY_BUFFER_STATE; + +// Associate a buffer with a new file to read. +extern OCTINTERP_API YY_BUFFER_STATE create_buffer (FILE *f); + +// Report the current buffer. +extern OCTINTERP_API YY_BUFFER_STATE current_buffer (void); + +// Connect to new buffer buffer. +extern OCTINTERP_API void switch_to_buffer (YY_BUFFER_STATE buf); + +// Delete a buffer. +extern OCTINTERP_API void delete_buffer (YY_BUFFER_STATE buf); + +extern OCTINTERP_API void clear_all_buffers (void); + +extern OCTINTERP_API void cleanup_parser (void); + +// Is the given string a keyword? +extern bool is_keyword (const std::string& s); + +extern void prep_lexer_for_script_file (void); +extern void prep_lexer_for_function_file (void); + +// For communication between the lexer and parser. + +class +lexical_feedback +{ +public: + + lexical_feedback (void) + + : bracketflag (0), braceflag (0), looping (0), + convert_spaces_to_comma (true), at_beginning_of_statement (true), + defining_func (0), looking_at_function_handle (0), + looking_at_anon_fcn_args (true), + looking_at_return_list (false), looking_at_parameter_list (false), + looking_at_decl_list (false), looking_at_initializer_expression (false), + looking_at_matrix_or_assign_lhs (false), looking_at_object_index (), + looking_for_object_index (false), do_comma_insert (false), + looking_at_indirect_ref (false), parsed_function_name (), + parsing_class_method (false), maybe_classdef_get_set_method (false), + parsing_classdef (false), quote_is_transpose (false), + pending_local_variables () + + { + init (); + } + + ~lexical_feedback (void) { } + + void init (void); + + // Square bracket level count. + int bracketflag; + + // Curly brace level count. + int braceflag; + + // TRUE means we're in the middle of defining a loop. + int looping; + + // TRUE means that we should convert spaces to a comma inside a + // matrix definition. + bool convert_spaces_to_comma; + + // TRUE means we are at the beginning of a statement, where a + // command name is possible. + bool at_beginning_of_statement; + + // Nonzero means we're in the middle of defining a function. + int defining_func; + + // Nonzero means we are parsing a function handle. + int looking_at_function_handle; + + // TRUE means we are parsing an anonymous function argument list. + bool looking_at_anon_fcn_args; + + // TRUE means we're parsing the return list for a function. + bool looking_at_return_list; + + // TRUE means we're parsing the parameter list for a function. + bool looking_at_parameter_list; + + // TRUE means we're parsing a declaration list (global or + // persistent). + bool looking_at_decl_list; + + // TRUE means we are looking at the initializer expression for a + // parameter list element. + bool looking_at_initializer_expression; + + // TRUE means we're parsing a matrix or the left hand side of + // multi-value assignment statement. + bool looking_at_matrix_or_assign_lhs; + + // If the front of the list is TRUE, the closest paren, brace, or + // bracket nesting is an index for an object. + std::list looking_at_object_index; + + // Object index not possible until we've seen something. + bool looking_for_object_index; + + // GAG. Stupid kludge so that [[1,2][3,4]] will work. + bool do_comma_insert; + + // TRUE means we're looking at an indirect reference to a + // structure element. + bool looking_at_indirect_ref; + + // If the top of the stack is TRUE, then we've already seen the name + // of the current function. Should only matter if + // current_function_level > 0 + std::stack parsed_function_name; + + // TRUE means we are parsing a class method in function or classdef file. + bool parsing_class_method; + + // TRUE means we are parsing a class method declaration line in a + // classdef file and can accept a property get or set method name. + // For example, "get.PropertyName" is recognized as a function name. + bool maybe_classdef_get_set_method; + + // TRUE means we are parsing a classdef file + bool parsing_classdef; + + // Return transpose or start a string? + bool quote_is_transpose; + + // Set of identifiers that might be local variable names. + std::set pending_local_variables; + +private: + + lexical_feedback (const lexical_feedback&); + + lexical_feedback& operator = (const lexical_feedback&); +}; + +class +stream_reader +{ +public: + virtual int getc (void) = 0; + virtual int ungetc (int c) = 0; + +protected: + stream_reader (void) { } + ~stream_reader (void) { } + +private: + + // No copying! + stream_reader (const stream_reader&); + stream_reader& operator = (const stream_reader&); +}; + +extern std::string +grab_comment_block (stream_reader& reader, bool at_bol, bool& eof); + +// TRUE means that we have encountered EOF on the input stream. +extern bool parser_end_of_input; + +// Flags that need to be shared between the lexer and parser. +extern lexical_feedback lexer_flags; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/lex.ll --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/lex.ll Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,3822 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +%option prefix = "octave_" + +%top { +#ifdef HAVE_CONFIG_H +#include +#endif + +} + +%s COMMAND_START +%s MATRIX_START + +%x SCRIPT_FILE_BEGIN +%x FUNCTION_FILE_BEGIN + +%{ + +#include +#include + +#include +#include +#include +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "quit.h" +#include "lo-mappers.h" + +// These would be alphabetical, but y.tab.h must be included before +// oct-gperf.h and y.tab.h must be included after token.h and the tree +// class declarations. We can't include y.tab.h in oct-gperf.h +// because it may not be protected to allow it to be included multiple +// times. + +#include "Cell.h" +#include "comment-list.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "lex.h" +#include "ov.h" +#include "parse.h" +#include "parse-private.h" +#include "pt-all.h" +#include "symtab.h" +#include "token.h" +#include "toplev.h" +#include "utils.h" +#include "variables.h" +#include +#include + +#if defined (GNULIB_NAMESPACE) +// Calls to the following functions appear in the generated output from +// flex without the namespace tag. Redefine them so we will use them +// via the gnulib namespace. +#define fprintf GNULIB_NAMESPACE::fprintf +#define fwrite GNULIB_NAMESPACE::fwrite +#define isatty GNULIB_NAMESPACE::isatty +#define malloc GNULIB_NAMESPACE::malloc +#define realloc GNULIB_NAMESPACE::realloc +#endif + +#if ! (defined (FLEX_SCANNER) \ + && defined (YY_FLEX_MAJOR_VERSION) && YY_FLEX_MAJOR_VERSION >= 2 \ + && defined (YY_FLEX_MINOR_VERSION) && YY_FLEX_MINOR_VERSION >= 5) +#error lex.l requires flex version 2.5.4 or later +#endif + +#define yylval octave_lval + +// Arrange to get input via readline. + +#ifdef YY_INPUT +#undef YY_INPUT +#endif +#define YY_INPUT(buf, result, max_size) \ + if ((result = octave_read (buf, max_size)) < 0) \ + YY_FATAL_ERROR ("octave_read () in flex scanner failed"); + +// Try to avoid crashing out completely on fatal scanner errors. +// The call to yy_fatal_error should never happen, but it avoids a +// `static function defined but not used' warning from gcc. + +#ifdef YY_FATAL_ERROR +#undef YY_FATAL_ERROR +#endif +#define YY_FATAL_ERROR(msg) \ + do \ + { \ + error (msg); \ + OCTAVE_QUIT; \ + yy_fatal_error (msg); \ + } \ + while (0) + +#define DISPLAY_TOK_AND_RETURN(tok) \ + do \ + { \ + int tok_val = tok; \ + if (Vdisplay_tokens) \ + display_token (tok_val); \ + if (lexer_debug_flag) \ + { \ + std::cerr << "R: "; \ + display_token (tok_val); \ + std::cerr << std::endl; \ + } \ + return tok_val; \ + } \ + while (0) + +#define COUNT_TOK_AND_RETURN(tok) \ + do \ + { \ + Vtoken_count++; \ + DISPLAY_TOK_AND_RETURN (tok); \ + } \ + while (0) + +#define TOK_RETURN(tok) \ + do \ + { \ + current_input_column += yyleng; \ + lexer_flags.quote_is_transpose = false; \ + lexer_flags.convert_spaces_to_comma = true; \ + COUNT_TOK_AND_RETURN (tok); \ + } \ + while (0) + +#define TOK_PUSH_AND_RETURN(name, tok) \ + do \ + { \ + yylval.tok_val = new token (name, input_line_number, \ + current_input_column); \ + token_stack.push (yylval.tok_val); \ + TOK_RETURN (tok); \ + } \ + while (0) + +#define BIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ + do \ + { \ + yylval.tok_val = new token (input_line_number, current_input_column); \ + token_stack.push (yylval.tok_val); \ + current_input_column += yyleng; \ + lexer_flags.quote_is_transpose = qit; \ + lexer_flags.convert_spaces_to_comma = convert; \ + lexer_flags.looking_for_object_index = false; \ + lexer_flags.at_beginning_of_statement = bos; \ + COUNT_TOK_AND_RETURN (tok); \ + } \ + while (0) + +#define XBIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ + do \ + { \ + gripe_matlab_incompatible_operator (yytext); \ + BIN_OP_RETURN_INTERNAL (tok, convert, bos, qit); \ + } \ + while (0) + +#define BIN_OP_RETURN(tok, convert, bos) \ + do \ + { \ + BIN_OP_RETURN_INTERNAL (tok, convert, bos, false); \ + } \ + while (0) + +#define XBIN_OP_RETURN(tok, convert, bos) \ + do \ + { \ + gripe_matlab_incompatible_operator (yytext); \ + BIN_OP_RETURN (tok, convert, bos); \ + } \ + while (0) + +#define LEXER_DEBUG(pattern) \ + do \ + { \ + if (lexer_debug_flag) \ + lexer_debug (pattern, yytext); \ + } \ + while (0) + +// TRUE means that we have encountered EOF on the input stream. +bool parser_end_of_input = false; + +// Flags that need to be shared between the lexer and parser. +lexical_feedback lexer_flags; + +// Stack to hold tokens so that we can delete them when the parser is +// reset and avoid growing forever just because we are stashing some +// information. This has to appear before lex.h is included, because +// one of the macros defined there uses token_stack. +// +// FIXME -- this should really be static, but that causes +// problems on some systems. +std::stack token_stack; + +// Did eat_whitespace() eat a space or tab, or a newline, or both? + +typedef int yum_yum; + +const yum_yum ATE_NOTHING = 0; +const yum_yum ATE_SPACE_OR_TAB = 1; +const yum_yum ATE_NEWLINE = 2; + +// Is the closest nesting level a square bracket, squiggly brace or a paren? + +class bracket_brace_paren_nesting_level +{ +public: + + bracket_brace_paren_nesting_level (void) : context () { } + + ~bracket_brace_paren_nesting_level (void) { } + + void bracket (void) { context.push (BRACKET); } + bool is_bracket (void) + { return ! context.empty () && context.top () == BRACKET; } + + void brace (void) { context.push (BRACE); } + bool is_brace (void) + { return ! context.empty () && context.top () == BRACE; } + + void paren (void) { context.push (PAREN); } + bool is_paren (void) + { return ! context.empty () && context.top () == PAREN; } + + bool is_bracket_or_brace (void) + { return (! context.empty () + && (context.top () == BRACKET || context.top () == BRACE)); } + + bool none (void) { return context.empty (); } + + void remove (void) { if (! context.empty ()) context.pop (); } + + void clear (void) { while (! context.empty ()) context.pop (); } + +private: + + std::stack context; + + static const int BRACKET; + static const int BRACE; + static const int PAREN; + + bracket_brace_paren_nesting_level (const bracket_brace_paren_nesting_level&); + + bracket_brace_paren_nesting_level& + operator = (const bracket_brace_paren_nesting_level&); +}; + +const int bracket_brace_paren_nesting_level::BRACKET = 1; +const int bracket_brace_paren_nesting_level::BRACE = 2; +const int bracket_brace_paren_nesting_level::PAREN = 3; + +static bracket_brace_paren_nesting_level nesting_level; + +static bool Vdisplay_tokens = false; + +static unsigned int Vtoken_count = 0; + +// The start state that was in effect when the beginning of a block +// comment was noticed. +static int block_comment_nesting_level = 0; + +// Internal variable for lexer debugging state. +static bool lexer_debug_flag = false; + +// Forward declarations for functions defined at the bottom of this +// file. + +static int text_yyinput (void); +static void xunput (char c, char *buf); +static void fixup_column_count (char *s); +static void do_comma_insert_check (void); +static int is_keyword_token (const std::string& s); +static int process_comment (bool start_in_block, bool& eof); +static bool match_any (char c, const char *s); +static bool next_token_is_sep_op (void); +static bool next_token_is_bin_op (bool spc_prev); +static bool next_token_is_postfix_unary_op (bool spc_prev); +static std::string strip_trailing_whitespace (char *s); +static void handle_number (void); +static int handle_string (char delim); +static int handle_close_bracket (bool spc_gobbled, int bracket_type); +static int handle_superclass_identifier (void); +static int handle_meta_identifier (void); +static int handle_identifier (void); +static bool have_continuation (bool trailing_comments_ok = true); +static bool have_ellipsis_continuation (bool trailing_comments_ok = true); +static void scan_for_comments (const char *); +static yum_yum eat_whitespace (void); +static yum_yum eat_continuation (void); +static void maybe_warn_separator_insert (char sep); +static void gripe_single_quote_string (void); +static void gripe_matlab_incompatible (const std::string& msg); +static void maybe_gripe_matlab_incompatible_comment (char c); +static void gripe_matlab_incompatible_continuation (void); +static void gripe_matlab_incompatible_operator (const std::string& op); +static void display_token (int tok); +static void lexer_debug (const char *pattern, const char *text); + +%} + +D [0-9] +S [ \t] +NL ((\n)|(\r)|(\r\n)) +SNL ({S}|{NL}) +EL (\.\.\.) +BS (\\) +CONT ({EL}|{BS}) +Im [iIjJ] +CCHAR [#%] +COMMENT ({CCHAR}.*{NL}) +SNLCMT ({SNL}|{COMMENT}) +NOT ((\~)|(\!)) +POW ((\*\*)|(\^)) +EPOW (\.{POW}) +IDENT ([_$a-zA-Z][_$a-zA-Z0-9]*) +EXPON ([DdEe][+-]?{D}+) +NUMBER (({D}+\.?{D}*{EXPON}?)|(\.{D}+{EXPON}?)|(0[xX][0-9a-fA-F]+)) +%% + +%{ +// Make script and function files start with a bogus token. This makes +// the parser go down a special path. +%} + +. { + LEXER_DEBUG ("."); + + BEGIN (INITIAL); + xunput (yytext[0], yytext); + COUNT_TOK_AND_RETURN (SCRIPT_FILE); + } + +. { + LEXER_DEBUG ("."); + + BEGIN (INITIAL); + xunput (yytext[0], yytext); + COUNT_TOK_AND_RETURN (FUNCTION_FILE); + } + +%{ +// Help and other command-style functions. +%} + +{NL} { + LEXER_DEBUG ("{NL}"); + + BEGIN (INITIAL); + input_line_number++; + current_input_column = 1; + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = true; + + COUNT_TOK_AND_RETURN ('\n'); + } + +[\;\,] { + LEXER_DEBUG ("[\\;\\,]"); + + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = true; + + BEGIN (INITIAL); + + if (strcmp (yytext, ",") == 0) + TOK_RETURN (','); + else + TOK_RETURN (';'); + } + +[\"\'] { + LEXER_DEBUG ("[\\\"\\']"); + + lexer_flags.at_beginning_of_statement = false; + + current_input_column++; + int tok = handle_string (yytext[0]); + + COUNT_TOK_AND_RETURN (tok); + } + +[^#% \t\r\n\;\,\"\'][^ \t\r\n\;\,]*{S}* { + LEXER_DEBUG ("[^#% \\t\\r\\n\\;\\,\\\"\\'][^ \\t\\r\\n\\;\\,]*{S}*"); + + std::string tok = strip_trailing_whitespace (yytext); + + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + TOK_PUSH_AND_RETURN (tok, SQ_STRING); + } + +%{ +// For this and the next two rules, we're looking at ']', and we +// need to know if the next token is `=' or `=='. +// +// It would have been so much easier if the delimiters were simply +// different for the expression on the left hand side of the equals +// operator. +// +// It's also a pain in the ass to decide whether to insert a comma +// after seeing a ']' character... + +// FIXME -- we need to handle block comments here. +%} + +{SNLCMT}*\]{S}* { + LEXER_DEBUG ("{SNLCMT}*\\]{S}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + int c = yytext[yyleng-1]; + int cont_is_spc = eat_continuation (); + bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); + int tok_to_return = handle_close_bracket (spc_gobbled, ']'); + + if (spc_gobbled) + xunput (' ', yytext); + + COUNT_TOK_AND_RETURN (tok_to_return); + } + +%{ +// FIXME -- we need to handle block comments here. +%} + +{SNLCMT}*\}{S}* { + LEXER_DEBUG ("{SNLCMT}*\\}{S}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + int c = yytext[yyleng-1]; + int cont_is_spc = eat_continuation (); + bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); + int tok_to_return = handle_close_bracket (spc_gobbled, '}'); + + if (spc_gobbled) + xunput (' ', yytext); + + COUNT_TOK_AND_RETURN (tok_to_return); + } + +%{ +// Commas are element separators in matrix constants. If we don't +// check for continuations here we can end up inserting too many +// commas. +%} + +{S}*\,{S}* { + LEXER_DEBUG ("{S}*\\,{S}*"); + + current_input_column += yyleng; + + int tmp = eat_continuation (); + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + if (! lexer_flags.looking_at_object_index.front ()) + { + if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) + { + maybe_warn_separator_insert (';'); + + xunput (';', yytext); + } + } + + COUNT_TOK_AND_RETURN (','); + } + +%{ +// In some cases, spaces in matrix constants can turn into commas. +// If commas are required, spaces are not important in matrix +// constants so we just eat them. If we don't check for continuations +// here we can end up inserting too many commas. +%} + +{S}+ { + LEXER_DEBUG ("{S}+"); + + current_input_column += yyleng; + + lexer_flags.at_beginning_of_statement = false; + + int tmp = eat_continuation (); + + if (! lexer_flags.looking_at_object_index.front ()) + { + bool bin_op = next_token_is_bin_op (true); + bool postfix_un_op = next_token_is_postfix_unary_op (true); + bool sep_op = next_token_is_sep_op (); + + if (! (postfix_un_op || bin_op || sep_op) + && nesting_level.is_bracket_or_brace () + && lexer_flags.convert_spaces_to_comma) + { + if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) + { + maybe_warn_separator_insert (';'); + + xunput (';', yytext); + } + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + + maybe_warn_separator_insert (','); + + COUNT_TOK_AND_RETURN (','); + } + } + } + +%{ +// Semicolons are handled as row seprators in matrix constants. If we +// don't eat whitespace here we can end up inserting too many +// semicolons. + +// FIXME -- we need to handle block comments here. +%} + +{SNLCMT}*;{SNLCMT}* { + LEXER_DEBUG ("{SNLCMT}*;{SNLCMT}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + eat_whitespace (); + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + COUNT_TOK_AND_RETURN (';'); + } + +%{ +// In some cases, new lines can also become row separators. If we +// don't eat whitespace here we can end up inserting too many +// semicolons. + +// FIXME -- we need to handle block comments here. +%} + +{S}*{COMMENT}{SNLCMT}* | +{S}*{NL}{SNLCMT}* { + LEXER_DEBUG ("{S}*{COMMENT}{SNLCMT}*|{S}*{NL}{SNLCMT}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + eat_whitespace (); + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.at_beginning_of_statement = false; + + if (nesting_level.none ()) + return LEXICAL_ERROR; + + if (! lexer_flags.looking_at_object_index.front () + && nesting_level.is_bracket_or_brace ()) + { + maybe_warn_separator_insert (';'); + + COUNT_TOK_AND_RETURN (';'); + } + } + +\[{S}* { + LEXER_DEBUG ("\\[{S}*"); + + nesting_level.bracket (); + + lexer_flags.looking_at_object_index.push_front (false); + + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + if (lexer_flags.defining_func + && ! lexer_flags.parsed_function_name.top ()) + lexer_flags.looking_at_return_list = true; + else + lexer_flags.looking_at_matrix_or_assign_lhs = true; + + promptflag--; + eat_whitespace (); + + lexer_flags.bracketflag++; + BEGIN (MATRIX_START); + COUNT_TOK_AND_RETURN ('['); + } + +\] { + LEXER_DEBUG ("\\]"); + + nesting_level.remove (); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + TOK_RETURN (']'); + } + +%{ +// Imaginary numbers. +%} + +{NUMBER}{Im} { + LEXER_DEBUG ("{NUMBER}{Im}"); + + handle_number (); + COUNT_TOK_AND_RETURN (IMAG_NUM); + } + +%{ +// Real numbers. Don't grab the `.' part of a dot operator as part of +// the constant. +%} + +{D}+/\.[\*/\\^\'] | +{NUMBER} { + LEXER_DEBUG ("{D}+/\\.[\\*/\\^\\']|{NUMBER}"); + handle_number (); + COUNT_TOK_AND_RETURN (NUM); + } + +%{ +// Eat whitespace. Whitespace inside matrix constants is handled by +// the start state code above. +%} + +{S}* { + current_input_column += yyleng; + } + +%{ +// Continuation lines. Allow comments after continuations. +%} + +{CONT}{S}*{NL} | +{CONT}{S}*{COMMENT} { + LEXER_DEBUG ("{CONT}{S}*{NL}|{CONT}{S}*{COMMENT}"); + + if (yytext[0] == '\\') + gripe_matlab_incompatible_continuation (); + scan_for_comments (yytext); + promptflag--; + input_line_number++; + current_input_column = 1; + } + +%{ +// End of file. +%} + +<> { + LEXER_DEBUG ("<>"); + + if (block_comment_nesting_level != 0) + { + warning ("block comment open at end of input"); + + if ((reading_fcn_file || reading_script_file || reading_classdef_file) + && ! curr_fcn_file_name.empty ()) + warning ("near line %d of file `%s.m'", + input_line_number, curr_fcn_file_name.c_str ()); + } + + TOK_RETURN (END_OF_INPUT); + } + +%{ +// Identifiers. Truncate the token at the first space or tab but +// don't write directly on yytext. +%} + +{IDENT}{S}* { + LEXER_DEBUG ("{IDENT}{S}*"); + + int id_tok = handle_identifier (); + + if (id_tok >= 0) + COUNT_TOK_AND_RETURN (id_tok); + } + +%{ +// Superclass method identifiers. +%} + +{IDENT}@{IDENT}{S}* | +{IDENT}@{IDENT}.{IDENT}{S}* { + LEXER_DEBUG ("{IDENT}@{IDENT}{S}*|{IDENT}@{IDENT}.{IDENT}{S}*"); + + int id_tok = handle_superclass_identifier (); + + if (id_tok >= 0) + { + lexer_flags.looking_for_object_index = true; + + COUNT_TOK_AND_RETURN (SUPERCLASSREF); + } + } + +%{ +// Metaclass query +%} + +\?{IDENT}{S}* | +\?{IDENT}\.{IDENT}{S}* { + LEXER_DEBUG ("\\?{IDENT}{S}*|\\?{IDENT}\\.{IDENT}{S}*"); + + int id_tok = handle_meta_identifier (); + + if (id_tok >= 0) + { + lexer_flags.looking_for_object_index = true; + + COUNT_TOK_AND_RETURN (METAQUERY); + } + } + +%{ +// Function handles and superclass references +%} + +"@" { + LEXER_DEBUG ("@"); + + current_input_column++; + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = false; + lexer_flags.looking_at_function_handle++; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + COUNT_TOK_AND_RETURN ('@'); + + } + +%{ +// A new line character. New line characters inside matrix constants +// are handled by the start state code above. If closest +// nesting is inside parentheses, don't return a row separator. +%} + +{NL} { + LEXER_DEBUG ("{NL}"); + + input_line_number++; + current_input_column = 1; + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + + if (nesting_level.none ()) + { + lexer_flags.at_beginning_of_statement = true; + COUNT_TOK_AND_RETURN ('\n'); + } + else if (nesting_level.is_paren ()) + { + lexer_flags.at_beginning_of_statement = false; + gripe_matlab_incompatible ("bare newline inside parentheses"); + } + else if (nesting_level.is_bracket_or_brace ()) + return LEXICAL_ERROR; + } + +%{ +// Single quote can either be the beginning of a string or a transpose +// operator. +%} + +"'" { + LEXER_DEBUG ("'"); + + current_input_column++; + lexer_flags.convert_spaces_to_comma = true; + + if (lexer_flags.quote_is_transpose) + { + do_comma_insert_check (); + COUNT_TOK_AND_RETURN (QUOTE); + } + else + { + int tok = handle_string ('\''); + COUNT_TOK_AND_RETURN (tok); + } + } + +%{ +// Double quotes always begin strings. +%} + +\" { + LEXER_DEBUG ("\""); + + current_input_column++; + int tok = handle_string ('"'); + + COUNT_TOK_AND_RETURN (tok); +} + +%{ +// Gobble comments. +%} + +{CCHAR} { + LEXER_DEBUG ("{CCHAR}"); + + lexer_flags.looking_for_object_index = false; + + xunput (yytext[0], yytext); + + bool eof = false; + int tok = process_comment (false, eof); + + if (eof) + TOK_RETURN (END_OF_INPUT); + else if (tok > 0) + COUNT_TOK_AND_RETURN (tok); + } + +%{ +// Block comments. +%} + +^{S}*{CCHAR}\{{S}*{NL} { + LEXER_DEBUG ("^{S}*{CCHAR}\\{{S}*{NL}"); + + lexer_flags.looking_for_object_index = false; + + input_line_number++; + current_input_column = 1; + block_comment_nesting_level++; + promptflag--; + + bool eof = false; + process_comment (true, eof); + } + +%{ +// Other operators. +%} + +":" { LEXER_DEBUG (":"); BIN_OP_RETURN (':', false, false); } + +".+" { LEXER_DEBUG (".+"); XBIN_OP_RETURN (EPLUS, false, false); } +".-" { LEXER_DEBUG (".-"); XBIN_OP_RETURN (EMINUS, false, false); } +".*" { LEXER_DEBUG (".*"); BIN_OP_RETURN (EMUL, false, false); } +"./" { LEXER_DEBUG ("./"); BIN_OP_RETURN (EDIV, false, false); } +".\\" { LEXER_DEBUG (".\\"); BIN_OP_RETURN (ELEFTDIV, false, false); } +".^" { LEXER_DEBUG (".^"); BIN_OP_RETURN (EPOW, false, false); } +".**" { LEXER_DEBUG (".**"); XBIN_OP_RETURN (EPOW, false, false); } +".'" { LEXER_DEBUG (".'"); do_comma_insert_check (); BIN_OP_RETURN (TRANSPOSE, true, false); } +"++" { LEXER_DEBUG ("++"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (PLUS_PLUS, true, false, true); } +"--" { LEXER_DEBUG ("--"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (MINUS_MINUS, true, false, true); } +"<=" { LEXER_DEBUG ("<="); BIN_OP_RETURN (EXPR_LE, false, false); } +"==" { LEXER_DEBUG ("=="); BIN_OP_RETURN (EXPR_EQ, false, false); } +"~=" { LEXER_DEBUG ("~="); BIN_OP_RETURN (EXPR_NE, false, false); } +"!=" { LEXER_DEBUG ("!="); XBIN_OP_RETURN (EXPR_NE, false, false); } +">=" { LEXER_DEBUG (">="); BIN_OP_RETURN (EXPR_GE, false, false); } +"&" { LEXER_DEBUG ("&"); BIN_OP_RETURN (EXPR_AND, false, false); } +"|" { LEXER_DEBUG ("|"); BIN_OP_RETURN (EXPR_OR, false, false); } +"<" { LEXER_DEBUG ("<"); BIN_OP_RETURN (EXPR_LT, false, false); } +">" { LEXER_DEBUG (">"); BIN_OP_RETURN (EXPR_GT, false, false); } +"+" { LEXER_DEBUG ("+"); BIN_OP_RETURN ('+', false, false); } +"-" { LEXER_DEBUG ("-"); BIN_OP_RETURN ('-', false, false); } +"*" { LEXER_DEBUG ("*"); BIN_OP_RETURN ('*', false, false); } +"/" { LEXER_DEBUG ("/"); BIN_OP_RETURN ('/', false, false); } +"\\" { LEXER_DEBUG ("\\"); BIN_OP_RETURN (LEFTDIV, false, false); } +";" { LEXER_DEBUG (";"); BIN_OP_RETURN (';', true, true); } +"," { LEXER_DEBUG (","); BIN_OP_RETURN (',', true, ! lexer_flags.looking_at_object_index.front ()); } +"^" { LEXER_DEBUG ("^"); BIN_OP_RETURN (POW, false, false); } +"**" { LEXER_DEBUG ("**"); XBIN_OP_RETURN (POW, false, false); } +"=" { LEXER_DEBUG ("="); BIN_OP_RETURN ('=', true, false); } +"&&" { LEXER_DEBUG ("&&"); BIN_OP_RETURN (EXPR_AND_AND, false, false); } +"||" { LEXER_DEBUG ("||"); BIN_OP_RETURN (EXPR_OR_OR, false, false); } +"<<" { LEXER_DEBUG ("<<"); XBIN_OP_RETURN (LSHIFT, false, false); } +">>" { LEXER_DEBUG (">>"); XBIN_OP_RETURN (RSHIFT, false, false); } + +{NOT} { + LEXER_DEBUG ("{NOT}"); + + if (yytext[0] == '~') + BIN_OP_RETURN (EXPR_NOT, false, false); + else + XBIN_OP_RETURN (EXPR_NOT, false, false); + } + +"(" { + LEXER_DEBUG ("("); + + // If we are looking for an object index, then push TRUE for + // looking_at_object_index. Otherwise, just push whatever state + // is current (so that we can pop it off the stack when we find + // the matching close paren). + + lexer_flags.looking_at_object_index.push_front + (lexer_flags.looking_for_object_index); + + lexer_flags.looking_at_indirect_ref = false; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + nesting_level.paren (); + promptflag--; + + TOK_RETURN ('('); + } + +")" { + LEXER_DEBUG (")"); + + nesting_level.remove (); + current_input_column++; + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma + = (nesting_level.is_bracket_or_brace () + && ! lexer_flags.looking_at_anon_fcn_args); + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + if (lexer_flags.looking_at_anon_fcn_args) + lexer_flags.looking_at_anon_fcn_args = false; + + do_comma_insert_check (); + + COUNT_TOK_AND_RETURN (')'); + } + +"." { + LEXER_DEBUG ("."); + + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + TOK_RETURN ('.'); + } + +"+=" { LEXER_DEBUG ("+="); XBIN_OP_RETURN (ADD_EQ, false, false); } +"-=" { LEXER_DEBUG ("-="); XBIN_OP_RETURN (SUB_EQ, false, false); } +"*=" { LEXER_DEBUG ("*="); XBIN_OP_RETURN (MUL_EQ, false, false); } +"/=" { LEXER_DEBUG ("/="); XBIN_OP_RETURN (DIV_EQ, false, false); } +"\\=" { LEXER_DEBUG ("\\="); XBIN_OP_RETURN (LEFTDIV_EQ, false, false); } +".+=" { LEXER_DEBUG (".+="); XBIN_OP_RETURN (ADD_EQ, false, false); } +".-=" { LEXER_DEBUG (".-="); XBIN_OP_RETURN (SUB_EQ, false, false); } +".*=" { LEXER_DEBUG (".*="); XBIN_OP_RETURN (EMUL_EQ, false, false); } +"./=" { LEXER_DEBUG ("./="); XBIN_OP_RETURN (EDIV_EQ, false, false); } +".\\=" { LEXER_DEBUG (".\\="); XBIN_OP_RETURN (ELEFTDIV_EQ, false, false); } +{POW}= { LEXER_DEBUG ("{POW}="); XBIN_OP_RETURN (POW_EQ, false, false); } +{EPOW}= { LEXER_DEBUG ("{EPOW}="); XBIN_OP_RETURN (EPOW_EQ, false, false); } +"&=" { LEXER_DEBUG ("&="); XBIN_OP_RETURN (AND_EQ, false, false); } +"|=" { LEXER_DEBUG ("|="); XBIN_OP_RETURN (OR_EQ, false, false); } +"<<=" { LEXER_DEBUG ("<<="); XBIN_OP_RETURN (LSHIFT_EQ, false, false); } +">>=" { LEXER_DEBUG (">>="); XBIN_OP_RETURN (RSHIFT_EQ, false, false); } + +\{{S}* { + LEXER_DEBUG ("\\{{S}*"); + + nesting_level.brace (); + + lexer_flags.looking_at_object_index.push_front + (lexer_flags.looking_for_object_index); + + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + promptflag--; + eat_whitespace (); + + lexer_flags.braceflag++; + BEGIN (MATRIX_START); + COUNT_TOK_AND_RETURN ('{'); + } + +"}" { + LEXER_DEBUG ("}"); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + nesting_level.remove (); + + TOK_RETURN ('}'); + } + +%{ +// Unrecognized input is a lexical error. +%} + +. { + LEXER_DEBUG ("."); + + xunput (yytext[0], yytext); + + int c = text_yyinput (); + + if (c != EOF) + { + current_input_column++; + + error ("invalid character `%s' (ASCII %d) near line %d, column %d", + undo_string_escape (static_cast (c)), c, + input_line_number, current_input_column); + + return LEXICAL_ERROR; + } + else + TOK_RETURN (END_OF_INPUT); + } + +%% + +// GAG. +// +// If we're reading a matrix and the next character is '[', make sure +// that we insert a comma ahead of it. + +void +do_comma_insert_check (void) +{ + int spc_gobbled = eat_continuation (); + + int c = text_yyinput (); + + xunput (c, yytext); + + if (spc_gobbled) + xunput (' ', yytext); + + lexer_flags.do_comma_insert = (! lexer_flags.looking_at_object_index.front () + && lexer_flags.bracketflag && c == '['); +} + +// Fix things up for errors or interrupts. The parser is never called +// recursively, so it is always safe to reinitialize its state before +// doing any parsing. + +void +reset_parser (void) +{ + // Start off on the right foot. + BEGIN (INITIAL); + + parser_end_of_input = false; + + parser_symtab_context.clear (); + + // We do want a prompt by default. + promptflag = 1; + + // We are not in a block comment. + block_comment_nesting_level = 0; + + // Error may have occurred inside some brackets, braces, or parentheses. + nesting_level.clear (); + + // Clear out the stack of token info used to track line and column + // numbers. + while (! token_stack.empty ()) + { + delete token_stack.top (); + token_stack.pop (); + } + + // Can be reset by defining a function. + if (! (reading_script_file || reading_fcn_file || reading_classdef_file)) + { + current_input_column = 1; + input_line_number = command_editor::current_command_number (); + } + + // Only ask for input from stdin if we are expecting interactive + // input. + + if (! quitting_gracefully + && (interactive || forced_interactive) + && ! (reading_fcn_file + || reading_classdef_file + || reading_script_file + || get_input_from_eval_string + || input_from_startup_file)) + yyrestart (stdin); + + // Clear the buffer for help text. + while (! help_buf.empty ()) + help_buf.pop (); + + // Reset other flags. + lexer_flags.init (); +} + +static void +display_character (char c) +{ + if (isgraph (c)) + std::cerr << c; + else + switch (c) + { + case 0: + std::cerr << "NUL"; + break; + + case 1: + std::cerr << "SOH"; + break; + + case 2: + std::cerr << "STX"; + break; + + case 3: + std::cerr << "ETX"; + break; + + case 4: + std::cerr << "EOT"; + break; + + case 5: + std::cerr << "ENQ"; + break; + + case 6: + std::cerr << "ACK"; + break; + + case 7: + std::cerr << "\\a"; + break; + + case 8: + std::cerr << "\\b"; + break; + + case 9: + std::cerr << "\\t"; + break; + + case 10: + std::cerr << "\\n"; + break; + + case 11: + std::cerr << "\\v"; + break; + + case 12: + std::cerr << "\\f"; + break; + + case 13: + std::cerr << "\\r"; + break; + + case 14: + std::cerr << "SO"; + break; + + case 15: + std::cerr << "SI"; + break; + + case 16: + std::cerr << "DLE"; + break; + + case 17: + std::cerr << "DC1"; + break; + + case 18: + std::cerr << "DC2"; + break; + + case 19: + std::cerr << "DC3"; + break; + + case 20: + std::cerr << "DC4"; + break; + + case 21: + std::cerr << "NAK"; + break; + + case 22: + std::cerr << "SYN"; + break; + + case 23: + std::cerr << "ETB"; + break; + + case 24: + std::cerr << "CAN"; + break; + + case 25: + std::cerr << "EM"; + break; + + case 26: + std::cerr << "SUB"; + break; + + case 27: + std::cerr << "ESC"; + break; + + case 28: + std::cerr << "FS"; + break; + + case 29: + std::cerr << "GS"; + break; + + case 30: + std::cerr << "RS"; + break; + + case 31: + std::cerr << "US"; + break; + + case 32: + std::cerr << "SPACE"; + break; + + case 127: + std::cerr << "DEL"; + break; + } +} + +static int +text_yyinput (void) +{ + int c = yyinput (); + + if (lexer_debug_flag) + { + std::cerr << "I: "; + display_character (c); + std::cerr << std::endl; + } + + // Convert CRLF into just LF and single CR into LF. + + if (c == '\r') + { + c = yyinput (); + + if (lexer_debug_flag) + { + std::cerr << "I: "; + display_character (c); + std::cerr << std::endl; + } + + if (c != '\n') + { + xunput (c, yytext); + c = '\n'; + } + } + + if (c == '\n') + input_line_number++; + + return c; +} + +static void +xunput (char c, char *buf) +{ + if (lexer_debug_flag) + { + std::cerr << "U: "; + display_character (c); + std::cerr << std::endl; + } + + if (c == '\n') + input_line_number--; + + yyunput (c, buf); +} + +// If we read some newlines, we need figure out what column we're +// really looking at. + +static void +fixup_column_count (char *s) +{ + char c; + while ((c = *s++) != '\0') + { + if (c == '\n') + { + input_line_number++; + current_input_column = 1; + } + else + current_input_column++; + } +} + +// Include these so that we don't have to link to libfl.a. + +int +yywrap (void) +{ + return 1; +} + +// Tell us all what the current buffer is. + +YY_BUFFER_STATE +current_buffer (void) +{ + return YY_CURRENT_BUFFER; +} + +// Create a new buffer. + +YY_BUFFER_STATE +create_buffer (FILE *f) +{ + return yy_create_buffer (f, YY_BUF_SIZE); +} + +// Start reading a new buffer. + +void +switch_to_buffer (YY_BUFFER_STATE buf) +{ + yy_switch_to_buffer (buf); +} + +// Delete a buffer. + +void +delete_buffer (YY_BUFFER_STATE buf) +{ + yy_delete_buffer (buf); + + // Prevent invalid yyin from being used by yyrestart. + if (! current_buffer ()) + yyin = 0; +} + +// Delete all buffers from the stack. +void +clear_all_buffers (void) +{ + while (current_buffer ()) + octave_pop_buffer_state (); +} + +void +cleanup_parser (void) +{ + reset_parser (); + + clear_all_buffers (); +} + +// Restore a buffer (for unwind-prot). + +void +restore_input_buffer (void *buf) +{ + switch_to_buffer (static_cast (buf)); +} + +// Delete a buffer (for unwind-prot). + +void +delete_input_buffer (void *buf) +{ + delete_buffer (static_cast (buf)); +} + +static bool +inside_any_object_index (void) +{ + bool retval = false; + + for (std::list::const_iterator i = lexer_flags.looking_at_object_index.begin (); + i != lexer_flags.looking_at_object_index.end (); i++) + { + if (*i) + { + retval = true; + break; + } + } + + return retval; +} + +// Handle keywords. Return -1 if the keyword should be ignored. + +static int +is_keyword_token (const std::string& s) +{ + int l = input_line_number; + int c = current_input_column; + + int len = s.length (); + + const octave_kw *kw = octave_kw_hash::in_word_set (s.c_str (), len); + + if (kw) + { + yylval.tok_val = 0; + + switch (kw->kw_id) + { + case break_kw: + case catch_kw: + case continue_kw: + case else_kw: + case otherwise_kw: + case return_kw: + case unwind_protect_cleanup_kw: + lexer_flags.at_beginning_of_statement = true; + break; + + case static_kw: + if ((reading_fcn_file || reading_script_file + || reading_classdef_file) + && ! curr_fcn_file_full_name.empty ()) + warning_with_id ("Octave:deprecated-keyword", + "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d of file `%s'", + input_line_number, + curr_fcn_file_full_name.c_str ()); + else + warning_with_id ("Octave:deprecated-keyword", + "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d", + input_line_number); + // fall through ... + + case persistent_kw: + break; + + case case_kw: + case elseif_kw: + case global_kw: + case until_kw: + break; + + case end_kw: + if (inside_any_object_index () + || (! reading_classdef_file + && (lexer_flags.defining_func + && ! (lexer_flags.looking_at_return_list + || lexer_flags.parsed_function_name.top ())))) + return 0; + + yylval.tok_val = new token (token::simple_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case end_try_catch_kw: + yylval.tok_val = new token (token::try_catch_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case end_unwind_protect_kw: + yylval.tok_val = new token (token::unwind_protect_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endfor_kw: + yylval.tok_val = new token (token::for_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endfunction_kw: + yylval.tok_val = new token (token::function_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endif_kw: + yylval.tok_val = new token (token::if_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endparfor_kw: + yylval.tok_val = new token (token::parfor_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endswitch_kw: + yylval.tok_val = new token (token::switch_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endwhile_kw: + yylval.tok_val = new token (token::while_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endclassdef_kw: + yylval.tok_val = new token (token::classdef_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endenumeration_kw: + yylval.tok_val = new token (token::enumeration_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endevents_kw: + yylval.tok_val = new token (token::events_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endmethods_kw: + yylval.tok_val = new token (token::methods_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endproperties_kw: + yylval.tok_val = new token (token::properties_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + + case for_kw: + case parfor_kw: + case while_kw: + promptflag--; + lexer_flags.looping++; + break; + + case do_kw: + lexer_flags.at_beginning_of_statement = true; + promptflag--; + lexer_flags.looping++; + break; + + case try_kw: + case unwind_protect_kw: + lexer_flags.at_beginning_of_statement = true; + promptflag--; + break; + + case if_kw: + case switch_kw: + promptflag--; + break; + + case get_kw: + case set_kw: + // 'get' and 'set' are keywords in classdef method + // declarations. + if (! lexer_flags.maybe_classdef_get_set_method) + return 0; + break; + + case enumeration_kw: + case events_kw: + case methods_kw: + case properties_kw: + // 'properties', 'methods' and 'events' are keywords for + // classdef blocks. + if (! lexer_flags.parsing_classdef) + return 0; + // fall through ... + + case classdef_kw: + // 'classdef' is always a keyword. + promptflag--; + break; + + case function_kw: + promptflag--; + + lexer_flags.defining_func++; + lexer_flags.parsed_function_name.push (false); + + if (! (reading_fcn_file || reading_script_file + || reading_classdef_file)) + input_line_number = 1; + break; + + case magic_file_kw: + { + if ((reading_fcn_file || reading_script_file + || reading_classdef_file) + && ! curr_fcn_file_full_name.empty ()) + yylval.tok_val = new token (curr_fcn_file_full_name, l, c); + else + yylval.tok_val = new token ("stdin", l, c); + } + break; + + case magic_line_kw: + yylval.tok_val = new token (static_cast (l), "", l, c); + break; + + default: + panic_impossible (); + } + + if (! yylval.tok_val) + yylval.tok_val = new token (l, c); + + token_stack.push (yylval.tok_val); + + return kw->tok; + } + + return 0; +} + +static bool +is_variable (const std::string& name) +{ + return (symbol_table::is_variable (name) + || (lexer_flags.pending_local_variables.find (name) + != lexer_flags.pending_local_variables.end ())); +} + +static std::string +grab_block_comment (stream_reader& reader, bool& eof) +{ + std::string buf; + + bool at_bol = true; + bool look_for_marker = false; + + bool warned_incompatible = false; + + int c = 0; + + while ((c = reader.getc ()) != EOF) + { + current_input_column++; + + if (look_for_marker) + { + at_bol = false; + look_for_marker = false; + + if (c == '{' || c == '}') + { + std::string tmp_buf (1, static_cast (c)); + + int type = c; + + bool done = false; + + while ((c = reader.getc ()) != EOF && ! done) + { + current_input_column++; + + switch (c) + { + case ' ': + case '\t': + tmp_buf += static_cast (c); + break; + + case '\n': + { + current_input_column = 0; + at_bol = true; + done = true; + + if (type == '{') + { + block_comment_nesting_level++; + promptflag--; + } + else + { + block_comment_nesting_level--; + promptflag++; + + if (block_comment_nesting_level == 0) + { + buf += grab_comment_block (reader, true, eof); + + return buf; + } + } + } + break; + + default: + at_bol = false; + tmp_buf += static_cast (c); + buf += tmp_buf; + done = true; + break; + } + } + } + } + + if (at_bol && (c == '%' || c == '#')) + { + if (c == '#' && ! warned_incompatible) + { + warned_incompatible = true; + maybe_gripe_matlab_incompatible_comment (c); + } + + at_bol = false; + look_for_marker = true; + } + else + { + buf += static_cast (c); + + if (c == '\n') + { + current_input_column = 0; + at_bol = true; + } + } + } + + if (c == EOF) + eof = true; + + return buf; +} + +std::string +grab_comment_block (stream_reader& reader, bool at_bol, + bool& eof) +{ + std::string buf; + + // TRUE means we are at the beginning of a comment block. + bool begin_comment = false; + + // TRUE means we are currently reading a comment block. + bool in_comment = false; + + bool warned_incompatible = false; + + int c = 0; + + while ((c = reader.getc ()) != EOF) + { + current_input_column++; + + if (begin_comment) + { + if (c == '%' || c == '#') + { + at_bol = false; + continue; + } + else if (at_bol && c == '{') + { + std::string tmp_buf (1, static_cast (c)); + + bool done = false; + + while ((c = reader.getc ()) != EOF && ! done) + { + current_input_column++; + + switch (c) + { + case ' ': + case '\t': + tmp_buf += static_cast (c); + break; + + case '\n': + { + current_input_column = 0; + at_bol = true; + done = true; + + block_comment_nesting_level++; + promptflag--; + + buf += grab_block_comment (reader, eof); + + in_comment = false; + + if (eof) + goto done; + } + break; + + default: + at_bol = false; + tmp_buf += static_cast (c); + buf += tmp_buf; + done = true; + break; + } + } + } + else + { + at_bol = false; + begin_comment = false; + } + } + + if (in_comment) + { + buf += static_cast (c); + + if (c == '\n') + { + at_bol = true; + current_input_column = 0; + in_comment = false; + + // FIXME -- bailing out here prevents things like + // + // octave> # comment + // octave> x = 1 + // + // from failing at the command line, while still + // allowing blocks of comments to be grabbed properly + // for function doc strings. But only the first line of + // a mult-line doc string will be picked up for + // functions defined on the command line. We need a + // better way of collecting these comments... + if (! (reading_fcn_file || reading_script_file)) + goto done; + } + } + else + { + switch (c) + { + case ' ': + case '\t': + break; + + case '#': + if (! warned_incompatible) + { + warned_incompatible = true; + maybe_gripe_matlab_incompatible_comment (c); + } + // fall through... + + case '%': + in_comment = true; + begin_comment = true; + break; + + default: + current_input_column--; + reader.ungetc (c); + goto done; + } + } + } + + done: + + if (c == EOF) + eof = true; + + return buf; +} + +class +flex_stream_reader : public stream_reader +{ +public: + flex_stream_reader (char *buf_arg) : stream_reader (), buf (buf_arg) { } + + int getc (void) { return ::text_yyinput (); } + int ungetc (int c) { ::xunput (c, buf); return 0; } + +private: + + // No copying! + + flex_stream_reader (const flex_stream_reader&); + + flex_stream_reader& operator = (const flex_stream_reader&); + + char *buf; +}; + +static int +process_comment (bool start_in_block, bool& eof) +{ + eof = false; + + std::string help_txt; + + if (! help_buf.empty ()) + help_txt = help_buf.top (); + + flex_stream_reader flex_reader (yytext); + + // process_comment is only supposed to be called when we are not + // initially looking at a block comment. + + std::string txt = start_in_block + ? grab_block_comment (flex_reader, eof) + : grab_comment_block (flex_reader, false, eof); + + if (lexer_debug_flag) + std::cerr << "C: " << txt << std::endl; + + if (help_txt.empty () && nesting_level.none ()) + { + if (! help_buf.empty ()) + help_buf.pop (); + + help_buf.push (txt); + } + + octave_comment_buffer::append (txt); + + current_input_column = 1; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.at_beginning_of_statement = true; + + if (YY_START == COMMAND_START) + BEGIN (INITIAL); + + if (nesting_level.none ()) + return '\n'; + else if (nesting_level.is_bracket_or_brace ()) + return ';'; + else + return 0; +} + +// Return 1 if the given character matches any character in the given +// string. + +static bool +match_any (char c, const char *s) +{ + char tmp; + while ((tmp = *s++) != '\0') + { + if (c == tmp) + return true; + } + return false; +} + +// Given information about the spacing surrounding an operator, +// return 1 if it looks like it should be treated as a binary +// operator. For example, +// +// [ 1 + 2 ] or [ 1+ 2] or [ 1+2 ] ==> binary +// +// [ 1 +2 ] ==> unary + +static bool +looks_like_bin_op (bool spc_prev, int next_char) +{ + bool spc_next = (next_char == ' ' || next_char == '\t'); + + return ((spc_prev && spc_next) || ! spc_prev); +} + +// Recognize separators. If the separator is a CRLF pair, it is +// replaced by a single LF. + +static bool +next_token_is_sep_op (void) +{ + bool retval = false; + + int c = text_yyinput (); + + retval = match_any (c, ",;\n]"); + + xunput (c, yytext); + + return retval; +} + +// Try to determine if the next token should be treated as a postfix +// unary operator. This is ugly, but it seems to do the right thing. + +static bool +next_token_is_postfix_unary_op (bool spc_prev) +{ + bool un_op = false; + + int c0 = text_yyinput (); + + if (c0 == '\'' && ! spc_prev) + { + un_op = true; + } + else if (c0 == '.') + { + int c1 = text_yyinput (); + un_op = (c1 == '\''); + xunput (c1, yytext); + } + else if (c0 == '+') + { + int c1 = text_yyinput (); + un_op = (c1 == '+'); + xunput (c1, yytext); + } + else if (c0 == '-') + { + int c1 = text_yyinput (); + un_op = (c1 == '-'); + xunput (c1, yytext); + } + + xunput (c0, yytext); + + return un_op; +} + +// Try to determine if the next token should be treated as a binary +// operator. +// +// This kluge exists because whitespace is not always ignored inside +// the square brackets that are used to create matrix objects (though +// spacing only really matters in the cases that can be interpreted +// either as binary ops or prefix unary ops: currently just +, -). +// +// Note that a line continuation directly following a + or - operator +// (e.g., the characters '[' 'a' ' ' '+' '\' LFD 'b' ']') will be +// parsed as a binary operator. + +static bool +next_token_is_bin_op (bool spc_prev) +{ + bool bin_op = false; + + int c0 = text_yyinput (); + + switch (c0) + { + case '+': + case '-': + { + int c1 = text_yyinput (); + + switch (c1) + { + case '+': + case '-': + // Unary ops, spacing doesn't matter. + break; + + case '=': + // Binary ops, spacing doesn't matter. + bin_op = true; + break; + + default: + // Could be either, spacing matters. + bin_op = looks_like_bin_op (spc_prev, c1); + break; + } + + xunput (c1, yytext); + } + break; + + case ':': + case '/': + case '\\': + case '^': + // Always a binary op (may also include /=, \=, and ^=). + bin_op = true; + break; + + // .+ .- ./ .\ .^ .* .** + case '.': + { + int c1 = text_yyinput (); + + if (match_any (c1, "+-/\\^*")) + // Always a binary op (may also include .+=, .-=, ./=, ...). + bin_op = true; + else if (! isdigit (c1) && c1 != ' ' && c1 != '\t' && c1 != '.') + // A structure element reference is a binary op. + bin_op = true; + + xunput (c1, yytext); + } + break; + + // = == & && | || * ** + case '=': + case '&': + case '|': + case '*': + // Always a binary op (may also include ==, &&, ||, **). + bin_op = true; + break; + + // < <= <> > >= + case '<': + case '>': + // Always a binary op (may also include <=, <>, >=). + bin_op = true; + break; + + // ~= != + case '~': + case '!': + { + int c1 = text_yyinput (); + + // ~ and ! can be unary ops, so require following =. + if (c1 == '=') + bin_op = true; + + xunput (c1, yytext); + } + break; + + default: + break; + } + + xunput (c0, yytext); + + return bin_op; +} + +// Used to delete trailing white space from tokens. + +static std::string +strip_trailing_whitespace (char *s) +{ + std::string retval = s; + + size_t pos = retval.find_first_of (" \t"); + + if (pos != std::string::npos) + retval.resize (pos); + + return retval; +} + +// FIXME -- we need to handle block comments here. + +static void +scan_for_comments (const char *text) +{ + std::string comment_buf; + + bool in_comment = false; + bool beginning_of_comment = false; + + int len = strlen (text); + int i = 0; + + while (i < len) + { + char c = text[i++]; + + switch (c) + { + case '%': + case '#': + if (in_comment) + { + if (! beginning_of_comment) + comment_buf += static_cast (c); + } + else + { + maybe_gripe_matlab_incompatible_comment (c); + in_comment = true; + beginning_of_comment = true; + } + break; + + case '\n': + if (in_comment) + { + comment_buf += static_cast (c); + octave_comment_buffer::append (comment_buf); + comment_buf.resize (0); + in_comment = false; + beginning_of_comment = false; + } + break; + + default: + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + } + break; + } + } + + if (! comment_buf.empty ()) + octave_comment_buffer::append (comment_buf); +} + +// Discard whitespace, including comments and continuations. +// +// Return value is logical OR of the following values: +// +// ATE_NOTHING : no spaces to eat +// ATE_SPACE_OR_TAB : space or tab in input +// ATE_NEWLINE : bare new line in input + +// FIXME -- we need to handle block comments here. + +static yum_yum +eat_whitespace (void) +{ + yum_yum retval = ATE_NOTHING; + + std::string comment_buf; + + bool in_comment = false; + bool beginning_of_comment = false; + + int c = 0; + + while ((c = text_yyinput ()) != EOF) + { + current_input_column++; + + switch (c) + { + case ' ': + case '\t': + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + } + retval |= ATE_SPACE_OR_TAB; + break; + + case '\n': + retval |= ATE_NEWLINE; + if (in_comment) + { + comment_buf += static_cast (c); + octave_comment_buffer::append (comment_buf); + comment_buf.resize (0); + in_comment = false; + beginning_of_comment = false; + } + current_input_column = 0; + break; + + case '#': + case '%': + if (in_comment) + { + if (! beginning_of_comment) + comment_buf += static_cast (c); + } + else + { + maybe_gripe_matlab_incompatible_comment (c); + in_comment = true; + beginning_of_comment = true; + } + break; + + case '.': + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + break; + } + else + { + if (have_ellipsis_continuation ()) + break; + else + goto done; + } + + case '\\': + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + break; + } + else + { + if (have_continuation ()) + break; + else + goto done; + } + + default: + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + break; + } + else + goto done; + } + } + + if (! comment_buf.empty ()) + octave_comment_buffer::append (comment_buf); + + done: + xunput (c, yytext); + current_input_column--; + return retval; +} + +static inline bool +looks_like_hex (const char *s, int len) +{ + return (len > 2 && s[0] == '0' && (s[1] == 'x' || s[1] == 'X')); +} + +static void +handle_number (void) +{ + double value = 0.0; + int nread = 0; + + if (looks_like_hex (yytext, strlen (yytext))) + { + unsigned long ival; + + nread = sscanf (yytext, "%lx", &ival); + + value = static_cast (ival); + } + else + { + char *tmp = strsave (yytext); + + char *idx = strpbrk (tmp, "Dd"); + + if (idx) + *idx = 'e'; + + nread = sscanf (tmp, "%lf", &value); + + delete [] tmp; + } + + // If yytext doesn't contain a valid number, we are in deep doo doo. + + assert (nread == 1); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + yylval.tok_val = new token (value, yytext, input_line_number, + current_input_column); + + token_stack.push (yylval.tok_val); + + current_input_column += yyleng; + + do_comma_insert_check (); +} + +// We have seen a backslash and need to find out if it should be +// treated as a continuation character. If so, this eats it, up to +// and including the new line character. +// +// Match whitespace only, followed by a comment character or newline. +// Once a comment character is found, discard all input until newline. +// If non-whitespace characters are found before comment +// characters, return 0. Otherwise, return 1. + +// FIXME -- we need to handle block comments here. + +static bool +have_continuation (bool trailing_comments_ok) +{ + std::ostringstream buf; + + std::string comment_buf; + + bool in_comment = false; + bool beginning_of_comment = false; + + int c = 0; + + while ((c = text_yyinput ()) != EOF) + { + buf << static_cast (c); + + switch (c) + { + case ' ': + case '\t': + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + } + break; + + case '%': + case '#': + if (trailing_comments_ok) + { + if (in_comment) + { + if (! beginning_of_comment) + comment_buf += static_cast (c); + } + else + { + maybe_gripe_matlab_incompatible_comment (c); + in_comment = true; + beginning_of_comment = true; + } + } + else + goto cleanup; + break; + + case '\n': + if (in_comment) + { + comment_buf += static_cast (c); + octave_comment_buffer::append (comment_buf); + } + current_input_column = 0; + promptflag--; + gripe_matlab_incompatible_continuation (); + return true; + + default: + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + } + else + goto cleanup; + break; + } + } + + xunput (c, yytext); + return false; + +cleanup: + + std::string s = buf.str (); + + int len = s.length (); + while (len--) + xunput (s[len], yytext); + + return false; +} + +// We have seen a `.' and need to see if it is the start of a +// continuation. If so, this eats it, up to and including the new +// line character. + +static bool +have_ellipsis_continuation (bool trailing_comments_ok) +{ + char c1 = text_yyinput (); + if (c1 == '.') + { + char c2 = text_yyinput (); + if (c2 == '.' && have_continuation (trailing_comments_ok)) + return true; + else + { + xunput (c2, yytext); + xunput (c1, yytext); + } + } + else + xunput (c1, yytext); + + return false; +} + +// See if we have a continuation line. If so, eat it and the leading +// whitespace on the next line. +// +// Return value is the same as described for eat_whitespace(). + +static yum_yum +eat_continuation (void) +{ + int retval = ATE_NOTHING; + + int c = text_yyinput (); + + if ((c == '.' && have_ellipsis_continuation ()) + || (c == '\\' && have_continuation ())) + retval = eat_whitespace (); + else + xunput (c, yytext); + + return retval; +} + +static int +handle_string (char delim) +{ + std::ostringstream buf; + + int bos_line = input_line_number; + int bos_col = current_input_column; + + int c; + int escape_pending = 0; + + while ((c = text_yyinput ()) != EOF) + { + current_input_column++; + + if (c == '\\') + { + if (delim == '\'' || escape_pending) + { + buf << static_cast (c); + escape_pending = 0; + } + else + { + if (have_continuation (false)) + escape_pending = 0; + else + { + buf << static_cast (c); + escape_pending = 1; + } + } + continue; + } + else if (c == '.') + { + if (delim == '\'' || ! have_ellipsis_continuation (false)) + buf << static_cast (c); + } + else if (c == '\n') + { + error ("unterminated string constant"); + break; + } + else if (c == delim) + { + if (escape_pending) + buf << static_cast (c); + else + { + c = text_yyinput (); + if (c == delim) + { + buf << static_cast (c); + } + else + { + std::string s; + xunput (c, yytext); + + if (delim == '\'') + s = buf.str (); + else + s = do_string_escapes (buf.str ()); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + + yylval.tok_val = new token (s, bos_line, bos_col); + token_stack.push (yylval.tok_val); + + if (delim == '"') + gripe_matlab_incompatible ("\" used as string delimiter"); + else if (delim == '\'') + gripe_single_quote_string (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + return delim == '"' ? DQ_STRING : SQ_STRING; + } + } + } + else + { + buf << static_cast (c); + } + + escape_pending = 0; + } + + return LEXICAL_ERROR; +} + +static bool +next_token_is_assign_op (void) +{ + bool retval = false; + + int c0 = text_yyinput (); + + switch (c0) + { + case '=': + { + int c1 = text_yyinput (); + xunput (c1, yytext); + if (c1 != '=') + retval = true; + } + break; + + case '+': + case '-': + case '*': + case '/': + case '\\': + case '&': + case '|': + { + int c1 = text_yyinput (); + xunput (c1, yytext); + if (c1 == '=') + retval = true; + } + break; + + case '.': + { + int c1 = text_yyinput (); + if (match_any (c1, "+-*/\\")) + { + int c2 = text_yyinput (); + xunput (c2, yytext); + if (c2 == '=') + retval = true; + } + xunput (c1, yytext); + } + break; + + case '>': + { + int c1 = text_yyinput (); + if (c1 == '>') + { + int c2 = text_yyinput (); + xunput (c2, yytext); + if (c2 == '=') + retval = true; + } + xunput (c1, yytext); + } + break; + + case '<': + { + int c1 = text_yyinput (); + if (c1 == '<') + { + int c2 = text_yyinput (); + xunput (c2, yytext); + if (c2 == '=') + retval = true; + } + xunput (c1, yytext); + } + break; + + default: + break; + } + + xunput (c0, yytext); + + return retval; +} + +static bool +next_token_is_index_op (void) +{ + int c = text_yyinput (); + xunput (c, yytext); + return c == '(' || c == '{'; +} + +static int +handle_close_bracket (bool spc_gobbled, int bracket_type) +{ + int retval = bracket_type; + + if (! nesting_level.none ()) + { + nesting_level.remove (); + + if (bracket_type == ']') + lexer_flags.bracketflag--; + else if (bracket_type == '}') + lexer_flags.braceflag--; + else + panic_impossible (); + } + + if (lexer_flags.bracketflag == 0 && lexer_flags.braceflag == 0) + BEGIN (INITIAL); + + if (bracket_type == ']' + && next_token_is_assign_op () + && ! lexer_flags.looking_at_return_list) + { + retval = CLOSE_BRACE; + } + else if ((lexer_flags.bracketflag || lexer_flags.braceflag) + && lexer_flags.convert_spaces_to_comma + && (nesting_level.is_bracket () + || (nesting_level.is_brace () + && ! lexer_flags.looking_at_object_index.front ()))) + { + bool index_op = next_token_is_index_op (); + + // Don't insert comma if we are looking at something like + // + // [x{i}{j}] or [x{i}(j)] + // + // but do if we are looking at + // + // [x{i} {j}] or [x{i} (j)] + + if (spc_gobbled || ! (bracket_type == '}' && index_op)) + { + bool bin_op = next_token_is_bin_op (spc_gobbled); + + bool postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); + + bool sep_op = next_token_is_sep_op (); + + if (! (postfix_un_op || bin_op || sep_op)) + { + maybe_warn_separator_insert (','); + + xunput (',', yytext); + return retval; + } + } + } + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + + return retval; +} + +static void +maybe_unput_comma (int spc_gobbled) +{ + if (nesting_level.is_bracket () + || (nesting_level.is_brace () + && ! lexer_flags.looking_at_object_index.front ())) + { + int bin_op = next_token_is_bin_op (spc_gobbled); + + int postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); + + int c1 = text_yyinput (); + int c2 = text_yyinput (); + + xunput (c2, yytext); + xunput (c1, yytext); + + int sep_op = next_token_is_sep_op (); + + int dot_op = (c1 == '.' + && (isalpha (c2) || isspace (c2) || c2 == '_')); + + if (postfix_un_op || bin_op || sep_op || dot_op) + return; + + int index_op = (c1 == '(' || c1 == '{'); + + // If there is no space before the indexing op, we don't insert + // a comma. + + if (index_op && ! spc_gobbled) + return; + + maybe_warn_separator_insert (','); + + xunput (',', yytext); + } +} + +static bool +next_token_can_follow_bin_op (void) +{ + std::stack buf; + + int c = EOF; + + // Skip whitespace in current statement on current line + while (true) + { + c = text_yyinput (); + + buf.push (c); + + if (match_any (c, ",;\n") || (c != ' ' && c != '\t')) + break; + } + + // Restore input. + while (! buf.empty ()) + { + xunput (buf.top (), yytext); + + buf.pop (); + } + + return (isalnum (c) || match_any (c, "!\"'(-[_{~")); +} + +static bool +can_be_command (const std::string& tok) +{ + // Don't allow these names to be treated as commands to avoid + // surprises when parsing things like "NaN ^2". + + return ! (tok == "e" + || tok == "I" || tok == "i" + || tok == "J" || tok == "j" + || tok == "Inf" || tok == "inf" + || tok == "NaN" || tok == "nan"); +} + +static bool +looks_like_command_arg (void) +{ + bool retval = true; + + int c0 = text_yyinput (); + + switch (c0) + { + // = == + case '=': + { + int c1 = text_yyinput (); + + if (c1 == '=') + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else + retval = false; + + xunput (c1, yytext); + } + break; + + case '(': + case '{': + // Indexing. + retval = false; + break; + + case '\n': + // EOL. + break; + + case '\'': + case '"': + // Beginning of a character string. + break; + + // + - ++ -- += -= + case '+': + case '-': + { + int c1 = text_yyinput (); + + switch (c1) + { + case '\n': + // EOL. + case '+': + case '-': + // Unary ops, spacing doesn't matter. + break; + + case '\t': + case ' ': + { + if (next_token_can_follow_bin_op ()) + retval = false; + } + break; + + case '=': + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + break; + } + + xunput (c1, yytext); + } + break; + + case ':': + case '/': + case '\\': + case '^': + { + int c1 = text_yyinput (); + + if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + // .+ .- ./ .\ .^ .* .** + case '.': + { + int c1 = text_yyinput (); + + if (match_any (c1, "+-/\\^*")) + { + int c2 = text_yyinput (); + + if (c2 == '=') + { + int c3 = text_yyinput (); + + if (! match_any (c3, ",;\n") && (c3 == ' ' || c3 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c3, yytext); + } + else if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") + && (! isdigit (c1) && c1 != ' ' && c1 != '\t' + && c1 != '.')) + { + // Structure reference. FIXME -- is this a complete check? + + retval = false; + } + + xunput (c1, yytext); + } + break; + + // & && | || * ** + case '&': + case '|': + case '*': + { + int c1 = text_yyinput (); + + if (c1 == c0) + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + // < <= > >= + case '<': + case '>': + { + int c1 = text_yyinput (); + + if (c1 == '=') + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + // ~= != + case '~': + case '!': + { + int c1 = text_yyinput (); + + // ~ and ! can be unary ops, so require following =. + if (c1 == '=') + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + default: + break; + } + + xunput (c0, yytext); + + return retval; +} + +static int +handle_superclass_identifier (void) +{ + eat_continuation (); + + std::string pkg; + std::string meth = strip_trailing_whitespace (yytext); + size_t pos = meth.find ("@"); + std::string cls = meth.substr (pos).substr (1); + meth = meth.substr (0, pos - 1); + + pos = cls.find ("."); + if (pos != std::string::npos) + { + pkg = cls.substr (pos).substr (1); + cls = cls.substr (0, pos - 1); + } + + int kw_token = (is_keyword_token (meth) || is_keyword_token (cls) + || is_keyword_token (pkg)); + if (kw_token) + { + error ("method, class and package names may not be keywords"); + return LEXICAL_ERROR; + } + + yylval.tok_val + = new token (meth.empty () ? 0 : &(symbol_table::insert (meth)), + cls.empty () ? 0 : &(symbol_table::insert (cls)), + pkg.empty () ? 0 : &(symbol_table::insert (pkg)), + input_line_number, current_input_column); + token_stack.push (yylval.tok_val); + + lexer_flags.convert_spaces_to_comma = true; + current_input_column += yyleng; + + return SUPERCLASSREF; +} + +static int +handle_meta_identifier (void) +{ + eat_continuation (); + + std::string pkg; + std::string cls = strip_trailing_whitespace (yytext).substr (1); + size_t pos = cls.find ("."); + + if (pos != std::string::npos) + { + pkg = cls.substr (pos).substr (1); + cls = cls.substr (0, pos - 1); + } + + int kw_token = is_keyword_token (cls) || is_keyword_token (pkg); + if (kw_token) + { + error ("class and package names may not be keywords"); + return LEXICAL_ERROR; + } + + yylval.tok_val + = new token (cls.empty () ? 0 : &(symbol_table::insert (cls)), + pkg.empty () ? 0 : &(symbol_table::insert (pkg)), + input_line_number, current_input_column); + + token_stack.push (yylval.tok_val); + + lexer_flags.convert_spaces_to_comma = true; + current_input_column += yyleng; + + return METAQUERY; +} + +// Figure out exactly what kind of token to return when we have seen +// an identifier. Handles keywords. Return -1 if the identifier +// should be ignored. + +static int +handle_identifier (void) +{ + bool at_bos = lexer_flags.at_beginning_of_statement; + + std::string tok = strip_trailing_whitespace (yytext); + + int c = yytext[yyleng-1]; + + int cont_is_spc = eat_continuation (); + + int spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); + + // If we are expecting a structure element, avoid recognizing + // keywords and other special names and return STRUCT_ELT, which is + // a string that is also a valid identifier. But first, we have to + // decide whether to insert a comma. + + if (lexer_flags.looking_at_indirect_ref) + { + do_comma_insert_check (); + + maybe_unput_comma (spc_gobbled); + + yylval.tok_val = new token (tok, input_line_number, + current_input_column); + + token_stack.push (yylval.tok_val); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = true; + + current_input_column += yyleng; + + return STRUCT_ELT; + } + + lexer_flags.at_beginning_of_statement = false; + + // The is_keyword_token may reset + // lexer_flags.at_beginning_of_statement. For example, if it sees + // an else token, then the next token is at the beginning of a + // statement. + + int kw_token = is_keyword_token (tok); + + // If we found a keyword token, then the beginning_of_statement flag + // is already set. Otherwise, we won't be at the beginning of a + // statement. + + if (lexer_flags.looking_at_function_handle) + { + if (kw_token) + { + error ("function handles may not refer to keywords"); + + return LEXICAL_ERROR; + } + else + { + yylval.tok_val = new token (tok, input_line_number, + current_input_column); + + token_stack.push (yylval.tok_val); + + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = true; + + return FCN_HANDLE; + } + } + + // If we have a regular keyword, return it. + // Keywords can be followed by identifiers. + + if (kw_token) + { + if (kw_token >= 0) + { + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + } + + return kw_token; + } + + // See if we have a plot keyword (title, using, with, or clear). + + int c1 = text_yyinput (); + + bool next_tok_is_eq = false; + if (c1 == '=') + { + int c2 = text_yyinput (); + xunput (c2, yytext); + + if (c2 != '=') + next_tok_is_eq = true; + } + + xunput (c1, yytext); + + // Kluge alert. + // + // If we are looking at a text style function, set up to gobble its + // arguments. + // + // If the following token is `=', or if we are parsing a function + // return list or function parameter list, or if we are looking at + // something like [ab,cd] = foo (), force the symbol to be inserted + // as a variable in the current symbol table. + + if (! is_variable (tok)) + { + if (at_bos && spc_gobbled && can_be_command (tok) + && looks_like_command_arg ()) + { + BEGIN (COMMAND_START); + } + else if (next_tok_is_eq + || lexer_flags.looking_at_decl_list + || lexer_flags.looking_at_return_list + || (lexer_flags.looking_at_parameter_list + && ! lexer_flags.looking_at_initializer_expression)) + { + symbol_table::force_variable (tok); + } + else if (lexer_flags.looking_at_matrix_or_assign_lhs) + { + lexer_flags.pending_local_variables.insert (tok); + } + } + + // Find the token in the symbol table. Beware the magic + // transformation of the end keyword... + + if (tok == "end") + tok = "__end__"; + + yylval.tok_val = new token (&(symbol_table::insert (tok)), + input_line_number, current_input_column); + + token_stack.push (yylval.tok_val); + + // After seeing an identifer, it is ok to convert spaces to a comma + // (if needed). + + lexer_flags.convert_spaces_to_comma = true; + + if (! (next_tok_is_eq || YY_START == COMMAND_START)) + { + lexer_flags.quote_is_transpose = true; + + do_comma_insert_check (); + + maybe_unput_comma (spc_gobbled); + } + + current_input_column += yyleng; + + if (tok != "__end__") + lexer_flags.looking_for_object_index = true; + + return NAME; +} + +void +lexical_feedback::init (void) +{ + // Not initially defining a matrix list. + bracketflag = 0; + + // Not initially defining a cell array list. + braceflag = 0; + + // Not initially inside a loop or if statement. + looping = 0; + + // Not initially defining a function. + defining_func = 0; + + // Not parsing an object index. + while (! parsed_function_name.empty ()) + parsed_function_name.pop (); + + parsing_class_method = false; + + // Not initially defining a class with classdef. + maybe_classdef_get_set_method = false; + parsing_classdef = false; + + // Not initiallly looking at a function handle. + looking_at_function_handle = 0; + + // Not initiallly looking at an anonymous function argument list. + looking_at_anon_fcn_args = 0; + + // Not parsing a function return, parameter, or declaration list. + looking_at_return_list = false; + looking_at_parameter_list = false; + looking_at_decl_list = false; + + // Not looking at an argument list initializer expression. + looking_at_initializer_expression = false; + + // Not parsing a matrix or the left hand side of multi-value + // assignment statement. + looking_at_matrix_or_assign_lhs = false; + + // Not parsing an object index. + while (! looking_at_object_index.empty ()) + looking_at_object_index.pop_front (); + + looking_at_object_index.push_front (false); + + // Object index not possible until we've seen something. + looking_for_object_index = false; + + // Yes, we are at the beginning of a statement. + at_beginning_of_statement = true; + + // No need to do comma insert or convert spaces to comma at + // beginning of input. + convert_spaces_to_comma = true; + do_comma_insert = false; + + // Not initially looking at indirect references. + looking_at_indirect_ref = false; + + // Quote marks strings intially. + quote_is_transpose = false; + + // Set of identifiers that might be local variable names is empty. + pending_local_variables.clear (); +} + +bool +is_keyword (const std::string& s) +{ + // Parsing function names like "set.property_name" inside + // classdef-style class definitions is simplified by handling the + // "set" and "get" portions of the names using the same mechanism as + // is used for keywords. However, they are not really keywords in + // the language, so omit them from the list of possible keywords. + + return (octave_kw_hash::in_word_set (s.c_str (), s.length ()) != 0 + && ! (s == "set" || s == "get")); +} + +DEFUN (iskeyword, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} iskeyword ()\n\ +@deftypefnx {Built-in Function} {} iskeyword (@var{name})\n\ +Return true if @var{name} is an Octave keyword. If @var{name}\n\ +is omitted, return a list of keywords.\n\ +@seealso{isvarname, exist}\n\ +@end deftypefn") +{ + octave_value retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("iskeyword"); + + if (error_state) + return retval; + + if (argc == 1) + { + // Neither set and get are keywords. See the note in the + // is_keyword function for additional details. + + string_vector lst (TOTAL_KEYWORDS); + + int j = 0; + + for (int i = 0; i < TOTAL_KEYWORDS; i++) + { + std::string tmp = wordlist[i].name; + + if (! (tmp == "set" || tmp == "get")) + lst[j++] = tmp; + } + + lst.resize (j); + + retval = Cell (lst.sort ()); + } + else if (argc == 2) + { + retval = is_keyword (argv[1]); + } + else + print_usage (); + + return retval; +} + +/* + +%!assert (iskeyword ("for")) +%!assert (iskeyword ("fort"), false) +%!assert (iskeyword ("fft"), false) + +*/ + +void +prep_lexer_for_script_file (void) +{ + BEGIN (SCRIPT_FILE_BEGIN); +} + +void +prep_lexer_for_function_file (void) +{ + BEGIN (FUNCTION_FILE_BEGIN); +} + +static void +maybe_warn_separator_insert (char sep) +{ + std::string nm = curr_fcn_file_full_name; + + if (nm.empty ()) + warning_with_id ("Octave:separator-insert", + "potential auto-insertion of `%c' near line %d", + sep, input_line_number); + else + warning_with_id ("Octave:separator-insert", + "potential auto-insertion of `%c' near line %d of file %s", + sep, input_line_number, nm.c_str ()); +} + +static void +gripe_single_quote_string (void) +{ + std::string nm = curr_fcn_file_full_name; + + if (nm.empty ()) + warning_with_id ("Octave:single-quote-string", + "single quote delimited string near line %d", + input_line_number); + else + warning_with_id ("Octave:single-quote-string", + "single quote delimited string near line %d of file %s", + input_line_number, nm.c_str ()); +} + +static void +gripe_matlab_incompatible (const std::string& msg) +{ + std::string nm = curr_fcn_file_full_name; + + if (nm.empty ()) + warning_with_id ("Octave:matlab-incompatible", + "potential Matlab compatibility problem: %s", + msg.c_str ()); + else + warning_with_id ("Octave:matlab-incompatible", + "potential Matlab compatibility problem: %s near line %d offile %s", + msg.c_str (), input_line_number, nm.c_str ()); +} + +static void +maybe_gripe_matlab_incompatible_comment (char c) +{ + if (c == '#') + gripe_matlab_incompatible ("# used as comment character"); +} + +static void +gripe_matlab_incompatible_continuation (void) +{ + gripe_matlab_incompatible ("\\ used as line continuation marker"); +} + +static void +gripe_matlab_incompatible_operator (const std::string& op) +{ + std::string t = op; + int n = t.length (); + if (t[n-1] == '\n') + t.resize (n-1); + gripe_matlab_incompatible (t + " used as operator"); +} + +static void +display_token (int tok) +{ + switch (tok) + { + case '=': std::cerr << "'='\n"; break; + case ':': std::cerr << "':'\n"; break; + case '-': std::cerr << "'-'\n"; break; + case '+': std::cerr << "'+'\n"; break; + case '*': std::cerr << "'*'\n"; break; + case '/': std::cerr << "'/'\n"; break; + case ADD_EQ: std::cerr << "ADD_EQ\n"; break; + case SUB_EQ: std::cerr << "SUB_EQ\n"; break; + case MUL_EQ: std::cerr << "MUL_EQ\n"; break; + case DIV_EQ: std::cerr << "DIV_EQ\n"; break; + case LEFTDIV_EQ: std::cerr << "LEFTDIV_EQ\n"; break; + case POW_EQ: std::cerr << "POW_EQ\n"; break; + case EMUL_EQ: std::cerr << "EMUL_EQ\n"; break; + case EDIV_EQ: std::cerr << "EDIV_EQ\n"; break; + case ELEFTDIV_EQ: std::cerr << "ELEFTDIV_EQ\n"; break; + case EPOW_EQ: std::cerr << "EPOW_EQ\n"; break; + case AND_EQ: std::cerr << "AND_EQ\n"; break; + case OR_EQ: std::cerr << "OR_EQ\n"; break; + case LSHIFT_EQ: std::cerr << "LSHIFT_EQ\n"; break; + case RSHIFT_EQ: std::cerr << "RSHIFT_EQ\n"; break; + case LSHIFT: std::cerr << "LSHIFT\n"; break; + case RSHIFT: std::cerr << "RSHIFT\n"; break; + case EXPR_AND_AND: std::cerr << "EXPR_AND_AND\n"; break; + case EXPR_OR_OR: std::cerr << "EXPR_OR_OR\n"; break; + case EXPR_AND: std::cerr << "EXPR_AND\n"; break; + case EXPR_OR: std::cerr << "EXPR_OR\n"; break; + case EXPR_NOT: std::cerr << "EXPR_NOT\n"; break; + case EXPR_LT: std::cerr << "EXPR_LT\n"; break; + case EXPR_LE: std::cerr << "EXPR_LE\n"; break; + case EXPR_EQ: std::cerr << "EXPR_EQ\n"; break; + case EXPR_NE: std::cerr << "EXPR_NE\n"; break; + case EXPR_GE: std::cerr << "EXPR_GE\n"; break; + case EXPR_GT: std::cerr << "EXPR_GT\n"; break; + case LEFTDIV: std::cerr << "LEFTDIV\n"; break; + case EMUL: std::cerr << "EMUL\n"; break; + case EDIV: std::cerr << "EDIV\n"; break; + case ELEFTDIV: std::cerr << "ELEFTDIV\n"; break; + case EPLUS: std::cerr << "EPLUS\n"; break; + case EMINUS: std::cerr << "EMINUS\n"; break; + case QUOTE: std::cerr << "QUOTE\n"; break; + case TRANSPOSE: std::cerr << "TRANSPOSE\n"; break; + case PLUS_PLUS: std::cerr << "PLUS_PLUS\n"; break; + case MINUS_MINUS: std::cerr << "MINUS_MINUS\n"; break; + case POW: std::cerr << "POW\n"; break; + case EPOW: std::cerr << "EPOW\n"; break; + + case NUM: + case IMAG_NUM: + std::cerr << (tok == NUM ? "NUM" : "IMAG_NUM") + << " [" << yylval.tok_val->number () << "]\n"; + break; + + case STRUCT_ELT: + std::cerr << "STRUCT_ELT [" << yylval.tok_val->text () << "]\n"; break; + + case NAME: + { + symbol_table::symbol_record *sr = yylval.tok_val->sym_rec (); + std::cerr << "NAME"; + if (sr) + std::cerr << " [" << sr->name () << "]"; + std::cerr << "\n"; + } + break; + + case END: std::cerr << "END\n"; break; + + case DQ_STRING: + case SQ_STRING: + std::cerr << (tok == DQ_STRING ? "DQ_STRING" : "SQ_STRING") + << " [" << yylval.tok_val->text () << "]\n"; + break; + + case FOR: std::cerr << "FOR\n"; break; + case WHILE: std::cerr << "WHILE\n"; break; + case DO: std::cerr << "DO\n"; break; + case UNTIL: std::cerr << "UNTIL\n"; break; + case IF: std::cerr << "IF\n"; break; + case ELSEIF: std::cerr << "ELSEIF\n"; break; + case ELSE: std::cerr << "ELSE\n"; break; + case SWITCH: std::cerr << "SWITCH\n"; break; + case CASE: std::cerr << "CASE\n"; break; + case OTHERWISE: std::cerr << "OTHERWISE\n"; break; + case BREAK: std::cerr << "BREAK\n"; break; + case CONTINUE: std::cerr << "CONTINUE\n"; break; + case FUNC_RET: std::cerr << "FUNC_RET\n"; break; + case UNWIND: std::cerr << "UNWIND\n"; break; + case CLEANUP: std::cerr << "CLEANUP\n"; break; + case TRY: std::cerr << "TRY\n"; break; + case CATCH: std::cerr << "CATCH\n"; break; + case GLOBAL: std::cerr << "GLOBAL\n"; break; + case PERSISTENT: std::cerr << "PERSISTENT\n"; break; + case FCN_HANDLE: std::cerr << "FCN_HANDLE\n"; break; + case END_OF_INPUT: std::cerr << "END_OF_INPUT\n\n"; break; + case LEXICAL_ERROR: std::cerr << "LEXICAL_ERROR\n\n"; break; + case FCN: std::cerr << "FCN\n"; break; + case CLOSE_BRACE: std::cerr << "CLOSE_BRACE\n"; break; + case SCRIPT_FILE: std::cerr << "SCRIPT_FILE\n"; break; + case FUNCTION_FILE: std::cerr << "FUNCTION_FILE\n"; break; + case SUPERCLASSREF: std::cerr << "SUPERCLASSREF\n"; break; + case METAQUERY: std::cerr << "METAQUERY\n"; break; + case GET: std::cerr << "GET\n"; break; + case SET: std::cerr << "SET\n"; break; + case PROPERTIES: std::cerr << "PROPERTIES\n"; break; + case METHODS: std::cerr << "METHODS\n"; break; + case EVENTS: std::cerr << "EVENTS\n"; break; + case CLASSDEF: std::cerr << "CLASSDEF\n"; break; + case '\n': std::cerr << "\\n\n"; break; + case '\r': std::cerr << "\\r\n"; break; + case '\t': std::cerr << "TAB\n"; break; + default: + { + if (tok < 256) + std::cerr << static_cast (tok) << "\n"; + else + std::cerr << "UNKNOWN(" << tok << ")\n"; + } + break; + } +} + +static void +display_state (void) +{ + std::cerr << "S: "; + + switch (YY_START) + { + case INITIAL: + std::cerr << "INITIAL" << std::endl; + break; + + case COMMAND_START: + std::cerr << "COMMAND_START" << std::endl; + break; + + case MATRIX_START: + std::cerr << "MATRIX_START" << std::endl; + break; + + case SCRIPT_FILE_BEGIN: + std::cerr << "SCRIPT_FILE_BEGIN" << std::endl; + break; + + case FUNCTION_FILE_BEGIN: + std::cerr << "FUNCTION_FILE_BEGIN" << std::endl; + break; + + default: + std::cerr << "UNKNOWN START STATE!" << std::endl; + break; + } +} + +static void +lexer_debug (const char *pattern, const char *text) +{ + std::cerr << std::endl; + + display_state (); + + std::cerr << "P: " << pattern << std::endl; + std::cerr << "T: " << text << std::endl; +} + +DEFUN (__display_tokens__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __display_tokens__ ()\n\ +Query or set the internal variable that determines whether Octave's\n\ +lexer displays tokens as they are read.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (display_tokens); +} + +DEFUN (__token_count__, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __token_count__ ()\n\ +Number of language tokens processed since Octave startup.\n\ +@end deftypefn") +{ + return octave_value (Vtoken_count); +} + +DEFUN (__lexer_debug_flag__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{old_val} =} __lexer_debug_flag__ (@var{new_val}))\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + retval = set_internal_variable (lexer_debug_flag, args, nargout, + "__lexer_debug_flag__"); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/module.mk --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/module.mk Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,75 @@ +EXTRA_DIST += \ + parse-tree/module.mk + +PARSER_INCLUDES = \ + parse-tree/lex.h \ + parse-tree/parse.h \ + parse-tree/parse-private.h + +PARSER_SRC = \ + parse-tree/lex.ll \ + parse-tree/oct-parse.yy + +lex.lo lex.o oct-parse.lo oct-parse.o: \ + AM_CXXFLAGS := $(filter-out -Wold-style-cast, $(AM_CXXFLAGS)) + +PT_INCLUDES = \ + parse-tree/pt-all.h \ + parse-tree/pt-arg-list.h \ + parse-tree/pt-assign.h \ + parse-tree/pt-binop.h \ + parse-tree/pt-bp.h \ + parse-tree/pt-cbinop.h \ + parse-tree/pt-cell.h \ + parse-tree/pt-check.h \ + parse-tree/pt-cmd.h \ + parse-tree/pt-colon.h \ + parse-tree/pt-const.h \ + parse-tree/pt-decl.h \ + parse-tree/pt-eval.h \ + parse-tree/pt-except.h \ + parse-tree/pt-exp.h \ + parse-tree/pt-fcn-handle.h \ + parse-tree/pt-id.h \ + parse-tree/pt-idx.h \ + parse-tree/pt-jump.h \ + parse-tree/pt-loop.h \ + parse-tree/pt-mat.h \ + parse-tree/pt-misc.h \ + parse-tree/pt-pr-code.h \ + parse-tree/pt-select.h \ + parse-tree/pt-stmt.h \ + parse-tree/pt-unop.h \ + parse-tree/pt-walk.h \ + parse-tree/pt.h \ + $(PARSER_INCLUDES) + +PARSE_TREE_SRC = \ + parse-tree/pt-arg-list.cc \ + parse-tree/pt-assign.cc \ + parse-tree/pt-binop.cc \ + parse-tree/pt-bp.cc \ + parse-tree/pt-cbinop.cc \ + parse-tree/pt-cell.cc \ + parse-tree/pt-check.cc \ + parse-tree/pt-cmd.cc \ + parse-tree/pt-colon.cc \ + parse-tree/pt-const.cc \ + parse-tree/pt-decl.cc \ + parse-tree/pt-eval.cc \ + parse-tree/pt-except.cc \ + parse-tree/pt-exp.cc \ + parse-tree/pt-fcn-handle.cc \ + parse-tree/pt-id.cc \ + parse-tree/pt-idx.cc \ + parse-tree/pt-jump.cc \ + parse-tree/pt-loop.cc \ + parse-tree/pt-mat.cc \ + parse-tree/pt-misc.cc \ + parse-tree/pt-pr-code.cc \ + parse-tree/pt-select.cc \ + parse-tree/pt-stmt.cc \ + parse-tree/pt-unop.cc \ + parse-tree/pt.cc \ + $(PARSER_SRC) + diff -r d02b229ce693 -r a132d206a36a src/parse-tree/oct-parse.yy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/oct-parse.yy Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,4734 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009 David Grundberg +Copyright (C) 2009-2010 VZLU Prague + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Parser for Octave. + +// C decarations. + +%{ +#define YYDEBUG 1 + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include + +#include "Cell.h" +#include "Matrix.h" +#include "cmd-edit.h" +#include "cmd-hist.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" + +#include "comment-list.h" +#include "defaults.h" +#include "defun.h" +#include "dirfns.h" +#include "dynamic-ld.h" +#include "error.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "oct-hist.h" +#include "oct-map.h" +#include "ov-fcn-handle.h" +#include "ov-usr-fcn.h" +#include "ov-null-mat.h" +#include "toplev.h" +#include "pager.h" +#include "parse.h" +#include "parse-private.h" +#include "pt-all.h" +#include "pt-eval.h" +#include "symtab.h" +#include "token.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +#if defined (GNULIB_NAMESPACE) +// Calls to the following functions appear in the generated output from +// Bison without the namespace tag. Redefine them so we will use them +// via the gnulib namespace. +#define fclose GNULIB_NAMESPACE::fclose +#define fprintf GNULIB_NAMESPACE::fprintf +#define malloc GNULIB_NAMESPACE::malloc +#endif + +// The current input line number. +int input_line_number = 1; + +// The column of the current token. +int current_input_column = 1; + +// Buffer for help text snagged from function files. +std::stack help_buf; + +// Buffer for comments appearing before a function statement. +static std::string fcn_comment_header; + +// TRUE means we are using readline. +// (--no-line-editing) +bool line_editing = true; + +// TRUE means we printed messages about reading startup files. +bool reading_startup_message_printed = false; + +// TRUE means input is coming from startup file. +bool input_from_startup_file = false; + +// = 0 currently outside any function. +// = 1 inside the primary function or a subfunction. +// > 1 means we are looking at a function definition that seems to be +// inside a function. Note that the function still might not be a +// nested function. +static int current_function_depth = 0; + +// A stack holding the nested function scopes being parsed. +// We don't use std::stack, because we want the clear method. Also, we +// must access one from the top +static std::vector function_scopes; + +// Maximum function depth detected. Just here to determine whether +// we have nested functions or just implicitly ended subfunctions. +static int max_function_depth = 0; + +// FALSE if we are still at the primary function. Subfunctions can +// only be declared inside function files. +static int parsing_subfunctions = false; + +// Have we found an explicit end to a function? +static bool endfunction_found = false; + +// Keep track of symbol table information when parsing functions. +symtab_context parser_symtab_context; + +// Name of the current class when we are parsing class methods or +// constructors. +std::string current_class_name; + +// TRUE means we are in the process of autoloading a function. +static bool autoloading = false; + +// TRUE means the current function file was found in a relative path +// element. +static bool fcn_file_from_relative_lookup = false; + +// Pointer to the primary user function or user script function. +static octave_function *primary_fcn_ptr = 0; + +// Scope where we install all subfunctions and nested functions. Only +// used while reading function files. +static symbol_table::scope_id primary_fcn_scope; + +// List of autoloads (function -> file mapping). +static std::map autoload_map; + +// Forward declarations for some functions defined at the bottom of +// the file. + +// Generic error messages. +static void +yyerror (const char *s); + +// Error mesages for mismatched end tokens. +static void +end_error (const char *type, token::end_tok_type ettype, int l, int c); + +// Check to see that end tokens are properly matched. +static bool +end_token_ok (token *tok, token::end_tok_type expected); + +// Maybe print a warning if an assignment expression is used as the +// test in a logical expression. +static void +maybe_warn_assign_as_truth_value (tree_expression *expr); + +// Maybe print a warning about switch labels that aren't constants. +static void +maybe_warn_variable_switch_label (tree_expression *expr); + +// Finish building a range. +static tree_expression * +finish_colon_expression (tree_colon_expression *e); + +// Build a constant. +static tree_constant * +make_constant (int op, token *tok_val); + +// Build a function handle. +static tree_fcn_handle * +make_fcn_handle (token *tok_val); + +// Build an anonymous function handle. +static tree_anon_fcn_handle * +make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt); + +// Build a binary expression. +static tree_expression * +make_binary_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2); + +// Build a boolean expression. +static tree_expression * +make_boolean_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2); + +// Build a prefix expression. +static tree_expression * +make_prefix_op (int op, tree_expression *op1, token *tok_val); + +// Build a postfix expression. +static tree_expression * +make_postfix_op (int op, tree_expression *op1, token *tok_val); + +// Build an unwind-protect command. +static tree_command * +make_unwind_command (token *unwind_tok, tree_statement_list *body, + tree_statement_list *cleanup, token *end_tok, + octave_comment_list *lc, octave_comment_list *mc); + +// Build a try-catch command. +static tree_command * +make_try_command (token *try_tok, tree_statement_list *body, + tree_statement_list *cleanup, token *end_tok, + octave_comment_list *lc, octave_comment_list *mc); + +// Build a while command. +static tree_command * +make_while_command (token *while_tok, tree_expression *expr, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc); + +// Build a do-until command. +static tree_command * +make_do_until_command (token *until_tok, tree_statement_list *body, + tree_expression *expr, octave_comment_list *lc); + +// Build a for command. +static tree_command * +make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, + tree_expression *expr, tree_expression *maxproc, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc); + +// Build a break command. +static tree_command * +make_break_command (token *break_tok); + +// Build a continue command. +static tree_command * +make_continue_command (token *continue_tok); + +// Build a return command. +static tree_command * +make_return_command (token *return_tok); + +// Start an if command. +static tree_if_command_list * +start_if_command (tree_expression *expr, tree_statement_list *list); + +// Finish an if command. +static tree_if_command * +finish_if_command (token *if_tok, tree_if_command_list *list, + token *end_tok, octave_comment_list *lc); + +// Build an elseif clause. +static tree_if_clause * +make_elseif_clause (token *elseif_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc); + +// Finish a switch command. +static tree_switch_command * +finish_switch_command (token *switch_tok, tree_expression *expr, + tree_switch_case_list *list, token *end_tok, + octave_comment_list *lc); + +// Build a switch case. +static tree_switch_case * +make_switch_case (token *case_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc); + +// Build an assignment to a variable. +static tree_expression * +make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, + tree_expression *rhs); + +// Define a script. +static void +make_script (tree_statement_list *cmds, tree_statement *end_script); + +// Begin defining a function. +static octave_user_function * +start_function (tree_parameter_list *param_list, tree_statement_list *body, + tree_statement *end_function); + +// Create a no-op statement for end_function. +static tree_statement * +make_end (const std::string& type, int l, int c); + +// Do most of the work for defining a function. +static octave_user_function * +frob_function (const std::string& fname, octave_user_function *fcn); + +// Finish defining a function. +static tree_function_def * +finish_function (tree_parameter_list *ret_list, + octave_user_function *fcn, octave_comment_list *lc); + +// Reset state after parsing function. +static void +recover_from_parsing_function (void); + +// Make an index expression. +static tree_index_expression * +make_index_expression (tree_expression *expr, + tree_argument_list *args, char type); + +// Make an indirect reference expression. +static tree_index_expression * +make_indirect_ref (tree_expression *expr, const std::string&); + +// Make an indirect reference expression with dynamic field name. +static tree_index_expression * +make_indirect_ref (tree_expression *expr, tree_expression *field); + +// Make a declaration command. +static tree_decl_command * +make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst); + +// Validate argument list forming a matrix or cell row. +static tree_argument_list * +validate_matrix_row (tree_argument_list *row); + +// Finish building a matrix list. +static tree_expression * +finish_matrix (tree_matrix *m); + +// Finish building a cell list. +static tree_expression * +finish_cell (tree_cell *c); + +// Maybe print a warning. Duh. +static void +maybe_warn_missing_semi (tree_statement_list *); + +// Set the print flag for a statement based on the separator type. +static tree_statement_list * +set_stmt_print_flag (tree_statement_list *, char, bool); + +// Create a statement list. +static tree_statement_list *make_statement_list (tree_statement *stmt); + +// Append a statement to an existing statement list. +static tree_statement_list * +append_statement_list (tree_statement_list *list, char sep, + tree_statement *stmt, bool warn_missing_semi); + +// Finish building a statement. +template +static tree_statement * +make_statement (T *arg) +{ + octave_comment_list *comment = octave_comment_buffer::get_comment (); + + return new tree_statement (arg, comment); +} + +#define ABORT_PARSE \ + do \ + { \ + global_command = 0; \ + yyerrok; \ + if (! parser_symtab_context.empty ()) \ + parser_symtab_context.pop (); \ + if ((interactive || forced_interactive) \ + && ! get_input_from_eval_string) \ + YYACCEPT; \ + else \ + YYABORT; \ + } \ + while (0) + +%} + +// Bison declarations. + +// Don't add spaces around the = here; it causes some versions of +// bison to fail to properly recognize the directive. + +%name-prefix="octave_" + +%union +{ + // The type of the basic tokens returned by the lexer. + token *tok_val; + + // Comment strings that we need to deal with mid-rule. + octave_comment_list *comment_type; + + // Types for the nonterminals we generate. + char sep_type; + tree *tree_type; + tree_matrix *tree_matrix_type; + tree_cell *tree_cell_type; + tree_expression *tree_expression_type; + tree_constant *tree_constant_type; + tree_fcn_handle *tree_fcn_handle_type; + tree_anon_fcn_handle *tree_anon_fcn_handle_type; + tree_identifier *tree_identifier_type; + tree_index_expression *tree_index_expression_type; + tree_colon_expression *tree_colon_expression_type; + tree_argument_list *tree_argument_list_type; + tree_parameter_list *tree_parameter_list_type; + tree_command *tree_command_type; + tree_if_command *tree_if_command_type; + tree_if_clause *tree_if_clause_type; + tree_if_command_list *tree_if_command_list_type; + tree_switch_command *tree_switch_command_type; + tree_switch_case *tree_switch_case_type; + tree_switch_case_list *tree_switch_case_list_type; + tree_decl_elt *tree_decl_elt_type; + tree_decl_init_list *tree_decl_init_list_type; + tree_decl_command *tree_decl_command_type; + tree_statement *tree_statement_type; + tree_statement_list *tree_statement_list_type; + octave_user_function *octave_user_function_type; + void *dummy_type; +} + +// Tokens with line and column information. +%token '=' ':' '-' '+' '*' '/' +%token ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ +%token EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ AND_EQ OR_EQ +%token LSHIFT_EQ RSHIFT_EQ LSHIFT RSHIFT +%token EXPR_AND_AND EXPR_OR_OR +%token EXPR_AND EXPR_OR EXPR_NOT +%token EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT +%token LEFTDIV EMUL EDIV ELEFTDIV EPLUS EMINUS +%token QUOTE TRANSPOSE +%token PLUS_PLUS MINUS_MINUS POW EPOW +%token NUM IMAG_NUM +%token STRUCT_ELT +%token NAME +%token END +%token DQ_STRING SQ_STRING +%token FOR PARFOR WHILE DO UNTIL +%token IF ELSEIF ELSE +%token SWITCH CASE OTHERWISE +%token BREAK CONTINUE FUNC_RET +%token UNWIND CLEANUP +%token TRY CATCH +%token GLOBAL PERSISTENT +%token FCN_HANDLE +%token PROPERTIES METHODS EVENTS ENUMERATION +%token METAQUERY +%token SUPERCLASSREF +%token GET SET + +// Other tokens. +%token END_OF_INPUT LEXICAL_ERROR +%token FCN SCRIPT_FILE FUNCTION_FILE CLASSDEF +// %token VARARGIN VARARGOUT +%token CLOSE_BRACE + +// Nonterminals we construct. +%type stash_comment function_beg classdef_beg +%type properties_beg methods_beg events_beg enum_beg +%type sep_no_nl opt_sep_no_nl sep opt_sep opt_comma +%type input +%type string constant magic_colon +%type anon_fcn_handle +%type fcn_handle +%type matrix_rows matrix_rows1 +%type cell_rows cell_rows1 +%type matrix cell +%type primary_expr oper_expr +%type simple_expr colon_expr assign_expr expression +%type identifier fcn_name magic_tilde +%type superclass_identifier meta_identifier +%type function1 function2 classdef1 +%type word_list_cmd +%type colon_expr1 +%type arg_list word_list assign_lhs +%type cell_or_matrix_row +%type param_list param_list1 param_list2 +%type return_list return_list1 +%type superclasses opt_superclasses +%type command select_command loop_command +%type jump_command except_command function +%type script_file classdef +%type function_file function_list +%type if_command +%type elseif_clause else_clause +%type if_cmd_list1 if_cmd_list +%type switch_command +%type switch_case default_case +%type case_list1 case_list +%type decl2 +%type decl1 +%type declaration +%type statement function_end classdef_end +%type simple_list simple_list1 list list1 +%type opt_list input1 +// These types need to be specified. +%type attr +%type class_event +%type class_enum +%type class_property +%type properties_list +%type properties_block +%type methods_list +%type methods_block +%type opt_attr_list +%type attr_list +%type events_list +%type events_block +%type enum_list +%type enum_block +%type class_body + +// Precedence and associativity. +%right '=' ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ OR_EQ AND_EQ LSHIFT_EQ RSHIFT_EQ +%left EXPR_OR_OR +%left EXPR_AND_AND +%left EXPR_OR +%left EXPR_AND +%left EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT +%left LSHIFT RSHIFT +%left ':' +%left '-' '+' EPLUS EMINUS +%left '*' '/' LEFTDIV EMUL EDIV ELEFTDIV +%right UNARY EXPR_NOT +%left POW EPOW QUOTE TRANSPOSE +%right PLUS_PLUS MINUS_MINUS +%left '(' '.' '{' + +// Where to start. +%start input + +%% + +// ============================== +// Statements and statement lists +// ============================== + +input : input1 + { + global_command = $1; + promptflag = 1; + YYACCEPT; + } + | function_file + { YYACCEPT; } + | simple_list parse_error + { ABORT_PARSE; } + | parse_error + { ABORT_PARSE; } + ; + +input1 : '\n' + { $$ = 0; } + | END_OF_INPUT + { + parser_end_of_input = 1; + $$ = 0; + } + | simple_list + { $$ = $1; } + | simple_list '\n' + { $$ = $1; } + | simple_list END_OF_INPUT + { $$ = $1; } + ; + +simple_list : simple_list1 opt_sep_no_nl + { $$ = set_stmt_print_flag ($1, $2, false); } + ; + +simple_list1 : statement + { $$ = make_statement_list ($1); } + | simple_list1 sep_no_nl statement + { $$ = append_statement_list ($1, $2, $3, false); } + ; + +opt_list : // empty + { $$ = new tree_statement_list (); } + | list + { $$ = $1; } + ; + +list : list1 opt_sep + { $$ = set_stmt_print_flag ($1, $2, true); } + ; + +list1 : statement + { $$ = make_statement_list ($1); } + | list1 sep statement + { $$ = append_statement_list ($1, $2, $3, true); } + ; + +statement : expression + { $$ = make_statement ($1); } + | command + { $$ = make_statement ($1); } + | word_list_cmd + { $$ = make_statement ($1); } + ; + +// ================= +// Word-list command +// ================= + +// These are not really like expressions since they can't appear on +// the RHS of an assignment. But they are also not like commands (IF, +// WHILE, etc. + +word_list_cmd : identifier word_list + { $$ = make_index_expression ($1, $2, '('); } + ; + +word_list : string + { $$ = new tree_argument_list ($1); } + | word_list string + { + $1->append ($2); + $$ = $1; + } + ; + +// =========== +// Expressions +// =========== + +identifier : NAME + { + symbol_table::symbol_record *sr = $1->sym_rec (); + $$ = new tree_identifier (*sr, $1->line (), $1->column ()); + } + ; + +superclass_identifier + : SUPERCLASSREF + { $$ = new tree_identifier ($1->line (), $1->column ()); } + ; + +meta_identifier : METAQUERY + { $$ = new tree_identifier ($1->line (), $1->column ()); } + ; + +string : DQ_STRING + { $$ = make_constant (DQ_STRING, $1); } + | SQ_STRING + { $$ = make_constant (SQ_STRING, $1); } + ; + +constant : NUM + { $$ = make_constant (NUM, $1); } + | IMAG_NUM + { $$ = make_constant (IMAG_NUM, $1); } + | string + { $$ = $1; } + ; + +matrix : '[' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.pending_local_variables.clear (); + } + | '[' ';' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.pending_local_variables.clear (); + } + | '[' ',' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.pending_local_variables.clear (); + } + | '[' matrix_rows ']' + { + $$ = finish_matrix ($2); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.pending_local_variables.clear (); + } + ; + +matrix_rows : matrix_rows1 + { $$ = $1; } + | matrix_rows1 ';' // Ignore trailing semicolon. + { $$ = $1; } + ; + +matrix_rows1 : cell_or_matrix_row + { $$ = new tree_matrix ($1); } + | matrix_rows1 ';' cell_or_matrix_row + { + $1->append ($3); + $$ = $1; + } + ; + +cell : '{' '}' + { $$ = new tree_constant (octave_value (Cell ())); } + | '{' ';' '}' + { $$ = new tree_constant (octave_value (Cell ())); } + | '{' cell_rows '}' + { $$ = finish_cell ($2); } + ; + +cell_rows : cell_rows1 + { $$ = $1; } + | cell_rows1 ';' // Ignore trailing semicolon. + { $$ = $1; } + ; + +cell_rows1 : cell_or_matrix_row + { $$ = new tree_cell ($1); } + | cell_rows1 ';' cell_or_matrix_row + { + $1->append ($3); + $$ = $1; + } + ; + +cell_or_matrix_row + : arg_list + { $$ = validate_matrix_row ($1); } + | arg_list ',' // Ignore trailing comma. + { $$ = validate_matrix_row ($1); } + ; + +fcn_handle : '@' FCN_HANDLE + { + $$ = make_fcn_handle ($2); + lexer_flags.looking_at_function_handle--; + } + ; + +anon_fcn_handle : '@' param_list statement + { + lexer_flags.quote_is_transpose = false; + $$ = make_anon_fcn_handle ($2, $3); + } + ; + +primary_expr : identifier + { $$ = $1; } + | constant + { $$ = $1; } + | fcn_handle + { $$ = $1; } + | matrix + { $$ = $1; } + | cell + { $$ = $1; } + | meta_identifier + { $$ = $1; } + | superclass_identifier + { $$ = $1; } + | '(' expression ')' + { $$ = $2->mark_in_parens (); } + ; + +magic_colon : ':' + { + octave_value tmp (octave_value::magic_colon_t); + $$ = new tree_constant (tmp); + } + ; + +magic_tilde : EXPR_NOT + { + $$ = new tree_black_hole (); + } + ; + +arg_list : expression + { $$ = new tree_argument_list ($1); } + | magic_colon + { $$ = new tree_argument_list ($1); } + | magic_tilde + { $$ = new tree_argument_list ($1); } + | arg_list ',' magic_colon + { + $1->append ($3); + $$ = $1; + } + | arg_list ',' magic_tilde + { + $1->append ($3); + $$ = $1; + } + | arg_list ',' expression + { + $1->append ($3); + $$ = $1; + } + ; + +indirect_ref_op : '.' + { lexer_flags.looking_at_indirect_ref = true; } + ; + +oper_expr : primary_expr + { $$ = $1; } + | oper_expr PLUS_PLUS + { $$ = make_postfix_op (PLUS_PLUS, $1, $2); } + | oper_expr MINUS_MINUS + { $$ = make_postfix_op (MINUS_MINUS, $1, $2); } + | oper_expr '(' ')' + { $$ = make_index_expression ($1, 0, '('); } + | oper_expr '(' arg_list ')' + { $$ = make_index_expression ($1, $3, '('); } + | oper_expr '{' '}' + { $$ = make_index_expression ($1, 0, '{'); } + | oper_expr '{' arg_list '}' + { $$ = make_index_expression ($1, $3, '{'); } + | oper_expr QUOTE + { $$ = make_postfix_op (QUOTE, $1, $2); } + | oper_expr TRANSPOSE + { $$ = make_postfix_op (TRANSPOSE, $1, $2); } + | oper_expr indirect_ref_op STRUCT_ELT + { $$ = make_indirect_ref ($1, $3->text ()); } + | oper_expr indirect_ref_op '(' expression ')' + { $$ = make_indirect_ref ($1, $4); } + | PLUS_PLUS oper_expr %prec UNARY + { $$ = make_prefix_op (PLUS_PLUS, $2, $1); } + | MINUS_MINUS oper_expr %prec UNARY + { $$ = make_prefix_op (MINUS_MINUS, $2, $1); } + | EXPR_NOT oper_expr %prec UNARY + { $$ = make_prefix_op (EXPR_NOT, $2, $1); } + | '+' oper_expr %prec UNARY + { $$ = make_prefix_op ('+', $2, $1); } + | '-' oper_expr %prec UNARY + { $$ = make_prefix_op ('-', $2, $1); } + | oper_expr POW oper_expr + { $$ = make_binary_op (POW, $1, $2, $3); } + | oper_expr EPOW oper_expr + { $$ = make_binary_op (EPOW, $1, $2, $3); } + | oper_expr '+' oper_expr + { $$ = make_binary_op ('+', $1, $2, $3); } + | oper_expr '-' oper_expr + { $$ = make_binary_op ('-', $1, $2, $3); } + | oper_expr '*' oper_expr + { $$ = make_binary_op ('*', $1, $2, $3); } + | oper_expr '/' oper_expr + { $$ = make_binary_op ('/', $1, $2, $3); } + | oper_expr EPLUS oper_expr + { $$ = make_binary_op ('+', $1, $2, $3); } + | oper_expr EMINUS oper_expr + { $$ = make_binary_op ('-', $1, $2, $3); } + | oper_expr EMUL oper_expr + { $$ = make_binary_op (EMUL, $1, $2, $3); } + | oper_expr EDIV oper_expr + { $$ = make_binary_op (EDIV, $1, $2, $3); } + | oper_expr LEFTDIV oper_expr + { $$ = make_binary_op (LEFTDIV, $1, $2, $3); } + | oper_expr ELEFTDIV oper_expr + { $$ = make_binary_op (ELEFTDIV, $1, $2, $3); } + ; + +colon_expr : colon_expr1 + { $$ = finish_colon_expression ($1); } + ; + +colon_expr1 : oper_expr + { $$ = new tree_colon_expression ($1); } + | colon_expr1 ':' oper_expr + { + if (! ($$ = $1->append ($3))) + ABORT_PARSE; + } + ; + +simple_expr : colon_expr + { $$ = $1; } + | simple_expr LSHIFT simple_expr + { $$ = make_binary_op (LSHIFT, $1, $2, $3); } + | simple_expr RSHIFT simple_expr + { $$ = make_binary_op (RSHIFT, $1, $2, $3); } + | simple_expr EXPR_LT simple_expr + { $$ = make_binary_op (EXPR_LT, $1, $2, $3); } + | simple_expr EXPR_LE simple_expr + { $$ = make_binary_op (EXPR_LE, $1, $2, $3); } + | simple_expr EXPR_EQ simple_expr + { $$ = make_binary_op (EXPR_EQ, $1, $2, $3); } + | simple_expr EXPR_GE simple_expr + { $$ = make_binary_op (EXPR_GE, $1, $2, $3); } + | simple_expr EXPR_GT simple_expr + { $$ = make_binary_op (EXPR_GT, $1, $2, $3); } + | simple_expr EXPR_NE simple_expr + { $$ = make_binary_op (EXPR_NE, $1, $2, $3); } + | simple_expr EXPR_AND simple_expr + { $$ = make_binary_op (EXPR_AND, $1, $2, $3); } + | simple_expr EXPR_OR simple_expr + { $$ = make_binary_op (EXPR_OR, $1, $2, $3); } + | simple_expr EXPR_AND_AND simple_expr + { $$ = make_boolean_op (EXPR_AND_AND, $1, $2, $3); } + | simple_expr EXPR_OR_OR simple_expr + { $$ = make_boolean_op (EXPR_OR_OR, $1, $2, $3); } + ; + +// Arrange for the lexer to return CLOSE_BRACE for `]' by looking ahead +// one token for an assignment op. + +assign_lhs : simple_expr + { + $$ = new tree_argument_list ($1); + $$->mark_as_simple_assign_lhs (); + } + | '[' arg_list opt_comma CLOSE_BRACE + { + $$ = $2; + lexer_flags.looking_at_matrix_or_assign_lhs = false; + for (std::set::const_iterator p = lexer_flags.pending_local_variables.begin (); + p != lexer_flags.pending_local_variables.end (); + p++) + { + symbol_table::force_variable (*p); + } + lexer_flags.pending_local_variables.clear (); + } + ; + +assign_expr : assign_lhs '=' expression + { $$ = make_assign_op ('=', $1, $2, $3); } + | assign_lhs ADD_EQ expression + { $$ = make_assign_op (ADD_EQ, $1, $2, $3); } + | assign_lhs SUB_EQ expression + { $$ = make_assign_op (SUB_EQ, $1, $2, $3); } + | assign_lhs MUL_EQ expression + { $$ = make_assign_op (MUL_EQ, $1, $2, $3); } + | assign_lhs DIV_EQ expression + { $$ = make_assign_op (DIV_EQ, $1, $2, $3); } + | assign_lhs LEFTDIV_EQ expression + { $$ = make_assign_op (LEFTDIV_EQ, $1, $2, $3); } + | assign_lhs POW_EQ expression + { $$ = make_assign_op (POW_EQ, $1, $2, $3); } + | assign_lhs LSHIFT_EQ expression + { $$ = make_assign_op (LSHIFT_EQ, $1, $2, $3); } + | assign_lhs RSHIFT_EQ expression + { $$ = make_assign_op (RSHIFT_EQ, $1, $2, $3); } + | assign_lhs EMUL_EQ expression + { $$ = make_assign_op (EMUL_EQ, $1, $2, $3); } + | assign_lhs EDIV_EQ expression + { $$ = make_assign_op (EDIV_EQ, $1, $2, $3); } + | assign_lhs ELEFTDIV_EQ expression + { $$ = make_assign_op (ELEFTDIV_EQ, $1, $2, $3); } + | assign_lhs EPOW_EQ expression + { $$ = make_assign_op (EPOW_EQ, $1, $2, $3); } + | assign_lhs AND_EQ expression + { $$ = make_assign_op (AND_EQ, $1, $2, $3); } + | assign_lhs OR_EQ expression + { $$ = make_assign_op (OR_EQ, $1, $2, $3); } + ; + +expression : simple_expr + { $$ = $1; } + | assign_expr + { $$ = $1; } + | anon_fcn_handle + { $$ = $1; } + ; + +// ================================================ +// Commands, declarations, and function definitions +// ================================================ + +command : declaration + { $$ = $1; } + | select_command + { $$ = $1; } + | loop_command + { $$ = $1; } + | jump_command + { $$ = $1; } + | except_command + { $$ = $1; } + | function + { $$ = $1; } + | script_file + { $$ = $1; } + | classdef + { $$ = $1; } + ; + +// ===================== +// Declaration statemnts +// ===================== + +parsing_decl_list + : // empty + { lexer_flags.looking_at_decl_list = true; } + +declaration : GLOBAL parsing_decl_list decl1 + { + $$ = make_decl_command (GLOBAL, $1, $3); + lexer_flags.looking_at_decl_list = false; + } + | PERSISTENT parsing_decl_list decl1 + { + $$ = make_decl_command (PERSISTENT, $1, $3); + lexer_flags.looking_at_decl_list = false; + } + ; + +decl1 : decl2 + { $$ = new tree_decl_init_list ($1); } + | decl1 decl2 + { + $1->append ($2); + $$ = $1; + } + ; + +decl_param_init : // empty + { lexer_flags.looking_at_initializer_expression = true; } + +decl2 : identifier + { $$ = new tree_decl_elt ($1); } + | identifier '=' decl_param_init expression + { + lexer_flags.looking_at_initializer_expression = false; + $$ = new tree_decl_elt ($1, $4); + } + | magic_tilde + { + $$ = new tree_decl_elt ($1); + } + ; + +// ==================== +// Selection statements +// ==================== + +select_command : if_command + { $$ = $1; } + | switch_command + { $$ = $1; } + ; + +// ============ +// If statement +// ============ + +if_command : IF stash_comment if_cmd_list END + { + if (! ($$ = finish_if_command ($1, $3, $4, $2))) + ABORT_PARSE; + } + ; + +if_cmd_list : if_cmd_list1 + { $$ = $1; } + | if_cmd_list1 else_clause + { + $1->append ($2); + $$ = $1; + } + ; + +if_cmd_list1 : expression opt_sep opt_list + { + $1->mark_braindead_shortcircuit (curr_fcn_file_full_name); + + $$ = start_if_command ($1, $3); + } + | if_cmd_list1 elseif_clause + { + $1->append ($2); + $$ = $1; + } + ; + +elseif_clause : ELSEIF stash_comment opt_sep expression opt_sep opt_list + { + $4->mark_braindead_shortcircuit (curr_fcn_file_full_name); + + $$ = make_elseif_clause ($1, $4, $6, $2); + } + ; + +else_clause : ELSE stash_comment opt_sep opt_list + { $$ = new tree_if_clause ($4, $2); } + ; + +// ================ +// Switch statement +// ================ + +switch_command : SWITCH stash_comment expression opt_sep case_list END + { + if (! ($$ = finish_switch_command ($1, $3, $5, $6, $2))) + ABORT_PARSE; + } + ; + +case_list : // empty + { $$ = new tree_switch_case_list (); } + | default_case + { $$ = new tree_switch_case_list ($1); } + | case_list1 + { $$ = $1; } + | case_list1 default_case + { + $1->append ($2); + $$ = $1; + } + ; + +case_list1 : switch_case + { $$ = new tree_switch_case_list ($1); } + | case_list1 switch_case + { + $1->append ($2); + $$ = $1; + } + ; + +switch_case : CASE stash_comment opt_sep expression opt_sep opt_list + { $$ = make_switch_case ($1, $4, $6, $2); } + ; + +default_case : OTHERWISE stash_comment opt_sep opt_list + { + $$ = new tree_switch_case ($4, $2); + } + ; + +// ======= +// Looping +// ======= + +loop_command : WHILE stash_comment expression opt_sep opt_list END + { + $3->mark_braindead_shortcircuit (curr_fcn_file_full_name); + + if (! ($$ = make_while_command ($1, $3, $5, $6, $2))) + ABORT_PARSE; + } + | DO stash_comment opt_sep opt_list UNTIL expression + { + if (! ($$ = make_do_until_command ($5, $4, $6, $2))) + ABORT_PARSE; + } + | FOR stash_comment assign_lhs '=' expression opt_sep opt_list END + { + if (! ($$ = make_for_command (FOR, $1, $3, $5, 0, + $7, $8, $2))) + ABORT_PARSE; + } + | FOR stash_comment '(' assign_lhs '=' expression ')' opt_sep opt_list END + { + if (! ($$ = make_for_command (FOR, $1, $4, $6, 0, + $9, $10, $2))) + ABORT_PARSE; + } + | PARFOR stash_comment assign_lhs '=' expression opt_sep opt_list END + { + if (! ($$ = make_for_command (PARFOR, $1, $3, $5, + 0, $7, $8, $2))) + ABORT_PARSE; + } + | PARFOR stash_comment '(' assign_lhs '=' expression ',' expression ')' opt_sep opt_list END + { + if (! ($$ = make_for_command (PARFOR, $1, $4, $6, + $8, $11, $12, $2))) + ABORT_PARSE; + } + ; + +// ======= +// Jumping +// ======= + +jump_command : BREAK + { + if (! ($$ = make_break_command ($1))) + ABORT_PARSE; + } + | CONTINUE + { + if (! ($$ = make_continue_command ($1))) + ABORT_PARSE; + } + | FUNC_RET + { + if (! ($$ = make_return_command ($1))) + ABORT_PARSE; + } + ; + +// ========== +// Exceptions +// ========== + +except_command : UNWIND stash_comment opt_sep opt_list CLEANUP + stash_comment opt_sep opt_list END + { + if (! ($$ = make_unwind_command ($1, $4, $8, $9, $2, $6))) + ABORT_PARSE; + } + | TRY stash_comment opt_sep opt_list CATCH + stash_comment opt_sep opt_list END + { + if (! ($$ = make_try_command ($1, $4, $8, $9, $2, $6))) + ABORT_PARSE; + } + | TRY stash_comment opt_sep opt_list END + { + if (! ($$ = make_try_command ($1, $4, 0, $5, $2, 0))) + ABORT_PARSE; + } + ; + +// =========================================== +// Some `subroutines' for function definitions +// =========================================== + +push_fcn_symtab : // empty + { + current_function_depth++; + + if (max_function_depth < current_function_depth) + max_function_depth = current_function_depth; + + parser_symtab_context.push (); + + symbol_table::set_scope (symbol_table::alloc_scope ()); + + function_scopes.push_back (symbol_table::current_scope ()); + + if (! reading_script_file && current_function_depth == 1 + && ! parsing_subfunctions) + primary_fcn_scope = symbol_table::current_scope (); + + if (reading_script_file && current_function_depth > 1) + yyerror ("nested functions not implemented in this context"); + } + ; + +// =========================== +// List of function parameters +// =========================== + +param_list_beg : '(' + { + lexer_flags.looking_at_parameter_list = true; + + if (lexer_flags.looking_at_function_handle) + { + parser_symtab_context.push (); + symbol_table::set_scope (symbol_table::alloc_scope ()); + lexer_flags.looking_at_function_handle--; + lexer_flags.looking_at_anon_fcn_args = true; + } + } + ; + +param_list_end : ')' + { + lexer_flags.looking_at_parameter_list = false; + lexer_flags.looking_for_object_index = false; + } + ; + +param_list : param_list_beg param_list1 param_list_end + { + lexer_flags.quote_is_transpose = false; + $$ = $2; + } + | param_list_beg error + { + yyerror ("invalid parameter list"); + $$ = 0; + ABORT_PARSE; + } + ; + +param_list1 : // empty + { $$ = 0; } + | param_list2 + { + $1->mark_as_formal_parameters (); + if ($1->validate (tree_parameter_list::in)) + $$ = $1; + else + ABORT_PARSE; + } + ; + +param_list2 : decl2 + { $$ = new tree_parameter_list ($1); } + | param_list2 ',' decl2 + { + $1->append ($3); + $$ = $1; + } + ; + +// =================================== +// List of function return value names +// =================================== + +return_list : '[' ']' + { + lexer_flags.looking_at_return_list = false; + $$ = new tree_parameter_list (); + } + | return_list1 + { + lexer_flags.looking_at_return_list = false; + if ($1->validate (tree_parameter_list::out)) + $$ = $1; + else + ABORT_PARSE; + } + | '[' return_list1 ']' + { + lexer_flags.looking_at_return_list = false; + if ($2->validate (tree_parameter_list::out)) + $$ = $2; + else + ABORT_PARSE; + } + ; + +return_list1 : identifier + { $$ = new tree_parameter_list (new tree_decl_elt ($1)); } + | return_list1 ',' identifier + { + $1->append (new tree_decl_elt ($3)); + $$ = $1; + } + ; + +// =========== +// Script file +// =========== + +script_file : SCRIPT_FILE opt_list END_OF_INPUT + { + tree_statement *end_of_script + = make_end ("endscript", input_line_number, + current_input_column); + + make_script ($2, end_of_script); + + $$ = 0; + } + ; + +// ============= +// Function file +// ============= + +function_file : FUNCTION_FILE function_list opt_sep END_OF_INPUT + { $$ = 0; } + ; + +function_list : function + | function_list sep function + ; + +// =================== +// Function definition +// =================== + +function_beg : push_fcn_symtab FCN stash_comment + { + $$ = $3; + + if (reading_classdef_file || lexer_flags.parsing_classdef) + lexer_flags.maybe_classdef_get_set_method = true; + } + ; + +function : function_beg function1 + { + $$ = finish_function (0, $2, $1); + recover_from_parsing_function (); + } + | function_beg return_list '=' function1 + { + $$ = finish_function ($2, $4, $1); + recover_from_parsing_function (); + } + ; + +fcn_name : identifier + { + std::string id_name = $1->name (); + + lexer_flags.parsed_function_name.top () = true; + lexer_flags.maybe_classdef_get_set_method = false; + + $$ = $1; + } + | GET '.' identifier + { + lexer_flags.parsed_function_name.top () = true; + lexer_flags.maybe_classdef_get_set_method = false; + $$ = $3; + } + | SET '.' identifier + { + lexer_flags.parsed_function_name.top () = true; + lexer_flags.maybe_classdef_get_set_method = false; + $$ = $3; + } + ; + +function1 : fcn_name function2 + { + std::string fname = $1->name (); + + delete $1; + + if (! ($$ = frob_function (fname, $2))) + ABORT_PARSE; + } + ; + +function2 : param_list opt_sep opt_list function_end + { $$ = start_function ($1, $3, $4); } + | opt_sep opt_list function_end + { $$ = start_function (0, $2, $3); } + ; + +function_end : END + { + endfunction_found = true; + if (end_token_ok ($1, token::function_end)) + $$ = make_end ("endfunction", $1->line (), $1->column ()); + else + ABORT_PARSE; + } + | END_OF_INPUT + { +// A lot of tests are based on the assumption that this is OK +// if (reading_script_file) +// { +// yyerror ("function body open at end of script"); +// YYABORT; +// } + + if (endfunction_found) + { + yyerror ("inconsistent function endings -- " + "if one function is explicitly ended, " + "so must all the others"); + YYABORT; + } + + if (! (reading_fcn_file || reading_script_file + || get_input_from_eval_string)) + { + yyerror ("function body open at end of input"); + YYABORT; + } + + if (reading_classdef_file) + { + yyerror ("classdef body open at end of input"); + YYABORT; + } + + $$ = make_end ("endfunction", input_line_number, + current_input_column); + } + ; + +// ======== +// Classdef +// ======== + +classdef_beg : CLASSDEF stash_comment + { + $$ = 0; + lexer_flags.parsing_classdef = true; + } + ; + +classdef_end : END + { + lexer_flags.parsing_classdef = false; + + if (end_token_ok ($1, token::classdef_end)) + $$ = make_end ("endclassdef", $1->line (), $1->column ()); + else + ABORT_PARSE; + } + ; + +classdef1 : classdef_beg opt_attr_list identifier opt_superclasses + { $$ = 0; } + ; + +classdef : classdef1 opt_sep class_body opt_sep stash_comment classdef_end + { $$ = 0; } + ; + +opt_attr_list : // empty + { $$ = 0; } + | '(' attr_list ')' + { $$ = 0; } + ; + +attr_list : attr + { $$ = 0; } + | attr_list ',' attr + { $$ = 0; } + ; + +attr : identifier + { $$ = 0; } + | identifier '=' decl_param_init expression + { $$ = 0; } + | EXPR_NOT identifier + { $$ = 0; } + ; + +opt_superclasses + : // empty + { $$ = 0; } + | superclasses + { $$ = 0; } + ; + +superclasses : EXPR_LT identifier '.' identifier + { $$ = 0; } + | EXPR_LT identifier + { $$ = 0; } + | superclasses EXPR_AND identifier '.' identifier + { $$ = 0; } + | superclasses EXPR_AND identifier + { $$ = 0; } + ; + +class_body : properties_block + { $$ = 0; } + | methods_block + { $$ = 0; } + | events_block + { $$ = 0; } + | enum_block + { $$ = 0; } + | class_body opt_sep properties_block + { $$ = 0; } + | class_body opt_sep methods_block + { $$ = 0; } + | class_body opt_sep events_block + { $$ = 0; } + | class_body opt_sep enum_block + { $$ = 0; } + ; + +properties_beg : PROPERTIES stash_comment + { $$ = 0; } + ; + +properties_block + : properties_beg opt_attr_list opt_sep properties_list opt_sep END + { $$ = 0; } + ; + +properties_list + : class_property + { $$ = 0; } + | properties_list opt_sep class_property + { $$ = 0; } + ; + +class_property : identifier + { $$ = 0; } + | identifier '=' decl_param_init expression ';' + { $$ = 0; } + ; + +methods_beg : METHODS stash_comment + { $$ = 0; } + ; + +methods_block : methods_beg opt_attr_list opt_sep methods_list opt_sep END + { $$ = 0; } + ; + +methods_list : function + { $$ = 0; } + | methods_list opt_sep function + { $$ = 0; } + ; + +events_beg : EVENTS stash_comment + { $$ = 0; } + ; + +events_block : events_beg opt_attr_list opt_sep events_list opt_sep END + { $$ = 0; } + ; + +events_list : class_event + { $$ = 0; } + | events_list opt_sep class_event + { $$ = 0; } + ; + +class_event : identifier + { $$ = 0; } + ; + +enum_beg : ENUMERATION stash_comment + { $$ = 0; } + ; + +enum_block : enum_beg opt_attr_list opt_sep enum_list opt_sep END + { $$ = 0; } + ; + +enum_list : class_enum + { $$ = 0; } + | enum_list opt_sep class_enum + { $$ = 0; } + ; + +class_enum : identifier '(' expression ')' + { $$ = 0; } + ; + +// ============= +// Miscellaneous +// ============= + +stash_comment : // empty + { $$ = octave_comment_buffer::get_comment (); } + ; + +parse_error : LEXICAL_ERROR + { yyerror ("parse error"); } + | error + ; + +sep_no_nl : ',' + { $$ = ','; } + | ';' + { $$ = ';'; } + | sep_no_nl ',' + { $$ = $1; } + | sep_no_nl ';' + { $$ = $1; } + ; + +opt_sep_no_nl : // empty + { $$ = 0; } + | sep_no_nl + { $$ = $1; } + ; + +sep : ',' + { $$ = ','; } + | ';' + { $$ = ';'; } + | '\n' + { $$ = '\n'; } + | sep ',' + { $$ = $1; } + | sep ';' + { $$ = $1; } + | sep '\n' + { $$ = $1; } + ; + +opt_sep : // empty + { $$ = 0; } + | sep + { $$ = $1; } + ; + +opt_comma : // empty + { $$ = 0; } + | ',' + { $$ = ','; } + ; + +%% + +// Generic error messages. + +static void +yyerror (const char *s) +{ + int err_col = current_input_column - 1; + + std::ostringstream output_buf; + + if (reading_fcn_file || reading_script_file || reading_classdef_file) + output_buf << "parse error near line " << input_line_number + << " of file " << curr_fcn_file_full_name; + else + output_buf << "parse error:"; + + if (s && strcmp (s, "parse error") != 0) + output_buf << "\n\n " << s; + + output_buf << "\n\n"; + + if (! current_input_line.empty ()) + { + size_t len = current_input_line.length (); + + if (current_input_line[len-1] == '\n') + current_input_line.resize (len-1); + + // Print the line, maybe with a pointer near the error token. + + output_buf << ">>> " << current_input_line << "\n"; + + if (err_col == 0) + err_col = len; + + for (int i = 0; i < err_col + 3; i++) + output_buf << " "; + + output_buf << "^"; + } + + output_buf << "\n"; + + std::string msg = output_buf.str (); + + parse_error ("%s", msg.c_str ()); +} + +// Error mesages for mismatched end tokens. + +static void +end_error (const char *type, token::end_tok_type ettype, int l, int c) +{ + static const char *fmt + = "`%s' command matched by `%s' near line %d column %d"; + + switch (ettype) + { + case token::simple_end: + error (fmt, type, "end", l, c); + break; + + case token::for_end: + error (fmt, type, "endfor", l, c); + break; + + case token::function_end: + error (fmt, type, "endfunction", l, c); + break; + + case token::classdef_end: + error (fmt, type, "endclassdef", l, c); + break; + + case token::if_end: + error (fmt, type, "endif", l, c); + break; + + case token::switch_end: + error (fmt, type, "endswitch", l, c); + break; + + case token::while_end: + error (fmt, type, "endwhile", l, c); + break; + + case token::try_catch_end: + error (fmt, type, "end_try_catch", l, c); + break; + + case token::unwind_protect_end: + error (fmt, type, "end_unwind_protect", l, c); + break; + + default: + panic_impossible (); + break; + } +} + +// Check to see that end tokens are properly matched. + +static bool +end_token_ok (token *tok, token::end_tok_type expected) +{ + bool retval = true; + + token::end_tok_type ettype = tok->ettype (); + + if (ettype != expected && ettype != token::simple_end) + { + retval = false; + + yyerror ("parse error"); + + int l = tok->line (); + int c = tok->column (); + + switch (expected) + { + case token::classdef_end: + end_error ("classdef", ettype, l, c); + break; + + case token::for_end: + end_error ("for", ettype, l, c); + break; + + case token::enumeration_end: + end_error ("enumeration", ettype, l, c); + break; + + case token::function_end: + end_error ("function", ettype, l, c); + break; + + case token::if_end: + end_error ("if", ettype, l, c); + break; + + case token::parfor_end: + end_error ("parfor", ettype, l, c); + break; + + case token::try_catch_end: + end_error ("try", ettype, l, c); + break; + + case token::switch_end: + end_error ("switch", ettype, l, c); + break; + + case token::unwind_protect_end: + end_error ("unwind_protect", ettype, l, c); + break; + + case token::while_end: + end_error ("while", ettype, l, c); + break; + + default: + panic_impossible (); + break; + } + } + + return retval; +} + +// Maybe print a warning if an assignment expression is used as the +// test in a logical expression. + +static void +maybe_warn_assign_as_truth_value (tree_expression *expr) +{ + if (expr->is_assignment_expression () + && expr->paren_count () < 2) + { + if (curr_fcn_file_full_name.empty ()) + warning_with_id + ("Octave:assign-as-truth-value", + "suggest parenthesis around assignment used as truth value"); + else + warning_with_id + ("Octave:assign-as-truth-value", + "suggest parenthesis around assignment used as truth value near line %d, column %d in file `%s'", + expr->line (), expr->column (), curr_fcn_file_full_name.c_str ()); + } +} + +// Maybe print a warning about switch labels that aren't constants. + +static void +maybe_warn_variable_switch_label (tree_expression *expr) +{ + if (! expr->is_constant ()) + { + if (curr_fcn_file_full_name.empty ()) + warning_with_id ("Octave:variable-switch-label", + "variable switch label"); + else + warning_with_id + ("Octave:variable-switch-label", + "variable switch label near line %d, column %d in file `%s'", + expr->line (), expr->column (), curr_fcn_file_full_name.c_str ()); + } +} + +static tree_expression * +fold (tree_binary_expression *e) +{ + tree_expression *retval = e; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + tree_expression *op1 = e->lhs (); + tree_expression *op2 = e->rhs (); + + if (op1->is_constant () && op2->is_constant ()) + { + octave_value tmp = e->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, op1->line (), op1->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + e->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete e; + + retval = tc_retval; + } + } + + return retval; +} + +static tree_expression * +fold (tree_unary_expression *e) +{ + tree_expression *retval = e; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + tree_expression *op = e->operand (); + + if (op->is_constant ()) + { + octave_value tmp = e->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, op->line (), op->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + e->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete e; + + retval = tc_retval; + } + } + + return retval; +} + +// Finish building a range. + +static tree_expression * +finish_colon_expression (tree_colon_expression *e) +{ + tree_expression *retval = e; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + tree_expression *base = e->base (); + tree_expression *limit = e->limit (); + tree_expression *incr = e->increment (); + + if (base) + { + if (limit) + { + if (base->is_constant () && limit->is_constant () + && (! incr || (incr && incr->is_constant ()))) + { + octave_value tmp = e->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, base->line (), base->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + e->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete e; + + retval = tc_retval; + } + } + } + else + { + e->preserve_base (); + delete e; + + // FIXME -- need to attempt constant folding here + // too (we need a generic way to do that). + retval = base; + } + } + + return retval; +} + +// Make a constant. + +static tree_constant * +make_constant (int op, token *tok_val) +{ + int l = tok_val->line (); + int c = tok_val->column (); + + tree_constant *retval = 0; + + switch (op) + { + case NUM: + { + octave_value tmp (tok_val->number ()); + retval = new tree_constant (tmp, l, c); + retval->stash_original_text (tok_val->text_rep ()); + } + break; + + case IMAG_NUM: + { + octave_value tmp (Complex (0.0, tok_val->number ())); + retval = new tree_constant (tmp, l, c); + retval->stash_original_text (tok_val->text_rep ()); + } + break; + + case DQ_STRING: + case SQ_STRING: + { + std::string txt = tok_val->text (); + + char delim = op == DQ_STRING ? '"' : '\''; + octave_value tmp (txt, delim); + + if (txt.empty ()) + { + if (op == DQ_STRING) + tmp = octave_null_str::instance; + else + tmp = octave_null_sq_str::instance; + } + + retval = new tree_constant (tmp, l, c); + + if (op == DQ_STRING) + txt = undo_string_escapes (txt); + + // FIXME -- maybe this should also be handled by + // tok_val->text_rep () for character strings? + retval->stash_original_text (delim + txt + delim); + } + break; + + default: + panic_impossible (); + break; + } + + return retval; +} + +// Make a function handle. + +static tree_fcn_handle * +make_fcn_handle (token *tok_val) +{ + int l = tok_val->line (); + int c = tok_val->column (); + + tree_fcn_handle *retval = new tree_fcn_handle (tok_val->text (), l, c); + + return retval; +} + +// Make an anonymous function handle. + +static tree_anon_fcn_handle * +make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt) +{ + // FIXME -- need to get these from the location of the @ symbol. + int l = input_line_number; + int c = current_input_column; + + tree_parameter_list *ret_list = 0; + + symbol_table::scope_id fcn_scope = symbol_table::current_scope (); + + if (parser_symtab_context.empty ()) + panic_impossible (); + + parser_symtab_context.pop (); + + stmt->set_print_flag (false); + + tree_statement_list *body = new tree_statement_list (stmt); + + body->mark_as_anon_function_body (); + + tree_anon_fcn_handle *retval + = new tree_anon_fcn_handle (param_list, ret_list, body, fcn_scope, l, c); + // FIXME: Stash the filename. This does not work and produces + // errors when executed. + //retval->stash_file_name (curr_fcn_file_name); + + return retval; +} + +// Build a binary expression. + +static tree_expression * +make_binary_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2) +{ + octave_value::binary_op t = octave_value::unknown_binary_op; + + switch (op) + { + case POW: + t = octave_value::op_pow; + break; + + case EPOW: + t = octave_value::op_el_pow; + break; + + case '+': + t = octave_value::op_add; + break; + + case '-': + t = octave_value::op_sub; + break; + + case '*': + t = octave_value::op_mul; + break; + + case '/': + t = octave_value::op_div; + break; + + case EMUL: + t = octave_value::op_el_mul; + break; + + case EDIV: + t = octave_value::op_el_div; + break; + + case LEFTDIV: + t = octave_value::op_ldiv; + break; + + case ELEFTDIV: + t = octave_value::op_el_ldiv; + break; + + case LSHIFT: + t = octave_value::op_lshift; + break; + + case RSHIFT: + t = octave_value::op_rshift; + break; + + case EXPR_LT: + t = octave_value::op_lt; + break; + + case EXPR_LE: + t = octave_value::op_le; + break; + + case EXPR_EQ: + t = octave_value::op_eq; + break; + + case EXPR_GE: + t = octave_value::op_ge; + break; + + case EXPR_GT: + t = octave_value::op_gt; + break; + + case EXPR_NE: + t = octave_value::op_ne; + break; + + case EXPR_AND: + t = octave_value::op_el_and; + break; + + case EXPR_OR: + t = octave_value::op_el_or; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_binary_expression *e + = maybe_compound_binary_expression (op1, op2, l, c, t); + + return fold (e); +} + +// Build a boolean expression. + +static tree_expression * +make_boolean_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2) +{ + tree_boolean_expression::type t; + + switch (op) + { + case EXPR_AND_AND: + t = tree_boolean_expression::bool_and; + break; + + case EXPR_OR_OR: + t = tree_boolean_expression::bool_or; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_boolean_expression *e + = new tree_boolean_expression (op1, op2, l, c, t); + + return fold (e); +} + +// Build a prefix expression. + +static tree_expression * +make_prefix_op (int op, tree_expression *op1, token *tok_val) +{ + octave_value::unary_op t = octave_value::unknown_unary_op; + + switch (op) + { + case EXPR_NOT: + t = octave_value::op_not; + break; + + case '+': + t = octave_value::op_uplus; + break; + + case '-': + t = octave_value::op_uminus; + break; + + case PLUS_PLUS: + t = octave_value::op_incr; + break; + + case MINUS_MINUS: + t = octave_value::op_decr; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_prefix_expression *e + = new tree_prefix_expression (op1, l, c, t); + + return fold (e); +} + +// Build a postfix expression. + +static tree_expression * +make_postfix_op (int op, tree_expression *op1, token *tok_val) +{ + octave_value::unary_op t = octave_value::unknown_unary_op; + + switch (op) + { + case QUOTE: + t = octave_value::op_hermitian; + break; + + case TRANSPOSE: + t = octave_value::op_transpose; + break; + + case PLUS_PLUS: + t = octave_value::op_incr; + break; + + case MINUS_MINUS: + t = octave_value::op_decr; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_postfix_expression *e + = new tree_postfix_expression (op1, l, c, t); + + return fold (e); +} + +// Build an unwind-protect command. + +static tree_command * +make_unwind_command (token *unwind_tok, tree_statement_list *body, + tree_statement_list *cleanup, token *end_tok, + octave_comment_list *lc, octave_comment_list *mc) +{ + tree_command *retval = 0; + + if (end_token_ok (end_tok, token::unwind_protect_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = unwind_tok->line (); + int c = unwind_tok->column (); + + retval = new tree_unwind_protect_command (body, cleanup, + lc, mc, tc, l, c); + } + + return retval; +} + +// Build a try-catch command. + +static tree_command * +make_try_command (token *try_tok, tree_statement_list *body, + tree_statement_list *cleanup, token *end_tok, + octave_comment_list *lc, octave_comment_list *mc) +{ + tree_command *retval = 0; + + if (end_token_ok (end_tok, token::try_catch_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = try_tok->line (); + int c = try_tok->column (); + + retval = new tree_try_catch_command (body, cleanup, + lc, mc, tc, l, c); + } + + return retval; +} + +// Build a while command. + +static tree_command * +make_while_command (token *while_tok, tree_expression *expr, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc) +{ + tree_command *retval = 0; + + maybe_warn_assign_as_truth_value (expr); + + if (end_token_ok (end_tok, token::while_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + lexer_flags.looping--; + + int l = while_tok->line (); + int c = while_tok->column (); + + retval = new tree_while_command (expr, body, lc, tc, l, c); + } + + return retval; +} + +// Build a do-until command. + +static tree_command * +make_do_until_command (token *until_tok, tree_statement_list *body, + tree_expression *expr, octave_comment_list *lc) +{ + tree_command *retval = 0; + + maybe_warn_assign_as_truth_value (expr); + + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + lexer_flags.looping--; + + int l = until_tok->line (); + int c = until_tok->column (); + + retval = new tree_do_until_command (expr, body, lc, tc, l, c); + + return retval; +} + +// Build a for command. + +static tree_command * +make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, + tree_expression *expr, tree_expression *maxproc, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc) +{ + tree_command *retval = 0; + + bool parfor = tok_id == PARFOR; + + if (end_token_ok (end_tok, parfor ? token::parfor_end : token::for_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + lexer_flags.looping--; + + int l = for_tok->line (); + int c = for_tok->column (); + + if (lhs->length () == 1) + { + tree_expression *tmp = lhs->remove_front (); + + retval = new tree_simple_for_command (parfor, tmp, expr, maxproc, + body, lc, tc, l, c); + + delete lhs; + } + else + { + if (parfor) + yyerror ("invalid syntax for parfor statement"); + else + retval = new tree_complex_for_command (lhs, expr, body, + lc, tc, l, c); + } + } + + return retval; +} + +// Build a break command. + +static tree_command * +make_break_command (token *break_tok) +{ + tree_command *retval = 0; + + int l = break_tok->line (); + int c = break_tok->column (); + + retval = new tree_break_command (l, c); + + return retval; +} + +// Build a continue command. + +static tree_command * +make_continue_command (token *continue_tok) +{ + tree_command *retval = 0; + + int l = continue_tok->line (); + int c = continue_tok->column (); + + retval = new tree_continue_command (l, c); + + return retval; +} + +// Build a return command. + +static tree_command * +make_return_command (token *return_tok) +{ + tree_command *retval = 0; + + int l = return_tok->line (); + int c = return_tok->column (); + + retval = new tree_return_command (l, c); + + return retval; +} + +// Start an if command. + +static tree_if_command_list * +start_if_command (tree_expression *expr, tree_statement_list *list) +{ + maybe_warn_assign_as_truth_value (expr); + + tree_if_clause *t = new tree_if_clause (expr, list); + + return new tree_if_command_list (t); +} + +// Finish an if command. + +static tree_if_command * +finish_if_command (token *if_tok, tree_if_command_list *list, + token *end_tok, octave_comment_list *lc) +{ + tree_if_command *retval = 0; + + if (end_token_ok (end_tok, token::if_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = if_tok->line (); + int c = if_tok->column (); + + if (list && ! list->empty ()) + { + tree_if_clause *elt = list->front (); + + if (elt) + { + elt->line (l); + elt->column (c); + } + } + + retval = new tree_if_command (list, lc, tc, l, c); + } + + return retval; +} + +// Build an elseif clause. + +static tree_if_clause * +make_elseif_clause (token *elseif_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc) +{ + maybe_warn_assign_as_truth_value (expr); + + int l = elseif_tok->line (); + int c = elseif_tok->column (); + + return new tree_if_clause (expr, list, lc, l, c); +} + +// Finish a switch command. + +static tree_switch_command * +finish_switch_command (token *switch_tok, tree_expression *expr, + tree_switch_case_list *list, token *end_tok, + octave_comment_list *lc) +{ + tree_switch_command *retval = 0; + + if (end_token_ok (end_tok, token::switch_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = switch_tok->line (); + int c = switch_tok->column (); + + if (list && ! list->empty ()) + { + tree_switch_case *elt = list->front (); + + if (elt) + { + elt->line (l); + elt->column (c); + } + } + + retval = new tree_switch_command (expr, list, lc, tc, l, c); + } + + return retval; +} + +// Build a switch case. + +static tree_switch_case * +make_switch_case (token *case_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc) +{ + maybe_warn_variable_switch_label (expr); + + int l = case_tok->line (); + int c = case_tok->column (); + + return new tree_switch_case (expr, list, lc, l, c); +} + +// Build an assignment to a variable. + +static tree_expression * +make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, + tree_expression *rhs) +{ + tree_expression *retval = 0; + + octave_value::assign_op t = octave_value::unknown_assign_op; + + switch (op) + { + case '=': + t = octave_value::op_asn_eq; + break; + + case ADD_EQ: + t = octave_value::op_add_eq; + break; + + case SUB_EQ: + t = octave_value::op_sub_eq; + break; + + case MUL_EQ: + t = octave_value::op_mul_eq; + break; + + case DIV_EQ: + t = octave_value::op_div_eq; + break; + + case LEFTDIV_EQ: + t = octave_value::op_ldiv_eq; + break; + + case POW_EQ: + t = octave_value::op_pow_eq; + break; + + case LSHIFT_EQ: + t = octave_value::op_lshift_eq; + break; + + case RSHIFT_EQ: + t = octave_value::op_rshift_eq; + break; + + case EMUL_EQ: + t = octave_value::op_el_mul_eq; + break; + + case EDIV_EQ: + t = octave_value::op_el_div_eq; + break; + + case ELEFTDIV_EQ: + t = octave_value::op_el_ldiv_eq; + break; + + case EPOW_EQ: + t = octave_value::op_el_pow_eq; + break; + + case AND_EQ: + t = octave_value::op_el_and_eq; + break; + + case OR_EQ: + t = octave_value::op_el_or_eq; + break; + + default: + panic_impossible (); + break; + } + + int l = eq_tok->line (); + int c = eq_tok->column (); + + if (lhs->is_simple_assign_lhs ()) + { + tree_expression *tmp = lhs->remove_front (); + + retval = new tree_simple_assignment (tmp, rhs, false, l, c, t); + + delete lhs; + } + else if (t == octave_value::op_asn_eq) + return new tree_multi_assignment (lhs, rhs, false, l, c); + else + yyerror ("computed multiple assignment not allowed"); + + return retval; +} + +// Define a script. + +static void +make_script (tree_statement_list *cmds, tree_statement *end_script) +{ + std::string doc_string; + + if (! help_buf.empty ()) + { + doc_string = help_buf.top (); + help_buf.pop (); + } + + if (! cmds) + cmds = new tree_statement_list (); + + cmds->append (end_script); + + octave_user_script *script + = new octave_user_script (curr_fcn_file_full_name, curr_fcn_file_name, + cmds, doc_string); + + octave_time now; + + script->stash_fcn_file_time (now); + + primary_fcn_ptr = script; + + // Unmark any symbols that may have been tagged as local variables + // while parsing (for example, by force_local_variable in lex.l). + + symbol_table::unmark_forced_variables (); +} + +// Begin defining a function. + +static octave_user_function * +start_function (tree_parameter_list *param_list, tree_statement_list *body, + tree_statement *end_fcn_stmt) +{ + // We'll fill in the return list later. + + if (! body) + body = new tree_statement_list (); + + body->append (end_fcn_stmt); + + octave_user_function *fcn + = new octave_user_function (symbol_table::current_scope (), + param_list, 0, body); + + if (fcn) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + fcn->stash_trailing_comment (tc); + } + + return fcn; +} + +static tree_statement * +make_end (const std::string& type, int l, int c) +{ + return make_statement (new tree_no_op_command (type, l, c)); +} + +// Do most of the work for defining a function. + +static octave_user_function * +frob_function (const std::string& fname, octave_user_function *fcn) +{ + std::string id_name = fname; + + // If input is coming from a file, issue a warning if the name of + // the file does not match the name of the function stated in the + // file. Matlab doesn't provide a diagnostic (it ignores the stated + // name). + if (! autoloading && reading_fcn_file + && current_function_depth == 1 && ! parsing_subfunctions) + { + // FIXME -- should curr_fcn_file_name already be + // preprocessed when we get here? It seems to only be a + // problem with relative file names. + + std::string nm = curr_fcn_file_name; + + size_t pos = nm.find_last_of (file_ops::dir_sep_chars ()); + + if (pos != std::string::npos) + nm = curr_fcn_file_name.substr (pos+1); + + if (nm != id_name) + { + warning_with_id + ("Octave:function-name-clash", + "function name `%s' does not agree with function file name `%s'", + id_name.c_str (), curr_fcn_file_full_name.c_str ()); + + id_name = nm; + } + } + + if (reading_fcn_file || reading_classdef_file || autoloading) + { + octave_time now; + + fcn->stash_fcn_file_name (curr_fcn_file_full_name); + fcn->stash_fcn_file_time (now); + fcn->mark_as_system_fcn_file (); + + if (fcn_file_from_relative_lookup) + fcn->mark_relative (); + + if (current_function_depth > 1 || parsing_subfunctions) + { + fcn->stash_parent_fcn_name (curr_fcn_file_name); + + if (current_function_depth > 1) + fcn->stash_parent_fcn_scope (function_scopes[function_scopes.size ()-2]); + else + fcn->stash_parent_fcn_scope (primary_fcn_scope); + } + + if (lexer_flags.parsing_class_method) + { + if (current_class_name == id_name) + fcn->mark_as_class_constructor (); + else + fcn->mark_as_class_method (); + + fcn->stash_dispatch_class (current_class_name); + } + + std::string nm = fcn->fcn_file_name (); + + file_stat fs (nm); + + if (fs && fs.is_newer (now)) + warning_with_id ("Octave:future-time-stamp", + "time stamp for `%s' is in the future", nm.c_str ()); + } + else if (! (input_from_tmp_history_file || input_from_startup_file) + && reading_script_file + && curr_fcn_file_name == id_name) + { + warning ("function `%s' defined within script file `%s'", + id_name.c_str (), curr_fcn_file_full_name.c_str ()); + } + + fcn->stash_function_name (id_name); + fcn->stash_fcn_location (input_line_number, current_input_column); + + if (! help_buf.empty () && current_function_depth == 1 + && ! parsing_subfunctions) + { + fcn->document (help_buf.top ()); + + help_buf.pop (); + } + + if (reading_fcn_file && current_function_depth == 1 + && ! parsing_subfunctions) + primary_fcn_ptr = fcn; + + return fcn; +} + +static tree_function_def * +finish_function (tree_parameter_list *ret_list, + octave_user_function *fcn, octave_comment_list *lc) +{ + tree_function_def *retval = 0; + + if (ret_list) + ret_list->mark_as_formal_parameters (); + + if (fcn) + { + std::string nm = fcn->name (); + std::string file = fcn->fcn_file_name (); + + std::string tmp = nm; + if (! file.empty ()) + tmp += ": " + file; + + symbol_table::cache_name (fcn->scope (), tmp); + + if (lc) + fcn->stash_leading_comment (lc); + + fcn->define_ret_list (ret_list); + + if (current_function_depth > 1 || parsing_subfunctions) + { + fcn->mark_as_subfunction (); + + if (endfunction_found && function_scopes.size () > 1) + { + symbol_table::scope_id pscope + = function_scopes[function_scopes.size ()-2]; + + symbol_table::install_nestfunction (nm, octave_value (fcn), + pscope); + } + else + symbol_table::install_subfunction (nm, octave_value (fcn), + primary_fcn_scope); + } + + if (current_function_depth == 1 && fcn) + symbol_table::update_nest (fcn->scope ()); + + if (! reading_fcn_file && current_function_depth == 1) + { + // We are either reading a script file or defining a function + // at the command line, so this definition creates a + // tree_function object that is placed in the parse tree. + // Otherwise, it is just inserted in the symbol table, + // either as a subfunction or nested function (see above), + // or as the primary function for the file, via + // primary_fcn_ptr (see also load_fcn_from_file,, + // parse_fcn_file, and + // symbol_table::fcn_info::fcn_info_rep::find_user_function). + + retval = new tree_function_def (fcn); + } + + // Unmark any symbols that may have been tagged as local + // variables while parsing (for example, by force_local_variable + // in lex.l). + + symbol_table::unmark_forced_variables (fcn->scope ()); + } + + return retval; +} + +static void +recover_from_parsing_function (void) +{ + if (parser_symtab_context.empty ()) + panic_impossible (); + + parser_symtab_context.pop (); + + if (reading_fcn_file && current_function_depth == 1 + && ! parsing_subfunctions) + parsing_subfunctions = true; + + current_function_depth--; + function_scopes.pop_back (); + + lexer_flags.defining_func--; + lexer_flags.parsed_function_name.pop (); + lexer_flags.looking_at_return_list = false; + lexer_flags.looking_at_parameter_list = false; +} + +// Make an index expression. + +static tree_index_expression * +make_index_expression (tree_expression *expr, tree_argument_list *args, + char type) +{ + tree_index_expression *retval = 0; + + if (args && args->has_magic_tilde ()) + { + yyerror ("invalid use of empty argument (~) in index expression"); + return retval; + } + + int l = expr->line (); + int c = expr->column (); + + expr->mark_postfix_indexed (); + + if (expr->is_index_expression ()) + { + tree_index_expression *tmp = static_cast (expr); + + tmp->append (args, type); + + retval = tmp; + } + else + retval = new tree_index_expression (expr, args, l, c, type); + + return retval; +} + +// Make an indirect reference expression. + +static tree_index_expression * +make_indirect_ref (tree_expression *expr, const std::string& elt) +{ + tree_index_expression *retval = 0; + + int l = expr->line (); + int c = expr->column (); + + if (expr->is_index_expression ()) + { + tree_index_expression *tmp = static_cast (expr); + + tmp->append (elt); + + retval = tmp; + } + else + retval = new tree_index_expression (expr, elt, l, c); + + lexer_flags.looking_at_indirect_ref = false; + + return retval; +} + +// Make an indirect reference expression with dynamic field name. + +static tree_index_expression * +make_indirect_ref (tree_expression *expr, tree_expression *elt) +{ + tree_index_expression *retval = 0; + + int l = expr->line (); + int c = expr->column (); + + if (expr->is_index_expression ()) + { + tree_index_expression *tmp = static_cast (expr); + + tmp->append (elt); + + retval = tmp; + } + else + retval = new tree_index_expression (expr, elt, l, c); + + lexer_flags.looking_at_indirect_ref = false; + + return retval; +} + +// Make a declaration command. + +static tree_decl_command * +make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst) +{ + tree_decl_command *retval = 0; + + int l = tok_val->line (); + int c = tok_val->column (); + + switch (tok) + { + case GLOBAL: + retval = new tree_global_command (lst, l, c); + break; + + case PERSISTENT: + if (current_function_depth > 0) + retval = new tree_persistent_command (lst, l, c); + else + { + if (reading_script_file) + warning ("ignoring persistent declaration near line %d of file `%s'", + l, curr_fcn_file_full_name.c_str ()); + else + warning ("ignoring persistent declaration near line %d", l); + } + break; + + default: + panic_impossible (); + break; + } + + return retval; +} + +static tree_argument_list * +validate_matrix_row (tree_argument_list *row) +{ + if (row && row->has_magic_tilde ()) + yyerror ("invalid use of tilde (~) in matrix expression"); + return row; +} + +// Finish building a matrix list. + +static tree_expression * +finish_matrix (tree_matrix *m) +{ + tree_expression *retval = m; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + if (m->all_elements_are_constant ()) + { + octave_value tmp = m->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, m->line (), m->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + m->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete m; + + retval = tc_retval; + } + } + + return retval; +} + +// Finish building a cell list. + +static tree_expression * +finish_cell (tree_cell *c) +{ + return finish_matrix (c); +} + +static void +maybe_warn_missing_semi (tree_statement_list *t) +{ + if (current_function_depth > 0) + { + tree_statement *tmp = t->back (); + + if (tmp->is_expression ()) + warning_with_id + ("Octave:missing-semicolon", + "missing semicolon near line %d, column %d in file `%s'", + tmp->line (), tmp->column (), curr_fcn_file_full_name.c_str ()); + } +} + +static tree_statement_list * +set_stmt_print_flag (tree_statement_list *list, char sep, + bool warn_missing_semi) +{ + tree_statement *tmp = list->back (); + + switch (sep) + { + case ';': + tmp->set_print_flag (false); + break; + + case 0: + case ',': + case '\n': + tmp->set_print_flag (true); + if (warn_missing_semi) + maybe_warn_missing_semi (list); + break; + + default: + warning ("unrecognized separator type!"); + break; + } + + // Even if a statement is null, we add it to the list then remove it + // here so that the print flag is applied to the correct statement. + + if (tmp->is_null_statement ()) + { + list->pop_back (); + delete tmp; + } + + return list; +} + +static tree_statement_list * +make_statement_list (tree_statement *stmt) +{ + return new tree_statement_list (stmt); +} + +static tree_statement_list * +append_statement_list (tree_statement_list *list, char sep, + tree_statement *stmt, bool warn_missing_semi) +{ + set_stmt_print_flag (list, sep, warn_missing_semi); + + list->append (stmt); + + return list; +} + +static void +safe_fclose (FILE *f) +{ + // FIXME -- comments at the end of an input file are + // discarded (otherwise, they would be appended to the next + // statement, possibly from the command line or another file, which + // can be quite confusing). + + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + delete tc; + + if (f) + fclose (static_cast (f)); +} + +static bool +looks_like_copyright (const std::string& s) +{ + bool retval = false; + + if (! s.empty ()) + { + size_t offset = s.find_first_not_of (" \t"); + + retval = (s.substr (offset, 9) == "Copyright" || s.substr (offset, 6) == "Author"); + } + + return retval; +} + +static int +text_getc (FILE *f) +{ + int c = gnulib::getc (f); + + // Convert CRLF into just LF and single CR into LF. + + if (c == '\r') + { + c = gnulib::getc (f); + + if (c != '\n') + { + ungetc (c, f); + c = '\n'; + } + } + + if (c == '\n') + input_line_number++; + + return c; +} + +class +stdio_stream_reader : public stream_reader +{ +public: + stdio_stream_reader (FILE *f_arg) : stream_reader (), f (f_arg) { } + + int getc (void) { return ::text_getc (f); } + int ungetc (int c) + { + if (c == '\n') + input_line_number--; + + return ::ungetc (c, f); + } + +private: + FILE *f; + + // No copying! + + stdio_stream_reader (const stdio_stream_reader&); + + stdio_stream_reader & operator = (const stdio_stream_reader&); +}; + +static bool +skip_white_space (stream_reader& reader) +{ + int c = 0; + + while ((c = reader.getc ()) != EOF) + { + switch (c) + { + case ' ': + case '\t': + current_input_column++; + break; + + case '\n': + current_input_column = 1; + break; + + default: + reader.ungetc (c); + goto done; + } + } + + done: + + return (c == EOF); +} + +static bool +looking_at_classdef_keyword (FILE *ffile) +{ + bool status = false; + + long pos = gnulib::ftell (ffile); + + char buf [10]; + gnulib::fgets (buf, 10, ffile); + size_t len = strlen (buf); + if (len > 8 && strncmp (buf, "classdef", 8) == 0 + && ! (isalnum (buf[8]) || buf[8] == '_')) + status = true; + + gnulib::fseek (ffile, pos, SEEK_SET); + + return status; + } + +static std::string +gobble_leading_white_space (FILE *ffile, bool& eof) +{ + std::string help_txt; + + eof = false; + + // TRUE means we have already cached the help text. + bool have_help_text = false; + + std::string txt; + + stdio_stream_reader stdio_reader (ffile); + + while (true) + { + eof = skip_white_space (stdio_reader); + + if (eof) + break; + + txt = grab_comment_block (stdio_reader, true, eof); + + if (txt.empty ()) + break; + + if (! (have_help_text || looks_like_copyright (txt))) + { + help_txt = txt; + have_help_text = true; + } + + octave_comment_buffer::append (txt); + + if (eof) + break; + } + + return help_txt; +} + +static bool +looking_at_function_keyword (FILE *ffile) +{ + bool status = false; + + long pos = gnulib::ftell (ffile); + + char buf [10]; + gnulib::fgets (buf, 10, ffile); + size_t len = strlen (buf); + if (len > 8 && strncmp (buf, "function", 8) == 0 + && ! (isalnum (buf[8]) || buf[8] == '_')) + status = true; + + gnulib::fseek (ffile, pos, SEEK_SET); + + return status; +} + +static octave_function * +parse_fcn_file (const std::string& ff, const std::string& dispatch_type, + bool force_script = false, bool require_file = true, + const std::string& warn_for = std::string ()) +{ + unwind_protect frame; + + octave_function *fcn_ptr = 0; + + // Open function file and parse. + + FILE *in_stream = command_editor::get_input_stream (); + + frame.add_fcn (command_editor::set_input_stream, in_stream); + + frame.protect_var (ff_instream); + + frame.protect_var (input_line_number); + frame.protect_var (current_input_column); + frame.protect_var (reading_fcn_file); + frame.protect_var (line_editing); + frame.protect_var (current_class_name); + frame.protect_var (current_function_depth); + frame.protect_var (function_scopes); + frame.protect_var (max_function_depth); + frame.protect_var (parsing_subfunctions); + frame.protect_var (endfunction_found); + + input_line_number = 1; + current_input_column = 1; + reading_fcn_file = true; + line_editing = false; + current_class_name = dispatch_type; + current_function_depth = 0; + function_scopes.clear (); + max_function_depth = 0; + parsing_subfunctions = false; + endfunction_found = false; + + frame.add_fcn (command_history::ignore_entries, + command_history::ignoring_entries ()); + + command_history::ignore_entries (); + + FILE *ffile = get_input_from_file (ff, 0); + + frame.add_fcn (safe_fclose, ffile); + + if (ffile) + { + bool eof; + + std::string help_txt = gobble_leading_white_space (ffile, eof); + + if (! help_txt.empty ()) + help_buf.push (help_txt); + + if (! eof) + { + std::string file_type; + + frame.protect_var (get_input_from_eval_string); + frame.protect_var (parser_end_of_input); + frame.protect_var (reading_fcn_file); + frame.protect_var (reading_script_file); + frame.protect_var (reading_classdef_file); + frame.protect_var (Vecho_executing_commands); + + + get_input_from_eval_string = false; + parser_end_of_input = false; + + if (! force_script && looking_at_function_keyword (ffile)) + { + file_type = "function"; + + Vecho_executing_commands = ECHO_OFF; + + reading_classdef_file = false; + reading_fcn_file = true; + reading_script_file = false; + } + else if (! force_script && looking_at_classdef_keyword (ffile)) + { + file_type = "classdef"; + + Vecho_executing_commands = ECHO_OFF; + + reading_classdef_file = true; + reading_fcn_file = false; + // FIXME -- Should classdef files be handled as + // scripts or separately? Currently, without setting up + // for reading script files, parsing classdef files + // fails. + reading_script_file = true; + } + else + { + file_type = "script"; + + Vecho_executing_commands = ECHO_OFF; + + reading_classdef_file = false; + reading_fcn_file = false; + reading_script_file = true; + } + + YY_BUFFER_STATE old_buf = current_buffer (); + YY_BUFFER_STATE new_buf = create_buffer (ffile); + + frame.add_fcn (switch_to_buffer, old_buf); + frame.add_fcn (delete_buffer, new_buf); + + switch_to_buffer (new_buf); + + frame.protect_var (primary_fcn_ptr); + primary_fcn_ptr = 0; + + reset_parser (); + + // Do this with an unwind-protect cleanup function so that + // the forced variables will be unmarked in the event of an + // interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); + + if (! help_txt.empty ()) + help_buf.push (help_txt); + + if (reading_script_file) + prep_lexer_for_script_file (); + else + prep_lexer_for_function_file (); + + lexer_flags.parsing_class_method = ! dispatch_type.empty (); + + frame.protect_var (global_command); + + global_command = 0; + + int status = yyparse (); + + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of an + // interrupt. + + frame.add_fcn (cleanup_statement_list, &global_command); + + fcn_ptr = primary_fcn_ptr; + + if (status != 0) + error ("parse error while reading %s file %s", + file_type.c_str (), ff.c_str ()); + } + else + { + tree_statement *end_of_script + = make_end ("endscript", input_line_number, current_input_column); + + make_script (0, end_of_script); + + fcn_ptr = primary_fcn_ptr; + } + } + else if (require_file) + error ("no such file, `%s'", ff.c_str ()); + else if (! warn_for.empty ()) + error ("%s: unable to open file `%s'", warn_for.c_str (), ff.c_str ()); + + return fcn_ptr; +} + +std::string +get_help_from_file (const std::string& nm, bool& symbol_found, + std::string& file) +{ + std::string retval; + + file = fcn_file_in_path (nm); + + if (! file.empty ()) + { + symbol_found = true; + + FILE *fptr = gnulib::fopen (file.c_str (), "r"); + + if (fptr) + { + unwind_protect frame; + frame.add_fcn (safe_fclose, fptr); + + bool eof; + retval = gobble_leading_white_space (fptr, eof); + + if (retval.empty ()) + { + octave_function *fcn = parse_fcn_file (file, ""); + + if (fcn) + { + retval = fcn->doc_string (); + + delete fcn; + } + } + } + } + + return retval; +} + +std::string +get_help_from_file (const std::string& nm, bool& symbol_found) +{ + std::string file; + return get_help_from_file (nm, symbol_found, file); +} + +std::string +lookup_autoload (const std::string& nm) +{ + std::string retval; + + typedef std::map::const_iterator am_iter; + + am_iter p = autoload_map.find (nm); + + if (p != autoload_map.end ()) + retval = load_path::find_file (p->second); + + return retval; +} + +string_vector +autoloaded_functions (void) +{ + string_vector names (autoload_map.size ()); + + octave_idx_type i = 0; + typedef std::map::const_iterator am_iter; + for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) + names[i++] = p->first; + + return names; +} + +string_vector +reverse_lookup_autoload (const std::string& nm) +{ + string_vector names; + + typedef std::map::const_iterator am_iter; + for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) + if (nm == p->second) + names.append (p->first); + + return names; +} + +octave_function * +load_fcn_from_file (const std::string& file_name, const std::string& dir_name, + const std::string& dispatch_type, + const std::string& fcn_name, bool autoload) +{ + octave_function *retval = 0; + + unwind_protect frame; + + std::string nm = file_name; + + size_t nm_len = nm.length (); + + std::string file; + + frame.protect_var (fcn_file_from_relative_lookup); + + fcn_file_from_relative_lookup = false; + + file = nm; + + if ((nm_len > 4 && nm.substr (nm_len-4) == ".oct") + || (nm_len > 4 && nm.substr (nm_len-4) == ".mex") + || (nm_len > 2 && nm.substr (nm_len-2) == ".m")) + { + nm = octave_env::base_pathname (file); + nm = nm.substr (0, nm.find_last_of ('.')); + + size_t pos = nm.find_last_of (file_ops::dir_sep_str ()); + if (pos != std::string::npos) + nm = nm.substr (pos+1); + } + + if (autoload) + { + frame.protect_var (autoloading); + autoloading = true; + } + + fcn_file_from_relative_lookup = ! octave_env::absolute_pathname (file); + + file = octave_env::make_absolute (file); + + int len = file.length (); + + if (len > 4 && file.substr (len-4, len-1) == ".oct") + { + if (autoload && ! fcn_name.empty ()) + nm = fcn_name; + + retval = octave_dynamic_loader::load_oct (nm, file, fcn_file_from_relative_lookup); + } + else if (len > 4 && file.substr (len-4, len-1) == ".mex") + { + // Temporarily load m-file version of mex-file, if it exists, + // to get the help-string to use. + frame.protect_var (curr_fcn_file_name); + frame.protect_var (curr_fcn_file_full_name); + + curr_fcn_file_name = nm; + curr_fcn_file_full_name = file.substr (0, len - 2); + + octave_function *tmpfcn = parse_fcn_file (file.substr (0, len - 2), + dispatch_type, autoloading, + false); + + retval = octave_dynamic_loader::load_mex (nm, file, fcn_file_from_relative_lookup); + + if (tmpfcn) + retval->document (tmpfcn->doc_string ()); + delete tmpfcn; + } + else if (len > 2) + { + // These are needed by yyparse. + + frame.protect_var (curr_fcn_file_name); + frame.protect_var (curr_fcn_file_full_name); + + curr_fcn_file_name = nm; + curr_fcn_file_full_name = file; + + retval = parse_fcn_file (file, dispatch_type, autoloading); + } + + if (retval) + { + retval->stash_dir_name (dir_name); + + if (retval->is_user_function ()) + { + symbol_table::scope_id id = retval->scope (); + + symbol_table::stash_dir_name_for_subfunctions (id, dir_name); + } + } + + return retval; +} + +DEFUN (autoload, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} autoload (@var{function}, @var{file})\n\ +Define @var{function} to autoload from @var{file}.\n\ +\n\ +The second argument, @var{file}, should be an absolute file name or\n\ +a file name in the same directory as the function or script from which\n\ +the autoload command was run. @var{file} should not depend on the\n\ +Octave load path.\n\ +\n\ +Normally, calls to @code{autoload} appear in PKG_ADD script files that\n\ +are evaluated when a directory is added to the Octave's load path. To\n\ +avoid having to hardcode directory names in @var{file}, if @var{file}\n\ +is in the same directory as the PKG_ADD script then\n\ +\n\ +@example\n\ +autoload (\"foo\", \"bar.oct\");\n\ +@end example\n\ +\n\ +@noindent\n\ +will load the function @code{foo} from the file @code{bar.oct}. The above\n\ +when @code{bar.oct} is not in the same directory or uses like\n\ +\n\ +@example\n\ +autoload (\"foo\", file_in_loadpath (\"bar.oct\"))\n\ +@end example\n\ +\n\ +@noindent\n\ +are strongly discouraged, as their behavior might be unpredictable.\n\ +\n\ +With no arguments, return a structure containing the current autoload map.\n\ +@seealso{PKG_ADD}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + { + Cell func_names (dim_vector (autoload_map.size (), 1)); + Cell file_names (dim_vector (autoload_map.size (), 1)); + + octave_idx_type i = 0; + typedef std::map::const_iterator am_iter; + for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) + { + func_names(i) = p->first; + file_names(i) = p->second; + + i++; + } + + octave_map m; + + m.assign ("function", func_names); + m.assign ("file", file_names); + + retval = m; + } + else if (nargin == 2) + { + string_vector argv = args.make_argv ("autoload"); + + if (! error_state) + { + std::string nm = argv[2]; + + if (! octave_env::absolute_pathname (nm)) + { + octave_user_code *fcn = octave_call_stack::caller_user_code (); + + bool found = false; + + if (fcn) + { + std::string fname = fcn->fcn_file_name (); + + if (! fname.empty ()) + { + fname = octave_env::make_absolute (fname); + fname = fname.substr (0, fname.find_last_of (file_ops::dir_sep_str ()) + 1); + + file_stat fs (fname + nm); + + if (fs.exists ()) + { + nm = fname + nm; + found = true; + } + } + } + if (! found) + warning_with_id ("Octave:autoload-relative-file-name", + "autoload: `%s' is not an absolute file name", + nm.c_str ()); + } + autoload_map[argv[1]] = nm; + } + } + else + print_usage (); + + return retval; +} + +void +source_file (const std::string& file_name, const std::string& context, + bool verbose, bool require_file, const std::string& warn_for) +{ + // Map from absolute name of script file to recursion level. We + // use a map instead of simply placing a limit on recursion in the + // source_file function so that two mutually recursive scripts + // written as + // + // foo1.m: + // ------ + // foo2 + // + // foo2.m: + // ------ + // foo1 + // + // and called with + // + // foo1 + // + // (for example) will behave the same if they are written as + // + // foo1.m: + // ------ + // source ("foo2.m") + // + // foo2.m: + // ------ + // source ("foo1.m") + // + // and called with + // + // source ("foo1.m") + // + // (for example). + + static std::map source_call_depth; + + std::string file_full_name = file_ops::tilde_expand (file_name); + + file_full_name = octave_env::make_absolute (file_full_name); + + unwind_protect frame; + + frame.protect_var (curr_fcn_file_name); + frame.protect_var (curr_fcn_file_full_name); + + curr_fcn_file_name = file_name; + curr_fcn_file_full_name = file_full_name; + + if (source_call_depth.find (file_full_name) == source_call_depth.end ()) + source_call_depth[file_full_name] = -1; + + frame.protect_var (source_call_depth[file_full_name]); + + source_call_depth[file_full_name]++; + + if (source_call_depth[file_full_name] >= Vmax_recursion_depth) + { + error ("max_recursion_depth exceeded"); + return; + } + + if (! context.empty ()) + { + if (context == "caller") + octave_call_stack::goto_caller_frame (); + else if (context == "base") + octave_call_stack::goto_base_frame (); + else + error ("source: context must be \"caller\" or \"base\""); + + if (! error_state) + frame.add_fcn (octave_call_stack::pop); + } + + if (! error_state) + { + octave_function *fcn = parse_fcn_file (file_full_name, "", true, + require_file, warn_for); + + if (! error_state) + { + if (fcn && fcn->is_user_script ()) + { + octave_value_list args; + + if (verbose) + { + std::cout << "executing commands from " << file_full_name << " ... "; + reading_startup_message_printed = true; + std::cout.flush (); + } + + fcn->do_multi_index_op (0, args); + + if (verbose) + std::cout << "done." << std::endl; + + delete fcn; + } + } + else + error ("source: error sourcing file `%s'", + file_full_name.c_str ()); + } +} + +DEFUN (mfilename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mfilename ()\n\ +@deftypefnx {Built-in Function} {} mfilename (\"fullpath\")\n\ +@deftypefnx {Built-in Function} {} mfilename (\"fullpathext\")\n\ +Return the name of the currently executing file. At the top-level,\n\ +return the empty string. Given the argument @code{\"fullpath\"},\n\ +include the directory part of the file name, but not the extension.\n\ +Given the argument @code{\"fullpathext\"}, include the directory part\n\ +of the file name and the extension.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin > 1) + { + print_usage (); + return retval; + } + + std::string arg; + + if (nargin == 1) + { + arg = args(0).string_value (); + + if (error_state) + { + error ("mfilename: expecting argument to be a character string"); + return retval; + } + } + + std::string fname; + + octave_user_code *fcn = octave_call_stack::caller_user_code (); + + if (fcn) + { + fname = fcn->fcn_file_name (); + + if (fname.empty ()) + fname = fcn->name (); + } + + if (arg == "fullpathext") + retval = fname; + else + { + size_t dpos = fname.rfind (file_ops::dir_sep_char ()); + size_t epos = fname.rfind ('.'); + + if (epos <= dpos) + epos = std::string::npos; + + fname = (epos != std::string::npos) ? fname.substr (0, epos) : fname; + + if (arg == "fullpath") + retval = fname; + else + retval = (dpos != std::string::npos) ? fname.substr (dpos+1) : fname; + } + + return retval; +} + + +DEFUN (source, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} source (@var{file})\n\ +Parse and execute the contents of @var{file}. This is equivalent to\n\ +executing commands from a script file, but without requiring the file to\n\ +be named @file{@var{file}.m}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string file_name = args(0).string_value (); + + if (! error_state) + { + std::string context; + + if (nargin == 2) + context = args(1).string_value (); + + if (! error_state) + source_file (file_name, context); + else + error ("source: expecting context to be character string"); + } + else + error ("source: expecting file name as argument"); + } + else + print_usage (); + + return retval; +} + +// Evaluate an Octave function (built-in or interpreted) and return +// the list of result values. NAME is the name of the function to +// call. ARGS are the arguments to the function. NARGOUT is the +// number of output arguments expected. + +octave_value_list +feval (const std::string& name, const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + octave_value fcn = symbol_table::find_function (name, args); + + if (fcn.is_defined ()) + retval = fcn.do_multi_index_op (nargout, args); + else + { + maybe_missing_function_hook (name); + if (! error_state) + error ("feval: function `%s' not found", name.c_str ()); + } + + return retval; +} + +octave_value_list +feval (octave_function *fcn, const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + if (fcn) + retval = fcn->do_multi_index_op (nargout, args); + + return retval; +} + +static octave_value_list +get_feval_args (const octave_value_list& args) +{ + return args.slice (1, args.length () - 1, true); +} + + +// Evaluate an Octave function (built-in or interpreted) and return +// the list of result values. The first element of ARGS should be a +// string containing the name of the function to call, then the rest +// are the actual arguments to the function. NARGOUT is the number of +// output arguments expected. + +octave_value_list +feval (const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + octave_value f_arg = args(0); + + if (f_arg.is_string ()) + { + std::string name = f_arg.string_value (); + + if (! error_state) + { + octave_value_list tmp_args = get_feval_args (args); + + retval = feval (name, tmp_args, nargout); + } + } + else if (f_arg.is_function_handle () + || f_arg.is_anonymous_function () + || f_arg.is_inline_function ()) + { + const octave_value_list tmp_args = get_feval_args (args); + + retval = f_arg.do_multi_index_op (nargout, tmp_args); + } + else + error ("feval: first argument must be a string, inline function or a function handle"); + } + + return retval; +} + +DEFUN (feval, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} feval (@var{name}, @dots{})\n\ +Evaluate the function named @var{name}. Any arguments after the first\n\ +are passed on to the named function. For example,\n\ +\n\ +@example\n\ +@group\n\ +feval (\"acos\", -1)\n\ + @result{} 3.1416\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +calls the function @code{acos} with the argument @samp{-1}.\n\ +\n\ +The function @code{feval} can also be used with function handles of\n\ +any sort (@pxref{Function Handles}). Historically, @code{feval} was\n\ +the only way to call user-supplied functions in strings, but\n\ +function handles are now preferred due to the cleaner syntax they\n\ +offer. For example,\n\ +\n\ +@example\n\ +@group\n\ +@var{f} = @@exp;\n\ +feval (@var{f}, 1)\n\ + @result{} 2.7183\n\ +@var{f} (1)\n\ + @result{} 2.7183\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +are equivalent ways to call the function referred to by @var{f}. If it\n\ +cannot be predicted beforehand that @var{f} is a function handle or the\n\ +function name in a string, @code{feval} can be used instead.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + retval = feval (args, nargout); + else + print_usage (); + + return retval; +} + +DEFUN (builtin, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@dots{}]} builtin (@var{f}, @dots{})\n\ +Call the base function @var{f} even if @var{f} is overloaded to\n\ +another function for the given type signature.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + const std::string name (args(0).string_value ()); + + if (! error_state) + { + octave_value fcn = symbol_table::builtin_find (name); + + if (fcn.is_defined ()) + retval = feval (fcn.function_value (), args.splice (0, 1), + nargout); + else + error ("builtin: lookup for symbol `%s' failed", name.c_str ()); + } + else + error ("builtin: function name (F) must be a string"); + } + else + print_usage (); + + return retval; +} + +octave_value_list +eval_string (const std::string& s, bool silent, int& parse_status, int nargout) +{ + octave_value_list retval; + + unwind_protect frame; + + frame.protect_var (input_line_number); + frame.protect_var (current_input_column); + frame.protect_var (get_input_from_eval_string); + frame.protect_var (input_from_eval_string_pending); + frame.protect_var (parser_end_of_input); + frame.protect_var (line_editing); + frame.protect_var (current_eval_string); + frame.protect_var (current_function_depth); + frame.protect_var (function_scopes); + frame.protect_var (max_function_depth); + frame.protect_var (parsing_subfunctions); + frame.protect_var (endfunction_found); + frame.protect_var (reading_fcn_file); + frame.protect_var (reading_script_file); + frame.protect_var (reading_classdef_file); + + input_line_number = 1; + current_input_column = 1; + get_input_from_eval_string = true; + input_from_eval_string_pending = true; + parser_end_of_input = false; + line_editing = false; + current_function_depth = 0; + function_scopes.clear (); + max_function_depth = 0; + parsing_subfunctions = false; + endfunction_found = false; + reading_fcn_file = false; + reading_script_file = false; + reading_classdef_file = false; + + current_eval_string = s; + + YY_BUFFER_STATE old_buf = current_buffer (); + YY_BUFFER_STATE new_buf = create_buffer (0); + + frame.add_fcn (switch_to_buffer, old_buf); + frame.add_fcn (delete_buffer, new_buf); + + switch_to_buffer (new_buf); + + do + { + reset_parser (); + + frame.protect_var (global_command); + + global_command = 0; + + // Do this with an unwind-protect cleanup function so that the + // forced variables will be unmarked in the event of an + // interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); + + parse_status = yyparse (); + + tree_statement_list *command_list = global_command; + + // Unmark forced variables. + // Restore previous value of global_command. + frame.run_top (2); + + if (parse_status == 0) + { + if (command_list) + { + unwind_protect inner_frame; + + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of an + // interrupt. + + inner_frame.add_fcn (cleanup_statement_list, &command_list); + + tree_statement *stmt = 0; + + if (command_list->length () == 1 + && (stmt = command_list->front ()) + && stmt->is_expression ()) + { + tree_expression *expr = stmt->expression (); + + if (silent) + expr->set_print_flag (false); + + bool do_bind_ans = false; + + if (expr->is_identifier ()) + { + tree_identifier *id + = dynamic_cast (expr); + + do_bind_ans = (! id->is_variable ()); + } + else + do_bind_ans = (! expr->is_assignment_expression ()); + + retval = expr->rvalue (nargout); + + if (do_bind_ans && ! (error_state || retval.empty ())) + bind_ans (retval(0), expr->print_result ()); + + if (nargout == 0) + retval = octave_value_list (); + } + else if (nargout == 0) + command_list->accept (*current_evaluator); + else + error ("eval: invalid use of statement list"); + + if (error_state + || tree_return_command::returning + || tree_break_command::breaking + || tree_continue_command::continuing) + break; + } + else if (parser_end_of_input) + break; + } + } + while (parse_status == 0); + + return retval; +} + +octave_value +eval_string (const std::string& s, bool silent, int& parse_status) +{ + octave_value retval; + + octave_value_list tmp = eval_string (s, silent, parse_status, 1); + + if (! tmp.empty ()) + retval = tmp(0); + + return retval; +} + +static octave_value_list +eval_string (const octave_value& arg, bool silent, int& parse_status, + int nargout) +{ + std::string s = arg.string_value (); + + if (error_state) + { + error ("eval: expecting std::string argument"); + return octave_value (-1); + } + + return eval_string (s, silent, parse_status, nargout); +} + +void +cleanup_statement_list (tree_statement_list **lst) +{ + if (*lst) + { + delete *lst; + *lst = 0; + } +} + +DEFUN (eval, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eval (@var{try})\n\ +@deftypefnx {Built-in Function} {} eval (@var{try}, @var{catch})\n\ +Parse the string @var{try} and evaluate it as if it were an Octave\n\ +program. If that fails, evaluate the optional string @var{catch}.\n\ +The string @var{try} is evaluated in the current context,\n\ +so any results remain available after @code{eval} returns.\n\ +\n\ +The following example makes the variable @var{a} with the approximate\n\ +value 3.1416 available.\n\ +\n\ +@example\n\ +eval (\"a = acos(-1);\");\n\ +@end example\n\ +\n\ +If an error occurs during the evaluation of @var{try} the @var{catch}\n\ +string is evaluated, as the following example shows:\n\ +\n\ +@example\n\ +@group\n\ +eval ('error (\"This is a bad example\");',\n\ + 'printf (\"This error occurred:\\n%s\\n\", lasterr ());');\n\ + @print{} This error occurred:\n\ + This is a bad example\n\ +@end group\n\ +@end example\n\ +\n\ +Consider using try/catch blocks instead if you are only using @code{eval}\n\ +as an error-capturing mechanism rather than for the execution of arbitrary\n\ +code strings.\n\ +@seealso{evalin}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + unwind_protect frame; + + if (nargin > 1) + { + frame.protect_var (buffer_error_messages); + buffer_error_messages++; + } + + int parse_status = 0; + + octave_value_list tmp = eval_string (args(0), nargout > 0, + parse_status, nargout); + + if (nargin > 1 && (parse_status != 0 || error_state)) + { + error_state = 0; + + // Set up for letting the user print any messages from + // errors that occurred in the first part of this eval(). + + buffer_error_messages--; + + tmp = eval_string (args(1), nargout > 0, parse_status, nargout); + + if (nargout > 0) + retval = tmp; + } + else if (nargout > 0) + retval = tmp; + } + else + print_usage (); + + return retval; +} + +/* + +%!shared x +%! x = 1; + +%!assert (eval ("x"), 1) +%!assert (eval ("x;")) +%!assert (eval ("x;"), 1); + +%!test +%! y = eval ("x"); +%! assert (y, 1); + +%!test +%! y = eval ("x;"); +%! assert (y, 1); + +%!test +%! eval ("x = 1;") +%! assert (x,1); + +%!test +%! eval ("flipud = 2;"); +%! assert (flipud, 2); + +%!function y = __f () +%! eval ("flipud = 2;"); +%! y = flipud; +%!endfunction +%!assert (__f(), 2) + +% bug #35645 +%!test +%! [a,] = gcd (1,2); +%! [a,b,] = gcd (1, 2); + +*/ + +DEFUN (assignin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} assignin (@var{context}, @var{varname}, @var{value})\n\ +Assign @var{value} to @var{varname} in context @var{context}, which\n\ +may be either @code{\"base\"} or @code{\"caller\"}.\n\ +@seealso{evalin}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 3) + { + std::string context = args(0).string_value (); + + if (! error_state) + { + unwind_protect frame; + + if (context == "caller") + octave_call_stack::goto_caller_frame (); + else if (context == "base") + octave_call_stack::goto_base_frame (); + else + error ("assignin: CONTEXT must be \"caller\" or \"base\""); + + if (! error_state) + { + frame.add_fcn (octave_call_stack::pop); + + std::string nm = args(1).string_value (); + + if (! error_state) + { + if (valid_identifier (nm)) + symbol_table::varref (nm) = args(2); + else + error ("assignin: invalid variable name in argument VARNAME"); + } + else + error ("assignin: VARNAME must be a string"); + } + } + else + error ("assignin: CONTEXT must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (evalin, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} evalin (@var{context}, @var{try})\n\ +@deftypefnx {Built-in Function} {} evalin (@var{context}, @var{try}, @var{catch})\n\ +Like @code{eval}, except that the expressions are evaluated in the\n\ +context @var{context}, which may be either @code{\"caller\"} or\n\ +@code{\"base\"}.\n\ +@seealso{eval, assignin}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 1) + { + std::string context = args(0).string_value (); + + if (! error_state) + { + unwind_protect frame; + + if (context == "caller") + octave_call_stack::goto_caller_frame (); + else if (context == "base") + octave_call_stack::goto_base_frame (); + else + error ("evalin: CONTEXT must be \"caller\" or \"base\""); + + if (! error_state) + { + frame.add_fcn (octave_call_stack::pop); + + if (nargin > 2) + { + frame.protect_var (buffer_error_messages); + buffer_error_messages++; + } + + int parse_status = 0; + + octave_value_list tmp = eval_string (args(1), nargout > 0, + parse_status, nargout); + + if (nargout > 0) + retval = tmp; + + if (nargin > 2 && (parse_status != 0 || error_state)) + { + error_state = 0; + + // Set up for letting the user print any messages from + // errors that occurred in the first part of this eval(). + + buffer_error_messages--; + + tmp = eval_string (args(2), nargout > 0, + parse_status, nargout); + + retval = (nargout > 0) ? tmp : octave_value_list (); + } + } + } + else + error ("evalin: CONTEXT must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__parser_debug_flag__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{old_val} =} __parser_debug_flag__ (@var{new_val}))\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + bool debug_flag = octave_debug; + + retval = set_internal_variable (debug_flag, args, nargout, + "__parser_debug_flag__"); + + octave_debug = debug_flag; + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/parse-private.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/parse-private.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,96 @@ +/* + +Copyright (C) 2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_parse_private_h) +#define octave_parse_private_h 1 + +#include + +#include "symtab.h" + +// Keep track of symbol table information when parsing functions. +class symtab_context +{ +private: + + class frame + { + public: + frame (symbol_table::scope_id s, symbol_table::scope_id c) + : m_scope (s), m_context (c) { } + + frame (const frame& f) : m_scope (f.m_scope), m_context (f.m_context) { } + + frame& operator = (const frame& f) + { + if (&f != this) + { + m_scope = f.m_scope; + m_context = f.m_context; + } + + return *this; + } + + ~frame (void) { } + + symbol_table::scope_id scope (void) const { return m_scope; } + symbol_table::scope_id context (void) const { return m_context; } + + private: + + symbol_table::scope_id m_scope; + symbol_table::scope_id m_context; + }; + + std::stack frame_stack; + +public: + symtab_context (void) : frame_stack () { } + + void clear (void) + { + while (! frame_stack.empty ()) + frame_stack.pop (); + } + + bool empty (void) const { return frame_stack.empty (); } + + void pop (void) + { + frame tmp = frame_stack.top (); + + symbol_table::set_scope_and_context (tmp.scope (), tmp.context ()); + + frame_stack.pop (); + } + + void push (void) + { + frame_stack.push (frame (symbol_table::current_scope (), + symbol_table::current_context ())); + } +}; + +extern symtab_context parser_symtab_context; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/parse.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/parse.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,116 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_parse_h) +#define octave_parse_h 1 + +#include + +#include + +#include + +extern void reset_parser (void); +extern int octave_lex (void); +extern int octave_parse (void); + +class tree; +class tree_matrix; +class tree_identifier; +class tree_statement_list; +class octave_function; + +#include "oct-obj.h" + +// Nonzero means print parser debugging info (-d). +extern int octave_debug; + +// The current input line number. +extern int input_line_number; + +// The column of the current token. +extern int current_input_column; + +// Buffer for help text snagged from function files. +extern std::stack help_buf; + +// TRUE means we are using readline. +extern bool line_editing; + +// TRUE means we printed messages about reading startup files. +extern bool reading_startup_message_printed; + +// TRUE means input is coming from startup file. +extern bool input_from_startup_file; + +// Name of the current class when we are parsing class methods or +// constructors. +extern std::string current_class_name; + +extern OCTINTERP_API std::string +get_help_from_file (const std::string& nm, bool& symbol_found, + std::string& file); + +extern OCTINTERP_API std::string +get_help_from_file (const std::string& nm, bool& symbol_found); + +extern OCTINTERP_API std::string lookup_autoload (const std::string& nm); + +extern OCTINTERP_API string_vector autoloaded_functions (void); + +extern OCTINTERP_API string_vector reverse_lookup_autoload (const std::string& nm); + +extern OCTINTERP_API octave_function * +load_fcn_from_file (const std::string& file_name, + const std::string& dir_name = std::string (), + const std::string& dispatch_type = std::string (), + const std::string& fcn_name = std::string (), + bool autoload = false); + +extern OCTINTERP_API void +source_file (const std::string& file_name, + const std::string& context = std::string (), + bool verbose = false, bool require_file = true, + const std::string& warn_for = std::string ()); + +extern OCTINTERP_API octave_value_list +feval (const std::string& name, + const octave_value_list& args = octave_value_list (), + int nargout = 0); + +extern OCTINTERP_API octave_value_list +feval (octave_function *fcn, + const octave_value_list& args = octave_value_list (), + int nargout = 0); + +extern OCTINTERP_API octave_value_list +feval (const octave_value_list& args, int nargout = 0); + +extern OCTINTERP_API octave_value_list +eval_string (const std::string&, bool silent, int& parse_status, int hargout); + +extern OCTINTERP_API octave_value +eval_string (const std::string&, bool silent, int& parse_status); + +extern OCTINTERP_API void cleanup_statement_list (tree_statement_list **lst); + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-all.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-all.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,54 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_all_h) +#define octave_tree_all_h 1 + +#include "pt.h" +#include "pt-arg-list.h" +#include "pt-assign.h" +#include "pt-bp.h" +#include "pt-binop.h" +#include "pt-cbinop.h" +#include "pt-check.h" +#include "pt-cmd.h" +#include "pt-colon.h" +#include "pt-const.h" +#include "pt-decl.h" +#include "pt-except.h" +#include "pt-exp.h" +#include "pt-fcn-handle.h" +#include "pt-id.h" +#include "pt-idx.h" +#include "pt-jump.h" +#include "pt-loop.h" +#include "pt-mat.h" +#include "pt-cell.h" +#include "pt-misc.h" +#include "pt-pr-code.h" +#include "pt-select.h" +#include "pt-stmt.h" +#include "pt-unop.h" +#include "pt-pr-code.h" +#include "pt-walk.h" + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-arg-list.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-arg-list.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,286 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "str-vec.h" + +#include "defun.h" +#include "error.h" +#include "oct-lvalue.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-usr-fcn.h" +#include "parse.h" +#include "pt-arg-list.h" +#include "pt-exp.h" +#include "pt-id.h" +#include "pt-pr-code.h" +#include "pt-walk.h" +#include "toplev.h" +#include "unwind-prot.h" + +// Argument lists. + +tree_argument_list::~tree_argument_list (void) +{ + while (! empty ()) + { + iterator p = begin (); + delete *p; + erase (p); + } +} + +bool +tree_argument_list::has_magic_end (void) const +{ + for (const_iterator p = begin (); p != end (); p++) + { + tree_expression *elt = *p; + + if (elt && elt->has_magic_end ()) + return true; + } + + return false; +} + +void +tree_argument_list::append (const element_type& s) +{ + octave_base_list::append (s); + + if (! list_includes_magic_end && s && s->has_magic_end ()) + list_includes_magic_end = true; + + if (! list_includes_magic_tilde && s && s->is_identifier ()) + { + tree_identifier *id = dynamic_cast (s); + list_includes_magic_tilde = id && id->is_black_hole (); + } +} + +bool +tree_argument_list::all_elements_are_constant (void) const +{ + for (const_iterator p = begin (); p != end (); p++) + { + tree_expression *elt = *p; + + if (! elt->is_constant ()) + return false; + } + + return true; +} + +static const octave_value *indexed_object = 0; +static int index_position = 0; +static int num_indices = 0; + +DEFCONSTFUN (__end__, , , + "internal function") +{ + octave_value retval; + + if (indexed_object) + { + if (indexed_object->is_object ()) + { + octave_value_list args; + + args(2) = num_indices; + args(1) = index_position + 1; + args(0) = *indexed_object; + + std::string class_name = indexed_object->class_name (); + + octave_value meth = symbol_table::find_method ("end", class_name); + + if (meth.is_defined ()) + return feval (meth.function_value (), args, 1); + } + + dim_vector dv = indexed_object->dims (); + int ndims = dv.length (); + + if (num_indices < ndims) + { + for (int i = num_indices; i < ndims; i++) + dv(num_indices-1) *= dv(i); + + if (num_indices == 1) + { + ndims = 2; + dv.resize (ndims); + dv(1) = 1; + } + else + { + ndims = num_indices; + dv.resize (ndims); + } + } + + if (index_position < ndims) + retval = dv(index_position); + else + retval = 1; + } + else + ::error ("invalid use of end"); + + return retval; +} + +octave_value_list +tree_argument_list::convert_to_const_vector (const octave_value *object) +{ + // END doesn't make sense for functions. Maybe we need a different + // way of asking an octave_value object this question? + + bool stash_object = (list_includes_magic_end + && object + && ! (object->is_function () + || object->is_function_handle ())); + + unwind_protect frame; + + if (stash_object) + { + frame.protect_var (indexed_object); + + indexed_object = object; + } + + int len = length (); + + std::list args; + + iterator p = begin (); + for (int k = 0; k < len; k++) + { + if (stash_object) + { + frame.protect_var (index_position); + frame.protect_var (num_indices); + + index_position = k; + num_indices = len; + } + + tree_expression *elt = *p++; + + if (elt) + { + octave_value tmp = elt->rvalue1 (); + + if (error_state) + { + ::error ("evaluating argument list element number %d", k+1); + args.clear (); + break; + } + else + { + if (tmp.is_cs_list ()) + args.push_back (tmp.list_value ()); + else if (tmp.is_defined ()) + args.push_back (tmp); + } + } + else + { + args.push_back (octave_value ()); + break; + } + } + + return args; +} + +std::list +tree_argument_list::lvalue_list (void) +{ + std::list retval; + + for (tree_argument_list::iterator p = begin (); + p != end (); + p++) + { + tree_expression *elt = *p; + + retval.push_back (elt->lvalue ()); + } + + return retval; +} + +string_vector +tree_argument_list::get_arg_names (void) const +{ + int len = length (); + + string_vector retval (len); + + int k = 0; + + for (const_iterator p = begin (); p != end (); p++) + { + tree_expression *elt = *p; + + retval(k++) = elt->str_print_code (); + } + + return retval; +} + +tree_argument_list * +tree_argument_list::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_argument_list *new_list = new tree_argument_list (); + + new_list->list_includes_magic_end = list_includes_magic_end; + new_list->simple_assign_lhs = simple_assign_lhs; + + for (const_iterator p = begin (); p != end (); p++) + { + const tree_expression *elt = *p; + + new_list->append (elt ? elt->dup (scope, context) : 0); + } + + return new_list; +} + +void +tree_argument_list::accept (tree_walker& tw) +{ + tw.visit_argument_list (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-arg-list.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-arg-list.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,105 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_arg_list_h) +#define octave_tree_arg_list_h 1 + +#include + +class octave_value_list; +class octave_lvalue; +class tree_expression; +class tree_walker; + +#include "str-vec.h" + +#include "base-list.h" + +// Argument lists. Used to hold the list of expressions that are the +// arguments in a function call or index expression. + +class +tree_argument_list : public octave_base_list +{ +public: + + typedef tree_expression* element_type; + + tree_argument_list (void) + : list_includes_magic_end (false), list_includes_magic_tilde (false), + simple_assign_lhs (false) { } + + tree_argument_list (tree_expression *t) + : list_includes_magic_end (false), list_includes_magic_tilde (false), + simple_assign_lhs (false) + { append (t); } + + ~tree_argument_list (void); + + bool has_magic_end (void) const; + + bool has_magic_tilde (void) const + { return list_includes_magic_tilde; } + + tree_expression *remove_front (void) + { + iterator p = begin (); + tree_expression *retval = *p; + erase (p); + return retval; + } + + void append (const element_type& s); + + void mark_as_simple_assign_lhs (void) { simple_assign_lhs = true; } + + bool is_simple_assign_lhs (void) { return simple_assign_lhs; } + + bool all_elements_are_constant (void) const; + + octave_value_list convert_to_const_vector (const octave_value *object = 0); + + std::list lvalue_list (void); + + string_vector get_arg_names (void) const; + + tree_argument_list *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + bool list_includes_magic_end; + + bool list_includes_magic_tilde; + + bool simple_assign_lhs; + + // No copying! + + tree_argument_list (const tree_argument_list&); + + tree_argument_list& operator = (const tree_argument_list&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-assign.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-assign.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,530 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "pager.h" +#include "ov.h" +#include "pt-arg-list.h" +#include "pt-bp.h" +#include "pt-assign.h" +#include "pt-walk.h" +#include "utils.h" +#include "variables.h" + +// Simple assignment expressions. + +// FIXME -- the following variable and the function that uses it +// should be removed from some future version of Octave. + +static const char *former_built_in_variables[] = +{ + "DEFAULT_EXEC_PATH", + "DEFAULT_LOADPATH", + "EDITOR", + "EXEC_PATH", + "FFTW_WISDOM_PROGRAM", + "IMAGEPATH", + "INFO_FILE", + "INFO_PROGRAM", + "LOADPATH", + "MAKEINFO_PROGRAM", + "PAGER", + "PS1", + "PS2", + "PS4", + "__kluge_procbuf_delay__", + "automatic_replot", + "beep_on_error", + "completion_append_char", + "crash_dumps_octave_core", + "current_script_file_name", + "debug_on_error", + "debug_on_interrupt", + "debug_on_warning", + "debug_symtab_lookups", + "default_save_options", + "echo_executing_commands", + "fixed_point_format", + "gnuplot_binary", + "gnuplot_command_axes", + "gnuplot_command_end", + "gnuplot_command_plot", + "gnuplot_command_replot", + "gnuplot_command_splot", + "gnuplot_command_title", + "gnuplot_command_using", + "gnuplot_command_with", + "gnuplot_has_frames", + "history_file", + "history_size", + "ignore_function_time_stamp", + "max_recursion_depth", + "octave_core_file_format", + "octave_core_file_limit", + "octave_core_file_name", + "output_max_field_width", + "output_precision", + "page_output_immediately", + "page_screen_output", + "print_answer_id_name", + "print_empty_dimensions", + "print_rhs_assign_val", + "save_header_format_string", + "save_precision", + "saving_history", + "sighup_dumps_octave_core", + "sigterm_dumps_octave_core", + "silent_functions", + "split_long_rows", + "string_fill_char", + "struct_levels_to_print", + "suppress_verbose_help_message", + "variables_can_hide_functions", + "warn_assign_as_truth_value", + "warn_associativity_change", + "warn_divide_by_zero", + "warn_empty_list_elements", + "warn_fortran_indexing", + "warn_function_name_clash", + "warn_future_time_stamp", + "warn_imag_to_real", + "warn_matlab_incompatible", + "warn_missing_semicolon", + "warn_neg_dim_as_zero", + "warn_num_to_str", + "warn_precedence_change", + "warn_reload_forces_clear", + "warn_resize_on_range_error", + "warn_separator_insert", + "warn_single_quote_string", + "warn_str_to_num", + "warn_undefined_return_values", + "warn_variable_switch_label", + "whos_line_format", + 0, +}; + +static void +maybe_warn_former_built_in_variable (const std::string& nm) +{ + static bool initialized = false; + + static std::set vars; + + if (! initialized) + { + const char **p = former_built_in_variables; + + while (*p) + vars.insert (*p++); + + initialized = true; + } + + if (vars.find (nm) != vars.end ()) + { + const char *nm_c_str = nm.c_str (); + + warning_with_id ("Octave:built-in-variable-assignment", + "\ +In recent versions of Octave, %s is a function instead\n\ +of a built-in variable.\n\n\ +By assigning to %s, you have created a variable that hides\n\ +the function %s. To remove the variable and restore the \n\ +function, type \"clear %s\"\n", + nm_c_str, nm_c_str, nm_c_str, nm_c_str); + } +} + +tree_simple_assignment::tree_simple_assignment + (tree_expression *le, tree_expression *re, + bool plhs, int l, int c, octave_value::assign_op t) + : tree_expression (l, c), lhs (le), rhs (re), preserve (plhs), etype (t), + first_execution (true) { } + +tree_simple_assignment::~tree_simple_assignment (void) +{ + if (! preserve) + delete lhs; + + delete rhs; +} + +octave_value_list +tree_simple_assignment::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("invalid number of output arguments for expression X = RHS"); + else + retval = rvalue1 (nargout); + + return retval; +} + +octave_value +tree_simple_assignment::rvalue1 (int) +{ + octave_value retval; + + if (first_execution && lhs) + maybe_warn_former_built_in_variable (lhs->name ()); + + if (error_state) + return retval; + + if (rhs) + { + octave_value rhs_val = rhs->rvalue1 (); + + if (! error_state) + { + if (rhs_val.is_undefined ()) + { + error ("value on right hand side of assignment is undefined"); + return retval; + } + else + { + if (rhs_val.is_cs_list ()) + { + const octave_value_list lst = rhs_val.list_value (); + + if (! lst.empty ()) + rhs_val = lst(0); + else + { + error ("invalid number of elements on RHS of assignment"); + return retval; + } + } + + octave_lvalue ult = lhs->lvalue (); + + if (ult.numel () != 1) + gripe_nonbraced_cs_list_assignment (); + + if (! error_state) + { + ult.assign (etype, rhs_val); + + if (! error_state) + { + if (etype == octave_value::op_asn_eq) + retval = rhs_val; + else + retval = ult.value (); + + if (print_result ()) + { + // We clear any index here so that we can + // get the new value of the referenced + // object below, instead of the indexed + // value (which should be the same as the + // right hand side value). + + ult.clear_index (); + + octave_value lhs_val = ult.value (); + + if (! error_state) + lhs_val.print_with_name (octave_stdout, + lhs->name ()); + } + } + } + } + } + } + + first_execution = false; + + return retval; +} + +std::string +tree_simple_assignment::oper (void) const +{ + return octave_value::assign_op_as_string (etype); +} + +tree_expression * +tree_simple_assignment::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_simple_assignment *new_sa + = new tree_simple_assignment (lhs ? lhs->dup (scope, context) : 0, + rhs ? rhs->dup (scope, context) : 0, + preserve, etype); + + new_sa->copy_base (*this); + + return new_sa; +} + +void +tree_simple_assignment::accept (tree_walker& tw) +{ + tw.visit_simple_assignment (*this); +} + +// Multi-valued assignment expressions. + +tree_multi_assignment::tree_multi_assignment + (tree_argument_list *lst, tree_expression *r, + bool plhs, int l, int c) + : tree_expression (l, c), lhs (lst), rhs (r), preserve (plhs), + first_execution (true) { } + +tree_multi_assignment::~tree_multi_assignment (void) +{ + if (! preserve) + delete lhs; + + delete rhs; +} + +octave_value +tree_multi_assignment::rvalue1 (int nargout) +{ + octave_value retval; + + const octave_value_list tmp = rvalue (nargout); + + if (! tmp.empty ()) + retval = tmp(0); + + return retval; +} + +// FIXME -- this works, but it would look a little better if +// it were broken up into a couple of separate functions. + +octave_value_list +tree_multi_assignment::rvalue (int) +{ + octave_value_list retval; + + if (error_state) + return retval; + + if (first_execution) + { + for (tree_argument_list::iterator p = lhs->begin (); p != lhs->end (); p++) + { + tree_expression *lhs_expr = *p; + + if (lhs_expr) + maybe_warn_former_built_in_variable (lhs_expr->name ()); + } + } + + if (rhs) + { + std::list lvalue_list = lhs->lvalue_list (); + + if (error_state) + return retval; + + octave_idx_type n_out = 0; + + for (std::list::const_iterator p = lvalue_list.begin (); + p != lvalue_list.end (); + p++) + n_out += p->numel (); + + // The following trick is used to keep rhs_val constant. + const octave_value_list rhs_val1 = rhs->rvalue (n_out, &lvalue_list); + const octave_value_list rhs_val = (rhs_val1.length () == 1 && rhs_val1(0).is_cs_list () + ? rhs_val1(0).list_value () : rhs_val1); + + if (error_state) + return retval; + + octave_idx_type k = 0; + + octave_idx_type n = rhs_val.length (); + + // To avoid copying per elements and possible optimizations, we + // postpone joining the final values. + std::list retval_list; + + tree_argument_list::iterator q = lhs->begin (); + + for (std::list::iterator p = lvalue_list.begin (); + p != lvalue_list.end (); + p++) + { + tree_expression *lhs_elt = *q++; + + octave_lvalue ult = *p; + + octave_idx_type nel = ult.numel (); + + if (nel != 1) + { + if (k + nel <= n) + { + // This won't do a copy. + octave_value_list ovl = rhs_val.slice (k, nel); + + ult.assign (octave_value::op_asn_eq, octave_value (ovl, true)); + + if (! error_state) + { + retval_list.push_back (ovl); + + k += nel; + } + } + else + error ("some elements undefined in return list"); + } + else + { + if (k < n) + { + ult.assign (octave_value::op_asn_eq, rhs_val(k)); + + if (ult.is_black_hole ()) + { + k++; + continue; + } + else if (! error_state) + { + retval_list.push_back (rhs_val(k)); + + k++; + } + } + else + { + // This can happen for a function like + // + // function varargout = f () + // varargout{1} = nargout; + // endfunction + // + // called with + // + // [a, ~] = f (); + // + // Then the list of of RHS values will contain one + // element but we are iterating over the list of all + // RHS values. We shouldn't complain that a value we + // don't need is missing from the list. + + if (ult.is_black_hole ()) + { + k++; + continue; + } + else + error ("element number %d undefined in return list", k+1); + } + } + + if (error_state) + break; + else if (print_result ()) + { + // We clear any index here so that we can get + // the new value of the referenced object below, + // instead of the indexed value (which should be + // the same as the right hand side value). + + ult.clear_index (); + + octave_value lhs_val = ult.value (); + + if (! error_state) + lhs_val.print_with_name (octave_stdout, + lhs_elt->name ()); + } + + if (error_state) + break; + + } + + // Concatenate return values. + retval = retval_list; + + } + + first_execution = false; + + return retval; +} + +/* +%!function varargout = f () +%! varargout{1} = nargout; +%!endfunction +%! +%!test +%! [a, ~] = f (); +%! assert (a, 2); +%!test +%! [a, ~, ~, ~, ~] = f (); +%! assert (a, 5); +*/ + +std::string +tree_multi_assignment::oper (void) const +{ + return octave_value::assign_op_as_string (op_type ()); +} + +tree_expression * +tree_multi_assignment::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_multi_assignment *new_ma + = new tree_multi_assignment (lhs ? lhs->dup (scope, context) : 0, + rhs ? rhs->dup (scope, context) : 0, + preserve); + + new_ma->copy_base (*this); + + return new_ma; +} + +void +tree_multi_assignment::accept (tree_walker& tw) +{ + tw.visit_multi_assignment (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-assign.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-assign.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,173 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_assign_h) +#define octave_tree_assign_h 1 + +#include +#include + +class tree_argument_list; +class tree_walker; + +class octave_value; +class octave_value_list; +class octave_lvalue; + +#include "ov.h" +#include "pt-exp.h" +#include "symtab.h" + +// Simple assignment expressions. + +class +tree_simple_assignment : public tree_expression +{ +public: + + tree_simple_assignment (bool plhs = false, int l = -1, int c = -1, + octave_value::assign_op t = octave_value::op_asn_eq) + : tree_expression (l, c), lhs (0), rhs (0), preserve (plhs), ans_ass (), + etype (t), first_execution (true) { } + + tree_simple_assignment (tree_expression *le, tree_expression *re, + bool plhs = false, int l = -1, int c = -1, + octave_value::assign_op t = octave_value::op_asn_eq); + + ~tree_simple_assignment (void); + + bool has_magic_end (void) const { return (rhs && rhs->has_magic_end ()); } + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + bool is_assignment_expression (void) const { return true; } + + std::string oper (void) const; + + tree_expression *left_hand_side (void) { return lhs; } + + tree_expression *right_hand_side (void) { return rhs; } + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + + octave_value::assign_op op_type (void) const { return etype; } + +private: + + void do_assign (octave_lvalue& ult, const octave_value_list& args, + const octave_value& rhs_val); + + void do_assign (octave_lvalue& ult, const octave_value& rhs_val); + + // The left hand side of the assignment. + tree_expression *lhs; + + // The right hand side of the assignment. + tree_expression *rhs; + + // True if we should not delete the lhs. + bool preserve; + + // True if this is an assignment to the automatic variable ans. + bool ans_ass; + + // The type of the expression. + octave_value::assign_op etype; + + // true only on first rvalue() call. + bool first_execution; + + // No copying! + + tree_simple_assignment (const tree_simple_assignment&); + + tree_simple_assignment& operator = (const tree_simple_assignment&); +}; + +// Multi-valued assignment expressions. + +class +tree_multi_assignment : public tree_expression +{ +public: + + tree_multi_assignment (bool plhs = false, int l = -1, int c = -1) + : tree_expression (l, c), lhs (0), rhs (0), preserve (plhs), + first_execution (true) { } + + tree_multi_assignment (tree_argument_list *lst, tree_expression *r, + bool plhs = false, int l = -1, int c = -1); + + ~tree_multi_assignment (void); + + bool has_magic_end (void) const { return (rhs && rhs->has_magic_end ()); } + + bool is_assignment_expression (void) const { return true; } + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + std::string oper (void) const; + + tree_argument_list *left_hand_side (void) { return lhs; } + + tree_expression *right_hand_side (void) { return rhs; } + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + + octave_value::assign_op op_type (void) const { return octave_value::op_asn_eq; } + +private: + + // The left hand side of the assignment. + tree_argument_list *lhs; + + // The right hand side of the assignment. + tree_expression *rhs; + + // True if we should not delete the lhs. + bool preserve; + + // true only on first rvalue() call. + bool first_execution; + + // No copying! + + tree_multi_assignment (const tree_multi_assignment&); + + tree_multi_assignment& operator = (const tree_multi_assignment&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-binop.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-binop.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,315 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "defun.h" +#include "oct-obj.h" +#include "ov.h" +#include "profiler.h" +#include "pt-binop.h" +#include "pt-bp.h" +#include "pt-walk.h" +#include "variables.h" + +// TRUE means we mark | and & expressions for braindead short-circuit +// behavior. +static bool Vdo_braindead_shortcircuit_evaluation; + +// Binary expressions. + +octave_value_list +tree_binary_expression::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("binary operator `%s': invalid number of output arguments", + oper () . c_str ()); + else + retval = rvalue1 (nargout); + + return retval; +} + +octave_value +tree_binary_expression::rvalue1 (int) +{ + octave_value retval; + + if (error_state) + return retval; + + if (Vdo_braindead_shortcircuit_evaluation + && eligible_for_braindead_shortcircuit) + { + if (op_lhs) + { + octave_value a = op_lhs->rvalue1 (); + + if (! error_state) + { + if (a.ndims () == 2 && a.rows () == 1 && a.columns () == 1) + { + bool result = false; + + bool a_true = a.is_true (); + + if (! error_state) + { + if (a_true) + { + if (etype == octave_value::op_el_or) + { + result = true; + goto done; + } + } + else + { + if (etype == octave_value::op_el_and) + goto done; + } + + if (op_rhs) + { + octave_value b = op_rhs->rvalue1 (); + + if (! error_state) + result = b.is_true (); + } + + done: + + if (! error_state) + return octave_value (result); + } + } + } + } + } + + if (op_lhs) + { + octave_value a = op_lhs->rvalue1 (); + + if (! error_state && a.is_defined () && op_rhs) + { + octave_value b = op_rhs->rvalue1 (); + + if (! error_state && b.is_defined ()) + { + BEGIN_PROFILER_BLOCK ("binary " + oper ()) + + // Note: The profiler does not catch the braindead + // short-circuit evaluation code above, but that should be + // ok. The evaluation of operands and the operator itself + // is entangled and it's not clear where to start/stop + // timing the operator to make it reasonable. + + retval = ::do_binary_op (etype, a, b); + + if (error_state) + retval = octave_value (); + + END_PROFILER_BLOCK + } + } + } + + return retval; +} + +std::string +tree_binary_expression::oper (void) const +{ + return octave_value::binary_op_as_string (etype); +} + +tree_expression * +tree_binary_expression::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_binary_expression *new_be + = new tree_binary_expression (op_lhs ? op_lhs->dup (scope, context) : 0, + op_rhs ? op_rhs->dup (scope, context) : 0, + line (), column (), etype); + + new_be->copy_base (*this); + + return new_be; +} + +void +tree_binary_expression::accept (tree_walker& tw) +{ + tw.visit_binary_expression (*this); +} + +// Boolean expressions. + +octave_value_list +tree_boolean_expression::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("binary operator `%s': invalid number of output arguments", + oper () . c_str ()); + else + retval = rvalue1 (nargout); + + return retval; +} + +octave_value +tree_boolean_expression::rvalue1 (int) +{ + octave_value retval; + + if (error_state) + return retval; + + bool result = false; + + // This evaluation is not caught by the profiler, since we can't find + // a reasonable place where to time. Note that we don't want to + // include evaluation of LHS or RHS into the timing, but this is + // entangled together with short-circuit evaluation here. + + if (op_lhs) + { + octave_value a = op_lhs->rvalue1 (); + + if (! error_state) + { + bool a_true = a.is_true (); + + if (! error_state) + { + if (a_true) + { + if (etype == bool_or) + { + result = true; + goto done; + } + } + else + { + if (etype == bool_and) + goto done; + } + + if (op_rhs) + { + octave_value b = op_rhs->rvalue1 (); + + if (! error_state) + result = b.is_true (); + } + + done: + + if (! error_state) + retval = octave_value (result); + } + } + } + + return retval; +} + +std::string +tree_boolean_expression::oper (void) const +{ + std::string retval = ""; + + switch (etype) + { + case bool_and: + retval = "&&"; + break; + + case bool_or: + retval = "||"; + break; + + default: + break; + } + + return retval; +} + +tree_expression * +tree_boolean_expression::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_boolean_expression *new_be + = new tree_boolean_expression (op_lhs ? op_lhs->dup (scope, context) : 0, + op_rhs ? op_rhs->dup (scope, context) : 0, + line (), column (), etype); + + new_be->copy_base (*this); + + return new_be; +} + +DEFUN (do_braindead_shortcircuit_evaluation, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} do_braindead_shortcircuit_evaluation ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} do_braindead_shortcircuit_evaluation (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} do_braindead_shortcircuit_evaluation (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will\n\ +do short-circuit evaluation of @samp{|} and @samp{&} operators inside the\n\ +conditions of if or while statements.\n\ +\n\ +This feature is only provided for compatibility with @sc{matlab} and should\n\ +not be used unless you are porting old code that relies on this feature.\n\ +\n\ +To obtain short-circuit behavior for logical expressions in new programs,\n\ +you should always use the @samp{&&} and @samp{||} operators.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (do_braindead_shortcircuit_evaluation); +} + +/* +%!test +%! x = 0; +%! do_braindead_shortcircuit_evaluation (0); +%! if (1 | (x = 1)) +%! endif +%! assert (x, 1); +%! do_braindead_shortcircuit_evaluation (1); +%! if (1 | (x = 0)) +%! endif +%! assert (x, 1); +*/ diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-binop.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-binop.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,183 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_binop_h) +#define octave_tree_binop_h 1 + +#include + +class tree_walker; + +class octave_value; +class octave_value_list; +class octave_lvalue; + +#include "ov.h" +#include "pt-exp.h" +#include "symtab.h" + +// Binary expressions. + +class +tree_binary_expression : public tree_expression +{ +public: + + tree_binary_expression (int l = -1, int c = -1, + octave_value::binary_op t + = octave_value::unknown_binary_op) + : tree_expression (l, c), op_lhs (0), op_rhs (0), etype (t), + eligible_for_braindead_shortcircuit (false) { } + + tree_binary_expression (tree_expression *a, tree_expression *b, + int l = -1, int c = -1, + octave_value::binary_op t + = octave_value::unknown_binary_op) + : tree_expression (l, c), op_lhs (a), op_rhs (b), etype (t), + eligible_for_braindead_shortcircuit (false) { } + + ~tree_binary_expression (void) + { + delete op_lhs; + delete op_rhs; + } + + void mark_braindead_shortcircuit (const std::string& file) + { + if (etype == octave_value::op_el_and + || etype == octave_value::op_el_or) + { + if (file.empty ()) + warning_with_id ("Octave:possible-matlab-short-circuit-operator", + "possible Matlab-style short-circuit operator at line %d, column %d", + line (), column ()); + else + warning_with_id ("Octave:possible-matlab-short-circuit-operator", + "%s: possible Matlab-style short-circuit operator at line %d, column %d", + file.c_str (), line (), column ()); + + eligible_for_braindead_shortcircuit = true; + + op_lhs->mark_braindead_shortcircuit (file); + op_rhs->mark_braindead_shortcircuit (file); + } + } + + bool has_magic_end (void) const + { + return ((op_lhs && op_lhs->has_magic_end ()) + || (op_rhs && op_rhs->has_magic_end ())); + } + + bool is_binary_expression (void) const { return true; } + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + std::string oper (void) const; + + octave_value::binary_op op_type (void) const { return etype; } + + tree_expression *lhs (void) { return op_lhs; } + tree_expression *rhs (void) { return op_rhs; } + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +protected: + + // The operands for the expression. + tree_expression *op_lhs; + tree_expression *op_rhs; + +private: + + // The type of the expression. + octave_value::binary_op etype; + + // TRUE if this is an | or & expression in the condition of an IF + // or WHILE statement. + bool eligible_for_braindead_shortcircuit; + + // No copying! + + tree_binary_expression (const tree_binary_expression&); + + tree_binary_expression& operator = (const tree_binary_expression&); +}; + +// Boolean expressions. + +class +tree_boolean_expression : public tree_binary_expression +{ +public: + + enum type + { + unknown, + bool_and, + bool_or + }; + + tree_boolean_expression (int l = -1, int c = -1, type t = unknown) + : tree_binary_expression (l, c), etype (t) { } + + tree_boolean_expression (tree_expression *a, tree_expression *b, + int l = -1, int c = -1, type t = unknown) + : tree_binary_expression (a, b, l, c), etype (t) { } + + ~tree_boolean_expression (void) { } + + bool is_boolean_expression (void) const { return true; } + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + std::string oper (void) const; + + type op_type (void) const { return etype; } + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + +private: + + // The type of the expression. + type etype; + + // No copying! + + tree_boolean_expression (const tree_boolean_expression&); + + tree_boolean_expression& operator = (const tree_boolean_expression&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-bp.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-bp.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,501 @@ +/* + +Copyright (C) 2001-2012 Ben Sapp + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "ov-usr-fcn.h" +#include "pager.h" +#include "pt-all.h" + +// TRUE means SIGINT should put us in the debugger at the next +// available breakpoint. +bool octave_debug_on_interrupt_state = false; + +void +tree_breakpoint::visit_while_command (tree_while_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); + + if (! found) + { + tree_statement_list *lst = cmd.body (); + + if (lst) + lst->accept (*this); + } +} + +void +tree_breakpoint::visit_do_until_command (tree_do_until_command& cmd) +{ + if (! found) + { + tree_statement_list *lst = cmd.body (); + + if (lst) + lst->accept (*this); + + if (! found) + { + if (cmd.line () >= line) + take_action (cmd); + } + } +} + +void +tree_breakpoint::visit_argument_list (tree_argument_list&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_binary_expression (tree_binary_expression&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_break_command (tree_break_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); +} + +void +tree_breakpoint::visit_colon_expression (tree_colon_expression&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_continue_command (tree_continue_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); +} + +void +tree_breakpoint::do_decl_command (tree_decl_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); +} + +void +tree_breakpoint::visit_global_command (tree_global_command& cmd) +{ + do_decl_command (cmd); +} + +void +tree_breakpoint::visit_persistent_command (tree_persistent_command& cmd) +{ + do_decl_command (cmd); +} + +void +tree_breakpoint::visit_decl_elt (tree_decl_elt&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_decl_init_list (tree_decl_init_list&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_simple_for_command (tree_simple_for_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); + + if (! found) + { + tree_statement_list *lst = cmd.body (); + + if (lst) + lst->accept (*this); + } +} + +void +tree_breakpoint::visit_complex_for_command (tree_complex_for_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); + + if (! found) + { + tree_statement_list *lst = cmd.body (); + + if (lst) + lst->accept (*this); + } +} + +void +tree_breakpoint::visit_octave_user_script (octave_user_script& fcn) +{ + tree_statement_list *cmd_list = fcn.body (); + + if (cmd_list) + cmd_list->accept (*this); +} + +void +tree_breakpoint::visit_octave_user_function (octave_user_function& fcn) +{ + tree_statement_list *cmd_list = fcn.body (); + + if (cmd_list) + cmd_list->accept (*this); +} + +void +tree_breakpoint::visit_octave_user_function_header (octave_user_function&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_octave_user_function_trailer (octave_user_function&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_function_def (tree_function_def& fdef) +{ + octave_value fcn = fdef.function (); + + octave_function *f = fcn.function_value (); + + if (f) + f->accept (*this); +} + +void +tree_breakpoint::visit_identifier (tree_identifier&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_if_clause (tree_if_clause&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_if_command (tree_if_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); + + if (! found) + { + tree_if_command_list *lst = cmd.cmd_list (); + + if (lst) + lst->accept (*this); + } +} + +void +tree_breakpoint::visit_if_command_list (tree_if_command_list& lst) +{ + for (tree_if_command_list::iterator p = lst.begin (); p != lst.end (); p++) + { + tree_if_clause *t = *p; + + if (t->line () >= line) + take_action (*t); + + if (! found) + { + tree_statement_list *stmt_lst = t->commands (); + + if (stmt_lst) + stmt_lst->accept (*this); + } + + if (found) + break; + } +} + +void +tree_breakpoint::visit_index_expression (tree_index_expression&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_matrix (tree_matrix&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_cell (tree_cell&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_multi_assignment (tree_multi_assignment&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_no_op_command (tree_no_op_command& cmd) +{ + if (cmd.is_end_of_fcn_or_script () && cmd.line () >= line) + take_action (cmd); +} + +void +tree_breakpoint::visit_anon_fcn_handle (tree_anon_fcn_handle&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_constant (tree_constant&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_fcn_handle (tree_fcn_handle&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_parameter_list (tree_parameter_list&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_postfix_expression (tree_postfix_expression&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_prefix_expression (tree_prefix_expression&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_return_command (tree_return_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); +} + +void +tree_breakpoint::visit_return_list (tree_return_list&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_simple_assignment (tree_simple_assignment&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_statement (tree_statement& stmt) +{ + if (stmt.is_command ()) + { + tree_command *cmd = stmt.command (); + + cmd->accept (*this); + } + else + { + if (stmt.line () >= line) + take_action (stmt); + } +} + +void +tree_breakpoint::visit_statement_list (tree_statement_list& lst) +{ + for (tree_statement_list::iterator p = lst.begin (); p != lst.end (); p++) + { + tree_statement *elt = *p; + + if (elt) + { + elt->accept (*this); + + if (found) + break; + } + } +} + +void +tree_breakpoint::visit_switch_case (tree_switch_case&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_switch_case_list (tree_switch_case_list& lst) +{ + for (tree_switch_case_list::iterator p = lst.begin (); p != lst.end (); p++) + { + tree_switch_case *t = *p; + + if (t->line () >= line) + take_action (*t); + + if (! found) + { + tree_statement_list *stmt_lst = t->commands (); + + if (stmt_lst) + stmt_lst->accept (*this); + } + + if (found) + break; + } +} + +void +tree_breakpoint::visit_switch_command (tree_switch_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); + + if (! found) + { + tree_switch_case_list *lst = cmd.case_list (); + + if (lst) + lst->accept (*this); + } +} + +void +tree_breakpoint::visit_try_catch_command (tree_try_catch_command& cmd) +{ + tree_statement_list *try_code = cmd.body (); + + if (try_code) + try_code->accept (*this); + + if (! found) + { + tree_statement_list *catch_code = cmd.cleanup (); + + if (catch_code) + catch_code->accept (*this); + } +} + +void +tree_breakpoint::visit_unwind_protect_command (tree_unwind_protect_command& cmd) +{ + tree_statement_list *body = cmd.body (); + + if (body) + body->accept (*this); + + if (! found) + { + tree_statement_list *cleanup = cmd.cleanup (); + + if (cleanup) + cleanup->accept (*this); + } +} + +void +tree_breakpoint::take_action (tree& tr) +{ + if (act == set) + { + tr.set_breakpoint (); + line = tr.line (); + found = true; + } + else if (act == clear) + { + if (tr.is_breakpoint ()) + { + tr.delete_breakpoint (); + found = true; + } + } + else if (act == list) + { + if (tr.is_breakpoint ()) + bp_list.append (octave_value (tr.line ())); + } + else + panic_impossible (); +} + +void +tree_breakpoint::take_action (tree_statement& stmt) +{ + int lineno = stmt.line (); + + if (act == set) + { + stmt.set_breakpoint (); + line = lineno; + found = true; + } + else if (act == clear) + { + if (stmt.is_breakpoint ()) + { + stmt.delete_breakpoint (); + found = true; + } + } + else if (act == list) + { + if (stmt.is_breakpoint ()) + bp_list.append (octave_value (lineno)); + } + else + panic_impossible (); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-bp.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-bp.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,170 @@ +/* + +Copyright (C) 2001-2012 Ben Sapp + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_bp_h) +#define octave_tree_bp_h 1 + +#include "input.h" +#include "ov-usr-fcn.h" +#include "pt-walk.h" +#include "pt-pr-code.h" +#include "toplev.h" + +class tree; +class tree_decl_command; + +class +tree_breakpoint : public tree_walker +{ + public: + + enum action { set = 1, clear = 2, list = 3 }; + + tree_breakpoint (int l, action a) + : line (l), act (a), found (false), bp_list () { } + + ~tree_breakpoint (void) { } + + bool success (void) const { return found; } + + void visit_argument_list (tree_argument_list&); + + void visit_binary_expression (tree_binary_expression&); + + void visit_break_command (tree_break_command&); + + void visit_colon_expression (tree_colon_expression&); + + void visit_continue_command (tree_continue_command&); + + void visit_global_command (tree_global_command&); + + void visit_persistent_command (tree_persistent_command&); + + void visit_decl_elt (tree_decl_elt&); + + void visit_decl_init_list (tree_decl_init_list&); + + void visit_while_command (tree_while_command&); + + void visit_do_until_command (tree_do_until_command&); + + void visit_simple_for_command (tree_simple_for_command&); + + void visit_complex_for_command (tree_complex_for_command&); + + void visit_octave_user_script (octave_user_script&); + + void visit_octave_user_function (octave_user_function&); + + void visit_octave_user_function_header (octave_user_function&); + + void visit_octave_user_function_trailer (octave_user_function&); + + void visit_function_def (tree_function_def&); + + void visit_identifier (tree_identifier&); + + void visit_if_clause (tree_if_clause&); + + void visit_if_command (tree_if_command&); + + void visit_if_command_list (tree_if_command_list&); + + void visit_index_expression (tree_index_expression&); + + void visit_matrix (tree_matrix&); + + void visit_cell (tree_cell&); + + void visit_multi_assignment (tree_multi_assignment&); + + void visit_no_op_command (tree_no_op_command&); + + void visit_anon_fcn_handle (tree_anon_fcn_handle&); + + void visit_constant (tree_constant&); + + void visit_fcn_handle (tree_fcn_handle&); + + void visit_parameter_list (tree_parameter_list&); + + void visit_postfix_expression (tree_postfix_expression&); + + void visit_prefix_expression (tree_prefix_expression&); + + void visit_return_command (tree_return_command&); + + void visit_return_list (tree_return_list&); + + void visit_simple_assignment (tree_simple_assignment&); + + void visit_statement (tree_statement&); + + void visit_statement_list (tree_statement_list&); + + void visit_switch_case (tree_switch_case&); + + void visit_switch_case_list (tree_switch_case_list&); + + void visit_switch_command (tree_switch_command&); + + void visit_try_catch_command (tree_try_catch_command&); + + void visit_unwind_protect_command (tree_unwind_protect_command&); + + octave_value_list get_list (void) { return bp_list; } + + int get_line (void) { return line; } + + private: + + void do_decl_command (tree_decl_command&); + + void take_action (tree& tr); + + void take_action (tree_statement& stmt); + + // Statement line number we are looking for. + int line; + + // What to do. + action act; + + // Have we already found the line? + bool found; + + // List of breakpoint line numbers. + octave_value_list bp_list; + + // No copying! + + tree_breakpoint (const tree_breakpoint&); + + tree_breakpoint& operator = (const tree_breakpoint&); +}; + +// TRUE means SIGINT should put us in the debugger at the next +// available breakpoint. +extern bool octave_debug_on_interrupt_state; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-cbinop.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-cbinop.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,223 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "oct-obj.h" +#include "ov.h" +#include "pt-cbinop.h" +#include "pt-bp.h" +#include "pt-unop.h" +#include "pt-walk.h" + +// If a tree expression is a transpose or hermitian transpose, return +// the argument and corresponding operator. + +static octave_value::unary_op +strip_trans_herm (tree_expression *&exp) +{ + if (exp->is_unary_expression ()) + { + tree_unary_expression *uexp = + dynamic_cast (exp); + + octave_value::unary_op op = uexp->op_type (); + + if (op == octave_value::op_transpose + || op == octave_value::op_hermitian) + exp = uexp->operand (); + else + op = octave_value::unknown_unary_op; + + return op; + } + else + return octave_value::unknown_unary_op; +} + +static octave_value::unary_op +strip_not (tree_expression *&exp) +{ + if (exp->is_unary_expression ()) + { + tree_unary_expression *uexp = + dynamic_cast (exp); + + octave_value::unary_op op = uexp->op_type (); + + if (op == octave_value::op_not) + exp = uexp->operand (); + else + op = octave_value::unknown_unary_op; + + return op; + } + else + return octave_value::unknown_unary_op; +} + +// Possibly convert multiplication to trans_mul, mul_trans, herm_mul, +// or mul_herm. + +static octave_value::compound_binary_op +simplify_mul_op (tree_expression *&a, tree_expression *&b) +{ + octave_value::compound_binary_op retop + = octave_value::unknown_compound_binary_op; + + octave_value::unary_op opa = strip_trans_herm (a); + + if (opa == octave_value::op_hermitian) + retop = octave_value::op_herm_mul; + else if (opa == octave_value::op_transpose) + retop = octave_value::op_trans_mul; + else + { + octave_value::unary_op opb = strip_trans_herm (b); + + if (opb == octave_value::op_hermitian) + retop = octave_value::op_mul_herm; + else if (opb == octave_value::op_transpose) + retop = octave_value::op_mul_trans; + } + + return retop; +} + +// Possibly convert left division to trans_ldiv or herm_ldiv. + +static octave_value::compound_binary_op +simplify_ldiv_op (tree_expression *&a, tree_expression *&) +{ + octave_value::compound_binary_op retop + = octave_value::unknown_compound_binary_op; + + octave_value::unary_op opa = strip_trans_herm (a); + + if (opa == octave_value::op_hermitian) + retop = octave_value::op_herm_ldiv; + else if (opa == octave_value::op_transpose) + retop = octave_value::op_trans_ldiv; + + return retop; +} + +// Possibly contract and/or with negation. + +static octave_value::compound_binary_op +simplify_and_or_op (tree_expression *&a, tree_expression *&b, octave_value::binary_op op) +{ + octave_value::compound_binary_op retop + = octave_value::unknown_compound_binary_op; + + octave_value::unary_op opa = strip_not (a); + + if (opa == octave_value::op_not) + { + if (op == octave_value::op_el_and) + retop = octave_value::op_el_not_and; + else if (op == octave_value::op_el_or) + retop = octave_value::op_el_not_or; + } + else + { + octave_value::unary_op opb = strip_not (b); + + if (opb == octave_value::op_not) + { + if (op == octave_value::op_el_and) + retop = octave_value::op_el_and_not; + else if (op == octave_value::op_el_or) + retop = octave_value::op_el_or_not; + } + } + + return retop; +} + +tree_binary_expression * +maybe_compound_binary_expression (tree_expression *a, tree_expression *b, + int l, int c, octave_value::binary_op t) +{ + tree_expression *ca = a, *cb = b; + octave_value::compound_binary_op ct; + + switch (t) + { + case octave_value::op_mul: + ct = simplify_mul_op (ca, cb); + break; + + case octave_value::op_ldiv: + ct = simplify_ldiv_op (ca, cb); + break; + + case octave_value::op_el_and: + case octave_value::op_el_or: + ct = simplify_and_or_op (ca, cb, t); + break; + + default: + ct = octave_value::unknown_compound_binary_op; + break; + } + + tree_binary_expression *ret = (ct == octave_value::unknown_compound_binary_op) + ? new tree_binary_expression (a, b, l, c, t) + : new tree_compound_binary_expression (a, b, l, c, t, ca, cb, ct); + + return ret; +} + +octave_value +tree_compound_binary_expression::rvalue1 (int) +{ + octave_value retval; + + if (error_state) + return retval; + + if (op_lhs) + { + octave_value a = op_lhs->rvalue1 (); + + if (! error_state && a.is_defined () && op_rhs) + { + octave_value b = op_rhs->rvalue1 (); + + if (! error_state && b.is_defined ()) + { + retval = ::do_binary_op (etype, a, b); + + if (error_state) + retval = octave_value (); + } + } + } + + return retval; +} + + diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-cbinop.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-cbinop.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,79 @@ +/* + +Copyright (C) 2008-2012 Jaroslav Hajek + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_cbinop_h) +#define octave_tree_cbinop_h 1 + +#include + +class tree_walker; + +class octave_value; +class octave_value_list; +class octave_lvalue; + +#include "ov.h" +#include "pt-binop.h" +#include "symtab.h" + +// Binary expressions that can be reduced to compound operations + +class +tree_compound_binary_expression : public tree_binary_expression +{ +public: + + tree_compound_binary_expression (tree_expression *a, tree_expression *b, + int l, int c, + octave_value::binary_op t, + tree_expression *ca, tree_expression *cb, + octave_value::compound_binary_op ct) + : tree_binary_expression (a, b, l, c, t), op_lhs (ca), op_rhs (cb), + etype (ct) { } + + octave_value rvalue1 (int nargout = 1); + + octave_value::compound_binary_op cop_type (void) const { return etype; } + +private: + + tree_expression *op_lhs; + tree_expression *op_rhs; + octave_value::compound_binary_op etype; + + // No copying! + + tree_compound_binary_expression (const tree_compound_binary_expression&); + + tree_compound_binary_expression& operator = + (const tree_compound_binary_expression&); +}; + +// a "virtual constructor" + +tree_binary_expression * +maybe_compound_binary_expression (tree_expression *a, tree_expression *b, + int l = -1, int c = -1, + octave_value::binary_op t + = octave_value::unknown_binary_op); + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-cell.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-cell.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,126 @@ +/* + +Copyright (C) 1999-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "oct-obj.h" +#include "pt-arg-list.h" +#include "pt-bp.h" +#include "pt-exp.h" +#include "pt-cell.h" +#include "pt-walk.h" +#include "utils.h" +#include "ov.h" +#include "variables.h" + +octave_value +tree_cell::rvalue1 (int) +{ + octave_value retval; + + octave_idx_type nr = length (); + octave_idx_type nc = -1; + + Cell val; + + int i = 0; + + for (iterator p = begin (); p != end (); p++) + { + tree_argument_list *elt = *p; + + octave_value_list row = elt->convert_to_const_vector (); + + if (nr == 1) + // Optimize the single row case. + val = row.cell_value (); + else if (nc < 0) + { + nc = row.length (); + + val = Cell (nr, nc); + } + else + { + octave_idx_type this_nc = row.length (); + + if (nc != this_nc) + { + ::error ("number of columns must match"); + return retval; + } + } + + for (octave_idx_type j = 0; j < nc; j++) + val(i,j) = row(j); + + i++; + } + + retval = val; + + return retval; +} + +octave_value_list +tree_cell::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("invalid number of output arguments for cell array"); + else + retval = rvalue1 (nargout); + + return retval; +} + +tree_expression * +tree_cell::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_cell *new_cell = new tree_cell (0, line (), column ()); + + for (const_iterator p = begin (); p != end (); p++) + { + const tree_argument_list *elt = *p; + + new_cell->append (elt ? elt->dup (scope, context) : 0); + } + + new_cell->copy_base (*this); + + return new_cell; +} + +void +tree_cell::accept (tree_walker& tw) +{ + tw.visit_cell (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-cell.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-cell.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,69 @@ +/* + +Copyright (C) 1999-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_cell_h) +#define octave_tree_cell_h 1 + +#include + +class octave_value; +class octave_value_list; +class tree_argument_list; + +class tree_walker; + +#include "pt-mat.h" +#include "symtab.h" + +// General cells. + +class +tree_cell : public tree_matrix +{ +public: + + tree_cell (tree_argument_list *row = 0, int l = -1, int c = -1) + : tree_matrix (row, l, c) { } + + ~tree_cell (void) { } + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int); + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // No copying! + + tree_cell (const tree_cell&); + + tree_cell& operator = (const tree_cell&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-check.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-check.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,561 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "input.h" +#include "ov-usr-fcn.h" +#include "pt-all.h" + +void +tree_checker::visit_argument_list (tree_argument_list& lst) +{ + tree_argument_list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_expression *elt = *p++; + + if (elt) + { + if (do_lvalue_check && ! elt->lvalue_ok ()) + gripe ("invalid lvalue in multiple assignment", elt->line ()); + } + } +} + +void +tree_checker::visit_binary_expression (tree_binary_expression& expr) +{ + tree_expression *op1 = expr.lhs (); + + if (op1) + op1->accept (*this); + + tree_expression *op2 = expr.rhs (); + + if (op2) + op2->accept (*this); +} + +void +tree_checker::visit_break_command (tree_break_command&) +{ +} + +void +tree_checker::visit_colon_expression (tree_colon_expression& expr) +{ + tree_expression *op1 = expr.base (); + + if (op1) + op1->accept (*this); + + tree_expression *op3 = expr.increment (); + + if (op3) + op3->accept (*this); + + tree_expression *op2 = expr.limit (); + + if (op2) + op2->accept (*this); +} + +void +tree_checker::visit_continue_command (tree_continue_command&) +{ +} + +void +tree_checker::do_decl_command (tree_decl_command& cmd) +{ + tree_decl_init_list *init_list = cmd.initializer_list (); + + if (init_list) + init_list->accept (*this); +} + +void +tree_checker::visit_global_command (tree_global_command& cmd) +{ + do_decl_command (cmd); +} + +void +tree_checker::visit_persistent_command (tree_persistent_command& cmd) +{ + do_decl_command (cmd); +} + +void +tree_checker::visit_decl_elt (tree_decl_elt& cmd) +{ + tree_identifier *id = cmd.ident (); + + if (id) + id->accept (*this); + + tree_expression *expr = cmd.expression (); + + if (expr) + expr->accept (*this); +} + +void +tree_checker::visit_decl_init_list (tree_decl_init_list& lst) +{ + tree_decl_init_list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_decl_elt *elt = *p++; + + if (elt) + elt->accept (*this); + } +} + +void +tree_checker::visit_simple_for_command (tree_simple_for_command& cmd) +{ + tree_expression *lhs = cmd.left_hand_side (); + + if (lhs) + { + if (! lhs->lvalue_ok ()) + gripe ("invalid lvalue in for command", cmd.line ()); + } + + tree_expression *expr = cmd.control_expr (); + + if (expr) + expr->accept (*this); + + tree_expression *maxproc = cmd.maxproc_expr (); + + if (maxproc) + maxproc->accept (*this); + + tree_statement_list *list = cmd.body (); + + if (list) + list->accept (*this); +} + +void +tree_checker::visit_complex_for_command (tree_complex_for_command& cmd) +{ + tree_argument_list *lhs = cmd.left_hand_side (); + + if (lhs) + { + int len = lhs->length (); + + if (len == 0 || len > 2) + gripe ("invalid number of output arguments in for command", + cmd.line ()); + + do_lvalue_check = true; + + lhs->accept (*this); + + do_lvalue_check = false; + } + + tree_expression *expr = cmd.control_expr (); + + if (expr) + expr->accept (*this); + + tree_statement_list *list = cmd.body (); + + if (list) + list->accept (*this); +} + +void +tree_checker::visit_octave_user_script (octave_user_script& fcn) +{ + tree_statement_list *cmd_list = fcn.body (); + + if (cmd_list) + cmd_list->accept (*this); +} + +void +tree_checker::visit_octave_user_function (octave_user_function& fcn) +{ + tree_statement_list *cmd_list = fcn.body (); + + if (cmd_list) + cmd_list->accept (*this); +} + +void +tree_checker::visit_function_def (tree_function_def& fdef) +{ + octave_value fcn = fdef.function (); + + octave_function *f = fcn.function_value (); + + if (f) + f->accept (*this); +} + +void +tree_checker::visit_identifier (tree_identifier& /* id */) +{ +} + +void +tree_checker::visit_if_clause (tree_if_clause& cmd) +{ + tree_expression *expr = cmd.condition (); + + if (expr) + expr->accept (*this); + + tree_statement_list *list = cmd.commands (); + + if (list) + list->accept (*this); +} + +void +tree_checker::visit_if_command (tree_if_command& cmd) +{ + tree_if_command_list *list = cmd.cmd_list (); + + if (list) + list->accept (*this); +} + +void +tree_checker::visit_if_command_list (tree_if_command_list& lst) +{ + tree_if_command_list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_if_clause *elt = *p++; + + if (elt) + elt->accept (*this); + } +} + +void +tree_checker::visit_index_expression (tree_index_expression& expr) +{ + tree_expression *e = expr.expression (); + + if (e) + e->accept (*this); + + std::list lst = expr.arg_lists (); + + std::list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_argument_list *elt = *p++; + + if (elt) + elt->accept (*this); + } +} + +void +tree_checker::visit_matrix (tree_matrix& lst) +{ + tree_matrix::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_argument_list *elt = *p++; + + if (elt) + elt->accept (*this); + } +} + +void +tree_checker::visit_cell (tree_cell& lst) +{ + tree_matrix::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_argument_list *elt = *p++; + + if (elt) + elt->accept (*this); + } +} + +void +tree_checker::visit_multi_assignment (tree_multi_assignment& expr) +{ + tree_argument_list *lhs = expr.left_hand_side (); + + if (lhs) + { + do_lvalue_check = true; + + lhs->accept (*this); + + do_lvalue_check = false; + } + + tree_expression *rhs = expr.right_hand_side (); + + if (rhs) + rhs->accept (*this); +} + +void +tree_checker::visit_no_op_command (tree_no_op_command& /* cmd */) +{ +} + +void +tree_checker::visit_anon_fcn_handle (tree_anon_fcn_handle& /* afh */) +{ +} + +void +tree_checker::visit_constant (tree_constant& /* val */) +{ +} + +void +tree_checker::visit_fcn_handle (tree_fcn_handle& /* fh */) +{ +} + +void +tree_checker::visit_parameter_list (tree_parameter_list& lst) +{ + tree_parameter_list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_decl_elt *elt = *p++; + + if (elt) + elt->accept (*this); + } +} + +void +tree_checker::visit_postfix_expression (tree_postfix_expression& expr) +{ + tree_expression *e = expr.operand (); + + if (e) + e->accept (*this); +} + +void +tree_checker::visit_prefix_expression (tree_prefix_expression& expr) +{ + tree_expression *e = expr.operand (); + + if (e) + e->accept (*this); +} + +void +tree_checker::visit_return_command (tree_return_command&) +{ +} + +void +tree_checker::visit_return_list (tree_return_list& lst) +{ + tree_return_list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_index_expression *elt = *p++; + + if (elt) + elt->accept (*this); + } +} + +void +tree_checker::visit_simple_assignment (tree_simple_assignment& expr) +{ + tree_expression *lhs = expr.left_hand_side (); + + if (lhs) + { + if (! lhs->lvalue_ok ()) + gripe ("invalid lvalue in assignment", expr.line ()); + } + + tree_expression *rhs = expr.right_hand_side (); + + if (rhs) + rhs->accept (*this); +} + +void +tree_checker::visit_statement (tree_statement& stmt) +{ + tree_command *cmd = stmt.command (); + + if (cmd) + cmd->accept (*this); + else + { + tree_expression *expr = stmt.expression (); + + if (expr) + expr->accept (*this); + } +} + +void +tree_checker::visit_statement_list (tree_statement_list& lst) +{ + for (tree_statement_list::iterator p = lst.begin (); p != lst.end (); p++) + { + tree_statement *elt = *p; + + if (elt) + elt->accept (*this); + } +} + +void +tree_checker::visit_switch_case (tree_switch_case& cs) +{ + tree_expression *label = cs.case_label (); + + if (label) + label->accept (*this); + + tree_statement_list *list = cs.commands (); + + if (list) + list->accept (*this); +} + +void +tree_checker::visit_switch_case_list (tree_switch_case_list& lst) +{ + tree_switch_case_list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_switch_case *elt = *p++; + + if (elt) + elt->accept (*this); + } +} + +void +tree_checker::visit_switch_command (tree_switch_command& cmd) +{ + tree_expression *expr = cmd.switch_value (); + + if (expr) + expr->accept (*this); + + tree_switch_case_list *list = cmd.case_list (); + + if (list) + list->accept (*this); +} + +void +tree_checker::visit_try_catch_command (tree_try_catch_command& cmd) +{ + tree_statement_list *try_code = cmd.body (); + + if (try_code) + try_code->accept (*this); + + tree_statement_list *catch_code = cmd.cleanup (); + + if (catch_code) + catch_code->accept (*this); +} + +void +tree_checker::visit_unwind_protect_command + (tree_unwind_protect_command& cmd) +{ + tree_statement_list *unwind_protect_code = cmd.body (); + + if (unwind_protect_code) + unwind_protect_code->accept (*this); + + tree_statement_list *cleanup_code = cmd.cleanup (); + + if (cleanup_code) + cleanup_code->accept (*this); +} + +void +tree_checker::visit_while_command (tree_while_command& cmd) +{ + tree_expression *expr = cmd.condition (); + + if (expr) + expr->accept (*this); + + tree_statement_list *list = cmd.body (); + + if (list) + list->accept (*this); +} + +void +tree_checker::visit_do_until_command (tree_do_until_command& cmd) +{ + tree_statement_list *list = cmd.body (); + + if (list) + list->accept (*this); + + tree_expression *expr = cmd.condition (); + + if (expr) + expr->accept (*this); +} + +void +tree_checker::gripe (const std::string& msg, int line) +{ + if (curr_fcn_file_name.empty ()) + error ("%s", msg.c_str ()); + else + error ("%s: %d: %s", curr_fcn_file_name.c_str (), line, msg.c_str ()); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-check.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-check.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,139 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_checker_h) +#define octave_tree_checker_h 1 + +#include "pt-walk.h" + +class tree_decl_command; + +// How to check the semantics of the code that the parse trees represent. + +class +tree_checker : public tree_walker +{ +public: + + tree_checker (void) + : do_lvalue_check (false) { } + + ~tree_checker (void) { } + + void visit_argument_list (tree_argument_list&); + + void visit_binary_expression (tree_binary_expression&); + + void visit_break_command (tree_break_command&); + + void visit_colon_expression (tree_colon_expression&); + + void visit_continue_command(tree_continue_command&); + + void visit_global_command (tree_global_command&); + + void visit_persistent_command (tree_persistent_command&); + + void visit_decl_elt (tree_decl_elt&); + + void visit_decl_init_list (tree_decl_init_list&); + + void visit_simple_for_command (tree_simple_for_command&); + + void visit_complex_for_command (tree_complex_for_command&); + + void visit_octave_user_script (octave_user_script&); + + void visit_octave_user_function (octave_user_function&); + + void visit_function_def (tree_function_def&); + + void visit_identifier (tree_identifier&); + + void visit_if_clause (tree_if_clause&); + + void visit_if_command (tree_if_command&); + + void visit_if_command_list (tree_if_command_list&); + + void visit_index_expression (tree_index_expression&); + + void visit_matrix (tree_matrix&); + + void visit_cell (tree_cell&); + + void visit_multi_assignment (tree_multi_assignment&); + + void visit_no_op_command (tree_no_op_command&); + + void visit_anon_fcn_handle (tree_anon_fcn_handle&); + + void visit_constant (tree_constant&); + + void visit_fcn_handle (tree_fcn_handle&); + + void visit_parameter_list (tree_parameter_list&); + + void visit_postfix_expression (tree_postfix_expression&); + + void visit_prefix_expression (tree_prefix_expression&); + + void visit_return_command (tree_return_command&); + + void visit_return_list (tree_return_list&); + + void visit_simple_assignment (tree_simple_assignment&); + + void visit_statement (tree_statement&); + + void visit_statement_list (tree_statement_list&); + + void visit_switch_case (tree_switch_case&); + + void visit_switch_case_list (tree_switch_case_list&); + + void visit_switch_command (tree_switch_command&); + + void visit_try_catch_command (tree_try_catch_command&); + + void visit_unwind_protect_command (tree_unwind_protect_command&); + + void visit_while_command (tree_while_command&); + + void visit_do_until_command (tree_do_until_command&); + +private: + + bool do_lvalue_check; + + void do_decl_command (tree_decl_command&); + + void gripe (const std::string& msg, int line); + + // No copying! + + tree_checker (const tree_checker&); + + tree_checker& operator = (const tree_checker&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-cmd.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-cmd.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,58 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "pt-cmd.h" +#include "pt-walk.h" + +// No-op. + +tree_command * +tree_no_op_command::dup (symbol_table::scope_id, + symbol_table::context_id) const +{ + return new tree_no_op_command (orig_cmd, line (), column ()); +} + +void +tree_no_op_command::accept (tree_walker& tw) +{ + tw.visit_no_op_command (*this); +} + +// Function definition. + +tree_command * +tree_function_def::dup (symbol_table::scope_id, + symbol_table::context_id) const +{ + return new tree_function_def (fcn, line (), column ()); +} + +void +tree_function_def::accept (tree_walker& tw) +{ + tw.visit_function_def (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-cmd.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-cmd.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,127 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_cmd_h) +#define octave_tree_cmd_h 1 + +#include + +class tree_walker; + +#include "ov-fcn.h" +#include "pt.h" +#include "pt-bp.h" +#include "symtab.h" + +// A base class for commands. + +class +tree_command : public tree +{ +public: + + tree_command (int l = -1, int c = -1) + : tree (l, c) { } + + virtual ~tree_command (void) { } + + virtual tree_command *dup (symbol_table::scope_id, + symbol_table::context_id context) const = 0; + +private: + + // No copying! + + tree_command (const tree_command&); + + tree_command& operator = (const tree_command&); +}; + +// No-op. + +class +tree_no_op_command : public tree_command +{ +public: + + tree_no_op_command (const std::string& cmd = "no_op", int l = -1, int c = -1) + : tree_command (l, c), eof (cmd == "endfunction" || cmd == "endscript"), + orig_cmd (cmd) { } + + ~tree_no_op_command (void) { } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + + bool is_end_of_fcn_or_script (void) const { return eof; } + + std::string original_command (void) { return orig_cmd; } + +private: + + bool eof; + + std::string orig_cmd; + + // No copying! + + tree_no_op_command (const tree_no_op_command&); + + tree_no_op_command& operator = (const tree_no_op_command&); +}; + +// Function definition. + +class +tree_function_def : public tree_command +{ +public: + + tree_function_def (octave_function *f, int l = -1, int c = -1) + : tree_command (l, c), fcn (f) { } + + ~tree_function_def (void) { } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + + octave_value function (void) { return fcn; } + +private: + + octave_value fcn; + + tree_function_def (const octave_value& v, int l = -1, int c = -1) + : tree_command (l, c), fcn (v) { } + + // No copying! + + tree_function_def (const tree_function_def&); + + tree_function_def& operator = (const tree_function_def&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-colon.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-colon.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,285 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "oct-obj.h" +#include "pager.h" +#include "ov.h" +#include "pt-bp.h" +#include "pt-colon.h" +#include "pt-walk.h" + +// Colon expressions. + +tree_colon_expression * +tree_colon_expression::append (tree_expression *t) +{ + tree_colon_expression *retval = 0; + + if (op_base) + { + if (op_limit) + { + if (op_increment) + ::error ("invalid colon expression"); + else + { + // Stupid syntax: + // + // base : limit + // base : increment : limit + + op_increment = op_limit; + op_limit = t; + } + } + else + op_limit = t; + + retval = this; + } + else + ::error ("invalid colon expression"); + + return retval; +} + +octave_value_list +tree_colon_expression::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("invalid number of output arguments for colon expression"); + else + retval = rvalue1 (nargout); + + return retval; +} + +octave_value +tree_colon_expression::make_range (const Matrix& m_base, + const Matrix& m_limit, + const Matrix& m_increment, + bool result_is_str, bool dq_str) const +{ + octave_value retval; + + bool base_empty = m_base.is_empty (); + bool limit_empty = m_limit.is_empty (); + bool increment_empty = m_increment.is_empty (); + + if (base_empty || limit_empty || increment_empty) + retval = Range (); + else + { + retval = Range (m_base(0), m_limit(0), m_increment(0)); + + if (result_is_str) + retval = retval.convert_to_str (false, true, dq_str ? '"' : '\''); + } + + return retval; +} + +octave_value +tree_colon_expression::make_range (const octave_value& ov_base, + const octave_value& ov_limit, + const octave_value& ov_increment) const +{ + octave_value retval; + + if (ov_base.is_object () || ov_limit.is_object () || + ov_increment.is_object ()) + { + octave_value_list tmp1; + tmp1(2) = ov_limit; + tmp1(1) = ov_increment; + tmp1(0) = ov_base; + + octave_value fcn = symbol_table::find_function ("colon", tmp1); + + if (fcn.is_defined ()) + { + octave_value_list tmp2 = fcn.do_multi_index_op (1, tmp1); + + if (! error_state) + retval = tmp2 (0); + } + else + ::error ("can not find overloaded colon function"); + } + else + { + bool result_is_str = (ov_base.is_string () && ov_limit.is_string ()); + bool dq_str = (ov_base.is_dq_string () || ov_limit.is_dq_string ()); + + Matrix m_base = ov_base.matrix_value (true); + + if (error_state) + eval_error ("invalid base value in colon expression"); + else + { + Matrix m_limit = ov_limit.matrix_value (true); + + if (error_state) + eval_error ("invalid limit value in colon expression"); + else + { + Matrix m_increment = ov_increment.matrix_value (true); + + if (error_state) + eval_error ("invalid increment value in colon expression"); + else + retval = make_range (m_base, m_limit, m_increment, + result_is_str, dq_str); + } + } + } + + return retval; +} + +octave_value +tree_colon_expression::rvalue1 (int) +{ + octave_value retval; + + if (error_state || ! op_base || ! op_limit) + return retval; + + octave_value ov_base = op_base->rvalue1 (); + + if (error_state || ov_base.is_undefined ()) + eval_error ("invalid base value in colon expression"); + else + { + octave_value ov_limit = op_limit->rvalue1 (); + + if (error_state || ov_limit.is_undefined ()) + eval_error ("invalid limit value in colon expression"); + else if (ov_base.is_object () || ov_limit.is_object ()) + { + octave_value_list tmp1; + + if (op_increment) + { + octave_value ov_increment = op_increment->rvalue1 (); + + if (error_state || ov_increment.is_undefined ()) + eval_error ("invalid increment value in colon expression"); + else + { + tmp1(2) = ov_limit; + tmp1(1) = ov_increment; + tmp1(0) = ov_base; + } + } + else + { + tmp1(1) = ov_limit; + tmp1(0) = ov_base; + } + + if (!error_state) + { + octave_value fcn = symbol_table::find_function ("colon", tmp1); + + if (fcn.is_defined ()) + { + octave_value_list tmp2 = fcn.do_multi_index_op (1, tmp1); + + if (! error_state) + retval = tmp2 (0); + } + else + ::error ("can not find overloaded colon function"); + } + } + else + { + octave_value ov_increment = 1.0; + + if (op_increment) + { + ov_increment = op_increment->rvalue1 (); + + if (error_state || ov_increment.is_undefined ()) + eval_error ("invalid increment value in colon expression"); + } + + if (! error_state) + retval = make_range (ov_base, ov_limit, ov_increment); + } + } + + return retval; +} + +void +tree_colon_expression::eval_error (const std::string& s) const +{ + ::error ("%s", s.c_str ()); +} + +int +tree_colon_expression::line (void) const +{ + return (op_base ? op_base->line () + : (op_increment ? op_increment->line () + : (op_limit ? op_limit->line () + : -1))); +} + +int +tree_colon_expression::column (void) const +{ + return (op_base ? op_base->column () + : (op_increment ? op_increment->column () + : (op_limit ? op_limit->column () + : -1))); +} + +tree_expression * +tree_colon_expression::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_colon_expression *new_ce = new + tree_colon_expression (op_base ? op_base->dup (scope, context) : 0, + op_limit ? op_limit->dup (scope, context) : 0, + op_increment ? op_increment->dup (scope, context) : 0, + line (), column ()); + + new_ce->copy_base (*new_ce); + + return new_ce; +} + +void +tree_colon_expression::accept (tree_walker& tw) +{ + tw.visit_colon_expression (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-colon.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-colon.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,124 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_colon_h) +#define octave_tree_colon 1 + +#include + +class tree_walker; + +class octave_value; +class octave_value_list; +class octave_lvalue; + +#include "pt-exp.h" +#include "symtab.h" + +// Colon expressions. + +class +tree_colon_expression : public tree_expression +{ +public: + + tree_colon_expression (int l = -1, int c = -1) + : tree_expression (l, c), op_base (0), op_limit (0), + op_increment (0), save_base (false) { } + + tree_colon_expression (tree_expression *e, int l = -1, int c = -1) + : tree_expression (l, c), op_base (e), op_limit (0), + op_increment (0), save_base (false) { } + + tree_colon_expression (tree_expression *bas, tree_expression *lim, + tree_expression *inc, int l = -1, int c = -1) + : tree_expression (l, c), op_base (bas), op_limit (lim), + op_increment (inc), save_base (false) { } + + ~tree_colon_expression (void) + { + if (! save_base) + delete op_base; + + delete op_limit; + delete op_increment; + } + + bool has_magic_end (void) const + { + return ((op_base && op_base->has_magic_end ()) + || (op_limit && op_limit->has_magic_end ()) + || (op_increment && op_increment->has_magic_end ())); + } + + void preserve_base (void) { save_base = true; } + + tree_colon_expression *append (tree_expression *t); + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + void eval_error (const std::string& s) const; + + tree_expression *base (void) { return op_base; } + + tree_expression *limit (void) { return op_limit; } + + tree_expression *increment (void) { return op_increment; } + + int line (void) const; + int column (void) const; + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // The components of the expression. + tree_expression *op_base; + tree_expression *op_limit; + tree_expression *op_increment; + + bool save_base; + + octave_value + make_range (const Matrix& m_base, const Matrix& m_limit, + const Matrix& m_increment, bool result_is_str, + bool dq_str) const; + + octave_value + make_range (const octave_value& ov_base, const octave_value& ov_limit, + const octave_value& ov_increment) const; + + // No copying! + + tree_colon_expression (const tree_colon_expression&); + + tree_colon_expression& operator = (const tree_colon_expression&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-const.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-const.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,87 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "error.h" +#include "oct-obj.h" +#include "pager.h" +#include "pt-const.h" +#include "pt-walk.h" + +// We are likely to have a lot of tree_constant objects to allocate, +// so make the grow_size large. +DEFINE_OCTAVE_ALLOCATOR2 (tree_constant, 1024); + +void +tree_constant::print (std::ostream& os, bool pr_as_read_syntax, bool pr_orig_text) +{ + if (pr_orig_text && ! orig_text.empty ()) + os << orig_text; + else + val.print (os, pr_as_read_syntax); +} + +void +tree_constant::print_raw (std::ostream& os, bool pr_as_read_syntax, + bool pr_orig_text) +{ + if (pr_orig_text && ! orig_text.empty ()) + os << orig_text; + else + val.print_raw (os, pr_as_read_syntax); +} + +octave_value_list +tree_constant::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("invalid number of output arguments for constant expression"); + else + retval = rvalue1 (nargout); + + return retval; +} + +tree_expression * +tree_constant::dup (symbol_table::scope_id, + symbol_table::context_id) const +{ + tree_constant *new_tc + = new tree_constant (val, orig_text, line (), column ()); + + new_tc->copy_base (*this); + + return new_tc; +} + +void +tree_constant::accept (tree_walker& tw) +{ + tw.visit_constant (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-const.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-const.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,105 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_const_h) +#define octave_tree_const_h 1 + +#include +#include + +#include "oct-alloc.h" + +class octave_value_list; +class tree_walker; + +#include "ov.h" +#include "pt-bp.h" +#include "pt-exp.h" +#include "symtab.h" + +class +tree_constant : public tree_expression +{ +public: + + tree_constant (int l = -1, int c = -1) + : tree_expression (l, c), val (), orig_text () { } + + tree_constant (const octave_value& v, int l = -1, int c = -1) + : tree_expression (l, c), val (v), orig_text () { } + + tree_constant (const octave_value& v, const std::string& ot, + int l = -1, int c = -1) + : tree_expression (l, c), val (v), orig_text (ot) { } + + ~tree_constant (void) { } + + bool has_magic_end (void) const { return false; } + + // Type. It would be nice to eliminate the need for this. + + bool is_constant (void) const { return true; } + + void maybe_mutate (void) { val.maybe_mutate (); } + + void print (std::ostream& os, bool pr_as_read_syntax = false, + bool pr_orig_txt = true); + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false, + bool pr_orig_txt = true); + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int = 1) { return val; } + + octave_value_list rvalue (int nargout); + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + + // Store the original text corresponding to this constant for later + // pretty printing. + + void stash_original_text (const std::string& s) { orig_text = s; } + + std::string original_text (void) const { return orig_text; } + +private: + + // The actual value that this constant refers to. + octave_value val; + + // The original text form of this constant. + std::string orig_text; + + // No copying! + + tree_constant (const tree_constant&); + + tree_constant& operator = (const tree_constant&); + + DECLARE_OCTAVE_ALLOCATOR +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-decl.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-decl.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,147 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "defun.h" +#include "error.h" +#include "pt-cmd.h" +#include "ov.h" +#include "oct-lvalue.h" +#include "pt-bp.h" +#include "pt-decl.h" +#include "pt-exp.h" +#include "pt-id.h" +#include "pt-walk.h" +#include "utils.h" +#include "variables.h" + +// Declarations (global, static, etc.). + +tree_decl_elt::~tree_decl_elt (void) +{ + delete id; + delete expr; +} + +bool +tree_decl_elt::eval (void) +{ + bool retval = false; + + if (id && expr) + { + octave_lvalue ult = id->lvalue (); + + octave_value init_val = expr->rvalue1 (); + + if (! error_state) + { + ult.assign (octave_value::op_asn_eq, init_val); + + retval = true; + } + } + + return retval; +} + +tree_decl_elt * +tree_decl_elt::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return new tree_decl_elt (id ? id->dup (scope, context) : 0, + expr ? expr->dup (scope, context) : 0); +} + +void +tree_decl_elt::accept (tree_walker& tw) +{ + tw.visit_decl_elt (*this); +} + +// Initializer lists for declaration statements. + +tree_decl_init_list * +tree_decl_init_list::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_decl_init_list *new_dil = new tree_decl_init_list (); + + for (const_iterator p = begin (); p != end (); p++) + { + const tree_decl_elt *elt = *p; + + new_dil->append (elt ? elt->dup (scope, context) : 0); + } + + return new_dil; +} + +void +tree_decl_init_list::accept (tree_walker& tw) +{ + tw.visit_decl_init_list (*this); +} + +// Base class for declaration commands (global, static). + +tree_decl_command::~tree_decl_command (void) +{ + delete init_list; +} + +// Global. + +tree_command * +tree_global_command::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return + new tree_global_command (init_list ? init_list->dup (scope, context) : 0, + line (), column ()); +} + +void +tree_global_command::accept (tree_walker& tw) +{ + tw.visit_global_command (*this); +} + +// Static. + +tree_command * +tree_persistent_command::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return + new tree_persistent_command (init_list ? init_list->dup (scope, context) : 0, + line (), column ()); +} + +void +tree_persistent_command::accept (tree_walker& tw) +{ + tw.visit_persistent_command (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-decl.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-decl.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,241 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_decl_h) +#define octave_tree_decl_h 1 + +class tree_expression; +class tree_identifier; + +class tree_walker; + +#include + +#include "base-list.h" +#include "oct-lvalue.h" +#include "pt-cmd.h" +#include "pt-id.h" +#include "symtab.h" + +// List of expressions that make up a declaration statement. + +class +tree_decl_elt +{ +public: + + tree_decl_elt (tree_identifier *i = 0, tree_expression *e = 0) + : id (i), expr (e) { } + + ~tree_decl_elt (void); + + bool eval (void); + + bool is_defined (void) { return id ? id->is_defined () : false; } + + bool is_variable (void) { return id ? id->is_variable () : false; } + + void mark_as_formal_parameter (void) + { + if (id) + id->mark_as_formal_parameter (); + } + + bool lvalue_ok (void) { return id ? id->lvalue_ok () : false; } + + // Do not allow functions to return null values. + octave_value rvalue1 (int nargout = 1) + { + return id ? id->rvalue1 (nargout).storable_value () : octave_value (); + } + + octave_value_list rvalue (int nargout) + { + octave_value_list retval; + + if (nargout > 1) + error ("invalid number of output arguments in declaration list"); + else + retval = rvalue1 (nargout); + + return retval; + } + + octave_lvalue lvalue (void) { return id ? id->lvalue () : octave_lvalue (); } + + tree_identifier *ident (void) { return id; } + + tree_expression *expression (void) { return expr; } + + tree_decl_elt *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // An identifier to tag with the declared property. + tree_identifier *id; + + // An initializer expression (may be zero); + tree_expression *expr; + + // No copying! + + tree_decl_elt (const tree_decl_elt&); + + tree_decl_elt& operator = (const tree_decl_elt&); +}; + +class +tree_decl_init_list : public octave_base_list +{ +public: + + tree_decl_init_list (void) { } + + tree_decl_init_list (tree_decl_elt *t) { append (t); } + + ~tree_decl_init_list (void) + { + while (! empty ()) + { + iterator p = begin (); + delete *p; + erase (p); + } + } + + tree_decl_init_list *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // No copying! + + tree_decl_init_list (const tree_decl_init_list&); + + tree_decl_init_list& operator = (const tree_decl_init_list&); +}; + +// Base class for declaration commands -- global, static, etc. + +class +tree_decl_command : public tree_command +{ +public: + + tree_decl_command (const std::string& n, int l = -1, int c = -1) + : tree_command (l, c), cmd_name (n), init_list (0) { } + + tree_decl_command (const std::string& n, tree_decl_init_list *t, + int l = -1, int c = -1) + : tree_command (l, c), cmd_name (n), init_list (t) { } + + ~tree_decl_command (void); + + tree_decl_init_list *initializer_list (void) { return init_list; } + + std::string name (void) { return cmd_name; } + +protected: + + // The name of this command -- global, static, etc. + std::string cmd_name; + + // The list of variables or initializers in this declaration command. + tree_decl_init_list *init_list; + +private: + + // No copying! + + tree_decl_command (const tree_decl_command&); + + tree_decl_command& operator = (const tree_decl_command&); +}; + +// Global. + +class +tree_global_command : public tree_decl_command +{ +public: + + tree_global_command (int l = -1, int c = -1) + : tree_decl_command ("global", l, c) { } + + tree_global_command (tree_decl_init_list *t, int l = -1, int c = -1) + : tree_decl_command ("global", t, l, c) { } + + ~tree_global_command (void) { } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + static void do_init (tree_decl_elt& elt); + + // No copying! + + tree_global_command (const tree_global_command&); + + tree_global_command& operator = (const tree_global_command&); +}; + +// Persistent. + +class +tree_persistent_command : public tree_decl_command +{ +public: + + tree_persistent_command (int l = -1, int c = -1) + : tree_decl_command ("persistent", l, c) { } + + tree_persistent_command (tree_decl_init_list *t, int l = -1, int c = -1) + : tree_decl_command ("persistent", t, l, c) { } + + ~tree_persistent_command (void) { } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + static void do_init (tree_decl_elt& elt); + + // No copying! + + tree_persistent_command (const tree_persistent_command&); + + tree_persistent_command& operator = (const tree_persistent_command&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-eval.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-eval.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1265 @@ +/* + +Copyright (C) 2009-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include +#include + +#include "debug.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "ov-fcn-handle.h" +#include "ov-usr-fcn.h" +#include "variables.h" +#include "pt-all.h" +#include "pt-eval.h" +#include "symtab.h" +#include "unwind-prot.h" + +#if HAVE_LLVM +//FIXME: This should be part of tree_evaluator +#include "pt-jit.h" +static tree_jit jiter; +#endif + +static tree_evaluator std_evaluator; + +tree_evaluator *current_evaluator = &std_evaluator; + +int tree_evaluator::dbstep_flag = 0; + +size_t tree_evaluator::current_frame = 0; + +bool tree_evaluator::debug_mode = false; + +tree_evaluator::stmt_list_type tree_evaluator::statement_context + = tree_evaluator::other; + +bool tree_evaluator::in_loop_command = false; + +// Maximum nesting level for functions, scripts, or sourced files called +// recursively. +int Vmax_recursion_depth = 256; + +// If TRUE, turn off printing of results in functions (as if a +// semicolon has been appended to each statement). +static bool Vsilent_functions = false; + +// Normal evaluator. + +void +tree_evaluator::visit_anon_fcn_handle (tree_anon_fcn_handle&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_argument_list (tree_argument_list&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_binary_expression (tree_binary_expression&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_break_command (tree_break_command& cmd) +{ + if (! error_state) + { + if (debug_mode) + do_breakpoint (cmd.is_breakpoint ()); + + if (statement_context == function || statement_context == script + || in_loop_command) + tree_break_command::breaking = 1; + } +} + +void +tree_evaluator::visit_colon_expression (tree_colon_expression&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_continue_command (tree_continue_command& cmd) +{ + if (! error_state) + { + if (debug_mode) + do_breakpoint (cmd.is_breakpoint ()); + + if (statement_context == function || statement_context == script + || in_loop_command) + tree_continue_command::continuing = 1; + } +} + +void +tree_evaluator::reset_debug_state (void) +{ + debug_mode = bp_table::have_breakpoints () || Vdebugging; + + dbstep_flag = 0; +} + +static inline void +do_global_init (tree_decl_elt& elt) +{ + tree_identifier *id = elt.ident (); + + if (id) + { + id->mark_global (); + + if (! error_state) + { + octave_lvalue ult = id->lvalue (); + + if (ult.is_undefined ()) + { + tree_expression *expr = elt.expression (); + + octave_value init_val; + + if (expr) + init_val = expr->rvalue1 (); + else + init_val = Matrix (); + + ult.assign (octave_value::op_asn_eq, init_val); + } + } + } +} + +static inline void +do_static_init (tree_decl_elt& elt) +{ + tree_identifier *id = elt.ident (); + + if (id) + { + id->mark_as_static (); + + octave_lvalue ult = id->lvalue (); + + if (ult.is_undefined ()) + { + tree_expression *expr = elt.expression (); + + octave_value init_val; + + if (expr) + init_val = expr->rvalue1 (); + else + init_val = Matrix (); + + ult.assign (octave_value::op_asn_eq, init_val); + } + } +} + +void +tree_evaluator::do_decl_init_list (decl_elt_init_fcn fcn, + tree_decl_init_list *init_list) +{ + if (init_list) + { + for (tree_decl_init_list::iterator p = init_list->begin (); + p != init_list->end (); p++) + { + tree_decl_elt *elt = *p; + + fcn (*elt); + + if (error_state) + break; + } + } +} + +void +tree_evaluator::visit_global_command (tree_global_command& cmd) +{ + if (debug_mode) + do_breakpoint (cmd.is_breakpoint ()); + + do_decl_init_list (do_global_init, cmd.initializer_list ()); +} + +void +tree_evaluator::visit_persistent_command (tree_persistent_command& cmd) +{ + if (debug_mode) + do_breakpoint (cmd.is_breakpoint ()); + + do_decl_init_list (do_static_init, cmd.initializer_list ()); +} + +void +tree_evaluator::visit_decl_elt (tree_decl_elt&) +{ + panic_impossible (); +} + +#if 0 +bool +tree_decl_elt::eval (void) +{ + bool retval = false; + + if (id && expr) + { + octave_lvalue ult = id->lvalue (); + + octave_value init_val = expr->rvalue1 (); + + if (! error_state) + { + ult.assign (octave_value::op_asn_eq, init_val); + + retval = true; + } + } + + return retval; +} +#endif + +void +tree_evaluator::visit_decl_init_list (tree_decl_init_list&) +{ + panic_impossible (); +} + +// Decide if it's time to quit a for or while loop. +static inline bool +quit_loop_now (void) +{ + octave_quit (); + + // Maybe handle `continue N' someday... + + if (tree_continue_command::continuing) + tree_continue_command::continuing--; + + bool quit = (error_state + || tree_return_command::returning + || tree_break_command::breaking + || tree_continue_command::continuing); + + if (tree_break_command::breaking) + tree_break_command::breaking--; + + return quit; +} + +void +tree_evaluator::visit_simple_for_command (tree_simple_for_command& cmd) +{ + if (error_state) + return; + + if (debug_mode) + do_breakpoint (cmd.is_breakpoint ()); + + // FIXME -- need to handle PARFOR loops here using cmd.in_parallel () + // and cmd.maxproc_expr (); + + unwind_protect frame; + + frame.protect_var (in_loop_command); + + in_loop_command = true; + + tree_expression *expr = cmd.control_expr (); + + octave_value rhs = expr->rvalue1 (); + +#if HAVE_LLVM + if (jiter.execute (cmd, rhs)) + return; +#endif + + if (error_state || rhs.is_undefined ()) + return; + + { + tree_expression *lhs = cmd.left_hand_side (); + + octave_lvalue ult = lhs->lvalue (); + + if (error_state) + return; + + tree_statement_list *loop_body = cmd.body (); + + if (rhs.is_range ()) + { + Range rng = rhs.range_value (); + + octave_idx_type steps = rng.nelem (); + double b = rng.base (); + double increment = rng.inc (); + + for (octave_idx_type i = 0; i < steps; i++) + { + // Use multiplication here rather than declaring a + // temporary variable outside the loop and using + // + // tmp_val += increment + // + // to avoid problems with limited precision. Also, this + // is consistent with the way Range::matrix_value is + // implemented. + + octave_value val (b + i * increment); + + ult.assign (octave_value::op_asn_eq, val); + + if (! error_state && loop_body) + loop_body->accept (*this); + + if (quit_loop_now ()) + break; + } + } + else if (rhs.is_scalar_type ()) + { + ult.assign (octave_value::op_asn_eq, rhs); + + if (! error_state && loop_body) + loop_body->accept (*this); + + // Maybe decrement break and continue states. + quit_loop_now (); + } + else if (rhs.is_matrix_type () || rhs.is_cell () || rhs.is_string () + || rhs.is_map ()) + { + // A matrix or cell is reshaped to 2 dimensions and iterated by + // columns. + + dim_vector dv = rhs.dims ().redim (2); + + octave_idx_type nrows = dv(0), steps = dv(1); + + if (steps > 0) + { + octave_value arg = rhs; + if (rhs.ndims () > 2) + arg = arg.reshape (dv); + + // for row vectors, use single index to speed things up. + octave_value_list idx; + octave_idx_type iidx; + if (nrows == 1) + { + idx.resize (1); + iidx = 0; + } + else + { + idx.resize (2); + idx(0) = octave_value::magic_colon_t; + iidx = 1; + } + + for (octave_idx_type i = 1; i <= steps; i++) + { + // do_index_op expects one-based indices. + idx(iidx) = i; + octave_value val = arg.do_index_op (idx); + + ult.assign (octave_value::op_asn_eq, val); + + if (! error_state && loop_body) + loop_body->accept (*this); + + if (quit_loop_now ()) + break; + } + } + } + else + { + ::error ("invalid type in for loop expression near line %d, column %d", + cmd.line (), cmd.column ()); + } + } +} + +void +tree_evaluator::visit_complex_for_command (tree_complex_for_command& cmd) +{ + if (error_state) + return; + + if (debug_mode) + do_breakpoint (cmd.is_breakpoint ()); + + unwind_protect frame; + + frame.protect_var (in_loop_command); + + in_loop_command = true; + + tree_expression *expr = cmd.control_expr (); + + octave_value rhs = expr->rvalue1 (); + + if (error_state || rhs.is_undefined ()) + return; + + if (rhs.is_map ()) + { + // Cycle through structure elements. First element of id_list + // is set to value and the second is set to the name of the + // structure element. + + tree_argument_list *lhs = cmd.left_hand_side (); + + tree_argument_list::iterator p = lhs->begin (); + + tree_expression *elt = *p++; + + octave_lvalue val_ref = elt->lvalue (); + + elt = *p; + + octave_lvalue key_ref = elt->lvalue (); + + const octave_map tmp_val = rhs.map_value (); + + tree_statement_list *loop_body = cmd.body (); + + string_vector keys = tmp_val.keys (); + + octave_idx_type nel = keys.numel (); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::string key = keys[i]; + + const Cell val_lst = tmp_val.contents (key); + + octave_idx_type n = val_lst.numel (); + + octave_value val = (n == 1) ? val_lst(0) : octave_value (val_lst); + + val_ref.assign (octave_value::op_asn_eq, val); + key_ref.assign (octave_value::op_asn_eq, key); + + if (! error_state && loop_body) + loop_body->accept (*this); + + if (quit_loop_now ()) + break; + } + } + else + error ("in statement `for [X, Y] = VAL', VAL must be a structure"); +} + +void +tree_evaluator::visit_octave_user_script (octave_user_script&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_octave_user_function (octave_user_function&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_octave_user_function_header (octave_user_function&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_octave_user_function_trailer (octave_user_function&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_function_def (tree_function_def& cmd) +{ + octave_value fcn = cmd.function (); + + octave_function *f = fcn.function_value (); + + if (f) + { + std::string nm = f->name (); + + symbol_table::install_cmdline_function (nm, fcn); + + // Make sure that any variable with the same name as the new + // function is cleared. + + symbol_table::varref (nm) = octave_value (); + } +} + +void +tree_evaluator::visit_identifier (tree_identifier&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_if_clause (tree_if_clause&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_if_command (tree_if_command& cmd) +{ + if (debug_mode) + do_breakpoint (cmd.is_breakpoint ()); + + tree_if_command_list *lst = cmd.cmd_list (); + + if (lst) + lst->accept (*this); +} + +void +tree_evaluator::visit_if_command_list (tree_if_command_list& lst) +{ + for (tree_if_command_list::iterator p = lst.begin (); p != lst.end (); p++) + { + tree_if_clause *tic = *p; + + tree_expression *expr = tic->condition (); + + if (debug_mode && ! tic->is_else_clause ()) + do_breakpoint (tic->is_breakpoint ()); + + if (tic->is_else_clause () || expr->is_logically_true ("if")) + { + if (! error_state) + { + tree_statement_list *stmt_lst = tic->commands (); + + if (stmt_lst) + stmt_lst->accept (*this); + } + + break; + } + } +} + +void +tree_evaluator::visit_index_expression (tree_index_expression&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_matrix (tree_matrix&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_cell (tree_cell&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_multi_assignment (tree_multi_assignment&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_no_op_command (tree_no_op_command& cmd) +{ + if (debug_mode && cmd.is_end_of_fcn_or_script ()) + do_breakpoint (cmd.is_breakpoint (), true); +} + +void +tree_evaluator::visit_constant (tree_constant&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_fcn_handle (tree_fcn_handle&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_parameter_list (tree_parameter_list&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_postfix_expression (tree_postfix_expression&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_prefix_expression (tree_prefix_expression&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_return_command (tree_return_command& cmd) +{ + if (! error_state) + { + if (debug_mode) + do_breakpoint (cmd.is_breakpoint ()); + + // Act like dbcont. + + if (Vdebugging + && octave_call_stack::current_frame () == current_frame) + { + Vdebugging = false; + + reset_debug_state (); + } + else if (statement_context == function || statement_context == script + || in_loop_command) + tree_return_command::returning = 1; + } +} + +void +tree_evaluator::visit_return_list (tree_return_list&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_simple_assignment (tree_simple_assignment&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_statement (tree_statement& stmt) +{ + tree_command *cmd = stmt.command (); + tree_expression *expr = stmt.expression (); + + if (cmd || expr) + { + if (statement_context == function || statement_context == script) + { + // Skip commands issued at a debug> prompt to avoid disturbing + // the state of the program we are debugging. + + if (! Vdebugging) + octave_call_stack::set_statement (&stmt); + + // FIXME -- we need to distinguish functions from scripts to + // get this right. + if ((statement_context == script + && ((Vecho_executing_commands & ECHO_SCRIPTS) + || (Vecho_executing_commands & ECHO_FUNCTIONS))) + || (statement_context == function + && (Vecho_executing_commands & ECHO_FUNCTIONS))) + stmt.echo_code (); + } + + try + { + if (cmd) + cmd->accept (*this); + else + { + if (debug_mode) + do_breakpoint (expr->is_breakpoint ()); + + if ((statement_context == function || statement_context == script) + && Vsilent_functions) + expr->set_print_flag (false); + + // FIXME -- maybe all of this should be packaged in + // one virtual function that returns a flag saying whether + // or not the expression will take care of binding ans and + // printing the result. + + // FIXME -- it seems that we should just have to + // call expr->rvalue1 () and that should take care of + // everything, binding ans as necessary? + + bool do_bind_ans = false; + + if (expr->is_identifier ()) + { + tree_identifier *id = dynamic_cast (expr); + + do_bind_ans = (! id->is_variable ()); + } + else + do_bind_ans = (! expr->is_assignment_expression ()); + + octave_value tmp_result = expr->rvalue1 (0); + + if (do_bind_ans && ! (error_state || tmp_result.is_undefined ())) + bind_ans (tmp_result, expr->print_result ()); + + // if (tmp_result.is_defined ()) + // result_values(0) = tmp_result; + } + } + catch (octave_execution_exception) + { + gripe_library_execution_error (); + } + } +} + +void +tree_evaluator::visit_statement_list (tree_statement_list& lst) +{ + static octave_value_list empty_list; + + if (error_state) + return; + + tree_statement_list::iterator p = lst.begin (); + + if (p != lst.end ()) + { + while (true) + { + tree_statement *elt = *p++; + + if (elt) + { + octave_quit (); + + elt->accept (*this); + + if (error_state) + break; + + if (tree_break_command::breaking + || tree_continue_command::continuing) + break; + + if (tree_return_command::returning) + break; + + if (p == lst.end ()) + break; + else + { + // Clear preivous values before next statement is + // evaluated so that we aren't holding an extra + // reference to a value that may be used next. For + // example, in code like this: + // + // X = rand (N); ## refcount for X should be 1 + // ## after this statement + // + // X(idx) = val; ## no extra copy of X should be + // ## needed, but we will be faked + // ## out if retval is not cleared + // ## between statements here + + // result_values = empty_list; + } + } + else + error ("invalid statement found in statement list!"); + } + } +} + +void +tree_evaluator::visit_switch_case (tree_switch_case&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_switch_case_list (tree_switch_case_list&) +{ + panic_impossible (); +} + +void +tree_evaluator::visit_switch_command (tree_switch_command& cmd) +{ + if (debug_mode) + do_breakpoint (cmd.is_breakpoint ()); + + tree_expression *expr = cmd.switch_value (); + + if (expr) + { + octave_value val = expr->rvalue1 (); + + tree_switch_case_list *lst = cmd.case_list (); + + if (! error_state && lst) + { + for (tree_switch_case_list::iterator p = lst->begin (); + p != lst->end (); p++) + { + tree_switch_case *t = *p; + + if (debug_mode && ! t->is_default_case ()) + do_breakpoint (t->is_breakpoint ()); + + if (t->is_default_case () || t->label_matches (val)) + { + if (error_state) + break; + + tree_statement_list *stmt_lst = t->commands (); + + if (stmt_lst) + stmt_lst->accept (*this); + + break; + } + } + } + } + else + ::error ("missing value in switch command near line %d, column %d", + cmd.line (), cmd.column ()); +} + +void +tree_evaluator::visit_try_catch_command (tree_try_catch_command& cmd) +{ + unwind_protect frame; + + frame.protect_var (buffer_error_messages); + frame.protect_var (Vdebug_on_error); + frame.protect_var (Vdebug_on_warning); + + buffer_error_messages++; + Vdebug_on_error = false; + Vdebug_on_warning = false; + + tree_statement_list *catch_code = cmd.cleanup (); + + // The catch code is *not* added to unwind_protect stack; it doesn't need + // to be run on interrupts. + + tree_statement_list *try_code = cmd.body (); + + if (try_code) + { + try_code->accept (*this); + // FIXME: should std::bad_alloc be handled here? + } + + if (error_state) + { + error_state = 0; + + if (catch_code) + { + // Set up for letting the user print any messages from errors that + // occurred in the body of the try_catch statement. + + buffer_error_messages--; + + if (catch_code) + catch_code->accept (*this); + } + } +} + +void +tree_evaluator::do_unwind_protect_cleanup_code (tree_statement_list *list) +{ + unwind_protect frame; + + frame.protect_var (octave_interrupt_state); + octave_interrupt_state = 0; + + // We want to run the cleanup code without error_state being set, + // but we need to restore its value, so that any errors encountered + // in the first part of the unwind_protect are not completely + // ignored. + + frame.protect_var (error_state); + error_state = 0; + + // We want to preserve the last statement indicator for possible + // backtracking. + frame.add_fcn (octave_call_stack::set_statement, + octave_call_stack::current_statement ()); + + // Similarly, if we have seen a return or break statement, allow all + // the cleanup code to run before returning or handling the break. + // We don't have to worry about continue statements because they can + // only occur in loops. + + frame.protect_var (tree_return_command::returning); + tree_return_command::returning = 0; + + frame.protect_var (tree_break_command::breaking); + tree_break_command::breaking = 0; + + if (list) + list->accept (*this); + + // The unwind_protects are popped off the stack in the reverse of + // the order they are pushed on. + + // FIXME -- these statements say that if we see a break or + // return statement in the cleanup block, that we want to use the + // new value of the breaking or returning flag instead of restoring + // the previous value. Is that the right thing to do? I think so. + // Consider the case of + // + // function foo () + // unwind_protect + // stderr << "1: this should always be executed\n"; + // break; + // stderr << "1: this should never be executed\n"; + // unwind_protect_cleanup + // stderr << "2: this should always be executed\n"; + // return; + // stderr << "2: this should never be executed\n"; + // end_unwind_protect + // endfunction + // + // If we reset the value of the breaking flag, both the returning + // flag and the breaking flag will be set, and we shouldn't have + // both. So, use the most recent one. If there is no return or + // break in the cleanup block, the values should be reset to + // whatever they were when the cleanup block was entered. + + if (tree_break_command::breaking || tree_return_command::returning) + { + frame.discard_top (2); + } + else + { + frame.run_top (2); + } + + // We don't want to ignore errors that occur in the cleanup code, so + // if an error is encountered there, leave error_state alone. + // Otherwise, set it back to what it was before. + + if (error_state) + frame.discard_top (2); + else + frame.run_top (2); + + frame.run (); +} + +void +tree_evaluator::visit_unwind_protect_command (tree_unwind_protect_command& cmd) +{ + tree_statement_list *cleanup_code = cmd.cleanup (); + + tree_statement_list *unwind_protect_code = cmd.body (); + + if (unwind_protect_code) + { + try + { + unwind_protect_code->accept (*this); + } + catch (...) + { + // Run the cleanup code on exceptions, so that it is run even in case + // of interrupt or out-of-memory. + do_unwind_protect_cleanup_code (cleanup_code); + // FIXME: should error_state be checked here? + // We want to rethrow the exception, even if error_state is set, so + // that interrupts continue. + throw; + } + + do_unwind_protect_cleanup_code (cleanup_code); + } +} + +void +tree_evaluator::visit_while_command (tree_while_command& cmd) +{ + if (error_state) + return; + +#if HAVE_LLVM + if (jiter.execute (cmd)) + return; +#endif + + unwind_protect frame; + + frame.protect_var (in_loop_command); + + in_loop_command = true; + + tree_expression *expr = cmd.condition (); + + if (! expr) + panic_impossible (); + + for (;;) + { + if (debug_mode) + do_breakpoint (cmd.is_breakpoint ()); + + if (expr->is_logically_true ("while")) + { + tree_statement_list *loop_body = cmd.body (); + + if (loop_body) + { + loop_body->accept (*this); + + if (error_state) + return; + } + + if (quit_loop_now ()) + break; + } + else + break; + } +} + +void +tree_evaluator::visit_do_until_command (tree_do_until_command& cmd) +{ + if (error_state) + return; + + unwind_protect frame; + + frame.protect_var (in_loop_command); + + in_loop_command = true; + + tree_expression *expr = cmd.condition (); + + if (! expr) + panic_impossible (); + + for (;;) + { + tree_statement_list *loop_body = cmd.body (); + + if (loop_body) + { + loop_body->accept (*this); + + if (error_state) + return; + } + + if (quit_loop_now ()) + break; + + if (debug_mode) + do_breakpoint (cmd.is_breakpoint ()); + + if (expr->is_logically_true ("do-until")) + break; + } +} + +void +tree_evaluator::do_breakpoint (tree_statement& stmt) const +{ + do_breakpoint (stmt.is_breakpoint (), stmt.is_end_of_fcn_or_script ()); +} + +void +tree_evaluator::do_breakpoint (bool is_breakpoint, + bool is_end_of_fcn_or_script) const +{ + bool break_on_this_statement = false; + + // Don't decrement break flag unless we are in the same frame as we + // were when we saw the "dbstep N" command. + + if (dbstep_flag > 1) + { + if (octave_call_stack::current_frame () == current_frame) + { + // Don't allow dbstep N to step past end of current frame. + + if (is_end_of_fcn_or_script) + dbstep_flag = 1; + else + dbstep_flag--; + } + } + + if (octave_debug_on_interrupt_state) + { + break_on_this_statement = true; + + octave_debug_on_interrupt_state = false; + + current_frame = octave_call_stack::current_frame (); + } + else if (is_breakpoint) + { + break_on_this_statement = true; + + dbstep_flag = 0; + + current_frame = octave_call_stack::current_frame (); + } + else if (dbstep_flag == 1) + { + if (octave_call_stack::current_frame () == current_frame) + { + // We get here if we are doing a "dbstep" or a "dbstep N" + // and the count has reached 1 and we are in the current + // debugging frame. + + break_on_this_statement = true; + + dbstep_flag = 0; + } + } + else if (dbstep_flag == -1) + { + // We get here if we are doing a "dbstep in". + + break_on_this_statement = true; + + dbstep_flag = 0; + + current_frame = octave_call_stack::current_frame (); + } + else if (dbstep_flag == -2) + { + // We get here if we are doing a "dbstep out". + + if (is_end_of_fcn_or_script) + dbstep_flag = -1; + } + + if (break_on_this_statement) + do_keyboard (); + +} + +// ARGS is currently unused, but since the do_keyboard function in +// input.cc accepts an argument list, we preserve it here so that the +// interface won't have to change if we decide to use it in the future. + +octave_value +tree_evaluator::do_keyboard (const octave_value_list& args) const +{ + return ::do_keyboard (args); +} + +DEFUN (max_recursion_depth, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} max_recursion_depth ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} max_recursion_depth (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} max_recursion_depth (@var{new_val}, \"local\")\n\ +Query or set the internal limit on the number of times a function may\n\ +be called recursively. If the limit is exceeded, an error message is\n\ +printed and control returns to the top level.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (max_recursion_depth); +} + +/* +%!test +%! orig_val = max_recursion_depth (); +%! old_val = max_recursion_depth (2*orig_val); +%! assert (orig_val, old_val); +%! assert (max_recursion_depth (), 2*orig_val); +%! max_recursion_depth (orig_val); +%! assert (max_recursion_depth (), orig_val); + +%!error (max_recursion_depth (1, 2)) +*/ + +DEFUN (silent_functions, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} silent_functions ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} silent_functions (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} silent_functions (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether internal\n\ +output from a function is suppressed. If this option is disabled,\n\ +Octave will display the results produced by evaluating expressions\n\ +within a function body that are not terminated with a semicolon.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (silent_functions); +} + +/* +%!test +%! orig_val = silent_functions (); +%! old_val = silent_functions (! orig_val); +%! assert (orig_val, old_val); +%! assert (silent_functions (), ! orig_val); +%! silent_functions (orig_val); +%! assert (silent_functions (), orig_val); + +%!error (silent_functions (1, 2)) +*/ diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-eval.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-eval.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,190 @@ +/* + +Copyright (C) 2009-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_eval_h) +#define octave_tree_eval_h 1 + +#include +#include + +#include "comment-list.h" +#include "oct-obj.h" +#include "pt-walk.h" + +class tree_expression; + +// How to evaluate the code that the parse trees represent. + +class +OCTINTERP_API +tree_evaluator : public tree_walker +{ +public: + + typedef void (*decl_elt_init_fcn) (tree_decl_elt&); + + tree_evaluator (void) { } + + ~tree_evaluator (void) { } + + void visit_anon_fcn_handle (tree_anon_fcn_handle&); + + void visit_argument_list (tree_argument_list&); + + void visit_binary_expression (tree_binary_expression&); + + void visit_break_command (tree_break_command&); + + void visit_colon_expression (tree_colon_expression&); + + void visit_continue_command (tree_continue_command&); + + void visit_global_command (tree_global_command&); + + void visit_persistent_command (tree_persistent_command&); + + void visit_decl_elt (tree_decl_elt&); + + void visit_decl_init_list (tree_decl_init_list&); + + void visit_simple_for_command (tree_simple_for_command&); + + void visit_complex_for_command (tree_complex_for_command&); + + void visit_octave_user_script (octave_user_script&); + + void visit_octave_user_function (octave_user_function&); + + void visit_octave_user_function_header (octave_user_function&); + + void visit_octave_user_function_trailer (octave_user_function&); + + void visit_function_def (tree_function_def&); + + void visit_identifier (tree_identifier&); + + void visit_if_clause (tree_if_clause&); + + void visit_if_command (tree_if_command&); + + void visit_if_command_list (tree_if_command_list&); + + void visit_index_expression (tree_index_expression&); + + void visit_matrix (tree_matrix&); + + void visit_cell (tree_cell&); + + void visit_multi_assignment (tree_multi_assignment&); + + void visit_no_op_command (tree_no_op_command&); + + void visit_constant (tree_constant&); + + void visit_fcn_handle (tree_fcn_handle&); + + void visit_parameter_list (tree_parameter_list&); + + void visit_postfix_expression (tree_postfix_expression&); + + void visit_prefix_expression (tree_prefix_expression&); + + void visit_return_command (tree_return_command&); + + void visit_return_list (tree_return_list&); + + void visit_simple_assignment (tree_simple_assignment&); + + void visit_statement (tree_statement&); + + void visit_statement_list (tree_statement_list&); + + void visit_switch_case (tree_switch_case&); + + void visit_switch_case_list (tree_switch_case_list&); + + void visit_switch_command (tree_switch_command&); + + void visit_try_catch_command (tree_try_catch_command&); + + void do_unwind_protect_cleanup_code (tree_statement_list *list); + + void visit_unwind_protect_command (tree_unwind_protect_command&); + + void visit_while_command (tree_while_command&); + + void visit_do_until_command (tree_do_until_command&); + + static void reset_debug_state (void); + + // If > 0, stop executing at the (N-1)th stopping point, counting + // from the the current execution point in the current frame. + // + // If < 0, stop executing at the next possible stopping point. + static int dbstep_flag; + + // The number of the stack frame we are currently debugging. + static size_t current_frame; + + static bool debug_mode; + + // Possible types of evaluation contexts. + enum stmt_list_type + { + function, // function body + script, // script file + other // command-line input or eval string + }; + + // The context for the current evaluation. + static stmt_list_type statement_context; + + // TRUE means we are evaluating some kind of looping construct. + static bool in_loop_command; + +private: + + void do_decl_init_list (decl_elt_init_fcn fcn, + tree_decl_init_list *init_list); + + void do_breakpoint (tree_statement& stmt) const; + + void do_breakpoint (bool is_breakpoint, + bool is_end_of_fcn_or_script = false) const; + + virtual octave_value + do_keyboard (const octave_value_list& args = octave_value_list ()) const; + + // No copying! + + tree_evaluator (const tree_evaluator&); + + tree_evaluator& operator = (const tree_evaluator&); +}; + +extern tree_evaluator *current_evaluator; + +// Maximum nesting level for functions, scripts, or sourced files called +// recursively. +extern int Vmax_recursion_depth; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-except.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-except.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,100 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "quit.h" + +#include "error.h" +#include "oct-lvalue.h" +#include "ov.h" +#include "pt-bp.h" +#include "pt-cmd.h" +#include "pt-except.h" +#include "pt-exp.h" +#include "pt-jump.h" +#include "pt-stmt.h" +#include "pt-walk.h" +#include "unwind-prot.h" +#include "variables.h" + +// Simple exception handling. + +tree_try_catch_command::~tree_try_catch_command (void) +{ + delete try_code; + delete catch_code; + delete lead_comm; + delete mid_comm; + delete trail_comm; +} + +tree_command * +tree_try_catch_command::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return new + tree_try_catch_command (try_code ? try_code->dup (scope, context) : 0, + catch_code ? catch_code->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0, + mid_comm ? mid_comm->dup () : 0, + trail_comm ? trail_comm->dup () : 0, + line (), column ()); +} + +void +tree_try_catch_command::accept (tree_walker& tw) +{ + tw.visit_try_catch_command (*this); +} + +// Simple exception handling. + +tree_unwind_protect_command::~tree_unwind_protect_command (void) +{ + delete unwind_protect_code; + delete cleanup_code; + delete lead_comm; + delete mid_comm; + delete trail_comm; +} + +tree_command * +tree_unwind_protect_command::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return new tree_unwind_protect_command + (unwind_protect_code ? unwind_protect_code->dup (scope, context) : 0, + cleanup_code ? cleanup_code->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0, + mid_comm ? mid_comm->dup () : 0, + trail_comm ? trail_comm->dup () : 0, + line (), column ()); +} + +void +tree_unwind_protect_command::accept (tree_walker& tw) +{ + tw.visit_unwind_protect_command (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-except.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-except.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,156 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_except_h) +#define octave_tree_except_h 1 + +class tree_statement_list; + +class tree_walker; + +#include "comment-list.h" +#include "pt-cmd.h" +#include "symtab.h" + +// Simple exception handling. + +class +tree_try_catch_command : public tree_command +{ +public: + + tree_try_catch_command (int l = -1, int c = -1) + : tree_command (l, c), try_code (0), catch_code (0), lead_comm (0), + mid_comm (0), trail_comm (0) { } + + tree_try_catch_command (tree_statement_list *tc, tree_statement_list *cc, + octave_comment_list *cl = 0, + octave_comment_list *cm = 0, + octave_comment_list *ct = 0, + int l = -1, int c = -1) + : tree_command (l, c), try_code (tc), catch_code (cc), + lead_comm (cl), mid_comm (cm), trail_comm (ct) { } + + ~tree_try_catch_command (void); + + tree_statement_list *body (void) { return try_code; } + + tree_statement_list *cleanup (void) { return catch_code; } + + octave_comment_list *leading_comment (void) { return lead_comm; } + + octave_comment_list *middle_comment (void) { return mid_comm; } + + octave_comment_list *trailing_comment (void) { return trail_comm; } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // The first block of code to attempt to execute. + tree_statement_list *try_code; + + // The code to execute if an error occurs in the first block. + tree_statement_list *catch_code; + + // Comment preceding TRY token. + octave_comment_list *lead_comm; + + // Comment preceding CATCH token. + octave_comment_list *mid_comm; + + // Comment preceding END_TRY_CATCH token. + octave_comment_list *trail_comm; + + // No copying! + + tree_try_catch_command (const tree_try_catch_command&); + + tree_try_catch_command& operator = (const tree_try_catch_command&); +}; + +// Simple exception handling. + +class +tree_unwind_protect_command : public tree_command +{ +public: + + tree_unwind_protect_command (int l = -1, int c = -1) + : tree_command (l, c), unwind_protect_code (0), cleanup_code (0), + lead_comm (0), mid_comm (0), trail_comm (0) { } + + tree_unwind_protect_command (tree_statement_list *tc, + tree_statement_list *cc, + octave_comment_list *cl = 0, + octave_comment_list *cm = 0, + octave_comment_list *ct = 0, + int l = -1, int c = -1) + : tree_command (l, c), unwind_protect_code (tc), cleanup_code (cc), + lead_comm (cl), mid_comm (cm), trail_comm (ct) { } + + ~tree_unwind_protect_command (void); + + tree_statement_list *body (void) { return unwind_protect_code; } + + tree_statement_list *cleanup (void) { return cleanup_code; } + + octave_comment_list *leading_comment (void) { return lead_comm; } + + octave_comment_list *middle_comment (void) { return mid_comm; } + + octave_comment_list *trailing_comment (void) { return trail_comm; } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // The first body of code to attempt to execute. + tree_statement_list *unwind_protect_code; + + // The body of code to execute no matter what happens in the first + // body of code. + tree_statement_list *cleanup_code; + + // Comment preceding UNWIND_PROTECT token. + octave_comment_list *lead_comm; + + // Comment preceding UNWIND_PROTECT_CLEANUP token. + octave_comment_list *mid_comm; + + // Comment preceding END_UNWIND_PROTECT token. + octave_comment_list *trail_comm; + + // No copying! + + tree_unwind_protect_command (const tree_unwind_protect_command&); + + tree_unwind_protect_command& operator = (const tree_unwind_protect_command&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-exp.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-exp.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,88 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "error.h" +#include "pager.h" +#include "oct-lvalue.h" +#include "ov.h" +#include "pt-exp.h" + +// Expressions. + +bool +tree_expression::is_logically_true (const char *warn_for) +{ + bool expr_value = false; + + octave_value t1 = rvalue1 (); + + if (! error_state) + { + if (t1.is_defined ()) + return t1.is_true (); + else + ::error ("%s: undefined value used in conditional expression", + warn_for); + } + + return expr_value; +} + +octave_value +tree_expression::rvalue1 (int) +{ + ::error ("invalid rvalue function called in expression"); + return octave_value (); +} + +octave_value_list +tree_expression::rvalue (int) +{ + ::error ("invalid rvalue function called in expression"); + return octave_value_list (); +} + +octave_value_list +tree_expression::rvalue (int nargout, const std::list *) +{ + return rvalue (nargout); +} + +octave_lvalue +tree_expression::lvalue (void) +{ + ::error ("invalid lvalue function called in expression"); + return octave_lvalue (); +} + +std::string +tree_expression::original_text (void) const +{ + return std::string (); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-exp.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-exp.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,151 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_expr_h) +#define octave_tree_expr_h 1 + +#include +#include + +class octave_value; +class octave_lvalue; + +#include "pt.h" +#include "symtab.h" + +// A base class for expressions. + +class +tree_expression : public tree +{ +public: + + tree_expression (int l = -1, int c = -1) + : tree (l, c), num_parens (0), postfix_indexed (false), + print_flag (false) { } + + virtual ~tree_expression (void) { } + + virtual bool has_magic_end (void) const = 0; + + virtual tree_expression *dup (symbol_table::scope_id, + symbol_table::context_id context) const = 0; + + virtual bool is_constant (void) const { return false; } + + virtual bool is_matrix_constant (void) const { return false; } + + virtual bool is_identifier (void) const { return false; } + + virtual bool is_index_expression (void) const { return false; } + + virtual bool is_assignment_expression (void) const { return false; } + + virtual bool is_prefix_expression (void) const { return false; } + + virtual bool is_unary_expression (void) const { return false; } + + virtual bool is_binary_expression (void) const { return false; } + + virtual bool is_boolean_expression (void) const { return false; } + + virtual bool is_logically_true (const char *); + + virtual bool lvalue_ok (void) const { return false; } + + virtual bool rvalue_ok (void) const { return false; } + + virtual octave_value rvalue1 (int nargout = 1); + + virtual octave_value_list rvalue (int nargout); + + virtual octave_value_list rvalue (int nargout, + const std::list *lvalue_list); + + virtual octave_lvalue lvalue (void); + + int paren_count (void) const { return num_parens; } + + bool is_postfix_indexed (void) const { return postfix_indexed; } + + bool print_result (void) const { return print_flag; } + + virtual std::string oper (void) const { return ""; } + + virtual std::string name (void) const { return ""; } + + virtual std::string original_text (void) const; + + virtual void mark_braindead_shortcircuit (const std::string&) { } + + tree_expression *mark_in_parens (void) + { + num_parens++; + return this; + } + + tree_expression *mark_postfix_indexed (void) + { + postfix_indexed = true; + return this; + } + + tree_expression *set_print_flag (bool print) + { + print_flag = print; + return this; + } + + virtual void copy_base (const tree_expression& e) + { + num_parens = e.num_parens; + postfix_indexed = e.postfix_indexed; + print_flag = e.print_flag; + } + +protected: + + // A count of the number of times this expression appears directly + // inside a set of parentheses. + // + // (((e1)) + e2) ==> 2 for expression e1 + // ==> 1 for expression ((e1)) + e2 + // ==> 0 for expression e2 + int num_parens; + + // A flag that says whether this expression has an index associated + // with it. See the code in tree_identifier::rvalue for the rationale. + bool postfix_indexed; + + // Print result of rvalue for this expression? + bool print_flag; + +private: + + // No copying! + + tree_expression (const tree_expression&); + + tree_expression& operator = (const tree_expression&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-fcn-handle.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-fcn-handle.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,207 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "error.h" +#include "oct-obj.h" +#include "ov-fcn-handle.h" +#include "pt-fcn-handle.h" +#include "pager.h" +#include "pt-const.h" +#include "pt-walk.h" +#include "variables.h" + +void +tree_fcn_handle::print (std::ostream& os, bool pr_as_read_syntax, + bool pr_orig_text) +{ + print_raw (os, pr_as_read_syntax, pr_orig_text); +} + +void +tree_fcn_handle::print_raw (std::ostream& os, bool pr_as_read_syntax, + bool pr_orig_text) +{ + os << ((pr_as_read_syntax || pr_orig_text) ? "@" : "") << nm; +} + +octave_value +tree_fcn_handle::rvalue1 (int) +{ + return make_fcn_handle (nm); +} + +octave_value_list +tree_fcn_handle::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("invalid number of output arguments for function handle expression"); + else + retval = rvalue1 (nargout); + + return retval; +} + +tree_expression * +tree_fcn_handle::dup (symbol_table::scope_id, + symbol_table::context_id) const +{ + tree_fcn_handle *new_fh = new tree_fcn_handle (nm, line (), column ()); + + new_fh->copy_base (*this); + + return new_fh; +} + +void +tree_fcn_handle::accept (tree_walker& tw) +{ + tw.visit_fcn_handle (*this); +} + +octave_value +tree_anon_fcn_handle::rvalue1 (int) +{ + // FIXME -- should CMD_LIST be limited to a single expression? + // I think that is what Matlab does. + + tree_parameter_list *param_list = parameter_list (); + tree_parameter_list *ret_list = return_list (); + tree_statement_list *cmd_list = body (); + symbol_table::scope_id this_scope = scope (); + + symbol_table::scope_id new_scope = symbol_table::dup_scope (this_scope); + + if (new_scope > 0) + symbol_table::inherit (new_scope, symbol_table::current_scope (), + symbol_table::current_context ()); + + octave_user_function *uf + = new octave_user_function (new_scope, + param_list ? param_list->dup (new_scope, 0) : 0, + ret_list ? ret_list->dup (new_scope, 0) : 0, + cmd_list ? cmd_list->dup (new_scope, 0) : 0); + + octave_function *curr_fcn = octave_call_stack::current (); + + if (curr_fcn) + { + // FIXME -- maybe it would be better to just stash curr_fcn + // instead of individual bits of info about it? + + uf->stash_parent_fcn_name (curr_fcn->name ()); + uf->stash_dir_name (curr_fcn->dir_name ()); + + symbol_table::scope_id parent_scope = curr_fcn->parent_fcn_scope (); + + if (parent_scope < 0) + parent_scope = curr_fcn->scope (); + + uf->stash_parent_fcn_scope (parent_scope); + + if (curr_fcn->is_class_method () || curr_fcn->is_class_constructor ()) + uf->stash_dispatch_class (curr_fcn->dispatch_class ()); + } + + uf->mark_as_anonymous_function (); + uf->stash_fcn_file_name (file_name); + uf->stash_fcn_location (line (), column ()); + + octave_value ov_fcn (uf); + + octave_value fh (octave_fcn_binder::maybe_binder (ov_fcn)); + + return fh; +} + +/* +%!function r = __f2 (f, x) +%! r = f (x); +%!endfunction +%!function f = __f1 (k) +%! f = @(x) __f2 (@(y) y-k, x); +%!endfunction + +%!assert ((__f1 (3)) (10) == 7) + +%!test +%! g = @(t) feval (@(x) t*x, 2); +%! assert (g(0.5) == 1); + +%!test +%! h = @(x) sin (x); +%! g = @(f, x) h (x); +%! f = @() g (@(x) h, pi); +%! assert (f () == sin (pi)); +*/ + +octave_value_list +tree_anon_fcn_handle::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("invalid number of output arguments for anonymous function handle expression"); + else + retval = rvalue1 (nargout); + + return retval; +} + +tree_expression * +tree_anon_fcn_handle::dup (symbol_table::scope_id, + symbol_table::context_id) const +{ + tree_parameter_list *param_list = parameter_list (); + tree_parameter_list *ret_list = return_list (); + tree_statement_list *cmd_list = body (); + symbol_table::scope_id this_scope = scope (); + + symbol_table::scope_id new_scope = symbol_table::dup_scope (this_scope); + + if (new_scope > 0) + symbol_table::inherit (new_scope, symbol_table::current_scope (), + symbol_table::current_context ()); + + tree_anon_fcn_handle *new_afh = new + tree_anon_fcn_handle (param_list ? param_list->dup (new_scope, 0) : 0, + ret_list ? ret_list->dup (new_scope, 0) : 0, + cmd_list ? cmd_list->dup (new_scope, 0) : 0, + new_scope, line (), column ()); + + new_afh->copy_base (*this); + + return new_afh; +} + +void +tree_anon_fcn_handle::accept (tree_walker& tw) +{ + tw.visit_anon_fcn_handle (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-fcn-handle.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-fcn-handle.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,156 @@ +/* + +Copyright (C) 2003-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_fcn_handle_h) +#define octave_fcn_handle_h 1 + +#include +#include + +#include "pt-bp.h" +#include "pt-exp.h" +#include "pt-misc.h" +#include "pt-stmt.h" +#include "symtab.h" + +class octave_value_list; + +class tree_walker; + +#include "ov.h" +#include "ov-usr-fcn.h" +#include "symtab.h" + +class +tree_fcn_handle : public tree_expression +{ +public: + + tree_fcn_handle (int l = -1, int c = -1) + : tree_expression (l, c), nm () { } + + tree_fcn_handle (const std::string& n, int l = -1, int c = -1) + : tree_expression (l, c), nm (n) { } + + ~tree_fcn_handle (void) { } + + bool has_magic_end (void) const { return false; } + + void print (std::ostream& os, bool pr_as_read_syntax = false, + bool pr_orig_txt = true); + + void print_raw (std::ostream& os, bool pr_as_read_syntax = false, + bool pr_orig_txt = true); + + std::string name (void) const { return nm; } + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // The name of this function handle. + std::string nm; + + // No copying! + + tree_fcn_handle (const tree_fcn_handle&); + + tree_fcn_handle& operator = (const tree_fcn_handle&); +}; + +class +tree_anon_fcn_handle : public tree_expression +{ +public: + + tree_anon_fcn_handle (int l = -1, int c = -1) + : tree_expression (l, c), fcn (0), file_name () { } + + tree_anon_fcn_handle (tree_parameter_list *pl, tree_parameter_list *rl, + tree_statement_list *cl, symbol_table::scope_id sid, + int l = -1, int c = -1) + : tree_expression (l, c), + fcn (new octave_user_function (sid, pl, rl, cl)), + file_name () { } + + ~tree_anon_fcn_handle (void) { delete fcn; } + + bool has_magic_end (void) const { return false; } + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + tree_parameter_list *parameter_list (void) const + { + return fcn ? fcn->parameter_list () : 0; + } + + tree_parameter_list *return_list (void) const + { + return fcn ? fcn->return_list () : 0; + } + + tree_statement_list *body (void) const + { + return fcn ? fcn->body () : 0; + } + + symbol_table::scope_id scope (void) const + { + return fcn ? fcn->scope () : -1; + } + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + + void stash_file_name (const std::string& file) { file_name = file; } + +private: + + // The function. + octave_user_function *fcn; + + // Filename where the handle was defined. + std::string file_name; + + // No copying! + + tree_anon_fcn_handle (const tree_anon_fcn_handle&); + + tree_anon_fcn_handle& operator = (const tree_anon_fcn_handle&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-id.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-id.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,145 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "pager.h" +#include "pt-bp.h" +#include "pt-const.h" +#include "pt-id.h" +#include "pt-walk.h" +#include "symtab.h" +#include "utils.h" +#include "variables.h" + +// Symbols from the symbol table. + +void +tree_identifier::eval_undefined_error (void) +{ + int l = line (); + int c = column (); + + maybe_missing_function_hook (name ()); + if (error_state) + return; + + if (l == -1 && c == -1) + ::error_with_id ("Octave:undefined-function", + "`%s' undefined", name ().c_str ()); + else + ::error_with_id ("Octave:undefined-function", + "`%s' undefined near line %d column %d", + name ().c_str (), l, c); +} + +octave_value_list +tree_identifier::rvalue (int nargout) +{ + octave_value_list retval; + + if (error_state) + return retval; + + octave_value val = sym->find (); + + if (val.is_defined ()) + { + // GAGME -- this would be cleaner if we required + // parens to indicate function calls. + // + // If this identifier refers to a function, we need to know + // whether it is indexed so that we can do the same thing + // for `f' and `f()'. If the index is present, return the + // function object and let tree_index_expression::rvalue + // handle indexing. Otherwise, arrange to call the function + // here, so that we don't return the function definition as + // a value. + + if (val.is_function () && ! is_postfix_indexed ()) + { + octave_value_list tmp_args; + + retval = val.do_multi_index_op (nargout, tmp_args); + } + else + { + if (print_result () && nargout == 0) + val.print_with_name (octave_stdout, name ()); + + retval = val; + } + } + else + eval_undefined_error (); + + return retval; +} + +octave_value +tree_identifier::rvalue1 (int nargout) +{ + octave_value retval; + + octave_value_list tmp = rvalue (nargout); + + if (! tmp.empty ()) + retval = tmp(0); + + return retval; +} + +octave_lvalue +tree_identifier::lvalue (void) +{ + return octave_lvalue (&(sym->varref ())); +} + +tree_identifier * +tree_identifier::dup (symbol_table::scope_id sc, + symbol_table::context_id) const +{ + // The new tree_identifier object contains a symbol_record + // entry from the duplicated scope. + + // FIXME -- is this the best way? + symbol_table::symbol_record new_sym + = symbol_table::find_symbol (name (), sc); + + tree_identifier *new_id + = new tree_identifier (new_sym, line (), column ()); + + new_id->copy_base (*this); + + return new_id; +} + +void +tree_identifier::accept (tree_walker& tw) +{ + tw.visit_identifier (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-id.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-id.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,155 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_identifier_h) +#define octave_tree_identifier_h 1 + +#include +#include + +class octave_value; +class octave_value_list; +class octave_function; + +class tree_walker; + +#include "pt-bp.h" +#include "pt-exp.h" +#include "symtab.h" + +// Symbols from the symbol table. + +class +tree_identifier : public tree_expression +{ + friend class tree_index_expression; + +public: + + tree_identifier (int l = -1, int c = -1) + : tree_expression (l, c) { } + + tree_identifier (const symbol_table::symbol_record& s, + int l = -1, int c = -1, + symbol_table::scope_id sc = symbol_table::current_scope ()) + : tree_expression (l, c), sym (s, sc) { } + + ~tree_identifier (void) { } + + bool has_magic_end (void) const { return (name () == "__end__"); } + + bool is_identifier (void) const { return true; } + + // The name doesn't change with scope, so use sym instead of + // accessing it through sym so that this function may remain const. + std::string name (void) const { return sym.name (); } + + bool is_defined (void) { return sym->is_defined (); } + + virtual bool is_variable (void) { return sym->is_variable (); } + + virtual bool is_black_hole (void) { return false; } + + // Try to find a definition for an identifier. Here's how: + // + // * If the identifier is already defined and is a function defined + // in an function file that has been modified since the last time + // we parsed it, parse it again. + // + // * If the identifier is not defined, try to find a builtin + // variable or an already compiled function with the same name. + // + // * If the identifier is still undefined, try looking for an + // function file to parse. + // + // * On systems that support dynamic linking, we prefer .oct files, + // then .mex files, then .m files. + + octave_value + do_lookup (const octave_value_list& args = octave_value_list ()) + { + return sym->find (args); + } + + void mark_global (void) { sym->mark_global (); } + + void mark_as_static (void) { sym->init_persistent (); } + + void mark_as_formal_parameter (void) { sym->mark_formal (); } + + // We really need to know whether this symbol referst to a variable + // or a function, but we may not know that yet. + + bool lvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + octave_lvalue lvalue (void); + + void eval_undefined_error (void); + + tree_identifier *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + + symbol_table::symbol_reference symbol (void) const + { + return sym; + } +private: + + // The symbol record that this identifier references. + symbol_table::symbol_reference sym; + + // No copying! + + tree_identifier (const tree_identifier&); + + tree_identifier& operator = (const tree_identifier&); +}; + +class tree_black_hole : public tree_identifier +{ +public: + + tree_black_hole (int l = -1, int c = -1) + : tree_identifier (l, c) { } + + std::string name (void) const { return "~"; } + + bool is_variable (void) { return false; } + + bool is_black_hole (void) { return true; } + + tree_black_hole *dup (void) const + { return new tree_black_hole; } + + octave_lvalue lvalue (void) + { + return octave_lvalue (0); // black hole lvalue + } +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-idx.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-idx.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,687 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "Cell.h" +#include "error.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "ov.h" +#include "pager.h" +#include "pt-arg-list.h" +#include "pt-bp.h" +#include "pt-id.h" +#include "pt-idx.h" +#include "pt-walk.h" +#include "utils.h" +#include "variables.h" +#include "gripes.h" + +// Index expressions. + +tree_index_expression::tree_index_expression (int l, int c) + : tree_expression (l, c), expr (0), args (0), type (), + arg_nm (), dyn_field () { } + +tree_index_expression::tree_index_expression (tree_expression *e, + tree_argument_list *lst, + int l, int c, char t) + : tree_expression (l, c), expr (e), args (0), type (), + arg_nm (), dyn_field () +{ + append (lst, t); +} + +tree_index_expression::tree_index_expression (tree_expression *e, + const std::string& n, + int l, int c) + : tree_expression (l, c), expr (e), args (0), type (), + arg_nm (), dyn_field () +{ + append (n); +} + +tree_index_expression::tree_index_expression (tree_expression *e, + tree_expression *df, + int l, int c) + : tree_expression (l, c), expr (e), args (0), type (), + arg_nm (), dyn_field () +{ + append (df); +} + +void +tree_index_expression::append (tree_argument_list *lst, char t) +{ + args.push_back (lst); + type.append (1, t); + arg_nm.push_back (lst ? lst->get_arg_names () : string_vector ()); + dyn_field.push_back (static_cast (0)); + + if (lst && lst->has_magic_tilde ()) + error ("invalid use of empty argument (~) in index expression"); +} + +void +tree_index_expression::append (const std::string& n) +{ + args.push_back (static_cast (0)); + type.append ("."); + arg_nm.push_back (n); + dyn_field.push_back (static_cast (0)); +} + +void +tree_index_expression::append (tree_expression *df) +{ + args.push_back (static_cast (0)); + type.append ("."); + arg_nm.push_back (""); + dyn_field.push_back (df); +} + +tree_index_expression::~tree_index_expression (void) +{ + delete expr; + + while (! args.empty ()) + { + std::list::iterator p = args.begin (); + delete *p; + args.erase (p); + } + + while (! dyn_field.empty ()) + { + std::list::iterator p = dyn_field.begin (); + delete *p; + dyn_field.erase (p); + } +} + +bool +tree_index_expression::has_magic_end (void) const +{ + for (std::list::const_iterator p = args.begin (); + p != args.end (); + p++) + { + tree_argument_list *elt = *p; + + if (elt && elt->has_magic_end ()) + return true; + } + + return false; +} + +// This is useful for printing the name of the variable in an indexed +// assignment. + +std::string +tree_index_expression::name (void) const +{ + return expr->name (); +} + +static Cell +make_subs_cell (tree_argument_list *args, const string_vector& arg_nm) +{ + Cell retval; + + octave_value_list arg_values; + + if (args) + arg_values = args->convert_to_const_vector (); + + if (! error_state) + { + int n = arg_values.length (); + + if (n > 0) + { + arg_values.stash_name_tags (arg_nm); + + retval.resize (dim_vector (1, n)); + + for (int i = 0; i < n; i++) + retval(0,i) = arg_values(i); + } + } + + return retval; +} + +static inline octave_value_list +make_value_list (tree_argument_list *args, const string_vector& arg_nm, + const octave_value *object, bool rvalue = true) +{ + octave_value_list retval; + + if (args) + { + if (rvalue && object && args->has_magic_end () && object->is_undefined ()) + gripe_invalid_inquiry_subscript (); + else + retval = args->convert_to_const_vector (object); + } + + if (! error_state) + { + octave_idx_type n = retval.length (); + + if (n > 0) + retval.stash_name_tags (arg_nm); + } + + return retval; +} + +std::string +tree_index_expression::get_struct_index + (std::list::const_iterator p_arg_nm, + std::list::const_iterator p_dyn_field) const +{ + std::string fn = (*p_arg_nm)(0); + + if (fn.empty ()) + { + tree_expression *df = *p_dyn_field; + + if (df) + { + octave_value t = df->rvalue1 (); + + if (! error_state) + { + fn = t.string_value (); + + if (! valid_identifier (fn)) + ::error ("invalid structure field name `%s'", fn.c_str ()); + } + } + else + panic_impossible (); + } + + return fn; +} + +octave_map +tree_index_expression::make_arg_struct (void) const +{ + int n = args.size (); + + Cell type_field (n, 1); + Cell subs_field (n, 1); + + std::list::const_iterator p_args = args.begin (); + std::list::const_iterator p_arg_nm = arg_nm.begin (); + std::list::const_iterator p_dyn_field = dyn_field.begin (); + + octave_map m; + + for (int i = 0; i < n; i++) + { + switch (type[i]) + { + case '(': + subs_field(i) = make_subs_cell (*p_args, *p_arg_nm); + break; + + case '{': + subs_field(i) = make_subs_cell (*p_args, *p_arg_nm); + break; + + case '.': + subs_field(i) = get_struct_index (p_arg_nm, p_dyn_field); + break; + + default: + panic_impossible (); + } + + if (error_state) + return m; + + p_args++; + p_arg_nm++; + p_dyn_field++; + } + + m.assign ("type", type_field); + m.assign ("subs", subs_field); + + return m; +} + +octave_value_list +tree_index_expression::rvalue (int nargout) +{ + return tree_index_expression::rvalue (nargout, 0); +} + +octave_value_list +tree_index_expression::rvalue (int nargout, const std::list *lvalue_list) +{ + octave_value_list retval; + + if (error_state) + return retval; + + octave_value first_expr_val; + + octave_value_list first_args; + + bool have_args = false; + + if (expr->is_identifier () && type[0] == '(') + { + tree_identifier *id = dynamic_cast (expr); + + if (! (id->is_variable () || args.empty ())) + { + tree_argument_list *al = *(args.begin ()); + + size_t n = al ? al->length () : 0; + + if (n > 0) + { + string_vector anm = *(arg_nm.begin ()); + have_args = true; + first_args = al -> convert_to_const_vector (); + first_args.stash_name_tags (anm); + + if (! error_state) + first_expr_val = id->do_lookup (first_args); + } + } + } + + if (! error_state) + { + if (first_expr_val.is_undefined ()) + first_expr_val = expr->rvalue1 (); + + octave_value tmp = first_expr_val; + octave_idx_type tmpi = 0; + + std::list idx; + + int n = args.size (); + + std::list::iterator p_args = args.begin (); + std::list::iterator p_arg_nm = arg_nm.begin (); + std::list::iterator p_dyn_field = dyn_field.begin (); + + for (int i = 0; i < n; i++) + { + if (i > 0) + { + tree_argument_list *al = *p_args; + + // In Matlab, () can only be followed by . In Octave, we do not + // enforce this for rvalue expressions, but we'll split the + // evaluation at this point. This will, hopefully, allow Octave's + // looser rules apply smoothly for Matlab overloaded subsref + // codes. + bool force_split = type[i-1] == '(' && type[i] != '.'; + + if (force_split || (al && al->has_magic_end ())) + { + // We have an expression like + // + // x{end}.a(end) + // + // and we are looking at the argument list that + // contains the second (or third, etc.) "end" token, + // so we must evaluate everything up to the point of + // that argument list so we can pass the appropriate + // value to the built-in __end__ function. + + const octave_value_list tmp_list + = tmp.subsref (type.substr (tmpi, i - tmpi), idx, nargout); + + tmp = tmp_list.length () ? tmp_list(0) : octave_value (); + tmpi = i; + idx.clear (); + + if (tmp.is_cs_list ()) + gripe_indexed_cs_list (); + + if (error_state) + break; + } + } + + switch (type[i]) + { + case '(': + if (have_args) + { + idx.push_back (first_args); + have_args = false; + } + else + idx.push_back (make_value_list (*p_args, *p_arg_nm, &tmp)); + break; + + case '{': + idx.push_back (make_value_list (*p_args, *p_arg_nm, &tmp)); + break; + + case '.': + idx.push_back (octave_value (get_struct_index (p_arg_nm, p_dyn_field))); + break; + + default: + panic_impossible (); + } + + if (error_state) + break; + + p_args++; + p_arg_nm++; + p_dyn_field++; + } + + if (! error_state) + retval = tmp.subsref (type.substr (tmpi, n - tmpi), idx, nargout, + lvalue_list); + } + + return retval; +} + +octave_value +tree_index_expression::rvalue1 (int nargout) +{ + octave_value retval; + + const octave_value_list tmp = rvalue (nargout); + + if (! tmp.empty ()) + retval = tmp(0); + + return retval; +} + +octave_lvalue +tree_index_expression::lvalue (void) +{ + octave_lvalue retval; + + std::list idx; + std::string tmp_type; + + int n = args.size (); + + std::list::iterator p_args = args.begin (); + std::list::iterator p_arg_nm = arg_nm.begin (); + std::list::iterator p_dyn_field = dyn_field.begin (); + + retval = expr->lvalue (); + + if (! error_state) + { + const octave_value *tro = retval.object (); + + octave_value tmp; + + if (tro) + tmp = *tro; + + octave_idx_type tmpi = 0; + std::list tmpidx; + + for (int i = 0; i < n; i++) + { + if (retval.numel () != 1) + gripe_indexed_cs_list (); + else if (tmpi < i) + { + tmp = tmp.subsref (type.substr (tmpi, i - tmpi), tmpidx, true); + tmpidx.clear (); + } + + if (error_state) + break; + + switch (type[i]) + { + case '(': + { + octave_value_list tidx + = make_value_list (*p_args, *p_arg_nm, &tmp, false); + + idx.push_back (tidx); + + if (i < n - 1) + { + if (type[i+1] == '.') + { + tmpidx.push_back (tidx); + tmpi = i+1; + } + else + error ("() must be followed by . or close the index chain"); + } + } + break; + + case '{': + { + octave_value_list tidx + = make_value_list (*p_args, *p_arg_nm, &tmp, false); + + if (tmp.is_undefined ()) + { + if (tidx.has_magic_colon ()) + gripe_invalid_inquiry_subscript (); + else + tmp = Cell (); + } + else if (tmp.is_zero_by_zero () + && (tmp.is_matrix_type () || tmp.is_string ())) + { + tmp = Cell (); + } + + retval.numel (tmp.numel (tidx)); + + if (error_state) + break; + + idx.push_back (tidx); + tmpidx.push_back (tidx); + tmpi = i; + } + break; + + case '.': + { + octave_value tidx = get_struct_index (p_arg_nm, p_dyn_field); + if (error_state) + break; + + bool autoconv = (tmp.is_zero_by_zero () + && (tmp.is_matrix_type () || tmp.is_string () + || tmp.is_cell ())); + + if (i > 0 && type[i-1] == '(') + { + octave_value_list pidx = idx.back (); + + // Use octave_map, not octave_scalar_map so that the + // dimensions are 0x0, not 1x1. + if (tmp.is_undefined ()) + { + if (pidx.has_magic_colon ()) + gripe_invalid_inquiry_subscript (); + else + tmp = octave_map (); + } + else if (autoconv) + tmp = octave_map (); + + retval.numel (tmp.numel (pidx)); + + tmpi = i-1; + tmpidx.push_back (tidx); + } + else + { + if (tmp.is_undefined () || autoconv) + { + tmpi = i+1; + tmp = octave_value (); + } + else + { + retval.numel (tmp.numel (octave_value_list ())); + + tmpi = i; + tmpidx.push_back (tidx); + } + } + + if (error_state) + break; + + idx.push_back (tidx); + } + break; + + default: + panic_impossible (); + } + + if (idx.back ().empty ()) + error ("invalid empty index list"); + + if (error_state) + break; + + p_args++; + p_arg_nm++; + p_dyn_field++; + } + + if (! error_state) + retval.set_index (type, idx); + + } + + return retval; +} + +/* +%!test +%! clear x; +%! clear y; +%! y = 3; +%! x(y(end)) = 1; +%! assert (x, [0, 0, 1]); +%! clear x; +%! clear y; +%! y = {3}; +%! x(y{end}) = 1; +%! assert (x, [0, 0, 1]); + +%!test +%! x = {1, 2, 3}; +%! [x{:}] = deal (4, 5, 6); +%! assert (x, {4, 5, 6}); + +%!test +%! [x.a, x.b.c] = deal (1, 2); +%! assert (x.a == 1 && x.b.c == 2); + +%!test +%! [x.a, x(2).b] = deal (1, 2); +%! assert (x(1).a == 1 && isempty (x(2).a) && isempty (x(1).b) && x(2).b == 2); + +%!test +%! x = struct (zeros (0, 1), {"a", "b"}); +%! x(2).b = 1; +%! assert (x(2).b == 1); + +%!test +%! x = struct (zeros (0, 1), {"a", "b"}); +%! x(2).b = 1; +%! assert (x(2).b == 1); +*/ + +tree_index_expression * +tree_index_expression::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_index_expression *new_idx_expr + = new tree_index_expression (line (), column ()); + + new_idx_expr->expr = expr ? expr->dup (scope, context) : 0; + + std::list new_args; + + for (std::list::const_iterator p = args.begin (); + p != args.end (); + p++) + { + const tree_argument_list *elt = *p; + + new_args.push_back (elt ? elt->dup (scope, context) : 0); + } + + new_idx_expr->args = new_args; + + new_idx_expr->type = type; + + new_idx_expr->arg_nm = arg_nm; + + std::list new_dyn_field; + + for (std::list::const_iterator p = dyn_field.begin (); + p != dyn_field.end (); + p++) + { + const tree_expression *elt = *p; + + new_dyn_field.push_back (elt ? elt->dup (scope, context) : 0); + } + + new_idx_expr->dyn_field = new_dyn_field; + + new_idx_expr->copy_base (*this); + + return new_idx_expr; +} + +void +tree_index_expression::accept (tree_walker& tw) +{ + tw.visit_index_expression (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-idx.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-idx.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,131 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_index_h) +#define octave_tree_index_h 1 + +#include + +class tree_argument_list; + +class tree_walker; + +class octave_map; +class octave_value; +class octave_value_list; +class octave_lvalue; + +#include "str-vec.h" + +#include "pt-exp.h" +#include "symtab.h" + +// Index expressions. + +class +tree_index_expression : public tree_expression +{ +public: + + tree_index_expression (tree_expression *e = 0, tree_argument_list *lst = 0, + int l = -1, int c = -1, char t = '('); + + tree_index_expression (tree_expression *e, const std::string& n, + int l = -1, int c = -1); + + tree_index_expression (tree_expression *e, tree_expression* df, + int l = -1, int c = -1); + + ~tree_index_expression (void); + + bool has_magic_end (void) const; + + void append (tree_argument_list *lst = 0, char t = '('); + + void append (const std::string& n); + + void append (tree_expression *df); + + bool is_index_expression (void) const { return true; } + + std::string name (void) const; + + tree_expression *expression (void) { return expr; } + + std::list arg_lists (void) { return args; } + + std::string type_tags (void) { return type; } + + std::list arg_names (void) { return arg_nm; } + + bool lvalue_ok (void) const { return expr->lvalue_ok (); } + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + octave_value_list rvalue (int nargout, const std::list *lvalue_list); + + octave_lvalue lvalue (void); + + tree_index_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // The LHS of this index expression. + tree_expression *expr; + + // The indices (only valid if type == paren || type == brace). + std::list args; + + // The type of this index expression. + std::string type; + + // The names of the arguments. Used for constant struct element + // references. + std::list arg_nm; + + // The list of dynamic field names, if any. + std::list dyn_field; + + tree_index_expression (int l, int c); + + octave_map make_arg_struct (void) const; + + std::string + get_struct_index + (std::list::const_iterator p_arg_nm, + std::list::const_iterator p_dyn_field) const; + + // No copying! + + tree_index_expression (const tree_index_expression&); + + tree_index_expression& operator = (const tree_index_expression&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-jump.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-jump.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,87 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "oct-obj.h" +#include "pt-bp.h" +#include "pt-jump.h" +#include "pt-walk.h" + +class octave_value_list; + +// Break. + +// Nonzero means we're breaking out of a loop or function body. +int tree_break_command::breaking = 0; + +tree_command * +tree_break_command::dup (symbol_table::scope_id, + symbol_table::context_id) const +{ + return new tree_break_command (line (), column ()); +} + +void +tree_break_command::accept (tree_walker& tw) +{ + tw.visit_break_command (*this); +} + +// Continue. + +// Nonzero means we're jumping to the end of a loop. +int tree_continue_command::continuing = 0; + +tree_command * +tree_continue_command::dup (symbol_table::scope_id, + symbol_table::context_id) const +{ + return new tree_continue_command (line (), column ()); +} + +void +tree_continue_command::accept (tree_walker& tw) +{ + tw.visit_continue_command (*this); +} + +// Return. + +// Nonzero means we're returning from a function. +int tree_return_command::returning = 0; + +tree_command * +tree_return_command::dup (symbol_table::scope_id, + symbol_table::context_id) const +{ + return new tree_return_command (line (), column ()); +} + +void +tree_return_command::accept (tree_walker& tw) +{ + tw.visit_return_command (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-jump.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-jump.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,115 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_jump_h) +#define octave_tree_jump_h 1 + +class tree_walker; + +#include "pt-cmd.h" +#include "symtab.h" + +// Break. + +class +tree_break_command : public tree_command +{ +public: + + tree_break_command (int l = -1, int c = -1) + : tree_command (l, c) { } + + ~tree_break_command (void) { } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + + static int breaking; + +private: + + // No copying! + + tree_break_command (const tree_break_command&); + + tree_break_command& operator = (const tree_break_command&); +}; + +// Continue. + +class +tree_continue_command : public tree_command +{ +public: + + tree_continue_command (int l = -1, int c = -1) + : tree_command (l, c) { } + + ~tree_continue_command (void) { } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + + static int continuing; + +private: + + // No copying! + + tree_continue_command (const tree_continue_command&); + + tree_continue_command& operator = (const tree_continue_command&); +}; + +// Return. + +class +tree_return_command : public tree_command +{ +public: + + tree_return_command (int l = -1, int c = -1) + : tree_command (l, c) { } + + ~tree_return_command (void) { } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + + static int returning; + +private: + + // No copying! + + tree_return_command (const tree_return_command&); + + tree_return_command& operator = (const tree_return_command&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-loop.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-loop.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,153 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "quit.h" + +#include "error.h" +#include "gripes.h" +#include "oct-map.h" +#include "oct-lvalue.h" +#include "ov.h" +#include "pt-arg-list.h" +#include "pt-bp.h" +#include "pt-cmd.h" +#include "pt-exp.h" +#include "pt-jit.h" +#include "pt-jump.h" +#include "pt-loop.h" +#include "pt-stmt.h" +#include "pt-walk.h" +#include "unwind-prot.h" + +// While. + +tree_while_command::~tree_while_command (void) +{ + delete expr; + delete list; + delete lead_comm; + delete trail_comm; +#ifdef HAVE_LLVM + delete compiled; +#endif +} + +tree_command * +tree_while_command::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return new tree_while_command (expr ? expr->dup (scope, context) : 0, + list ? list->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0, + trail_comm ? trail_comm->dup (): 0, + line (), column ()); +} + +void +tree_while_command::accept (tree_walker& tw) +{ + tw.visit_while_command (*this); +} + +// Do-Until + +tree_command * +tree_do_until_command::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return new tree_do_until_command (expr ? expr->dup (scope, context) : 0, + list ? list->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0, + trail_comm ? trail_comm->dup (): 0, + line (), column ()); +} + +void +tree_do_until_command::accept (tree_walker& tw) +{ + tw.visit_do_until_command (*this); +} + +// For. + +tree_simple_for_command::~tree_simple_for_command (void) +{ + delete lhs; + delete expr; + delete maxproc; + delete list; + delete lead_comm; + delete trail_comm; +#ifdef HAVE_LLVM + delete compiled; +#endif +} + +tree_command * +tree_simple_for_command::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return new tree_simple_for_command + (parallel, lhs ? lhs->dup (scope, context) : 0, + expr ? expr->dup (scope, context) : 0, + maxproc ? maxproc->dup (scope, context) : 0, + list ? list->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0, + trail_comm ? trail_comm->dup () : 0, line (), column ()); +} + +void +tree_simple_for_command::accept (tree_walker& tw) +{ + tw.visit_simple_for_command (*this); +} + +tree_complex_for_command::~tree_complex_for_command (void) +{ + delete lhs; + delete expr; + delete list; + delete lead_comm; + delete trail_comm; +} + +tree_command * +tree_complex_for_command::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return new tree_complex_for_command (lhs ? lhs->dup (scope, context) : 0, + expr ? expr->dup (scope, context) : 0, + list ? list->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0, + trail_comm ? trail_comm->dup () : 0, + line (), column ()); +} + +void +tree_complex_for_command::accept (tree_walker& tw) +{ + tw.visit_complex_for_command (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-loop.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-loop.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,328 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_loop_h) +#define octave_tree_loop_h 1 + +class octave_value; +class octave_lvalue; + +class tree_argument_list; +class tree_expression; +class tree_statement_list; + +class tree_walker; + +#include "comment-list.h" +#include "pt-cmd.h" +#include "symtab.h" + +class jit_info; + +// While. + +class +tree_while_command : public tree_command +{ +public: + + tree_while_command (int l = -1, int c = -1) + : tree_command (l, c), expr (0), list (0), lead_comm (0), + trail_comm (0) +#ifdef HAVE_LLVM + , compiled (0) +#endif + { } + + tree_while_command (tree_expression *e, + octave_comment_list *lc = 0, + octave_comment_list *tc = 0, + int l = -1, int c = -1) + : tree_command (l, c), expr (e), list (0), lead_comm (lc), + trail_comm (tc) +#ifdef HAVE_LLVM + , compiled (0) +#endif + { } + + tree_while_command (tree_expression *e, tree_statement_list *lst, + octave_comment_list *lc = 0, + octave_comment_list *tc = 0, + int l = -1, int c = -1) + : tree_command (l, c), expr (e), list (lst), lead_comm (lc), + trail_comm (tc) +#ifdef HAVE_LLVM + , compiled (0) +#endif + { } + + ~tree_while_command (void); + + tree_expression *condition (void) { return expr; } + + tree_statement_list *body (void) { return list; } + + octave_comment_list *leading_comment (void) { return lead_comm; } + + octave_comment_list *trailing_comment (void) { return trail_comm; } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +#ifdef HAVE_LLVM + // some functions use by tree_jit + jit_info *get_info (void) const + { + return compiled; + } + + void stash_info (jit_info *jinfo) + { + compiled = jinfo; + } +#endif + +protected: + + // Expression to test. + tree_expression *expr; + + // List of commands to execute. + tree_statement_list *list; + + // Comment preceding WHILE token. + octave_comment_list *lead_comm; + + // Comment preceding ENDWHILE token. + octave_comment_list *trail_comm; + +private: + +#ifdef HAVE_LLVM + // compiled version of the loop + jit_info *compiled; +#endif + + // No copying! + + tree_while_command (const tree_while_command&); + + tree_while_command& operator = (const tree_while_command&); +}; + +// Do-Until. + +class +tree_do_until_command : public tree_while_command +{ +public: + + tree_do_until_command (int l = -1, int c = -1) + : tree_while_command (l, c) { } + + tree_do_until_command (tree_expression *e, + octave_comment_list *lc = 0, + octave_comment_list *tc = 0, + int l = -1, int c = -1) + : tree_while_command (e, lc, tc, l, c) { } + + tree_do_until_command (tree_expression *e, tree_statement_list *lst, + octave_comment_list *lc = 0, + octave_comment_list *tc = 0, + int l = -1, int c = -1) + : tree_while_command (e, lst, lc, tc, l, c) { } + + ~tree_do_until_command (void) { } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // No copying! + + tree_do_until_command (const tree_do_until_command&); + + tree_do_until_command& operator = (const tree_do_until_command&); +}; + +// For. + +class +tree_simple_for_command : public tree_command +{ +public: + + tree_simple_for_command (int l = -1, int c = -1) + : tree_command (l, c), parallel (false), lhs (0), expr (0), + maxproc (0), list (0), lead_comm (0), trail_comm (0) +#ifdef HAVE_LLVM + , compiled (0) +#endif + { } + + tree_simple_for_command (bool parallel_arg, tree_expression *le, + tree_expression *re, + tree_expression *maxproc_arg, + tree_statement_list *lst, + octave_comment_list *lc = 0, + octave_comment_list *tc = 0, + int l = -1, int c = -1) + : tree_command (l, c), parallel (parallel_arg), lhs (le), + expr (re), maxproc (maxproc_arg), list (lst), + lead_comm (lc), trail_comm (tc) +#ifdef HAVE_LLVM + , compiled (0) +#endif + { } + + ~tree_simple_for_command (void); + + bool in_parallel (void) { return parallel; } + + tree_expression *left_hand_side (void) { return lhs; } + + tree_expression *control_expr (void) { return expr; } + + tree_expression *maxproc_expr (void) { return maxproc; } + + tree_statement_list *body (void) { return list; } + + octave_comment_list *leading_comment (void) { return lead_comm; } + + octave_comment_list *trailing_comment (void) { return trail_comm; } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +#ifdef HAVE_LLVM + // some functions use by tree_jit + jit_info *get_info (void) const + { + return compiled; + } + + void stash_info (jit_info *jinfo) + { + compiled = jinfo; + } +#endif + +private: + // TRUE means operate in parallel (subject to the value of the + // maxproc expression). + bool parallel; + + // Expression to modify. + tree_expression *lhs; + + // Expression to evaluate. + tree_expression *expr; + + // Expression to tell how many processors should be used (only valid + // if parallel is TRUE). + tree_expression *maxproc; + + // List of commands to execute. + tree_statement_list *list; + + // Comment preceding FOR token. + octave_comment_list *lead_comm; + + // Comment preceding ENDFOR token. + octave_comment_list *trail_comm; + + // compiled version of the loop + jit_info *compiled; + + // No copying! + + tree_simple_for_command (const tree_simple_for_command&); + + tree_simple_for_command& operator = (const tree_simple_for_command&); +}; + +class +tree_complex_for_command : public tree_command +{ +public: + + tree_complex_for_command (int l = -1, int c = -1) + : tree_command (l, c), lhs (0), expr (0), list (0), lead_comm (0), + trail_comm (0) { } + + tree_complex_for_command (tree_argument_list *le, tree_expression *re, + tree_statement_list *lst, + octave_comment_list *lc = 0, + octave_comment_list *tc = 0, + int l = -1, int c = -1) + : tree_command (l, c), lhs (le), expr (re), list (lst), + lead_comm (lc), trail_comm (tc) { } + + ~tree_complex_for_command (void); + + tree_argument_list *left_hand_side (void) { return lhs; } + + tree_expression *control_expr (void) { return expr; } + + tree_statement_list *body (void) { return list; } + + octave_comment_list *leading_comment (void) { return lead_comm; } + + octave_comment_list *trailing_comment (void) { return trail_comm; } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // Expression to modify. + tree_argument_list *lhs; + + // Expression to evaluate. + tree_expression *expr; + + // List of commands to execute. + tree_statement_list *list; + + // Comment preceding FOR token. + octave_comment_list *lead_comm; + + // Comment preceding ENDFOR token. + octave_comment_list *trail_comm; + + // No copying! + + tree_complex_for_command (const tree_complex_for_command&); + + tree_complex_for_command& operator = (const tree_complex_for_command&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-mat.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-mat.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1431 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "quit.h" + +#include "data.h" +#include "defun.h" +#include "error.h" +#include "oct-obj.h" +#include "pt-arg-list.h" +#include "pt-bp.h" +#include "pt-exp.h" +#include "pt-mat.h" +#include "pt-walk.h" +#include "utils.h" +#include "ov.h" +#include "variables.h" + +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +// The character to fill with when creating string arrays. +char Vstring_fill_char = ' '; + +// General matrices. This list type is much more work to handle than +// constant matrices, but it allows us to construct matrices from +// other matrices, variables, and functions. + +// But first, some internal classes that make our job much easier. + +class +tm_row_const +{ +private: + + class + tm_row_const_rep : public octave_base_list + { + public: + + tm_row_const_rep (void) + : count (1), dv (0, 0), all_str (false), + all_sq_str (false), all_dq_str (false), + some_str (false), all_real (false), all_cmplx (false), + all_mt (true), any_cell (false), any_sparse (false), + any_class (false), all_1x1 (false), + first_elem_is_struct (false), class_nm (), ok (false) + { } + + tm_row_const_rep (const tree_argument_list& row) + : count (1), dv (0, 0), all_str (false), all_sq_str (false), + some_str (false), all_real (false), all_cmplx (false), + all_mt (true), any_cell (false), any_sparse (false), + any_class (false), all_1x1 (! row.empty ()), + first_elem_is_struct (false), class_nm (), ok (false) + { init (row); } + + ~tm_row_const_rep (void) { } + + octave_refcount count; + + dim_vector dv; + + bool all_str; + bool all_sq_str; + bool all_dq_str; + bool some_str; + bool all_real; + bool all_cmplx; + bool all_mt; + bool any_cell; + bool any_sparse; + bool any_class; + bool all_1x1; + bool first_elem_is_struct; + + std::string class_nm; + + bool ok; + + void do_init_element (const octave_value&, bool&); + + void init (const tree_argument_list&); + + void cellify (void); + + private: + + tm_row_const_rep (const tm_row_const_rep&); + + tm_row_const_rep& operator = (const tm_row_const_rep&); + + }; + +public: + + typedef tm_row_const_rep::iterator iterator; + typedef tm_row_const_rep::const_iterator const_iterator; + + tm_row_const (void) + : rep (0) { } + + tm_row_const (const tree_argument_list& row) + : rep (new tm_row_const_rep (row)) { } + + tm_row_const (const tm_row_const& x) + : rep (x.rep) + { + if (rep) + rep->count++; + } + + tm_row_const& operator = (const tm_row_const& x) + { + if (this != &x && rep != x.rep) + { + if (rep && --rep->count == 0) + delete rep; + + rep = x.rep; + + if (rep) + rep->count++; + } + + return *this; + } + + ~tm_row_const (void) + { + if (rep && --rep->count == 0) + delete rep; + } + + octave_idx_type rows (void) { return rep->dv(0); } + octave_idx_type cols (void) { return rep->dv(1); } + + bool empty (void) const { return rep->empty (); } + + size_t length (void) const { return rep->length (); } + + dim_vector dims (void) { return rep->dv; } + + bool all_strings_p (void) const { return rep->all_str; } + bool all_sq_strings_p (void) const { return rep->all_sq_str; } + bool all_dq_strings_p (void) const { return rep->all_dq_str; } + bool some_strings_p (void) const { return rep->some_str; } + bool all_real_p (void) const { return rep->all_real; } + bool all_complex_p (void) const { return rep->all_cmplx; } + bool all_empty_p (void) const { return rep->all_mt; } + bool any_cell_p (void) const { return rep->any_cell; } + bool any_sparse_p (void) const { return rep->any_sparse; } + bool any_class_p (void) const { return rep->any_class; } + bool all_1x1_p (void) const { return rep->all_1x1; } + bool first_elem_struct_p (void) const { return rep->first_elem_is_struct; } + + std::string class_name (void) const { return rep->class_nm; } + + void cellify (void) { rep->cellify (); } + + operator bool () const { return (rep && rep->ok); } + + iterator begin (void) { return rep->begin (); } + const_iterator begin (void) const { return rep->begin (); } + + iterator end (void) { return rep->end (); } + const_iterator end (void) const { return rep->end (); } + +private: + + tm_row_const_rep *rep; +}; + +std::string +get_concat_class (const std::string& c1, const std::string& c2) +{ + std::string retval = octave_base_value::static_class_name (); + + if (c1 == c2) + retval = c1; + else if (c1.empty ()) + retval = c2; + else if (c2.empty ()) + retval = c1; + else if (c1 == "class" || c2 == "class") + retval = "class"; + else + { + bool c1_is_int = (c1 == "int8" || c1 == "uint8" + || c1 == "int16" || c1 == "uint16" + || c1 == "int32" || c1 == "uint32" + || c1 == "int64" || c1 == "uint64"); + bool c2_is_int = (c2 == "int8" || c2 == "uint8" + || c2 == "int16" || c2 == "uint16" + || c2 == "int32" || c2 == "uint32" + || c2 == "int64" || c2 == "uint64"); + + bool c1_is_char = (c1 == "char"); + bool c2_is_char = (c2 == "char"); + + bool c1_is_double = (c1 == "double"); + bool c2_is_double = (c2 == "double"); + + bool c1_is_single = (c1 == "single"); + bool c2_is_single = (c2 == "single"); + + bool c1_is_logical = (c1 == "logical"); + bool c2_is_logical = (c2 == "logical"); + + bool c1_is_built_in_type + = (c1_is_int || c1_is_char || c1_is_double || c1_is_single + || c1_is_logical); + + bool c2_is_built_in_type + = (c2_is_int || c2_is_char || c2_is_double || c2_is_single + || c2_is_logical); + + // Order is important here... + + if (c1 == "struct" && c2 == c1) + retval = c1; + else if (c1 == "cell" || c2 == "cell") + retval = "cell"; + else if (c1_is_char && c2_is_built_in_type) + retval = c1; + else if (c2_is_char && c1_is_built_in_type) + retval = c2; + else if (c1_is_int && c2_is_built_in_type) + retval = c1; + else if (c2_is_int && c1_is_built_in_type) + retval = c2; + else if (c1_is_single && c2_is_built_in_type) + retval = c1; + else if (c2_is_single && c1_is_built_in_type) + retval = c2; + else if (c1_is_double && c2_is_built_in_type) + retval = c1; + else if (c2_is_double && c1_is_built_in_type) + retval = c2; + else if (c1_is_logical && c2_is_logical) + retval = c1; + } + + return retval; +} + +static void +eval_error (const char *msg, const dim_vector& x, const dim_vector& y) +{ + ::error ("%s (%s vs %s)", msg, x.str ().c_str (), y.str ().c_str ()); +} + +void +tm_row_const::tm_row_const_rep::do_init_element (const octave_value& val, + bool& first_elem) +{ + std::string this_elt_class_nm + = val.is_object () ? std::string ("class") : val.class_name (); + + class_nm = get_concat_class (class_nm, this_elt_class_nm); + + dim_vector this_elt_dv = val.dims (); + + if (! this_elt_dv.zero_by_zero ()) + { + all_mt = false; + + if (first_elem) + { + if (val.is_map ()) + first_elem_is_struct = true; + + first_elem = false; + } + } + + append (val); + + if (all_str && ! val.is_string ()) + all_str = false; + + if (all_sq_str && ! val.is_sq_string ()) + all_sq_str = false; + + if (all_dq_str && ! val.is_dq_string ()) + all_dq_str = false; + + if (! some_str && val.is_string ()) + some_str = true; + + if (all_real && ! val.is_real_type ()) + all_real = false; + + if (all_cmplx && ! (val.is_complex_type () || val.is_real_type ())) + all_cmplx = false; + + if (!any_cell && val.is_cell ()) + any_cell = true; + + if (!any_sparse && val.is_sparse_type ()) + any_sparse = true; + + if (!any_class && val.is_object ()) + any_class = true; + + all_1x1 = all_1x1 && val.numel () == 1; +} + +void +tm_row_const::tm_row_const_rep::init (const tree_argument_list& row) +{ + all_str = true; + all_sq_str = true; + all_dq_str = true; + all_real = true; + all_cmplx = true; + any_cell = false; + any_sparse = false; + any_class = false; + + bool first_elem = true; + + for (tree_argument_list::const_iterator p = row.begin (); + p != row.end (); + p++) + { + octave_quit (); + + tree_expression *elt = *p; + + octave_value tmp = elt->rvalue1 (); + + if (error_state || tmp.is_undefined ()) + { + ok = ! error_state; + return; + } + else + { + if (tmp.is_cs_list ()) + { + octave_value_list tlst = tmp.list_value (); + + for (octave_idx_type i = 0; i < tlst.length (); i++) + { + octave_quit (); + + do_init_element (tlst(i), first_elem); + } + } + else + do_init_element (tmp, first_elem); + } + } + + if (any_cell && ! any_class && ! first_elem_is_struct) + cellify (); + + first_elem = true; + + for (iterator p = begin (); p != end (); p++) + { + octave_quit (); + + octave_value val = *p; + + dim_vector this_elt_dv = val.dims (); + + if (! this_elt_dv.zero_by_zero ()) + { + all_mt = false; + + if (first_elem) + { + first_elem = false; + dv = this_elt_dv; + } + else if (! dv.hvcat (this_elt_dv, 1)) + { + eval_error ("horizontal dimensions mismatch", dv, this_elt_dv); + break; + } + } + } + + ok = ! error_state; +} + +void +tm_row_const::tm_row_const_rep::cellify (void) +{ + bool elt_changed = false; + + for (iterator p = begin (); p != end (); p++) + { + octave_quit (); + + if (! p->is_cell ()) + { + elt_changed = true; + + *p = Cell (*p); + } + } + + if (elt_changed) + { + bool first_elem = true; + + for (iterator p = begin (); p != end (); p++) + { + octave_quit (); + + octave_value val = *p; + + dim_vector this_elt_dv = val.dims (); + + if (! this_elt_dv.zero_by_zero ()) + { + if (first_elem) + { + first_elem = false; + dv = this_elt_dv; + } + else if (! dv.hvcat (this_elt_dv, 1)) + { + eval_error ("horizontal dimensions mismatch", dv, this_elt_dv); + break; + } + } + } + } +} + +class +tm_const : public octave_base_list +{ +public: + + tm_const (const tree_matrix& tm) + : dv (0, 0), all_str (false), all_sq_str (false), all_dq_str (false), + some_str (false), all_real (false), all_cmplx (false), + all_mt (true), any_cell (false), any_sparse (false), + any_class (false), class_nm (), ok (false) + { init (tm); } + + ~tm_const (void) { } + + octave_idx_type rows (void) const { return dv.elem (0); } + octave_idx_type cols (void) const { return dv.elem (1); } + + dim_vector dims (void) const { return dv; } + + bool all_strings_p (void) const { return all_str; } + bool all_sq_strings_p (void) const { return all_sq_str; } + bool all_dq_strings_p (void) const { return all_dq_str; } + bool some_strings_p (void) const { return some_str; } + bool all_real_p (void) const { return all_real; } + bool all_complex_p (void) const { return all_cmplx; } + bool all_empty_p (void) const { return all_mt; } + bool any_cell_p (void) const { return any_cell; } + bool any_sparse_p (void) const { return any_sparse; } + bool any_class_p (void) const { return any_class; } + bool all_1x1_p (void) const { return all_1x1; } + + std::string class_name (void) const { return class_nm; } + + operator bool () const { return ok; } + +private: + + dim_vector dv; + + bool all_str; + bool all_sq_str; + bool all_dq_str; + bool some_str; + bool all_real; + bool all_cmplx; + bool all_mt; + bool any_cell; + bool any_sparse; + bool any_class; + bool all_1x1; + + std::string class_nm; + + bool ok; + + tm_const (void); + + tm_const (const tm_const&); + + tm_const& operator = (const tm_const&); + + void init (const tree_matrix& tm); +}; + +void +tm_const::init (const tree_matrix& tm) +{ + all_str = true; + all_sq_str = true; + all_dq_str = true; + all_real = true; + all_cmplx = true; + any_cell = false; + any_sparse = false; + any_class = false; + all_1x1 = ! tm.empty (); + + bool first_elem = true; + bool first_elem_is_struct = false; + + // Just eval and figure out if what we have is complex or all + // strings. We can't check columns until we know that this is a + // numeric matrix -- collections of strings can have elements of + // different lengths. + + for (tree_matrix::const_iterator p = tm.begin (); p != tm.end (); p++) + { + octave_quit (); + + tree_argument_list *elt = *p; + + tm_row_const tmp (*elt); + + if (first_elem) + { + first_elem_is_struct = tmp.first_elem_struct_p (); + + first_elem = false; + } + + if (tmp && ! tmp.empty ()) + { + if (all_str && ! tmp.all_strings_p ()) + all_str = false; + + if (all_sq_str && ! tmp.all_sq_strings_p ()) + all_sq_str = false; + + if (all_dq_str && ! tmp.all_dq_strings_p ()) + all_dq_str = false; + + if (! some_str && tmp.some_strings_p ()) + some_str = true; + + if (all_real && ! tmp.all_real_p ()) + all_real = false; + + if (all_cmplx && ! tmp.all_complex_p ()) + all_cmplx = false; + + if (all_mt && ! tmp.all_empty_p ()) + all_mt = false; + + if (!any_cell && tmp.any_cell_p ()) + any_cell = true; + + if (!any_sparse && tmp.any_sparse_p ()) + any_sparse = true; + + if (!any_class && tmp.any_class_p ()) + any_class = true; + + all_1x1 = all_1x1 && tmp.all_1x1_p (); + + append (tmp); + } + else + break; + } + + if (! error_state) + { + if (any_cell && ! any_class && ! first_elem_is_struct) + { + for (iterator q = begin (); q != end (); q++) + { + octave_quit (); + + q->cellify (); + } + } + + first_elem = true; + + for (iterator q = begin (); q != end (); q++) + { + octave_quit (); + + tm_row_const elt = *q; + + octave_idx_type this_elt_nr = elt.rows (); + octave_idx_type this_elt_nc = elt.cols (); + + std::string this_elt_class_nm = elt.class_name (); + class_nm = get_concat_class (class_nm, this_elt_class_nm); + + dim_vector this_elt_dv = elt.dims (); + + all_mt = false; + + if (first_elem) + { + first_elem = false; + + dv = this_elt_dv; + } + else if (all_str && dv.length () == 2 + && this_elt_dv.length () == 2) + { + // FIXME: this is Octave's specialty. Character matrices allow + // rows of unequal length. + if (this_elt_nc > cols ()) + dv(1) = this_elt_nc; + dv(0) += this_elt_nr; + } + else if (! dv.hvcat (this_elt_dv, 0)) + { + eval_error ("vertical dimensions mismatch", dv, this_elt_dv); + return; + } + } + } + + ok = ! error_state; +} + +tree_matrix::~tree_matrix (void) +{ + while (! empty ()) + { + iterator p = begin (); + delete *p; + erase (p); + } +} + +bool +tree_matrix::has_magic_end (void) const +{ + for (const_iterator p = begin (); p != end (); p++) + { + octave_quit (); + + tree_argument_list *elt = *p; + + if (elt && elt->has_magic_end ()) + return true; + } + + return false; +} + +bool +tree_matrix::all_elements_are_constant (void) const +{ + for (const_iterator p = begin (); p != end (); p++) + { + octave_quit (); + + tree_argument_list *elt = *p; + + if (! elt->all_elements_are_constant ()) + return false; + } + + return true; +} + +octave_value_list +tree_matrix::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("invalid number of output arguments for matrix list"); + else + retval = rvalue1 (nargout); + + return retval; +} + +void +maybe_warn_string_concat (bool all_dq_strings_p, bool all_sq_strings_p) +{ + if (! (all_dq_strings_p || all_sq_strings_p)) + warning_with_id ("Octave:mixed-string-concat", + "concatenation of different character string types may have unintended consequences"); +} + +template +static void +single_type_concat (Array& result, + tm_const& tmp) +{ + octave_idx_type r = 0, c = 0; + + for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) + { + tm_row_const row = *p; + // Skip empty arrays to allow looser rules. + if (row.dims ().any_zero ()) + continue; + + for (tm_row_const::iterator q = row.begin (); + q != row.end (); + q++) + { + octave_quit (); + + TYPE ra = octave_value_extract (*q); + + // Skip empty arrays to allow looser rules. + if (! error_state) + { + if (! ra.is_empty ()) + { + result.insert (ra, r, c); + + if (! error_state) + c += ra.columns (); + else + return; + } + } + else + return; + } + + r += row.rows (); + c = 0; + } +} + +template +static void +single_type_concat (Array& result, + const dim_vector& dv, + tm_const& tmp) +{ + if (dv.any_zero ()) + { + result = Array (dv); + return; + } + + if (tmp.length () == 1) + { + // If possible, forward the operation to liboctave. + // Single row. + tm_row_const& row = tmp.front (); + if (! (equal_types::value || equal_types::value) + && row.all_1x1_p ()) + { + // Optimize all scalars case. + result.clear (dv); + assert (static_cast (result.numel ()) == row.length ()); + octave_idx_type i = 0; + for (tm_row_const::iterator q = row.begin (); + q != row.end () && ! error_state; q++) + result(i++) = octave_value_extract (*q); + + return; + } + + octave_idx_type ncols = row.length (), i = 0; + OCTAVE_LOCAL_BUFFER (Array, array_list, ncols); + + for (tm_row_const::iterator q = row.begin (); + q != row.end () && ! error_state; + q++) + { + octave_quit (); + + array_list[i] = octave_value_extract (*q); + i++; + } + + if (! error_state) + result = Array::cat (-2, ncols, array_list); + } + else + { + result = Array (dv); + single_type_concat (result, tmp); + } +} + +template +static void +single_type_concat (Sparse& result, + const dim_vector& dv, + tm_const& tmp) +{ + if (dv.any_zero ()) + { + result = Sparse (dv); + return; + } + + // Sparse matrices require preallocation for efficient indexing; besides, + // only horizontal concatenation can be efficiently handled by indexing. + // So we just cat all rows through liboctave, then cat the final column. + octave_idx_type nrows = tmp.length (), j = 0; + OCTAVE_LOCAL_BUFFER (Sparse, sparse_row_list, nrows); + for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) + { + tm_row_const row = *p; + octave_idx_type ncols = row.length (), i = 0; + OCTAVE_LOCAL_BUFFER (Sparse, sparse_list, ncols); + + for (tm_row_const::iterator q = row.begin (); + q != row.end () && ! error_state; + q++) + { + octave_quit (); + + sparse_list[i] = octave_value_extract (*q); + i++; + } + + Sparse stmp = Sparse::cat (-2, ncols, sparse_list); + sparse_row_list[j] = stmp; + j++; + } + + result = Sparse::cat (-1, nrows, sparse_row_list); +} + +template +static void +single_type_concat (octave_map& result, + const dim_vector& dv, + tm_const& tmp) +{ + if (dv.any_zero ()) + { + result = octave_map (dv); + return; + } + + octave_idx_type nrows = tmp.length (), j = 0; + OCTAVE_LOCAL_BUFFER (octave_map, map_row_list, nrows); + for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) + { + tm_row_const row = *p; + octave_idx_type ncols = row.length (), i = 0; + OCTAVE_LOCAL_BUFFER (MAP, map_list, ncols); + + for (tm_row_const::iterator q = row.begin (); + q != row.end () && ! error_state; + q++) + { + octave_quit (); + + map_list[i] = octave_value_extract (*q); + i++; + } + + octave_map mtmp = octave_map::cat (-2, ncols, map_list); + map_row_list[j] = mtmp; + j++; + } + + result = octave_map::cat (-1, nrows, map_row_list); +} + +template +static octave_value +do_single_type_concat (const dim_vector& dv, + tm_const& tmp) +{ + TYPE result; + + single_type_concat (result, dv, tmp); + + return result; +} + +template<> +octave_value +do_single_type_concat (const dim_vector& dv, + tm_const& tmp) +{ + octave_map result; + + if (tmp.all_1x1_p ()) + single_type_concat (result, dv, tmp); + else + single_type_concat (result, dv, tmp); + + return result; +} + +static octave_value +do_class_concat (tm_const& tmc) +{ + octave_value retval; + + octave_value_list rows (tmc.length (), octave_value ()); + + octave_idx_type j = 0; + for (tm_const::iterator p = tmc.begin (); p != tmc.end (); p++) + { + octave_quit (); + + tm_row_const tmrc = *p; + + if (tmrc.length () == 1) + rows(j++) = *(tmrc.begin ()); + else + { + octave_value_list row (tmrc.length (), octave_value ()); + + octave_idx_type i = 0; + for (tm_row_const::iterator q = tmrc.begin (); q != tmrc.end (); q++) + row(i++) = *q; + + rows(j++) = do_class_concat (row, "horzcat", 1); + } + } + + if (! error_state) + { + if (rows.length () == 1) + retval = rows(0); + else + retval = do_class_concat (rows, "vertcat", 0); + } + + return retval; +} + +octave_value +tree_matrix::rvalue1 (int) +{ + octave_value retval = Matrix (); + + bool all_sq_strings_p = false; + bool all_dq_strings_p = false; + bool all_empty_p = false; + bool all_real_p = false; + bool any_sparse_p = false; + bool any_class_p = false; + bool frc_str_conv = false; + + tm_const tmp (*this); + + if (tmp && ! tmp.empty ()) + { + dim_vector dv = tmp.dims (); + all_sq_strings_p = tmp.all_sq_strings_p (); + all_dq_strings_p = tmp.all_dq_strings_p (); + all_empty_p = tmp.all_empty_p (); + all_real_p = tmp.all_real_p (); + any_sparse_p = tmp.any_sparse_p (); + any_class_p = tmp.any_class_p (); + frc_str_conv = tmp.some_strings_p (); + + // Try to speed up the common cases. + + std::string result_type = tmp.class_name (); + + if (any_class_p) + { + retval = do_class_concat (tmp); + } + else if (result_type == "double") + { + if (any_sparse_p) + { + if (all_real_p) + retval = do_single_type_concat (dv, tmp); + else + retval = do_single_type_concat (dv, tmp); + } + else + { + if (all_real_p) + retval = do_single_type_concat (dv, tmp); + else + retval = do_single_type_concat (dv, tmp); + } + } + else if (result_type == "single") + { + if (all_real_p) + retval = do_single_type_concat (dv, tmp); + else + retval = do_single_type_concat (dv, tmp); + } + else if (result_type == "char") + { + char type = all_dq_strings_p ? '"' : '\''; + + maybe_warn_string_concat (all_dq_strings_p, all_sq_strings_p); + + charNDArray result (dv, Vstring_fill_char); + + single_type_concat (result, tmp); + + retval = octave_value (result, type); + } + else if (result_type == "logical") + { + if (any_sparse_p) + retval = do_single_type_concat (dv, tmp); + else + retval = do_single_type_concat (dv, tmp); + } + else if (result_type == "int8") + retval = do_single_type_concat (dv, tmp); + else if (result_type == "int16") + retval = do_single_type_concat (dv, tmp); + else if (result_type == "int32") + retval = do_single_type_concat (dv, tmp); + else if (result_type == "int64") + retval = do_single_type_concat (dv, tmp); + else if (result_type == "uint8") + retval = do_single_type_concat (dv, tmp); + else if (result_type == "uint16") + retval = do_single_type_concat (dv, tmp); + else if (result_type == "uint32") + retval = do_single_type_concat (dv, tmp); + else if (result_type == "uint64") + retval = do_single_type_concat (dv, tmp); + else if (result_type == "cell") + retval = do_single_type_concat (dv, tmp); + else if (result_type == "struct") + retval = do_single_type_concat (dv, tmp); + else + { + // The line below might seem crazy, since we take a copy of + // the first argument, resize it to be empty and then resize + // it to be full. This is done since it means that there is + // no recopying of data, as would happen if we used a single + // resize. It should be noted that resize operation is also + // significantly slower than the do_cat_op function, so it + // makes sense to have an empty matrix and copy all data. + // + // We might also start with a empty octave_value using + // + // ctmp = octave_value_typeinfo::lookup_type + // (tmp.begin() -> begin() -> type_name()); + // + // and then directly resize. However, for some types there + // might be some additional setup needed, and so this should + // be avoided. + + octave_value ctmp; + + // Find the first non-empty object + + if (any_sparse_p) + { + // Start with sparse matrix to avoid issues memory issues + // with things like [ones(1,4),sprandn(1e8,4,1e-4)] + if (all_real_p) + ctmp = octave_sparse_matrix ().resize (dv); + else + ctmp = octave_sparse_complex_matrix ().resize (dv); + } + else + { + for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) + { + octave_quit (); + + tm_row_const row = *p; + + for (tm_row_const::iterator q = row.begin (); + q != row.end (); q++) + { + octave_quit (); + + ctmp = *q; + + if (! ctmp.all_zero_dims ()) + goto found_non_empty; + } + } + + ctmp = (*(tmp.begin () -> begin ())); + + found_non_empty: + + if (! all_empty_p) + ctmp = ctmp.resize (dim_vector (0,0)).resize (dv); + } + + if (! error_state) + { + // Now, extract the values from the individual elements and + // insert them in the result matrix. + + int dv_len = dv.length (); + octave_idx_type ntmp = dv_len > 1 ? dv_len : 2; + Array ra_idx (dim_vector (ntmp, 1), 0); + + for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) + { + octave_quit (); + + tm_row_const row = *p; + + for (tm_row_const::iterator q = row.begin (); + q != row.end (); + q++) + { + octave_quit (); + + octave_value elt = *q; + + if (elt.is_empty ()) + continue; + + ctmp = do_cat_op (ctmp, elt, ra_idx); + + if (error_state) + goto done; + + ra_idx (1) += elt.columns (); + } + + ra_idx (0) += row.rows (); + ra_idx (1) = 0; + } + + retval = ctmp; + + if (frc_str_conv && ! retval.is_string ()) + retval = retval.convert_to_str (); + } + } + } + +done: + return retval; +} + +tree_expression * +tree_matrix::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_matrix *new_matrix = new tree_matrix (0, line (), column ()); + + for (const_iterator p = begin (); p != end (); p++) + { + const tree_argument_list *elt = *p; + + new_matrix->append (elt ? elt->dup (scope, context) : 0); + } + + new_matrix->copy_base (*this); + + return new_matrix; +} + +void +tree_matrix::accept (tree_walker& tw) +{ + tw.visit_matrix (*this); +} + +/* +## test concatenation with all zero matrices +%!assert ([ "" 65*ones(1,10) ], "AAAAAAAAAA"); +%!assert ([ 65*ones(1,10) "" ], "AAAAAAAAAA"); + +%!test +%! c = {"foo"; "bar"; "bazoloa"}; +%! assert ([c; "a"; "bc"; "def"], {"foo"; "bar"; "bazoloa"; "a"; "bc"; "def"}); + +%!assert (class ([int64(1), int64(1)]), "int64") +%!assert (class ([int64(1), int32(1)]), "int64") +%!assert (class ([int64(1), int16(1)]), "int64") +%!assert (class ([int64(1), int8(1)]), "int64") +%!assert (class ([int64(1), uint64(1)]), "int64") +%!assert (class ([int64(1), uint32(1)]), "int64") +%!assert (class ([int64(1), uint16(1)]), "int64") +%!assert (class ([int64(1), uint8(1)]), "int64") +%!assert (class ([int64(1), single(1)]), "int64") +%!assert (class ([int64(1), double(1)]), "int64") +%!assert (class ([int64(1), cell(1)]), "cell") +%!assert (class ([int64(1), true]), "int64") +%!assert (class ([int64(1), "a"]), "char") + +%!assert (class ([int32(1), int64(1)]), "int32") +%!assert (class ([int32(1), int32(1)]), "int32") +%!assert (class ([int32(1), int16(1)]), "int32") +%!assert (class ([int32(1), int8(1)]), "int32") +%!assert (class ([int32(1), uint64(1)]), "int32") +%!assert (class ([int32(1), uint32(1)]), "int32") +%!assert (class ([int32(1), uint16(1)]), "int32") +%!assert (class ([int32(1), uint8(1)]), "int32") +%!assert (class ([int32(1), single(1)]), "int32") +%!assert (class ([int32(1), double(1)]), "int32") +%!assert (class ([int32(1), cell(1)]), "cell") +%!assert (class ([int32(1), true]), "int32") +%!assert (class ([int32(1), "a"]), "char") + +%!assert (class ([int16(1), int64(1)]), "int16") +%!assert (class ([int16(1), int32(1)]), "int16") +%!assert (class ([int16(1), int16(1)]), "int16") +%!assert (class ([int16(1), int8(1)]), "int16") +%!assert (class ([int16(1), uint64(1)]), "int16") +%!assert (class ([int16(1), uint32(1)]), "int16") +%!assert (class ([int16(1), uint16(1)]), "int16") +%!assert (class ([int16(1), uint8(1)]), "int16") +%!assert (class ([int16(1), single(1)]), "int16") +%!assert (class ([int16(1), double(1)]), "int16") +%!assert (class ([int16(1), cell(1)]), "cell") +%!assert (class ([int16(1), true]), "int16") +%!assert (class ([int16(1), "a"]), "char") + +%!assert (class ([int8(1), int64(1)]), "int8") +%!assert (class ([int8(1), int32(1)]), "int8") +%!assert (class ([int8(1), int16(1)]), "int8") +%!assert (class ([int8(1), int8(1)]), "int8") +%!assert (class ([int8(1), uint64(1)]), "int8") +%!assert (class ([int8(1), uint32(1)]), "int8") +%!assert (class ([int8(1), uint16(1)]), "int8") +%!assert (class ([int8(1), uint8(1)]), "int8") +%!assert (class ([int8(1), single(1)]), "int8") +%!assert (class ([int8(1), double(1)]), "int8") +%!assert (class ([int8(1), cell(1)]), "cell") +%!assert (class ([int8(1), true]), "int8") +%!assert (class ([int8(1), "a"]), "char") + +%!assert (class ([uint64(1), int64(1)]), "uint64") +%!assert (class ([uint64(1), int32(1)]), "uint64") +%!assert (class ([uint64(1), int16(1)]), "uint64") +%!assert (class ([uint64(1), int8(1)]), "uint64") +%!assert (class ([uint64(1), uint64(1)]), "uint64") +%!assert (class ([uint64(1), uint32(1)]), "uint64") +%!assert (class ([uint64(1), uint16(1)]), "uint64") +%!assert (class ([uint64(1), uint8(1)]), "uint64") +%!assert (class ([uint64(1), single(1)]), "uint64") +%!assert (class ([uint64(1), double(1)]), "uint64") +%!assert (class ([uint64(1), cell(1)]), "cell") +%!assert (class ([uint64(1), true]), "uint64") +%!assert (class ([uint64(1), "a"]), "char") + +%!assert (class ([uint32(1), int64(1)]), "uint32") +%!assert (class ([uint32(1), int32(1)]), "uint32") +%!assert (class ([uint32(1), int16(1)]), "uint32") +%!assert (class ([uint32(1), int8(1)]), "uint32") +%!assert (class ([uint32(1), uint64(1)]), "uint32") +%!assert (class ([uint32(1), uint32(1)]), "uint32") +%!assert (class ([uint32(1), uint16(1)]), "uint32") +%!assert (class ([uint32(1), uint8(1)]), "uint32") +%!assert (class ([uint32(1), single(1)]), "uint32") +%!assert (class ([uint32(1), double(1)]), "uint32") +%!assert (class ([uint32(1), cell(1)]), "cell") +%!assert (class ([uint32(1), true]), "uint32") +%!assert (class ([uint32(1), "a"]), "char") + +%!assert (class ([uint16(1), int64(1)]), "uint16") +%!assert (class ([uint16(1), int32(1)]), "uint16") +%!assert (class ([uint16(1), int16(1)]), "uint16") +%!assert (class ([uint16(1), int8(1)]), "uint16") +%!assert (class ([uint16(1), uint64(1)]), "uint16") +%!assert (class ([uint16(1), uint32(1)]), "uint16") +%!assert (class ([uint16(1), uint16(1)]), "uint16") +%!assert (class ([uint16(1), uint8(1)]), "uint16") +%!assert (class ([uint16(1), single(1)]), "uint16") +%!assert (class ([uint16(1), double(1)]), "uint16") +%!assert (class ([uint16(1), cell(1)]), "cell") +%!assert (class ([uint16(1), true]), "uint16") +%!assert (class ([uint16(1), "a"]), "char") + +%!assert (class ([uint8(1), int64(1)]), "uint8") +%!assert (class ([uint8(1), int32(1)]), "uint8") +%!assert (class ([uint8(1), int16(1)]), "uint8") +%!assert (class ([uint8(1), int8(1)]), "uint8") +%!assert (class ([uint8(1), uint64(1)]), "uint8") +%!assert (class ([uint8(1), uint32(1)]), "uint8") +%!assert (class ([uint8(1), uint16(1)]), "uint8") +%!assert (class ([uint8(1), uint8(1)]), "uint8") +%!assert (class ([uint8(1), single(1)]), "uint8") +%!assert (class ([uint8(1), double(1)]), "uint8") +%!assert (class ([uint8(1), cell(1)]), "cell") +%!assert (class ([uint8(1), true]), "uint8") +%!assert (class ([uint8(1), "a"]), "char") + +%!assert (class ([single(1), int64(1)]), "int64") +%!assert (class ([single(1), int32(1)]), "int32") +%!assert (class ([single(1), int16(1)]), "int16") +%!assert (class ([single(1), int8(1)]), "int8") +%!assert (class ([single(1), uint64(1)]), "uint64") +%!assert (class ([single(1), uint32(1)]), "uint32") +%!assert (class ([single(1), uint16(1)]), "uint16") +%!assert (class ([single(1), uint8(1)]), "uint8") +%!assert (class ([single(1), single(1)]), "single") +%!assert (class ([single(1), double(1)]), "single") +%!assert (class ([single(1), cell(1)]), "cell") +%!assert (class ([single(1), true]), "single") +%!assert (class ([single(1), "a"]), "char") + +%!assert (class ([double(1), int64(1)]), "int64") +%!assert (class ([double(1), int32(1)]), "int32") +%!assert (class ([double(1), int16(1)]), "int16") +%!assert (class ([double(1), int8(1)]), "int8") +%!assert (class ([double(1), uint64(1)]), "uint64") +%!assert (class ([double(1), uint32(1)]), "uint32") +%!assert (class ([double(1), uint16(1)]), "uint16") +%!assert (class ([double(1), uint8(1)]), "uint8") +%!assert (class ([double(1), single(1)]), "single") +%!assert (class ([double(1), double(1)]), "double") +%!assert (class ([double(1), cell(1)]), "cell") +%!assert (class ([double(1), true]), "double") +%!assert (class ([double(1), "a"]), "char") + +%!assert (class ([cell(1), int64(1)]), "cell") +%!assert (class ([cell(1), int32(1)]), "cell") +%!assert (class ([cell(1), int16(1)]), "cell") +%!assert (class ([cell(1), int8(1)]), "cell") +%!assert (class ([cell(1), uint64(1)]), "cell") +%!assert (class ([cell(1), uint32(1)]), "cell") +%!assert (class ([cell(1), uint16(1)]), "cell") +%!assert (class ([cell(1), uint8(1)]), "cell") +%!assert (class ([cell(1), single(1)]), "cell") +%!assert (class ([cell(1), double(1)]), "cell") +%!assert (class ([cell(1), cell(1)]), "cell") +%!assert (class ([cell(1), true]), "cell") +%!assert (class ([cell(1), "a"]), "cell") + +%!assert (class ([true, int64(1)]), "int64") +%!assert (class ([true, int32(1)]), "int32") +%!assert (class ([true, int16(1)]), "int16") +%!assert (class ([true, int8(1)]), "int8") +%!assert (class ([true, uint64(1)]), "uint64") +%!assert (class ([true, uint32(1)]), "uint32") +%!assert (class ([true, uint16(1)]), "uint16") +%!assert (class ([true, uint8(1)]), "uint8") +%!assert (class ([true, single(1)]), "single") +%!assert (class ([true, double(1)]), "double") +%!assert (class ([true, cell(1)]), "cell") +%!assert (class ([true, true]), "logical") +%!assert (class ([true, "a"]), "char") + +%!assert (class (["a", int64(1)]), "char") +%!assert (class (["a", int32(1)]), "char") +%!assert (class (["a", int16(1)]), "char") +%!assert (class (["a", int8(1)]), "char") +%!assert (class (["a", int64(1)]), "char") +%!assert (class (["a", int32(1)]), "char") +%!assert (class (["a", int16(1)]), "char") +%!assert (class (["a", int8(1)]), "char") +%!assert (class (["a", single(1)]), "char") +%!assert (class (["a", double(1)]), "char") +%!assert (class (["a", cell(1)]), "cell") +%!assert (class (["a", true]), "char") +%!assert (class (["a", "a"]), "char") + +%!assert (class ([cell(1), struct("foo", "bar")]), "cell") +%!error [struct("foo", "bar"), cell(1)] +*/ + +DEFUN (string_fill_char, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} string_fill_char ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} string_fill_char (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} string_fill_char (@var{new_val}, \"local\")\n\ +Query or set the internal variable used to pad all rows of a character\n\ +matrix to the same length. It must be a single character. The default\n\ +value is @code{\" \"} (a single space). For example:\n\ +\n\ +@example\n\ +@group\n\ +string_fill_char (\"X\");\n\ +[ \"these\"; \"are\"; \"strings\" ]\n\ + @result{} \"theseXX\"\n\ + \"areXXXX\"\n\ + \"strings\"\n\ +@end group\n\ +@end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (string_fill_char); +} + +/* +## string_fill_char() function call must be outside of %!test block +## due to the way a %!test block is wrapped inside a function +%!shared orig_val, old_val +%! orig_val = string_fill_char (); +%! old_val = string_fill_char ("X"); +%!test +%! assert (orig_val, old_val); +%! assert (string_fill_char (), "X"); +%! assert (["these"; "are"; "strings"], ["theseXX"; "areXXXX"; "strings"]); +%! string_fill_char (orig_val); +%! assert (string_fill_char (), orig_val); + +%!error (string_fill_char (1, 2)) +*/ diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-mat.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-mat.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,95 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_mat_h) +#define octave_tree_mat_h 1 + +#include + +class octave_value; +class octave_value_list; +class tree_argument_list; + +class tree_walker; + +#include "base-list.h" +#include "pt-exp.h" +#include "symtab.h" + +// General matrices. This allows us to construct matrices from +// other matrices, variables, and functions. + +class +tree_matrix : public tree_expression, + public octave_base_list +{ +public: + + tree_matrix (tree_argument_list *row = 0, int l = -1, int c = -1) + : tree_expression (l, c) + { + if (row) + append (row); + } + + ~tree_matrix (void); + + bool has_magic_end (void) const; + + bool all_elements_are_constant (void) const; + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // No copying! + + tree_matrix (const tree_matrix&); + + tree_matrix& operator = (const tree_matrix&); +}; + +// The character to fill with when creating string arrays. +extern char Vstring_fill_char; + +extern std::string +get_concat_class (const std::string& c1, const std::string& c2); + +extern void +maybe_warn_string_concat (bool all_dq_strings_p, bool all_sq_strings_p); + +extern std::string +get_concat_class (const std::string& c1, const std::string& c2); + +extern void +maybe_warn_string_concat (bool all_dq_strings_p, bool all_sq_strings_p); + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-misc.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-misc.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,353 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "Cell.h" + +#include "defun.h" +#include "error.h" +#include "ov.h" +#include "oct-lvalue.h" +#include "pt-id.h" +#include "pt-idx.h" +#include "pt-misc.h" +#include "pt-walk.h" +#include "utils.h" + +// Parameter lists. + +tree_parameter_list::~tree_parameter_list (void) +{ + while (! empty ()) + { + iterator p = begin (); + delete *p; + erase (p); + } +} + +void +tree_parameter_list::mark_as_formal_parameters (void) +{ + for (iterator p = begin (); p != end (); p++) + { + tree_decl_elt *elt = *p; + elt->mark_as_formal_parameter (); + } +} + +bool +tree_parameter_list::validate (in_or_out type) +{ + bool retval = true; + + std::set dict; + + for (iterator p = begin (); p != end (); p++) + { + tree_decl_elt *elt = *p; + + tree_identifier *id = elt->ident (); + + if (id) + { + std::string name = id->name (); + + if (id->is_black_hole ()) + { + if (type != in) + error ("invalid use of ~ in output list"); + } + else if (dict.find (name) != dict.end ()) + { + retval = false; + error ("`%s' appears more than once in parameter list", + name.c_str ()); + break; + } + else + dict.insert (name); + } + } + + if (! error_state) + { + std::string va_type = (type == in ? "varargin" : "varargout"); + + size_t len = length (); + + if (len > 0) + { + tree_decl_elt *elt = back (); + + tree_identifier *id = elt->ident (); + + if (id && id->name () == va_type) + { + if (len == 1) + mark_varargs_only (); + else + mark_varargs (); + + iterator p = end (); + --p; + delete *p; + erase (p); + } + } + } + + return retval; +} + +void +tree_parameter_list::initialize_undefined_elements (const std::string& warnfor, + int nargout, const octave_value& val) +{ + bool warned = false; + + int count = 0; + + octave_value tmp = symbol_table::varval (".ignored."); + const Matrix ignored = tmp.is_defined () ? tmp.matrix_value () : Matrix (); + + octave_idx_type k = 0; + + for (iterator p = begin (); p != end (); p++) + { + if (++count > nargout) + break; + + tree_decl_elt *elt = *p; + + if (! elt->is_variable ()) + { + if (! warned) + { + warned = true; + + while (k < ignored.numel ()) + { + octave_idx_type l = ignored (k); + if (l == count) + { + warned = false; + break; + } + else if (l > count) + break; + else + k++; + } + + if (warned) + { + warning_with_id + ("Octave:undefined-return-values", + "%s: some elements in list of return values are undefined", + warnfor.c_str ()); + } + } + + octave_lvalue lval = elt->lvalue (); + + lval.assign (octave_value::op_asn_eq, val); + } + } +} + +void +tree_parameter_list::define_from_arg_vector (const octave_value_list& args) +{ + int nargin = args.length (); + + int expected_nargin = length (); + + iterator p = begin (); + + for (int i = 0; i < expected_nargin; i++) + { + tree_decl_elt *elt = *p++; + + octave_lvalue ref = elt->lvalue (); + + if (i < nargin) + { + if (args(i).is_defined () && args(i).is_magic_colon ()) + { + if (! elt->eval ()) + { + ::error ("no default value for argument %d\n", i+1); + return; + } + } + else + ref.define (args(i)); + } + else + elt->eval (); + } +} + +void +tree_parameter_list::undefine (void) +{ + int len = length (); + + iterator p = begin (); + + for (int i = 0; i < len; i++) + { + tree_decl_elt *elt = *p++; + + octave_lvalue ref = elt->lvalue (); + + ref.assign (octave_value::op_asn_eq, octave_value ()); + } +} + +octave_value_list +tree_parameter_list::convert_to_const_vector (int nargout, + const Cell& varargout) +{ + octave_idx_type vlen = varargout.numel (); + int len = length (); + + // Special case. Will do a shallow copy. + if (len == 0) + return varargout; + else if (nargout <= len) + { + octave_value_list retval (nargout); + + int i = 0; + + for (iterator p = begin (); p != end (); p++) + { + tree_decl_elt *elt = *p; + if (elt->is_defined ()) + retval(i++) = elt->rvalue1 (); + else + break; + } + + return retval; + } + else + { + octave_value_list retval (len + vlen); + + int i = 0; + + for (iterator p = begin (); p != end (); p++) + { + tree_decl_elt *elt = *p; + retval(i++) = elt->rvalue1 (); + } + + for (octave_idx_type j = 0; j < vlen; j++) + retval(i++) = varargout(j); + + return retval; + } +} + +bool +tree_parameter_list::is_defined (void) +{ + bool status = true; + + for (iterator p = begin (); p != end (); p++) + { + tree_decl_elt *elt = *p; + + if (! elt->is_variable ()) + { + status = false; + break; + } + } + + return status; +} + +tree_parameter_list * +tree_parameter_list::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_parameter_list *new_list = new tree_parameter_list (); + + if (takes_varargs ()) + new_list->mark_varargs (); + + for (const_iterator p = begin (); p != end (); p++) + { + const tree_decl_elt *elt = *p; + + new_list->append (elt->dup (scope, context)); + } + + return new_list; +} + +void +tree_parameter_list::accept (tree_walker& tw) +{ + tw.visit_parameter_list (*this); +} + +// Return lists. + +tree_return_list::~tree_return_list (void) +{ + while (! empty ()) + { + iterator p = begin (); + delete *p; + erase (p); + } +} + +tree_return_list * +tree_return_list::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_return_list *new_list = new tree_return_list (); + + for (const_iterator p = begin (); p != end (); p++) + { + const tree_index_expression *elt = *p; + + new_list->append (elt->dup (scope, context)); + } + + return new_list; +} + +void +tree_return_list::accept (tree_walker& tw) +{ + tw.visit_return_list (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-misc.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-misc.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,149 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_misc_h) +#define octave_tree_misc_h 1 + +class Cell; + +class octave_value; +class octave_value_list; + +class tree_identifier; +class tree_index_expression; +class tree_va_return_list; + +class tree_walker; + +#include "base-list.h" +#include "pt-decl.h" +#include "symtab.h" + +// Parameter lists. Used to hold the list of input and output +// parameters in a function definition. Elements are identifiers +// only. + +class +tree_parameter_list : public octave_base_list +{ +public: + + enum in_or_out + { + in = 1, + out = 2 + }; + + tree_parameter_list (void) + : marked_for_varargs (0) { } + + tree_parameter_list (tree_decl_elt *t) + : marked_for_varargs (0) { append (t); } + + ~tree_parameter_list (void); + + void mark_as_formal_parameters (void); + + bool validate (in_or_out type); + + bool takes_varargs (void) const { return marked_for_varargs != 0; } + + bool varargs_only (void) { return (marked_for_varargs < 0); } + + void initialize_undefined_elements (const std::string& warnfor, + int nargout, const octave_value& val); + + void define_from_arg_vector (const octave_value_list& args); + + void undefine (void); + + bool is_defined (void); + + octave_value_list convert_to_const_vector (int nargout, const Cell& varargout); + + tree_parameter_list *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + int marked_for_varargs; + + void mark_varargs (void) { marked_for_varargs = 1; } + + void mark_varargs_only (void) { marked_for_varargs = -1; } + + // No copying! + + tree_parameter_list (const tree_parameter_list&); + + tree_parameter_list& operator = (const tree_parameter_list&); +}; + +// Return lists. Used to hold the right hand sides of multiple +// assignment expressions. + +class +tree_return_list : public octave_base_list +{ +public: + + tree_return_list (void) { } + + tree_return_list (tree_index_expression *t) { append (t); } + + ~tree_return_list (void); + + tree_return_list *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // No copying! + + tree_return_list (const tree_return_list&); + + tree_return_list& operator = (const tree_return_list&); +}; + +class +tree_va_return_list : public octave_base_list +{ +public: + + tree_va_return_list (void) { } + + ~tree_va_return_list (void) { } + +private: + + // No copying! + + tree_va_return_list (const tree_va_return_list&); + + tree_va_return_list& operator = (const tree_va_return_list&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-pr-code.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-pr-code.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,1322 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "comment-list.h" +#include "error.h" +#include "ov-usr-fcn.h" +#include "pr-output.h" +#include "pt-all.h" + +void +tree_print_code::visit_anon_fcn_handle (tree_anon_fcn_handle& afh) +{ + indent (); + + print_parens (afh, "("); + + os << "@("; + + tree_parameter_list *param_list = afh.parameter_list (); + + if (param_list) + param_list->accept (*this); + + os << ") "; + + print_fcn_handle_body (afh.body ()); + + print_parens (afh, ")"); +} + +void +tree_print_code::visit_argument_list (tree_argument_list& lst) +{ + tree_argument_list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_expression *elt = *p++; + + if (elt) + { + elt->accept (*this); + + if (p != lst.end ()) + os << ", "; + } + } +} + +void +tree_print_code::visit_binary_expression (tree_binary_expression& expr) +{ + indent (); + + print_parens (expr, "("); + + tree_expression *op1 = expr.lhs (); + + if (op1) + op1->accept (*this); + + os << " " << expr.oper () << " "; + + tree_expression *op2 = expr.rhs (); + + if (op2) + op2->accept (*this); + + print_parens (expr, ")"); +} + +void +tree_print_code::visit_break_command (tree_break_command&) +{ + indent (); + + os << "break"; +} + +void +tree_print_code::visit_colon_expression (tree_colon_expression& expr) +{ + indent (); + + print_parens (expr, "("); + + tree_expression *op1 = expr.base (); + + if (op1) + op1->accept (*this); + + // Stupid syntax. + + tree_expression *op3 = expr.increment (); + + if (op3) + { + os << ":"; + op3->accept (*this); + } + + tree_expression *op2 = expr.limit (); + + if (op2) + { + os << ":"; + op2->accept (*this); + } + + print_parens (expr, ")"); +} + +void +tree_print_code::visit_continue_command (tree_continue_command&) +{ + indent (); + + os << "continue"; +} + +void +tree_print_code::do_decl_command (tree_decl_command& cmd) +{ + indent (); + + os << cmd.name () << " "; + + tree_decl_init_list *init_list = cmd.initializer_list (); + + if (init_list) + init_list->accept (*this); +} + +void +tree_print_code::visit_global_command (tree_global_command& cmd) +{ + do_decl_command (cmd); +} + +void +tree_print_code::visit_persistent_command (tree_persistent_command& cmd) +{ + do_decl_command (cmd); +} + +void +tree_print_code::visit_decl_elt (tree_decl_elt& cmd) +{ + tree_identifier *id = cmd.ident (); + + if (id) + id->accept (*this); + + tree_expression *expr = cmd.expression (); + + if (expr) + { + os << " = "; + + expr->accept (*this); + } +} + +void +tree_print_code::visit_decl_init_list (tree_decl_init_list& lst) +{ + tree_decl_init_list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_decl_elt *elt = *p++; + + if (elt) + { + elt->accept (*this); + + if (p != lst.end ()) + os << ", "; + } + } +} + +void +tree_print_code::visit_simple_for_command (tree_simple_for_command& cmd) +{ + print_comment_list (cmd.leading_comment ()); + + indent (); + + os << (cmd.in_parallel () ? "parfor " : "for "); + + tree_expression *lhs = cmd.left_hand_side (); + + tree_expression *maxproc = cmd.maxproc_expr (); + + if (maxproc) + os << "("; + + if (lhs) + lhs->accept (*this); + + os << " = "; + + tree_expression *expr = cmd.control_expr (); + + if (expr) + expr->accept (*this); + + if (maxproc) + { + os << ", "; + maxproc->accept (*this); + os << ")"; + } + + newline (); + + tree_statement_list *list = cmd.body (); + + if (list) + { + increment_indent_level (); + + list->accept (*this); + + decrement_indent_level (); + } + + print_indented_comment (cmd.trailing_comment ()); + + indent (); + + os << (cmd.in_parallel () ? "endparfor" : "endfor"); +} + +void +tree_print_code::visit_complex_for_command (tree_complex_for_command& cmd) +{ + print_comment_list (cmd.leading_comment ()); + + indent (); + + os << "for ["; + nesting.push ('['); + + tree_argument_list *lhs = cmd.left_hand_side (); + + if (lhs) + lhs->accept (*this); + + nesting.pop (); + os << "] = "; + + tree_expression *expr = cmd.control_expr (); + + if (expr) + expr->accept (*this); + + newline (); + + tree_statement_list *list = cmd.body (); + + if (list) + { + increment_indent_level (); + + list->accept (*this); + + decrement_indent_level (); + } + + print_indented_comment (cmd.trailing_comment ()); + + indent (); + + os << "endfor"; +} + +void +tree_print_code::visit_octave_user_script (octave_user_script& fcn) +{ + reset (); + + tree_statement_list *cmd_list = fcn.body (); + + if (cmd_list) + cmd_list->accept (*this); +} + +void +tree_print_code::visit_octave_user_function (octave_user_function& fcn) +{ + reset (); + + visit_octave_user_function_header (fcn); + + tree_statement_list *cmd_list = fcn.body (); + + if (cmd_list) + { + increment_indent_level (); + + cmd_list->accept (*this); + + decrement_indent_level (); + } + + visit_octave_user_function_trailer (fcn); +} + +void +tree_print_code::visit_octave_user_function_header (octave_user_function& fcn) +{ + octave_comment_list *leading_comment = fcn.leading_comment (); + + if (leading_comment) + { + print_comment_list (leading_comment); + newline (); + } + + indent (); + + os << "function "; + + tree_parameter_list *ret_list = fcn.return_list (); + + if (ret_list) + { + bool takes_var_return = fcn.takes_var_return (); + + int len = ret_list->length (); + + if (len > 1 || takes_var_return) + { + os << "["; + nesting.push ('['); + } + + ret_list->accept (*this); + + if (takes_var_return) + { + if (len > 0) + os << ", "; + + os << "varargout"; + } + + if (len > 1 || takes_var_return) + { + nesting.pop (); + os << "]"; + } + + os << " = "; + } + + std::string fcn_name = fcn.name (); + + os << (fcn_name.empty () ? std::string ("(empty)") : fcn_name) << " "; + + tree_parameter_list *param_list = fcn.parameter_list (); + + if (param_list) + { + bool takes_varargs = fcn.takes_varargs (); + + int len = param_list->length (); + + if (len > 0 || takes_varargs) + { + os << "("; + nesting.push ('('); + } + + param_list->accept (*this); + + if (takes_varargs) + { + if (len > 0) + os << ", "; + + os << "varargin"; + } + + if (len > 0 || takes_varargs) + { + nesting.pop (); + os << ")"; + newline (); + } + } + else + { + os << "()"; + newline (); + } +} + +void +tree_print_code::visit_octave_user_function_trailer (octave_user_function& fcn) +{ + print_indented_comment (fcn.trailing_comment ()); + + newline (); +} + +void +tree_print_code::visit_function_def (tree_function_def& fdef) +{ + indent (); + + octave_value fcn = fdef.function (); + + octave_function *f = fcn.function_value (); + + if (f) + f->accept (*this); +} + +void +tree_print_code::visit_identifier (tree_identifier& id) +{ + indent (); + + print_parens (id, "("); + + std::string nm = id.name (); + os << (nm.empty () ? std::string ("(empty)") : nm); + + print_parens (id, ")"); +} + +void +tree_print_code::visit_if_clause (tree_if_clause& cmd) +{ + tree_expression *expr = cmd.condition (); + + if (expr) + expr->accept (*this); + + newline (); + + tree_statement_list *list = cmd.commands (); + + if (list) + { + increment_indent_level (); + + list->accept (*this); + + decrement_indent_level (); + } +} + +void +tree_print_code::visit_if_command (tree_if_command& cmd) +{ + print_comment_list (cmd.leading_comment ()); + + indent (); + + os << "if "; + + tree_if_command_list *list = cmd.cmd_list (); + + if (list) + list->accept (*this); + + print_indented_comment (cmd.trailing_comment ()); + + indent (); + + os << "endif"; +} + +void +tree_print_code::visit_if_command_list (tree_if_command_list& lst) +{ + tree_if_command_list::iterator p = lst.begin (); + + bool first_elt = true; + + while (p != lst.end ()) + { + tree_if_clause *elt = *p++; + + if (elt) + { + if (! first_elt) + { + print_indented_comment (elt->leading_comment ()); + + indent (); + + if (elt->is_else_clause ()) + os << "else"; + else + os << "elseif "; + } + + elt->accept (*this); + } + + first_elt = false; + } +} + +void +tree_print_code::visit_index_expression (tree_index_expression& expr) +{ + indent (); + + print_parens (expr, "("); + + tree_expression *e = expr.expression (); + + if (e) + e->accept (*this); + + std::list arg_lists = expr.arg_lists (); + std::string type_tags = expr.type_tags (); + std::list arg_names = expr.arg_names (); + + int n = type_tags.length (); + + std::list::iterator p_arg_lists = arg_lists.begin (); + std::list::iterator p_arg_names = arg_names.begin (); + + for (int i = 0; i < n; i++) + { + switch (type_tags[i]) + { + case '(': + { + char nc = nesting.top (); + if ((nc == '[' || nc == '{') && expr.paren_count () == 0) + os << "("; + else + os << " ("; + nesting.push ('('); + + tree_argument_list *l = *p_arg_lists; + if (l) + l->accept (*this); + + nesting.pop (); + os << ")"; + } + break; + + case '{': + { + char nc = nesting.top (); + if ((nc == '[' || nc == '{') && expr.paren_count () == 0) + os << "{"; + else + os << " {"; + // We only care about whitespace inside [] and {} when we + // are defining matrix and cell objects, not when indexing. + nesting.push ('('); + + tree_argument_list *l = *p_arg_lists; + if (l) + l->accept (*this); + + nesting.pop (); + os << "}"; + } + break; + + case '.': + { + string_vector nm = *p_arg_names; + assert (nm.length () == 1); + os << "." << nm(0); + } + break; + + default: + panic_impossible (); + } + + p_arg_lists++; + p_arg_names++; + } + + print_parens (expr, ")"); +} + +void +tree_print_code::visit_matrix (tree_matrix& lst) +{ + indent (); + + print_parens (lst, "("); + + os << "["; + nesting.push ('['); + + tree_matrix::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_argument_list *elt = *p++; + + if (elt) + { + elt->accept (*this); + + if (p != lst.end ()) + os << "; "; + } + } + + nesting.pop (); + os << "]"; + + print_parens (lst, ")"); +} + +void +tree_print_code::visit_cell (tree_cell& lst) +{ + indent (); + + print_parens (lst, "("); + + os << "{"; + nesting.push ('{'); + + tree_cell::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_argument_list *elt = *p++; + + if (elt) + { + elt->accept (*this); + + if (p != lst.end ()) + os << "; "; + } + } + + nesting.pop (); + os << "}"; + + print_parens (lst, ")"); +} + +void +tree_print_code::visit_multi_assignment (tree_multi_assignment& expr) +{ + indent (); + + print_parens (expr, "("); + + tree_argument_list *lhs = expr.left_hand_side (); + + if (lhs) + { + int len = lhs->length (); + + if (len > 1) + { + os << "["; + nesting.push ('['); + } + + lhs->accept (*this); + + if (len > 1) + { + nesting.pop (); + os << "]"; + } + } + + os << " " << expr.oper () << " "; + + tree_expression *rhs = expr.right_hand_side (); + + if (rhs) + rhs->accept (*this); + + print_parens (expr, ")"); +} + +void +tree_print_code::visit_no_op_command (tree_no_op_command& cmd) +{ + indent (); + + os << cmd.original_command (); +} + +void +tree_print_code::visit_constant (tree_constant& val) +{ + indent (); + + print_parens (val, "("); + + val.print_raw (os, true, print_original_text); + + print_parens (val, ")"); +} + +void +tree_print_code::visit_fcn_handle (tree_fcn_handle& fh) +{ + indent (); + + print_parens (fh, "("); + + fh.print_raw (os, true, print_original_text); + + print_parens (fh, ")"); +} + +void +tree_print_code::visit_parameter_list (tree_parameter_list& lst) +{ + tree_parameter_list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_decl_elt *elt = *p++; + + if (elt) + { + elt->accept (*this); + + if (p != lst.end ()) + os << ", "; + } + } +} + +void +tree_print_code::visit_postfix_expression (tree_postfix_expression& expr) +{ + indent (); + + print_parens (expr, "("); + + tree_expression *e = expr.operand (); + + if (e) + e->accept (*this); + + os << expr.oper (); + + print_parens (expr, ")"); +} + +void +tree_print_code::visit_prefix_expression (tree_prefix_expression& expr) +{ + indent (); + + print_parens (expr, "("); + + os << expr.oper (); + + tree_expression *e = expr.operand (); + + if (e) + e->accept (*this); + + print_parens (expr, ")"); +} + +void +tree_print_code::visit_return_command (tree_return_command&) +{ + indent (); + + os << "return"; +} + +void +tree_print_code::visit_return_list (tree_return_list& lst) +{ + tree_return_list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_index_expression *elt = *p++; + + if (elt) + { + elt->accept (*this); + + if (p != lst.end ()) + os << ", "; + } + } +} + +void +tree_print_code::visit_simple_assignment (tree_simple_assignment& expr) +{ + indent (); + + print_parens (expr, "("); + + tree_expression *lhs = expr.left_hand_side (); + + if (lhs) + lhs->accept (*this); + + os << " " << expr.oper () << " "; + + tree_expression *rhs = expr.right_hand_side (); + + if (rhs) + rhs->accept (*this); + + print_parens (expr, ")"); +} + +void +tree_print_code::visit_statement (tree_statement& stmt) +{ + print_comment_list (stmt.comment_text ()); + + tree_command *cmd = stmt.command (); + + if (cmd) + { + cmd->accept (*this); + + if (! stmt.print_result ()) + { + os << ";"; + newline (" "); + } + else + newline (); + } + else + { + tree_expression *expr = stmt.expression (); + + if (expr) + { + expr->accept (*this); + + if (! stmt.print_result ()) + { + os << ";"; + newline (" "); + } + else + newline (); + } + } +} + +void +tree_print_code::visit_statement_list (tree_statement_list& lst) +{ + for (tree_statement_list::iterator p = lst.begin (); p != lst.end (); p++) + { + tree_statement *elt = *p; + + if (elt) + elt->accept (*this); + } +} + +void +tree_print_code::visit_switch_case (tree_switch_case& cs) +{ + print_comment_list (cs.leading_comment ()); + + indent (); + + if (cs.is_default_case ()) + os << "otherwise"; + else + os << "case "; + + tree_expression *label = cs.case_label (); + + if (label) + label->accept (*this); + + newline (); + + tree_statement_list *list = cs.commands (); + + if (list) + { + increment_indent_level (); + + list->accept (*this); + + newline (); + + decrement_indent_level (); + } +} + +void +tree_print_code::visit_switch_case_list (tree_switch_case_list& lst) +{ + tree_switch_case_list::iterator p = lst.begin (); + + while (p != lst.end ()) + { + tree_switch_case *elt = *p++; + + if (elt) + elt->accept (*this); + } +} + +void +tree_print_code::visit_switch_command (tree_switch_command& cmd) +{ + print_comment_list (cmd.leading_comment ()); + + indent (); + + os << "switch "; + + tree_expression *expr = cmd.switch_value (); + + if (expr) + expr->accept (*this); + + newline (); + + tree_switch_case_list *list = cmd.case_list (); + + if (list) + { + increment_indent_level (); + + list->accept (*this); + + decrement_indent_level (); + } + + print_indented_comment (cmd.leading_comment ()); + + indent (); + + os << "endswitch"; +} + +void +tree_print_code::visit_try_catch_command (tree_try_catch_command& cmd) +{ + print_comment_list (cmd.leading_comment ()); + + indent (); + + os << "try"; + + newline (); + + tree_statement_list *try_code = cmd.body (); + + if (try_code) + { + increment_indent_level (); + + try_code->accept (*this); + + decrement_indent_level (); + } + + print_indented_comment (cmd.middle_comment ()); + + indent (); + + os << "catch"; + + newline (); + + tree_statement_list *catch_code = cmd.cleanup (); + + if (catch_code) + { + increment_indent_level (); + + catch_code->accept (*this); + + decrement_indent_level (); + } + + print_indented_comment (cmd.trailing_comment ()); + + indent (); + + os << "end_try_catch"; +} + +void +tree_print_code::visit_unwind_protect_command + (tree_unwind_protect_command& cmd) +{ + print_comment_list (cmd.leading_comment ()); + + indent (); + + os << "unwind_protect"; + + newline (); + + tree_statement_list *unwind_protect_code = cmd.body (); + + if (unwind_protect_code) + { + increment_indent_level (); + + unwind_protect_code->accept (*this); + + decrement_indent_level (); + } + + print_indented_comment (cmd.middle_comment ()); + + indent (); + + os << "unwind_protect_cleanup"; + + newline (); + + tree_statement_list *cleanup_code = cmd.cleanup (); + + if (cleanup_code) + { + increment_indent_level (); + + cleanup_code->accept (*this); + + decrement_indent_level (); + } + + print_indented_comment (cmd.trailing_comment ()); + + indent (); + + os << "end_unwind_protect"; +} + +void +tree_print_code::visit_while_command (tree_while_command& cmd) +{ + print_comment_list (cmd.leading_comment ()); + + indent (); + + os << "while "; + + tree_expression *expr = cmd.condition (); + + if (expr) + expr->accept (*this); + + newline (); + + tree_statement_list *list = cmd.body (); + + if (list) + { + increment_indent_level (); + + list->accept (*this); + + decrement_indent_level (); + } + + print_indented_comment (cmd.trailing_comment ()); + + indent (); + + os << "endwhile"; +} + +void +tree_print_code::visit_do_until_command (tree_do_until_command& cmd) +{ + print_comment_list (cmd.leading_comment ()); + + indent (); + + os << "do"; + + newline (); + + tree_statement_list *list = cmd.body (); + + if (list) + { + increment_indent_level (); + + list->accept (*this); + + decrement_indent_level (); + } + + print_indented_comment (cmd.trailing_comment ()); + + indent (); + + os << "until"; + + tree_expression *expr = cmd.condition (); + + if (expr) + expr->accept (*this); + + newline (); +} + +void +tree_print_code::print_fcn_handle_body (tree_statement_list *b) +{ + if (b) + { + assert (b->length () == 1); + + tree_statement *s = b->front (); + + if (s) + { + if (s->is_expression ()) + { + tree_expression *e = s->expression (); + + if (e) + { + suppress_newlines++; + e->accept (*this); + suppress_newlines--; + } + } + else + { + tree_command *c = s->command (); + + suppress_newlines++; + c->accept (*this); + suppress_newlines--; + } + } + } +} + +// Each print_code() function should call this before printing +// anything. +// +// This doesn't need to be fast, but isn't there a better way? + +void +tree_print_code::indent (void) +{ + assert (curr_print_indent_level >= 0); + + if (beginning_of_line) + { + os << prefix; + + for (int i = 0; i < curr_print_indent_level; i++) + os << " "; + + beginning_of_line = false; + } +} + +// All print_code() functions should use this to print new lines. + +void +tree_print_code::newline (const char *alt_txt) +{ + if (suppress_newlines) + os << alt_txt; + else + { + os << "\n"; + + beginning_of_line = true; + } +} + +// For ressetting print_code state. + +void +tree_print_code::reset (void) +{ + beginning_of_line = true; + curr_print_indent_level = 0; + while (nesting.top () != 'n') + nesting.pop (); +} + +void +tree_print_code::print_parens (const tree_expression& expr, const char *txt) +{ + int n = expr.paren_count (); + + for (int i = 0; i < n; i++) + os << txt; +} + +void +tree_print_code::print_comment_elt (const octave_comment_elt& elt) +{ + bool printed_something = false; + + bool prev_char_was_newline = false; + + std::string comment = elt.text (); + + size_t len = comment.length (); + + size_t i = 0; + + while (i < len && comment[i++] == '\n') + ; /* Skip leading new lines. */ + i--; + + while (i < len) + { + char c = comment[i++]; + + if (c == '\n') + { + if (prev_char_was_newline) + os << "##"; + + newline (); + + prev_char_was_newline = true; + } + else + { + if (beginning_of_line) + { + printed_something = true; + + indent (); + + os << "##"; + + if (! (isspace (c) || c == '!')) + os << " "; + } + + os << static_cast (c); + + prev_char_was_newline = false; + } + } + + if (printed_something && ! beginning_of_line) + newline (); +} + +void +tree_print_code::print_comment_list (octave_comment_list *comment_list) +{ + if (comment_list) + { + octave_comment_list::iterator p = comment_list->begin (); + + while (p != comment_list->end ()) + { + octave_comment_elt elt = *p++; + + print_comment_elt (elt); + + if (p != comment_list->end ()) + newline (); + } + } +} + +void +tree_print_code::print_indented_comment (octave_comment_list *comment_list) +{ + increment_indent_level (); + + print_comment_list (comment_list); + + decrement_indent_level (); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-pr-code.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-pr-code.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,196 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_print_code_h) +#define octave_tree_print_code_h 1 + +#include +#include + +#include "comment-list.h" +#include "pt-walk.h" + +class tree_decl_command; +class tree_expression; + +// How to print the code that the parse trees represent. + +class +tree_print_code : public tree_walker +{ +public: + + tree_print_code (std::ostream& os_arg, + const std::string& pfx = std::string (), + bool pr_orig_txt = true) + : os (os_arg), prefix (pfx), nesting (), + print_original_text (pr_orig_txt), + curr_print_indent_level (0), beginning_of_line (true), + suppress_newlines (0) + { + // For "none". + nesting.push ('n'); + } + + ~tree_print_code (void) { } + + void visit_anon_fcn_handle (tree_anon_fcn_handle&); + + void visit_argument_list (tree_argument_list&); + + void visit_binary_expression (tree_binary_expression&); + + void visit_break_command (tree_break_command&); + + void visit_colon_expression (tree_colon_expression&); + + void visit_continue_command (tree_continue_command&); + + void visit_global_command (tree_global_command&); + + void visit_persistent_command (tree_persistent_command&); + + void visit_decl_elt (tree_decl_elt&); + + void visit_decl_init_list (tree_decl_init_list&); + + void visit_simple_for_command (tree_simple_for_command&); + + void visit_complex_for_command (tree_complex_for_command&); + + void visit_octave_user_script (octave_user_script&); + + void visit_octave_user_function (octave_user_function&); + + void visit_octave_user_function_header (octave_user_function&); + + void visit_octave_user_function_trailer (octave_user_function&); + + void visit_function_def (tree_function_def&); + + void visit_identifier (tree_identifier&); + + void visit_if_clause (tree_if_clause&); + + void visit_if_command (tree_if_command&); + + void visit_if_command_list (tree_if_command_list&); + + void visit_index_expression (tree_index_expression&); + + void visit_matrix (tree_matrix&); + + void visit_cell (tree_cell&); + + void visit_multi_assignment (tree_multi_assignment&); + + void visit_no_op_command (tree_no_op_command&); + + void visit_constant (tree_constant&); + + void visit_fcn_handle (tree_fcn_handle&); + + void visit_parameter_list (tree_parameter_list&); + + void visit_postfix_expression (tree_postfix_expression&); + + void visit_prefix_expression (tree_prefix_expression&); + + void visit_return_command (tree_return_command&); + + void visit_return_list (tree_return_list&); + + void visit_simple_assignment (tree_simple_assignment&); + + void visit_statement (tree_statement&); + + void visit_statement_list (tree_statement_list&); + + void visit_switch_case (tree_switch_case&); + + void visit_switch_case_list (tree_switch_case_list&); + + void visit_switch_command (tree_switch_command&); + + void visit_try_catch_command (tree_try_catch_command&); + + void visit_unwind_protect_command (tree_unwind_protect_command&); + + void visit_while_command (tree_while_command&); + + void visit_do_until_command (tree_do_until_command&); + + void print_fcn_handle_body (tree_statement_list *); + +private: + + std::ostream& os; + + std::string prefix; + + std::stack nesting; + + bool print_original_text; + + // Current indentation. + int curr_print_indent_level; + + // TRUE means we are at the beginning of a line. + bool beginning_of_line; + + // Nonzero means we are not printing newlines and indenting. + int suppress_newlines; + + void do_decl_command (tree_decl_command& cmd); + + void reset_indent_level (void) { curr_print_indent_level = 0; } + + void increment_indent_level (void) { curr_print_indent_level += 2; } + + void decrement_indent_level (void) { curr_print_indent_level -= 2; } + + void newline (const char *alt_txt = ", "); + + void indent (void); + + void reset (void); + + void print_parens (const tree_expression& expr, const char *txt); + + void print_comment_list (octave_comment_list *comment_list); + + void print_comment_elt (const octave_comment_elt& comment_elt); + + void print_indented_comment (octave_comment_list *comment_list); + + // Must create with an output stream! + + tree_print_code (void); + + // No copying! + + tree_print_code (const tree_print_code&); + + tree_print_code& operator = (const tree_print_code&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-select.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-select.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,223 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "oct-obj.h" +#include "ov.h" +#include "pt-cmd.h" +#include "pt-exp.h" +#include "pt-select.h" +#include "pt-stmt.h" +#include "pt-walk.h" +#include "Cell.h" +#include "ov-typeinfo.h" + +// If clauses. + +tree_if_clause::~tree_if_clause (void) +{ + delete expr; + delete list; + delete lead_comm; +} + +tree_if_clause * +tree_if_clause::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return new tree_if_clause (expr ? expr->dup (scope, context) : 0, + list ? list->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0); +} + +void +tree_if_clause::accept (tree_walker& tw) +{ + tw.visit_if_clause (*this); +} + +// List of if commands. + +tree_if_command_list * +tree_if_command_list::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_if_command_list *new_icl = new tree_if_command_list (); + + for (const_iterator p = begin (); p != end (); p++) + { + const tree_if_clause *elt = *p; + + new_icl->append (elt ? elt->dup (scope, context) : 0); + } + + return new_icl; +} + +void +tree_if_command_list::accept (tree_walker& tw) +{ + tw.visit_if_command_list (*this); +} + +// If. + +tree_if_command::~tree_if_command (void) +{ + delete list; + delete lead_comm; + delete trail_comm; +} + +tree_command * +tree_if_command::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return new tree_if_command (list ? list->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0, + trail_comm ? trail_comm->dup () : 0, + line (), column ()); +} + +void +tree_if_command::accept (tree_walker& tw) +{ + tw.visit_if_command (*this); +} + +// Switch cases. + +tree_switch_case::~tree_switch_case (void) +{ + delete label; + delete list; + delete lead_comm; +} + + +bool +tree_switch_case::label_matches (const octave_value& val) +{ + octave_value label_value = label->rvalue1 (); + + if (! error_state && label_value.is_defined () ) + { + if (label_value.is_cell ()) + { + Cell cell (label_value.cell_value ()); + + for (octave_idx_type i = 0; i < cell.rows (); i++) + { + for (octave_idx_type j = 0; j < cell.columns (); j++) + { + bool match = val.is_equal (cell(i,j)); + + if (error_state) + return false; + else if (match) + return true; + } + } + } + else + { + bool match = val.is_equal (label_value); + + if (error_state) + return false; + else + return match; + } + } + + return false; +} + +tree_switch_case * +tree_switch_case::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return new tree_switch_case (label ? label->dup (scope, context) : 0, + list ? list->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0); +} + +void +tree_switch_case::accept (tree_walker& tw) +{ + tw.visit_switch_case (*this); +} + +// List of switch cases. + +tree_switch_case_list * +tree_switch_case_list::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_switch_case_list *new_scl = new tree_switch_case_list (); + + for (const_iterator p = begin (); p != end (); p++) + { + const tree_switch_case *elt = *p; + + new_scl->append (elt ? elt->dup (scope, context) : 0); + } + + return new_scl; +} + +void +tree_switch_case_list::accept (tree_walker& tw) +{ + tw.visit_switch_case_list (*this); +} + +// Switch. + +tree_switch_command::~tree_switch_command (void) +{ + delete expr; + delete list; + delete lead_comm; + delete trail_comm; +} + +tree_command * +tree_switch_command::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + return new tree_switch_command (expr ? expr->dup (scope, context) : 0, + list ? list->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0, + trail_comm ? trail_comm->dup () : 0, + line (), column ()); +} + +void +tree_switch_command::accept (tree_walker& tw) +{ + tw.visit_switch_command (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-select.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-select.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,302 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_select_h) +#define octave_tree_select_h 1 + +class expression; +class tree_statement_list; + +class tree_walker; + +#include "base-list.h" +#include "comment-list.h" +#include "pt-cmd.h" +#include "symtab.h" + +// If. + +class +tree_if_clause : public tree +{ +public: + + tree_if_clause (int l = -1, int c = -1) + : tree (l, c), expr (0), list (0), lead_comm (0) { } + + tree_if_clause (tree_statement_list *sl, octave_comment_list *lc = 0, + int l = -1, int c = -1) + : tree (l, c), expr (0), list (sl), lead_comm (lc) { } + + tree_if_clause (tree_expression *e, tree_statement_list *sl, + octave_comment_list *lc = 0, + int l = -1, int c = -1) + : tree (l, c), expr (e), list (sl), lead_comm (lc) { } + + ~tree_if_clause (void); + + bool is_else_clause (void) { return ! expr; } + + tree_expression *condition (void) { return expr; } + + tree_statement_list *commands (void) { return list; } + + octave_comment_list *leading_comment (void) { return lead_comm; } + + tree_if_clause *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // The condition to test. + tree_expression *expr; + + // The list of statements to evaluate if expr is true. + tree_statement_list *list; + + // Comment preceding ELSE or ELSEIF token. + octave_comment_list *lead_comm; + + // No copying! + + tree_if_clause (const tree_if_clause&); + + tree_if_clause& operator = (const tree_if_clause&); +}; + +class +tree_if_command_list : public octave_base_list +{ +public: + + tree_if_command_list (void) { } + + tree_if_command_list (tree_if_clause *t) { append (t); } + + ~tree_if_command_list (void) + { + while (! empty ()) + { + iterator p = begin (); + delete *p; + erase (p); + } + } + + tree_if_command_list *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // No copying! + + tree_if_command_list (const tree_if_command_list&); + + tree_if_command_list& operator = (const tree_if_command_list&); +}; + +class +tree_if_command : public tree_command +{ +public: + + tree_if_command (int l = -1, int c = -1) + : tree_command (l, c), list (0), lead_comm (0), trail_comm (0) { } + + tree_if_command (tree_if_command_list *lst, octave_comment_list *lc, + octave_comment_list *tc, int l = -1, int c = -1) + : tree_command (l, c), list (lst), lead_comm (lc), trail_comm (tc) { } + + ~tree_if_command (void); + + tree_if_command_list *cmd_list (void) { return list; } + + octave_comment_list *leading_comment (void) { return lead_comm; } + + octave_comment_list *trailing_comment (void) { return trail_comm; } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // List of if commands (if, elseif, elseif, ... else, endif) + tree_if_command_list *list; + + // Comment preceding IF token. + octave_comment_list *lead_comm; + + // Comment preceding ENDIF token. + octave_comment_list *trail_comm; + + // No copying! + + tree_if_command (const tree_if_command&); + + tree_if_command& operator = (const tree_if_command&); +}; + +// Switch. + +class +tree_switch_case : public tree +{ +public: + + tree_switch_case (int l = -1, int c = -1) + : tree (l, c), label (0), list (0), lead_comm (0) { } + + tree_switch_case (tree_statement_list *sl, octave_comment_list *lc = 0, + int l = -1, int c = -1) + : tree (l, c), label (0), list (sl), lead_comm (lc) { } + + tree_switch_case (tree_expression *e, tree_statement_list *sl, + octave_comment_list *lc = 0, + int l = -1, int c = -1) + : tree (l, c), label (e), list (sl), lead_comm (lc) { } + + ~tree_switch_case (void); + + bool is_default_case (void) { return ! label; } + + bool label_matches (const octave_value& val); + + tree_expression *case_label (void) { return label; } + + tree_statement_list *commands (void) { return list; } + + octave_comment_list *leading_comment (void) { return lead_comm; } + + tree_switch_case *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // The case label. + tree_expression *label; + + // The list of statements to evaluate if the label matches. + tree_statement_list *list; + + // Comment preceding CASE or OTHERWISE token. + octave_comment_list *lead_comm; + + // No copying! + + tree_switch_case (const tree_switch_case&); + + tree_switch_case& operator = (const tree_switch_case&); +}; + +class +tree_switch_case_list : public octave_base_list +{ +public: + + tree_switch_case_list (void) { } + + tree_switch_case_list (tree_switch_case *t) { append (t); } + + ~tree_switch_case_list (void) + { + while (! empty ()) + { + iterator p = begin (); + delete *p; + erase (p); + } + } + + tree_switch_case_list *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // No copying! + + tree_switch_case_list (const tree_switch_case_list&); + + tree_switch_case_list& operator = (const tree_switch_case_list&); +}; + +class +tree_switch_command : public tree_command +{ +public: + + tree_switch_command (int l = -1, int c = -1) + : tree_command (l, c), expr (0), list (0), lead_comm (0), + trail_comm (0) { } + + tree_switch_command (tree_expression *e, tree_switch_case_list *lst, + octave_comment_list *lc, octave_comment_list *tc, + int l = -1, int c = -1) + : tree_command (l, c), expr (e), list (lst), lead_comm (lc), + trail_comm (tc) { } + + ~tree_switch_command (void); + + tree_expression *switch_value (void) { return expr; } + + tree_switch_case_list *case_list (void) { return list; } + + octave_comment_list *leading_comment (void) { return lead_comm; } + + octave_comment_list *trailing_comment (void) { return trail_comm; } + + tree_command *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // Value on which to switch. + tree_expression *expr; + + // List of cases (case 1, case 2, ..., default) + tree_switch_case_list *list; + + // Comment preceding SWITCH token. + octave_comment_list *lead_comm; + + // Comment preceding ENDSWITCH token. + octave_comment_list *trail_comm; + + // No copying! + + tree_switch_command (const tree_switch_command&); + + tree_switch_command& operator = (const tree_switch_command&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-stmt.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-stmt.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,216 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "quit.h" + +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "ov.h" +#include "oct-lvalue.h" +#include "input.h" +#include "pager.h" +#include "pt-bp.h" +#include "pt-cmd.h" +#include "pt-id.h" +#include "pt-idx.h" +#include "pt-jump.h" +#include "pt-pr-code.h" +#include "pt-stmt.h" +#include "pt-walk.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// A list of commands to be executed. + +tree_statement::~tree_statement (void) +{ + delete cmd; + delete expr; + delete comm; +} + +void +tree_statement::set_print_flag (bool print_flag) +{ + if (expr) + expr->set_print_flag (print_flag); +} + +bool +tree_statement::print_result (void) +{ + return expr && expr->print_result (); +} + +void +tree_statement::set_breakpoint (void) +{ + if (cmd) + cmd->set_breakpoint (); + else if (expr) + expr->set_breakpoint (); +} + +void +tree_statement::delete_breakpoint (void) +{ + if (cmd) + cmd->delete_breakpoint (); + else if (expr) + expr->delete_breakpoint (); +} + +bool +tree_statement::is_breakpoint (void) const +{ + return cmd ? cmd->is_breakpoint () : (expr ? expr->is_breakpoint () : false); +} + +int +tree_statement::line (void) const +{ + return cmd ? cmd->line () : (expr ? expr->line () : -1); +} + +int +tree_statement::column (void) const +{ + return cmd ? cmd->column () : (expr ? expr->column () : -1); +} + +void +tree_statement::echo_code (void) +{ + tree_print_code tpc (octave_stdout, VPS4); + + accept (tpc); +} + +bool +tree_statement::is_end_of_fcn_or_script (void) const +{ + bool retval = false; + + if (cmd) + { + tree_no_op_command *no_op_cmd + = dynamic_cast (cmd); + + if (no_op_cmd) + retval = no_op_cmd->is_end_of_fcn_or_script (); + } + + return retval; +} + +tree_statement * +tree_statement::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_statement *new_stmt = new tree_statement (); + + new_stmt->cmd = cmd ? cmd->dup (scope, context) : 0; + + new_stmt->expr = expr ? expr->dup (scope, context) : 0; + + new_stmt->comm = comm ? comm->dup () : 0; + + return new_stmt; +} + +void +tree_statement::accept (tree_walker& tw) +{ + tw.visit_statement (*this); +} + +int +tree_statement_list::set_breakpoint (int line) +{ + tree_breakpoint tbp (line, tree_breakpoint::set); + accept (tbp); + + return tbp.get_line (); +} + +void +tree_statement_list::delete_breakpoint (int line) +{ + if (line < 0) + { + octave_value_list bp_lst = list_breakpoints (); + + int len = bp_lst.length (); + + for (int i = 0; i < len; i++) + { + tree_breakpoint tbp (i, tree_breakpoint::clear); + accept (tbp); + } + } + else + { + tree_breakpoint tbp (line, tree_breakpoint::clear); + accept (tbp); + } +} + +octave_value_list +tree_statement_list::list_breakpoints (void) +{ + tree_breakpoint tbp (0, tree_breakpoint::list); + accept (tbp); + + return tbp.get_list (); +} + +tree_statement_list * +tree_statement_list::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_statement_list *new_list = new tree_statement_list (); + + new_list->function_body = function_body; + + for (const_iterator p = begin (); p != end (); p++) + { + const tree_statement *elt = *p; + + new_list->append (elt ? elt->dup (scope, context) : 0); + } + + return new_list; +} + +void +tree_statement_list::accept (tree_walker& tw) +{ + tw.visit_statement_list (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-stmt.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-stmt.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,186 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_stmt_h) +#define octave_tree_stmt_h 1 + +class octave_value_list; + +class tree_command; +class tree_expression; + +class tree_walker; + +#include + +#include "base-list.h" +#include "comment-list.h" +#include "symtab.h" +#include "pt.h" + +// A statement is either a command to execute or an expression to +// evaluate. + +class +tree_statement : public tree +{ +public: + + tree_statement (void) + : cmd (0), expr (0), comm (0) { } + + tree_statement (tree_command *c, octave_comment_list *cl) + : cmd (c), expr (0), comm (cl) { } + + tree_statement (tree_expression *e, octave_comment_list *cl) + : cmd (0), expr (e), comm (cl) { } + + ~tree_statement (void); + + void set_print_flag (bool print_flag); + + bool print_result (void); + + bool is_command (void) const { return cmd != 0; } + + bool is_expression (void) const { return expr != 0; } + + void set_breakpoint (void); + + void delete_breakpoint (void); + + bool is_breakpoint (void) const; + + int line (void) const; + int column (void) const; + + void echo_code (void); + + tree_command *command (void) { return cmd; } + + tree_expression *expression (void) { return expr; } + + octave_comment_list *comment_text (void) { return comm; } + + bool is_null_statement (void) const { return ! (cmd || expr || comm); } + + bool is_end_of_fcn_or_script (void) const; + + // Allow modification of this statement. Note that there is no + // checking. If you use these, are you sure you knwo what you are + // doing? + + void set_command (tree_command *c) { cmd = c; } + + void set_expression (tree_expression *e) { expr = e; } + + tree_statement *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // Only one of cmd or expr can be valid at once. + + // Command to execute. + tree_command *cmd; + + // Expression to evaluate. + tree_expression *expr; + + // Comment associated with this statement. + octave_comment_list *comm; + + // No copying! + tree_statement (const tree_statement&); + + tree_statement& operator = (const tree_statement&); +}; + +// A list of statements to evaluate. + +class +tree_statement_list : public octave_base_list +{ +public: + + tree_statement_list (void) + : function_body (false), anon_function_body (false), + script_body (false) { } + + tree_statement_list (tree_statement *s) + : function_body (false), anon_function_body (false), + script_body (false) { append (s); } + + ~tree_statement_list (void) + { + while (! empty ()) + { + iterator p = begin (); + delete *p; + erase (p); + } + } + + void mark_as_function_body (void) { function_body = true; } + + void mark_as_anon_function_body (void) { anon_function_body = true; } + + void mark_as_script_body (void) { script_body = true; } + + bool is_function_body (void) const { return function_body; } + + bool is_anon_function_body (void) const { return anon_function_body; } + + bool is_script_body (void) const { return script_body; } + + int set_breakpoint (int line); + + void delete_breakpoint (int line); + + octave_value_list list_breakpoints (void); + + tree_statement_list *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // Does this list of statements make up the body of a function? + bool function_body; + + // Does this list of statements make up the body of a function? + bool anon_function_body; + + // Does this list of statements make up the body of a script? + bool script_body; + + // No copying! + + tree_statement_list (const tree_statement_list&); + + tree_statement_list& operator = (const tree_statement_list&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-unop.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-unop.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,208 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "ov.h" +#include "profiler.h" +#include "pt-bp.h" +#include "pt-unop.h" +#include "pt-walk.h" + +// Unary expressions. + +std::string +tree_unary_expression::oper (void) const +{ + return octave_value::unary_op_as_string (etype); +} + +// Prefix expressions. + +octave_value_list +tree_prefix_expression::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("prefix operator `%s': invalid number of output arguments", + oper () . c_str ()); + else + retval = rvalue1 (nargout); + + return retval; +} + +octave_value +tree_prefix_expression::rvalue1 (int) +{ + octave_value retval; + + if (error_state) + return retval; + + if (op) + { + if (etype == octave_value::op_incr || etype == octave_value::op_decr) + { + octave_lvalue ref = op->lvalue (); + + if (! error_state) + { + BEGIN_PROFILER_BLOCK ("prefix " + oper ()) + + ref.do_unary_op (etype); + + if (! error_state) + retval = ref.value (); + + END_PROFILER_BLOCK + } + } + else + { + octave_value val = op->rvalue1 (); + + if (! error_state && val.is_defined ()) + { + BEGIN_PROFILER_BLOCK ("prefix " + oper ()) + + // Attempt to do the operation in-place if it is unshared + // (a temporary expression). + if (val.get_count () == 1) + retval = val.do_non_const_unary_op (etype); + else + retval = ::do_unary_op (etype, val); + + if (error_state) + retval = octave_value (); + + END_PROFILER_BLOCK + } + } + } + + return retval; +} + +tree_expression * +tree_prefix_expression::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_prefix_expression *new_pe + = new tree_prefix_expression (op ? op->dup (scope, context) : 0, + line (), column (), etype); + + new_pe->copy_base (*this); + + return new_pe; +} + +void +tree_prefix_expression::accept (tree_walker& tw) +{ + tw.visit_prefix_expression (*this); +} + +// Postfix expressions. + +octave_value_list +tree_postfix_expression::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("postfix operator `%s': invalid number of output arguments", + oper () . c_str ()); + else + retval = rvalue1 (nargout); + + return retval; +} + +octave_value +tree_postfix_expression::rvalue1 (int) +{ + octave_value retval; + + if (error_state) + return retval; + + if (op) + { + if (etype == octave_value::op_incr || etype == octave_value::op_decr) + { + octave_lvalue ref = op->lvalue (); + + if (! error_state) + { + retval = ref.value (); + + BEGIN_PROFILER_BLOCK ("postfix " + oper ()) + ref.do_unary_op (etype); + END_PROFILER_BLOCK + } + } + else + { + octave_value val = op->rvalue1 (); + + if (! error_state && val.is_defined ()) + { + BEGIN_PROFILER_BLOCK ("postfix " + oper ()) + + retval = ::do_unary_op (etype, val); + + if (error_state) + retval = octave_value (); + + END_PROFILER_BLOCK + } + } + } + + return retval; +} + +tree_expression * +tree_postfix_expression::dup (symbol_table::scope_id scope, + symbol_table::context_id context) const +{ + tree_postfix_expression *new_pe + = new tree_postfix_expression (op ? op->dup (scope, context) : 0, + line (), column (), etype); + + new_pe->copy_base (*this); + + return new_pe; +} + +void +tree_postfix_expression::accept (tree_walker& tw) +{ + tw.visit_postfix_expression (*this); +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-unop.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-unop.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,157 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_unop_h) +#define octave_tree_unop_h 1 + +#include + +class tree_walker; + +class octave_value; +class octave_value_list; +class octave_lvalue; + +#include "pt-exp.h" +#include "symtab.h" + +// Unary expressions. + +class +tree_unary_expression : public tree_expression +{ +public: + + tree_unary_expression (int l = -1, int c = -1, + octave_value::unary_op t + = octave_value::unknown_unary_op) + : tree_expression (l, c), op (0), etype (t) { } + + tree_unary_expression (tree_expression *e, int l = -1, int c = -1, + octave_value::unary_op t + = octave_value::unknown_unary_op) + : tree_expression (l, c), op (e), etype (t) { } + + ~tree_unary_expression (void) { delete op; } + + bool is_unary_expression (void) const { return true; } + + bool has_magic_end (void) const { return (op && op->has_magic_end ()); } + + tree_expression *operand (void) { return op; } + + std::string oper (void) const; + + octave_value::unary_op op_type (void) const { return etype; } + +protected: + + // The operand for the expression. + tree_expression *op; + + // The type of the expression. + octave_value::unary_op etype; + +private: + + // No copying! + + tree_unary_expression (const tree_unary_expression&); + + tree_unary_expression& operator = (const tree_unary_expression&); +}; + +// Prefix expressions. + +class +tree_prefix_expression : public tree_unary_expression +{ +public: + + tree_prefix_expression (int l = -1, int c = -1) + : tree_unary_expression (l, c, octave_value::unknown_unary_op) { } + + tree_prefix_expression (tree_expression *e, int l = -1, int c = -1, + octave_value::unary_op t + = octave_value::unknown_unary_op) + : tree_unary_expression (e, l, c, t) { } + + ~tree_prefix_expression (void) { } + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // No copying! + + tree_prefix_expression (const tree_prefix_expression&); + + tree_prefix_expression& operator = (const tree_prefix_expression&); +}; + +// Postfix expressions. + +class +tree_postfix_expression : public tree_unary_expression +{ +public: + + tree_postfix_expression (int l = -1, int c = -1) + : tree_unary_expression (l, c, octave_value::unknown_unary_op) { } + + tree_postfix_expression (tree_expression *e, int l = -1, int c = -1, + octave_value::unary_op t + = octave_value::unknown_unary_op) + : tree_unary_expression (e, l, c, t) { } + + ~tree_postfix_expression (void) { } + + bool rvalue_ok (void) const { return true; } + + octave_value rvalue1 (int nargout = 1); + + octave_value_list rvalue (int nargout); + + tree_expression *dup (symbol_table::scope_id scope, + symbol_table::context_id context) const; + + void accept (tree_walker& tw); + +private: + + // No copying! + + tree_postfix_expression (const tree_postfix_expression&); + + tree_postfix_expression& operator = (const tree_postfix_expression&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt-walk.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt-walk.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,211 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_walker_h) +#define octave_tree_walker_h 1 + +class tree_anon_fcn_handle; +class tree_argument_list; +class tree_binary_expression; +class tree_break_command; +class tree_colon_expression; +class tree_continue_command; +class tree_global_command; +class tree_persistent_command; +class tree_decl_elt; +class tree_decl_init_list; +class tree_simple_for_command; +class tree_complex_for_command; +class octave_user_script; +class octave_user_function; +class tree_function_def; +class tree_identifier; +class tree_if_clause; +class tree_if_command; +class tree_if_command_list; +class tree_switch_case; +class tree_switch_case_list; +class tree_switch_command; +class tree_index_expression; +class tree_matrix; +class tree_cell; +class tree_multi_assignment; +class tree_no_op_command; +class tree_constant; +class tree_fcn_handle; +class tree_parameter_list; +class tree_postfix_expression; +class tree_prefix_expression; +class tree_return_command; +class tree_return_list; +class tree_simple_assignment; +class tree_statement; +class tree_statement_list; +class tree_try_catch_command; +class tree_unwind_protect_command; +class tree_while_command; +class tree_do_until_command; + +class +tree_walker +{ +public: + + virtual void + visit_anon_fcn_handle (tree_anon_fcn_handle&) = 0; + + virtual void + visit_argument_list (tree_argument_list&) = 0; + + virtual void + visit_binary_expression (tree_binary_expression&) = 0; + + virtual void + visit_break_command (tree_break_command&) = 0; + + virtual void + visit_colon_expression (tree_colon_expression&) = 0; + + virtual void + visit_continue_command (tree_continue_command&) = 0; + + virtual void + visit_global_command (tree_global_command&) = 0; + + virtual void + visit_persistent_command (tree_persistent_command&) = 0; + + virtual void + visit_decl_elt (tree_decl_elt&) = 0; + + virtual void + visit_decl_init_list (tree_decl_init_list&) = 0; + + virtual void + visit_simple_for_command (tree_simple_for_command&) = 0; + + virtual void + visit_complex_for_command (tree_complex_for_command&) = 0; + + virtual void + visit_octave_user_script (octave_user_script&) = 0; + + virtual void + visit_octave_user_function (octave_user_function&) = 0; + + virtual void + visit_function_def (tree_function_def&) = 0; + + virtual void + visit_identifier (tree_identifier&) = 0; + + virtual void + visit_if_clause (tree_if_clause&) = 0; + + virtual void + visit_if_command (tree_if_command&) = 0; + + virtual void + visit_if_command_list (tree_if_command_list&) = 0; + + virtual void + visit_switch_case (tree_switch_case&) = 0; + + virtual void + visit_switch_case_list (tree_switch_case_list&) = 0; + + virtual void + visit_switch_command (tree_switch_command&) = 0; + + virtual void + visit_index_expression (tree_index_expression&) = 0; + + virtual void + visit_matrix (tree_matrix&) = 0; + + virtual void + visit_cell (tree_cell&) = 0; + + virtual void + visit_multi_assignment (tree_multi_assignment&) = 0; + + virtual void + visit_no_op_command (tree_no_op_command&) = 0; + + virtual void + visit_constant (tree_constant&) = 0; + + virtual void + visit_fcn_handle (tree_fcn_handle&) = 0; + + virtual void + visit_parameter_list (tree_parameter_list&) = 0; + + virtual void + visit_postfix_expression (tree_postfix_expression&) = 0; + + virtual void + visit_prefix_expression (tree_prefix_expression&) = 0; + + virtual void + visit_return_command (tree_return_command&) = 0; + + virtual void + visit_return_list (tree_return_list&) = 0; + + virtual void + visit_simple_assignment (tree_simple_assignment&) = 0; + + virtual void + visit_statement (tree_statement&) = 0; + + virtual void + visit_statement_list (tree_statement_list&) = 0; + + virtual void + visit_try_catch_command (tree_try_catch_command&) = 0; + + virtual void + visit_unwind_protect_command (tree_unwind_protect_command&) = 0; + + virtual void + visit_while_command (tree_while_command&) = 0; + + virtual void + visit_do_until_command (tree_do_until_command&) = 0; + +protected: + + tree_walker (void) { } + + virtual ~tree_walker (void) { } + +private: + + // No copying! + + tree_walker (const tree_walker&); + + tree_walker& operator = (const tree_walker&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,50 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "ov-fcn.h" +#include "pt.h" +#include "pt-pr-code.h" + +// Hide the details of the string buffer so that we are less likely to +// create a memory leak. + +std::string +tree::str_print_code (void) +{ + std::ostringstream buf; + + tree_print_code tpc (buf); + + accept (tpc); + + std::string retval = buf.str (); + + return retval; +} diff -r d02b229ce693 -r a132d206a36a src/parse-tree/pt.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/pt.h Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,80 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#if !defined (octave_tree_h) +#define octave_tree_h 1 + +#include + +#include + +class octave_function; +class tree_walker; + +// Base class for the parse tree. + +class +tree +{ +public: + + tree (int l = -1, int c = -1) + : line_num (l), column_num (c), bp (false) { } + + virtual ~tree (void) { } + + virtual int line (void) const { return line_num; } + + virtual int column (void) const { return column_num; } + + void line (int l) { line_num = l; } + + void column (int c) { column_num = c; } + + virtual void set_breakpoint (void) { bp = true; } + + virtual void delete_breakpoint (void) { bp = false; } + + bool is_breakpoint (void) const { return bp; } + + std::string str_print_code (void); + + virtual void accept (tree_walker& tw) = 0; + +private: + + // The input line and column where we found the text that was + // eventually converted to this tree node. + int line_num; + int column_num; + + // Breakpoint flag. + bool bp; + + // No copying! + + tree (const tree&); + + tree& operator = (const tree&); +}; + +#endif diff -r d02b229ce693 -r a132d206a36a src/parse.h --- a/src/parse.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,116 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_parse_h) -#define octave_parse_h 1 - -#include - -#include - -#include - -extern void reset_parser (void); -extern int octave_lex (void); -extern int octave_parse (void); - -class tree; -class tree_matrix; -class tree_identifier; -class tree_statement_list; -class octave_function; - -#include "oct-obj.h" - -// Nonzero means print parser debugging info (-d). -extern int octave_debug; - -// The current input line number. -extern int input_line_number; - -// The column of the current token. -extern int current_input_column; - -// Buffer for help text snagged from function files. -extern std::stack help_buf; - -// TRUE means we are using readline. -extern bool line_editing; - -// TRUE means we printed messages about reading startup files. -extern bool reading_startup_message_printed; - -// TRUE means input is coming from startup file. -extern bool input_from_startup_file; - -// Name of the current class when we are parsing class methods or -// constructors. -extern std::string current_class_name; - -extern OCTINTERP_API std::string -get_help_from_file (const std::string& nm, bool& symbol_found, - std::string& file); - -extern OCTINTERP_API std::string -get_help_from_file (const std::string& nm, bool& symbol_found); - -extern OCTINTERP_API std::string lookup_autoload (const std::string& nm); - -extern OCTINTERP_API string_vector autoloaded_functions (void); - -extern OCTINTERP_API string_vector reverse_lookup_autoload (const std::string& nm); - -extern OCTINTERP_API octave_function * -load_fcn_from_file (const std::string& file_name, - const std::string& dir_name = std::string (), - const std::string& dispatch_type = std::string (), - const std::string& fcn_name = std::string (), - bool autoload = false); - -extern OCTINTERP_API void -source_file (const std::string& file_name, - const std::string& context = std::string (), - bool verbose = false, bool require_file = true, - const std::string& warn_for = std::string ()); - -extern OCTINTERP_API octave_value_list -feval (const std::string& name, - const octave_value_list& args = octave_value_list (), - int nargout = 0); - -extern OCTINTERP_API octave_value_list -feval (octave_function *fcn, - const octave_value_list& args = octave_value_list (), - int nargout = 0); - -extern OCTINTERP_API octave_value_list -feval (const octave_value_list& args, int nargout = 0); - -extern OCTINTERP_API octave_value_list -eval_string (const std::string&, bool silent, int& parse_status, int hargout); - -extern OCTINTERP_API octave_value -eval_string (const std::string&, bool silent, int& parse_status); - -extern OCTINTERP_API void cleanup_statement_list (tree_statement_list **lst); - -#endif diff -r d02b229ce693 -r a132d206a36a src/pr-output.cc --- a/src/pr-output.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4089 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include - -#include "Array-util.h" -#include "CMatrix.h" -#include "Range.h" -#include "cmd-edit.h" -#include "dMatrix.h" -#include "lo-mappers.h" -#include "lo-math.h" -#include "mach-info.h" -#include "oct-cmplx.h" -#include "quit.h" -#include "str-vec.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-stream.h" -#include "pager.h" -#include "pr-output.h" -#include "sysdep.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// TRUE means use a scaled fixed point format for `format long' and -// `format short'. -static bool Vfixed_point_format = false; - -// The maximum field width for a number printed by the default output -// routines. -static int Voutput_max_field_width = 10; - -// The precision of the numbers printed by the default output -// routines. -static int Voutput_precision = 5; - -// TRUE means that the dimensions of empty objects should be printed -// like this: x = [](2x0). -bool Vprint_empty_dimensions = true; - -// TRUE means that the rows of big matrices should be split into -// smaller slices that fit on the screen. -static bool Vsplit_long_rows = true; - -// TRUE means don't do any fancy formatting. -static bool free_format = false; - -// TRUE means print plus sign for nonzero, blank for zero. -static bool plus_format = false; - -// First char for > 0, second for < 0, third for == 0. -static std::string plus_format_chars = "+ "; - -// TRUE means always print in a rational approximation -static bool rat_format = false; - -// Used to force the length of the rational approximation string for Frats -static int rat_string_len = -1; - -// TRUE means always print like dollars and cents. -static bool bank_format = false; - -// TRUE means print data in hexadecimal format. -static int hex_format = 0; - -// TRUE means print data in binary-bit-pattern format. -static int bit_format = 0; - -// TRUE means don't put newlines around the column number headers. -bool Vcompact_format = false; - -// TRUE means use an e format. -static bool print_e = false; - -// TRUE means use a g format. -static bool print_g = false; - -// TRUE means print E instead of e for exponent field. -static bool print_big_e = false; - -// TRUE means use an engineering format. -static bool print_eng = false; - -class pr_engineering_float; -class pr_formatted_float; -class pr_rational_float; - -static int -current_output_max_field_width (void) -{ - return Voutput_max_field_width; -} - -static int -current_output_precision (void) -{ - return Voutput_precision; -} - -class -float_format -{ -public: - - float_format (int w = current_output_max_field_width (), - int p = current_output_precision (), int f = 0) - : fw (w), ex (0), prec (p), fmt (f), up (0), sp (0) { } - - float_format (int w, int e, int p, int f) - : fw (w), ex (e), prec (p), fmt (f), up (0), sp (0) { } - - float_format (const float_format& ff) - : fw (ff.fw), ex (ff.ex), prec (ff.prec), fmt (ff.fmt), up (ff.up), sp (ff.sp) { } - - float_format& operator = (const float_format& ff) - { - if (&ff != this) - { - fw = ff.fw; - ex = ff.ex; - prec = ff.prec; - fmt = ff.fmt; - up = ff.up; - sp = ff.sp; - } - - return *this; - } - - ~float_format (void) { } - - float_format& scientific (void) { fmt = std::ios::scientific; return *this; } - float_format& fixed (void) { fmt = std::ios::fixed; return *this; } - float_format& general (void) { fmt = 0; return *this; } - - float_format& uppercase (void) { up = std::ios::uppercase; return *this; } - float_format& lowercase (void) { up = 0; return *this; } - - float_format& precision (int p) { prec = p; return *this; } - - float_format& width (int w) { fw = w; return *this; } - - float_format& trailing_zeros (bool tz = true) - { sp = tz ? std::ios::showpoint : 0; return *this; } - - friend std::ostream& operator << (std::ostream& os, - const pr_engineering_float& pef); - - friend std::ostream& operator << (std::ostream& os, - const pr_formatted_float& pff); - - friend std::ostream& operator << (std::ostream& os, - const pr_rational_float& prf); - -private: - - // Field width. Zero means as wide as necessary. - int fw; - - // Exponent Field width. Zero means as wide as necessary. - int ex; - - // Precision. - int prec; - - // Format. - int fmt; - - // E or e. - int up; - - // Show trailing zeros. - int sp; -}; - -static int -calc_scale_exp (const int& x) -{ - if (! print_eng) - return x; - else - return x - 3*static_cast (x/3); - /* The expression above is equivalent to x - (x % 3). - * According to the ISO specification for C++ the modulo operator is - * compiler dependent if any of the arguments are negative. Since this - * function will need to work on negative arguments, and we want to avoid - * portability issues, we re-implement the modulo function to the desired - * behavior (truncation). There may be a gnulib replacement. - * - * ISO/IEC 14882:2003 : Programming languages -- C++. 5.6.4: ISO, IEC. 2003 . - * "the binary % operator yields the remainder from the division of the first - * expression by the second. .... If both operands are nonnegative then the - * remainder is nonnegative; if not, the sign of the remainder is - * implementation-defined". */ -} - -static int -engineering_exponent (const double& x) -{ - int ex = 0; - if (x != 0) - { - double absval = (x < 0.0 ? -x : x); - int logabsval = static_cast (gnulib::floor (log10 (absval))); - /* Avoid using modulo function with negative arguments for portability. - * See extended comment at calc_scale_exp */ - if (logabsval < 0.0) - ex = logabsval - 2 + ((-logabsval + 2) % 3); - else - ex = logabsval - (logabsval % 3); - } - return ex; -} - -static int -num_digits (const double& x) -{ - return 1 + (print_eng - ? engineering_exponent (x) - : static_cast (gnulib::floor (log10 (x)))); -} - -class -pr_engineering_float -{ -public: - - const float_format& f; - - double val; - - int exponent (void) const - { - return engineering_exponent (val); - } - - double mantissa (void) const - { - return val / std::pow (10.0, exponent ()); - } - - pr_engineering_float (const float_format& f_arg, double val_arg) - : f (f_arg), val (val_arg) { } -}; - -std::ostream& -operator << (std::ostream& os, const pr_engineering_float& pef) -{ - if (pef.f.fw >= 0) - os << std::setw (pef.f.fw - pef.f.ex); - - if (pef.f.prec >= 0) - os << std::setprecision (pef.f.prec); - - std::ios::fmtflags oflags = - os.flags (static_cast - (pef.f.fmt | pef.f.up | pef.f.sp)); - - os << pef.mantissa (); - - int ex = pef.exponent (); - if (ex < 0) - { - os << std::setw (0) << "e-"; - ex = -ex; - } - else - os << std::setw (0) << "e+"; - - os << std::setw (pef.f.ex - 2) << std::setfill ('0') << ex - << std::setfill (' '); - - os.flags (oflags); - - return os; -} - -class -pr_formatted_float -{ -public: - - const float_format& f; - - double val; - - pr_formatted_float (const float_format& f_arg, double val_arg) - : f (f_arg), val (val_arg) { } -}; - -std::ostream& -operator << (std::ostream& os, const pr_formatted_float& pff) -{ - if (pff.f.fw >= 0) - os << std::setw (pff.f.fw); - - if (pff.f.prec >= 0) - os << std::setprecision (pff.f.prec); - - std::ios::fmtflags oflags = - os.flags (static_cast - (pff.f.fmt | pff.f.up | pff.f.sp)); - - os << pff.val; - - os.flags (oflags); - - return os; -} - -static inline std::string -rational_approx (double val, int len) -{ - std::string s; - - if (len <= 0) - len = 10; - - if (xisinf (val)) - s = "1/0"; - else if (xisnan (val)) - s = "0/0"; - else if (val < INT_MIN || val > INT_MAX || D_NINT (val) == val) - { - std::ostringstream buf; - buf.flags (std::ios::fixed); - buf << std::setprecision (0) << xround (val); - s = buf.str (); - } - else - { - double lastn = 1.; - double lastd = 0.; - double n = xround (val); - double d = 1.; - double frac = val - n; - int m = 0; - - std::ostringstream buf2; - buf2.flags (std::ios::fixed); - buf2 << std::setprecision (0) << static_cast(n); - s = buf2.str (); - - while (1) - { - double flip = 1. / frac; - double step = xround (flip); - double nextn = n; - double nextd = d; - - // Have we converged to 1/intmax ? - if (m > 100 || fabs (frac) < 1 / static_cast(INT_MAX)) - { - lastn = n; - lastd = d; - break; - } - - frac = flip - step; - n = n * step + lastn; - d = d * step + lastd; - lastn = nextn; - lastd = nextd; - - std::ostringstream buf; - buf.flags (std::ios::fixed); - buf << std::setprecision (0) << static_cast(n) - << "/" << static_cast(d); - m++; - - if (n < 0 && d < 0) - { - // Double negative, string can be two characters longer.. - if (buf.str ().length () > static_cast(len + 2) && - m > 1) - break; - } - else if (buf.str ().length () > static_cast(len) && - m > 1) - break; - - s = buf.str (); - } - - if (lastd < 0.) - { - // Move sign to the top - lastd = - lastd; - lastn = - lastn; - std::ostringstream buf; - buf.flags (std::ios::fixed); - buf << std::setprecision (0) << static_cast(lastn) - << "/" << static_cast(lastd); - s = buf.str (); - } - } - - return s; -} - -class -pr_rational_float -{ -public: - - const float_format& f; - - double val; - - pr_rational_float (const float_format& f_arg, double val_arg) - : f (f_arg), val (val_arg) { } -}; - -std::ostream& -operator << (std::ostream& os, const pr_rational_float& prf) -{ - int fw = (rat_string_len > 0 ? rat_string_len : prf.f.fw); - std::string s = rational_approx (prf.val, fw); - - if (fw >= 0) - os << std::setw (fw); - - std::ios::fmtflags oflags = - os.flags (static_cast - (prf.f.fmt | prf.f.up | prf.f.sp)); - - if (fw > 0 && s.length () > static_cast(fw)) - os << "*"; - else - os << s; - - os.flags (oflags); - - return os; -} - -// Current format for real numbers and the real part of complex -// numbers. -static float_format *curr_real_fmt = 0; - -// Current format for the imaginary part of complex numbers. -static float_format *curr_imag_fmt = 0; - -static double -pr_max_internal (const Matrix& m) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - double result = -DBL_MAX; - - bool all_inf_or_nan = true; - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - double val = m(i,j); - if (xisinf (val) || xisnan (val)) - continue; - - all_inf_or_nan = false; - - if (val > result) - result = val; - } - - if (all_inf_or_nan) - result = 0.0; - - return result; -} - -static double -pr_min_internal (const Matrix& m) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - double result = DBL_MAX; - - bool all_inf_or_nan = true; - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - double val = m(i,j); - if (xisinf (val) || xisnan (val)) - continue; - - all_inf_or_nan = false; - - if (val < result) - result = val; - } - - if (all_inf_or_nan) - result = 0.0; - - return result; -} - -// FIXME -- it would be nice to share more code among these -// functions,.. - -static void -set_real_format (int digits, bool inf_or_nan, bool int_only, int &fw) -{ - static float_format fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - fw = 0; - rd = 0; - } - else if (bank_format) - { - fw = digits < 0 ? 4 : digits + 3; - if (inf_or_nan && fw < 4) - fw = 4; - rd = 2; - } - else if (hex_format) - { - fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - fw = 8 * sizeof (double); - rd = 0; - } - else if (inf_or_nan || int_only) - { - fw = 1 + digits; - if (inf_or_nan && fw < 4) - fw = 4; - rd = fw; - } - else - { - if (digits > 0) - { - ld = digits; - rd = prec > digits ? prec - digits : prec; - digits++; - } - else - { - ld = 1; - rd = prec > digits ? prec - digits : prec; - digits = -digits + 1; - } - - fw = 1 + ld + 1 + rd; - if (inf_or_nan && fw < 4) - fw = 4; - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (fw > Voutput_max_field_width || print_e || print_g || print_eng)) - { - if (print_g) - fmt = float_format (); - else - { - int ex = 4; - if (digits > 100) - ex++; - - if (print_eng) - { - fw = 4 + prec + ex; - if (inf_or_nan && fw < 6) - fw = 6; - fmt = float_format (fw, ex, prec - 1, std::ios::fixed); - } - else - { - fw = 2 + prec + ex; - if (inf_or_nan && fw < 4) - fw = 4; - fmt = float_format (fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - fmt.uppercase (); - } - else if (! bank_format && (inf_or_nan || int_only)) - fmt = float_format (fw, rd); - else - fmt = float_format (fw, rd, std::ios::fixed); - - curr_real_fmt = &fmt; -} - -static void -set_format (double d, int& fw) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - bool inf_or_nan = (xisinf (d) || xisnan (d)); - - bool int_only = (! inf_or_nan && D_NINT (d) == d); - - double d_abs = d < 0.0 ? -d : d; - - int digits = (inf_or_nan || d_abs == 0.0) - ? 0 : num_digits (d_abs); - - set_real_format (digits, inf_or_nan, int_only, fw); -} - -static inline void -set_format (double d) -{ - int fw; - set_format (d, fw); -} - -static void -set_real_matrix_format (int x_max, int x_min, bool inf_or_nan, - int int_or_inf_or_nan, int& fw) -{ - static float_format fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - fw = 9; - rd = 0; - } - else if (bank_format) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits <= 0 ? 4 : digits + 3; - if (inf_or_nan && fw < 4) - fw = 4; - rd = 2; - } - else if (hex_format) - { - fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - fw = 8 * sizeof (double); - rd = 0; - } - else if (Vfixed_point_format && ! print_g) - { - rd = prec; - fw = rd + 2; - if (inf_or_nan && fw < 4) - fw = 4; - } - else if (int_or_inf_or_nan) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits <= 0 ? 2 : digits + 1; - if (inf_or_nan && fw < 4) - fw = 4; - rd = fw; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - fw = 1 + ld + 1 + rd; - if (inf_or_nan && fw < 4) - fw = 4; - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (print_e - || print_eng || print_g - || (! Vfixed_point_format && fw > Voutput_max_field_width))) - { - if (print_g) - fmt = float_format (); - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - fw = 4 + prec + ex; - if (inf_or_nan && fw < 6) - fw = 6; - fmt = float_format (fw, ex, prec - 1, std::ios::fixed); - } - else - { - fw = 2 + prec + ex; - if (inf_or_nan && fw < 4) - fw = 4; - fmt = float_format (fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - fmt.uppercase (); - } - else if (! bank_format && int_or_inf_or_nan) - fmt = float_format (fw, rd); - else - fmt = float_format (fw, rd, std::ios::fixed); - - curr_real_fmt = &fmt; -} - -static void -set_format (const Matrix& m, int& fw, double& scale) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - bool inf_or_nan = m.any_element_is_inf_or_nan (); - - bool int_or_inf_or_nan = m.all_elements_are_int_or_inf_or_nan (); - - Matrix m_abs = m.abs (); - double max_abs = pr_max_internal (m_abs); - double min_abs = pr_min_internal (m_abs); - - int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); - - int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); - - scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 - : std::pow (10.0, calc_scale_exp (x_max - 1)); - - set_real_matrix_format (x_max, x_min, inf_or_nan, int_or_inf_or_nan, fw); -} - -static inline void -set_format (const Matrix& m) -{ - int fw; - double scale; - set_format (m, fw, scale); -} - -static void -set_complex_format (int x_max, int x_min, int r_x, bool inf_or_nan, - int int_only, int& r_fw, int& i_fw) -{ - static float_format r_fmt; - static float_format i_fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - i_fw = 0; - r_fw = 0; - rd = 0; - } - else if (bank_format) - { - int digits = r_x; - i_fw = 0; - r_fw = digits <= 0 ? 4 : digits + 3; - if (inf_or_nan && r_fw < 4) - r_fw = 4; - rd = 2; - } - else if (hex_format) - { - r_fw = 2 * sizeof (double); - i_fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - r_fw = 8 * sizeof (double); - i_fw = 8 * sizeof (double); - rd = 0; - } - else if (inf_or_nan || int_only) - { - int digits = x_max > x_min ? x_max : x_min; - i_fw = digits <= 0 ? 1 : digits; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - rd = r_fw; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - i_fw = ld + 1 + rd; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (r_fw > Voutput_max_field_width || print_e || print_eng || print_g)) - { - if (print_g) - { - r_fmt = float_format (); - i_fmt = float_format (); - } - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - i_fw = 3 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 5) - { - i_fw = 5; - r_fw = 6; - } - r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); - i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); - } - else - { - i_fw = 1 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); - i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - { - r_fmt.uppercase (); - i_fmt.uppercase (); - } - } - else if (! bank_format && (inf_or_nan || int_only)) - { - r_fmt = float_format (r_fw, rd); - i_fmt = float_format (i_fw, rd); - } - else - { - r_fmt = float_format (r_fw, rd, std::ios::fixed); - i_fmt = float_format (i_fw, rd, std::ios::fixed); - } - - curr_real_fmt = &r_fmt; - curr_imag_fmt = &i_fmt; -} - -static void -set_format (const Complex& c, int& r_fw, int& i_fw) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - double rp = c.real (); - double ip = c.imag (); - - bool inf_or_nan = (xisinf (c) || xisnan (c)); - - bool int_only = (D_NINT (rp) == rp && D_NINT (ip) == ip); - - double r_abs = rp < 0.0 ? -rp : rp; - double i_abs = ip < 0.0 ? -ip : ip; - - int r_x = (xisinf (rp) || xisnan (rp) || r_abs == 0.0) - ? 0 : num_digits (r_abs); - - int i_x = (xisinf (ip) || xisnan (ip) || i_abs == 0.0) - ? 0 : num_digits (i_abs); - - int x_max, x_min; - - if (r_x > i_x) - { - x_max = r_x; - x_min = i_x; - } - else - { - x_max = i_x; - x_min = r_x; - } - - set_complex_format (x_max, x_min, r_x, inf_or_nan, int_only, r_fw, i_fw); -} - -static inline void -set_format (const Complex& c) -{ - int r_fw, i_fw; - set_format (c, r_fw, i_fw); -} - -static void -set_complex_matrix_format (int x_max, int x_min, int r_x_max, - int r_x_min, bool inf_or_nan, - int int_or_inf_or_nan, int& r_fw, int& i_fw) -{ - static float_format r_fmt; - static float_format i_fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - i_fw = 9; - r_fw = 9; - rd = 0; - } - else if (bank_format) - { - int digits = r_x_max > r_x_min ? r_x_max : r_x_min; - i_fw = 0; - r_fw = digits <= 0 ? 4 : digits + 3; - if (inf_or_nan && r_fw < 4) - r_fw = 4; - rd = 2; - } - else if (hex_format) - { - r_fw = 2 * sizeof (double); - i_fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - r_fw = 8 * sizeof (double); - i_fw = 8 * sizeof (double); - rd = 0; - } - else if (Vfixed_point_format && ! print_g) - { - rd = prec; - i_fw = rd + 1; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - } - else if (int_or_inf_or_nan) - { - int digits = x_max > x_min ? x_max : x_min; - i_fw = digits <= 0 ? 1 : digits; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - rd = r_fw; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - i_fw = ld + 1 + rd; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (print_e - || print_eng || print_g - || (! Vfixed_point_format && r_fw > Voutput_max_field_width))) - { - if (print_g) - { - r_fmt = float_format (); - i_fmt = float_format (); - } - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - i_fw = 3 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 5) - { - i_fw = 5; - r_fw = 6; - } - r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); - i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); - } - else - { - i_fw = 1 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); - i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - { - r_fmt.uppercase (); - i_fmt.uppercase (); - } - } - else if (! bank_format && int_or_inf_or_nan) - { - r_fmt = float_format (r_fw, rd); - i_fmt = float_format (i_fw, rd); - } - else - { - r_fmt = float_format (r_fw, rd, std::ios::fixed); - i_fmt = float_format (i_fw, rd, std::ios::fixed); - } - - curr_real_fmt = &r_fmt; - curr_imag_fmt = &i_fmt; -} - -static void -set_format (const ComplexMatrix& cm, int& r_fw, int& i_fw, double& scale) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - Matrix rp = real (cm); - Matrix ip = imag (cm); - - bool inf_or_nan = cm.any_element_is_inf_or_nan (); - - bool int_or_inf_or_nan = (rp.all_elements_are_int_or_inf_or_nan () - && ip.all_elements_are_int_or_inf_or_nan ()); - - Matrix r_m_abs = rp.abs (); - double r_max_abs = pr_max_internal (r_m_abs); - double r_min_abs = pr_min_internal (r_m_abs); - - Matrix i_m_abs = ip.abs (); - double i_max_abs = pr_max_internal (i_m_abs); - double i_min_abs = pr_min_internal (i_m_abs); - - int r_x_max = r_max_abs == 0.0 ? 0 : num_digits (r_max_abs); - - int r_x_min = r_min_abs == 0.0 ? 0 : num_digits (r_min_abs); - - int i_x_max = i_max_abs == 0.0 ? 0 : num_digits (i_max_abs); - - int i_x_min = i_min_abs == 0.0 ? 0 : num_digits (i_min_abs); - - int x_max = r_x_max > i_x_max ? r_x_max : i_x_max; - int x_min = r_x_min > i_x_min ? r_x_min : i_x_min; - - scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 - : std::pow (10.0, calc_scale_exp (x_max - 1)); - - set_complex_matrix_format (x_max, x_min, r_x_max, r_x_min, inf_or_nan, - int_or_inf_or_nan, r_fw, i_fw); -} - -static inline void -set_format (const ComplexMatrix& cm) -{ - int r_fw, i_fw; - double scale; - set_format (cm, r_fw, i_fw, scale); -} - -static void -set_range_format (int x_max, int x_min, int all_ints, int& fw) -{ - static float_format fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - fw = 9; - rd = 0; - } - else if (bank_format) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits < 0 ? 5 : digits + 4; - rd = 2; - } - else if (hex_format) - { - fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - fw = 8 * sizeof (double); - rd = 0; - } - else if (all_ints) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits + 1; - rd = fw; - } - else if (Vfixed_point_format && ! print_g) - { - rd = prec; - fw = rd + 3; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - fw = ld + rd + 3; - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (print_e - || print_eng || print_g - || (! Vfixed_point_format && fw > Voutput_max_field_width))) - { - if (print_g) - fmt = float_format (); - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - fw = 5 + prec + ex; - fmt = float_format (fw, ex, prec - 1, std::ios::fixed); - } - else - { - fw = 3 + prec + ex; - fmt = float_format (fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - fmt.uppercase (); - } - else if (! bank_format && all_ints) - fmt = float_format (fw, rd); - else - fmt = float_format (fw, rd, std::ios::fixed); - - curr_real_fmt = &fmt; -} - -static void -set_format (const Range& r, int& fw, double& scale) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - double r_min = r.base (); - double r_max = r.limit (); - - if (r_max < r_min) - { - double tmp = r_max; - r_max = r_min; - r_min = tmp; - } - - bool all_ints = r.all_elements_are_ints (); - - double max_abs = r_max < 0.0 ? -r_max : r_max; - double min_abs = r_min < 0.0 ? -r_min : r_min; - - int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); - - int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); - - scale = (x_max == 0 || all_ints) ? 1.0 - : std::pow (10.0, calc_scale_exp (x_max - 1)); - - set_range_format (x_max, x_min, all_ints, fw); -} - -static inline void -set_format (const Range& r) -{ - int fw; - double scale; - set_format (r, fw, scale); -} - -union equiv -{ - double d; - unsigned char i[sizeof (double)]; -}; - -#define PRINT_CHAR_BITS(os, c) \ - do \ - { \ - unsigned char ctmp = c; \ - char stmp[9]; \ - stmp[0] = (ctmp & 0x80) ? '1' : '0'; \ - stmp[1] = (ctmp & 0x40) ? '1' : '0'; \ - stmp[2] = (ctmp & 0x20) ? '1' : '0'; \ - stmp[3] = (ctmp & 0x10) ? '1' : '0'; \ - stmp[4] = (ctmp & 0x08) ? '1' : '0'; \ - stmp[5] = (ctmp & 0x04) ? '1' : '0'; \ - stmp[6] = (ctmp & 0x02) ? '1' : '0'; \ - stmp[7] = (ctmp & 0x01) ? '1' : '0'; \ - stmp[8] = '\0'; \ - os << stmp; \ - } \ - while (0) - -#define PRINT_CHAR_BITS_SWAPPED(os, c) \ - do \ - { \ - unsigned char ctmp = c; \ - char stmp[9]; \ - stmp[0] = (ctmp & 0x01) ? '1' : '0'; \ - stmp[1] = (ctmp & 0x02) ? '1' : '0'; \ - stmp[2] = (ctmp & 0x04) ? '1' : '0'; \ - stmp[3] = (ctmp & 0x08) ? '1' : '0'; \ - stmp[4] = (ctmp & 0x10) ? '1' : '0'; \ - stmp[5] = (ctmp & 0x20) ? '1' : '0'; \ - stmp[6] = (ctmp & 0x40) ? '1' : '0'; \ - stmp[7] = (ctmp & 0x80) ? '1' : '0'; \ - stmp[8] = '\0'; \ - os << stmp; \ - } \ - while (0) - -static void -pr_any_float (const float_format *fmt, std::ostream& os, double d, int fw = 0) -{ - if (fmt) - { - // Unless explicitly asked for, always print in big-endian - // format for hex and bit formats. - // - // {bit,hex}_format == 1: print big-endian - // {bit,hex}_format == 2: print native - - if (hex_format) - { - equiv tmp; - tmp.d = d; - - // Unless explicitly asked for, always print in big-endian - // format. - - // FIXME -- is it correct to swap bytes for VAX - // formats and not for Cray? - - // FIXME -- will bad things happen if we are - // interrupted before resetting the format flags and fill - // character? - - oct_mach_info::float_format flt_fmt = - oct_mach_info::native_float_format (); - - char ofill = os.fill ('0'); - - std::ios::fmtflags oflags - = os.flags (std::ios::right | std::ios::hex); - - if (hex_format > 1 - || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian - || flt_fmt == oct_mach_info::flt_fmt_cray - || flt_fmt == oct_mach_info::flt_fmt_unknown) - { - for (size_t i = 0; i < sizeof (double); i++) - os << std::setw (2) << static_cast (tmp.i[i]); - } - else - { - for (int i = sizeof (double) - 1; i >= 0; i--) - os << std::setw (2) << static_cast (tmp.i[i]); - } - - os.fill (ofill); - os.setf (oflags); - } - else if (bit_format) - { - equiv tmp; - tmp.d = d; - - // FIXME -- is it correct to swap bytes for VAX - // formats and not for Cray? - - oct_mach_info::float_format flt_fmt = - oct_mach_info::native_float_format (); - - if (flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian - || flt_fmt == oct_mach_info::flt_fmt_cray - || flt_fmt == oct_mach_info::flt_fmt_unknown) - { - for (size_t i = 0; i < sizeof (double); i++) - PRINT_CHAR_BITS (os, tmp.i[i]); - } - else - { - if (bit_format > 1) - { - for (size_t i = 0; i < sizeof (double); i++) - PRINT_CHAR_BITS_SWAPPED (os, tmp.i[i]); - } - else - { - for (int i = sizeof (double) - 1; i >= 0; i--) - PRINT_CHAR_BITS (os, tmp.i[i]); - } - } - } - else if (octave_is_NA (d)) - { - if (fw > 0) - os << std::setw (fw) << "NA"; - else - os << "NA"; - } - else if (rat_format) - os << pr_rational_float (*fmt, d); - else if (xisinf (d)) - { - const char *s; - if (d < 0.0) - s = "-Inf"; - else - s = "Inf"; - - if (fw > 0) - os << std::setw (fw) << s; - else - os << s; - } - else if (xisnan (d)) - { - if (fw > 0) - os << std::setw (fw) << "NaN"; - else - os << "NaN"; - } - else if (print_eng) - os << pr_engineering_float (*fmt, d); - else - os << pr_formatted_float (*fmt, d); - } - else - os << d; -} - -static inline void -pr_float (std::ostream& os, double d, int fw = 0, double scale = 1.0) -{ - if (Vfixed_point_format && ! print_g && scale != 1.0) - d /= scale; - - pr_any_float (curr_real_fmt, os, d, fw); -} - -static inline void -pr_imag_float (std::ostream& os, double d, int fw = 0) -{ - pr_any_float (curr_imag_fmt, os, d, fw); -} - -static void -pr_complex (std::ostream& os, const Complex& c, int r_fw = 0, - int i_fw = 0, double scale = 1.0) -{ - Complex tmp - = (Vfixed_point_format && ! print_g && scale != 1.0) ? c / scale : c; - - double r = tmp.real (); - - pr_float (os, r, r_fw); - - if (! bank_format) - { - double i = tmp.imag (); - if (! (hex_format || bit_format) && lo_ieee_signbit (i)) - { - os << " - "; - i = -i; - pr_imag_float (os, i, i_fw); - } - else - { - if (hex_format || bit_format) - os << " "; - else - os << " + "; - - pr_imag_float (os, i, i_fw); - } - os << "i"; - } -} - -static void -print_empty_matrix (std::ostream& os, octave_idx_type nr, octave_idx_type nc, bool pr_as_read_syntax) -{ - assert (nr == 0 || nc == 0); - - if (pr_as_read_syntax) - { - if (nr == 0 && nc == 0) - os << "[]"; - else - os << "zeros (" << nr << ", " << nc << ")"; - } - else - { - os << "[]"; - - if (Vprint_empty_dimensions) - os << "(" << nr << "x" << nc << ")"; - } -} - -static void -print_empty_nd_array (std::ostream& os, const dim_vector& dims, - bool pr_as_read_syntax) -{ - assert (dims.any_zero ()); - - if (pr_as_read_syntax) - os << "zeros (" << dims.str (',') << ")"; - else - { - os << "[]"; - - if (Vprint_empty_dimensions) - os << "(" << dims.str () << ")"; - } -} - -static void -pr_scale_header (std::ostream& os, double scale) -{ - if (Vfixed_point_format && ! print_g && scale != 1.0) - { - os << " " - << std::setw (8) << std::setprecision (1) - << std::setiosflags (std::ios::scientific|std::ios::left) - << scale - << std::resetiosflags (std::ios::scientific|std::ios::left) - << " *\n"; - - if (! Vcompact_format) - os << "\n"; - } -} - -static void -pr_col_num_header (std::ostream& os, octave_idx_type total_width, int max_width, - octave_idx_type lim, octave_idx_type col, int extra_indent) -{ - if (total_width > max_width && Vsplit_long_rows) - { - if (col != 0) - { - if (Vcompact_format) - os << "\n"; - else - os << "\n\n"; - } - - octave_idx_type num_cols = lim - col; - - os << std::setw (extra_indent) << ""; - - if (num_cols == 1) - os << " Column " << col + 1 << ":\n"; - else if (num_cols == 2) - os << " Columns " << col + 1 << " and " << lim << ":\n"; - else - os << " Columns " << col + 1 << " through " << lim << ":\n"; - - if (! Vcompact_format) - os << "\n"; - } -} - -template -/* static */ inline void -pr_plus_format (std::ostream& os, const T& val) -{ - if (val > T (0)) - os << plus_format_chars[0]; - else if (val < T (0)) - os << plus_format_chars[1]; - else - os << plus_format_chars[2]; -} - -void -octave_print_internal (std::ostream& os, double d, - bool /* pr_as_read_syntax */) -{ - if (plus_format) - { - pr_plus_format (os, d); - } - else - { - set_format (d); - if (free_format) - os << d; - else - pr_float (os, d); - } -} - -void -octave_print_internal (std::ostream& os, const Matrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, m(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int fw; - double scale = 1.0; - set_format (m, fw, scale); - int column_width = fw + 2; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << m; - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (i == 0 && j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_float (os, m(i,j)); - } - - col += inc; - - if (col >= nc) - { - if (i == nr - 1) - os << " ]"; - else - os << ";\n"; - } - else - os << " ...\n"; - } - } - } - else - { - pr_scale_header (os, scale); - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - pr_float (os, m(i,j), fw, scale); - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const DiagMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, m(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int fw; - double scale = 1.0; - set_format (Matrix (m.diag ()), fw, scale); - int column_width = fw + 2; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << Matrix (m); - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - os << "diag ("; - - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_float (os, m(j,j)); - } - - col += inc; - - if (col >= nc) - os << " ]"; - else - os << " ...\n"; - } - os << ")"; - } - else - { - os << "Diagonal Matrix\n"; - if (! Vcompact_format) - os << "\n"; - - pr_scale_header (os, scale); - - // kluge. Get the true width of a number. - int zero_fw; - - { - std::ostringstream tmp_oss; - pr_float (tmp_oss, 0.0, fw, scale); - zero_fw = tmp_oss.str ().length (); - } - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - if (i == j) - pr_float (os, m(i,j), fw, scale); - else - os << std::setw (zero_fw) << '0'; - - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -template -void print_nd_array (std::ostream& os, const NDA_T& nda, - bool pr_as_read_syntax) -{ - - if (nda.is_empty ()) - print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); - else - { - - int ndims = nda.ndims (); - - dim_vector dims = nda.dims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - for (octave_idx_type i = 0; i < m; i++) - { - octave_quit (); - - std::string nm = "ans"; - - if (m > 1) - { - nm += "(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - octave_value page - = MAT_T (Array (nda.index (idx), dim_vector (nr, nc))); - - if (i != m - 1) - { - page.print_with_name (os, nm); - } - else - { - page.print_name_tag (os, nm); - page.print_raw (os); - } - - if (i < m) - NDA_T::increment_index (ra_idx, dims, 2); - } - } -} - -void -octave_print_internal (std::ostream& os, const NDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -template <> -/* static */ inline void -pr_plus_format<> (std::ostream& os, const Complex& c) -{ - double rp = c.real (); - double ip = c.imag (); - - if (rp == 0.0) - { - if (ip == 0.0) - os << " "; - else - os << "i"; - } - else if (ip == 0.0) - pr_plus_format (os, rp); - else - os << "c"; -} - -void -octave_print_internal (std::ostream& os, const Complex& c, - bool /* pr_as_read_syntax */) -{ - if (plus_format) - { - pr_plus_format (os, c); - } - else - { - set_format (c); - if (free_format) - os << c; - else - pr_complex (os, c); - } -} - -void -octave_print_internal (std::ostream& os, const ComplexMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = cm.rows (); - octave_idx_type nc = cm.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, cm(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int r_fw, i_fw; - double scale = 1.0; - set_format (cm, r_fw, i_fw, scale); - int column_width = i_fw + r_fw; - column_width += (rat_format || bank_format || hex_format - || bit_format) ? 2 : 7; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << cm; - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (i == 0 && j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_complex (os, cm(i,j)); - } - - col += inc; - - if (col >= nc) - { - if (i == nr - 1) - os << " ]"; - else - os << ";\n"; - } - else - os << " ...\n"; - } - } - } - else - { - pr_scale_header (os, scale); - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - pr_complex (os, cm(i,j), r_fw, i_fw, scale); - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = cm.rows (); - octave_idx_type nc = cm.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, cm(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int r_fw, i_fw; - double scale = 1.0; - set_format (ComplexMatrix (cm.diag ()), r_fw, i_fw, scale); - int column_width = i_fw + r_fw; - column_width += (rat_format || bank_format || hex_format - || bit_format) ? 2 : 7; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << ComplexMatrix (cm); - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - os << "diag ("; - - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_complex (os, cm(j,j)); - } - - col += inc; - - if (col >= nc) - os << " ]"; - else - os << " ...\n"; - } - os << ")"; - } - else - { - os << "Diagonal Matrix\n"; - if (! Vcompact_format) - os << "\n"; - - pr_scale_header (os, scale); - - // kluge. Get the true width of a number. - int zero_fw; - - { - std::ostringstream tmp_oss; - pr_complex (tmp_oss, Complex (0.0), r_fw, i_fw, scale); - zero_fw = tmp_oss.str ().length (); - } - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - if (i == j) - pr_complex (os, cm(i,j), r_fw, i_fw, scale); - else - os << std::setw (zero_fw) << '0'; - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const PermMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, m(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int fw = 2; - int column_width = fw + 2; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << Matrix (m); - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - Array pvec = m.pvec (); - bool colp = m.is_col_perm (); - - os << "eye ("; - if (colp) os << ":, "; - - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - os << pvec (j); - } - - col += inc; - - if (col >= nc) - os << " ]"; - else - os << " ...\n"; - } - if (! colp) os << ", :"; - os << ")"; - } - else - { - os << "Permutation Matrix\n"; - if (! Vcompact_format) - os << "\n"; - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - os << std::setw (fw) << m(i,j); - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const ComplexNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -void -octave_print_internal (std::ostream& os, bool d, bool pr_as_read_syntax) -{ - octave_print_internal (os, double (d), pr_as_read_syntax); -} - -// FIXME -- write single precision versions of the printing functions. - -void -octave_print_internal (std::ostream& os, float d, bool pr_as_read_syntax) -{ - octave_print_internal (os, double (d), pr_as_read_syntax); -} - -void -octave_print_internal (std::ostream& os, const FloatMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, Matrix (m), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, DiagMatrix (m), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, NDArray (nda), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatComplex& c, - bool pr_as_read_syntax) -{ - octave_print_internal (os, Complex (c), pr_as_read_syntax); -} - -void -octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, ComplexMatrix (cm), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, ComplexDiagMatrix (cm), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, ComplexNDArray (nda), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const Range& r, - bool pr_as_read_syntax, int extra_indent) -{ - double base = r.base (); - double increment = r.inc (); - double limit = r.limit (); - octave_idx_type num_elem = r.nelem (); - - if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < num_elem; i++) - { - octave_quit (); - - double val = base + i * increment; - - pr_plus_format (os, val); - } - } - else - { - int fw = 0; - double scale = 1.0; - set_format (r, fw, scale); - - if (pr_as_read_syntax) - { - if (free_format) - { - os << base << " : "; - if (increment != 1.0) - os << increment << " : "; - os << limit; - } - else - { - pr_float (os, base, fw); - os << " : "; - if (increment != 1.0) - { - pr_float (os, increment, fw); - os << " : "; - } - pr_float (os, limit, fw); - } - } - else - { - int column_width = fw + 2; - octave_idx_type total_width = num_elem * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (free_format) - { - os << r; - return; - } - - octave_idx_type inc = num_elem; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - pr_scale_header (os, scale); - - octave_idx_type col = 0; - while (col < num_elem) - { - octave_idx_type lim = col + inc < num_elem ? col + inc : num_elem; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - os << std::setw (extra_indent) << ""; - - for (octave_idx_type i = col; i < lim; i++) - { - octave_quit (); - - double val = base + i * increment; - - if (i == num_elem - 1) - { - // See the comments in Range::matrix_value. - - if ((increment > 0 && val > limit) - || (increment < 0 && val < limit)) - val = limit; - } - - os << " "; - - pr_float (os, val, fw, scale); - } - - col += inc; - } - } - } -} - -void -octave_print_internal (std::ostream& os, const boolMatrix& bm, - bool pr_as_read_syntax, - int extra_indent) -{ - Matrix tmp (bm); - octave_print_internal (os, tmp, pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const boolNDArray& nda, - bool pr_as_read_syntax, - int extra_indent) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -void -octave_print_internal (std::ostream& os, const charMatrix& chm, - bool pr_as_read_syntax, - int /* extra_indent FIXME */, - bool pr_as_string) -{ - if (pr_as_string) - { - octave_idx_type nstr = chm.rows (); - - if (pr_as_read_syntax && nstr > 1) - os << "[ "; - - if (nstr != 0) - { - for (octave_idx_type i = 0; i < nstr; i++) - { - octave_quit (); - - std::string row = chm.row_as_string (i); - - if (pr_as_read_syntax) - { - os << "\"" << undo_string_escapes (row) << "\""; - - if (i < nstr - 1) - os << "; "; - } - else - { - os << row; - - if (i < nstr - 1) - os << "\n"; - } - } - } - - if (pr_as_read_syntax && nstr > 1) - os << " ]"; - } - else - { - os << "sorry, printing char matrices not implemented yet\n"; - } -} - -void -octave_print_internal (std::ostream& os, const charNDArray& nda, - bool pr_as_read_syntax, int extra_indent, - bool pr_as_string) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent, pr_as_string); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -void -octave_print_internal (std::ostream& os, const std::string& s, - bool pr_as_read_syntax, int extra_indent) -{ - Array nda (dim_vector (1, 1), s); - - octave_print_internal (os, nda, pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const Array& nda, - bool pr_as_read_syntax, int /* extra_indent */) -{ - // FIXME -- this mostly duplicates the code in the print_nd_array<> - // function. Can fix this with std::is_same from C++11. - - if (nda.is_empty ()) - print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); - else if (nda.length () == 1) - { - os << nda(0); - } - else - { - int ndims = nda.ndims (); - - dim_vector dims = nda.dims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - for (octave_idx_type i = 0; i < m; i++) - { - std::string nm = "ans"; - - if (m > 1) - { - nm += "(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - Array page (nda.index (idx), dim_vector (nr, nc)); - - // FIXME -- need to do some more work to put these - // in neatly aligned columns... - - octave_idx_type n_rows = page.rows (); - octave_idx_type n_cols = page.cols (); - - os << nm << " =\n"; - if (! Vcompact_format) - os << "\n"; - - for (octave_idx_type ii = 0; ii < n_rows; ii++) - { - for (octave_idx_type jj = 0; jj < n_cols; jj++) - os << " " << page(ii,jj); - - os << "\n"; - } - - if (i < m - 1) - os << "\n"; - - if (i < m) - increment_index (ra_idx, dims, 2); - } - } -} - -template -class -octave_print_conv -{ -public: - typedef T print_conv_type; -}; - -#define PRINT_CONV(T1, T2) \ - template <> \ - class \ - octave_print_conv \ - { \ - public: \ - typedef T2 print_conv_type; \ - } - -PRINT_CONV (octave_int8, octave_int16); -PRINT_CONV (octave_uint8, octave_uint16); - -#undef PRINT_CONV - -template -/* static */ inline void -pr_int (std::ostream& os, const T& d, int fw = 0) -{ - size_t sz = d.byte_size (); - const unsigned char * tmpi = d.iptr (); - - // Unless explicitly asked for, always print in big-endian - // format for hex and bit formats. - // - // {bit,hex}_format == 1: print big-endian - // {bit,hex}_format == 2: print native - - if (hex_format) - { - char ofill = os.fill ('0'); - - std::ios::fmtflags oflags - = os.flags (std::ios::right | std::ios::hex); - - if (hex_format > 1 || oct_mach_info::words_big_endian ()) - { - for (size_t i = 0; i < sz; i++) - os << std::setw (2) << static_cast (tmpi[i]); - } - else - { - for (int i = sz - 1; i >= 0; i--) - os << std::setw (2) << static_cast (tmpi[i]); - } - - os.fill (ofill); - os.setf (oflags); - } - else if (bit_format) - { - if (oct_mach_info::words_big_endian ()) - { - for (size_t i = 0; i < sz; i++) - PRINT_CHAR_BITS (os, tmpi[i]); - } - else - { - if (bit_format > 1) - { - for (size_t i = 0; i < sz; i++) - PRINT_CHAR_BITS_SWAPPED (os, tmpi[i]); - } - else - { - for (int i = sz - 1; i >= 0; i--) - PRINT_CHAR_BITS (os, tmpi[i]); - } - } - } - else - { - os << std::setw (fw) - << typename octave_print_conv::print_conv_type (d); - - if (bank_format) - os << ".00"; - } -} - -// FIXME -- all this mess with abs is an attempt to avoid seeing -// -// warning: comparison of unsigned expression < 0 is always false -// -// from GCC. Isn't there a better way - -template -/* static */ inline T -abs (T x) -{ - return x < 0 ? -x : x; -} - -#define INSTANTIATE_ABS(T) \ - template /* static */ T abs (T) - -INSTANTIATE_ABS(signed char); -INSTANTIATE_ABS(short); -INSTANTIATE_ABS(int); -INSTANTIATE_ABS(long); -INSTANTIATE_ABS(long long); - -#define SPECIALIZE_UABS(T) \ - template <> \ - /* static */ inline unsigned T \ - abs (unsigned T x) \ - { \ - return x; \ - } - -SPECIALIZE_UABS(char) -SPECIALIZE_UABS(short) -SPECIALIZE_UABS(int) -SPECIALIZE_UABS(long) -SPECIALIZE_UABS(long long) - -template void -pr_int (std::ostream&, const octave_int8&, int); - -template void -pr_int (std::ostream&, const octave_int16&, int); - -template void -pr_int (std::ostream&, const octave_int32&, int); - -template void -pr_int (std::ostream&, const octave_int64&, int); - -template void -pr_int (std::ostream&, const octave_uint8&, int); - -template void -pr_int (std::ostream&, const octave_uint16&, int); - -template void -pr_int (std::ostream&, const octave_uint32&, int); - -template void -pr_int (std::ostream&, const octave_uint64&, int); - -template -void -octave_print_internal_template (std::ostream& os, const octave_int& val, - bool) -{ - if (plus_format) - { - pr_plus_format (os, val); - } - else - { - if (free_format) - os << typename octave_print_conv >::print_conv_type (val); - else - pr_int (os, val); - } -} - -#define PRINT_INT_SCALAR_INTERNAL(TYPE) \ - OCTINTERP_API void \ - octave_print_internal (std::ostream& os, const octave_int& val, bool dummy) \ - { \ - octave_print_internal_template (os, val, dummy); \ - } - -PRINT_INT_SCALAR_INTERNAL (int8_t) -PRINT_INT_SCALAR_INTERNAL (uint8_t) -PRINT_INT_SCALAR_INTERNAL (int16_t) -PRINT_INT_SCALAR_INTERNAL (uint16_t) -PRINT_INT_SCALAR_INTERNAL (int32_t) -PRINT_INT_SCALAR_INTERNAL (uint32_t) -PRINT_INT_SCALAR_INTERNAL (int64_t) -PRINT_INT_SCALAR_INTERNAL (uint64_t) - -template -/* static */ inline void -octave_print_internal_template (std::ostream& os, const intNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - // FIXME -- this mostly duplicates the code in the print_nd_array<> - // function. Can fix this with std::is_same from C++11. - - if (nda.is_empty ()) - print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); - else if (nda.length () == 1) - octave_print_internal_template (os, nda(0), pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - int ndims = nda.ndims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - dim_vector dims = nda.dims (); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - for (octave_idx_type i = 0; i < m; i++) - { - if (m > 1) - { - std::string nm = "ans(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - - os << nm << " =\n"; - if (! Vcompact_format) - os << "\n"; - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - Array page (nda.index (idx), dim_vector (nr, nc)); - - for (octave_idx_type ii = 0; ii < nr; ii++) - { - for (octave_idx_type jj = 0; jj < nc; jj++) - { - octave_quit (); - - pr_plus_format (os, page(ii,jj)); - } - - if ((ii < nr - 1) || (i < m -1)) - os << "\n"; - } - - if (i < m - 1) - { - os << "\n"; - increment_index (ra_idx, dims, 2); - } - } - } - else - { - int ndims = nda.ndims (); - - dim_vector dims = nda.dims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - int fw = 0; - if (hex_format) - fw = 2 * nda(0).byte_size (); - else if (bit_format) - fw = nda(0).nbits (); - else - { - bool isneg = false; - int digits = 0; - - for (octave_idx_type i = 0; i < dims.numel (); i++) - { - int new_digits = static_cast - (gnulib::floor (log10 (double (abs (nda(i).value ()))) + 1.0)); - - if (new_digits > digits) - digits = new_digits; - - if (! isneg) - isneg = (abs (nda(i).value ()) != nda(i).value ()); - } - - fw = digits + isneg; - } - - int column_width = fw + (rat_format ? 0 : (bank_format ? 5 : 2)); - octave_idx_type total_width = nc * column_width; - int max_width = command_editor::terminal_cols () - extra_indent; - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - for (octave_idx_type i = 0; i < m; i++) - { - if (m > 1) - { - std::string nm = "ans(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - - os << nm << " =\n"; - if (! Vcompact_format) - os << "\n"; - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - Array page (nda.index (idx), dim_vector (nr, nc)); - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - for (octave_idx_type ii = 0; ii < nr; ii++) - { - for (octave_idx_type jj = 0; jj < nc; jj++) - { - octave_quit (); - os << " "; - os << typename octave_print_conv::print_conv_type (page(ii,jj)); - } - os << "\n"; - } - - if (pr_as_read_syntax) - os << "]"; - } - else - { - octave_idx_type n_rows = page.rows (); - octave_idx_type n_cols = page.cols (); - - for (octave_idx_type col = 0; col < n_cols; col += inc) - { - octave_idx_type lim = col + inc < n_cols ? col + inc : n_cols; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type ii = 0; ii < n_rows; ii++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type jj = col; jj < lim; jj++) - { - octave_quit (); - os << " "; - pr_int (os, page(ii,jj), fw); - } - if ((ii < n_rows - 1) || (i < m -1)) - os << "\n"; - } - } - } - - if (i < m - 1) - { - os << "\n"; - increment_index (ra_idx, dims, 2); - } - } - } -} - -#define PRINT_INT_ARRAY_INTERNAL(TYPE) \ - OCTINTERP_API void \ - octave_print_internal (std::ostream& os, const intNDArray& nda, \ - bool pr_as_read_syntax, int extra_indent) \ - { \ - octave_print_internal_template (os, nda, pr_as_read_syntax, extra_indent); \ - } - -PRINT_INT_ARRAY_INTERNAL (octave_int8) -PRINT_INT_ARRAY_INTERNAL (octave_uint8) -PRINT_INT_ARRAY_INTERNAL (octave_int16) -PRINT_INT_ARRAY_INTERNAL (octave_uint16) -PRINT_INT_ARRAY_INTERNAL (octave_int32) -PRINT_INT_ARRAY_INTERNAL (octave_uint32) -PRINT_INT_ARRAY_INTERNAL (octave_int64) -PRINT_INT_ARRAY_INTERNAL (octave_uint64) - -void -octave_print_internal (std::ostream&, const Cell&, bool, int, bool) -{ - panic_impossible (); -} - -DEFUN (rats, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rats (@var{x}, @var{len})\n\ -Convert @var{x} into a rational approximation represented as a string.\n\ -You can convert the string back into a matrix as follows:\n\ -\n\ -@example\n\ -@group\n\ -r = rats (hilb (4));\n\ -x = str2num (r)\n\ -@end group\n\ -@end example\n\ -\n\ -The optional second argument defines the maximum length of the string\n\ -representing the elements of @var{x}. By default @var{len} is 9.\n\ -@seealso{format, rat}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 2 || nargout > 1) - print_usage (); - else - { - unwind_protect frame; - - frame.protect_var (rat_string_len); - - rat_string_len = 9; - - if (nargin == 2) - rat_string_len = args(1).nint_value (); - - if (! error_state) - { - octave_value arg = args(0); - - if (arg.is_numeric_type ()) - { - frame.protect_var (rat_format); - - rat_format = true; - - std::ostringstream buf; - args(0).print (buf); - std::string s = buf.str (); - - std::list lst; - - size_t n = 0; - size_t s_len = s.length (); - - while (n < s_len) - { - size_t m = s.find ('\n', n); - - if (m == std::string::npos) - { - lst.push_back (s.substr (n)); - break; - } - else - { - lst.push_back (s.substr (n, m - n)); - n = m + 1; - } - } - - retval = string_vector (lst); - } - else - error ("rats: X must be numeric"); - } - } - - return retval; -} - -DEFUN (disp, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} disp (@var{x})\n\ -Display the value of @var{x}. For example:\n\ -\n\ -@example\n\ -@group\n\ -disp (\"The value of pi is:\"), disp (pi)\n\ -\n\ - @print{} the value of pi is:\n\ - @print{} 3.1416\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Note that the output from @code{disp} always ends with a newline.\n\ -\n\ -If an output value is requested, @code{disp} prints nothing and\n\ -returns the formatted output in a string.\n\ -@seealso{fdisp}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 && nargout < 2) - { - if (nargout == 0) - args(0).print (octave_stdout); - else - { - octave_value arg = args(0); - std::ostringstream buf; - arg.print (buf); - retval = octave_value (buf.str (), arg.is_dq_string () ? '"' : '\''); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fdisp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fdisp (@var{fid}, @var{x})\n\ -Display the value of @var{x} on the stream @var{fid}. For example:\n\ -\n\ -@example\n\ -@group\n\ -fdisp (stdout, \"The value of pi is:\"), fdisp (stdout, pi)\n\ -\n\ - @print{} the value of pi is:\n\ - @print{} 3.1416\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Note that the output from @code{fdisp} always ends with a newline.\n\ -@seealso{disp}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 2) - { - int fid = octave_stream_list::get_file_number (args (0)); - - octave_stream os = octave_stream_list::lookup (fid, "fdisp"); - - if (! error_state) - { - std::ostream *osp = os.output_stream (); - - if (osp) - args(1).print (*osp); - else - error ("fdisp: stream FID not open for writing"); - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! format short -%! fd = tmpfile (); -%! for r = [0, Inf -Inf, NaN] -%! for i = [0, Inf -Inf, NaN] -%! fdisp (fd, complex (r, i)); -%! endfor -%! endfor -%! fclose (fd); - -%!test -%! foo.real = pi * ones (3,20,3); -%! foo.complex = pi * ones (3,20,3) + 1i; -%! foo.char = repmat ("- Hello World -", [3, 20]); -%! foo.cell = {foo.real, foo.complex, foo.char}; -%! fields = fieldnames (foo); -%! for f = 1:numel (fields) -%! format loose; -%! loose = disp (foo.(fields{f})); -%! format compact; -%! compact = disp (foo.(fields{f})); -%! expected = strrep (loose, "\n\n", "\n"); -%! assert (expected, compact); -%! endfor -*/ - -static void -init_format_state (void) -{ - free_format = false; - plus_format = false; - rat_format = false; - bank_format = false; - hex_format = 0; - bit_format = 0; - Vcompact_format = false; - print_e = false; - print_big_e = false; - print_g = false; - print_eng = false; -} - -static void -set_output_prec_and_fw (int prec, int fw) -{ - Voutput_precision = prec; - Voutput_max_field_width = fw; -} - -static void -set_format_style (int argc, const string_vector& argv) -{ - int idx = 1; - - if (--argc > 0) - { - std::string arg = argv[idx++]; - - if (arg == "short") - { - if (--argc > 0) - { - arg = argv[idx++]; - - if (arg == "e") - { - init_format_state (); - print_e = true; - } - else if (arg == "E") - { - init_format_state (); - print_e = true; - print_big_e = true; - } - else if (arg == "g") - { - init_format_state (); - print_g = true; - } - else if (arg == "G") - { - init_format_state (); - print_g = true; - print_big_e = true; - } - else if (arg == "eng") - { - init_format_state (); - print_eng = true; - } - else - { - error ("format: unrecognized option `short %s'", - arg.c_str ()); - return; - } - } - else - init_format_state (); - - set_output_prec_and_fw (5, 10); - } - else if (arg == "long") - { - if (--argc > 0) - { - arg = argv[idx++]; - - if (arg == "e") - { - init_format_state (); - print_e = true; - } - else if (arg == "E") - { - init_format_state (); - print_e = true; - print_big_e = true; - } - else if (arg == "g") - { - init_format_state (); - print_g = true; - } - else if (arg == "G") - { - init_format_state (); - print_g = true; - print_big_e = true; - } - else if (arg == "eng") - { - init_format_state (); - print_eng = true; - } - else - { - error ("format: unrecognized option `long %s'", - arg.c_str ()); - return; - } - } - else - init_format_state (); - - set_output_prec_and_fw (15, 20); - } - else if (arg == "hex") - { - init_format_state (); - hex_format = 1; - } - else if (arg == "native-hex") - { - init_format_state (); - hex_format = 2; - } - else if (arg == "bit") - { - init_format_state (); - bit_format = 1; - } - else if (arg == "native-bit") - { - init_format_state (); - bit_format = 2; - } - else if (arg == "+" || arg == "plus") - { - if (--argc > 0) - { - arg = argv[idx++]; - - if (arg.length () == 3) - plus_format_chars = arg; - else - { - error ("format: invalid option for plus format"); - return; - } - } - else - plus_format_chars = "+ "; - - init_format_state (); - plus_format = true; - } - else if (arg == "rat") - { - init_format_state (); - rat_format = true; - } - else if (arg == "bank") - { - init_format_state (); - bank_format = true; - } - else if (arg == "free") - { - init_format_state (); - free_format = true; - } - else if (arg == "none") - { - init_format_state (); - free_format = true; - } - else if (arg == "compact") - { - Vcompact_format = true; - } - else if (arg == "loose") - { - Vcompact_format = false; - } - else - error ("format: unrecognized format state `%s'", arg.c_str ()); - } - else - { - init_format_state (); - set_output_prec_and_fw (5, 10); - } -} - -DEFUN (format, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} format\n\ -@deftypefnx {Command} {} format options\n\ -Reset or specify the format of the output produced by @code{disp} and\n\ -Octave's normal echoing mechanism. This command only affects the display\n\ -of numbers but not how they are stored or computed. To change the internal\n\ -representation from the default double use one of the conversion functions\n\ -such as @code{single}, @code{uint8}, @code{int64}, etc.\n\ -\n\ -By default, Octave displays 5 significant digits in a human readable form\n\ -(option @samp{short} paired with @samp{loose} format for matrices).\n\ -If @code{format} is invoked without any options, this default format\n\ -is restored.\n\ -\n\ -Valid formats for floating point numbers are listed in the following\n\ -table.\n\ -\n\ -@table @code\n\ -@item short\n\ -Fixed point format with 5 significant figures in a field that is a maximum\n\ -of 10 characters wide. (default).\n\ -\n\ -If Octave is unable to format a matrix so that columns line up on the\n\ -decimal point and all numbers fit within the maximum field width then\n\ -it switches to an exponential @samp{e} format.\n\ -\n\ -@item long\n\ -Fixed point format with 15 significant figures in a field that is a maximum\n\ -of 20 characters wide.\n\ -\n\ -As with the @samp{short} format, Octave will switch to an exponential\n\ -@samp{e} format if it is unable to format a matrix properly using the\n\ -current format.\n\ -\n\ -@item short e\n\ -@itemx long e\n\ -Exponential format. The number to be represented is split between a mantissa\n\ -and an exponent (power of 10). The mantissa has 5 significant digits in the\n\ -short format and 15 digits in the long format.\n\ -For example, with the @samp{short e} format, @code{pi} is displayed as\n\ -@code{3.1416e+00}.\n\ -\n\ -@item short E\n\ -@itemx long E\n\ -Identical to @samp{short e} or @samp{long e} but displays an uppercase\n\ -@samp{E} to indicate the exponent.\n\ -For example, with the @samp{long E} format, @code{pi} is displayed as\n\ -@code{3.14159265358979E+00}.\n\ -\n\ -@item short g\n\ -@itemx long g\n\ -Optimally choose between fixed point and exponential format based on\n\ -the magnitude of the number.\n\ -For example, with the @samp{short g} format,\n\ -@code{pi .^ [2; 4; 8; 16; 32]} is displayed as\n\ -\n\ -@example\n\ -@group\n\ -ans =\n\ -\n\ - 9.8696\n\ - 97.409\n\ - 9488.5\n\ - 9.0032e+07\n\ - 8.1058e+15\n\ -@end group\n\ -@end example\n\ -\n\ -@item short eng\n\ -@itemx long eng\n\ -Identical to @samp{short e} or @samp{long e} but displays the value\n\ -using an engineering format, where the exponent is divisible by 3. For\n\ -example, with the @samp{short eng} format, @code{10 * pi} is displayed as\n\ -@code{31.4159e+00}.\n\ -\n\ -@item long G\n\ -@itemx short G\n\ -Identical to @samp{short g} or @samp{long g} but displays an uppercase\n\ -@samp{E} to indicate the exponent.\n\ -\n\ -@item free\n\ -@itemx none\n\ -Print output in free format, without trying to line up columns of\n\ -matrices on the decimal point. This also causes complex numbers to be\n\ -formatted as numeric pairs like this @samp{(0.60419, 0.60709)} instead\n\ -of like this @samp{0.60419 + 0.60709i}.\n\ -@end table\n\ -\n\ -The following formats affect all numeric output (floating point and\n\ -integer types).\n\ -\n\ -@table @code\n\ -@item +\n\ -@itemx + @var{chars}\n\ -@itemx plus\n\ -@itemx plus @var{chars}\n\ -Print a @samp{+} symbol for nonzero matrix elements and a space for zero\n\ -matrix elements. This format can be very useful for examining the\n\ -structure of a large sparse matrix.\n\ -\n\ -The optional argument @var{chars} specifies a list of 3 characters to use\n\ -for printing values greater than zero, less than zero and equal to zero.\n\ -For example, with the @samp{+ \"+-.\"} format, @code{[1, 0, -1; -1, 0, 1]}\n\ -is displayed as\n\ -\n\ -@example\n\ -@group\n\ -ans =\n\ -\n\ -+.-\n\ --.+\n\ -@end group\n\ -@end example\n\ -\n\ -@item bank\n\ -Print in a fixed format with two digits to the right of the decimal\n\ -point.\n\ -\n\ -@item native-hex\n\ -Print the hexadecimal representation of numbers as they are stored in\n\ -memory. For example, on a workstation which stores 8 byte real values\n\ -in IEEE format with the least significant byte first, the value of\n\ -@code{pi} when printed in @code{native-hex} format is\n\ -@code{400921fb54442d18}.\n\ -\n\ -@item hex\n\ -The same as @code{native-hex}, but always print the most significant\n\ -byte first.\n\ -\n\ -@item native-bit\n\ -Print the bit representation of numbers as stored in memory.\n\ -For example, the value of @code{pi} is\n\ -\n\ -@example\n\ -@group\n\ -01000000000010010010000111111011\n\ -01010100010001000010110100011000\n\ -@end group\n\ -@end example\n\ -\n\ -(shown here in two 32 bit sections for typesetting purposes) when\n\ -printed in native-bit format on a workstation which stores 8 byte real values\n\ -in IEEE format with the least significant byte first.\n\ -\n\ -@item bit\n\ -The same as @code{native-bit}, but always print the most significant\n\ -bits first.\n\ -\n\ -@item rat\n\ -Print a rational approximation, i.e., values are approximated\n\ -as the ratio of small integers.\n\ -For example, with the @samp{rat} format,\n\ -@code{pi} is displayed as @code{355/113}.\n\ -@end table\n\ -\n\ -The following two options affect the display of all matrices.\n\ -\n\ -@table @code\n\ -@item compact\n\ -Remove blank lines around column number labels and between\n\ -matrices producing more compact output with more data per page.\n\ -\n\ -@item loose\n\ -Insert blank lines above and below column number labels and between matrices\n\ -to produce a more readable output with less data per page. (default).\n\ -@end table\n\ -@seealso{fixed_point_format, output_max_field_width, output_precision, split_long_rows, rats}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("format"); - - if (error_state) - return retval; - - set_format_style (argc, argv); - - return retval; -} - -DEFUN (fixed_point_format, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} fixed_point_format ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} fixed_point_format (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} fixed_point_format (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will\n\ -use a scaled format to print matrix values such that the largest\n\ -element may be written with a single leading digit with the scaling\n\ -factor is printed on the first line of output. For example:\n\ -\n\ -@example\n\ -@group\n\ -octave:1> logspace (1, 7, 5)'\n\ -ans =\n\ -\n\ - 1.0e+07 *\n\ -\n\ - 0.00000\n\ - 0.00003\n\ - 0.00100\n\ - 0.03162\n\ - 1.00000\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Notice that first value appears to be zero when it is actually 1. For\n\ -this reason, you should be careful when setting\n\ -@code{fixed_point_format} to a nonzero value.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format, output_max_field_width, output_precision}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (fixed_point_format); -} - -DEFUN (print_empty_dimensions, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} print_empty_dimensions ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} print_empty_dimensions (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} print_empty_dimensions (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether the\n\ -dimensions of empty matrices are printed along with the empty matrix\n\ -symbol, @samp{[]}. For example, the expression\n\ -\n\ -@example\n\ -zeros (3, 0)\n\ -@end example\n\ -\n\ -@noindent\n\ -will print\n\ -\n\ -@example\n\ -ans = [](3x0)\n\ -@end example\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (print_empty_dimensions); -} - -DEFUN (split_long_rows, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} split_long_rows ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} split_long_rows (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} split_long_rows (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether rows of a matrix\n\ -may be split when displayed to a terminal window. If the rows are split,\n\ -Octave will display the matrix in a series of smaller pieces, each of\n\ -which can fit within the limits of your terminal width and each set of\n\ -rows is labeled so that you can easily see which columns are currently\n\ -being displayed. For example:\n\ -\n\ -@example\n\ -@group\n\ -octave:13> rand (2,10)\n\ -ans =\n\ -\n\ - Columns 1 through 6:\n\ -\n\ - 0.75883 0.93290 0.40064 0.43818 0.94958 0.16467\n\ - 0.75697 0.51942 0.40031 0.61784 0.92309 0.40201\n\ -\n\ - Columns 7 through 10:\n\ -\n\ - 0.90174 0.11854 0.72313 0.73326\n\ - 0.44672 0.94303 0.56564 0.82150\n\ -@end group\n\ -@end example\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (split_long_rows); -} - -DEFUN (output_max_field_width, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} output_max_field_width ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} output_max_field_width (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} output_max_field_width (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the maximum width\n\ -of a numeric output field.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format, fixed_point_format, output_precision}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_max_field_width, 0, INT_MAX); -} - -DEFUN (output_precision, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} output_precision ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} output_precision (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} output_precision (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the minimum number of\n\ -significant figures to display for numeric output.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format, fixed_point_format, output_max_field_width}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_precision, -1, INT_MAX); -} diff -r d02b229ce693 -r a132d206a36a src/pr-output.h --- a/src/pr-output.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,262 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_pr_output_h) -#define octave_pr_output_h 1 - -#include - -#include "oct-cmplx.h" - -template class Array; -class ComplexMatrix; -class FloatComplexMatrix; -class ComplexDiagMatrix; -class FloatComplexDiagMatrix; -class ComplexNDArray; -class FloatComplexNDArray; -class Matrix; -class FloatMatrix; -class DiagMatrix; -class FloatDiagMatrix; -class NDArray; -class FloatNDArray; -class Range; -class boolMatrix; -class boolNDArray; -class charMatrix; -class charNDArray; -class PermMatrix; -class Cell; - -#include "intNDArray.h" -#include "oct-inttypes.h" - - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, bool d, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, double d, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, float d, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Matrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const DiagMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const NDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Complex& c, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplex& c, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const ComplexMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const ComplexNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const PermMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Range& r, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const boolMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const boolNDArray& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const charMatrix& chm, - bool pr_as_read_syntax = false, - int extra_indent = 0, - bool pr_as_string = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const charNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0, - bool pr_as_string = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const std::string& s, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Array& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Cell& cell, - bool pr_as_read_syntax = false, - int extra_indent = 0, - bool pr_as_string = false); - -// TRUE means that the dimensions of empty objects should be printed -// like this: x = [](2x0). -extern bool Vprint_empty_dimensions; - -// TRUE means don't put empty lines in output -extern bool Vcompact_format; - -#endif diff -r d02b229ce693 -r a132d206a36a src/profiler.cc --- a/src/profiler.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,470 +0,0 @@ -/* - -Copyright (C) 2012 Daniel Kraft - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "defun.h" -#include "oct-time.h" -#include "ov-struct.h" -#include "pager.h" -#include "profiler.h" - -profile_data_accumulator::enter::enter (profile_data_accumulator& a, - const std::string& f) - : acc (a) -{ - if (acc.is_active ()) - { - fcn = f; - acc.enter_function (fcn); - } - else - fcn = ""; -} - -profile_data_accumulator::enter::~enter () -{ - if (fcn != "") - acc.exit_function (fcn); -} - -profile_data_accumulator::stats::stats () - : time (0.0), calls (0), recursive (false), - parents (), children () -{} - -octave_value -profile_data_accumulator::stats::function_set_value (const function_set& list) -{ - const octave_idx_type n = list.size (); - - RowVector retval (n); - octave_idx_type i = 0; - for (function_set::const_iterator p = list.begin (); p != list.end (); ++p) - { - retval(i) = *p; - ++i; - } - assert (i == n); - - return retval; -} - -profile_data_accumulator::tree_node::tree_node (tree_node* p, octave_idx_type f) - : parent (p), fcn_id (f), children (), time (0.0), calls (0) -{} - -profile_data_accumulator::tree_node::~tree_node () -{ - for (child_map::iterator i = children.begin (); i != children.end (); ++i) - delete i->second; -} - -profile_data_accumulator::tree_node* -profile_data_accumulator::tree_node::enter (octave_idx_type fcn) -{ - tree_node* retval; - - child_map::iterator pos = children.find (fcn); - if (pos == children.end ()) - { - retval = new tree_node (this, fcn); - children[fcn] = retval; - } - else - retval = pos->second; - - ++retval->calls; - return retval; -} - -profile_data_accumulator::tree_node* -profile_data_accumulator::tree_node::exit (octave_idx_type fcn) -{ - assert (parent); - assert (fcn_id == fcn); - - return parent; -} - -void -profile_data_accumulator::tree_node::build_flat (flat_profile& data) const -{ - // If this is not the top-level node, update profile entry for this function. - if (fcn_id != 0) - { - stats& entry = data[fcn_id - 1]; - - entry.time += time; - entry.calls += calls; - - assert (parent); - if (parent->fcn_id != 0) - { - entry.parents.insert (parent->fcn_id); - data[parent->fcn_id - 1].children.insert (fcn_id); - } - - if (!entry.recursive) - for (const tree_node* i = parent; i; i = i->parent) - if (i->fcn_id == fcn_id) - { - entry.recursive = true; - break; - } - } - - // Recurse on children. - for (child_map::const_iterator i = children.begin (); - i != children.end (); ++i) - i->second->build_flat (data); -} - -octave_value -profile_data_accumulator::tree_node::get_hierarchical (double* total) const -{ - /* Note that we don't generate the entry just for this node, but rather - a struct-array with entries for all children. This way, the top-node - (for which we don't want a real entry) generates already the final - hierarchical profile data. */ - - const octave_idx_type n = children.size (); - - Cell rv_indices (n, 1); - Cell rv_times (n, 1); - Cell rv_totals (n, 1); - Cell rv_calls (n, 1); - Cell rv_children (n, 1); - - octave_idx_type i = 0; - for (child_map::const_iterator p = children.begin (); - p != children.end (); ++p) - { - const tree_node& entry = *p->second; - double child_total = entry.time; - - rv_indices(i) = octave_value (p->first); - rv_times(i) = octave_value (entry.time); - rv_calls(i) = octave_value (entry.calls); - rv_children(i) = entry.get_hierarchical (&child_total); - rv_totals(i) = octave_value (child_total); - - if (total) - *total += child_total; - - ++i; - } - assert (i == n); - - octave_map retval; - - retval.assign ("Index", rv_indices); - retval.assign ("SelfTime", rv_times); - retval.assign ("TotalTime", rv_totals); - retval.assign ("NumCalls", rv_calls); - retval.assign ("Children", rv_children); - - return retval; -} - -profile_data_accumulator::profile_data_accumulator () - : known_functions (), fcn_index (), - enabled (false), call_tree (NULL), last_time (-1.0) -{} - -profile_data_accumulator::~profile_data_accumulator () -{ - if (call_tree) - delete call_tree; -} - -void -profile_data_accumulator::set_active (bool value) -{ - if (value) - { - // Create a call-tree top-node if there isn't yet one. - if (!call_tree) - call_tree = new tree_node (NULL, 0); - - // Let the top-node be the active one. This ensures we have a clean - // fresh start collecting times. - active_fcn = call_tree; - } - else - { - // Make sure we start with fresh timing if we're re-enabled later. - last_time = -1.0; - } - - enabled = value; -} - -void -profile_data_accumulator::enter_function (const std::string& fcn) -{ - // The enter class will check and only call us if the profiler is active. - assert (is_active ()); - assert (call_tree); - - // If there is already an active function, add to its time before - // pushing the new one. - if (active_fcn != call_tree) - add_current_time (); - - // Map the function's name to its index. - octave_idx_type fcn_idx; - fcn_index_map::iterator pos = fcn_index.find (fcn); - if (pos == fcn_index.end ()) - { - known_functions.push_back (fcn); - fcn_idx = known_functions.size (); - fcn_index[fcn] = fcn_idx; - } - else - fcn_idx = pos->second; - - active_fcn = active_fcn->enter (fcn_idx); - last_time = query_time (); -} - -void -profile_data_accumulator::exit_function (const std::string& fcn) -{ - assert (call_tree); - assert (active_fcn != call_tree); - - // Usually, if we are disabled this function is not even called. But the - // call disabling the profiler is an exception. So also check here - // and only record the time if enabled. - if (is_active ()) - add_current_time (); - - fcn_index_map::iterator pos = fcn_index.find (fcn); - assert (pos != fcn_index.end ()); - active_fcn = active_fcn->exit (pos->second); - - // If this was an "inner call", we resume executing the parent function - // up the stack. So note the start-time for this! - last_time = query_time (); -} - -void -profile_data_accumulator::reset (void) -{ - if (is_active ()) - { - error ("Can't reset active profiler."); - return; - } - - known_functions.clear (); - fcn_index.clear (); - - if (call_tree) - { - delete call_tree; - call_tree = NULL; - } - - last_time = -1.0; -} - -octave_value -profile_data_accumulator::get_flat (void) const -{ - octave_value retval; - - const octave_idx_type n = known_functions.size (); - - flat_profile flat (n); - - if (call_tree) - { - call_tree->build_flat (flat); - - Cell rv_names (n, 1); - Cell rv_times (n, 1); - Cell rv_calls (n, 1); - Cell rv_recursive (n, 1); - Cell rv_parents (n, 1); - Cell rv_children (n, 1); - - for (octave_idx_type i = 0; i != n; ++i) - { - rv_names(i) = octave_value (known_functions[i]); - rv_times(i) = octave_value (flat[i].time); - rv_calls(i) = octave_value (flat[i].calls); - rv_recursive(i) = octave_value (flat[i].recursive); - rv_parents(i) = stats::function_set_value (flat[i].parents); - rv_children(i) = stats::function_set_value (flat[i].children); - } - - octave_map m; - - m.assign ("FunctionName", rv_names); - m.assign ("TotalTime", rv_times); - m.assign ("NumCalls", rv_calls); - m.assign ("IsRecursive", rv_recursive); - m.assign ("Parents", rv_parents); - m.assign ("Children", rv_children); - - retval = m; - } - else - { - static const char *fn[] = - { - "FunctionName", - "TotalTime", - "NumCalls", - "IsRecursive", - "Parents", - "Children", - 0 - }; - - static octave_map m (dim_vector (0, 1), string_vector (fn)); - - retval = m; - } - - return retval; -} - -octave_value -profile_data_accumulator::get_hierarchical (void) const -{ - octave_value retval; - - if (call_tree) - retval = call_tree->get_hierarchical (); - else - { - static const char *fn[] = - { - "Index", - "SelfTime", - "NumCalls", - "Children", - 0 - }; - - static octave_map m (dim_vector (0, 1), string_vector (fn)); - - retval = m; - } - - return retval; -} - -double -profile_data_accumulator::query_time (void) const -{ - octave_time now; - - // FIXME -- is this volatile declaration really needed? - // See bug #34210 for additional details. - volatile double dnow = now.double_value (); - - return dnow; -} - -void -profile_data_accumulator::add_current_time (void) -{ - const double t = query_time (); - assert (last_time >= 0.0 && last_time <= t); - - assert (call_tree && active_fcn != call_tree); - active_fcn->add_time (t - last_time); -} - -profile_data_accumulator profiler; - -// Enable or disable the profiler data collection. -DEFUN (__profiler_enable__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __profiler_enable ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - - const int nargin = args.length (); - if (nargin > 0) - { - if (nargin > 1) - { - print_usage (); - return retval; - } - - profiler.set_active (args(0).bool_value ()); - } - - retval(0) = profiler.is_active (); - - return retval; -} - -// Clear all collected profiling data. -DEFUN (__profiler_reset__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __profiler_reset ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - const int nargin = args.length (); - - if (nargin > 0) - warning ("profiler_reset: ignoring extra arguments"); - - profiler.reset (); - - return retval; -} - -// Query the timings collected by the profiler. -DEFUN (__profiler_data__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Function File} __profiler_data ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - const int nargin = args.length (); - - if (nargin > 0) - warning ("profiler_data: ignoring extra arguments"); - - retval(0) = profiler.get_flat (); - if (nargout > 1) - retval(1) = profiler.get_hierarchical (); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/profiler.h --- a/src/profiler.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,190 +0,0 @@ -/* - -Copyright (C) 2012 Daniel Kraft - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_profiler_h) -#define octave_profiler_h 1 - -#include -#include -#include -#include -#include - -class octave_value; - -class -OCTINTERP_API -profile_data_accumulator -{ -public: - - // This is a utility class that can be used to call the enter/exit - // functions in a manner protected from stack unwinding. - class enter - { - private: - - profile_data_accumulator& acc; - std::string fcn; - - public: - - enter (profile_data_accumulator&, const std::string&); - virtual ~enter (void); - - private: - - // No copying! - enter (const enter&); - enter& operator = (const enter&); - }; - - profile_data_accumulator (void); - virtual ~profile_data_accumulator (); - - bool is_active (void) const { return enabled; } - void set_active (bool); - - void reset (void); - - octave_value get_flat (void) const; - octave_value get_hierarchical (void) const; - -private: - - // One entry in the flat profile (i.e., a collection of data for a single - // function). This is filled in when building the flat profile from the - // hierarchical call tree. - struct stats - { - stats (); - - double time; - unsigned calls; - - bool recursive; - - typedef std::set function_set; - function_set parents; - function_set children; - - // Convert a function_set list to an Octave array of indices. - static octave_value function_set_value (const function_set&); - }; - - typedef std::vector flat_profile; - - // Store data for one node in the call-tree of the hierarchical profiler - // data we collect. - class tree_node - { - public: - - tree_node (tree_node*, octave_idx_type); - virtual ~tree_node (); - - void add_time (double dt) { time += dt; } - - // Enter a child function. It is created in the list of children if it - // wasn't already there. The now-active child node is returned. - tree_node* enter (octave_idx_type); - - // Exit function. As a sanity-check, it is verified that the currently - // active function actually is the one handed in here. Returned is the - // then-active node, which is our parent. - tree_node* exit (octave_idx_type); - - void build_flat (flat_profile&) const; - - // Get the hierarchical profile for this node and its children. If total - // is set, accumulate total time of the subtree in that variable as - // additional return value. - octave_value get_hierarchical (double* total = NULL) const; - - private: - - tree_node* parent; - octave_idx_type fcn_id; - - typedef std::map child_map; - child_map children; - - // This is only time spent *directly* on this level, excluding children! - double time; - - unsigned calls; - - // No copying! - tree_node (const tree_node&); - tree_node& operator = (const tree_node&); - }; - - // Each function we see in the profiler is given a unique index (which - // simply counts starting from 1). We thus have to map profiler-names to - // those indices. For all other stuff, we identify functions by their index. - - typedef std::vector function_set; - typedef std::map fcn_index_map; - - function_set known_functions; - fcn_index_map fcn_index; - - bool enabled; - - tree_node* call_tree; - tree_node* active_fcn; - - // Store last timestamp we had, when the currently active function was called. - double last_time; - - // These are private as only the unwind-protecting inner class enter - // should be allowed to call them. - void enter_function (const std::string&); - void exit_function (const std::string&); - - // Query a timestamp, used for timing calls (obviously). - // This is not static because in the future, maybe we want a flag - // in the profiler or something to choose between cputime, wall-time, - // user-time, system-time, ... - double query_time () const; - - // Add the time elapsed since last_time to the function we're currently in. - // This is called from two different positions, thus it is useful to have - // it as a seperate function. - void add_current_time (void); - - // No copying! - profile_data_accumulator (const profile_data_accumulator&); - profile_data_accumulator& operator = (const profile_data_accumulator&); -}; - -// The instance used. -extern OCTINTERP_API profile_data_accumulator profiler; - -// Helper macro to profile a block of code. -#define BEGIN_PROFILER_BLOCK(name) \ - { \ - profile_data_accumulator::enter pe (profiler, (name)); -#define END_PROFILER_BLOCK \ - } - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-all.h --- a/src/pt-all.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_all_h) -#define octave_tree_all_h 1 - -#include "pt.h" -#include "pt-arg-list.h" -#include "pt-assign.h" -#include "pt-bp.h" -#include "pt-binop.h" -#include "pt-cbinop.h" -#include "pt-check.h" -#include "pt-cmd.h" -#include "pt-colon.h" -#include "pt-const.h" -#include "pt-decl.h" -#include "pt-except.h" -#include "pt-exp.h" -#include "pt-fcn-handle.h" -#include "pt-id.h" -#include "pt-idx.h" -#include "pt-jump.h" -#include "pt-loop.h" -#include "pt-mat.h" -#include "pt-cell.h" -#include "pt-misc.h" -#include "pt-pr-code.h" -#include "pt-select.h" -#include "pt-stmt.h" -#include "pt-unop.h" -#include "pt-pr-code.h" -#include "pt-walk.h" - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-arg-list.cc --- a/src/pt-arg-list.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,286 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "str-vec.h" - -#include "defun.h" -#include "error.h" -#include "oct-lvalue.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-usr-fcn.h" -#include "parse.h" -#include "pt-arg-list.h" -#include "pt-exp.h" -#include "pt-id.h" -#include "pt-pr-code.h" -#include "pt-walk.h" -#include "toplev.h" -#include "unwind-prot.h" - -// Argument lists. - -tree_argument_list::~tree_argument_list (void) -{ - while (! empty ()) - { - iterator p = begin (); - delete *p; - erase (p); - } -} - -bool -tree_argument_list::has_magic_end (void) const -{ - for (const_iterator p = begin (); p != end (); p++) - { - tree_expression *elt = *p; - - if (elt && elt->has_magic_end ()) - return true; - } - - return false; -} - -void -tree_argument_list::append (const element_type& s) -{ - octave_base_list::append (s); - - if (! list_includes_magic_end && s && s->has_magic_end ()) - list_includes_magic_end = true; - - if (! list_includes_magic_tilde && s && s->is_identifier ()) - { - tree_identifier *id = dynamic_cast (s); - list_includes_magic_tilde = id && id->is_black_hole (); - } -} - -bool -tree_argument_list::all_elements_are_constant (void) const -{ - for (const_iterator p = begin (); p != end (); p++) - { - tree_expression *elt = *p; - - if (! elt->is_constant ()) - return false; - } - - return true; -} - -static const octave_value *indexed_object = 0; -static int index_position = 0; -static int num_indices = 0; - -DEFCONSTFUN (__end__, , , - "internal function") -{ - octave_value retval; - - if (indexed_object) - { - if (indexed_object->is_object ()) - { - octave_value_list args; - - args(2) = num_indices; - args(1) = index_position + 1; - args(0) = *indexed_object; - - std::string class_name = indexed_object->class_name (); - - octave_value meth = symbol_table::find_method ("end", class_name); - - if (meth.is_defined ()) - return feval (meth.function_value (), args, 1); - } - - dim_vector dv = indexed_object->dims (); - int ndims = dv.length (); - - if (num_indices < ndims) - { - for (int i = num_indices; i < ndims; i++) - dv(num_indices-1) *= dv(i); - - if (num_indices == 1) - { - ndims = 2; - dv.resize (ndims); - dv(1) = 1; - } - else - { - ndims = num_indices; - dv.resize (ndims); - } - } - - if (index_position < ndims) - retval = dv(index_position); - else - retval = 1; - } - else - ::error ("invalid use of end"); - - return retval; -} - -octave_value_list -tree_argument_list::convert_to_const_vector (const octave_value *object) -{ - // END doesn't make sense for functions. Maybe we need a different - // way of asking an octave_value object this question? - - bool stash_object = (list_includes_magic_end - && object - && ! (object->is_function () - || object->is_function_handle ())); - - unwind_protect frame; - - if (stash_object) - { - frame.protect_var (indexed_object); - - indexed_object = object; - } - - int len = length (); - - std::list args; - - iterator p = begin (); - for (int k = 0; k < len; k++) - { - if (stash_object) - { - frame.protect_var (index_position); - frame.protect_var (num_indices); - - index_position = k; - num_indices = len; - } - - tree_expression *elt = *p++; - - if (elt) - { - octave_value tmp = elt->rvalue1 (); - - if (error_state) - { - ::error ("evaluating argument list element number %d", k+1); - args.clear (); - break; - } - else - { - if (tmp.is_cs_list ()) - args.push_back (tmp.list_value ()); - else if (tmp.is_defined ()) - args.push_back (tmp); - } - } - else - { - args.push_back (octave_value ()); - break; - } - } - - return args; -} - -std::list -tree_argument_list::lvalue_list (void) -{ - std::list retval; - - for (tree_argument_list::iterator p = begin (); - p != end (); - p++) - { - tree_expression *elt = *p; - - retval.push_back (elt->lvalue ()); - } - - return retval; -} - -string_vector -tree_argument_list::get_arg_names (void) const -{ - int len = length (); - - string_vector retval (len); - - int k = 0; - - for (const_iterator p = begin (); p != end (); p++) - { - tree_expression *elt = *p; - - retval(k++) = elt->str_print_code (); - } - - return retval; -} - -tree_argument_list * -tree_argument_list::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_argument_list *new_list = new tree_argument_list (); - - new_list->list_includes_magic_end = list_includes_magic_end; - new_list->simple_assign_lhs = simple_assign_lhs; - - for (const_iterator p = begin (); p != end (); p++) - { - const tree_expression *elt = *p; - - new_list->append (elt ? elt->dup (scope, context) : 0); - } - - return new_list; -} - -void -tree_argument_list::accept (tree_walker& tw) -{ - tw.visit_argument_list (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-arg-list.h --- a/src/pt-arg-list.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,105 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_arg_list_h) -#define octave_tree_arg_list_h 1 - -#include - -class octave_value_list; -class octave_lvalue; -class tree_expression; -class tree_walker; - -#include "str-vec.h" - -#include "base-list.h" - -// Argument lists. Used to hold the list of expressions that are the -// arguments in a function call or index expression. - -class -tree_argument_list : public octave_base_list -{ -public: - - typedef tree_expression* element_type; - - tree_argument_list (void) - : list_includes_magic_end (false), list_includes_magic_tilde (false), - simple_assign_lhs (false) { } - - tree_argument_list (tree_expression *t) - : list_includes_magic_end (false), list_includes_magic_tilde (false), - simple_assign_lhs (false) - { append (t); } - - ~tree_argument_list (void); - - bool has_magic_end (void) const; - - bool has_magic_tilde (void) const - { return list_includes_magic_tilde; } - - tree_expression *remove_front (void) - { - iterator p = begin (); - tree_expression *retval = *p; - erase (p); - return retval; - } - - void append (const element_type& s); - - void mark_as_simple_assign_lhs (void) { simple_assign_lhs = true; } - - bool is_simple_assign_lhs (void) { return simple_assign_lhs; } - - bool all_elements_are_constant (void) const; - - octave_value_list convert_to_const_vector (const octave_value *object = 0); - - std::list lvalue_list (void); - - string_vector get_arg_names (void) const; - - tree_argument_list *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - bool list_includes_magic_end; - - bool list_includes_magic_tilde; - - bool simple_assign_lhs; - - // No copying! - - tree_argument_list (const tree_argument_list&); - - tree_argument_list& operator = (const tree_argument_list&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-assign.cc --- a/src/pt-assign.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,530 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "pager.h" -#include "ov.h" -#include "pt-arg-list.h" -#include "pt-bp.h" -#include "pt-assign.h" -#include "pt-walk.h" -#include "utils.h" -#include "variables.h" - -// Simple assignment expressions. - -// FIXME -- the following variable and the function that uses it -// should be removed from some future version of Octave. - -static const char *former_built_in_variables[] = -{ - "DEFAULT_EXEC_PATH", - "DEFAULT_LOADPATH", - "EDITOR", - "EXEC_PATH", - "FFTW_WISDOM_PROGRAM", - "IMAGEPATH", - "INFO_FILE", - "INFO_PROGRAM", - "LOADPATH", - "MAKEINFO_PROGRAM", - "PAGER", - "PS1", - "PS2", - "PS4", - "__kluge_procbuf_delay__", - "automatic_replot", - "beep_on_error", - "completion_append_char", - "crash_dumps_octave_core", - "current_script_file_name", - "debug_on_error", - "debug_on_interrupt", - "debug_on_warning", - "debug_symtab_lookups", - "default_save_options", - "echo_executing_commands", - "fixed_point_format", - "gnuplot_binary", - "gnuplot_command_axes", - "gnuplot_command_end", - "gnuplot_command_plot", - "gnuplot_command_replot", - "gnuplot_command_splot", - "gnuplot_command_title", - "gnuplot_command_using", - "gnuplot_command_with", - "gnuplot_has_frames", - "history_file", - "history_size", - "ignore_function_time_stamp", - "max_recursion_depth", - "octave_core_file_format", - "octave_core_file_limit", - "octave_core_file_name", - "output_max_field_width", - "output_precision", - "page_output_immediately", - "page_screen_output", - "print_answer_id_name", - "print_empty_dimensions", - "print_rhs_assign_val", - "save_header_format_string", - "save_precision", - "saving_history", - "sighup_dumps_octave_core", - "sigterm_dumps_octave_core", - "silent_functions", - "split_long_rows", - "string_fill_char", - "struct_levels_to_print", - "suppress_verbose_help_message", - "variables_can_hide_functions", - "warn_assign_as_truth_value", - "warn_associativity_change", - "warn_divide_by_zero", - "warn_empty_list_elements", - "warn_fortran_indexing", - "warn_function_name_clash", - "warn_future_time_stamp", - "warn_imag_to_real", - "warn_matlab_incompatible", - "warn_missing_semicolon", - "warn_neg_dim_as_zero", - "warn_num_to_str", - "warn_precedence_change", - "warn_reload_forces_clear", - "warn_resize_on_range_error", - "warn_separator_insert", - "warn_single_quote_string", - "warn_str_to_num", - "warn_undefined_return_values", - "warn_variable_switch_label", - "whos_line_format", - 0, -}; - -static void -maybe_warn_former_built_in_variable (const std::string& nm) -{ - static bool initialized = false; - - static std::set vars; - - if (! initialized) - { - const char **p = former_built_in_variables; - - while (*p) - vars.insert (*p++); - - initialized = true; - } - - if (vars.find (nm) != vars.end ()) - { - const char *nm_c_str = nm.c_str (); - - warning_with_id ("Octave:built-in-variable-assignment", - "\ -In recent versions of Octave, %s is a function instead\n\ -of a built-in variable.\n\n\ -By assigning to %s, you have created a variable that hides\n\ -the function %s. To remove the variable and restore the \n\ -function, type \"clear %s\"\n", - nm_c_str, nm_c_str, nm_c_str, nm_c_str); - } -} - -tree_simple_assignment::tree_simple_assignment - (tree_expression *le, tree_expression *re, - bool plhs, int l, int c, octave_value::assign_op t) - : tree_expression (l, c), lhs (le), rhs (re), preserve (plhs), etype (t), - first_execution (true) { } - -tree_simple_assignment::~tree_simple_assignment (void) -{ - if (! preserve) - delete lhs; - - delete rhs; -} - -octave_value_list -tree_simple_assignment::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("invalid number of output arguments for expression X = RHS"); - else - retval = rvalue1 (nargout); - - return retval; -} - -octave_value -tree_simple_assignment::rvalue1 (int) -{ - octave_value retval; - - if (first_execution && lhs) - maybe_warn_former_built_in_variable (lhs->name ()); - - if (error_state) - return retval; - - if (rhs) - { - octave_value rhs_val = rhs->rvalue1 (); - - if (! error_state) - { - if (rhs_val.is_undefined ()) - { - error ("value on right hand side of assignment is undefined"); - return retval; - } - else - { - if (rhs_val.is_cs_list ()) - { - const octave_value_list lst = rhs_val.list_value (); - - if (! lst.empty ()) - rhs_val = lst(0); - else - { - error ("invalid number of elements on RHS of assignment"); - return retval; - } - } - - octave_lvalue ult = lhs->lvalue (); - - if (ult.numel () != 1) - gripe_nonbraced_cs_list_assignment (); - - if (! error_state) - { - ult.assign (etype, rhs_val); - - if (! error_state) - { - if (etype == octave_value::op_asn_eq) - retval = rhs_val; - else - retval = ult.value (); - - if (print_result ()) - { - // We clear any index here so that we can - // get the new value of the referenced - // object below, instead of the indexed - // value (which should be the same as the - // right hand side value). - - ult.clear_index (); - - octave_value lhs_val = ult.value (); - - if (! error_state) - lhs_val.print_with_name (octave_stdout, - lhs->name ()); - } - } - } - } - } - } - - first_execution = false; - - return retval; -} - -std::string -tree_simple_assignment::oper (void) const -{ - return octave_value::assign_op_as_string (etype); -} - -tree_expression * -tree_simple_assignment::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_simple_assignment *new_sa - = new tree_simple_assignment (lhs ? lhs->dup (scope, context) : 0, - rhs ? rhs->dup (scope, context) : 0, - preserve, etype); - - new_sa->copy_base (*this); - - return new_sa; -} - -void -tree_simple_assignment::accept (tree_walker& tw) -{ - tw.visit_simple_assignment (*this); -} - -// Multi-valued assignment expressions. - -tree_multi_assignment::tree_multi_assignment - (tree_argument_list *lst, tree_expression *r, - bool plhs, int l, int c) - : tree_expression (l, c), lhs (lst), rhs (r), preserve (plhs), - first_execution (true) { } - -tree_multi_assignment::~tree_multi_assignment (void) -{ - if (! preserve) - delete lhs; - - delete rhs; -} - -octave_value -tree_multi_assignment::rvalue1 (int nargout) -{ - octave_value retval; - - const octave_value_list tmp = rvalue (nargout); - - if (! tmp.empty ()) - retval = tmp(0); - - return retval; -} - -// FIXME -- this works, but it would look a little better if -// it were broken up into a couple of separate functions. - -octave_value_list -tree_multi_assignment::rvalue (int) -{ - octave_value_list retval; - - if (error_state) - return retval; - - if (first_execution) - { - for (tree_argument_list::iterator p = lhs->begin (); p != lhs->end (); p++) - { - tree_expression *lhs_expr = *p; - - if (lhs_expr) - maybe_warn_former_built_in_variable (lhs_expr->name ()); - } - } - - if (rhs) - { - std::list lvalue_list = lhs->lvalue_list (); - - if (error_state) - return retval; - - octave_idx_type n_out = 0; - - for (std::list::const_iterator p = lvalue_list.begin (); - p != lvalue_list.end (); - p++) - n_out += p->numel (); - - // The following trick is used to keep rhs_val constant. - const octave_value_list rhs_val1 = rhs->rvalue (n_out, &lvalue_list); - const octave_value_list rhs_val = (rhs_val1.length () == 1 && rhs_val1(0).is_cs_list () - ? rhs_val1(0).list_value () : rhs_val1); - - if (error_state) - return retval; - - octave_idx_type k = 0; - - octave_idx_type n = rhs_val.length (); - - // To avoid copying per elements and possible optimizations, we - // postpone joining the final values. - std::list retval_list; - - tree_argument_list::iterator q = lhs->begin (); - - for (std::list::iterator p = lvalue_list.begin (); - p != lvalue_list.end (); - p++) - { - tree_expression *lhs_elt = *q++; - - octave_lvalue ult = *p; - - octave_idx_type nel = ult.numel (); - - if (nel != 1) - { - if (k + nel <= n) - { - // This won't do a copy. - octave_value_list ovl = rhs_val.slice (k, nel); - - ult.assign (octave_value::op_asn_eq, octave_value (ovl, true)); - - if (! error_state) - { - retval_list.push_back (ovl); - - k += nel; - } - } - else - error ("some elements undefined in return list"); - } - else - { - if (k < n) - { - ult.assign (octave_value::op_asn_eq, rhs_val(k)); - - if (ult.is_black_hole ()) - { - k++; - continue; - } - else if (! error_state) - { - retval_list.push_back (rhs_val(k)); - - k++; - } - } - else - { - // This can happen for a function like - // - // function varargout = f () - // varargout{1} = nargout; - // endfunction - // - // called with - // - // [a, ~] = f (); - // - // Then the list of of RHS values will contain one - // element but we are iterating over the list of all - // RHS values. We shouldn't complain that a value we - // don't need is missing from the list. - - if (ult.is_black_hole ()) - { - k++; - continue; - } - else - error ("element number %d undefined in return list", k+1); - } - } - - if (error_state) - break; - else if (print_result ()) - { - // We clear any index here so that we can get - // the new value of the referenced object below, - // instead of the indexed value (which should be - // the same as the right hand side value). - - ult.clear_index (); - - octave_value lhs_val = ult.value (); - - if (! error_state) - lhs_val.print_with_name (octave_stdout, - lhs_elt->name ()); - } - - if (error_state) - break; - - } - - // Concatenate return values. - retval = retval_list; - - } - - first_execution = false; - - return retval; -} - -/* -%!function varargout = f () -%! varargout{1} = nargout; -%!endfunction -%! -%!test -%! [a, ~] = f (); -%! assert (a, 2); -%!test -%! [a, ~, ~, ~, ~] = f (); -%! assert (a, 5); -*/ - -std::string -tree_multi_assignment::oper (void) const -{ - return octave_value::assign_op_as_string (op_type ()); -} - -tree_expression * -tree_multi_assignment::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_multi_assignment *new_ma - = new tree_multi_assignment (lhs ? lhs->dup (scope, context) : 0, - rhs ? rhs->dup (scope, context) : 0, - preserve); - - new_ma->copy_base (*this); - - return new_ma; -} - -void -tree_multi_assignment::accept (tree_walker& tw) -{ - tw.visit_multi_assignment (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-assign.h --- a/src/pt-assign.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,173 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_assign_h) -#define octave_tree_assign_h 1 - -#include -#include - -class tree_argument_list; -class tree_walker; - -class octave_value; -class octave_value_list; -class octave_lvalue; - -#include "ov.h" -#include "pt-exp.h" -#include "symtab.h" - -// Simple assignment expressions. - -class -tree_simple_assignment : public tree_expression -{ -public: - - tree_simple_assignment (bool plhs = false, int l = -1, int c = -1, - octave_value::assign_op t = octave_value::op_asn_eq) - : tree_expression (l, c), lhs (0), rhs (0), preserve (plhs), ans_ass (), - etype (t), first_execution (true) { } - - tree_simple_assignment (tree_expression *le, tree_expression *re, - bool plhs = false, int l = -1, int c = -1, - octave_value::assign_op t = octave_value::op_asn_eq); - - ~tree_simple_assignment (void); - - bool has_magic_end (void) const { return (rhs && rhs->has_magic_end ()); } - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - bool is_assignment_expression (void) const { return true; } - - std::string oper (void) const; - - tree_expression *left_hand_side (void) { return lhs; } - - tree_expression *right_hand_side (void) { return rhs; } - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - - octave_value::assign_op op_type (void) const { return etype; } - -private: - - void do_assign (octave_lvalue& ult, const octave_value_list& args, - const octave_value& rhs_val); - - void do_assign (octave_lvalue& ult, const octave_value& rhs_val); - - // The left hand side of the assignment. - tree_expression *lhs; - - // The right hand side of the assignment. - tree_expression *rhs; - - // True if we should not delete the lhs. - bool preserve; - - // True if this is an assignment to the automatic variable ans. - bool ans_ass; - - // The type of the expression. - octave_value::assign_op etype; - - // true only on first rvalue() call. - bool first_execution; - - // No copying! - - tree_simple_assignment (const tree_simple_assignment&); - - tree_simple_assignment& operator = (const tree_simple_assignment&); -}; - -// Multi-valued assignment expressions. - -class -tree_multi_assignment : public tree_expression -{ -public: - - tree_multi_assignment (bool plhs = false, int l = -1, int c = -1) - : tree_expression (l, c), lhs (0), rhs (0), preserve (plhs), - first_execution (true) { } - - tree_multi_assignment (tree_argument_list *lst, tree_expression *r, - bool plhs = false, int l = -1, int c = -1); - - ~tree_multi_assignment (void); - - bool has_magic_end (void) const { return (rhs && rhs->has_magic_end ()); } - - bool is_assignment_expression (void) const { return true; } - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - std::string oper (void) const; - - tree_argument_list *left_hand_side (void) { return lhs; } - - tree_expression *right_hand_side (void) { return rhs; } - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - - octave_value::assign_op op_type (void) const { return octave_value::op_asn_eq; } - -private: - - // The left hand side of the assignment. - tree_argument_list *lhs; - - // The right hand side of the assignment. - tree_expression *rhs; - - // True if we should not delete the lhs. - bool preserve; - - // true only on first rvalue() call. - bool first_execution; - - // No copying! - - tree_multi_assignment (const tree_multi_assignment&); - - tree_multi_assignment& operator = (const tree_multi_assignment&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-binop.cc --- a/src/pt-binop.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,315 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "defun.h" -#include "oct-obj.h" -#include "ov.h" -#include "profiler.h" -#include "pt-binop.h" -#include "pt-bp.h" -#include "pt-walk.h" -#include "variables.h" - -// TRUE means we mark | and & expressions for braindead short-circuit -// behavior. -static bool Vdo_braindead_shortcircuit_evaluation; - -// Binary expressions. - -octave_value_list -tree_binary_expression::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("binary operator `%s': invalid number of output arguments", - oper () . c_str ()); - else - retval = rvalue1 (nargout); - - return retval; -} - -octave_value -tree_binary_expression::rvalue1 (int) -{ - octave_value retval; - - if (error_state) - return retval; - - if (Vdo_braindead_shortcircuit_evaluation - && eligible_for_braindead_shortcircuit) - { - if (op_lhs) - { - octave_value a = op_lhs->rvalue1 (); - - if (! error_state) - { - if (a.ndims () == 2 && a.rows () == 1 && a.columns () == 1) - { - bool result = false; - - bool a_true = a.is_true (); - - if (! error_state) - { - if (a_true) - { - if (etype == octave_value::op_el_or) - { - result = true; - goto done; - } - } - else - { - if (etype == octave_value::op_el_and) - goto done; - } - - if (op_rhs) - { - octave_value b = op_rhs->rvalue1 (); - - if (! error_state) - result = b.is_true (); - } - - done: - - if (! error_state) - return octave_value (result); - } - } - } - } - } - - if (op_lhs) - { - octave_value a = op_lhs->rvalue1 (); - - if (! error_state && a.is_defined () && op_rhs) - { - octave_value b = op_rhs->rvalue1 (); - - if (! error_state && b.is_defined ()) - { - BEGIN_PROFILER_BLOCK ("binary " + oper ()) - - // Note: The profiler does not catch the braindead - // short-circuit evaluation code above, but that should be - // ok. The evaluation of operands and the operator itself - // is entangled and it's not clear where to start/stop - // timing the operator to make it reasonable. - - retval = ::do_binary_op (etype, a, b); - - if (error_state) - retval = octave_value (); - - END_PROFILER_BLOCK - } - } - } - - return retval; -} - -std::string -tree_binary_expression::oper (void) const -{ - return octave_value::binary_op_as_string (etype); -} - -tree_expression * -tree_binary_expression::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_binary_expression *new_be - = new tree_binary_expression (op_lhs ? op_lhs->dup (scope, context) : 0, - op_rhs ? op_rhs->dup (scope, context) : 0, - line (), column (), etype); - - new_be->copy_base (*this); - - return new_be; -} - -void -tree_binary_expression::accept (tree_walker& tw) -{ - tw.visit_binary_expression (*this); -} - -// Boolean expressions. - -octave_value_list -tree_boolean_expression::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("binary operator `%s': invalid number of output arguments", - oper () . c_str ()); - else - retval = rvalue1 (nargout); - - return retval; -} - -octave_value -tree_boolean_expression::rvalue1 (int) -{ - octave_value retval; - - if (error_state) - return retval; - - bool result = false; - - // This evaluation is not caught by the profiler, since we can't find - // a reasonable place where to time. Note that we don't want to - // include evaluation of LHS or RHS into the timing, but this is - // entangled together with short-circuit evaluation here. - - if (op_lhs) - { - octave_value a = op_lhs->rvalue1 (); - - if (! error_state) - { - bool a_true = a.is_true (); - - if (! error_state) - { - if (a_true) - { - if (etype == bool_or) - { - result = true; - goto done; - } - } - else - { - if (etype == bool_and) - goto done; - } - - if (op_rhs) - { - octave_value b = op_rhs->rvalue1 (); - - if (! error_state) - result = b.is_true (); - } - - done: - - if (! error_state) - retval = octave_value (result); - } - } - } - - return retval; -} - -std::string -tree_boolean_expression::oper (void) const -{ - std::string retval = ""; - - switch (etype) - { - case bool_and: - retval = "&&"; - break; - - case bool_or: - retval = "||"; - break; - - default: - break; - } - - return retval; -} - -tree_expression * -tree_boolean_expression::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_boolean_expression *new_be - = new tree_boolean_expression (op_lhs ? op_lhs->dup (scope, context) : 0, - op_rhs ? op_rhs->dup (scope, context) : 0, - line (), column (), etype); - - new_be->copy_base (*this); - - return new_be; -} - -DEFUN (do_braindead_shortcircuit_evaluation, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} do_braindead_shortcircuit_evaluation ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} do_braindead_shortcircuit_evaluation (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} do_braindead_shortcircuit_evaluation (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will\n\ -do short-circuit evaluation of @samp{|} and @samp{&} operators inside the\n\ -conditions of if or while statements.\n\ -\n\ -This feature is only provided for compatibility with @sc{matlab} and should\n\ -not be used unless you are porting old code that relies on this feature.\n\ -\n\ -To obtain short-circuit behavior for logical expressions in new programs,\n\ -you should always use the @samp{&&} and @samp{||} operators.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (do_braindead_shortcircuit_evaluation); -} - -/* -%!test -%! x = 0; -%! do_braindead_shortcircuit_evaluation (0); -%! if (1 | (x = 1)) -%! endif -%! assert (x, 1); -%! do_braindead_shortcircuit_evaluation (1); -%! if (1 | (x = 0)) -%! endif -%! assert (x, 1); -*/ diff -r d02b229ce693 -r a132d206a36a src/pt-binop.h --- a/src/pt-binop.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,183 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_binop_h) -#define octave_tree_binop_h 1 - -#include - -class tree_walker; - -class octave_value; -class octave_value_list; -class octave_lvalue; - -#include "ov.h" -#include "pt-exp.h" -#include "symtab.h" - -// Binary expressions. - -class -tree_binary_expression : public tree_expression -{ -public: - - tree_binary_expression (int l = -1, int c = -1, - octave_value::binary_op t - = octave_value::unknown_binary_op) - : tree_expression (l, c), op_lhs (0), op_rhs (0), etype (t), - eligible_for_braindead_shortcircuit (false) { } - - tree_binary_expression (tree_expression *a, tree_expression *b, - int l = -1, int c = -1, - octave_value::binary_op t - = octave_value::unknown_binary_op) - : tree_expression (l, c), op_lhs (a), op_rhs (b), etype (t), - eligible_for_braindead_shortcircuit (false) { } - - ~tree_binary_expression (void) - { - delete op_lhs; - delete op_rhs; - } - - void mark_braindead_shortcircuit (const std::string& file) - { - if (etype == octave_value::op_el_and - || etype == octave_value::op_el_or) - { - if (file.empty ()) - warning_with_id ("Octave:possible-matlab-short-circuit-operator", - "possible Matlab-style short-circuit operator at line %d, column %d", - line (), column ()); - else - warning_with_id ("Octave:possible-matlab-short-circuit-operator", - "%s: possible Matlab-style short-circuit operator at line %d, column %d", - file.c_str (), line (), column ()); - - eligible_for_braindead_shortcircuit = true; - - op_lhs->mark_braindead_shortcircuit (file); - op_rhs->mark_braindead_shortcircuit (file); - } - } - - bool has_magic_end (void) const - { - return ((op_lhs && op_lhs->has_magic_end ()) - || (op_rhs && op_rhs->has_magic_end ())); - } - - bool is_binary_expression (void) const { return true; } - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - std::string oper (void) const; - - octave_value::binary_op op_type (void) const { return etype; } - - tree_expression *lhs (void) { return op_lhs; } - tree_expression *rhs (void) { return op_rhs; } - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -protected: - - // The operands for the expression. - tree_expression *op_lhs; - tree_expression *op_rhs; - -private: - - // The type of the expression. - octave_value::binary_op etype; - - // TRUE if this is an | or & expression in the condition of an IF - // or WHILE statement. - bool eligible_for_braindead_shortcircuit; - - // No copying! - - tree_binary_expression (const tree_binary_expression&); - - tree_binary_expression& operator = (const tree_binary_expression&); -}; - -// Boolean expressions. - -class -tree_boolean_expression : public tree_binary_expression -{ -public: - - enum type - { - unknown, - bool_and, - bool_or - }; - - tree_boolean_expression (int l = -1, int c = -1, type t = unknown) - : tree_binary_expression (l, c), etype (t) { } - - tree_boolean_expression (tree_expression *a, tree_expression *b, - int l = -1, int c = -1, type t = unknown) - : tree_binary_expression (a, b, l, c), etype (t) { } - - ~tree_boolean_expression (void) { } - - bool is_boolean_expression (void) const { return true; } - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - std::string oper (void) const; - - type op_type (void) const { return etype; } - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - -private: - - // The type of the expression. - type etype; - - // No copying! - - tree_boolean_expression (const tree_boolean_expression&); - - tree_boolean_expression& operator = (const tree_boolean_expression&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-bp.cc --- a/src/pt-bp.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,501 +0,0 @@ -/* - -Copyright (C) 2001-2012 Ben Sapp - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "ov-usr-fcn.h" -#include "pager.h" -#include "pt-all.h" - -// TRUE means SIGINT should put us in the debugger at the next -// available breakpoint. -bool octave_debug_on_interrupt_state = false; - -void -tree_breakpoint::visit_while_command (tree_while_command& cmd) -{ - if (cmd.line () >= line) - take_action (cmd); - - if (! found) - { - tree_statement_list *lst = cmd.body (); - - if (lst) - lst->accept (*this); - } -} - -void -tree_breakpoint::visit_do_until_command (tree_do_until_command& cmd) -{ - if (! found) - { - tree_statement_list *lst = cmd.body (); - - if (lst) - lst->accept (*this); - - if (! found) - { - if (cmd.line () >= line) - take_action (cmd); - } - } -} - -void -tree_breakpoint::visit_argument_list (tree_argument_list&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_binary_expression (tree_binary_expression&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_break_command (tree_break_command& cmd) -{ - if (cmd.line () >= line) - take_action (cmd); -} - -void -tree_breakpoint::visit_colon_expression (tree_colon_expression&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_continue_command (tree_continue_command& cmd) -{ - if (cmd.line () >= line) - take_action (cmd); -} - -void -tree_breakpoint::do_decl_command (tree_decl_command& cmd) -{ - if (cmd.line () >= line) - take_action (cmd); -} - -void -tree_breakpoint::visit_global_command (tree_global_command& cmd) -{ - do_decl_command (cmd); -} - -void -tree_breakpoint::visit_persistent_command (tree_persistent_command& cmd) -{ - do_decl_command (cmd); -} - -void -tree_breakpoint::visit_decl_elt (tree_decl_elt&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_decl_init_list (tree_decl_init_list&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_simple_for_command (tree_simple_for_command& cmd) -{ - if (cmd.line () >= line) - take_action (cmd); - - if (! found) - { - tree_statement_list *lst = cmd.body (); - - if (lst) - lst->accept (*this); - } -} - -void -tree_breakpoint::visit_complex_for_command (tree_complex_for_command& cmd) -{ - if (cmd.line () >= line) - take_action (cmd); - - if (! found) - { - tree_statement_list *lst = cmd.body (); - - if (lst) - lst->accept (*this); - } -} - -void -tree_breakpoint::visit_octave_user_script (octave_user_script& fcn) -{ - tree_statement_list *cmd_list = fcn.body (); - - if (cmd_list) - cmd_list->accept (*this); -} - -void -tree_breakpoint::visit_octave_user_function (octave_user_function& fcn) -{ - tree_statement_list *cmd_list = fcn.body (); - - if (cmd_list) - cmd_list->accept (*this); -} - -void -tree_breakpoint::visit_octave_user_function_header (octave_user_function&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_octave_user_function_trailer (octave_user_function&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_function_def (tree_function_def& fdef) -{ - octave_value fcn = fdef.function (); - - octave_function *f = fcn.function_value (); - - if (f) - f->accept (*this); -} - -void -tree_breakpoint::visit_identifier (tree_identifier&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_if_clause (tree_if_clause&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_if_command (tree_if_command& cmd) -{ - if (cmd.line () >= line) - take_action (cmd); - - if (! found) - { - tree_if_command_list *lst = cmd.cmd_list (); - - if (lst) - lst->accept (*this); - } -} - -void -tree_breakpoint::visit_if_command_list (tree_if_command_list& lst) -{ - for (tree_if_command_list::iterator p = lst.begin (); p != lst.end (); p++) - { - tree_if_clause *t = *p; - - if (t->line () >= line) - take_action (*t); - - if (! found) - { - tree_statement_list *stmt_lst = t->commands (); - - if (stmt_lst) - stmt_lst->accept (*this); - } - - if (found) - break; - } -} - -void -tree_breakpoint::visit_index_expression (tree_index_expression&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_matrix (tree_matrix&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_cell (tree_cell&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_multi_assignment (tree_multi_assignment&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_no_op_command (tree_no_op_command& cmd) -{ - if (cmd.is_end_of_fcn_or_script () && cmd.line () >= line) - take_action (cmd); -} - -void -tree_breakpoint::visit_anon_fcn_handle (tree_anon_fcn_handle&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_constant (tree_constant&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_fcn_handle (tree_fcn_handle&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_parameter_list (tree_parameter_list&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_postfix_expression (tree_postfix_expression&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_prefix_expression (tree_prefix_expression&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_return_command (tree_return_command& cmd) -{ - if (cmd.line () >= line) - take_action (cmd); -} - -void -tree_breakpoint::visit_return_list (tree_return_list&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_simple_assignment (tree_simple_assignment&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_statement (tree_statement& stmt) -{ - if (stmt.is_command ()) - { - tree_command *cmd = stmt.command (); - - cmd->accept (*this); - } - else - { - if (stmt.line () >= line) - take_action (stmt); - } -} - -void -tree_breakpoint::visit_statement_list (tree_statement_list& lst) -{ - for (tree_statement_list::iterator p = lst.begin (); p != lst.end (); p++) - { - tree_statement *elt = *p; - - if (elt) - { - elt->accept (*this); - - if (found) - break; - } - } -} - -void -tree_breakpoint::visit_switch_case (tree_switch_case&) -{ - panic_impossible (); -} - -void -tree_breakpoint::visit_switch_case_list (tree_switch_case_list& lst) -{ - for (tree_switch_case_list::iterator p = lst.begin (); p != lst.end (); p++) - { - tree_switch_case *t = *p; - - if (t->line () >= line) - take_action (*t); - - if (! found) - { - tree_statement_list *stmt_lst = t->commands (); - - if (stmt_lst) - stmt_lst->accept (*this); - } - - if (found) - break; - } -} - -void -tree_breakpoint::visit_switch_command (tree_switch_command& cmd) -{ - if (cmd.line () >= line) - take_action (cmd); - - if (! found) - { - tree_switch_case_list *lst = cmd.case_list (); - - if (lst) - lst->accept (*this); - } -} - -void -tree_breakpoint::visit_try_catch_command (tree_try_catch_command& cmd) -{ - tree_statement_list *try_code = cmd.body (); - - if (try_code) - try_code->accept (*this); - - if (! found) - { - tree_statement_list *catch_code = cmd.cleanup (); - - if (catch_code) - catch_code->accept (*this); - } -} - -void -tree_breakpoint::visit_unwind_protect_command (tree_unwind_protect_command& cmd) -{ - tree_statement_list *body = cmd.body (); - - if (body) - body->accept (*this); - - if (! found) - { - tree_statement_list *cleanup = cmd.cleanup (); - - if (cleanup) - cleanup->accept (*this); - } -} - -void -tree_breakpoint::take_action (tree& tr) -{ - if (act == set) - { - tr.set_breakpoint (); - line = tr.line (); - found = true; - } - else if (act == clear) - { - if (tr.is_breakpoint ()) - { - tr.delete_breakpoint (); - found = true; - } - } - else if (act == list) - { - if (tr.is_breakpoint ()) - bp_list.append (octave_value (tr.line ())); - } - else - panic_impossible (); -} - -void -tree_breakpoint::take_action (tree_statement& stmt) -{ - int lineno = stmt.line (); - - if (act == set) - { - stmt.set_breakpoint (); - line = lineno; - found = true; - } - else if (act == clear) - { - if (stmt.is_breakpoint ()) - { - stmt.delete_breakpoint (); - found = true; - } - } - else if (act == list) - { - if (stmt.is_breakpoint ()) - bp_list.append (octave_value (lineno)); - } - else - panic_impossible (); -} diff -r d02b229ce693 -r a132d206a36a src/pt-bp.h --- a/src/pt-bp.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,170 +0,0 @@ -/* - -Copyright (C) 2001-2012 Ben Sapp - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_bp_h) -#define octave_tree_bp_h 1 - -#include "input.h" -#include "ov-usr-fcn.h" -#include "pt-walk.h" -#include "pt-pr-code.h" -#include "toplev.h" - -class tree; -class tree_decl_command; - -class -tree_breakpoint : public tree_walker -{ - public: - - enum action { set = 1, clear = 2, list = 3 }; - - tree_breakpoint (int l, action a) - : line (l), act (a), found (false), bp_list () { } - - ~tree_breakpoint (void) { } - - bool success (void) const { return found; } - - void visit_argument_list (tree_argument_list&); - - void visit_binary_expression (tree_binary_expression&); - - void visit_break_command (tree_break_command&); - - void visit_colon_expression (tree_colon_expression&); - - void visit_continue_command (tree_continue_command&); - - void visit_global_command (tree_global_command&); - - void visit_persistent_command (tree_persistent_command&); - - void visit_decl_elt (tree_decl_elt&); - - void visit_decl_init_list (tree_decl_init_list&); - - void visit_while_command (tree_while_command&); - - void visit_do_until_command (tree_do_until_command&); - - void visit_simple_for_command (tree_simple_for_command&); - - void visit_complex_for_command (tree_complex_for_command&); - - void visit_octave_user_script (octave_user_script&); - - void visit_octave_user_function (octave_user_function&); - - void visit_octave_user_function_header (octave_user_function&); - - void visit_octave_user_function_trailer (octave_user_function&); - - void visit_function_def (tree_function_def&); - - void visit_identifier (tree_identifier&); - - void visit_if_clause (tree_if_clause&); - - void visit_if_command (tree_if_command&); - - void visit_if_command_list (tree_if_command_list&); - - void visit_index_expression (tree_index_expression&); - - void visit_matrix (tree_matrix&); - - void visit_cell (tree_cell&); - - void visit_multi_assignment (tree_multi_assignment&); - - void visit_no_op_command (tree_no_op_command&); - - void visit_anon_fcn_handle (tree_anon_fcn_handle&); - - void visit_constant (tree_constant&); - - void visit_fcn_handle (tree_fcn_handle&); - - void visit_parameter_list (tree_parameter_list&); - - void visit_postfix_expression (tree_postfix_expression&); - - void visit_prefix_expression (tree_prefix_expression&); - - void visit_return_command (tree_return_command&); - - void visit_return_list (tree_return_list&); - - void visit_simple_assignment (tree_simple_assignment&); - - void visit_statement (tree_statement&); - - void visit_statement_list (tree_statement_list&); - - void visit_switch_case (tree_switch_case&); - - void visit_switch_case_list (tree_switch_case_list&); - - void visit_switch_command (tree_switch_command&); - - void visit_try_catch_command (tree_try_catch_command&); - - void visit_unwind_protect_command (tree_unwind_protect_command&); - - octave_value_list get_list (void) { return bp_list; } - - int get_line (void) { return line; } - - private: - - void do_decl_command (tree_decl_command&); - - void take_action (tree& tr); - - void take_action (tree_statement& stmt); - - // Statement line number we are looking for. - int line; - - // What to do. - action act; - - // Have we already found the line? - bool found; - - // List of breakpoint line numbers. - octave_value_list bp_list; - - // No copying! - - tree_breakpoint (const tree_breakpoint&); - - tree_breakpoint& operator = (const tree_breakpoint&); -}; - -// TRUE means SIGINT should put us in the debugger at the next -// available breakpoint. -extern bool octave_debug_on_interrupt_state; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-cbinop.cc --- a/src/pt-cbinop.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,223 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "oct-obj.h" -#include "ov.h" -#include "pt-cbinop.h" -#include "pt-bp.h" -#include "pt-unop.h" -#include "pt-walk.h" - -// If a tree expression is a transpose or hermitian transpose, return -// the argument and corresponding operator. - -static octave_value::unary_op -strip_trans_herm (tree_expression *&exp) -{ - if (exp->is_unary_expression ()) - { - tree_unary_expression *uexp = - dynamic_cast (exp); - - octave_value::unary_op op = uexp->op_type (); - - if (op == octave_value::op_transpose - || op == octave_value::op_hermitian) - exp = uexp->operand (); - else - op = octave_value::unknown_unary_op; - - return op; - } - else - return octave_value::unknown_unary_op; -} - -static octave_value::unary_op -strip_not (tree_expression *&exp) -{ - if (exp->is_unary_expression ()) - { - tree_unary_expression *uexp = - dynamic_cast (exp); - - octave_value::unary_op op = uexp->op_type (); - - if (op == octave_value::op_not) - exp = uexp->operand (); - else - op = octave_value::unknown_unary_op; - - return op; - } - else - return octave_value::unknown_unary_op; -} - -// Possibly convert multiplication to trans_mul, mul_trans, herm_mul, -// or mul_herm. - -static octave_value::compound_binary_op -simplify_mul_op (tree_expression *&a, tree_expression *&b) -{ - octave_value::compound_binary_op retop - = octave_value::unknown_compound_binary_op; - - octave_value::unary_op opa = strip_trans_herm (a); - - if (opa == octave_value::op_hermitian) - retop = octave_value::op_herm_mul; - else if (opa == octave_value::op_transpose) - retop = octave_value::op_trans_mul; - else - { - octave_value::unary_op opb = strip_trans_herm (b); - - if (opb == octave_value::op_hermitian) - retop = octave_value::op_mul_herm; - else if (opb == octave_value::op_transpose) - retop = octave_value::op_mul_trans; - } - - return retop; -} - -// Possibly convert left division to trans_ldiv or herm_ldiv. - -static octave_value::compound_binary_op -simplify_ldiv_op (tree_expression *&a, tree_expression *&) -{ - octave_value::compound_binary_op retop - = octave_value::unknown_compound_binary_op; - - octave_value::unary_op opa = strip_trans_herm (a); - - if (opa == octave_value::op_hermitian) - retop = octave_value::op_herm_ldiv; - else if (opa == octave_value::op_transpose) - retop = octave_value::op_trans_ldiv; - - return retop; -} - -// Possibly contract and/or with negation. - -static octave_value::compound_binary_op -simplify_and_or_op (tree_expression *&a, tree_expression *&b, octave_value::binary_op op) -{ - octave_value::compound_binary_op retop - = octave_value::unknown_compound_binary_op; - - octave_value::unary_op opa = strip_not (a); - - if (opa == octave_value::op_not) - { - if (op == octave_value::op_el_and) - retop = octave_value::op_el_not_and; - else if (op == octave_value::op_el_or) - retop = octave_value::op_el_not_or; - } - else - { - octave_value::unary_op opb = strip_not (b); - - if (opb == octave_value::op_not) - { - if (op == octave_value::op_el_and) - retop = octave_value::op_el_and_not; - else if (op == octave_value::op_el_or) - retop = octave_value::op_el_or_not; - } - } - - return retop; -} - -tree_binary_expression * -maybe_compound_binary_expression (tree_expression *a, tree_expression *b, - int l, int c, octave_value::binary_op t) -{ - tree_expression *ca = a, *cb = b; - octave_value::compound_binary_op ct; - - switch (t) - { - case octave_value::op_mul: - ct = simplify_mul_op (ca, cb); - break; - - case octave_value::op_ldiv: - ct = simplify_ldiv_op (ca, cb); - break; - - case octave_value::op_el_and: - case octave_value::op_el_or: - ct = simplify_and_or_op (ca, cb, t); - break; - - default: - ct = octave_value::unknown_compound_binary_op; - break; - } - - tree_binary_expression *ret = (ct == octave_value::unknown_compound_binary_op) - ? new tree_binary_expression (a, b, l, c, t) - : new tree_compound_binary_expression (a, b, l, c, t, ca, cb, ct); - - return ret; -} - -octave_value -tree_compound_binary_expression::rvalue1 (int) -{ - octave_value retval; - - if (error_state) - return retval; - - if (op_lhs) - { - octave_value a = op_lhs->rvalue1 (); - - if (! error_state && a.is_defined () && op_rhs) - { - octave_value b = op_rhs->rvalue1 (); - - if (! error_state && b.is_defined ()) - { - retval = ::do_binary_op (etype, a, b); - - if (error_state) - retval = octave_value (); - } - } - } - - return retval; -} - - diff -r d02b229ce693 -r a132d206a36a src/pt-cbinop.h --- a/src/pt-cbinop.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -/* - -Copyright (C) 2008-2012 Jaroslav Hajek - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_cbinop_h) -#define octave_tree_cbinop_h 1 - -#include - -class tree_walker; - -class octave_value; -class octave_value_list; -class octave_lvalue; - -#include "ov.h" -#include "pt-binop.h" -#include "symtab.h" - -// Binary expressions that can be reduced to compound operations - -class -tree_compound_binary_expression : public tree_binary_expression -{ -public: - - tree_compound_binary_expression (tree_expression *a, tree_expression *b, - int l, int c, - octave_value::binary_op t, - tree_expression *ca, tree_expression *cb, - octave_value::compound_binary_op ct) - : tree_binary_expression (a, b, l, c, t), op_lhs (ca), op_rhs (cb), - etype (ct) { } - - octave_value rvalue1 (int nargout = 1); - - octave_value::compound_binary_op cop_type (void) const { return etype; } - -private: - - tree_expression *op_lhs; - tree_expression *op_rhs; - octave_value::compound_binary_op etype; - - // No copying! - - tree_compound_binary_expression (const tree_compound_binary_expression&); - - tree_compound_binary_expression& operator = - (const tree_compound_binary_expression&); -}; - -// a "virtual constructor" - -tree_binary_expression * -maybe_compound_binary_expression (tree_expression *a, tree_expression *b, - int l = -1, int c = -1, - octave_value::binary_op t - = octave_value::unknown_binary_op); - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-cell.cc --- a/src/pt-cell.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,126 +0,0 @@ -/* - -Copyright (C) 1999-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "oct-obj.h" -#include "pt-arg-list.h" -#include "pt-bp.h" -#include "pt-exp.h" -#include "pt-cell.h" -#include "pt-walk.h" -#include "utils.h" -#include "ov.h" -#include "variables.h" - -octave_value -tree_cell::rvalue1 (int) -{ - octave_value retval; - - octave_idx_type nr = length (); - octave_idx_type nc = -1; - - Cell val; - - int i = 0; - - for (iterator p = begin (); p != end (); p++) - { - tree_argument_list *elt = *p; - - octave_value_list row = elt->convert_to_const_vector (); - - if (nr == 1) - // Optimize the single row case. - val = row.cell_value (); - else if (nc < 0) - { - nc = row.length (); - - val = Cell (nr, nc); - } - else - { - octave_idx_type this_nc = row.length (); - - if (nc != this_nc) - { - ::error ("number of columns must match"); - return retval; - } - } - - for (octave_idx_type j = 0; j < nc; j++) - val(i,j) = row(j); - - i++; - } - - retval = val; - - return retval; -} - -octave_value_list -tree_cell::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("invalid number of output arguments for cell array"); - else - retval = rvalue1 (nargout); - - return retval; -} - -tree_expression * -tree_cell::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_cell *new_cell = new tree_cell (0, line (), column ()); - - for (const_iterator p = begin (); p != end (); p++) - { - const tree_argument_list *elt = *p; - - new_cell->append (elt ? elt->dup (scope, context) : 0); - } - - new_cell->copy_base (*this); - - return new_cell; -} - -void -tree_cell::accept (tree_walker& tw) -{ - tw.visit_cell (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-cell.h --- a/src/pt-cell.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,69 +0,0 @@ -/* - -Copyright (C) 1999-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_cell_h) -#define octave_tree_cell_h 1 - -#include - -class octave_value; -class octave_value_list; -class tree_argument_list; - -class tree_walker; - -#include "pt-mat.h" -#include "symtab.h" - -// General cells. - -class -tree_cell : public tree_matrix -{ -public: - - tree_cell (tree_argument_list *row = 0, int l = -1, int c = -1) - : tree_matrix (row, l, c) { } - - ~tree_cell (void) { } - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int); - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // No copying! - - tree_cell (const tree_cell&); - - tree_cell& operator = (const tree_cell&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-check.cc --- a/src/pt-check.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,561 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "input.h" -#include "ov-usr-fcn.h" -#include "pt-all.h" - -void -tree_checker::visit_argument_list (tree_argument_list& lst) -{ - tree_argument_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_expression *elt = *p++; - - if (elt) - { - if (do_lvalue_check && ! elt->lvalue_ok ()) - gripe ("invalid lvalue in multiple assignment", elt->line ()); - } - } -} - -void -tree_checker::visit_binary_expression (tree_binary_expression& expr) -{ - tree_expression *op1 = expr.lhs (); - - if (op1) - op1->accept (*this); - - tree_expression *op2 = expr.rhs (); - - if (op2) - op2->accept (*this); -} - -void -tree_checker::visit_break_command (tree_break_command&) -{ -} - -void -tree_checker::visit_colon_expression (tree_colon_expression& expr) -{ - tree_expression *op1 = expr.base (); - - if (op1) - op1->accept (*this); - - tree_expression *op3 = expr.increment (); - - if (op3) - op3->accept (*this); - - tree_expression *op2 = expr.limit (); - - if (op2) - op2->accept (*this); -} - -void -tree_checker::visit_continue_command (tree_continue_command&) -{ -} - -void -tree_checker::do_decl_command (tree_decl_command& cmd) -{ - tree_decl_init_list *init_list = cmd.initializer_list (); - - if (init_list) - init_list->accept (*this); -} - -void -tree_checker::visit_global_command (tree_global_command& cmd) -{ - do_decl_command (cmd); -} - -void -tree_checker::visit_persistent_command (tree_persistent_command& cmd) -{ - do_decl_command (cmd); -} - -void -tree_checker::visit_decl_elt (tree_decl_elt& cmd) -{ - tree_identifier *id = cmd.ident (); - - if (id) - id->accept (*this); - - tree_expression *expr = cmd.expression (); - - if (expr) - expr->accept (*this); -} - -void -tree_checker::visit_decl_init_list (tree_decl_init_list& lst) -{ - tree_decl_init_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_decl_elt *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_checker::visit_simple_for_command (tree_simple_for_command& cmd) -{ - tree_expression *lhs = cmd.left_hand_side (); - - if (lhs) - { - if (! lhs->lvalue_ok ()) - gripe ("invalid lvalue in for command", cmd.line ()); - } - - tree_expression *expr = cmd.control_expr (); - - if (expr) - expr->accept (*this); - - tree_expression *maxproc = cmd.maxproc_expr (); - - if (maxproc) - maxproc->accept (*this); - - tree_statement_list *list = cmd.body (); - - if (list) - list->accept (*this); -} - -void -tree_checker::visit_complex_for_command (tree_complex_for_command& cmd) -{ - tree_argument_list *lhs = cmd.left_hand_side (); - - if (lhs) - { - int len = lhs->length (); - - if (len == 0 || len > 2) - gripe ("invalid number of output arguments in for command", - cmd.line ()); - - do_lvalue_check = true; - - lhs->accept (*this); - - do_lvalue_check = false; - } - - tree_expression *expr = cmd.control_expr (); - - if (expr) - expr->accept (*this); - - tree_statement_list *list = cmd.body (); - - if (list) - list->accept (*this); -} - -void -tree_checker::visit_octave_user_script (octave_user_script& fcn) -{ - tree_statement_list *cmd_list = fcn.body (); - - if (cmd_list) - cmd_list->accept (*this); -} - -void -tree_checker::visit_octave_user_function (octave_user_function& fcn) -{ - tree_statement_list *cmd_list = fcn.body (); - - if (cmd_list) - cmd_list->accept (*this); -} - -void -tree_checker::visit_function_def (tree_function_def& fdef) -{ - octave_value fcn = fdef.function (); - - octave_function *f = fcn.function_value (); - - if (f) - f->accept (*this); -} - -void -tree_checker::visit_identifier (tree_identifier& /* id */) -{ -} - -void -tree_checker::visit_if_clause (tree_if_clause& cmd) -{ - tree_expression *expr = cmd.condition (); - - if (expr) - expr->accept (*this); - - tree_statement_list *list = cmd.commands (); - - if (list) - list->accept (*this); -} - -void -tree_checker::visit_if_command (tree_if_command& cmd) -{ - tree_if_command_list *list = cmd.cmd_list (); - - if (list) - list->accept (*this); -} - -void -tree_checker::visit_if_command_list (tree_if_command_list& lst) -{ - tree_if_command_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_if_clause *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_checker::visit_index_expression (tree_index_expression& expr) -{ - tree_expression *e = expr.expression (); - - if (e) - e->accept (*this); - - std::list lst = expr.arg_lists (); - - std::list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_argument_list *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_checker::visit_matrix (tree_matrix& lst) -{ - tree_matrix::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_argument_list *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_checker::visit_cell (tree_cell& lst) -{ - tree_matrix::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_argument_list *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_checker::visit_multi_assignment (tree_multi_assignment& expr) -{ - tree_argument_list *lhs = expr.left_hand_side (); - - if (lhs) - { - do_lvalue_check = true; - - lhs->accept (*this); - - do_lvalue_check = false; - } - - tree_expression *rhs = expr.right_hand_side (); - - if (rhs) - rhs->accept (*this); -} - -void -tree_checker::visit_no_op_command (tree_no_op_command& /* cmd */) -{ -} - -void -tree_checker::visit_anon_fcn_handle (tree_anon_fcn_handle& /* afh */) -{ -} - -void -tree_checker::visit_constant (tree_constant& /* val */) -{ -} - -void -tree_checker::visit_fcn_handle (tree_fcn_handle& /* fh */) -{ -} - -void -tree_checker::visit_parameter_list (tree_parameter_list& lst) -{ - tree_parameter_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_decl_elt *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_checker::visit_postfix_expression (tree_postfix_expression& expr) -{ - tree_expression *e = expr.operand (); - - if (e) - e->accept (*this); -} - -void -tree_checker::visit_prefix_expression (tree_prefix_expression& expr) -{ - tree_expression *e = expr.operand (); - - if (e) - e->accept (*this); -} - -void -tree_checker::visit_return_command (tree_return_command&) -{ -} - -void -tree_checker::visit_return_list (tree_return_list& lst) -{ - tree_return_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_index_expression *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_checker::visit_simple_assignment (tree_simple_assignment& expr) -{ - tree_expression *lhs = expr.left_hand_side (); - - if (lhs) - { - if (! lhs->lvalue_ok ()) - gripe ("invalid lvalue in assignment", expr.line ()); - } - - tree_expression *rhs = expr.right_hand_side (); - - if (rhs) - rhs->accept (*this); -} - -void -tree_checker::visit_statement (tree_statement& stmt) -{ - tree_command *cmd = stmt.command (); - - if (cmd) - cmd->accept (*this); - else - { - tree_expression *expr = stmt.expression (); - - if (expr) - expr->accept (*this); - } -} - -void -tree_checker::visit_statement_list (tree_statement_list& lst) -{ - for (tree_statement_list::iterator p = lst.begin (); p != lst.end (); p++) - { - tree_statement *elt = *p; - - if (elt) - elt->accept (*this); - } -} - -void -tree_checker::visit_switch_case (tree_switch_case& cs) -{ - tree_expression *label = cs.case_label (); - - if (label) - label->accept (*this); - - tree_statement_list *list = cs.commands (); - - if (list) - list->accept (*this); -} - -void -tree_checker::visit_switch_case_list (tree_switch_case_list& lst) -{ - tree_switch_case_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_switch_case *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_checker::visit_switch_command (tree_switch_command& cmd) -{ - tree_expression *expr = cmd.switch_value (); - - if (expr) - expr->accept (*this); - - tree_switch_case_list *list = cmd.case_list (); - - if (list) - list->accept (*this); -} - -void -tree_checker::visit_try_catch_command (tree_try_catch_command& cmd) -{ - tree_statement_list *try_code = cmd.body (); - - if (try_code) - try_code->accept (*this); - - tree_statement_list *catch_code = cmd.cleanup (); - - if (catch_code) - catch_code->accept (*this); -} - -void -tree_checker::visit_unwind_protect_command - (tree_unwind_protect_command& cmd) -{ - tree_statement_list *unwind_protect_code = cmd.body (); - - if (unwind_protect_code) - unwind_protect_code->accept (*this); - - tree_statement_list *cleanup_code = cmd.cleanup (); - - if (cleanup_code) - cleanup_code->accept (*this); -} - -void -tree_checker::visit_while_command (tree_while_command& cmd) -{ - tree_expression *expr = cmd.condition (); - - if (expr) - expr->accept (*this); - - tree_statement_list *list = cmd.body (); - - if (list) - list->accept (*this); -} - -void -tree_checker::visit_do_until_command (tree_do_until_command& cmd) -{ - tree_statement_list *list = cmd.body (); - - if (list) - list->accept (*this); - - tree_expression *expr = cmd.condition (); - - if (expr) - expr->accept (*this); -} - -void -tree_checker::gripe (const std::string& msg, int line) -{ - if (curr_fcn_file_name.empty ()) - error ("%s", msg.c_str ()); - else - error ("%s: %d: %s", curr_fcn_file_name.c_str (), line, msg.c_str ()); -} diff -r d02b229ce693 -r a132d206a36a src/pt-check.h --- a/src/pt-check.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,139 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_checker_h) -#define octave_tree_checker_h 1 - -#include "pt-walk.h" - -class tree_decl_command; - -// How to check the semantics of the code that the parse trees represent. - -class -tree_checker : public tree_walker -{ -public: - - tree_checker (void) - : do_lvalue_check (false) { } - - ~tree_checker (void) { } - - void visit_argument_list (tree_argument_list&); - - void visit_binary_expression (tree_binary_expression&); - - void visit_break_command (tree_break_command&); - - void visit_colon_expression (tree_colon_expression&); - - void visit_continue_command(tree_continue_command&); - - void visit_global_command (tree_global_command&); - - void visit_persistent_command (tree_persistent_command&); - - void visit_decl_elt (tree_decl_elt&); - - void visit_decl_init_list (tree_decl_init_list&); - - void visit_simple_for_command (tree_simple_for_command&); - - void visit_complex_for_command (tree_complex_for_command&); - - void visit_octave_user_script (octave_user_script&); - - void visit_octave_user_function (octave_user_function&); - - void visit_function_def (tree_function_def&); - - void visit_identifier (tree_identifier&); - - void visit_if_clause (tree_if_clause&); - - void visit_if_command (tree_if_command&); - - void visit_if_command_list (tree_if_command_list&); - - void visit_index_expression (tree_index_expression&); - - void visit_matrix (tree_matrix&); - - void visit_cell (tree_cell&); - - void visit_multi_assignment (tree_multi_assignment&); - - void visit_no_op_command (tree_no_op_command&); - - void visit_anon_fcn_handle (tree_anon_fcn_handle&); - - void visit_constant (tree_constant&); - - void visit_fcn_handle (tree_fcn_handle&); - - void visit_parameter_list (tree_parameter_list&); - - void visit_postfix_expression (tree_postfix_expression&); - - void visit_prefix_expression (tree_prefix_expression&); - - void visit_return_command (tree_return_command&); - - void visit_return_list (tree_return_list&); - - void visit_simple_assignment (tree_simple_assignment&); - - void visit_statement (tree_statement&); - - void visit_statement_list (tree_statement_list&); - - void visit_switch_case (tree_switch_case&); - - void visit_switch_case_list (tree_switch_case_list&); - - void visit_switch_command (tree_switch_command&); - - void visit_try_catch_command (tree_try_catch_command&); - - void visit_unwind_protect_command (tree_unwind_protect_command&); - - void visit_while_command (tree_while_command&); - - void visit_do_until_command (tree_do_until_command&); - -private: - - bool do_lvalue_check; - - void do_decl_command (tree_decl_command&); - - void gripe (const std::string& msg, int line); - - // No copying! - - tree_checker (const tree_checker&); - - tree_checker& operator = (const tree_checker&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-cmd.cc --- a/src/pt-cmd.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,58 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "pt-cmd.h" -#include "pt-walk.h" - -// No-op. - -tree_command * -tree_no_op_command::dup (symbol_table::scope_id, - symbol_table::context_id) const -{ - return new tree_no_op_command (orig_cmd, line (), column ()); -} - -void -tree_no_op_command::accept (tree_walker& tw) -{ - tw.visit_no_op_command (*this); -} - -// Function definition. - -tree_command * -tree_function_def::dup (symbol_table::scope_id, - symbol_table::context_id) const -{ - return new tree_function_def (fcn, line (), column ()); -} - -void -tree_function_def::accept (tree_walker& tw) -{ - tw.visit_function_def (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-cmd.h --- a/src/pt-cmd.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,127 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_cmd_h) -#define octave_tree_cmd_h 1 - -#include - -class tree_walker; - -#include "ov-fcn.h" -#include "pt.h" -#include "pt-bp.h" -#include "symtab.h" - -// A base class for commands. - -class -tree_command : public tree -{ -public: - - tree_command (int l = -1, int c = -1) - : tree (l, c) { } - - virtual ~tree_command (void) { } - - virtual tree_command *dup (symbol_table::scope_id, - symbol_table::context_id context) const = 0; - -private: - - // No copying! - - tree_command (const tree_command&); - - tree_command& operator = (const tree_command&); -}; - -// No-op. - -class -tree_no_op_command : public tree_command -{ -public: - - tree_no_op_command (const std::string& cmd = "no_op", int l = -1, int c = -1) - : tree_command (l, c), eof (cmd == "endfunction" || cmd == "endscript"), - orig_cmd (cmd) { } - - ~tree_no_op_command (void) { } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - - bool is_end_of_fcn_or_script (void) const { return eof; } - - std::string original_command (void) { return orig_cmd; } - -private: - - bool eof; - - std::string orig_cmd; - - // No copying! - - tree_no_op_command (const tree_no_op_command&); - - tree_no_op_command& operator = (const tree_no_op_command&); -}; - -// Function definition. - -class -tree_function_def : public tree_command -{ -public: - - tree_function_def (octave_function *f, int l = -1, int c = -1) - : tree_command (l, c), fcn (f) { } - - ~tree_function_def (void) { } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - - octave_value function (void) { return fcn; } - -private: - - octave_value fcn; - - tree_function_def (const octave_value& v, int l = -1, int c = -1) - : tree_command (l, c), fcn (v) { } - - // No copying! - - tree_function_def (const tree_function_def&); - - tree_function_def& operator = (const tree_function_def&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-colon.cc --- a/src/pt-colon.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,285 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "oct-obj.h" -#include "pager.h" -#include "ov.h" -#include "pt-bp.h" -#include "pt-colon.h" -#include "pt-walk.h" - -// Colon expressions. - -tree_colon_expression * -tree_colon_expression::append (tree_expression *t) -{ - tree_colon_expression *retval = 0; - - if (op_base) - { - if (op_limit) - { - if (op_increment) - ::error ("invalid colon expression"); - else - { - // Stupid syntax: - // - // base : limit - // base : increment : limit - - op_increment = op_limit; - op_limit = t; - } - } - else - op_limit = t; - - retval = this; - } - else - ::error ("invalid colon expression"); - - return retval; -} - -octave_value_list -tree_colon_expression::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("invalid number of output arguments for colon expression"); - else - retval = rvalue1 (nargout); - - return retval; -} - -octave_value -tree_colon_expression::make_range (const Matrix& m_base, - const Matrix& m_limit, - const Matrix& m_increment, - bool result_is_str, bool dq_str) const -{ - octave_value retval; - - bool base_empty = m_base.is_empty (); - bool limit_empty = m_limit.is_empty (); - bool increment_empty = m_increment.is_empty (); - - if (base_empty || limit_empty || increment_empty) - retval = Range (); - else - { - retval = Range (m_base(0), m_limit(0), m_increment(0)); - - if (result_is_str) - retval = retval.convert_to_str (false, true, dq_str ? '"' : '\''); - } - - return retval; -} - -octave_value -tree_colon_expression::make_range (const octave_value& ov_base, - const octave_value& ov_limit, - const octave_value& ov_increment) const -{ - octave_value retval; - - if (ov_base.is_object () || ov_limit.is_object () || - ov_increment.is_object ()) - { - octave_value_list tmp1; - tmp1(2) = ov_limit; - tmp1(1) = ov_increment; - tmp1(0) = ov_base; - - octave_value fcn = symbol_table::find_function ("colon", tmp1); - - if (fcn.is_defined ()) - { - octave_value_list tmp2 = fcn.do_multi_index_op (1, tmp1); - - if (! error_state) - retval = tmp2 (0); - } - else - ::error ("can not find overloaded colon function"); - } - else - { - bool result_is_str = (ov_base.is_string () && ov_limit.is_string ()); - bool dq_str = (ov_base.is_dq_string () || ov_limit.is_dq_string ()); - - Matrix m_base = ov_base.matrix_value (true); - - if (error_state) - eval_error ("invalid base value in colon expression"); - else - { - Matrix m_limit = ov_limit.matrix_value (true); - - if (error_state) - eval_error ("invalid limit value in colon expression"); - else - { - Matrix m_increment = ov_increment.matrix_value (true); - - if (error_state) - eval_error ("invalid increment value in colon expression"); - else - retval = make_range (m_base, m_limit, m_increment, - result_is_str, dq_str); - } - } - } - - return retval; -} - -octave_value -tree_colon_expression::rvalue1 (int) -{ - octave_value retval; - - if (error_state || ! op_base || ! op_limit) - return retval; - - octave_value ov_base = op_base->rvalue1 (); - - if (error_state || ov_base.is_undefined ()) - eval_error ("invalid base value in colon expression"); - else - { - octave_value ov_limit = op_limit->rvalue1 (); - - if (error_state || ov_limit.is_undefined ()) - eval_error ("invalid limit value in colon expression"); - else if (ov_base.is_object () || ov_limit.is_object ()) - { - octave_value_list tmp1; - - if (op_increment) - { - octave_value ov_increment = op_increment->rvalue1 (); - - if (error_state || ov_increment.is_undefined ()) - eval_error ("invalid increment value in colon expression"); - else - { - tmp1(2) = ov_limit; - tmp1(1) = ov_increment; - tmp1(0) = ov_base; - } - } - else - { - tmp1(1) = ov_limit; - tmp1(0) = ov_base; - } - - if (!error_state) - { - octave_value fcn = symbol_table::find_function ("colon", tmp1); - - if (fcn.is_defined ()) - { - octave_value_list tmp2 = fcn.do_multi_index_op (1, tmp1); - - if (! error_state) - retval = tmp2 (0); - } - else - ::error ("can not find overloaded colon function"); - } - } - else - { - octave_value ov_increment = 1.0; - - if (op_increment) - { - ov_increment = op_increment->rvalue1 (); - - if (error_state || ov_increment.is_undefined ()) - eval_error ("invalid increment value in colon expression"); - } - - if (! error_state) - retval = make_range (ov_base, ov_limit, ov_increment); - } - } - - return retval; -} - -void -tree_colon_expression::eval_error (const std::string& s) const -{ - ::error ("%s", s.c_str ()); -} - -int -tree_colon_expression::line (void) const -{ - return (op_base ? op_base->line () - : (op_increment ? op_increment->line () - : (op_limit ? op_limit->line () - : -1))); -} - -int -tree_colon_expression::column (void) const -{ - return (op_base ? op_base->column () - : (op_increment ? op_increment->column () - : (op_limit ? op_limit->column () - : -1))); -} - -tree_expression * -tree_colon_expression::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_colon_expression *new_ce = new - tree_colon_expression (op_base ? op_base->dup (scope, context) : 0, - op_limit ? op_limit->dup (scope, context) : 0, - op_increment ? op_increment->dup (scope, context) : 0, - line (), column ()); - - new_ce->copy_base (*new_ce); - - return new_ce; -} - -void -tree_colon_expression::accept (tree_walker& tw) -{ - tw.visit_colon_expression (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-colon.h --- a/src/pt-colon.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,124 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_colon_h) -#define octave_tree_colon 1 - -#include - -class tree_walker; - -class octave_value; -class octave_value_list; -class octave_lvalue; - -#include "pt-exp.h" -#include "symtab.h" - -// Colon expressions. - -class -tree_colon_expression : public tree_expression -{ -public: - - tree_colon_expression (int l = -1, int c = -1) - : tree_expression (l, c), op_base (0), op_limit (0), - op_increment (0), save_base (false) { } - - tree_colon_expression (tree_expression *e, int l = -1, int c = -1) - : tree_expression (l, c), op_base (e), op_limit (0), - op_increment (0), save_base (false) { } - - tree_colon_expression (tree_expression *bas, tree_expression *lim, - tree_expression *inc, int l = -1, int c = -1) - : tree_expression (l, c), op_base (bas), op_limit (lim), - op_increment (inc), save_base (false) { } - - ~tree_colon_expression (void) - { - if (! save_base) - delete op_base; - - delete op_limit; - delete op_increment; - } - - bool has_magic_end (void) const - { - return ((op_base && op_base->has_magic_end ()) - || (op_limit && op_limit->has_magic_end ()) - || (op_increment && op_increment->has_magic_end ())); - } - - void preserve_base (void) { save_base = true; } - - tree_colon_expression *append (tree_expression *t); - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - void eval_error (const std::string& s) const; - - tree_expression *base (void) { return op_base; } - - tree_expression *limit (void) { return op_limit; } - - tree_expression *increment (void) { return op_increment; } - - int line (void) const; - int column (void) const; - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // The components of the expression. - tree_expression *op_base; - tree_expression *op_limit; - tree_expression *op_increment; - - bool save_base; - - octave_value - make_range (const Matrix& m_base, const Matrix& m_limit, - const Matrix& m_increment, bool result_is_str, - bool dq_str) const; - - octave_value - make_range (const octave_value& ov_base, const octave_value& ov_limit, - const octave_value& ov_increment) const; - - // No copying! - - tree_colon_expression (const tree_colon_expression&); - - tree_colon_expression& operator = (const tree_colon_expression&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-const.cc --- a/src/pt-const.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,87 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "error.h" -#include "oct-obj.h" -#include "pager.h" -#include "pt-const.h" -#include "pt-walk.h" - -// We are likely to have a lot of tree_constant objects to allocate, -// so make the grow_size large. -DEFINE_OCTAVE_ALLOCATOR2 (tree_constant, 1024); - -void -tree_constant::print (std::ostream& os, bool pr_as_read_syntax, bool pr_orig_text) -{ - if (pr_orig_text && ! orig_text.empty ()) - os << orig_text; - else - val.print (os, pr_as_read_syntax); -} - -void -tree_constant::print_raw (std::ostream& os, bool pr_as_read_syntax, - bool pr_orig_text) -{ - if (pr_orig_text && ! orig_text.empty ()) - os << orig_text; - else - val.print_raw (os, pr_as_read_syntax); -} - -octave_value_list -tree_constant::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("invalid number of output arguments for constant expression"); - else - retval = rvalue1 (nargout); - - return retval; -} - -tree_expression * -tree_constant::dup (symbol_table::scope_id, - symbol_table::context_id) const -{ - tree_constant *new_tc - = new tree_constant (val, orig_text, line (), column ()); - - new_tc->copy_base (*this); - - return new_tc; -} - -void -tree_constant::accept (tree_walker& tw) -{ - tw.visit_constant (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-const.h --- a/src/pt-const.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,105 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_const_h) -#define octave_tree_const_h 1 - -#include -#include - -#include "oct-alloc.h" - -class octave_value_list; -class tree_walker; - -#include "ov.h" -#include "pt-bp.h" -#include "pt-exp.h" -#include "symtab.h" - -class -tree_constant : public tree_expression -{ -public: - - tree_constant (int l = -1, int c = -1) - : tree_expression (l, c), val (), orig_text () { } - - tree_constant (const octave_value& v, int l = -1, int c = -1) - : tree_expression (l, c), val (v), orig_text () { } - - tree_constant (const octave_value& v, const std::string& ot, - int l = -1, int c = -1) - : tree_expression (l, c), val (v), orig_text (ot) { } - - ~tree_constant (void) { } - - bool has_magic_end (void) const { return false; } - - // Type. It would be nice to eliminate the need for this. - - bool is_constant (void) const { return true; } - - void maybe_mutate (void) { val.maybe_mutate (); } - - void print (std::ostream& os, bool pr_as_read_syntax = false, - bool pr_orig_txt = true); - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false, - bool pr_orig_txt = true); - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int = 1) { return val; } - - octave_value_list rvalue (int nargout); - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - - // Store the original text corresponding to this constant for later - // pretty printing. - - void stash_original_text (const std::string& s) { orig_text = s; } - - std::string original_text (void) const { return orig_text; } - -private: - - // The actual value that this constant refers to. - octave_value val; - - // The original text form of this constant. - std::string orig_text; - - // No copying! - - tree_constant (const tree_constant&); - - tree_constant& operator = (const tree_constant&); - - DECLARE_OCTAVE_ALLOCATOR -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-decl.cc --- a/src/pt-decl.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,147 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "defun.h" -#include "error.h" -#include "pt-cmd.h" -#include "ov.h" -#include "oct-lvalue.h" -#include "pt-bp.h" -#include "pt-decl.h" -#include "pt-exp.h" -#include "pt-id.h" -#include "pt-walk.h" -#include "utils.h" -#include "variables.h" - -// Declarations (global, static, etc.). - -tree_decl_elt::~tree_decl_elt (void) -{ - delete id; - delete expr; -} - -bool -tree_decl_elt::eval (void) -{ - bool retval = false; - - if (id && expr) - { - octave_lvalue ult = id->lvalue (); - - octave_value init_val = expr->rvalue1 (); - - if (! error_state) - { - ult.assign (octave_value::op_asn_eq, init_val); - - retval = true; - } - } - - return retval; -} - -tree_decl_elt * -tree_decl_elt::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return new tree_decl_elt (id ? id->dup (scope, context) : 0, - expr ? expr->dup (scope, context) : 0); -} - -void -tree_decl_elt::accept (tree_walker& tw) -{ - tw.visit_decl_elt (*this); -} - -// Initializer lists for declaration statements. - -tree_decl_init_list * -tree_decl_init_list::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_decl_init_list *new_dil = new tree_decl_init_list (); - - for (const_iterator p = begin (); p != end (); p++) - { - const tree_decl_elt *elt = *p; - - new_dil->append (elt ? elt->dup (scope, context) : 0); - } - - return new_dil; -} - -void -tree_decl_init_list::accept (tree_walker& tw) -{ - tw.visit_decl_init_list (*this); -} - -// Base class for declaration commands (global, static). - -tree_decl_command::~tree_decl_command (void) -{ - delete init_list; -} - -// Global. - -tree_command * -tree_global_command::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return - new tree_global_command (init_list ? init_list->dup (scope, context) : 0, - line (), column ()); -} - -void -tree_global_command::accept (tree_walker& tw) -{ - tw.visit_global_command (*this); -} - -// Static. - -tree_command * -tree_persistent_command::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return - new tree_persistent_command (init_list ? init_list->dup (scope, context) : 0, - line (), column ()); -} - -void -tree_persistent_command::accept (tree_walker& tw) -{ - tw.visit_persistent_command (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-decl.h --- a/src/pt-decl.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,241 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_decl_h) -#define octave_tree_decl_h 1 - -class tree_expression; -class tree_identifier; - -class tree_walker; - -#include - -#include "base-list.h" -#include "oct-lvalue.h" -#include "pt-cmd.h" -#include "pt-id.h" -#include "symtab.h" - -// List of expressions that make up a declaration statement. - -class -tree_decl_elt -{ -public: - - tree_decl_elt (tree_identifier *i = 0, tree_expression *e = 0) - : id (i), expr (e) { } - - ~tree_decl_elt (void); - - bool eval (void); - - bool is_defined (void) { return id ? id->is_defined () : false; } - - bool is_variable (void) { return id ? id->is_variable () : false; } - - void mark_as_formal_parameter (void) - { - if (id) - id->mark_as_formal_parameter (); - } - - bool lvalue_ok (void) { return id ? id->lvalue_ok () : false; } - - // Do not allow functions to return null values. - octave_value rvalue1 (int nargout = 1) - { - return id ? id->rvalue1 (nargout).storable_value () : octave_value (); - } - - octave_value_list rvalue (int nargout) - { - octave_value_list retval; - - if (nargout > 1) - error ("invalid number of output arguments in declaration list"); - else - retval = rvalue1 (nargout); - - return retval; - } - - octave_lvalue lvalue (void) { return id ? id->lvalue () : octave_lvalue (); } - - tree_identifier *ident (void) { return id; } - - tree_expression *expression (void) { return expr; } - - tree_decl_elt *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // An identifier to tag with the declared property. - tree_identifier *id; - - // An initializer expression (may be zero); - tree_expression *expr; - - // No copying! - - tree_decl_elt (const tree_decl_elt&); - - tree_decl_elt& operator = (const tree_decl_elt&); -}; - -class -tree_decl_init_list : public octave_base_list -{ -public: - - tree_decl_init_list (void) { } - - tree_decl_init_list (tree_decl_elt *t) { append (t); } - - ~tree_decl_init_list (void) - { - while (! empty ()) - { - iterator p = begin (); - delete *p; - erase (p); - } - } - - tree_decl_init_list *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // No copying! - - tree_decl_init_list (const tree_decl_init_list&); - - tree_decl_init_list& operator = (const tree_decl_init_list&); -}; - -// Base class for declaration commands -- global, static, etc. - -class -tree_decl_command : public tree_command -{ -public: - - tree_decl_command (const std::string& n, int l = -1, int c = -1) - : tree_command (l, c), cmd_name (n), init_list (0) { } - - tree_decl_command (const std::string& n, tree_decl_init_list *t, - int l = -1, int c = -1) - : tree_command (l, c), cmd_name (n), init_list (t) { } - - ~tree_decl_command (void); - - tree_decl_init_list *initializer_list (void) { return init_list; } - - std::string name (void) { return cmd_name; } - -protected: - - // The name of this command -- global, static, etc. - std::string cmd_name; - - // The list of variables or initializers in this declaration command. - tree_decl_init_list *init_list; - -private: - - // No copying! - - tree_decl_command (const tree_decl_command&); - - tree_decl_command& operator = (const tree_decl_command&); -}; - -// Global. - -class -tree_global_command : public tree_decl_command -{ -public: - - tree_global_command (int l = -1, int c = -1) - : tree_decl_command ("global", l, c) { } - - tree_global_command (tree_decl_init_list *t, int l = -1, int c = -1) - : tree_decl_command ("global", t, l, c) { } - - ~tree_global_command (void) { } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - static void do_init (tree_decl_elt& elt); - - // No copying! - - tree_global_command (const tree_global_command&); - - tree_global_command& operator = (const tree_global_command&); -}; - -// Persistent. - -class -tree_persistent_command : public tree_decl_command -{ -public: - - tree_persistent_command (int l = -1, int c = -1) - : tree_decl_command ("persistent", l, c) { } - - tree_persistent_command (tree_decl_init_list *t, int l = -1, int c = -1) - : tree_decl_command ("persistent", t, l, c) { } - - ~tree_persistent_command (void) { } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - static void do_init (tree_decl_elt& elt); - - // No copying! - - tree_persistent_command (const tree_persistent_command&); - - tree_persistent_command& operator = (const tree_persistent_command&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-eval.cc --- a/src/pt-eval.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1265 +0,0 @@ -/* - -Copyright (C) 2009-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include -#include - -#include "debug.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "ov-fcn-handle.h" -#include "ov-usr-fcn.h" -#include "variables.h" -#include "pt-all.h" -#include "pt-eval.h" -#include "symtab.h" -#include "unwind-prot.h" - -#if HAVE_LLVM -//FIXME: This should be part of tree_evaluator -#include "pt-jit.h" -static tree_jit jiter; -#endif - -static tree_evaluator std_evaluator; - -tree_evaluator *current_evaluator = &std_evaluator; - -int tree_evaluator::dbstep_flag = 0; - -size_t tree_evaluator::current_frame = 0; - -bool tree_evaluator::debug_mode = false; - -tree_evaluator::stmt_list_type tree_evaluator::statement_context - = tree_evaluator::other; - -bool tree_evaluator::in_loop_command = false; - -// Maximum nesting level for functions, scripts, or sourced files called -// recursively. -int Vmax_recursion_depth = 256; - -// If TRUE, turn off printing of results in functions (as if a -// semicolon has been appended to each statement). -static bool Vsilent_functions = false; - -// Normal evaluator. - -void -tree_evaluator::visit_anon_fcn_handle (tree_anon_fcn_handle&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_argument_list (tree_argument_list&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_binary_expression (tree_binary_expression&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_break_command (tree_break_command& cmd) -{ - if (! error_state) - { - if (debug_mode) - do_breakpoint (cmd.is_breakpoint ()); - - if (statement_context == function || statement_context == script - || in_loop_command) - tree_break_command::breaking = 1; - } -} - -void -tree_evaluator::visit_colon_expression (tree_colon_expression&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_continue_command (tree_continue_command& cmd) -{ - if (! error_state) - { - if (debug_mode) - do_breakpoint (cmd.is_breakpoint ()); - - if (statement_context == function || statement_context == script - || in_loop_command) - tree_continue_command::continuing = 1; - } -} - -void -tree_evaluator::reset_debug_state (void) -{ - debug_mode = bp_table::have_breakpoints () || Vdebugging; - - dbstep_flag = 0; -} - -static inline void -do_global_init (tree_decl_elt& elt) -{ - tree_identifier *id = elt.ident (); - - if (id) - { - id->mark_global (); - - if (! error_state) - { - octave_lvalue ult = id->lvalue (); - - if (ult.is_undefined ()) - { - tree_expression *expr = elt.expression (); - - octave_value init_val; - - if (expr) - init_val = expr->rvalue1 (); - else - init_val = Matrix (); - - ult.assign (octave_value::op_asn_eq, init_val); - } - } - } -} - -static inline void -do_static_init (tree_decl_elt& elt) -{ - tree_identifier *id = elt.ident (); - - if (id) - { - id->mark_as_static (); - - octave_lvalue ult = id->lvalue (); - - if (ult.is_undefined ()) - { - tree_expression *expr = elt.expression (); - - octave_value init_val; - - if (expr) - init_val = expr->rvalue1 (); - else - init_val = Matrix (); - - ult.assign (octave_value::op_asn_eq, init_val); - } - } -} - -void -tree_evaluator::do_decl_init_list (decl_elt_init_fcn fcn, - tree_decl_init_list *init_list) -{ - if (init_list) - { - for (tree_decl_init_list::iterator p = init_list->begin (); - p != init_list->end (); p++) - { - tree_decl_elt *elt = *p; - - fcn (*elt); - - if (error_state) - break; - } - } -} - -void -tree_evaluator::visit_global_command (tree_global_command& cmd) -{ - if (debug_mode) - do_breakpoint (cmd.is_breakpoint ()); - - do_decl_init_list (do_global_init, cmd.initializer_list ()); -} - -void -tree_evaluator::visit_persistent_command (tree_persistent_command& cmd) -{ - if (debug_mode) - do_breakpoint (cmd.is_breakpoint ()); - - do_decl_init_list (do_static_init, cmd.initializer_list ()); -} - -void -tree_evaluator::visit_decl_elt (tree_decl_elt&) -{ - panic_impossible (); -} - -#if 0 -bool -tree_decl_elt::eval (void) -{ - bool retval = false; - - if (id && expr) - { - octave_lvalue ult = id->lvalue (); - - octave_value init_val = expr->rvalue1 (); - - if (! error_state) - { - ult.assign (octave_value::op_asn_eq, init_val); - - retval = true; - } - } - - return retval; -} -#endif - -void -tree_evaluator::visit_decl_init_list (tree_decl_init_list&) -{ - panic_impossible (); -} - -// Decide if it's time to quit a for or while loop. -static inline bool -quit_loop_now (void) -{ - octave_quit (); - - // Maybe handle `continue N' someday... - - if (tree_continue_command::continuing) - tree_continue_command::continuing--; - - bool quit = (error_state - || tree_return_command::returning - || tree_break_command::breaking - || tree_continue_command::continuing); - - if (tree_break_command::breaking) - tree_break_command::breaking--; - - return quit; -} - -void -tree_evaluator::visit_simple_for_command (tree_simple_for_command& cmd) -{ - if (error_state) - return; - - if (debug_mode) - do_breakpoint (cmd.is_breakpoint ()); - - // FIXME -- need to handle PARFOR loops here using cmd.in_parallel () - // and cmd.maxproc_expr (); - - unwind_protect frame; - - frame.protect_var (in_loop_command); - - in_loop_command = true; - - tree_expression *expr = cmd.control_expr (); - - octave_value rhs = expr->rvalue1 (); - -#if HAVE_LLVM - if (jiter.execute (cmd, rhs)) - return; -#endif - - if (error_state || rhs.is_undefined ()) - return; - - { - tree_expression *lhs = cmd.left_hand_side (); - - octave_lvalue ult = lhs->lvalue (); - - if (error_state) - return; - - tree_statement_list *loop_body = cmd.body (); - - if (rhs.is_range ()) - { - Range rng = rhs.range_value (); - - octave_idx_type steps = rng.nelem (); - double b = rng.base (); - double increment = rng.inc (); - - for (octave_idx_type i = 0; i < steps; i++) - { - // Use multiplication here rather than declaring a - // temporary variable outside the loop and using - // - // tmp_val += increment - // - // to avoid problems with limited precision. Also, this - // is consistent with the way Range::matrix_value is - // implemented. - - octave_value val (b + i * increment); - - ult.assign (octave_value::op_asn_eq, val); - - if (! error_state && loop_body) - loop_body->accept (*this); - - if (quit_loop_now ()) - break; - } - } - else if (rhs.is_scalar_type ()) - { - ult.assign (octave_value::op_asn_eq, rhs); - - if (! error_state && loop_body) - loop_body->accept (*this); - - // Maybe decrement break and continue states. - quit_loop_now (); - } - else if (rhs.is_matrix_type () || rhs.is_cell () || rhs.is_string () - || rhs.is_map ()) - { - // A matrix or cell is reshaped to 2 dimensions and iterated by - // columns. - - dim_vector dv = rhs.dims ().redim (2); - - octave_idx_type nrows = dv(0), steps = dv(1); - - if (steps > 0) - { - octave_value arg = rhs; - if (rhs.ndims () > 2) - arg = arg.reshape (dv); - - // for row vectors, use single index to speed things up. - octave_value_list idx; - octave_idx_type iidx; - if (nrows == 1) - { - idx.resize (1); - iidx = 0; - } - else - { - idx.resize (2); - idx(0) = octave_value::magic_colon_t; - iidx = 1; - } - - for (octave_idx_type i = 1; i <= steps; i++) - { - // do_index_op expects one-based indices. - idx(iidx) = i; - octave_value val = arg.do_index_op (idx); - - ult.assign (octave_value::op_asn_eq, val); - - if (! error_state && loop_body) - loop_body->accept (*this); - - if (quit_loop_now ()) - break; - } - } - } - else - { - ::error ("invalid type in for loop expression near line %d, column %d", - cmd.line (), cmd.column ()); - } - } -} - -void -tree_evaluator::visit_complex_for_command (tree_complex_for_command& cmd) -{ - if (error_state) - return; - - if (debug_mode) - do_breakpoint (cmd.is_breakpoint ()); - - unwind_protect frame; - - frame.protect_var (in_loop_command); - - in_loop_command = true; - - tree_expression *expr = cmd.control_expr (); - - octave_value rhs = expr->rvalue1 (); - - if (error_state || rhs.is_undefined ()) - return; - - if (rhs.is_map ()) - { - // Cycle through structure elements. First element of id_list - // is set to value and the second is set to the name of the - // structure element. - - tree_argument_list *lhs = cmd.left_hand_side (); - - tree_argument_list::iterator p = lhs->begin (); - - tree_expression *elt = *p++; - - octave_lvalue val_ref = elt->lvalue (); - - elt = *p; - - octave_lvalue key_ref = elt->lvalue (); - - const octave_map tmp_val = rhs.map_value (); - - tree_statement_list *loop_body = cmd.body (); - - string_vector keys = tmp_val.keys (); - - octave_idx_type nel = keys.numel (); - - for (octave_idx_type i = 0; i < nel; i++) - { - std::string key = keys[i]; - - const Cell val_lst = tmp_val.contents (key); - - octave_idx_type n = val_lst.numel (); - - octave_value val = (n == 1) ? val_lst(0) : octave_value (val_lst); - - val_ref.assign (octave_value::op_asn_eq, val); - key_ref.assign (octave_value::op_asn_eq, key); - - if (! error_state && loop_body) - loop_body->accept (*this); - - if (quit_loop_now ()) - break; - } - } - else - error ("in statement `for [X, Y] = VAL', VAL must be a structure"); -} - -void -tree_evaluator::visit_octave_user_script (octave_user_script&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_octave_user_function (octave_user_function&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_octave_user_function_header (octave_user_function&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_octave_user_function_trailer (octave_user_function&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_function_def (tree_function_def& cmd) -{ - octave_value fcn = cmd.function (); - - octave_function *f = fcn.function_value (); - - if (f) - { - std::string nm = f->name (); - - symbol_table::install_cmdline_function (nm, fcn); - - // Make sure that any variable with the same name as the new - // function is cleared. - - symbol_table::varref (nm) = octave_value (); - } -} - -void -tree_evaluator::visit_identifier (tree_identifier&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_if_clause (tree_if_clause&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_if_command (tree_if_command& cmd) -{ - if (debug_mode) - do_breakpoint (cmd.is_breakpoint ()); - - tree_if_command_list *lst = cmd.cmd_list (); - - if (lst) - lst->accept (*this); -} - -void -tree_evaluator::visit_if_command_list (tree_if_command_list& lst) -{ - for (tree_if_command_list::iterator p = lst.begin (); p != lst.end (); p++) - { - tree_if_clause *tic = *p; - - tree_expression *expr = tic->condition (); - - if (debug_mode && ! tic->is_else_clause ()) - do_breakpoint (tic->is_breakpoint ()); - - if (tic->is_else_clause () || expr->is_logically_true ("if")) - { - if (! error_state) - { - tree_statement_list *stmt_lst = tic->commands (); - - if (stmt_lst) - stmt_lst->accept (*this); - } - - break; - } - } -} - -void -tree_evaluator::visit_index_expression (tree_index_expression&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_matrix (tree_matrix&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_cell (tree_cell&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_multi_assignment (tree_multi_assignment&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_no_op_command (tree_no_op_command& cmd) -{ - if (debug_mode && cmd.is_end_of_fcn_or_script ()) - do_breakpoint (cmd.is_breakpoint (), true); -} - -void -tree_evaluator::visit_constant (tree_constant&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_fcn_handle (tree_fcn_handle&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_parameter_list (tree_parameter_list&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_postfix_expression (tree_postfix_expression&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_prefix_expression (tree_prefix_expression&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_return_command (tree_return_command& cmd) -{ - if (! error_state) - { - if (debug_mode) - do_breakpoint (cmd.is_breakpoint ()); - - // Act like dbcont. - - if (Vdebugging - && octave_call_stack::current_frame () == current_frame) - { - Vdebugging = false; - - reset_debug_state (); - } - else if (statement_context == function || statement_context == script - || in_loop_command) - tree_return_command::returning = 1; - } -} - -void -tree_evaluator::visit_return_list (tree_return_list&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_simple_assignment (tree_simple_assignment&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_statement (tree_statement& stmt) -{ - tree_command *cmd = stmt.command (); - tree_expression *expr = stmt.expression (); - - if (cmd || expr) - { - if (statement_context == function || statement_context == script) - { - // Skip commands issued at a debug> prompt to avoid disturbing - // the state of the program we are debugging. - - if (! Vdebugging) - octave_call_stack::set_statement (&stmt); - - // FIXME -- we need to distinguish functions from scripts to - // get this right. - if ((statement_context == script - && ((Vecho_executing_commands & ECHO_SCRIPTS) - || (Vecho_executing_commands & ECHO_FUNCTIONS))) - || (statement_context == function - && (Vecho_executing_commands & ECHO_FUNCTIONS))) - stmt.echo_code (); - } - - try - { - if (cmd) - cmd->accept (*this); - else - { - if (debug_mode) - do_breakpoint (expr->is_breakpoint ()); - - if ((statement_context == function || statement_context == script) - && Vsilent_functions) - expr->set_print_flag (false); - - // FIXME -- maybe all of this should be packaged in - // one virtual function that returns a flag saying whether - // or not the expression will take care of binding ans and - // printing the result. - - // FIXME -- it seems that we should just have to - // call expr->rvalue1 () and that should take care of - // everything, binding ans as necessary? - - bool do_bind_ans = false; - - if (expr->is_identifier ()) - { - tree_identifier *id = dynamic_cast (expr); - - do_bind_ans = (! id->is_variable ()); - } - else - do_bind_ans = (! expr->is_assignment_expression ()); - - octave_value tmp_result = expr->rvalue1 (0); - - if (do_bind_ans && ! (error_state || tmp_result.is_undefined ())) - bind_ans (tmp_result, expr->print_result ()); - - // if (tmp_result.is_defined ()) - // result_values(0) = tmp_result; - } - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); - } - } -} - -void -tree_evaluator::visit_statement_list (tree_statement_list& lst) -{ - static octave_value_list empty_list; - - if (error_state) - return; - - tree_statement_list::iterator p = lst.begin (); - - if (p != lst.end ()) - { - while (true) - { - tree_statement *elt = *p++; - - if (elt) - { - octave_quit (); - - elt->accept (*this); - - if (error_state) - break; - - if (tree_break_command::breaking - || tree_continue_command::continuing) - break; - - if (tree_return_command::returning) - break; - - if (p == lst.end ()) - break; - else - { - // Clear preivous values before next statement is - // evaluated so that we aren't holding an extra - // reference to a value that may be used next. For - // example, in code like this: - // - // X = rand (N); ## refcount for X should be 1 - // ## after this statement - // - // X(idx) = val; ## no extra copy of X should be - // ## needed, but we will be faked - // ## out if retval is not cleared - // ## between statements here - - // result_values = empty_list; - } - } - else - error ("invalid statement found in statement list!"); - } - } -} - -void -tree_evaluator::visit_switch_case (tree_switch_case&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_switch_case_list (tree_switch_case_list&) -{ - panic_impossible (); -} - -void -tree_evaluator::visit_switch_command (tree_switch_command& cmd) -{ - if (debug_mode) - do_breakpoint (cmd.is_breakpoint ()); - - tree_expression *expr = cmd.switch_value (); - - if (expr) - { - octave_value val = expr->rvalue1 (); - - tree_switch_case_list *lst = cmd.case_list (); - - if (! error_state && lst) - { - for (tree_switch_case_list::iterator p = lst->begin (); - p != lst->end (); p++) - { - tree_switch_case *t = *p; - - if (debug_mode && ! t->is_default_case ()) - do_breakpoint (t->is_breakpoint ()); - - if (t->is_default_case () || t->label_matches (val)) - { - if (error_state) - break; - - tree_statement_list *stmt_lst = t->commands (); - - if (stmt_lst) - stmt_lst->accept (*this); - - break; - } - } - } - } - else - ::error ("missing value in switch command near line %d, column %d", - cmd.line (), cmd.column ()); -} - -void -tree_evaluator::visit_try_catch_command (tree_try_catch_command& cmd) -{ - unwind_protect frame; - - frame.protect_var (buffer_error_messages); - frame.protect_var (Vdebug_on_error); - frame.protect_var (Vdebug_on_warning); - - buffer_error_messages++; - Vdebug_on_error = false; - Vdebug_on_warning = false; - - tree_statement_list *catch_code = cmd.cleanup (); - - // The catch code is *not* added to unwind_protect stack; it doesn't need - // to be run on interrupts. - - tree_statement_list *try_code = cmd.body (); - - if (try_code) - { - try_code->accept (*this); - // FIXME: should std::bad_alloc be handled here? - } - - if (error_state) - { - error_state = 0; - - if (catch_code) - { - // Set up for letting the user print any messages from errors that - // occurred in the body of the try_catch statement. - - buffer_error_messages--; - - if (catch_code) - catch_code->accept (*this); - } - } -} - -void -tree_evaluator::do_unwind_protect_cleanup_code (tree_statement_list *list) -{ - unwind_protect frame; - - frame.protect_var (octave_interrupt_state); - octave_interrupt_state = 0; - - // We want to run the cleanup code without error_state being set, - // but we need to restore its value, so that any errors encountered - // in the first part of the unwind_protect are not completely - // ignored. - - frame.protect_var (error_state); - error_state = 0; - - // We want to preserve the last statement indicator for possible - // backtracking. - frame.add_fcn (octave_call_stack::set_statement, - octave_call_stack::current_statement ()); - - // Similarly, if we have seen a return or break statement, allow all - // the cleanup code to run before returning or handling the break. - // We don't have to worry about continue statements because they can - // only occur in loops. - - frame.protect_var (tree_return_command::returning); - tree_return_command::returning = 0; - - frame.protect_var (tree_break_command::breaking); - tree_break_command::breaking = 0; - - if (list) - list->accept (*this); - - // The unwind_protects are popped off the stack in the reverse of - // the order they are pushed on. - - // FIXME -- these statements say that if we see a break or - // return statement in the cleanup block, that we want to use the - // new value of the breaking or returning flag instead of restoring - // the previous value. Is that the right thing to do? I think so. - // Consider the case of - // - // function foo () - // unwind_protect - // stderr << "1: this should always be executed\n"; - // break; - // stderr << "1: this should never be executed\n"; - // unwind_protect_cleanup - // stderr << "2: this should always be executed\n"; - // return; - // stderr << "2: this should never be executed\n"; - // end_unwind_protect - // endfunction - // - // If we reset the value of the breaking flag, both the returning - // flag and the breaking flag will be set, and we shouldn't have - // both. So, use the most recent one. If there is no return or - // break in the cleanup block, the values should be reset to - // whatever they were when the cleanup block was entered. - - if (tree_break_command::breaking || tree_return_command::returning) - { - frame.discard_top (2); - } - else - { - frame.run_top (2); - } - - // We don't want to ignore errors that occur in the cleanup code, so - // if an error is encountered there, leave error_state alone. - // Otherwise, set it back to what it was before. - - if (error_state) - frame.discard_top (2); - else - frame.run_top (2); - - frame.run (); -} - -void -tree_evaluator::visit_unwind_protect_command (tree_unwind_protect_command& cmd) -{ - tree_statement_list *cleanup_code = cmd.cleanup (); - - tree_statement_list *unwind_protect_code = cmd.body (); - - if (unwind_protect_code) - { - try - { - unwind_protect_code->accept (*this); - } - catch (...) - { - // Run the cleanup code on exceptions, so that it is run even in case - // of interrupt or out-of-memory. - do_unwind_protect_cleanup_code (cleanup_code); - // FIXME: should error_state be checked here? - // We want to rethrow the exception, even if error_state is set, so - // that interrupts continue. - throw; - } - - do_unwind_protect_cleanup_code (cleanup_code); - } -} - -void -tree_evaluator::visit_while_command (tree_while_command& cmd) -{ - if (error_state) - return; - -#if HAVE_LLVM - if (jiter.execute (cmd)) - return; -#endif - - unwind_protect frame; - - frame.protect_var (in_loop_command); - - in_loop_command = true; - - tree_expression *expr = cmd.condition (); - - if (! expr) - panic_impossible (); - - for (;;) - { - if (debug_mode) - do_breakpoint (cmd.is_breakpoint ()); - - if (expr->is_logically_true ("while")) - { - tree_statement_list *loop_body = cmd.body (); - - if (loop_body) - { - loop_body->accept (*this); - - if (error_state) - return; - } - - if (quit_loop_now ()) - break; - } - else - break; - } -} - -void -tree_evaluator::visit_do_until_command (tree_do_until_command& cmd) -{ - if (error_state) - return; - - unwind_protect frame; - - frame.protect_var (in_loop_command); - - in_loop_command = true; - - tree_expression *expr = cmd.condition (); - - if (! expr) - panic_impossible (); - - for (;;) - { - tree_statement_list *loop_body = cmd.body (); - - if (loop_body) - { - loop_body->accept (*this); - - if (error_state) - return; - } - - if (quit_loop_now ()) - break; - - if (debug_mode) - do_breakpoint (cmd.is_breakpoint ()); - - if (expr->is_logically_true ("do-until")) - break; - } -} - -void -tree_evaluator::do_breakpoint (tree_statement& stmt) const -{ - do_breakpoint (stmt.is_breakpoint (), stmt.is_end_of_fcn_or_script ()); -} - -void -tree_evaluator::do_breakpoint (bool is_breakpoint, - bool is_end_of_fcn_or_script) const -{ - bool break_on_this_statement = false; - - // Don't decrement break flag unless we are in the same frame as we - // were when we saw the "dbstep N" command. - - if (dbstep_flag > 1) - { - if (octave_call_stack::current_frame () == current_frame) - { - // Don't allow dbstep N to step past end of current frame. - - if (is_end_of_fcn_or_script) - dbstep_flag = 1; - else - dbstep_flag--; - } - } - - if (octave_debug_on_interrupt_state) - { - break_on_this_statement = true; - - octave_debug_on_interrupt_state = false; - - current_frame = octave_call_stack::current_frame (); - } - else if (is_breakpoint) - { - break_on_this_statement = true; - - dbstep_flag = 0; - - current_frame = octave_call_stack::current_frame (); - } - else if (dbstep_flag == 1) - { - if (octave_call_stack::current_frame () == current_frame) - { - // We get here if we are doing a "dbstep" or a "dbstep N" - // and the count has reached 1 and we are in the current - // debugging frame. - - break_on_this_statement = true; - - dbstep_flag = 0; - } - } - else if (dbstep_flag == -1) - { - // We get here if we are doing a "dbstep in". - - break_on_this_statement = true; - - dbstep_flag = 0; - - current_frame = octave_call_stack::current_frame (); - } - else if (dbstep_flag == -2) - { - // We get here if we are doing a "dbstep out". - - if (is_end_of_fcn_or_script) - dbstep_flag = -1; - } - - if (break_on_this_statement) - do_keyboard (); - -} - -// ARGS is currently unused, but since the do_keyboard function in -// input.cc accepts an argument list, we preserve it here so that the -// interface won't have to change if we decide to use it in the future. - -octave_value -tree_evaluator::do_keyboard (const octave_value_list& args) const -{ - return ::do_keyboard (args); -} - -DEFUN (max_recursion_depth, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} max_recursion_depth ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} max_recursion_depth (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} max_recursion_depth (@var{new_val}, \"local\")\n\ -Query or set the internal limit on the number of times a function may\n\ -be called recursively. If the limit is exceeded, an error message is\n\ -printed and control returns to the top level.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (max_recursion_depth); -} - -/* -%!test -%! orig_val = max_recursion_depth (); -%! old_val = max_recursion_depth (2*orig_val); -%! assert (orig_val, old_val); -%! assert (max_recursion_depth (), 2*orig_val); -%! max_recursion_depth (orig_val); -%! assert (max_recursion_depth (), orig_val); - -%!error (max_recursion_depth (1, 2)) -*/ - -DEFUN (silent_functions, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} silent_functions ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} silent_functions (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} silent_functions (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether internal\n\ -output from a function is suppressed. If this option is disabled,\n\ -Octave will display the results produced by evaluating expressions\n\ -within a function body that are not terminated with a semicolon.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (silent_functions); -} - -/* -%!test -%! orig_val = silent_functions (); -%! old_val = silent_functions (! orig_val); -%! assert (orig_val, old_val); -%! assert (silent_functions (), ! orig_val); -%! silent_functions (orig_val); -%! assert (silent_functions (), orig_val); - -%!error (silent_functions (1, 2)) -*/ diff -r d02b229ce693 -r a132d206a36a src/pt-eval.h --- a/src/pt-eval.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,190 +0,0 @@ -/* - -Copyright (C) 2009-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_eval_h) -#define octave_tree_eval_h 1 - -#include -#include - -#include "comment-list.h" -#include "oct-obj.h" -#include "pt-walk.h" - -class tree_expression; - -// How to evaluate the code that the parse trees represent. - -class -OCTINTERP_API -tree_evaluator : public tree_walker -{ -public: - - typedef void (*decl_elt_init_fcn) (tree_decl_elt&); - - tree_evaluator (void) { } - - ~tree_evaluator (void) { } - - void visit_anon_fcn_handle (tree_anon_fcn_handle&); - - void visit_argument_list (tree_argument_list&); - - void visit_binary_expression (tree_binary_expression&); - - void visit_break_command (tree_break_command&); - - void visit_colon_expression (tree_colon_expression&); - - void visit_continue_command (tree_continue_command&); - - void visit_global_command (tree_global_command&); - - void visit_persistent_command (tree_persistent_command&); - - void visit_decl_elt (tree_decl_elt&); - - void visit_decl_init_list (tree_decl_init_list&); - - void visit_simple_for_command (tree_simple_for_command&); - - void visit_complex_for_command (tree_complex_for_command&); - - void visit_octave_user_script (octave_user_script&); - - void visit_octave_user_function (octave_user_function&); - - void visit_octave_user_function_header (octave_user_function&); - - void visit_octave_user_function_trailer (octave_user_function&); - - void visit_function_def (tree_function_def&); - - void visit_identifier (tree_identifier&); - - void visit_if_clause (tree_if_clause&); - - void visit_if_command (tree_if_command&); - - void visit_if_command_list (tree_if_command_list&); - - void visit_index_expression (tree_index_expression&); - - void visit_matrix (tree_matrix&); - - void visit_cell (tree_cell&); - - void visit_multi_assignment (tree_multi_assignment&); - - void visit_no_op_command (tree_no_op_command&); - - void visit_constant (tree_constant&); - - void visit_fcn_handle (tree_fcn_handle&); - - void visit_parameter_list (tree_parameter_list&); - - void visit_postfix_expression (tree_postfix_expression&); - - void visit_prefix_expression (tree_prefix_expression&); - - void visit_return_command (tree_return_command&); - - void visit_return_list (tree_return_list&); - - void visit_simple_assignment (tree_simple_assignment&); - - void visit_statement (tree_statement&); - - void visit_statement_list (tree_statement_list&); - - void visit_switch_case (tree_switch_case&); - - void visit_switch_case_list (tree_switch_case_list&); - - void visit_switch_command (tree_switch_command&); - - void visit_try_catch_command (tree_try_catch_command&); - - void do_unwind_protect_cleanup_code (tree_statement_list *list); - - void visit_unwind_protect_command (tree_unwind_protect_command&); - - void visit_while_command (tree_while_command&); - - void visit_do_until_command (tree_do_until_command&); - - static void reset_debug_state (void); - - // If > 0, stop executing at the (N-1)th stopping point, counting - // from the the current execution point in the current frame. - // - // If < 0, stop executing at the next possible stopping point. - static int dbstep_flag; - - // The number of the stack frame we are currently debugging. - static size_t current_frame; - - static bool debug_mode; - - // Possible types of evaluation contexts. - enum stmt_list_type - { - function, // function body - script, // script file - other // command-line input or eval string - }; - - // The context for the current evaluation. - static stmt_list_type statement_context; - - // TRUE means we are evaluating some kind of looping construct. - static bool in_loop_command; - -private: - - void do_decl_init_list (decl_elt_init_fcn fcn, - tree_decl_init_list *init_list); - - void do_breakpoint (tree_statement& stmt) const; - - void do_breakpoint (bool is_breakpoint, - bool is_end_of_fcn_or_script = false) const; - - virtual octave_value - do_keyboard (const octave_value_list& args = octave_value_list ()) const; - - // No copying! - - tree_evaluator (const tree_evaluator&); - - tree_evaluator& operator = (const tree_evaluator&); -}; - -extern tree_evaluator *current_evaluator; - -// Maximum nesting level for functions, scripts, or sourced files called -// recursively. -extern int Vmax_recursion_depth; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-except.cc --- a/src/pt-except.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,100 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "quit.h" - -#include "error.h" -#include "oct-lvalue.h" -#include "ov.h" -#include "pt-bp.h" -#include "pt-cmd.h" -#include "pt-except.h" -#include "pt-exp.h" -#include "pt-jump.h" -#include "pt-stmt.h" -#include "pt-walk.h" -#include "unwind-prot.h" -#include "variables.h" - -// Simple exception handling. - -tree_try_catch_command::~tree_try_catch_command (void) -{ - delete try_code; - delete catch_code; - delete lead_comm; - delete mid_comm; - delete trail_comm; -} - -tree_command * -tree_try_catch_command::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return new - tree_try_catch_command (try_code ? try_code->dup (scope, context) : 0, - catch_code ? catch_code->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0, - mid_comm ? mid_comm->dup () : 0, - trail_comm ? trail_comm->dup () : 0, - line (), column ()); -} - -void -tree_try_catch_command::accept (tree_walker& tw) -{ - tw.visit_try_catch_command (*this); -} - -// Simple exception handling. - -tree_unwind_protect_command::~tree_unwind_protect_command (void) -{ - delete unwind_protect_code; - delete cleanup_code; - delete lead_comm; - delete mid_comm; - delete trail_comm; -} - -tree_command * -tree_unwind_protect_command::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return new tree_unwind_protect_command - (unwind_protect_code ? unwind_protect_code->dup (scope, context) : 0, - cleanup_code ? cleanup_code->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0, - mid_comm ? mid_comm->dup () : 0, - trail_comm ? trail_comm->dup () : 0, - line (), column ()); -} - -void -tree_unwind_protect_command::accept (tree_walker& tw) -{ - tw.visit_unwind_protect_command (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-except.h --- a/src/pt-except.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,156 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_except_h) -#define octave_tree_except_h 1 - -class tree_statement_list; - -class tree_walker; - -#include "comment-list.h" -#include "pt-cmd.h" -#include "symtab.h" - -// Simple exception handling. - -class -tree_try_catch_command : public tree_command -{ -public: - - tree_try_catch_command (int l = -1, int c = -1) - : tree_command (l, c), try_code (0), catch_code (0), lead_comm (0), - mid_comm (0), trail_comm (0) { } - - tree_try_catch_command (tree_statement_list *tc, tree_statement_list *cc, - octave_comment_list *cl = 0, - octave_comment_list *cm = 0, - octave_comment_list *ct = 0, - int l = -1, int c = -1) - : tree_command (l, c), try_code (tc), catch_code (cc), - lead_comm (cl), mid_comm (cm), trail_comm (ct) { } - - ~tree_try_catch_command (void); - - tree_statement_list *body (void) { return try_code; } - - tree_statement_list *cleanup (void) { return catch_code; } - - octave_comment_list *leading_comment (void) { return lead_comm; } - - octave_comment_list *middle_comment (void) { return mid_comm; } - - octave_comment_list *trailing_comment (void) { return trail_comm; } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // The first block of code to attempt to execute. - tree_statement_list *try_code; - - // The code to execute if an error occurs in the first block. - tree_statement_list *catch_code; - - // Comment preceding TRY token. - octave_comment_list *lead_comm; - - // Comment preceding CATCH token. - octave_comment_list *mid_comm; - - // Comment preceding END_TRY_CATCH token. - octave_comment_list *trail_comm; - - // No copying! - - tree_try_catch_command (const tree_try_catch_command&); - - tree_try_catch_command& operator = (const tree_try_catch_command&); -}; - -// Simple exception handling. - -class -tree_unwind_protect_command : public tree_command -{ -public: - - tree_unwind_protect_command (int l = -1, int c = -1) - : tree_command (l, c), unwind_protect_code (0), cleanup_code (0), - lead_comm (0), mid_comm (0), trail_comm (0) { } - - tree_unwind_protect_command (tree_statement_list *tc, - tree_statement_list *cc, - octave_comment_list *cl = 0, - octave_comment_list *cm = 0, - octave_comment_list *ct = 0, - int l = -1, int c = -1) - : tree_command (l, c), unwind_protect_code (tc), cleanup_code (cc), - lead_comm (cl), mid_comm (cm), trail_comm (ct) { } - - ~tree_unwind_protect_command (void); - - tree_statement_list *body (void) { return unwind_protect_code; } - - tree_statement_list *cleanup (void) { return cleanup_code; } - - octave_comment_list *leading_comment (void) { return lead_comm; } - - octave_comment_list *middle_comment (void) { return mid_comm; } - - octave_comment_list *trailing_comment (void) { return trail_comm; } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // The first body of code to attempt to execute. - tree_statement_list *unwind_protect_code; - - // The body of code to execute no matter what happens in the first - // body of code. - tree_statement_list *cleanup_code; - - // Comment preceding UNWIND_PROTECT token. - octave_comment_list *lead_comm; - - // Comment preceding UNWIND_PROTECT_CLEANUP token. - octave_comment_list *mid_comm; - - // Comment preceding END_UNWIND_PROTECT token. - octave_comment_list *trail_comm; - - // No copying! - - tree_unwind_protect_command (const tree_unwind_protect_command&); - - tree_unwind_protect_command& operator = (const tree_unwind_protect_command&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-exp.cc --- a/src/pt-exp.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,88 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "error.h" -#include "pager.h" -#include "oct-lvalue.h" -#include "ov.h" -#include "pt-exp.h" - -// Expressions. - -bool -tree_expression::is_logically_true (const char *warn_for) -{ - bool expr_value = false; - - octave_value t1 = rvalue1 (); - - if (! error_state) - { - if (t1.is_defined ()) - return t1.is_true (); - else - ::error ("%s: undefined value used in conditional expression", - warn_for); - } - - return expr_value; -} - -octave_value -tree_expression::rvalue1 (int) -{ - ::error ("invalid rvalue function called in expression"); - return octave_value (); -} - -octave_value_list -tree_expression::rvalue (int) -{ - ::error ("invalid rvalue function called in expression"); - return octave_value_list (); -} - -octave_value_list -tree_expression::rvalue (int nargout, const std::list *) -{ - return rvalue (nargout); -} - -octave_lvalue -tree_expression::lvalue (void) -{ - ::error ("invalid lvalue function called in expression"); - return octave_lvalue (); -} - -std::string -tree_expression::original_text (void) const -{ - return std::string (); -} diff -r d02b229ce693 -r a132d206a36a src/pt-exp.h --- a/src/pt-exp.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,151 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_expr_h) -#define octave_tree_expr_h 1 - -#include -#include - -class octave_value; -class octave_lvalue; - -#include "pt.h" -#include "symtab.h" - -// A base class for expressions. - -class -tree_expression : public tree -{ -public: - - tree_expression (int l = -1, int c = -1) - : tree (l, c), num_parens (0), postfix_indexed (false), - print_flag (false) { } - - virtual ~tree_expression (void) { } - - virtual bool has_magic_end (void) const = 0; - - virtual tree_expression *dup (symbol_table::scope_id, - symbol_table::context_id context) const = 0; - - virtual bool is_constant (void) const { return false; } - - virtual bool is_matrix_constant (void) const { return false; } - - virtual bool is_identifier (void) const { return false; } - - virtual bool is_index_expression (void) const { return false; } - - virtual bool is_assignment_expression (void) const { return false; } - - virtual bool is_prefix_expression (void) const { return false; } - - virtual bool is_unary_expression (void) const { return false; } - - virtual bool is_binary_expression (void) const { return false; } - - virtual bool is_boolean_expression (void) const { return false; } - - virtual bool is_logically_true (const char *); - - virtual bool lvalue_ok (void) const { return false; } - - virtual bool rvalue_ok (void) const { return false; } - - virtual octave_value rvalue1 (int nargout = 1); - - virtual octave_value_list rvalue (int nargout); - - virtual octave_value_list rvalue (int nargout, - const std::list *lvalue_list); - - virtual octave_lvalue lvalue (void); - - int paren_count (void) const { return num_parens; } - - bool is_postfix_indexed (void) const { return postfix_indexed; } - - bool print_result (void) const { return print_flag; } - - virtual std::string oper (void) const { return ""; } - - virtual std::string name (void) const { return ""; } - - virtual std::string original_text (void) const; - - virtual void mark_braindead_shortcircuit (const std::string&) { } - - tree_expression *mark_in_parens (void) - { - num_parens++; - return this; - } - - tree_expression *mark_postfix_indexed (void) - { - postfix_indexed = true; - return this; - } - - tree_expression *set_print_flag (bool print) - { - print_flag = print; - return this; - } - - virtual void copy_base (const tree_expression& e) - { - num_parens = e.num_parens; - postfix_indexed = e.postfix_indexed; - print_flag = e.print_flag; - } - -protected: - - // A count of the number of times this expression appears directly - // inside a set of parentheses. - // - // (((e1)) + e2) ==> 2 for expression e1 - // ==> 1 for expression ((e1)) + e2 - // ==> 0 for expression e2 - int num_parens; - - // A flag that says whether this expression has an index associated - // with it. See the code in tree_identifier::rvalue for the rationale. - bool postfix_indexed; - - // Print result of rvalue for this expression? - bool print_flag; - -private: - - // No copying! - - tree_expression (const tree_expression&); - - tree_expression& operator = (const tree_expression&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-fcn-handle.cc --- a/src/pt-fcn-handle.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,207 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "error.h" -#include "oct-obj.h" -#include "ov-fcn-handle.h" -#include "pt-fcn-handle.h" -#include "pager.h" -#include "pt-const.h" -#include "pt-walk.h" -#include "variables.h" - -void -tree_fcn_handle::print (std::ostream& os, bool pr_as_read_syntax, - bool pr_orig_text) -{ - print_raw (os, pr_as_read_syntax, pr_orig_text); -} - -void -tree_fcn_handle::print_raw (std::ostream& os, bool pr_as_read_syntax, - bool pr_orig_text) -{ - os << ((pr_as_read_syntax || pr_orig_text) ? "@" : "") << nm; -} - -octave_value -tree_fcn_handle::rvalue1 (int) -{ - return make_fcn_handle (nm); -} - -octave_value_list -tree_fcn_handle::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("invalid number of output arguments for function handle expression"); - else - retval = rvalue1 (nargout); - - return retval; -} - -tree_expression * -tree_fcn_handle::dup (symbol_table::scope_id, - symbol_table::context_id) const -{ - tree_fcn_handle *new_fh = new tree_fcn_handle (nm, line (), column ()); - - new_fh->copy_base (*this); - - return new_fh; -} - -void -tree_fcn_handle::accept (tree_walker& tw) -{ - tw.visit_fcn_handle (*this); -} - -octave_value -tree_anon_fcn_handle::rvalue1 (int) -{ - // FIXME -- should CMD_LIST be limited to a single expression? - // I think that is what Matlab does. - - tree_parameter_list *param_list = parameter_list (); - tree_parameter_list *ret_list = return_list (); - tree_statement_list *cmd_list = body (); - symbol_table::scope_id this_scope = scope (); - - symbol_table::scope_id new_scope = symbol_table::dup_scope (this_scope); - - if (new_scope > 0) - symbol_table::inherit (new_scope, symbol_table::current_scope (), - symbol_table::current_context ()); - - octave_user_function *uf - = new octave_user_function (new_scope, - param_list ? param_list->dup (new_scope, 0) : 0, - ret_list ? ret_list->dup (new_scope, 0) : 0, - cmd_list ? cmd_list->dup (new_scope, 0) : 0); - - octave_function *curr_fcn = octave_call_stack::current (); - - if (curr_fcn) - { - // FIXME -- maybe it would be better to just stash curr_fcn - // instead of individual bits of info about it? - - uf->stash_parent_fcn_name (curr_fcn->name ()); - uf->stash_dir_name (curr_fcn->dir_name ()); - - symbol_table::scope_id parent_scope = curr_fcn->parent_fcn_scope (); - - if (parent_scope < 0) - parent_scope = curr_fcn->scope (); - - uf->stash_parent_fcn_scope (parent_scope); - - if (curr_fcn->is_class_method () || curr_fcn->is_class_constructor ()) - uf->stash_dispatch_class (curr_fcn->dispatch_class ()); - } - - uf->mark_as_anonymous_function (); - uf->stash_fcn_file_name (file_name); - uf->stash_fcn_location (line (), column ()); - - octave_value ov_fcn (uf); - - octave_value fh (octave_fcn_binder::maybe_binder (ov_fcn)); - - return fh; -} - -/* -%!function r = __f2 (f, x) -%! r = f (x); -%!endfunction -%!function f = __f1 (k) -%! f = @(x) __f2 (@(y) y-k, x); -%!endfunction - -%!assert ((__f1 (3)) (10) == 7) - -%!test -%! g = @(t) feval (@(x) t*x, 2); -%! assert (g(0.5) == 1); - -%!test -%! h = @(x) sin (x); -%! g = @(f, x) h (x); -%! f = @() g (@(x) h, pi); -%! assert (f () == sin (pi)); -*/ - -octave_value_list -tree_anon_fcn_handle::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("invalid number of output arguments for anonymous function handle expression"); - else - retval = rvalue1 (nargout); - - return retval; -} - -tree_expression * -tree_anon_fcn_handle::dup (symbol_table::scope_id, - symbol_table::context_id) const -{ - tree_parameter_list *param_list = parameter_list (); - tree_parameter_list *ret_list = return_list (); - tree_statement_list *cmd_list = body (); - symbol_table::scope_id this_scope = scope (); - - symbol_table::scope_id new_scope = symbol_table::dup_scope (this_scope); - - if (new_scope > 0) - symbol_table::inherit (new_scope, symbol_table::current_scope (), - symbol_table::current_context ()); - - tree_anon_fcn_handle *new_afh = new - tree_anon_fcn_handle (param_list ? param_list->dup (new_scope, 0) : 0, - ret_list ? ret_list->dup (new_scope, 0) : 0, - cmd_list ? cmd_list->dup (new_scope, 0) : 0, - new_scope, line (), column ()); - - new_afh->copy_base (*this); - - return new_afh; -} - -void -tree_anon_fcn_handle::accept (tree_walker& tw) -{ - tw.visit_anon_fcn_handle (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-fcn-handle.h --- a/src/pt-fcn-handle.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,156 +0,0 @@ -/* - -Copyright (C) 2003-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_fcn_handle_h) -#define octave_fcn_handle_h 1 - -#include -#include - -#include "pt-bp.h" -#include "pt-exp.h" -#include "pt-misc.h" -#include "pt-stmt.h" -#include "symtab.h" - -class octave_value_list; - -class tree_walker; - -#include "ov.h" -#include "ov-usr-fcn.h" -#include "symtab.h" - -class -tree_fcn_handle : public tree_expression -{ -public: - - tree_fcn_handle (int l = -1, int c = -1) - : tree_expression (l, c), nm () { } - - tree_fcn_handle (const std::string& n, int l = -1, int c = -1) - : tree_expression (l, c), nm (n) { } - - ~tree_fcn_handle (void) { } - - bool has_magic_end (void) const { return false; } - - void print (std::ostream& os, bool pr_as_read_syntax = false, - bool pr_orig_txt = true); - - void print_raw (std::ostream& os, bool pr_as_read_syntax = false, - bool pr_orig_txt = true); - - std::string name (void) const { return nm; } - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // The name of this function handle. - std::string nm; - - // No copying! - - tree_fcn_handle (const tree_fcn_handle&); - - tree_fcn_handle& operator = (const tree_fcn_handle&); -}; - -class -tree_anon_fcn_handle : public tree_expression -{ -public: - - tree_anon_fcn_handle (int l = -1, int c = -1) - : tree_expression (l, c), fcn (0), file_name () { } - - tree_anon_fcn_handle (tree_parameter_list *pl, tree_parameter_list *rl, - tree_statement_list *cl, symbol_table::scope_id sid, - int l = -1, int c = -1) - : tree_expression (l, c), - fcn (new octave_user_function (sid, pl, rl, cl)), - file_name () { } - - ~tree_anon_fcn_handle (void) { delete fcn; } - - bool has_magic_end (void) const { return false; } - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - tree_parameter_list *parameter_list (void) const - { - return fcn ? fcn->parameter_list () : 0; - } - - tree_parameter_list *return_list (void) const - { - return fcn ? fcn->return_list () : 0; - } - - tree_statement_list *body (void) const - { - return fcn ? fcn->body () : 0; - } - - symbol_table::scope_id scope (void) const - { - return fcn ? fcn->scope () : -1; - } - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - - void stash_file_name (const std::string& file) { file_name = file; } - -private: - - // The function. - octave_user_function *fcn; - - // Filename where the handle was defined. - std::string file_name; - - // No copying! - - tree_anon_fcn_handle (const tree_anon_fcn_handle&); - - tree_anon_fcn_handle& operator = (const tree_anon_fcn_handle&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-id.cc --- a/src/pt-id.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,145 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "pager.h" -#include "pt-bp.h" -#include "pt-const.h" -#include "pt-id.h" -#include "pt-walk.h" -#include "symtab.h" -#include "utils.h" -#include "variables.h" - -// Symbols from the symbol table. - -void -tree_identifier::eval_undefined_error (void) -{ - int l = line (); - int c = column (); - - maybe_missing_function_hook (name ()); - if (error_state) - return; - - if (l == -1 && c == -1) - ::error_with_id ("Octave:undefined-function", - "`%s' undefined", name ().c_str ()); - else - ::error_with_id ("Octave:undefined-function", - "`%s' undefined near line %d column %d", - name ().c_str (), l, c); -} - -octave_value_list -tree_identifier::rvalue (int nargout) -{ - octave_value_list retval; - - if (error_state) - return retval; - - octave_value val = sym->find (); - - if (val.is_defined ()) - { - // GAGME -- this would be cleaner if we required - // parens to indicate function calls. - // - // If this identifier refers to a function, we need to know - // whether it is indexed so that we can do the same thing - // for `f' and `f()'. If the index is present, return the - // function object and let tree_index_expression::rvalue - // handle indexing. Otherwise, arrange to call the function - // here, so that we don't return the function definition as - // a value. - - if (val.is_function () && ! is_postfix_indexed ()) - { - octave_value_list tmp_args; - - retval = val.do_multi_index_op (nargout, tmp_args); - } - else - { - if (print_result () && nargout == 0) - val.print_with_name (octave_stdout, name ()); - - retval = val; - } - } - else - eval_undefined_error (); - - return retval; -} - -octave_value -tree_identifier::rvalue1 (int nargout) -{ - octave_value retval; - - octave_value_list tmp = rvalue (nargout); - - if (! tmp.empty ()) - retval = tmp(0); - - return retval; -} - -octave_lvalue -tree_identifier::lvalue (void) -{ - return octave_lvalue (&(sym->varref ())); -} - -tree_identifier * -tree_identifier::dup (symbol_table::scope_id sc, - symbol_table::context_id) const -{ - // The new tree_identifier object contains a symbol_record - // entry from the duplicated scope. - - // FIXME -- is this the best way? - symbol_table::symbol_record new_sym - = symbol_table::find_symbol (name (), sc); - - tree_identifier *new_id - = new tree_identifier (new_sym, line (), column ()); - - new_id->copy_base (*this); - - return new_id; -} - -void -tree_identifier::accept (tree_walker& tw) -{ - tw.visit_identifier (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-id.h --- a/src/pt-id.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,155 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_identifier_h) -#define octave_tree_identifier_h 1 - -#include -#include - -class octave_value; -class octave_value_list; -class octave_function; - -class tree_walker; - -#include "pt-bp.h" -#include "pt-exp.h" -#include "symtab.h" - -// Symbols from the symbol table. - -class -tree_identifier : public tree_expression -{ - friend class tree_index_expression; - -public: - - tree_identifier (int l = -1, int c = -1) - : tree_expression (l, c) { } - - tree_identifier (const symbol_table::symbol_record& s, - int l = -1, int c = -1, - symbol_table::scope_id sc = symbol_table::current_scope ()) - : tree_expression (l, c), sym (s, sc) { } - - ~tree_identifier (void) { } - - bool has_magic_end (void) const { return (name () == "__end__"); } - - bool is_identifier (void) const { return true; } - - // The name doesn't change with scope, so use sym instead of - // accessing it through sym so that this function may remain const. - std::string name (void) const { return sym.name (); } - - bool is_defined (void) { return sym->is_defined (); } - - virtual bool is_variable (void) { return sym->is_variable (); } - - virtual bool is_black_hole (void) { return false; } - - // Try to find a definition for an identifier. Here's how: - // - // * If the identifier is already defined and is a function defined - // in an function file that has been modified since the last time - // we parsed it, parse it again. - // - // * If the identifier is not defined, try to find a builtin - // variable or an already compiled function with the same name. - // - // * If the identifier is still undefined, try looking for an - // function file to parse. - // - // * On systems that support dynamic linking, we prefer .oct files, - // then .mex files, then .m files. - - octave_value - do_lookup (const octave_value_list& args = octave_value_list ()) - { - return sym->find (args); - } - - void mark_global (void) { sym->mark_global (); } - - void mark_as_static (void) { sym->init_persistent (); } - - void mark_as_formal_parameter (void) { sym->mark_formal (); } - - // We really need to know whether this symbol referst to a variable - // or a function, but we may not know that yet. - - bool lvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - octave_lvalue lvalue (void); - - void eval_undefined_error (void); - - tree_identifier *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - - symbol_table::symbol_reference symbol (void) const - { - return sym; - } -private: - - // The symbol record that this identifier references. - symbol_table::symbol_reference sym; - - // No copying! - - tree_identifier (const tree_identifier&); - - tree_identifier& operator = (const tree_identifier&); -}; - -class tree_black_hole : public tree_identifier -{ -public: - - tree_black_hole (int l = -1, int c = -1) - : tree_identifier (l, c) { } - - std::string name (void) const { return "~"; } - - bool is_variable (void) { return false; } - - bool is_black_hole (void) { return true; } - - tree_black_hole *dup (void) const - { return new tree_black_hole; } - - octave_lvalue lvalue (void) - { - return octave_lvalue (0); // black hole lvalue - } -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-idx.cc --- a/src/pt-idx.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,687 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "Cell.h" -#include "error.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "ov.h" -#include "pager.h" -#include "pt-arg-list.h" -#include "pt-bp.h" -#include "pt-id.h" -#include "pt-idx.h" -#include "pt-walk.h" -#include "utils.h" -#include "variables.h" -#include "gripes.h" - -// Index expressions. - -tree_index_expression::tree_index_expression (int l, int c) - : tree_expression (l, c), expr (0), args (0), type (), - arg_nm (), dyn_field () { } - -tree_index_expression::tree_index_expression (tree_expression *e, - tree_argument_list *lst, - int l, int c, char t) - : tree_expression (l, c), expr (e), args (0), type (), - arg_nm (), dyn_field () -{ - append (lst, t); -} - -tree_index_expression::tree_index_expression (tree_expression *e, - const std::string& n, - int l, int c) - : tree_expression (l, c), expr (e), args (0), type (), - arg_nm (), dyn_field () -{ - append (n); -} - -tree_index_expression::tree_index_expression (tree_expression *e, - tree_expression *df, - int l, int c) - : tree_expression (l, c), expr (e), args (0), type (), - arg_nm (), dyn_field () -{ - append (df); -} - -void -tree_index_expression::append (tree_argument_list *lst, char t) -{ - args.push_back (lst); - type.append (1, t); - arg_nm.push_back (lst ? lst->get_arg_names () : string_vector ()); - dyn_field.push_back (static_cast (0)); - - if (lst && lst->has_magic_tilde ()) - error ("invalid use of empty argument (~) in index expression"); -} - -void -tree_index_expression::append (const std::string& n) -{ - args.push_back (static_cast (0)); - type.append ("."); - arg_nm.push_back (n); - dyn_field.push_back (static_cast (0)); -} - -void -tree_index_expression::append (tree_expression *df) -{ - args.push_back (static_cast (0)); - type.append ("."); - arg_nm.push_back (""); - dyn_field.push_back (df); -} - -tree_index_expression::~tree_index_expression (void) -{ - delete expr; - - while (! args.empty ()) - { - std::list::iterator p = args.begin (); - delete *p; - args.erase (p); - } - - while (! dyn_field.empty ()) - { - std::list::iterator p = dyn_field.begin (); - delete *p; - dyn_field.erase (p); - } -} - -bool -tree_index_expression::has_magic_end (void) const -{ - for (std::list::const_iterator p = args.begin (); - p != args.end (); - p++) - { - tree_argument_list *elt = *p; - - if (elt && elt->has_magic_end ()) - return true; - } - - return false; -} - -// This is useful for printing the name of the variable in an indexed -// assignment. - -std::string -tree_index_expression::name (void) const -{ - return expr->name (); -} - -static Cell -make_subs_cell (tree_argument_list *args, const string_vector& arg_nm) -{ - Cell retval; - - octave_value_list arg_values; - - if (args) - arg_values = args->convert_to_const_vector (); - - if (! error_state) - { - int n = arg_values.length (); - - if (n > 0) - { - arg_values.stash_name_tags (arg_nm); - - retval.resize (dim_vector (1, n)); - - for (int i = 0; i < n; i++) - retval(0,i) = arg_values(i); - } - } - - return retval; -} - -static inline octave_value_list -make_value_list (tree_argument_list *args, const string_vector& arg_nm, - const octave_value *object, bool rvalue = true) -{ - octave_value_list retval; - - if (args) - { - if (rvalue && object && args->has_magic_end () && object->is_undefined ()) - gripe_invalid_inquiry_subscript (); - else - retval = args->convert_to_const_vector (object); - } - - if (! error_state) - { - octave_idx_type n = retval.length (); - - if (n > 0) - retval.stash_name_tags (arg_nm); - } - - return retval; -} - -std::string -tree_index_expression::get_struct_index - (std::list::const_iterator p_arg_nm, - std::list::const_iterator p_dyn_field) const -{ - std::string fn = (*p_arg_nm)(0); - - if (fn.empty ()) - { - tree_expression *df = *p_dyn_field; - - if (df) - { - octave_value t = df->rvalue1 (); - - if (! error_state) - { - fn = t.string_value (); - - if (! valid_identifier (fn)) - ::error ("invalid structure field name `%s'", fn.c_str ()); - } - } - else - panic_impossible (); - } - - return fn; -} - -octave_map -tree_index_expression::make_arg_struct (void) const -{ - int n = args.size (); - - Cell type_field (n, 1); - Cell subs_field (n, 1); - - std::list::const_iterator p_args = args.begin (); - std::list::const_iterator p_arg_nm = arg_nm.begin (); - std::list::const_iterator p_dyn_field = dyn_field.begin (); - - octave_map m; - - for (int i = 0; i < n; i++) - { - switch (type[i]) - { - case '(': - subs_field(i) = make_subs_cell (*p_args, *p_arg_nm); - break; - - case '{': - subs_field(i) = make_subs_cell (*p_args, *p_arg_nm); - break; - - case '.': - subs_field(i) = get_struct_index (p_arg_nm, p_dyn_field); - break; - - default: - panic_impossible (); - } - - if (error_state) - return m; - - p_args++; - p_arg_nm++; - p_dyn_field++; - } - - m.assign ("type", type_field); - m.assign ("subs", subs_field); - - return m; -} - -octave_value_list -tree_index_expression::rvalue (int nargout) -{ - return tree_index_expression::rvalue (nargout, 0); -} - -octave_value_list -tree_index_expression::rvalue (int nargout, const std::list *lvalue_list) -{ - octave_value_list retval; - - if (error_state) - return retval; - - octave_value first_expr_val; - - octave_value_list first_args; - - bool have_args = false; - - if (expr->is_identifier () && type[0] == '(') - { - tree_identifier *id = dynamic_cast (expr); - - if (! (id->is_variable () || args.empty ())) - { - tree_argument_list *al = *(args.begin ()); - - size_t n = al ? al->length () : 0; - - if (n > 0) - { - string_vector anm = *(arg_nm.begin ()); - have_args = true; - first_args = al -> convert_to_const_vector (); - first_args.stash_name_tags (anm); - - if (! error_state) - first_expr_val = id->do_lookup (first_args); - } - } - } - - if (! error_state) - { - if (first_expr_val.is_undefined ()) - first_expr_val = expr->rvalue1 (); - - octave_value tmp = first_expr_val; - octave_idx_type tmpi = 0; - - std::list idx; - - int n = args.size (); - - std::list::iterator p_args = args.begin (); - std::list::iterator p_arg_nm = arg_nm.begin (); - std::list::iterator p_dyn_field = dyn_field.begin (); - - for (int i = 0; i < n; i++) - { - if (i > 0) - { - tree_argument_list *al = *p_args; - - // In Matlab, () can only be followed by . In Octave, we do not - // enforce this for rvalue expressions, but we'll split the - // evaluation at this point. This will, hopefully, allow Octave's - // looser rules apply smoothly for Matlab overloaded subsref - // codes. - bool force_split = type[i-1] == '(' && type[i] != '.'; - - if (force_split || (al && al->has_magic_end ())) - { - // We have an expression like - // - // x{end}.a(end) - // - // and we are looking at the argument list that - // contains the second (or third, etc.) "end" token, - // so we must evaluate everything up to the point of - // that argument list so we can pass the appropriate - // value to the built-in __end__ function. - - const octave_value_list tmp_list - = tmp.subsref (type.substr (tmpi, i - tmpi), idx, nargout); - - tmp = tmp_list.length () ? tmp_list(0) : octave_value (); - tmpi = i; - idx.clear (); - - if (tmp.is_cs_list ()) - gripe_indexed_cs_list (); - - if (error_state) - break; - } - } - - switch (type[i]) - { - case '(': - if (have_args) - { - idx.push_back (first_args); - have_args = false; - } - else - idx.push_back (make_value_list (*p_args, *p_arg_nm, &tmp)); - break; - - case '{': - idx.push_back (make_value_list (*p_args, *p_arg_nm, &tmp)); - break; - - case '.': - idx.push_back (octave_value (get_struct_index (p_arg_nm, p_dyn_field))); - break; - - default: - panic_impossible (); - } - - if (error_state) - break; - - p_args++; - p_arg_nm++; - p_dyn_field++; - } - - if (! error_state) - retval = tmp.subsref (type.substr (tmpi, n - tmpi), idx, nargout, - lvalue_list); - } - - return retval; -} - -octave_value -tree_index_expression::rvalue1 (int nargout) -{ - octave_value retval; - - const octave_value_list tmp = rvalue (nargout); - - if (! tmp.empty ()) - retval = tmp(0); - - return retval; -} - -octave_lvalue -tree_index_expression::lvalue (void) -{ - octave_lvalue retval; - - std::list idx; - std::string tmp_type; - - int n = args.size (); - - std::list::iterator p_args = args.begin (); - std::list::iterator p_arg_nm = arg_nm.begin (); - std::list::iterator p_dyn_field = dyn_field.begin (); - - retval = expr->lvalue (); - - if (! error_state) - { - const octave_value *tro = retval.object (); - - octave_value tmp; - - if (tro) - tmp = *tro; - - octave_idx_type tmpi = 0; - std::list tmpidx; - - for (int i = 0; i < n; i++) - { - if (retval.numel () != 1) - gripe_indexed_cs_list (); - else if (tmpi < i) - { - tmp = tmp.subsref (type.substr (tmpi, i - tmpi), tmpidx, true); - tmpidx.clear (); - } - - if (error_state) - break; - - switch (type[i]) - { - case '(': - { - octave_value_list tidx - = make_value_list (*p_args, *p_arg_nm, &tmp, false); - - idx.push_back (tidx); - - if (i < n - 1) - { - if (type[i+1] == '.') - { - tmpidx.push_back (tidx); - tmpi = i+1; - } - else - error ("() must be followed by . or close the index chain"); - } - } - break; - - case '{': - { - octave_value_list tidx - = make_value_list (*p_args, *p_arg_nm, &tmp, false); - - if (tmp.is_undefined ()) - { - if (tidx.has_magic_colon ()) - gripe_invalid_inquiry_subscript (); - else - tmp = Cell (); - } - else if (tmp.is_zero_by_zero () - && (tmp.is_matrix_type () || tmp.is_string ())) - { - tmp = Cell (); - } - - retval.numel (tmp.numel (tidx)); - - if (error_state) - break; - - idx.push_back (tidx); - tmpidx.push_back (tidx); - tmpi = i; - } - break; - - case '.': - { - octave_value tidx = get_struct_index (p_arg_nm, p_dyn_field); - if (error_state) - break; - - bool autoconv = (tmp.is_zero_by_zero () - && (tmp.is_matrix_type () || tmp.is_string () - || tmp.is_cell ())); - - if (i > 0 && type[i-1] == '(') - { - octave_value_list pidx = idx.back (); - - // Use octave_map, not octave_scalar_map so that the - // dimensions are 0x0, not 1x1. - if (tmp.is_undefined ()) - { - if (pidx.has_magic_colon ()) - gripe_invalid_inquiry_subscript (); - else - tmp = octave_map (); - } - else if (autoconv) - tmp = octave_map (); - - retval.numel (tmp.numel (pidx)); - - tmpi = i-1; - tmpidx.push_back (tidx); - } - else - { - if (tmp.is_undefined () || autoconv) - { - tmpi = i+1; - tmp = octave_value (); - } - else - { - retval.numel (tmp.numel (octave_value_list ())); - - tmpi = i; - tmpidx.push_back (tidx); - } - } - - if (error_state) - break; - - idx.push_back (tidx); - } - break; - - default: - panic_impossible (); - } - - if (idx.back ().empty ()) - error ("invalid empty index list"); - - if (error_state) - break; - - p_args++; - p_arg_nm++; - p_dyn_field++; - } - - if (! error_state) - retval.set_index (type, idx); - - } - - return retval; -} - -/* -%!test -%! clear x; -%! clear y; -%! y = 3; -%! x(y(end)) = 1; -%! assert (x, [0, 0, 1]); -%! clear x; -%! clear y; -%! y = {3}; -%! x(y{end}) = 1; -%! assert (x, [0, 0, 1]); - -%!test -%! x = {1, 2, 3}; -%! [x{:}] = deal (4, 5, 6); -%! assert (x, {4, 5, 6}); - -%!test -%! [x.a, x.b.c] = deal (1, 2); -%! assert (x.a == 1 && x.b.c == 2); - -%!test -%! [x.a, x(2).b] = deal (1, 2); -%! assert (x(1).a == 1 && isempty (x(2).a) && isempty (x(1).b) && x(2).b == 2); - -%!test -%! x = struct (zeros (0, 1), {"a", "b"}); -%! x(2).b = 1; -%! assert (x(2).b == 1); - -%!test -%! x = struct (zeros (0, 1), {"a", "b"}); -%! x(2).b = 1; -%! assert (x(2).b == 1); -*/ - -tree_index_expression * -tree_index_expression::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_index_expression *new_idx_expr - = new tree_index_expression (line (), column ()); - - new_idx_expr->expr = expr ? expr->dup (scope, context) : 0; - - std::list new_args; - - for (std::list::const_iterator p = args.begin (); - p != args.end (); - p++) - { - const tree_argument_list *elt = *p; - - new_args.push_back (elt ? elt->dup (scope, context) : 0); - } - - new_idx_expr->args = new_args; - - new_idx_expr->type = type; - - new_idx_expr->arg_nm = arg_nm; - - std::list new_dyn_field; - - for (std::list::const_iterator p = dyn_field.begin (); - p != dyn_field.end (); - p++) - { - const tree_expression *elt = *p; - - new_dyn_field.push_back (elt ? elt->dup (scope, context) : 0); - } - - new_idx_expr->dyn_field = new_dyn_field; - - new_idx_expr->copy_base (*this); - - return new_idx_expr; -} - -void -tree_index_expression::accept (tree_walker& tw) -{ - tw.visit_index_expression (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-idx.h --- a/src/pt-idx.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,131 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_index_h) -#define octave_tree_index_h 1 - -#include - -class tree_argument_list; - -class tree_walker; - -class octave_map; -class octave_value; -class octave_value_list; -class octave_lvalue; - -#include "str-vec.h" - -#include "pt-exp.h" -#include "symtab.h" - -// Index expressions. - -class -tree_index_expression : public tree_expression -{ -public: - - tree_index_expression (tree_expression *e = 0, tree_argument_list *lst = 0, - int l = -1, int c = -1, char t = '('); - - tree_index_expression (tree_expression *e, const std::string& n, - int l = -1, int c = -1); - - tree_index_expression (tree_expression *e, tree_expression* df, - int l = -1, int c = -1); - - ~tree_index_expression (void); - - bool has_magic_end (void) const; - - void append (tree_argument_list *lst = 0, char t = '('); - - void append (const std::string& n); - - void append (tree_expression *df); - - bool is_index_expression (void) const { return true; } - - std::string name (void) const; - - tree_expression *expression (void) { return expr; } - - std::list arg_lists (void) { return args; } - - std::string type_tags (void) { return type; } - - std::list arg_names (void) { return arg_nm; } - - bool lvalue_ok (void) const { return expr->lvalue_ok (); } - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - octave_value_list rvalue (int nargout, const std::list *lvalue_list); - - octave_lvalue lvalue (void); - - tree_index_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // The LHS of this index expression. - tree_expression *expr; - - // The indices (only valid if type == paren || type == brace). - std::list args; - - // The type of this index expression. - std::string type; - - // The names of the arguments. Used for constant struct element - // references. - std::list arg_nm; - - // The list of dynamic field names, if any. - std::list dyn_field; - - tree_index_expression (int l, int c); - - octave_map make_arg_struct (void) const; - - std::string - get_struct_index - (std::list::const_iterator p_arg_nm, - std::list::const_iterator p_dyn_field) const; - - // No copying! - - tree_index_expression (const tree_index_expression&); - - tree_index_expression& operator = (const tree_index_expression&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-jit.cc --- a/src/pt-jit.cc Thu Aug 02 12:12:00 2012 +0200 +++ b/src/pt-jit.cc Fri Aug 03 14:59:40 2012 -0400 @@ -412,7 +412,14 @@ void jit_convert::visit_identifier (tree_identifier& ti) { - result = get_variable (ti.name ()); + if (ti.has_magic_end ()) + { + if (!end_context.size ()) + throw jit_fail_exception ("Illegal end"); + result = block->append (create (end_context)); + } + else + result = get_variable (ti.name ()); } void @@ -511,11 +518,7 @@ void jit_convert::visit_index_expression (tree_index_expression& exp) { - std::pair res = resolve (exp); - jit_value *object = res.first; - jit_value *index = res.second; - - result = create_checked (jit_typeinfo::paren_subsref, object, index); + result = resolve (jit_typeinfo::paren_subsref (), exp); } void @@ -806,8 +809,9 @@ return ss.str (); } -std::pair -jit_convert::resolve (tree_index_expression& exp) +jit_instruction * +jit_convert::resolve (const jit_operation& fres, tree_index_expression& exp, + jit_value *extra_arg) { std::string type = exp.type_tags (); if (! (type.size () == 1 && type[0] == '(')) @@ -821,15 +825,31 @@ if (! arg_list) throw jit_fail_exception ("null argument list"); - if (arg_list->size () != 1) - throw jit_fail_exception ("Bad number of arguments in arg_list"); + if (arg_list->size () < 1) + throw jit_fail_exception ("Empty arg_list"); tree_expression *tree_object = exp.expression (); jit_value *object = visit (tree_object); - tree_expression *arg0 = arg_list->front (); - jit_value *index = visit (arg0); + + size_t narg = arg_list->size (); + tree_argument_list::iterator iter = arg_list->begin (); + bool have_extra = extra_arg; + std::vector call_args (narg + 1 + have_extra); + call_args[0] = object; - return std::make_pair (object, index); + for (size_t idx = 0; iter != arg_list->end (); ++idx, ++iter) + { + unwind_protect prot; + prot.add_method (&end_context, + &std::vector::pop_back); + end_context.push_back (jit_magic_end::context (object, idx, narg)); + call_args[idx + 1] = visit (*iter); + } + + if (extra_arg) + call_args[call_args.size () - 1] = extra_arg; + + return create_checked (fres, call_args); } jit_value * @@ -843,14 +863,9 @@ else if (tree_index_expression *idx = dynamic_cast (exp)) { - std::pair res = resolve (*idx); - jit_value *object = res.first; - jit_value *index = res.second; - jit_call *new_object = create (&jit_typeinfo::paren_subsasgn, - object, index, rhs); - block->append (new_object); + jit_value *new_object = resolve (jit_typeinfo::paren_subsasgn (), *idx, + rhs); do_assign (idx->expression (), new_object, true); - create_check (new_object); // FIXME: Will not work for values that must be release/grabed return rhs; @@ -1479,6 +1494,14 @@ jit_convert::convert_llvm::visit (jit_argument&) {} +void +jit_convert::convert_llvm::visit (jit_magic_end& me) +{ + const jit_function& ol = me.overload (); + llvm::Value *ret = ol.call (builder, me.resolve_context ()); + me.stash_llvm (ret); +} + // -------------------- tree_jit -------------------- tree_jit::tree_jit (void) : module (0), engine (0) @@ -1823,4 +1846,62 @@ %! endwhile %! assert (i == niter); +%!test +%! niter = 1001; +%! result = 0; +%! m = [5 10]; +%! for i=1:niter +%! result = result + m(end); +%! endfor +%! assert (result == m(end) * niter); + +%!test +%! ndim = 100; +%! result = 0; +%! m = zeros (ndim); +%! m(:) = 1:ndim^2; +%! i = 1; +%! while (i <= ndim) +%! for j = 1:ndim +%! result = result + m(i, j); +%! endfor +%! i = i + 1; +%! endwhile +%! assert (result == sum (sum (m))); + +%!test +%! ndim = 100; +%! m = zeros (ndim); +%! i = 1; +%! while (i <= ndim) +%! for j = 1:ndim +%! m(i, j) = (j - 1) * ndim + i; +%! endfor +%! i = i + 1; +%! endwhile +%! m2 = zeros (ndim); +%! m2(:) = 1:(ndim^2); +%! assert (all (m == m2)); + +%!test +%! ndim = 2; +%! m = zeros (ndim, ndim, ndim, ndim); +%! result = 0; +%! i0 = 1; +%! while (i0 <= ndim) +%! for i1 = 1:ndim +%! for i2 = 1:ndim +%! for i3 = 1:ndim +%! m(i0, i1, i2, i3) = 1; +%! m(i0, i1, i2, i3, 1, 1, 1, 1, 1, 1) = 1; +%! result = result + m(i0, i1, i2, i3); +%! endfor +%! endfor +%! endfor +%! i0 = i0 + 1; +%! endwhile +%! expected = ones (ndim, ndim, ndim, ndim); +%! assert (all (m == expected)); +%! assert (result == sum (expected (:))); + */ diff -r d02b229ce693 -r a132d206a36a src/pt-jit.h --- a/src/pt-jit.h Thu Aug 02 12:12:00 2012 +0200 +++ b/src/pt-jit.h Fri Aug 03 14:59:40 2012 -0400 @@ -244,6 +244,8 @@ std::list all_values; + std::vector end_context; + size_t iterator_count; size_t for_bounds_count; size_t short_count; @@ -294,7 +296,9 @@ std::string next_name (const char *prefix, size_t& count, bool inc); - std::pair resolve (tree_index_expression& exp); + jit_instruction *resolve (const jit_operation& fres, + tree_index_expression& exp, + jit_value *extra_arg = 0); jit_value *do_assign (tree_expression *exp, jit_value *rhs, bool artificial = false); diff -r d02b229ce693 -r a132d206a36a src/pt-jump.cc --- a/src/pt-jump.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,87 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "oct-obj.h" -#include "pt-bp.h" -#include "pt-jump.h" -#include "pt-walk.h" - -class octave_value_list; - -// Break. - -// Nonzero means we're breaking out of a loop or function body. -int tree_break_command::breaking = 0; - -tree_command * -tree_break_command::dup (symbol_table::scope_id, - symbol_table::context_id) const -{ - return new tree_break_command (line (), column ()); -} - -void -tree_break_command::accept (tree_walker& tw) -{ - tw.visit_break_command (*this); -} - -// Continue. - -// Nonzero means we're jumping to the end of a loop. -int tree_continue_command::continuing = 0; - -tree_command * -tree_continue_command::dup (symbol_table::scope_id, - symbol_table::context_id) const -{ - return new tree_continue_command (line (), column ()); -} - -void -tree_continue_command::accept (tree_walker& tw) -{ - tw.visit_continue_command (*this); -} - -// Return. - -// Nonzero means we're returning from a function. -int tree_return_command::returning = 0; - -tree_command * -tree_return_command::dup (symbol_table::scope_id, - symbol_table::context_id) const -{ - return new tree_return_command (line (), column ()); -} - -void -tree_return_command::accept (tree_walker& tw) -{ - tw.visit_return_command (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-jump.h --- a/src/pt-jump.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,115 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_jump_h) -#define octave_tree_jump_h 1 - -class tree_walker; - -#include "pt-cmd.h" -#include "symtab.h" - -// Break. - -class -tree_break_command : public tree_command -{ -public: - - tree_break_command (int l = -1, int c = -1) - : tree_command (l, c) { } - - ~tree_break_command (void) { } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - - static int breaking; - -private: - - // No copying! - - tree_break_command (const tree_break_command&); - - tree_break_command& operator = (const tree_break_command&); -}; - -// Continue. - -class -tree_continue_command : public tree_command -{ -public: - - tree_continue_command (int l = -1, int c = -1) - : tree_command (l, c) { } - - ~tree_continue_command (void) { } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - - static int continuing; - -private: - - // No copying! - - tree_continue_command (const tree_continue_command&); - - tree_continue_command& operator = (const tree_continue_command&); -}; - -// Return. - -class -tree_return_command : public tree_command -{ -public: - - tree_return_command (int l = -1, int c = -1) - : tree_command (l, c) { } - - ~tree_return_command (void) { } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - - static int returning; - -private: - - // No copying! - - tree_return_command (const tree_return_command&); - - tree_return_command& operator = (const tree_return_command&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-loop.cc --- a/src/pt-loop.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,153 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "quit.h" - -#include "error.h" -#include "gripes.h" -#include "oct-map.h" -#include "oct-lvalue.h" -#include "ov.h" -#include "pt-arg-list.h" -#include "pt-bp.h" -#include "pt-cmd.h" -#include "pt-exp.h" -#include "pt-jit.h" -#include "pt-jump.h" -#include "pt-loop.h" -#include "pt-stmt.h" -#include "pt-walk.h" -#include "unwind-prot.h" - -// While. - -tree_while_command::~tree_while_command (void) -{ - delete expr; - delete list; - delete lead_comm; - delete trail_comm; -#ifdef HAVE_LLVM - delete compiled; -#endif -} - -tree_command * -tree_while_command::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return new tree_while_command (expr ? expr->dup (scope, context) : 0, - list ? list->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0, - trail_comm ? trail_comm->dup (): 0, - line (), column ()); -} - -void -tree_while_command::accept (tree_walker& tw) -{ - tw.visit_while_command (*this); -} - -// Do-Until - -tree_command * -tree_do_until_command::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return new tree_do_until_command (expr ? expr->dup (scope, context) : 0, - list ? list->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0, - trail_comm ? trail_comm->dup (): 0, - line (), column ()); -} - -void -tree_do_until_command::accept (tree_walker& tw) -{ - tw.visit_do_until_command (*this); -} - -// For. - -tree_simple_for_command::~tree_simple_for_command (void) -{ - delete lhs; - delete expr; - delete maxproc; - delete list; - delete lead_comm; - delete trail_comm; -#ifdef HAVE_LLVM - delete compiled; -#endif -} - -tree_command * -tree_simple_for_command::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return new tree_simple_for_command - (parallel, lhs ? lhs->dup (scope, context) : 0, - expr ? expr->dup (scope, context) : 0, - maxproc ? maxproc->dup (scope, context) : 0, - list ? list->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0, - trail_comm ? trail_comm->dup () : 0, line (), column ()); -} - -void -tree_simple_for_command::accept (tree_walker& tw) -{ - tw.visit_simple_for_command (*this); -} - -tree_complex_for_command::~tree_complex_for_command (void) -{ - delete lhs; - delete expr; - delete list; - delete lead_comm; - delete trail_comm; -} - -tree_command * -tree_complex_for_command::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return new tree_complex_for_command (lhs ? lhs->dup (scope, context) : 0, - expr ? expr->dup (scope, context) : 0, - list ? list->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0, - trail_comm ? trail_comm->dup () : 0, - line (), column ()); -} - -void -tree_complex_for_command::accept (tree_walker& tw) -{ - tw.visit_complex_for_command (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-loop.h --- a/src/pt-loop.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,328 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_loop_h) -#define octave_tree_loop_h 1 - -class octave_value; -class octave_lvalue; - -class tree_argument_list; -class tree_expression; -class tree_statement_list; - -class tree_walker; - -#include "comment-list.h" -#include "pt-cmd.h" -#include "symtab.h" - -class jit_info; - -// While. - -class -tree_while_command : public tree_command -{ -public: - - tree_while_command (int l = -1, int c = -1) - : tree_command (l, c), expr (0), list (0), lead_comm (0), - trail_comm (0) -#ifdef HAVE_LLVM - , compiled (0) -#endif - { } - - tree_while_command (tree_expression *e, - octave_comment_list *lc = 0, - octave_comment_list *tc = 0, - int l = -1, int c = -1) - : tree_command (l, c), expr (e), list (0), lead_comm (lc), - trail_comm (tc) -#ifdef HAVE_LLVM - , compiled (0) -#endif - { } - - tree_while_command (tree_expression *e, tree_statement_list *lst, - octave_comment_list *lc = 0, - octave_comment_list *tc = 0, - int l = -1, int c = -1) - : tree_command (l, c), expr (e), list (lst), lead_comm (lc), - trail_comm (tc) -#ifdef HAVE_LLVM - , compiled (0) -#endif - { } - - ~tree_while_command (void); - - tree_expression *condition (void) { return expr; } - - tree_statement_list *body (void) { return list; } - - octave_comment_list *leading_comment (void) { return lead_comm; } - - octave_comment_list *trailing_comment (void) { return trail_comm; } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -#ifdef HAVE_LLVM - // some functions use by tree_jit - jit_info *get_info (void) const - { - return compiled; - } - - void stash_info (jit_info *jinfo) - { - compiled = jinfo; - } -#endif - -protected: - - // Expression to test. - tree_expression *expr; - - // List of commands to execute. - tree_statement_list *list; - - // Comment preceding WHILE token. - octave_comment_list *lead_comm; - - // Comment preceding ENDWHILE token. - octave_comment_list *trail_comm; - -private: - -#ifdef HAVE_LLVM - // compiled version of the loop - jit_info *compiled; -#endif - - // No copying! - - tree_while_command (const tree_while_command&); - - tree_while_command& operator = (const tree_while_command&); -}; - -// Do-Until. - -class -tree_do_until_command : public tree_while_command -{ -public: - - tree_do_until_command (int l = -1, int c = -1) - : tree_while_command (l, c) { } - - tree_do_until_command (tree_expression *e, - octave_comment_list *lc = 0, - octave_comment_list *tc = 0, - int l = -1, int c = -1) - : tree_while_command (e, lc, tc, l, c) { } - - tree_do_until_command (tree_expression *e, tree_statement_list *lst, - octave_comment_list *lc = 0, - octave_comment_list *tc = 0, - int l = -1, int c = -1) - : tree_while_command (e, lst, lc, tc, l, c) { } - - ~tree_do_until_command (void) { } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // No copying! - - tree_do_until_command (const tree_do_until_command&); - - tree_do_until_command& operator = (const tree_do_until_command&); -}; - -// For. - -class -tree_simple_for_command : public tree_command -{ -public: - - tree_simple_for_command (int l = -1, int c = -1) - : tree_command (l, c), parallel (false), lhs (0), expr (0), - maxproc (0), list (0), lead_comm (0), trail_comm (0) -#ifdef HAVE_LLVM - , compiled (0) -#endif - { } - - tree_simple_for_command (bool parallel_arg, tree_expression *le, - tree_expression *re, - tree_expression *maxproc_arg, - tree_statement_list *lst, - octave_comment_list *lc = 0, - octave_comment_list *tc = 0, - int l = -1, int c = -1) - : tree_command (l, c), parallel (parallel_arg), lhs (le), - expr (re), maxproc (maxproc_arg), list (lst), - lead_comm (lc), trail_comm (tc) -#ifdef HAVE_LLVM - , compiled (0) -#endif - { } - - ~tree_simple_for_command (void); - - bool in_parallel (void) { return parallel; } - - tree_expression *left_hand_side (void) { return lhs; } - - tree_expression *control_expr (void) { return expr; } - - tree_expression *maxproc_expr (void) { return maxproc; } - - tree_statement_list *body (void) { return list; } - - octave_comment_list *leading_comment (void) { return lead_comm; } - - octave_comment_list *trailing_comment (void) { return trail_comm; } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -#ifdef HAVE_LLVM - // some functions use by tree_jit - jit_info *get_info (void) const - { - return compiled; - } - - void stash_info (jit_info *jinfo) - { - compiled = jinfo; - } -#endif - -private: - // TRUE means operate in parallel (subject to the value of the - // maxproc expression). - bool parallel; - - // Expression to modify. - tree_expression *lhs; - - // Expression to evaluate. - tree_expression *expr; - - // Expression to tell how many processors should be used (only valid - // if parallel is TRUE). - tree_expression *maxproc; - - // List of commands to execute. - tree_statement_list *list; - - // Comment preceding FOR token. - octave_comment_list *lead_comm; - - // Comment preceding ENDFOR token. - octave_comment_list *trail_comm; - - // compiled version of the loop - jit_info *compiled; - - // No copying! - - tree_simple_for_command (const tree_simple_for_command&); - - tree_simple_for_command& operator = (const tree_simple_for_command&); -}; - -class -tree_complex_for_command : public tree_command -{ -public: - - tree_complex_for_command (int l = -1, int c = -1) - : tree_command (l, c), lhs (0), expr (0), list (0), lead_comm (0), - trail_comm (0) { } - - tree_complex_for_command (tree_argument_list *le, tree_expression *re, - tree_statement_list *lst, - octave_comment_list *lc = 0, - octave_comment_list *tc = 0, - int l = -1, int c = -1) - : tree_command (l, c), lhs (le), expr (re), list (lst), - lead_comm (lc), trail_comm (tc) { } - - ~tree_complex_for_command (void); - - tree_argument_list *left_hand_side (void) { return lhs; } - - tree_expression *control_expr (void) { return expr; } - - tree_statement_list *body (void) { return list; } - - octave_comment_list *leading_comment (void) { return lead_comm; } - - octave_comment_list *trailing_comment (void) { return trail_comm; } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // Expression to modify. - tree_argument_list *lhs; - - // Expression to evaluate. - tree_expression *expr; - - // List of commands to execute. - tree_statement_list *list; - - // Comment preceding FOR token. - octave_comment_list *lead_comm; - - // Comment preceding ENDFOR token. - octave_comment_list *trail_comm; - - // No copying! - - tree_complex_for_command (const tree_complex_for_command&); - - tree_complex_for_command& operator = (const tree_complex_for_command&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-mat.cc --- a/src/pt-mat.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1431 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "quit.h" - -#include "data.h" -#include "defun.h" -#include "error.h" -#include "oct-obj.h" -#include "pt-arg-list.h" -#include "pt-bp.h" -#include "pt-exp.h" -#include "pt-mat.h" -#include "pt-walk.h" -#include "utils.h" -#include "ov.h" -#include "variables.h" - -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -// The character to fill with when creating string arrays. -char Vstring_fill_char = ' '; - -// General matrices. This list type is much more work to handle than -// constant matrices, but it allows us to construct matrices from -// other matrices, variables, and functions. - -// But first, some internal classes that make our job much easier. - -class -tm_row_const -{ -private: - - class - tm_row_const_rep : public octave_base_list - { - public: - - tm_row_const_rep (void) - : count (1), dv (0, 0), all_str (false), - all_sq_str (false), all_dq_str (false), - some_str (false), all_real (false), all_cmplx (false), - all_mt (true), any_cell (false), any_sparse (false), - any_class (false), all_1x1 (false), - first_elem_is_struct (false), class_nm (), ok (false) - { } - - tm_row_const_rep (const tree_argument_list& row) - : count (1), dv (0, 0), all_str (false), all_sq_str (false), - some_str (false), all_real (false), all_cmplx (false), - all_mt (true), any_cell (false), any_sparse (false), - any_class (false), all_1x1 (! row.empty ()), - first_elem_is_struct (false), class_nm (), ok (false) - { init (row); } - - ~tm_row_const_rep (void) { } - - octave_refcount count; - - dim_vector dv; - - bool all_str; - bool all_sq_str; - bool all_dq_str; - bool some_str; - bool all_real; - bool all_cmplx; - bool all_mt; - bool any_cell; - bool any_sparse; - bool any_class; - bool all_1x1; - bool first_elem_is_struct; - - std::string class_nm; - - bool ok; - - void do_init_element (const octave_value&, bool&); - - void init (const tree_argument_list&); - - void cellify (void); - - private: - - tm_row_const_rep (const tm_row_const_rep&); - - tm_row_const_rep& operator = (const tm_row_const_rep&); - - }; - -public: - - typedef tm_row_const_rep::iterator iterator; - typedef tm_row_const_rep::const_iterator const_iterator; - - tm_row_const (void) - : rep (0) { } - - tm_row_const (const tree_argument_list& row) - : rep (new tm_row_const_rep (row)) { } - - tm_row_const (const tm_row_const& x) - : rep (x.rep) - { - if (rep) - rep->count++; - } - - tm_row_const& operator = (const tm_row_const& x) - { - if (this != &x && rep != x.rep) - { - if (rep && --rep->count == 0) - delete rep; - - rep = x.rep; - - if (rep) - rep->count++; - } - - return *this; - } - - ~tm_row_const (void) - { - if (rep && --rep->count == 0) - delete rep; - } - - octave_idx_type rows (void) { return rep->dv(0); } - octave_idx_type cols (void) { return rep->dv(1); } - - bool empty (void) const { return rep->empty (); } - - size_t length (void) const { return rep->length (); } - - dim_vector dims (void) { return rep->dv; } - - bool all_strings_p (void) const { return rep->all_str; } - bool all_sq_strings_p (void) const { return rep->all_sq_str; } - bool all_dq_strings_p (void) const { return rep->all_dq_str; } - bool some_strings_p (void) const { return rep->some_str; } - bool all_real_p (void) const { return rep->all_real; } - bool all_complex_p (void) const { return rep->all_cmplx; } - bool all_empty_p (void) const { return rep->all_mt; } - bool any_cell_p (void) const { return rep->any_cell; } - bool any_sparse_p (void) const { return rep->any_sparse; } - bool any_class_p (void) const { return rep->any_class; } - bool all_1x1_p (void) const { return rep->all_1x1; } - bool first_elem_struct_p (void) const { return rep->first_elem_is_struct; } - - std::string class_name (void) const { return rep->class_nm; } - - void cellify (void) { rep->cellify (); } - - operator bool () const { return (rep && rep->ok); } - - iterator begin (void) { return rep->begin (); } - const_iterator begin (void) const { return rep->begin (); } - - iterator end (void) { return rep->end (); } - const_iterator end (void) const { return rep->end (); } - -private: - - tm_row_const_rep *rep; -}; - -std::string -get_concat_class (const std::string& c1, const std::string& c2) -{ - std::string retval = octave_base_value::static_class_name (); - - if (c1 == c2) - retval = c1; - else if (c1.empty ()) - retval = c2; - else if (c2.empty ()) - retval = c1; - else if (c1 == "class" || c2 == "class") - retval = "class"; - else - { - bool c1_is_int = (c1 == "int8" || c1 == "uint8" - || c1 == "int16" || c1 == "uint16" - || c1 == "int32" || c1 == "uint32" - || c1 == "int64" || c1 == "uint64"); - bool c2_is_int = (c2 == "int8" || c2 == "uint8" - || c2 == "int16" || c2 == "uint16" - || c2 == "int32" || c2 == "uint32" - || c2 == "int64" || c2 == "uint64"); - - bool c1_is_char = (c1 == "char"); - bool c2_is_char = (c2 == "char"); - - bool c1_is_double = (c1 == "double"); - bool c2_is_double = (c2 == "double"); - - bool c1_is_single = (c1 == "single"); - bool c2_is_single = (c2 == "single"); - - bool c1_is_logical = (c1 == "logical"); - bool c2_is_logical = (c2 == "logical"); - - bool c1_is_built_in_type - = (c1_is_int || c1_is_char || c1_is_double || c1_is_single - || c1_is_logical); - - bool c2_is_built_in_type - = (c2_is_int || c2_is_char || c2_is_double || c2_is_single - || c2_is_logical); - - // Order is important here... - - if (c1 == "struct" && c2 == c1) - retval = c1; - else if (c1 == "cell" || c2 == "cell") - retval = "cell"; - else if (c1_is_char && c2_is_built_in_type) - retval = c1; - else if (c2_is_char && c1_is_built_in_type) - retval = c2; - else if (c1_is_int && c2_is_built_in_type) - retval = c1; - else if (c2_is_int && c1_is_built_in_type) - retval = c2; - else if (c1_is_single && c2_is_built_in_type) - retval = c1; - else if (c2_is_single && c1_is_built_in_type) - retval = c2; - else if (c1_is_double && c2_is_built_in_type) - retval = c1; - else if (c2_is_double && c1_is_built_in_type) - retval = c2; - else if (c1_is_logical && c2_is_logical) - retval = c1; - } - - return retval; -} - -static void -eval_error (const char *msg, const dim_vector& x, const dim_vector& y) -{ - ::error ("%s (%s vs %s)", msg, x.str ().c_str (), y.str ().c_str ()); -} - -void -tm_row_const::tm_row_const_rep::do_init_element (const octave_value& val, - bool& first_elem) -{ - std::string this_elt_class_nm - = val.is_object () ? std::string ("class") : val.class_name (); - - class_nm = get_concat_class (class_nm, this_elt_class_nm); - - dim_vector this_elt_dv = val.dims (); - - if (! this_elt_dv.zero_by_zero ()) - { - all_mt = false; - - if (first_elem) - { - if (val.is_map ()) - first_elem_is_struct = true; - - first_elem = false; - } - } - - append (val); - - if (all_str && ! val.is_string ()) - all_str = false; - - if (all_sq_str && ! val.is_sq_string ()) - all_sq_str = false; - - if (all_dq_str && ! val.is_dq_string ()) - all_dq_str = false; - - if (! some_str && val.is_string ()) - some_str = true; - - if (all_real && ! val.is_real_type ()) - all_real = false; - - if (all_cmplx && ! (val.is_complex_type () || val.is_real_type ())) - all_cmplx = false; - - if (!any_cell && val.is_cell ()) - any_cell = true; - - if (!any_sparse && val.is_sparse_type ()) - any_sparse = true; - - if (!any_class && val.is_object ()) - any_class = true; - - all_1x1 = all_1x1 && val.numel () == 1; -} - -void -tm_row_const::tm_row_const_rep::init (const tree_argument_list& row) -{ - all_str = true; - all_sq_str = true; - all_dq_str = true; - all_real = true; - all_cmplx = true; - any_cell = false; - any_sparse = false; - any_class = false; - - bool first_elem = true; - - for (tree_argument_list::const_iterator p = row.begin (); - p != row.end (); - p++) - { - octave_quit (); - - tree_expression *elt = *p; - - octave_value tmp = elt->rvalue1 (); - - if (error_state || tmp.is_undefined ()) - { - ok = ! error_state; - return; - } - else - { - if (tmp.is_cs_list ()) - { - octave_value_list tlst = tmp.list_value (); - - for (octave_idx_type i = 0; i < tlst.length (); i++) - { - octave_quit (); - - do_init_element (tlst(i), first_elem); - } - } - else - do_init_element (tmp, first_elem); - } - } - - if (any_cell && ! any_class && ! first_elem_is_struct) - cellify (); - - first_elem = true; - - for (iterator p = begin (); p != end (); p++) - { - octave_quit (); - - octave_value val = *p; - - dim_vector this_elt_dv = val.dims (); - - if (! this_elt_dv.zero_by_zero ()) - { - all_mt = false; - - if (first_elem) - { - first_elem = false; - dv = this_elt_dv; - } - else if (! dv.hvcat (this_elt_dv, 1)) - { - eval_error ("horizontal dimensions mismatch", dv, this_elt_dv); - break; - } - } - } - - ok = ! error_state; -} - -void -tm_row_const::tm_row_const_rep::cellify (void) -{ - bool elt_changed = false; - - for (iterator p = begin (); p != end (); p++) - { - octave_quit (); - - if (! p->is_cell ()) - { - elt_changed = true; - - *p = Cell (*p); - } - } - - if (elt_changed) - { - bool first_elem = true; - - for (iterator p = begin (); p != end (); p++) - { - octave_quit (); - - octave_value val = *p; - - dim_vector this_elt_dv = val.dims (); - - if (! this_elt_dv.zero_by_zero ()) - { - if (first_elem) - { - first_elem = false; - dv = this_elt_dv; - } - else if (! dv.hvcat (this_elt_dv, 1)) - { - eval_error ("horizontal dimensions mismatch", dv, this_elt_dv); - break; - } - } - } - } -} - -class -tm_const : public octave_base_list -{ -public: - - tm_const (const tree_matrix& tm) - : dv (0, 0), all_str (false), all_sq_str (false), all_dq_str (false), - some_str (false), all_real (false), all_cmplx (false), - all_mt (true), any_cell (false), any_sparse (false), - any_class (false), class_nm (), ok (false) - { init (tm); } - - ~tm_const (void) { } - - octave_idx_type rows (void) const { return dv.elem (0); } - octave_idx_type cols (void) const { return dv.elem (1); } - - dim_vector dims (void) const { return dv; } - - bool all_strings_p (void) const { return all_str; } - bool all_sq_strings_p (void) const { return all_sq_str; } - bool all_dq_strings_p (void) const { return all_dq_str; } - bool some_strings_p (void) const { return some_str; } - bool all_real_p (void) const { return all_real; } - bool all_complex_p (void) const { return all_cmplx; } - bool all_empty_p (void) const { return all_mt; } - bool any_cell_p (void) const { return any_cell; } - bool any_sparse_p (void) const { return any_sparse; } - bool any_class_p (void) const { return any_class; } - bool all_1x1_p (void) const { return all_1x1; } - - std::string class_name (void) const { return class_nm; } - - operator bool () const { return ok; } - -private: - - dim_vector dv; - - bool all_str; - bool all_sq_str; - bool all_dq_str; - bool some_str; - bool all_real; - bool all_cmplx; - bool all_mt; - bool any_cell; - bool any_sparse; - bool any_class; - bool all_1x1; - - std::string class_nm; - - bool ok; - - tm_const (void); - - tm_const (const tm_const&); - - tm_const& operator = (const tm_const&); - - void init (const tree_matrix& tm); -}; - -void -tm_const::init (const tree_matrix& tm) -{ - all_str = true; - all_sq_str = true; - all_dq_str = true; - all_real = true; - all_cmplx = true; - any_cell = false; - any_sparse = false; - any_class = false; - all_1x1 = ! tm.empty (); - - bool first_elem = true; - bool first_elem_is_struct = false; - - // Just eval and figure out if what we have is complex or all - // strings. We can't check columns until we know that this is a - // numeric matrix -- collections of strings can have elements of - // different lengths. - - for (tree_matrix::const_iterator p = tm.begin (); p != tm.end (); p++) - { - octave_quit (); - - tree_argument_list *elt = *p; - - tm_row_const tmp (*elt); - - if (first_elem) - { - first_elem_is_struct = tmp.first_elem_struct_p (); - - first_elem = false; - } - - if (tmp && ! tmp.empty ()) - { - if (all_str && ! tmp.all_strings_p ()) - all_str = false; - - if (all_sq_str && ! tmp.all_sq_strings_p ()) - all_sq_str = false; - - if (all_dq_str && ! tmp.all_dq_strings_p ()) - all_dq_str = false; - - if (! some_str && tmp.some_strings_p ()) - some_str = true; - - if (all_real && ! tmp.all_real_p ()) - all_real = false; - - if (all_cmplx && ! tmp.all_complex_p ()) - all_cmplx = false; - - if (all_mt && ! tmp.all_empty_p ()) - all_mt = false; - - if (!any_cell && tmp.any_cell_p ()) - any_cell = true; - - if (!any_sparse && tmp.any_sparse_p ()) - any_sparse = true; - - if (!any_class && tmp.any_class_p ()) - any_class = true; - - all_1x1 = all_1x1 && tmp.all_1x1_p (); - - append (tmp); - } - else - break; - } - - if (! error_state) - { - if (any_cell && ! any_class && ! first_elem_is_struct) - { - for (iterator q = begin (); q != end (); q++) - { - octave_quit (); - - q->cellify (); - } - } - - first_elem = true; - - for (iterator q = begin (); q != end (); q++) - { - octave_quit (); - - tm_row_const elt = *q; - - octave_idx_type this_elt_nr = elt.rows (); - octave_idx_type this_elt_nc = elt.cols (); - - std::string this_elt_class_nm = elt.class_name (); - class_nm = get_concat_class (class_nm, this_elt_class_nm); - - dim_vector this_elt_dv = elt.dims (); - - all_mt = false; - - if (first_elem) - { - first_elem = false; - - dv = this_elt_dv; - } - else if (all_str && dv.length () == 2 - && this_elt_dv.length () == 2) - { - // FIXME: this is Octave's specialty. Character matrices allow - // rows of unequal length. - if (this_elt_nc > cols ()) - dv(1) = this_elt_nc; - dv(0) += this_elt_nr; - } - else if (! dv.hvcat (this_elt_dv, 0)) - { - eval_error ("vertical dimensions mismatch", dv, this_elt_dv); - return; - } - } - } - - ok = ! error_state; -} - -tree_matrix::~tree_matrix (void) -{ - while (! empty ()) - { - iterator p = begin (); - delete *p; - erase (p); - } -} - -bool -tree_matrix::has_magic_end (void) const -{ - for (const_iterator p = begin (); p != end (); p++) - { - octave_quit (); - - tree_argument_list *elt = *p; - - if (elt && elt->has_magic_end ()) - return true; - } - - return false; -} - -bool -tree_matrix::all_elements_are_constant (void) const -{ - for (const_iterator p = begin (); p != end (); p++) - { - octave_quit (); - - tree_argument_list *elt = *p; - - if (! elt->all_elements_are_constant ()) - return false; - } - - return true; -} - -octave_value_list -tree_matrix::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("invalid number of output arguments for matrix list"); - else - retval = rvalue1 (nargout); - - return retval; -} - -void -maybe_warn_string_concat (bool all_dq_strings_p, bool all_sq_strings_p) -{ - if (! (all_dq_strings_p || all_sq_strings_p)) - warning_with_id ("Octave:mixed-string-concat", - "concatenation of different character string types may have unintended consequences"); -} - -template -static void -single_type_concat (Array& result, - tm_const& tmp) -{ - octave_idx_type r = 0, c = 0; - - for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) - { - tm_row_const row = *p; - // Skip empty arrays to allow looser rules. - if (row.dims ().any_zero ()) - continue; - - for (tm_row_const::iterator q = row.begin (); - q != row.end (); - q++) - { - octave_quit (); - - TYPE ra = octave_value_extract (*q); - - // Skip empty arrays to allow looser rules. - if (! error_state) - { - if (! ra.is_empty ()) - { - result.insert (ra, r, c); - - if (! error_state) - c += ra.columns (); - else - return; - } - } - else - return; - } - - r += row.rows (); - c = 0; - } -} - -template -static void -single_type_concat (Array& result, - const dim_vector& dv, - tm_const& tmp) -{ - if (dv.any_zero ()) - { - result = Array (dv); - return; - } - - if (tmp.length () == 1) - { - // If possible, forward the operation to liboctave. - // Single row. - tm_row_const& row = tmp.front (); - if (! (equal_types::value || equal_types::value) - && row.all_1x1_p ()) - { - // Optimize all scalars case. - result.clear (dv); - assert (static_cast (result.numel ()) == row.length ()); - octave_idx_type i = 0; - for (tm_row_const::iterator q = row.begin (); - q != row.end () && ! error_state; q++) - result(i++) = octave_value_extract (*q); - - return; - } - - octave_idx_type ncols = row.length (), i = 0; - OCTAVE_LOCAL_BUFFER (Array, array_list, ncols); - - for (tm_row_const::iterator q = row.begin (); - q != row.end () && ! error_state; - q++) - { - octave_quit (); - - array_list[i] = octave_value_extract (*q); - i++; - } - - if (! error_state) - result = Array::cat (-2, ncols, array_list); - } - else - { - result = Array (dv); - single_type_concat (result, tmp); - } -} - -template -static void -single_type_concat (Sparse& result, - const dim_vector& dv, - tm_const& tmp) -{ - if (dv.any_zero ()) - { - result = Sparse (dv); - return; - } - - // Sparse matrices require preallocation for efficient indexing; besides, - // only horizontal concatenation can be efficiently handled by indexing. - // So we just cat all rows through liboctave, then cat the final column. - octave_idx_type nrows = tmp.length (), j = 0; - OCTAVE_LOCAL_BUFFER (Sparse, sparse_row_list, nrows); - for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) - { - tm_row_const row = *p; - octave_idx_type ncols = row.length (), i = 0; - OCTAVE_LOCAL_BUFFER (Sparse, sparse_list, ncols); - - for (tm_row_const::iterator q = row.begin (); - q != row.end () && ! error_state; - q++) - { - octave_quit (); - - sparse_list[i] = octave_value_extract (*q); - i++; - } - - Sparse stmp = Sparse::cat (-2, ncols, sparse_list); - sparse_row_list[j] = stmp; - j++; - } - - result = Sparse::cat (-1, nrows, sparse_row_list); -} - -template -static void -single_type_concat (octave_map& result, - const dim_vector& dv, - tm_const& tmp) -{ - if (dv.any_zero ()) - { - result = octave_map (dv); - return; - } - - octave_idx_type nrows = tmp.length (), j = 0; - OCTAVE_LOCAL_BUFFER (octave_map, map_row_list, nrows); - for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) - { - tm_row_const row = *p; - octave_idx_type ncols = row.length (), i = 0; - OCTAVE_LOCAL_BUFFER (MAP, map_list, ncols); - - for (tm_row_const::iterator q = row.begin (); - q != row.end () && ! error_state; - q++) - { - octave_quit (); - - map_list[i] = octave_value_extract (*q); - i++; - } - - octave_map mtmp = octave_map::cat (-2, ncols, map_list); - map_row_list[j] = mtmp; - j++; - } - - result = octave_map::cat (-1, nrows, map_row_list); -} - -template -static octave_value -do_single_type_concat (const dim_vector& dv, - tm_const& tmp) -{ - TYPE result; - - single_type_concat (result, dv, tmp); - - return result; -} - -template<> -octave_value -do_single_type_concat (const dim_vector& dv, - tm_const& tmp) -{ - octave_map result; - - if (tmp.all_1x1_p ()) - single_type_concat (result, dv, tmp); - else - single_type_concat (result, dv, tmp); - - return result; -} - -static octave_value -do_class_concat (tm_const& tmc) -{ - octave_value retval; - - octave_value_list rows (tmc.length (), octave_value ()); - - octave_idx_type j = 0; - for (tm_const::iterator p = tmc.begin (); p != tmc.end (); p++) - { - octave_quit (); - - tm_row_const tmrc = *p; - - if (tmrc.length () == 1) - rows(j++) = *(tmrc.begin ()); - else - { - octave_value_list row (tmrc.length (), octave_value ()); - - octave_idx_type i = 0; - for (tm_row_const::iterator q = tmrc.begin (); q != tmrc.end (); q++) - row(i++) = *q; - - rows(j++) = do_class_concat (row, "horzcat", 1); - } - } - - if (! error_state) - { - if (rows.length () == 1) - retval = rows(0); - else - retval = do_class_concat (rows, "vertcat", 0); - } - - return retval; -} - -octave_value -tree_matrix::rvalue1 (int) -{ - octave_value retval = Matrix (); - - bool all_sq_strings_p = false; - bool all_dq_strings_p = false; - bool all_empty_p = false; - bool all_real_p = false; - bool any_sparse_p = false; - bool any_class_p = false; - bool frc_str_conv = false; - - tm_const tmp (*this); - - if (tmp && ! tmp.empty ()) - { - dim_vector dv = tmp.dims (); - all_sq_strings_p = tmp.all_sq_strings_p (); - all_dq_strings_p = tmp.all_dq_strings_p (); - all_empty_p = tmp.all_empty_p (); - all_real_p = tmp.all_real_p (); - any_sparse_p = tmp.any_sparse_p (); - any_class_p = tmp.any_class_p (); - frc_str_conv = tmp.some_strings_p (); - - // Try to speed up the common cases. - - std::string result_type = tmp.class_name (); - - if (any_class_p) - { - retval = do_class_concat (tmp); - } - else if (result_type == "double") - { - if (any_sparse_p) - { - if (all_real_p) - retval = do_single_type_concat (dv, tmp); - else - retval = do_single_type_concat (dv, tmp); - } - else - { - if (all_real_p) - retval = do_single_type_concat (dv, tmp); - else - retval = do_single_type_concat (dv, tmp); - } - } - else if (result_type == "single") - { - if (all_real_p) - retval = do_single_type_concat (dv, tmp); - else - retval = do_single_type_concat (dv, tmp); - } - else if (result_type == "char") - { - char type = all_dq_strings_p ? '"' : '\''; - - maybe_warn_string_concat (all_dq_strings_p, all_sq_strings_p); - - charNDArray result (dv, Vstring_fill_char); - - single_type_concat (result, tmp); - - retval = octave_value (result, type); - } - else if (result_type == "logical") - { - if (any_sparse_p) - retval = do_single_type_concat (dv, tmp); - else - retval = do_single_type_concat (dv, tmp); - } - else if (result_type == "int8") - retval = do_single_type_concat (dv, tmp); - else if (result_type == "int16") - retval = do_single_type_concat (dv, tmp); - else if (result_type == "int32") - retval = do_single_type_concat (dv, tmp); - else if (result_type == "int64") - retval = do_single_type_concat (dv, tmp); - else if (result_type == "uint8") - retval = do_single_type_concat (dv, tmp); - else if (result_type == "uint16") - retval = do_single_type_concat (dv, tmp); - else if (result_type == "uint32") - retval = do_single_type_concat (dv, tmp); - else if (result_type == "uint64") - retval = do_single_type_concat (dv, tmp); - else if (result_type == "cell") - retval = do_single_type_concat (dv, tmp); - else if (result_type == "struct") - retval = do_single_type_concat (dv, tmp); - else - { - // The line below might seem crazy, since we take a copy of - // the first argument, resize it to be empty and then resize - // it to be full. This is done since it means that there is - // no recopying of data, as would happen if we used a single - // resize. It should be noted that resize operation is also - // significantly slower than the do_cat_op function, so it - // makes sense to have an empty matrix and copy all data. - // - // We might also start with a empty octave_value using - // - // ctmp = octave_value_typeinfo::lookup_type - // (tmp.begin() -> begin() -> type_name()); - // - // and then directly resize. However, for some types there - // might be some additional setup needed, and so this should - // be avoided. - - octave_value ctmp; - - // Find the first non-empty object - - if (any_sparse_p) - { - // Start with sparse matrix to avoid issues memory issues - // with things like [ones(1,4),sprandn(1e8,4,1e-4)] - if (all_real_p) - ctmp = octave_sparse_matrix ().resize (dv); - else - ctmp = octave_sparse_complex_matrix ().resize (dv); - } - else - { - for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) - { - octave_quit (); - - tm_row_const row = *p; - - for (tm_row_const::iterator q = row.begin (); - q != row.end (); q++) - { - octave_quit (); - - ctmp = *q; - - if (! ctmp.all_zero_dims ()) - goto found_non_empty; - } - } - - ctmp = (*(tmp.begin () -> begin ())); - - found_non_empty: - - if (! all_empty_p) - ctmp = ctmp.resize (dim_vector (0,0)).resize (dv); - } - - if (! error_state) - { - // Now, extract the values from the individual elements and - // insert them in the result matrix. - - int dv_len = dv.length (); - octave_idx_type ntmp = dv_len > 1 ? dv_len : 2; - Array ra_idx (dim_vector (ntmp, 1), 0); - - for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) - { - octave_quit (); - - tm_row_const row = *p; - - for (tm_row_const::iterator q = row.begin (); - q != row.end (); - q++) - { - octave_quit (); - - octave_value elt = *q; - - if (elt.is_empty ()) - continue; - - ctmp = do_cat_op (ctmp, elt, ra_idx); - - if (error_state) - goto done; - - ra_idx (1) += elt.columns (); - } - - ra_idx (0) += row.rows (); - ra_idx (1) = 0; - } - - retval = ctmp; - - if (frc_str_conv && ! retval.is_string ()) - retval = retval.convert_to_str (); - } - } - } - -done: - return retval; -} - -tree_expression * -tree_matrix::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_matrix *new_matrix = new tree_matrix (0, line (), column ()); - - for (const_iterator p = begin (); p != end (); p++) - { - const tree_argument_list *elt = *p; - - new_matrix->append (elt ? elt->dup (scope, context) : 0); - } - - new_matrix->copy_base (*this); - - return new_matrix; -} - -void -tree_matrix::accept (tree_walker& tw) -{ - tw.visit_matrix (*this); -} - -/* -## test concatenation with all zero matrices -%!assert ([ "" 65*ones(1,10) ], "AAAAAAAAAA"); -%!assert ([ 65*ones(1,10) "" ], "AAAAAAAAAA"); - -%!test -%! c = {"foo"; "bar"; "bazoloa"}; -%! assert ([c; "a"; "bc"; "def"], {"foo"; "bar"; "bazoloa"; "a"; "bc"; "def"}); - -%!assert (class ([int64(1), int64(1)]), "int64") -%!assert (class ([int64(1), int32(1)]), "int64") -%!assert (class ([int64(1), int16(1)]), "int64") -%!assert (class ([int64(1), int8(1)]), "int64") -%!assert (class ([int64(1), uint64(1)]), "int64") -%!assert (class ([int64(1), uint32(1)]), "int64") -%!assert (class ([int64(1), uint16(1)]), "int64") -%!assert (class ([int64(1), uint8(1)]), "int64") -%!assert (class ([int64(1), single(1)]), "int64") -%!assert (class ([int64(1), double(1)]), "int64") -%!assert (class ([int64(1), cell(1)]), "cell") -%!assert (class ([int64(1), true]), "int64") -%!assert (class ([int64(1), "a"]), "char") - -%!assert (class ([int32(1), int64(1)]), "int32") -%!assert (class ([int32(1), int32(1)]), "int32") -%!assert (class ([int32(1), int16(1)]), "int32") -%!assert (class ([int32(1), int8(1)]), "int32") -%!assert (class ([int32(1), uint64(1)]), "int32") -%!assert (class ([int32(1), uint32(1)]), "int32") -%!assert (class ([int32(1), uint16(1)]), "int32") -%!assert (class ([int32(1), uint8(1)]), "int32") -%!assert (class ([int32(1), single(1)]), "int32") -%!assert (class ([int32(1), double(1)]), "int32") -%!assert (class ([int32(1), cell(1)]), "cell") -%!assert (class ([int32(1), true]), "int32") -%!assert (class ([int32(1), "a"]), "char") - -%!assert (class ([int16(1), int64(1)]), "int16") -%!assert (class ([int16(1), int32(1)]), "int16") -%!assert (class ([int16(1), int16(1)]), "int16") -%!assert (class ([int16(1), int8(1)]), "int16") -%!assert (class ([int16(1), uint64(1)]), "int16") -%!assert (class ([int16(1), uint32(1)]), "int16") -%!assert (class ([int16(1), uint16(1)]), "int16") -%!assert (class ([int16(1), uint8(1)]), "int16") -%!assert (class ([int16(1), single(1)]), "int16") -%!assert (class ([int16(1), double(1)]), "int16") -%!assert (class ([int16(1), cell(1)]), "cell") -%!assert (class ([int16(1), true]), "int16") -%!assert (class ([int16(1), "a"]), "char") - -%!assert (class ([int8(1), int64(1)]), "int8") -%!assert (class ([int8(1), int32(1)]), "int8") -%!assert (class ([int8(1), int16(1)]), "int8") -%!assert (class ([int8(1), int8(1)]), "int8") -%!assert (class ([int8(1), uint64(1)]), "int8") -%!assert (class ([int8(1), uint32(1)]), "int8") -%!assert (class ([int8(1), uint16(1)]), "int8") -%!assert (class ([int8(1), uint8(1)]), "int8") -%!assert (class ([int8(1), single(1)]), "int8") -%!assert (class ([int8(1), double(1)]), "int8") -%!assert (class ([int8(1), cell(1)]), "cell") -%!assert (class ([int8(1), true]), "int8") -%!assert (class ([int8(1), "a"]), "char") - -%!assert (class ([uint64(1), int64(1)]), "uint64") -%!assert (class ([uint64(1), int32(1)]), "uint64") -%!assert (class ([uint64(1), int16(1)]), "uint64") -%!assert (class ([uint64(1), int8(1)]), "uint64") -%!assert (class ([uint64(1), uint64(1)]), "uint64") -%!assert (class ([uint64(1), uint32(1)]), "uint64") -%!assert (class ([uint64(1), uint16(1)]), "uint64") -%!assert (class ([uint64(1), uint8(1)]), "uint64") -%!assert (class ([uint64(1), single(1)]), "uint64") -%!assert (class ([uint64(1), double(1)]), "uint64") -%!assert (class ([uint64(1), cell(1)]), "cell") -%!assert (class ([uint64(1), true]), "uint64") -%!assert (class ([uint64(1), "a"]), "char") - -%!assert (class ([uint32(1), int64(1)]), "uint32") -%!assert (class ([uint32(1), int32(1)]), "uint32") -%!assert (class ([uint32(1), int16(1)]), "uint32") -%!assert (class ([uint32(1), int8(1)]), "uint32") -%!assert (class ([uint32(1), uint64(1)]), "uint32") -%!assert (class ([uint32(1), uint32(1)]), "uint32") -%!assert (class ([uint32(1), uint16(1)]), "uint32") -%!assert (class ([uint32(1), uint8(1)]), "uint32") -%!assert (class ([uint32(1), single(1)]), "uint32") -%!assert (class ([uint32(1), double(1)]), "uint32") -%!assert (class ([uint32(1), cell(1)]), "cell") -%!assert (class ([uint32(1), true]), "uint32") -%!assert (class ([uint32(1), "a"]), "char") - -%!assert (class ([uint16(1), int64(1)]), "uint16") -%!assert (class ([uint16(1), int32(1)]), "uint16") -%!assert (class ([uint16(1), int16(1)]), "uint16") -%!assert (class ([uint16(1), int8(1)]), "uint16") -%!assert (class ([uint16(1), uint64(1)]), "uint16") -%!assert (class ([uint16(1), uint32(1)]), "uint16") -%!assert (class ([uint16(1), uint16(1)]), "uint16") -%!assert (class ([uint16(1), uint8(1)]), "uint16") -%!assert (class ([uint16(1), single(1)]), "uint16") -%!assert (class ([uint16(1), double(1)]), "uint16") -%!assert (class ([uint16(1), cell(1)]), "cell") -%!assert (class ([uint16(1), true]), "uint16") -%!assert (class ([uint16(1), "a"]), "char") - -%!assert (class ([uint8(1), int64(1)]), "uint8") -%!assert (class ([uint8(1), int32(1)]), "uint8") -%!assert (class ([uint8(1), int16(1)]), "uint8") -%!assert (class ([uint8(1), int8(1)]), "uint8") -%!assert (class ([uint8(1), uint64(1)]), "uint8") -%!assert (class ([uint8(1), uint32(1)]), "uint8") -%!assert (class ([uint8(1), uint16(1)]), "uint8") -%!assert (class ([uint8(1), uint8(1)]), "uint8") -%!assert (class ([uint8(1), single(1)]), "uint8") -%!assert (class ([uint8(1), double(1)]), "uint8") -%!assert (class ([uint8(1), cell(1)]), "cell") -%!assert (class ([uint8(1), true]), "uint8") -%!assert (class ([uint8(1), "a"]), "char") - -%!assert (class ([single(1), int64(1)]), "int64") -%!assert (class ([single(1), int32(1)]), "int32") -%!assert (class ([single(1), int16(1)]), "int16") -%!assert (class ([single(1), int8(1)]), "int8") -%!assert (class ([single(1), uint64(1)]), "uint64") -%!assert (class ([single(1), uint32(1)]), "uint32") -%!assert (class ([single(1), uint16(1)]), "uint16") -%!assert (class ([single(1), uint8(1)]), "uint8") -%!assert (class ([single(1), single(1)]), "single") -%!assert (class ([single(1), double(1)]), "single") -%!assert (class ([single(1), cell(1)]), "cell") -%!assert (class ([single(1), true]), "single") -%!assert (class ([single(1), "a"]), "char") - -%!assert (class ([double(1), int64(1)]), "int64") -%!assert (class ([double(1), int32(1)]), "int32") -%!assert (class ([double(1), int16(1)]), "int16") -%!assert (class ([double(1), int8(1)]), "int8") -%!assert (class ([double(1), uint64(1)]), "uint64") -%!assert (class ([double(1), uint32(1)]), "uint32") -%!assert (class ([double(1), uint16(1)]), "uint16") -%!assert (class ([double(1), uint8(1)]), "uint8") -%!assert (class ([double(1), single(1)]), "single") -%!assert (class ([double(1), double(1)]), "double") -%!assert (class ([double(1), cell(1)]), "cell") -%!assert (class ([double(1), true]), "double") -%!assert (class ([double(1), "a"]), "char") - -%!assert (class ([cell(1), int64(1)]), "cell") -%!assert (class ([cell(1), int32(1)]), "cell") -%!assert (class ([cell(1), int16(1)]), "cell") -%!assert (class ([cell(1), int8(1)]), "cell") -%!assert (class ([cell(1), uint64(1)]), "cell") -%!assert (class ([cell(1), uint32(1)]), "cell") -%!assert (class ([cell(1), uint16(1)]), "cell") -%!assert (class ([cell(1), uint8(1)]), "cell") -%!assert (class ([cell(1), single(1)]), "cell") -%!assert (class ([cell(1), double(1)]), "cell") -%!assert (class ([cell(1), cell(1)]), "cell") -%!assert (class ([cell(1), true]), "cell") -%!assert (class ([cell(1), "a"]), "cell") - -%!assert (class ([true, int64(1)]), "int64") -%!assert (class ([true, int32(1)]), "int32") -%!assert (class ([true, int16(1)]), "int16") -%!assert (class ([true, int8(1)]), "int8") -%!assert (class ([true, uint64(1)]), "uint64") -%!assert (class ([true, uint32(1)]), "uint32") -%!assert (class ([true, uint16(1)]), "uint16") -%!assert (class ([true, uint8(1)]), "uint8") -%!assert (class ([true, single(1)]), "single") -%!assert (class ([true, double(1)]), "double") -%!assert (class ([true, cell(1)]), "cell") -%!assert (class ([true, true]), "logical") -%!assert (class ([true, "a"]), "char") - -%!assert (class (["a", int64(1)]), "char") -%!assert (class (["a", int32(1)]), "char") -%!assert (class (["a", int16(1)]), "char") -%!assert (class (["a", int8(1)]), "char") -%!assert (class (["a", int64(1)]), "char") -%!assert (class (["a", int32(1)]), "char") -%!assert (class (["a", int16(1)]), "char") -%!assert (class (["a", int8(1)]), "char") -%!assert (class (["a", single(1)]), "char") -%!assert (class (["a", double(1)]), "char") -%!assert (class (["a", cell(1)]), "cell") -%!assert (class (["a", true]), "char") -%!assert (class (["a", "a"]), "char") - -%!assert (class ([cell(1), struct("foo", "bar")]), "cell") -%!error [struct("foo", "bar"), cell(1)] -*/ - -DEFUN (string_fill_char, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} string_fill_char ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} string_fill_char (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} string_fill_char (@var{new_val}, \"local\")\n\ -Query or set the internal variable used to pad all rows of a character\n\ -matrix to the same length. It must be a single character. The default\n\ -value is @code{\" \"} (a single space). For example:\n\ -\n\ -@example\n\ -@group\n\ -string_fill_char (\"X\");\n\ -[ \"these\"; \"are\"; \"strings\" ]\n\ - @result{} \"theseXX\"\n\ - \"areXXXX\"\n\ - \"strings\"\n\ -@end group\n\ -@end example\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (string_fill_char); -} - -/* -## string_fill_char() function call must be outside of %!test block -## due to the way a %!test block is wrapped inside a function -%!shared orig_val, old_val -%! orig_val = string_fill_char (); -%! old_val = string_fill_char ("X"); -%!test -%! assert (orig_val, old_val); -%! assert (string_fill_char (), "X"); -%! assert (["these"; "are"; "strings"], ["theseXX"; "areXXXX"; "strings"]); -%! string_fill_char (orig_val); -%! assert (string_fill_char (), orig_val); - -%!error (string_fill_char (1, 2)) -*/ diff -r d02b229ce693 -r a132d206a36a src/pt-mat.h --- a/src/pt-mat.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,95 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_mat_h) -#define octave_tree_mat_h 1 - -#include - -class octave_value; -class octave_value_list; -class tree_argument_list; - -class tree_walker; - -#include "base-list.h" -#include "pt-exp.h" -#include "symtab.h" - -// General matrices. This allows us to construct matrices from -// other matrices, variables, and functions. - -class -tree_matrix : public tree_expression, - public octave_base_list -{ -public: - - tree_matrix (tree_argument_list *row = 0, int l = -1, int c = -1) - : tree_expression (l, c) - { - if (row) - append (row); - } - - ~tree_matrix (void); - - bool has_magic_end (void) const; - - bool all_elements_are_constant (void) const; - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // No copying! - - tree_matrix (const tree_matrix&); - - tree_matrix& operator = (const tree_matrix&); -}; - -// The character to fill with when creating string arrays. -extern char Vstring_fill_char; - -extern std::string -get_concat_class (const std::string& c1, const std::string& c2); - -extern void -maybe_warn_string_concat (bool all_dq_strings_p, bool all_sq_strings_p); - -extern std::string -get_concat_class (const std::string& c1, const std::string& c2); - -extern void -maybe_warn_string_concat (bool all_dq_strings_p, bool all_sq_strings_p); - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-misc.cc --- a/src/pt-misc.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,353 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "Cell.h" - -#include "defun.h" -#include "error.h" -#include "ov.h" -#include "oct-lvalue.h" -#include "pt-id.h" -#include "pt-idx.h" -#include "pt-misc.h" -#include "pt-walk.h" -#include "utils.h" - -// Parameter lists. - -tree_parameter_list::~tree_parameter_list (void) -{ - while (! empty ()) - { - iterator p = begin (); - delete *p; - erase (p); - } -} - -void -tree_parameter_list::mark_as_formal_parameters (void) -{ - for (iterator p = begin (); p != end (); p++) - { - tree_decl_elt *elt = *p; - elt->mark_as_formal_parameter (); - } -} - -bool -tree_parameter_list::validate (in_or_out type) -{ - bool retval = true; - - std::set dict; - - for (iterator p = begin (); p != end (); p++) - { - tree_decl_elt *elt = *p; - - tree_identifier *id = elt->ident (); - - if (id) - { - std::string name = id->name (); - - if (id->is_black_hole ()) - { - if (type != in) - error ("invalid use of ~ in output list"); - } - else if (dict.find (name) != dict.end ()) - { - retval = false; - error ("`%s' appears more than once in parameter list", - name.c_str ()); - break; - } - else - dict.insert (name); - } - } - - if (! error_state) - { - std::string va_type = (type == in ? "varargin" : "varargout"); - - size_t len = length (); - - if (len > 0) - { - tree_decl_elt *elt = back (); - - tree_identifier *id = elt->ident (); - - if (id && id->name () == va_type) - { - if (len == 1) - mark_varargs_only (); - else - mark_varargs (); - - iterator p = end (); - --p; - delete *p; - erase (p); - } - } - } - - return retval; -} - -void -tree_parameter_list::initialize_undefined_elements (const std::string& warnfor, - int nargout, const octave_value& val) -{ - bool warned = false; - - int count = 0; - - octave_value tmp = symbol_table::varval (".ignored."); - const Matrix ignored = tmp.is_defined () ? tmp.matrix_value () : Matrix (); - - octave_idx_type k = 0; - - for (iterator p = begin (); p != end (); p++) - { - if (++count > nargout) - break; - - tree_decl_elt *elt = *p; - - if (! elt->is_variable ()) - { - if (! warned) - { - warned = true; - - while (k < ignored.numel ()) - { - octave_idx_type l = ignored (k); - if (l == count) - { - warned = false; - break; - } - else if (l > count) - break; - else - k++; - } - - if (warned) - { - warning_with_id - ("Octave:undefined-return-values", - "%s: some elements in list of return values are undefined", - warnfor.c_str ()); - } - } - - octave_lvalue lval = elt->lvalue (); - - lval.assign (octave_value::op_asn_eq, val); - } - } -} - -void -tree_parameter_list::define_from_arg_vector (const octave_value_list& args) -{ - int nargin = args.length (); - - int expected_nargin = length (); - - iterator p = begin (); - - for (int i = 0; i < expected_nargin; i++) - { - tree_decl_elt *elt = *p++; - - octave_lvalue ref = elt->lvalue (); - - if (i < nargin) - { - if (args(i).is_defined () && args(i).is_magic_colon ()) - { - if (! elt->eval ()) - { - ::error ("no default value for argument %d\n", i+1); - return; - } - } - else - ref.define (args(i)); - } - else - elt->eval (); - } -} - -void -tree_parameter_list::undefine (void) -{ - int len = length (); - - iterator p = begin (); - - for (int i = 0; i < len; i++) - { - tree_decl_elt *elt = *p++; - - octave_lvalue ref = elt->lvalue (); - - ref.assign (octave_value::op_asn_eq, octave_value ()); - } -} - -octave_value_list -tree_parameter_list::convert_to_const_vector (int nargout, - const Cell& varargout) -{ - octave_idx_type vlen = varargout.numel (); - int len = length (); - - // Special case. Will do a shallow copy. - if (len == 0) - return varargout; - else if (nargout <= len) - { - octave_value_list retval (nargout); - - int i = 0; - - for (iterator p = begin (); p != end (); p++) - { - tree_decl_elt *elt = *p; - if (elt->is_defined ()) - retval(i++) = elt->rvalue1 (); - else - break; - } - - return retval; - } - else - { - octave_value_list retval (len + vlen); - - int i = 0; - - for (iterator p = begin (); p != end (); p++) - { - tree_decl_elt *elt = *p; - retval(i++) = elt->rvalue1 (); - } - - for (octave_idx_type j = 0; j < vlen; j++) - retval(i++) = varargout(j); - - return retval; - } -} - -bool -tree_parameter_list::is_defined (void) -{ - bool status = true; - - for (iterator p = begin (); p != end (); p++) - { - tree_decl_elt *elt = *p; - - if (! elt->is_variable ()) - { - status = false; - break; - } - } - - return status; -} - -tree_parameter_list * -tree_parameter_list::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_parameter_list *new_list = new tree_parameter_list (); - - if (takes_varargs ()) - new_list->mark_varargs (); - - for (const_iterator p = begin (); p != end (); p++) - { - const tree_decl_elt *elt = *p; - - new_list->append (elt->dup (scope, context)); - } - - return new_list; -} - -void -tree_parameter_list::accept (tree_walker& tw) -{ - tw.visit_parameter_list (*this); -} - -// Return lists. - -tree_return_list::~tree_return_list (void) -{ - while (! empty ()) - { - iterator p = begin (); - delete *p; - erase (p); - } -} - -tree_return_list * -tree_return_list::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_return_list *new_list = new tree_return_list (); - - for (const_iterator p = begin (); p != end (); p++) - { - const tree_index_expression *elt = *p; - - new_list->append (elt->dup (scope, context)); - } - - return new_list; -} - -void -tree_return_list::accept (tree_walker& tw) -{ - tw.visit_return_list (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-misc.h --- a/src/pt-misc.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_misc_h) -#define octave_tree_misc_h 1 - -class Cell; - -class octave_value; -class octave_value_list; - -class tree_identifier; -class tree_index_expression; -class tree_va_return_list; - -class tree_walker; - -#include "base-list.h" -#include "pt-decl.h" -#include "symtab.h" - -// Parameter lists. Used to hold the list of input and output -// parameters in a function definition. Elements are identifiers -// only. - -class -tree_parameter_list : public octave_base_list -{ -public: - - enum in_or_out - { - in = 1, - out = 2 - }; - - tree_parameter_list (void) - : marked_for_varargs (0) { } - - tree_parameter_list (tree_decl_elt *t) - : marked_for_varargs (0) { append (t); } - - ~tree_parameter_list (void); - - void mark_as_formal_parameters (void); - - bool validate (in_or_out type); - - bool takes_varargs (void) const { return marked_for_varargs != 0; } - - bool varargs_only (void) { return (marked_for_varargs < 0); } - - void initialize_undefined_elements (const std::string& warnfor, - int nargout, const octave_value& val); - - void define_from_arg_vector (const octave_value_list& args); - - void undefine (void); - - bool is_defined (void); - - octave_value_list convert_to_const_vector (int nargout, const Cell& varargout); - - tree_parameter_list *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - int marked_for_varargs; - - void mark_varargs (void) { marked_for_varargs = 1; } - - void mark_varargs_only (void) { marked_for_varargs = -1; } - - // No copying! - - tree_parameter_list (const tree_parameter_list&); - - tree_parameter_list& operator = (const tree_parameter_list&); -}; - -// Return lists. Used to hold the right hand sides of multiple -// assignment expressions. - -class -tree_return_list : public octave_base_list -{ -public: - - tree_return_list (void) { } - - tree_return_list (tree_index_expression *t) { append (t); } - - ~tree_return_list (void); - - tree_return_list *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // No copying! - - tree_return_list (const tree_return_list&); - - tree_return_list& operator = (const tree_return_list&); -}; - -class -tree_va_return_list : public octave_base_list -{ -public: - - tree_va_return_list (void) { } - - ~tree_va_return_list (void) { } - -private: - - // No copying! - - tree_va_return_list (const tree_va_return_list&); - - tree_va_return_list& operator = (const tree_va_return_list&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-pr-code.cc --- a/src/pt-pr-code.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1322 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "comment-list.h" -#include "error.h" -#include "ov-usr-fcn.h" -#include "pr-output.h" -#include "pt-all.h" - -void -tree_print_code::visit_anon_fcn_handle (tree_anon_fcn_handle& afh) -{ - indent (); - - print_parens (afh, "("); - - os << "@("; - - tree_parameter_list *param_list = afh.parameter_list (); - - if (param_list) - param_list->accept (*this); - - os << ") "; - - print_fcn_handle_body (afh.body ()); - - print_parens (afh, ")"); -} - -void -tree_print_code::visit_argument_list (tree_argument_list& lst) -{ - tree_argument_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_expression *elt = *p++; - - if (elt) - { - elt->accept (*this); - - if (p != lst.end ()) - os << ", "; - } - } -} - -void -tree_print_code::visit_binary_expression (tree_binary_expression& expr) -{ - indent (); - - print_parens (expr, "("); - - tree_expression *op1 = expr.lhs (); - - if (op1) - op1->accept (*this); - - os << " " << expr.oper () << " "; - - tree_expression *op2 = expr.rhs (); - - if (op2) - op2->accept (*this); - - print_parens (expr, ")"); -} - -void -tree_print_code::visit_break_command (tree_break_command&) -{ - indent (); - - os << "break"; -} - -void -tree_print_code::visit_colon_expression (tree_colon_expression& expr) -{ - indent (); - - print_parens (expr, "("); - - tree_expression *op1 = expr.base (); - - if (op1) - op1->accept (*this); - - // Stupid syntax. - - tree_expression *op3 = expr.increment (); - - if (op3) - { - os << ":"; - op3->accept (*this); - } - - tree_expression *op2 = expr.limit (); - - if (op2) - { - os << ":"; - op2->accept (*this); - } - - print_parens (expr, ")"); -} - -void -tree_print_code::visit_continue_command (tree_continue_command&) -{ - indent (); - - os << "continue"; -} - -void -tree_print_code::do_decl_command (tree_decl_command& cmd) -{ - indent (); - - os << cmd.name () << " "; - - tree_decl_init_list *init_list = cmd.initializer_list (); - - if (init_list) - init_list->accept (*this); -} - -void -tree_print_code::visit_global_command (tree_global_command& cmd) -{ - do_decl_command (cmd); -} - -void -tree_print_code::visit_persistent_command (tree_persistent_command& cmd) -{ - do_decl_command (cmd); -} - -void -tree_print_code::visit_decl_elt (tree_decl_elt& cmd) -{ - tree_identifier *id = cmd.ident (); - - if (id) - id->accept (*this); - - tree_expression *expr = cmd.expression (); - - if (expr) - { - os << " = "; - - expr->accept (*this); - } -} - -void -tree_print_code::visit_decl_init_list (tree_decl_init_list& lst) -{ - tree_decl_init_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_decl_elt *elt = *p++; - - if (elt) - { - elt->accept (*this); - - if (p != lst.end ()) - os << ", "; - } - } -} - -void -tree_print_code::visit_simple_for_command (tree_simple_for_command& cmd) -{ - print_comment_list (cmd.leading_comment ()); - - indent (); - - os << (cmd.in_parallel () ? "parfor " : "for "); - - tree_expression *lhs = cmd.left_hand_side (); - - tree_expression *maxproc = cmd.maxproc_expr (); - - if (maxproc) - os << "("; - - if (lhs) - lhs->accept (*this); - - os << " = "; - - tree_expression *expr = cmd.control_expr (); - - if (expr) - expr->accept (*this); - - if (maxproc) - { - os << ", "; - maxproc->accept (*this); - os << ")"; - } - - newline (); - - tree_statement_list *list = cmd.body (); - - if (list) - { - increment_indent_level (); - - list->accept (*this); - - decrement_indent_level (); - } - - print_indented_comment (cmd.trailing_comment ()); - - indent (); - - os << (cmd.in_parallel () ? "endparfor" : "endfor"); -} - -void -tree_print_code::visit_complex_for_command (tree_complex_for_command& cmd) -{ - print_comment_list (cmd.leading_comment ()); - - indent (); - - os << "for ["; - nesting.push ('['); - - tree_argument_list *lhs = cmd.left_hand_side (); - - if (lhs) - lhs->accept (*this); - - nesting.pop (); - os << "] = "; - - tree_expression *expr = cmd.control_expr (); - - if (expr) - expr->accept (*this); - - newline (); - - tree_statement_list *list = cmd.body (); - - if (list) - { - increment_indent_level (); - - list->accept (*this); - - decrement_indent_level (); - } - - print_indented_comment (cmd.trailing_comment ()); - - indent (); - - os << "endfor"; -} - -void -tree_print_code::visit_octave_user_script (octave_user_script& fcn) -{ - reset (); - - tree_statement_list *cmd_list = fcn.body (); - - if (cmd_list) - cmd_list->accept (*this); -} - -void -tree_print_code::visit_octave_user_function (octave_user_function& fcn) -{ - reset (); - - visit_octave_user_function_header (fcn); - - tree_statement_list *cmd_list = fcn.body (); - - if (cmd_list) - { - increment_indent_level (); - - cmd_list->accept (*this); - - decrement_indent_level (); - } - - visit_octave_user_function_trailer (fcn); -} - -void -tree_print_code::visit_octave_user_function_header (octave_user_function& fcn) -{ - octave_comment_list *leading_comment = fcn.leading_comment (); - - if (leading_comment) - { - print_comment_list (leading_comment); - newline (); - } - - indent (); - - os << "function "; - - tree_parameter_list *ret_list = fcn.return_list (); - - if (ret_list) - { - bool takes_var_return = fcn.takes_var_return (); - - int len = ret_list->length (); - - if (len > 1 || takes_var_return) - { - os << "["; - nesting.push ('['); - } - - ret_list->accept (*this); - - if (takes_var_return) - { - if (len > 0) - os << ", "; - - os << "varargout"; - } - - if (len > 1 || takes_var_return) - { - nesting.pop (); - os << "]"; - } - - os << " = "; - } - - std::string fcn_name = fcn.name (); - - os << (fcn_name.empty () ? std::string ("(empty)") : fcn_name) << " "; - - tree_parameter_list *param_list = fcn.parameter_list (); - - if (param_list) - { - bool takes_varargs = fcn.takes_varargs (); - - int len = param_list->length (); - - if (len > 0 || takes_varargs) - { - os << "("; - nesting.push ('('); - } - - param_list->accept (*this); - - if (takes_varargs) - { - if (len > 0) - os << ", "; - - os << "varargin"; - } - - if (len > 0 || takes_varargs) - { - nesting.pop (); - os << ")"; - newline (); - } - } - else - { - os << "()"; - newline (); - } -} - -void -tree_print_code::visit_octave_user_function_trailer (octave_user_function& fcn) -{ - print_indented_comment (fcn.trailing_comment ()); - - newline (); -} - -void -tree_print_code::visit_function_def (tree_function_def& fdef) -{ - indent (); - - octave_value fcn = fdef.function (); - - octave_function *f = fcn.function_value (); - - if (f) - f->accept (*this); -} - -void -tree_print_code::visit_identifier (tree_identifier& id) -{ - indent (); - - print_parens (id, "("); - - std::string nm = id.name (); - os << (nm.empty () ? std::string ("(empty)") : nm); - - print_parens (id, ")"); -} - -void -tree_print_code::visit_if_clause (tree_if_clause& cmd) -{ - tree_expression *expr = cmd.condition (); - - if (expr) - expr->accept (*this); - - newline (); - - tree_statement_list *list = cmd.commands (); - - if (list) - { - increment_indent_level (); - - list->accept (*this); - - decrement_indent_level (); - } -} - -void -tree_print_code::visit_if_command (tree_if_command& cmd) -{ - print_comment_list (cmd.leading_comment ()); - - indent (); - - os << "if "; - - tree_if_command_list *list = cmd.cmd_list (); - - if (list) - list->accept (*this); - - print_indented_comment (cmd.trailing_comment ()); - - indent (); - - os << "endif"; -} - -void -tree_print_code::visit_if_command_list (tree_if_command_list& lst) -{ - tree_if_command_list::iterator p = lst.begin (); - - bool first_elt = true; - - while (p != lst.end ()) - { - tree_if_clause *elt = *p++; - - if (elt) - { - if (! first_elt) - { - print_indented_comment (elt->leading_comment ()); - - indent (); - - if (elt->is_else_clause ()) - os << "else"; - else - os << "elseif "; - } - - elt->accept (*this); - } - - first_elt = false; - } -} - -void -tree_print_code::visit_index_expression (tree_index_expression& expr) -{ - indent (); - - print_parens (expr, "("); - - tree_expression *e = expr.expression (); - - if (e) - e->accept (*this); - - std::list arg_lists = expr.arg_lists (); - std::string type_tags = expr.type_tags (); - std::list arg_names = expr.arg_names (); - - int n = type_tags.length (); - - std::list::iterator p_arg_lists = arg_lists.begin (); - std::list::iterator p_arg_names = arg_names.begin (); - - for (int i = 0; i < n; i++) - { - switch (type_tags[i]) - { - case '(': - { - char nc = nesting.top (); - if ((nc == '[' || nc == '{') && expr.paren_count () == 0) - os << "("; - else - os << " ("; - nesting.push ('('); - - tree_argument_list *l = *p_arg_lists; - if (l) - l->accept (*this); - - nesting.pop (); - os << ")"; - } - break; - - case '{': - { - char nc = nesting.top (); - if ((nc == '[' || nc == '{') && expr.paren_count () == 0) - os << "{"; - else - os << " {"; - // We only care about whitespace inside [] and {} when we - // are defining matrix and cell objects, not when indexing. - nesting.push ('('); - - tree_argument_list *l = *p_arg_lists; - if (l) - l->accept (*this); - - nesting.pop (); - os << "}"; - } - break; - - case '.': - { - string_vector nm = *p_arg_names; - assert (nm.length () == 1); - os << "." << nm(0); - } - break; - - default: - panic_impossible (); - } - - p_arg_lists++; - p_arg_names++; - } - - print_parens (expr, ")"); -} - -void -tree_print_code::visit_matrix (tree_matrix& lst) -{ - indent (); - - print_parens (lst, "("); - - os << "["; - nesting.push ('['); - - tree_matrix::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_argument_list *elt = *p++; - - if (elt) - { - elt->accept (*this); - - if (p != lst.end ()) - os << "; "; - } - } - - nesting.pop (); - os << "]"; - - print_parens (lst, ")"); -} - -void -tree_print_code::visit_cell (tree_cell& lst) -{ - indent (); - - print_parens (lst, "("); - - os << "{"; - nesting.push ('{'); - - tree_cell::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_argument_list *elt = *p++; - - if (elt) - { - elt->accept (*this); - - if (p != lst.end ()) - os << "; "; - } - } - - nesting.pop (); - os << "}"; - - print_parens (lst, ")"); -} - -void -tree_print_code::visit_multi_assignment (tree_multi_assignment& expr) -{ - indent (); - - print_parens (expr, "("); - - tree_argument_list *lhs = expr.left_hand_side (); - - if (lhs) - { - int len = lhs->length (); - - if (len > 1) - { - os << "["; - nesting.push ('['); - } - - lhs->accept (*this); - - if (len > 1) - { - nesting.pop (); - os << "]"; - } - } - - os << " " << expr.oper () << " "; - - tree_expression *rhs = expr.right_hand_side (); - - if (rhs) - rhs->accept (*this); - - print_parens (expr, ")"); -} - -void -tree_print_code::visit_no_op_command (tree_no_op_command& cmd) -{ - indent (); - - os << cmd.original_command (); -} - -void -tree_print_code::visit_constant (tree_constant& val) -{ - indent (); - - print_parens (val, "("); - - val.print_raw (os, true, print_original_text); - - print_parens (val, ")"); -} - -void -tree_print_code::visit_fcn_handle (tree_fcn_handle& fh) -{ - indent (); - - print_parens (fh, "("); - - fh.print_raw (os, true, print_original_text); - - print_parens (fh, ")"); -} - -void -tree_print_code::visit_parameter_list (tree_parameter_list& lst) -{ - tree_parameter_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_decl_elt *elt = *p++; - - if (elt) - { - elt->accept (*this); - - if (p != lst.end ()) - os << ", "; - } - } -} - -void -tree_print_code::visit_postfix_expression (tree_postfix_expression& expr) -{ - indent (); - - print_parens (expr, "("); - - tree_expression *e = expr.operand (); - - if (e) - e->accept (*this); - - os << expr.oper (); - - print_parens (expr, ")"); -} - -void -tree_print_code::visit_prefix_expression (tree_prefix_expression& expr) -{ - indent (); - - print_parens (expr, "("); - - os << expr.oper (); - - tree_expression *e = expr.operand (); - - if (e) - e->accept (*this); - - print_parens (expr, ")"); -} - -void -tree_print_code::visit_return_command (tree_return_command&) -{ - indent (); - - os << "return"; -} - -void -tree_print_code::visit_return_list (tree_return_list& lst) -{ - tree_return_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_index_expression *elt = *p++; - - if (elt) - { - elt->accept (*this); - - if (p != lst.end ()) - os << ", "; - } - } -} - -void -tree_print_code::visit_simple_assignment (tree_simple_assignment& expr) -{ - indent (); - - print_parens (expr, "("); - - tree_expression *lhs = expr.left_hand_side (); - - if (lhs) - lhs->accept (*this); - - os << " " << expr.oper () << " "; - - tree_expression *rhs = expr.right_hand_side (); - - if (rhs) - rhs->accept (*this); - - print_parens (expr, ")"); -} - -void -tree_print_code::visit_statement (tree_statement& stmt) -{ - print_comment_list (stmt.comment_text ()); - - tree_command *cmd = stmt.command (); - - if (cmd) - { - cmd->accept (*this); - - if (! stmt.print_result ()) - { - os << ";"; - newline (" "); - } - else - newline (); - } - else - { - tree_expression *expr = stmt.expression (); - - if (expr) - { - expr->accept (*this); - - if (! stmt.print_result ()) - { - os << ";"; - newline (" "); - } - else - newline (); - } - } -} - -void -tree_print_code::visit_statement_list (tree_statement_list& lst) -{ - for (tree_statement_list::iterator p = lst.begin (); p != lst.end (); p++) - { - tree_statement *elt = *p; - - if (elt) - elt->accept (*this); - } -} - -void -tree_print_code::visit_switch_case (tree_switch_case& cs) -{ - print_comment_list (cs.leading_comment ()); - - indent (); - - if (cs.is_default_case ()) - os << "otherwise"; - else - os << "case "; - - tree_expression *label = cs.case_label (); - - if (label) - label->accept (*this); - - newline (); - - tree_statement_list *list = cs.commands (); - - if (list) - { - increment_indent_level (); - - list->accept (*this); - - newline (); - - decrement_indent_level (); - } -} - -void -tree_print_code::visit_switch_case_list (tree_switch_case_list& lst) -{ - tree_switch_case_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_switch_case *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_print_code::visit_switch_command (tree_switch_command& cmd) -{ - print_comment_list (cmd.leading_comment ()); - - indent (); - - os << "switch "; - - tree_expression *expr = cmd.switch_value (); - - if (expr) - expr->accept (*this); - - newline (); - - tree_switch_case_list *list = cmd.case_list (); - - if (list) - { - increment_indent_level (); - - list->accept (*this); - - decrement_indent_level (); - } - - print_indented_comment (cmd.leading_comment ()); - - indent (); - - os << "endswitch"; -} - -void -tree_print_code::visit_try_catch_command (tree_try_catch_command& cmd) -{ - print_comment_list (cmd.leading_comment ()); - - indent (); - - os << "try"; - - newline (); - - tree_statement_list *try_code = cmd.body (); - - if (try_code) - { - increment_indent_level (); - - try_code->accept (*this); - - decrement_indent_level (); - } - - print_indented_comment (cmd.middle_comment ()); - - indent (); - - os << "catch"; - - newline (); - - tree_statement_list *catch_code = cmd.cleanup (); - - if (catch_code) - { - increment_indent_level (); - - catch_code->accept (*this); - - decrement_indent_level (); - } - - print_indented_comment (cmd.trailing_comment ()); - - indent (); - - os << "end_try_catch"; -} - -void -tree_print_code::visit_unwind_protect_command - (tree_unwind_protect_command& cmd) -{ - print_comment_list (cmd.leading_comment ()); - - indent (); - - os << "unwind_protect"; - - newline (); - - tree_statement_list *unwind_protect_code = cmd.body (); - - if (unwind_protect_code) - { - increment_indent_level (); - - unwind_protect_code->accept (*this); - - decrement_indent_level (); - } - - print_indented_comment (cmd.middle_comment ()); - - indent (); - - os << "unwind_protect_cleanup"; - - newline (); - - tree_statement_list *cleanup_code = cmd.cleanup (); - - if (cleanup_code) - { - increment_indent_level (); - - cleanup_code->accept (*this); - - decrement_indent_level (); - } - - print_indented_comment (cmd.trailing_comment ()); - - indent (); - - os << "end_unwind_protect"; -} - -void -tree_print_code::visit_while_command (tree_while_command& cmd) -{ - print_comment_list (cmd.leading_comment ()); - - indent (); - - os << "while "; - - tree_expression *expr = cmd.condition (); - - if (expr) - expr->accept (*this); - - newline (); - - tree_statement_list *list = cmd.body (); - - if (list) - { - increment_indent_level (); - - list->accept (*this); - - decrement_indent_level (); - } - - print_indented_comment (cmd.trailing_comment ()); - - indent (); - - os << "endwhile"; -} - -void -tree_print_code::visit_do_until_command (tree_do_until_command& cmd) -{ - print_comment_list (cmd.leading_comment ()); - - indent (); - - os << "do"; - - newline (); - - tree_statement_list *list = cmd.body (); - - if (list) - { - increment_indent_level (); - - list->accept (*this); - - decrement_indent_level (); - } - - print_indented_comment (cmd.trailing_comment ()); - - indent (); - - os << "until"; - - tree_expression *expr = cmd.condition (); - - if (expr) - expr->accept (*this); - - newline (); -} - -void -tree_print_code::print_fcn_handle_body (tree_statement_list *b) -{ - if (b) - { - assert (b->length () == 1); - - tree_statement *s = b->front (); - - if (s) - { - if (s->is_expression ()) - { - tree_expression *e = s->expression (); - - if (e) - { - suppress_newlines++; - e->accept (*this); - suppress_newlines--; - } - } - else - { - tree_command *c = s->command (); - - suppress_newlines++; - c->accept (*this); - suppress_newlines--; - } - } - } -} - -// Each print_code() function should call this before printing -// anything. -// -// This doesn't need to be fast, but isn't there a better way? - -void -tree_print_code::indent (void) -{ - assert (curr_print_indent_level >= 0); - - if (beginning_of_line) - { - os << prefix; - - for (int i = 0; i < curr_print_indent_level; i++) - os << " "; - - beginning_of_line = false; - } -} - -// All print_code() functions should use this to print new lines. - -void -tree_print_code::newline (const char *alt_txt) -{ - if (suppress_newlines) - os << alt_txt; - else - { - os << "\n"; - - beginning_of_line = true; - } -} - -// For ressetting print_code state. - -void -tree_print_code::reset (void) -{ - beginning_of_line = true; - curr_print_indent_level = 0; - while (nesting.top () != 'n') - nesting.pop (); -} - -void -tree_print_code::print_parens (const tree_expression& expr, const char *txt) -{ - int n = expr.paren_count (); - - for (int i = 0; i < n; i++) - os << txt; -} - -void -tree_print_code::print_comment_elt (const octave_comment_elt& elt) -{ - bool printed_something = false; - - bool prev_char_was_newline = false; - - std::string comment = elt.text (); - - size_t len = comment.length (); - - size_t i = 0; - - while (i < len && comment[i++] == '\n') - ; /* Skip leading new lines. */ - i--; - - while (i < len) - { - char c = comment[i++]; - - if (c == '\n') - { - if (prev_char_was_newline) - os << "##"; - - newline (); - - prev_char_was_newline = true; - } - else - { - if (beginning_of_line) - { - printed_something = true; - - indent (); - - os << "##"; - - if (! (isspace (c) || c == '!')) - os << " "; - } - - os << static_cast (c); - - prev_char_was_newline = false; - } - } - - if (printed_something && ! beginning_of_line) - newline (); -} - -void -tree_print_code::print_comment_list (octave_comment_list *comment_list) -{ - if (comment_list) - { - octave_comment_list::iterator p = comment_list->begin (); - - while (p != comment_list->end ()) - { - octave_comment_elt elt = *p++; - - print_comment_elt (elt); - - if (p != comment_list->end ()) - newline (); - } - } -} - -void -tree_print_code::print_indented_comment (octave_comment_list *comment_list) -{ - increment_indent_level (); - - print_comment_list (comment_list); - - decrement_indent_level (); -} diff -r d02b229ce693 -r a132d206a36a src/pt-pr-code.h --- a/src/pt-pr-code.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,196 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_print_code_h) -#define octave_tree_print_code_h 1 - -#include -#include - -#include "comment-list.h" -#include "pt-walk.h" - -class tree_decl_command; -class tree_expression; - -// How to print the code that the parse trees represent. - -class -tree_print_code : public tree_walker -{ -public: - - tree_print_code (std::ostream& os_arg, - const std::string& pfx = std::string (), - bool pr_orig_txt = true) - : os (os_arg), prefix (pfx), nesting (), - print_original_text (pr_orig_txt), - curr_print_indent_level (0), beginning_of_line (true), - suppress_newlines (0) - { - // For "none". - nesting.push ('n'); - } - - ~tree_print_code (void) { } - - void visit_anon_fcn_handle (tree_anon_fcn_handle&); - - void visit_argument_list (tree_argument_list&); - - void visit_binary_expression (tree_binary_expression&); - - void visit_break_command (tree_break_command&); - - void visit_colon_expression (tree_colon_expression&); - - void visit_continue_command (tree_continue_command&); - - void visit_global_command (tree_global_command&); - - void visit_persistent_command (tree_persistent_command&); - - void visit_decl_elt (tree_decl_elt&); - - void visit_decl_init_list (tree_decl_init_list&); - - void visit_simple_for_command (tree_simple_for_command&); - - void visit_complex_for_command (tree_complex_for_command&); - - void visit_octave_user_script (octave_user_script&); - - void visit_octave_user_function (octave_user_function&); - - void visit_octave_user_function_header (octave_user_function&); - - void visit_octave_user_function_trailer (octave_user_function&); - - void visit_function_def (tree_function_def&); - - void visit_identifier (tree_identifier&); - - void visit_if_clause (tree_if_clause&); - - void visit_if_command (tree_if_command&); - - void visit_if_command_list (tree_if_command_list&); - - void visit_index_expression (tree_index_expression&); - - void visit_matrix (tree_matrix&); - - void visit_cell (tree_cell&); - - void visit_multi_assignment (tree_multi_assignment&); - - void visit_no_op_command (tree_no_op_command&); - - void visit_constant (tree_constant&); - - void visit_fcn_handle (tree_fcn_handle&); - - void visit_parameter_list (tree_parameter_list&); - - void visit_postfix_expression (tree_postfix_expression&); - - void visit_prefix_expression (tree_prefix_expression&); - - void visit_return_command (tree_return_command&); - - void visit_return_list (tree_return_list&); - - void visit_simple_assignment (tree_simple_assignment&); - - void visit_statement (tree_statement&); - - void visit_statement_list (tree_statement_list&); - - void visit_switch_case (tree_switch_case&); - - void visit_switch_case_list (tree_switch_case_list&); - - void visit_switch_command (tree_switch_command&); - - void visit_try_catch_command (tree_try_catch_command&); - - void visit_unwind_protect_command (tree_unwind_protect_command&); - - void visit_while_command (tree_while_command&); - - void visit_do_until_command (tree_do_until_command&); - - void print_fcn_handle_body (tree_statement_list *); - -private: - - std::ostream& os; - - std::string prefix; - - std::stack nesting; - - bool print_original_text; - - // Current indentation. - int curr_print_indent_level; - - // TRUE means we are at the beginning of a line. - bool beginning_of_line; - - // Nonzero means we are not printing newlines and indenting. - int suppress_newlines; - - void do_decl_command (tree_decl_command& cmd); - - void reset_indent_level (void) { curr_print_indent_level = 0; } - - void increment_indent_level (void) { curr_print_indent_level += 2; } - - void decrement_indent_level (void) { curr_print_indent_level -= 2; } - - void newline (const char *alt_txt = ", "); - - void indent (void); - - void reset (void); - - void print_parens (const tree_expression& expr, const char *txt); - - void print_comment_list (octave_comment_list *comment_list); - - void print_comment_elt (const octave_comment_elt& comment_elt); - - void print_indented_comment (octave_comment_list *comment_list); - - // Must create with an output stream! - - tree_print_code (void); - - // No copying! - - tree_print_code (const tree_print_code&); - - tree_print_code& operator = (const tree_print_code&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-select.cc --- a/src/pt-select.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,223 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "oct-obj.h" -#include "ov.h" -#include "pt-cmd.h" -#include "pt-exp.h" -#include "pt-select.h" -#include "pt-stmt.h" -#include "pt-walk.h" -#include "Cell.h" -#include "ov-typeinfo.h" - -// If clauses. - -tree_if_clause::~tree_if_clause (void) -{ - delete expr; - delete list; - delete lead_comm; -} - -tree_if_clause * -tree_if_clause::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return new tree_if_clause (expr ? expr->dup (scope, context) : 0, - list ? list->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0); -} - -void -tree_if_clause::accept (tree_walker& tw) -{ - tw.visit_if_clause (*this); -} - -// List of if commands. - -tree_if_command_list * -tree_if_command_list::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_if_command_list *new_icl = new tree_if_command_list (); - - for (const_iterator p = begin (); p != end (); p++) - { - const tree_if_clause *elt = *p; - - new_icl->append (elt ? elt->dup (scope, context) : 0); - } - - return new_icl; -} - -void -tree_if_command_list::accept (tree_walker& tw) -{ - tw.visit_if_command_list (*this); -} - -// If. - -tree_if_command::~tree_if_command (void) -{ - delete list; - delete lead_comm; - delete trail_comm; -} - -tree_command * -tree_if_command::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return new tree_if_command (list ? list->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0, - trail_comm ? trail_comm->dup () : 0, - line (), column ()); -} - -void -tree_if_command::accept (tree_walker& tw) -{ - tw.visit_if_command (*this); -} - -// Switch cases. - -tree_switch_case::~tree_switch_case (void) -{ - delete label; - delete list; - delete lead_comm; -} - - -bool -tree_switch_case::label_matches (const octave_value& val) -{ - octave_value label_value = label->rvalue1 (); - - if (! error_state && label_value.is_defined () ) - { - if (label_value.is_cell ()) - { - Cell cell (label_value.cell_value ()); - - for (octave_idx_type i = 0; i < cell.rows (); i++) - { - for (octave_idx_type j = 0; j < cell.columns (); j++) - { - bool match = val.is_equal (cell(i,j)); - - if (error_state) - return false; - else if (match) - return true; - } - } - } - else - { - bool match = val.is_equal (label_value); - - if (error_state) - return false; - else - return match; - } - } - - return false; -} - -tree_switch_case * -tree_switch_case::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return new tree_switch_case (label ? label->dup (scope, context) : 0, - list ? list->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0); -} - -void -tree_switch_case::accept (tree_walker& tw) -{ - tw.visit_switch_case (*this); -} - -// List of switch cases. - -tree_switch_case_list * -tree_switch_case_list::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_switch_case_list *new_scl = new tree_switch_case_list (); - - for (const_iterator p = begin (); p != end (); p++) - { - const tree_switch_case *elt = *p; - - new_scl->append (elt ? elt->dup (scope, context) : 0); - } - - return new_scl; -} - -void -tree_switch_case_list::accept (tree_walker& tw) -{ - tw.visit_switch_case_list (*this); -} - -// Switch. - -tree_switch_command::~tree_switch_command (void) -{ - delete expr; - delete list; - delete lead_comm; - delete trail_comm; -} - -tree_command * -tree_switch_command::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - return new tree_switch_command (expr ? expr->dup (scope, context) : 0, - list ? list->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0, - trail_comm ? trail_comm->dup () : 0, - line (), column ()); -} - -void -tree_switch_command::accept (tree_walker& tw) -{ - tw.visit_switch_command (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-select.h --- a/src/pt-select.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,302 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_select_h) -#define octave_tree_select_h 1 - -class expression; -class tree_statement_list; - -class tree_walker; - -#include "base-list.h" -#include "comment-list.h" -#include "pt-cmd.h" -#include "symtab.h" - -// If. - -class -tree_if_clause : public tree -{ -public: - - tree_if_clause (int l = -1, int c = -1) - : tree (l, c), expr (0), list (0), lead_comm (0) { } - - tree_if_clause (tree_statement_list *sl, octave_comment_list *lc = 0, - int l = -1, int c = -1) - : tree (l, c), expr (0), list (sl), lead_comm (lc) { } - - tree_if_clause (tree_expression *e, tree_statement_list *sl, - octave_comment_list *lc = 0, - int l = -1, int c = -1) - : tree (l, c), expr (e), list (sl), lead_comm (lc) { } - - ~tree_if_clause (void); - - bool is_else_clause (void) { return ! expr; } - - tree_expression *condition (void) { return expr; } - - tree_statement_list *commands (void) { return list; } - - octave_comment_list *leading_comment (void) { return lead_comm; } - - tree_if_clause *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // The condition to test. - tree_expression *expr; - - // The list of statements to evaluate if expr is true. - tree_statement_list *list; - - // Comment preceding ELSE or ELSEIF token. - octave_comment_list *lead_comm; - - // No copying! - - tree_if_clause (const tree_if_clause&); - - tree_if_clause& operator = (const tree_if_clause&); -}; - -class -tree_if_command_list : public octave_base_list -{ -public: - - tree_if_command_list (void) { } - - tree_if_command_list (tree_if_clause *t) { append (t); } - - ~tree_if_command_list (void) - { - while (! empty ()) - { - iterator p = begin (); - delete *p; - erase (p); - } - } - - tree_if_command_list *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // No copying! - - tree_if_command_list (const tree_if_command_list&); - - tree_if_command_list& operator = (const tree_if_command_list&); -}; - -class -tree_if_command : public tree_command -{ -public: - - tree_if_command (int l = -1, int c = -1) - : tree_command (l, c), list (0), lead_comm (0), trail_comm (0) { } - - tree_if_command (tree_if_command_list *lst, octave_comment_list *lc, - octave_comment_list *tc, int l = -1, int c = -1) - : tree_command (l, c), list (lst), lead_comm (lc), trail_comm (tc) { } - - ~tree_if_command (void); - - tree_if_command_list *cmd_list (void) { return list; } - - octave_comment_list *leading_comment (void) { return lead_comm; } - - octave_comment_list *trailing_comment (void) { return trail_comm; } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // List of if commands (if, elseif, elseif, ... else, endif) - tree_if_command_list *list; - - // Comment preceding IF token. - octave_comment_list *lead_comm; - - // Comment preceding ENDIF token. - octave_comment_list *trail_comm; - - // No copying! - - tree_if_command (const tree_if_command&); - - tree_if_command& operator = (const tree_if_command&); -}; - -// Switch. - -class -tree_switch_case : public tree -{ -public: - - tree_switch_case (int l = -1, int c = -1) - : tree (l, c), label (0), list (0), lead_comm (0) { } - - tree_switch_case (tree_statement_list *sl, octave_comment_list *lc = 0, - int l = -1, int c = -1) - : tree (l, c), label (0), list (sl), lead_comm (lc) { } - - tree_switch_case (tree_expression *e, tree_statement_list *sl, - octave_comment_list *lc = 0, - int l = -1, int c = -1) - : tree (l, c), label (e), list (sl), lead_comm (lc) { } - - ~tree_switch_case (void); - - bool is_default_case (void) { return ! label; } - - bool label_matches (const octave_value& val); - - tree_expression *case_label (void) { return label; } - - tree_statement_list *commands (void) { return list; } - - octave_comment_list *leading_comment (void) { return lead_comm; } - - tree_switch_case *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // The case label. - tree_expression *label; - - // The list of statements to evaluate if the label matches. - tree_statement_list *list; - - // Comment preceding CASE or OTHERWISE token. - octave_comment_list *lead_comm; - - // No copying! - - tree_switch_case (const tree_switch_case&); - - tree_switch_case& operator = (const tree_switch_case&); -}; - -class -tree_switch_case_list : public octave_base_list -{ -public: - - tree_switch_case_list (void) { } - - tree_switch_case_list (tree_switch_case *t) { append (t); } - - ~tree_switch_case_list (void) - { - while (! empty ()) - { - iterator p = begin (); - delete *p; - erase (p); - } - } - - tree_switch_case_list *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // No copying! - - tree_switch_case_list (const tree_switch_case_list&); - - tree_switch_case_list& operator = (const tree_switch_case_list&); -}; - -class -tree_switch_command : public tree_command -{ -public: - - tree_switch_command (int l = -1, int c = -1) - : tree_command (l, c), expr (0), list (0), lead_comm (0), - trail_comm (0) { } - - tree_switch_command (tree_expression *e, tree_switch_case_list *lst, - octave_comment_list *lc, octave_comment_list *tc, - int l = -1, int c = -1) - : tree_command (l, c), expr (e), list (lst), lead_comm (lc), - trail_comm (tc) { } - - ~tree_switch_command (void); - - tree_expression *switch_value (void) { return expr; } - - tree_switch_case_list *case_list (void) { return list; } - - octave_comment_list *leading_comment (void) { return lead_comm; } - - octave_comment_list *trailing_comment (void) { return trail_comm; } - - tree_command *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // Value on which to switch. - tree_expression *expr; - - // List of cases (case 1, case 2, ..., default) - tree_switch_case_list *list; - - // Comment preceding SWITCH token. - octave_comment_list *lead_comm; - - // Comment preceding ENDSWITCH token. - octave_comment_list *trail_comm; - - // No copying! - - tree_switch_command (const tree_switch_command&); - - tree_switch_command& operator = (const tree_switch_command&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-stmt.cc --- a/src/pt-stmt.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,216 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "quit.h" - -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "ov.h" -#include "oct-lvalue.h" -#include "input.h" -#include "pager.h" -#include "pt-bp.h" -#include "pt-cmd.h" -#include "pt-id.h" -#include "pt-idx.h" -#include "pt-jump.h" -#include "pt-pr-code.h" -#include "pt-stmt.h" -#include "pt-walk.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// A list of commands to be executed. - -tree_statement::~tree_statement (void) -{ - delete cmd; - delete expr; - delete comm; -} - -void -tree_statement::set_print_flag (bool print_flag) -{ - if (expr) - expr->set_print_flag (print_flag); -} - -bool -tree_statement::print_result (void) -{ - return expr && expr->print_result (); -} - -void -tree_statement::set_breakpoint (void) -{ - if (cmd) - cmd->set_breakpoint (); - else if (expr) - expr->set_breakpoint (); -} - -void -tree_statement::delete_breakpoint (void) -{ - if (cmd) - cmd->delete_breakpoint (); - else if (expr) - expr->delete_breakpoint (); -} - -bool -tree_statement::is_breakpoint (void) const -{ - return cmd ? cmd->is_breakpoint () : (expr ? expr->is_breakpoint () : false); -} - -int -tree_statement::line (void) const -{ - return cmd ? cmd->line () : (expr ? expr->line () : -1); -} - -int -tree_statement::column (void) const -{ - return cmd ? cmd->column () : (expr ? expr->column () : -1); -} - -void -tree_statement::echo_code (void) -{ - tree_print_code tpc (octave_stdout, VPS4); - - accept (tpc); -} - -bool -tree_statement::is_end_of_fcn_or_script (void) const -{ - bool retval = false; - - if (cmd) - { - tree_no_op_command *no_op_cmd - = dynamic_cast (cmd); - - if (no_op_cmd) - retval = no_op_cmd->is_end_of_fcn_or_script (); - } - - return retval; -} - -tree_statement * -tree_statement::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_statement *new_stmt = new tree_statement (); - - new_stmt->cmd = cmd ? cmd->dup (scope, context) : 0; - - new_stmt->expr = expr ? expr->dup (scope, context) : 0; - - new_stmt->comm = comm ? comm->dup () : 0; - - return new_stmt; -} - -void -tree_statement::accept (tree_walker& tw) -{ - tw.visit_statement (*this); -} - -int -tree_statement_list::set_breakpoint (int line) -{ - tree_breakpoint tbp (line, tree_breakpoint::set); - accept (tbp); - - return tbp.get_line (); -} - -void -tree_statement_list::delete_breakpoint (int line) -{ - if (line < 0) - { - octave_value_list bp_lst = list_breakpoints (); - - int len = bp_lst.length (); - - for (int i = 0; i < len; i++) - { - tree_breakpoint tbp (i, tree_breakpoint::clear); - accept (tbp); - } - } - else - { - tree_breakpoint tbp (line, tree_breakpoint::clear); - accept (tbp); - } -} - -octave_value_list -tree_statement_list::list_breakpoints (void) -{ - tree_breakpoint tbp (0, tree_breakpoint::list); - accept (tbp); - - return tbp.get_list (); -} - -tree_statement_list * -tree_statement_list::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_statement_list *new_list = new tree_statement_list (); - - new_list->function_body = function_body; - - for (const_iterator p = begin (); p != end (); p++) - { - const tree_statement *elt = *p; - - new_list->append (elt ? elt->dup (scope, context) : 0); - } - - return new_list; -} - -void -tree_statement_list::accept (tree_walker& tw) -{ - tw.visit_statement_list (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-stmt.h --- a/src/pt-stmt.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,186 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_stmt_h) -#define octave_tree_stmt_h 1 - -class octave_value_list; - -class tree_command; -class tree_expression; - -class tree_walker; - -#include - -#include "base-list.h" -#include "comment-list.h" -#include "symtab.h" -#include "pt.h" - -// A statement is either a command to execute or an expression to -// evaluate. - -class -tree_statement : public tree -{ -public: - - tree_statement (void) - : cmd (0), expr (0), comm (0) { } - - tree_statement (tree_command *c, octave_comment_list *cl) - : cmd (c), expr (0), comm (cl) { } - - tree_statement (tree_expression *e, octave_comment_list *cl) - : cmd (0), expr (e), comm (cl) { } - - ~tree_statement (void); - - void set_print_flag (bool print_flag); - - bool print_result (void); - - bool is_command (void) const { return cmd != 0; } - - bool is_expression (void) const { return expr != 0; } - - void set_breakpoint (void); - - void delete_breakpoint (void); - - bool is_breakpoint (void) const; - - int line (void) const; - int column (void) const; - - void echo_code (void); - - tree_command *command (void) { return cmd; } - - tree_expression *expression (void) { return expr; } - - octave_comment_list *comment_text (void) { return comm; } - - bool is_null_statement (void) const { return ! (cmd || expr || comm); } - - bool is_end_of_fcn_or_script (void) const; - - // Allow modification of this statement. Note that there is no - // checking. If you use these, are you sure you knwo what you are - // doing? - - void set_command (tree_command *c) { cmd = c; } - - void set_expression (tree_expression *e) { expr = e; } - - tree_statement *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // Only one of cmd or expr can be valid at once. - - // Command to execute. - tree_command *cmd; - - // Expression to evaluate. - tree_expression *expr; - - // Comment associated with this statement. - octave_comment_list *comm; - - // No copying! - tree_statement (const tree_statement&); - - tree_statement& operator = (const tree_statement&); -}; - -// A list of statements to evaluate. - -class -tree_statement_list : public octave_base_list -{ -public: - - tree_statement_list (void) - : function_body (false), anon_function_body (false), - script_body (false) { } - - tree_statement_list (tree_statement *s) - : function_body (false), anon_function_body (false), - script_body (false) { append (s); } - - ~tree_statement_list (void) - { - while (! empty ()) - { - iterator p = begin (); - delete *p; - erase (p); - } - } - - void mark_as_function_body (void) { function_body = true; } - - void mark_as_anon_function_body (void) { anon_function_body = true; } - - void mark_as_script_body (void) { script_body = true; } - - bool is_function_body (void) const { return function_body; } - - bool is_anon_function_body (void) const { return anon_function_body; } - - bool is_script_body (void) const { return script_body; } - - int set_breakpoint (int line); - - void delete_breakpoint (int line); - - octave_value_list list_breakpoints (void); - - tree_statement_list *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // Does this list of statements make up the body of a function? - bool function_body; - - // Does this list of statements make up the body of a function? - bool anon_function_body; - - // Does this list of statements make up the body of a script? - bool script_body; - - // No copying! - - tree_statement_list (const tree_statement_list&); - - tree_statement_list& operator = (const tree_statement_list&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-unop.cc --- a/src/pt-unop.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,208 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "error.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "ov.h" -#include "profiler.h" -#include "pt-bp.h" -#include "pt-unop.h" -#include "pt-walk.h" - -// Unary expressions. - -std::string -tree_unary_expression::oper (void) const -{ - return octave_value::unary_op_as_string (etype); -} - -// Prefix expressions. - -octave_value_list -tree_prefix_expression::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("prefix operator `%s': invalid number of output arguments", - oper () . c_str ()); - else - retval = rvalue1 (nargout); - - return retval; -} - -octave_value -tree_prefix_expression::rvalue1 (int) -{ - octave_value retval; - - if (error_state) - return retval; - - if (op) - { - if (etype == octave_value::op_incr || etype == octave_value::op_decr) - { - octave_lvalue ref = op->lvalue (); - - if (! error_state) - { - BEGIN_PROFILER_BLOCK ("prefix " + oper ()) - - ref.do_unary_op (etype); - - if (! error_state) - retval = ref.value (); - - END_PROFILER_BLOCK - } - } - else - { - octave_value val = op->rvalue1 (); - - if (! error_state && val.is_defined ()) - { - BEGIN_PROFILER_BLOCK ("prefix " + oper ()) - - // Attempt to do the operation in-place if it is unshared - // (a temporary expression). - if (val.get_count () == 1) - retval = val.do_non_const_unary_op (etype); - else - retval = ::do_unary_op (etype, val); - - if (error_state) - retval = octave_value (); - - END_PROFILER_BLOCK - } - } - } - - return retval; -} - -tree_expression * -tree_prefix_expression::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_prefix_expression *new_pe - = new tree_prefix_expression (op ? op->dup (scope, context) : 0, - line (), column (), etype); - - new_pe->copy_base (*this); - - return new_pe; -} - -void -tree_prefix_expression::accept (tree_walker& tw) -{ - tw.visit_prefix_expression (*this); -} - -// Postfix expressions. - -octave_value_list -tree_postfix_expression::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("postfix operator `%s': invalid number of output arguments", - oper () . c_str ()); - else - retval = rvalue1 (nargout); - - return retval; -} - -octave_value -tree_postfix_expression::rvalue1 (int) -{ - octave_value retval; - - if (error_state) - return retval; - - if (op) - { - if (etype == octave_value::op_incr || etype == octave_value::op_decr) - { - octave_lvalue ref = op->lvalue (); - - if (! error_state) - { - retval = ref.value (); - - BEGIN_PROFILER_BLOCK ("postfix " + oper ()) - ref.do_unary_op (etype); - END_PROFILER_BLOCK - } - } - else - { - octave_value val = op->rvalue1 (); - - if (! error_state && val.is_defined ()) - { - BEGIN_PROFILER_BLOCK ("postfix " + oper ()) - - retval = ::do_unary_op (etype, val); - - if (error_state) - retval = octave_value (); - - END_PROFILER_BLOCK - } - } - } - - return retval; -} - -tree_expression * -tree_postfix_expression::dup (symbol_table::scope_id scope, - symbol_table::context_id context) const -{ - tree_postfix_expression *new_pe - = new tree_postfix_expression (op ? op->dup (scope, context) : 0, - line (), column (), etype); - - new_pe->copy_base (*this); - - return new_pe; -} - -void -tree_postfix_expression::accept (tree_walker& tw) -{ - tw.visit_postfix_expression (*this); -} diff -r d02b229ce693 -r a132d206a36a src/pt-unop.h --- a/src/pt-unop.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,157 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_unop_h) -#define octave_tree_unop_h 1 - -#include - -class tree_walker; - -class octave_value; -class octave_value_list; -class octave_lvalue; - -#include "pt-exp.h" -#include "symtab.h" - -// Unary expressions. - -class -tree_unary_expression : public tree_expression -{ -public: - - tree_unary_expression (int l = -1, int c = -1, - octave_value::unary_op t - = octave_value::unknown_unary_op) - : tree_expression (l, c), op (0), etype (t) { } - - tree_unary_expression (tree_expression *e, int l = -1, int c = -1, - octave_value::unary_op t - = octave_value::unknown_unary_op) - : tree_expression (l, c), op (e), etype (t) { } - - ~tree_unary_expression (void) { delete op; } - - bool is_unary_expression (void) const { return true; } - - bool has_magic_end (void) const { return (op && op->has_magic_end ()); } - - tree_expression *operand (void) { return op; } - - std::string oper (void) const; - - octave_value::unary_op op_type (void) const { return etype; } - -protected: - - // The operand for the expression. - tree_expression *op; - - // The type of the expression. - octave_value::unary_op etype; - -private: - - // No copying! - - tree_unary_expression (const tree_unary_expression&); - - tree_unary_expression& operator = (const tree_unary_expression&); -}; - -// Prefix expressions. - -class -tree_prefix_expression : public tree_unary_expression -{ -public: - - tree_prefix_expression (int l = -1, int c = -1) - : tree_unary_expression (l, c, octave_value::unknown_unary_op) { } - - tree_prefix_expression (tree_expression *e, int l = -1, int c = -1, - octave_value::unary_op t - = octave_value::unknown_unary_op) - : tree_unary_expression (e, l, c, t) { } - - ~tree_prefix_expression (void) { } - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // No copying! - - tree_prefix_expression (const tree_prefix_expression&); - - tree_prefix_expression& operator = (const tree_prefix_expression&); -}; - -// Postfix expressions. - -class -tree_postfix_expression : public tree_unary_expression -{ -public: - - tree_postfix_expression (int l = -1, int c = -1) - : tree_unary_expression (l, c, octave_value::unknown_unary_op) { } - - tree_postfix_expression (tree_expression *e, int l = -1, int c = -1, - octave_value::unary_op t - = octave_value::unknown_unary_op) - : tree_unary_expression (e, l, c, t) { } - - ~tree_postfix_expression (void) { } - - bool rvalue_ok (void) const { return true; } - - octave_value rvalue1 (int nargout = 1); - - octave_value_list rvalue (int nargout); - - tree_expression *dup (symbol_table::scope_id scope, - symbol_table::context_id context) const; - - void accept (tree_walker& tw); - -private: - - // No copying! - - tree_postfix_expression (const tree_postfix_expression&); - - tree_postfix_expression& operator = (const tree_postfix_expression&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt-walk.h --- a/src/pt-walk.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,211 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_walker_h) -#define octave_tree_walker_h 1 - -class tree_anon_fcn_handle; -class tree_argument_list; -class tree_binary_expression; -class tree_break_command; -class tree_colon_expression; -class tree_continue_command; -class tree_global_command; -class tree_persistent_command; -class tree_decl_elt; -class tree_decl_init_list; -class tree_simple_for_command; -class tree_complex_for_command; -class octave_user_script; -class octave_user_function; -class tree_function_def; -class tree_identifier; -class tree_if_clause; -class tree_if_command; -class tree_if_command_list; -class tree_switch_case; -class tree_switch_case_list; -class tree_switch_command; -class tree_index_expression; -class tree_matrix; -class tree_cell; -class tree_multi_assignment; -class tree_no_op_command; -class tree_constant; -class tree_fcn_handle; -class tree_parameter_list; -class tree_postfix_expression; -class tree_prefix_expression; -class tree_return_command; -class tree_return_list; -class tree_simple_assignment; -class tree_statement; -class tree_statement_list; -class tree_try_catch_command; -class tree_unwind_protect_command; -class tree_while_command; -class tree_do_until_command; - -class -tree_walker -{ -public: - - virtual void - visit_anon_fcn_handle (tree_anon_fcn_handle&) = 0; - - virtual void - visit_argument_list (tree_argument_list&) = 0; - - virtual void - visit_binary_expression (tree_binary_expression&) = 0; - - virtual void - visit_break_command (tree_break_command&) = 0; - - virtual void - visit_colon_expression (tree_colon_expression&) = 0; - - virtual void - visit_continue_command (tree_continue_command&) = 0; - - virtual void - visit_global_command (tree_global_command&) = 0; - - virtual void - visit_persistent_command (tree_persistent_command&) = 0; - - virtual void - visit_decl_elt (tree_decl_elt&) = 0; - - virtual void - visit_decl_init_list (tree_decl_init_list&) = 0; - - virtual void - visit_simple_for_command (tree_simple_for_command&) = 0; - - virtual void - visit_complex_for_command (tree_complex_for_command&) = 0; - - virtual void - visit_octave_user_script (octave_user_script&) = 0; - - virtual void - visit_octave_user_function (octave_user_function&) = 0; - - virtual void - visit_function_def (tree_function_def&) = 0; - - virtual void - visit_identifier (tree_identifier&) = 0; - - virtual void - visit_if_clause (tree_if_clause&) = 0; - - virtual void - visit_if_command (tree_if_command&) = 0; - - virtual void - visit_if_command_list (tree_if_command_list&) = 0; - - virtual void - visit_switch_case (tree_switch_case&) = 0; - - virtual void - visit_switch_case_list (tree_switch_case_list&) = 0; - - virtual void - visit_switch_command (tree_switch_command&) = 0; - - virtual void - visit_index_expression (tree_index_expression&) = 0; - - virtual void - visit_matrix (tree_matrix&) = 0; - - virtual void - visit_cell (tree_cell&) = 0; - - virtual void - visit_multi_assignment (tree_multi_assignment&) = 0; - - virtual void - visit_no_op_command (tree_no_op_command&) = 0; - - virtual void - visit_constant (tree_constant&) = 0; - - virtual void - visit_fcn_handle (tree_fcn_handle&) = 0; - - virtual void - visit_parameter_list (tree_parameter_list&) = 0; - - virtual void - visit_postfix_expression (tree_postfix_expression&) = 0; - - virtual void - visit_prefix_expression (tree_prefix_expression&) = 0; - - virtual void - visit_return_command (tree_return_command&) = 0; - - virtual void - visit_return_list (tree_return_list&) = 0; - - virtual void - visit_simple_assignment (tree_simple_assignment&) = 0; - - virtual void - visit_statement (tree_statement&) = 0; - - virtual void - visit_statement_list (tree_statement_list&) = 0; - - virtual void - visit_try_catch_command (tree_try_catch_command&) = 0; - - virtual void - visit_unwind_protect_command (tree_unwind_protect_command&) = 0; - - virtual void - visit_while_command (tree_while_command&) = 0; - - virtual void - visit_do_until_command (tree_do_until_command&) = 0; - -protected: - - tree_walker (void) { } - - virtual ~tree_walker (void) { } - -private: - - // No copying! - - tree_walker (const tree_walker&); - - tree_walker& operator = (const tree_walker&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/pt.cc --- a/src/pt.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,50 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "ov-fcn.h" -#include "pt.h" -#include "pt-pr-code.h" - -// Hide the details of the string buffer so that we are less likely to -// create a memory leak. - -std::string -tree::str_print_code (void) -{ - std::ostringstream buf; - - tree_print_code tpc (buf); - - accept (tpc); - - std::string retval = buf.str (); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/pt.h --- a/src/pt.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,80 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_tree_h) -#define octave_tree_h 1 - -#include - -#include - -class octave_function; -class tree_walker; - -// Base class for the parse tree. - -class -tree -{ -public: - - tree (int l = -1, int c = -1) - : line_num (l), column_num (c), bp (false) { } - - virtual ~tree (void) { } - - virtual int line (void) const { return line_num; } - - virtual int column (void) const { return column_num; } - - void line (int l) { line_num = l; } - - void column (int c) { column_num = c; } - - virtual void set_breakpoint (void) { bp = true; } - - virtual void delete_breakpoint (void) { bp = false; } - - bool is_breakpoint (void) const { return bp; } - - std::string str_print_code (void); - - virtual void accept (tree_walker& tw) = 0; - -private: - - // The input line and column where we found the text that was - // eventually converted to this tree node. - int line_num; - int column_num; - - // Breakpoint flag. - bool bp; - - // No copying! - - tree (const tree&); - - tree& operator = (const tree&); -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/sighandlers.cc --- a/src/sighandlers.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1054 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "oct-syscalls.h" -#include "quit.h" -#include "singleton-cleanup.h" - -#include "debug.h" -#include "defun.h" -#include "error.h" -#include "input.h" -#include "load-save.h" -#include "oct-map.h" -#include "pager.h" -#include "pt-bp.h" -#include "pt-eval.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "syswait.h" -#include "toplev.h" -#include "utils.h" -#include "variables.h" - -// Nonzero means we have already printed a message for this series of -// SIGPIPES. We assume that the writer will eventually give up. -int pipe_handler_error_count = 0; - -// TRUE means we can be interrupted. -bool can_interrupt = false; - -// TRUE means we should try to enter the debugger on SIGINT. -static bool Vdebug_on_interrupt = false; - -// Allow users to avoid writing octave-workspace for SIGHUP (sent by -// closing gnome-terminal, for example). Note that this variable has -// no effect if Vcrash_dumps_octave_core is FALSE. -static bool Vsighup_dumps_octave_core = true; - -// Similar to Vsighup_dumps_octave_core, but for SIGTERM signal. -static bool Vsigterm_dumps_octave_core = true; - -// List of signals we have caught since last call to octave_signal_handler. -static bool octave_signals_caught[NSIG]; - -// Signal handler return type. -#ifndef BADSIG -#define BADSIG (void (*)(int))-1 -#endif - -// The following is a workaround for an apparent bug in GCC 4.1.2 and -// possibly earlier versions. See Octave bug report #30685 for details. -#if defined (__GNUC__) -# if ! (__GNUC__ > 4 \ - || (__GNUC__ == 4 && (__GNUC_MINOR__ > 1 \ - || (__GNUC_MINOR__ == 1 && __GNUC_PATCHLEVEL__ > 2)))) -# undef GNULIB_NAMESPACE -# define GNULIB_NAMESPACE -# warning "disabling GNULIB_NAMESPACE for signal functions -- consider upgrading to a current version of GCC" -# endif -#endif - -#define BLOCK_SIGNAL(sig, nvar, ovar) \ - do \ - { \ - GNULIB_NAMESPACE::sigemptyset (&nvar); \ - GNULIB_NAMESPACE::sigaddset (&nvar, sig); \ - GNULIB_NAMESPACE::sigemptyset (&ovar); \ - GNULIB_NAMESPACE::sigprocmask (SIG_BLOCK, &nvar, &ovar); \ - } \ - while (0) - -#if !defined (SIGCHLD) && defined (SIGCLD) -#define SIGCHLD SIGCLD -#endif - -#define BLOCK_CHILD(nvar, ovar) BLOCK_SIGNAL (SIGCHLD, nvar, ovar) -#define UNBLOCK_CHILD(ovar) GNULIB_NAMESPACE::sigprocmask (SIG_SETMASK, &ovar, 0) - -// Called from octave_quit () to actually do something about the signals -// we have caught. - -void -octave_signal_handler (void) -{ - // The list of signals is relatively short, so we will just go - // linearly through the list. - - for (int i = 0; i < NSIG; i++) - { - if (octave_signals_caught[i]) - { - octave_signals_caught[i] = false; - - switch (i) - { -#ifdef SIGCHLD - case SIGCHLD: - { - volatile octave_interrupt_handler saved_interrupt_handler - = octave_ignore_interrupts (); - - sigset_t set, oset; - - BLOCK_CHILD (set, oset); - - octave_child_list::wait (); - - octave_set_interrupt_handler (saved_interrupt_handler); - - UNBLOCK_CHILD (oset); - - octave_child_list::reap (); - } - break; -#endif - - case SIGFPE: - std::cerr << "warning: floating point exception" << std::endl; - break; - -#ifdef SIGPIPE - case SIGPIPE: - std::cerr << "warning: broken pipe" << std::endl; - break; -#endif - } - } - } -} - -static void -my_friendly_exit (const char *sig_name, int sig_number, - bool save_vars = true) -{ - static bool been_there_done_that = false; - - if (been_there_done_that) - { -#if defined (SIGABRT) - octave_set_signal_handler (SIGABRT, SIG_DFL); -#endif - - std::cerr << "panic: attempted clean up apparently failed -- aborting...\n"; - - MINGW_SIGNAL_CLEANUP (); - - abort (); - } - else - { - been_there_done_that = true; - - std::cerr << "panic: " << sig_name << " -- stopping myself...\n"; - - if (save_vars) - dump_octave_core (); - - if (sig_number < 0) - { - MINGW_SIGNAL_CLEANUP (); - - exit (1); - } - else - { - octave_set_signal_handler (sig_number, SIG_DFL); - - GNULIB_NAMESPACE::raise (sig_number); - } - } -} - -sig_handler * -octave_set_signal_handler (int sig, sig_handler *handler, - bool restart_syscalls) -{ - struct sigaction act, oact; - - act.sa_handler = handler; - act.sa_flags = 0; - -#if defined (SIGALRM) - if (sig == SIGALRM) - { -#if defined (SA_INTERRUPT) - act.sa_flags |= SA_INTERRUPT; -#endif - } -#endif -#if defined (SA_RESTART) -#if defined (SIGALRM) - else -#endif - // FIXME -- Do we also need to explicitly disable SA_RESTART? - if (restart_syscalls) - act.sa_flags |= SA_RESTART; -#endif - - GNULIB_NAMESPACE::sigemptyset (&act.sa_mask); - GNULIB_NAMESPACE::sigemptyset (&oact.sa_mask); - - GNULIB_NAMESPACE::sigaction (sig, &act, &oact); - - return oact.sa_handler; -} - -static void -generic_sig_handler (int sig) -{ - my_friendly_exit (strsignal (sig), sig); -} - -// Handle SIGCHLD. - -#ifdef SIGCHLD -static void -sigchld_handler (int /* sig */) -{ - octave_signal_caught = 1; - - octave_signals_caught[SIGCHLD] = true; -} -#endif /* defined (SIGCHLD) */ - -#ifdef SIGFPE -#if defined (__alpha__) -static void -sigfpe_handler (int /* sig */) -{ - if (can_interrupt && octave_interrupt_state >= 0) - { - octave_signal_caught = 1; - - octave_signals_caught[SIGFPE] = true; - - octave_interrupt_state++; - } -} -#endif /* defined (__alpha__) */ -#endif /* defined (SIGFPE) */ - -#if defined (SIGHUP) || defined (SIGTERM) -static void -sig_hup_or_term_handler (int sig) -{ - switch (sig) - { -#if defined (SIGHUP) - case SIGHUP: - { - if (Vsighup_dumps_octave_core) - dump_octave_core (); - } - break; -#endif - -#if defined (SIGTERM) - case SIGTERM: - { - if (Vsigterm_dumps_octave_core) - dump_octave_core (); - } - break; -#endif - - default: - break; - } - - clean_up_and_exit (0); -} -#endif - -#if 0 -#if defined (SIGWINCH) -static void -sigwinch_handler (int /* sig */) -{ - command_editor::resize_terminal (); -} -#endif -#endif - -// Handle SIGINT by restarting the parser (see octave.cc). -// -// This also has to work for SIGBREAK (on systems that have it), so we -// use the value of sig, instead of just assuming that it is called -// for SIGINT only. - -static void -user_abort (const char *sig_name, int sig_number) -{ - if (! octave_initialized) - exit (1); - - if (can_interrupt) - { - if (Vdebug_on_interrupt) - { - if (! octave_debug_on_interrupt_state) - { - tree_evaluator::debug_mode = true; - octave_debug_on_interrupt_state = true; - - return; - } - else - { - // Clear the flag and do normal interrupt stuff. - - tree_evaluator::debug_mode - = bp_table::have_breakpoints () || Vdebugging; - octave_debug_on_interrupt_state = false; - } - } - - if (octave_interrupt_immediately) - { - if (octave_interrupt_state == 0) - octave_interrupt_state = 1; - - octave_jump_to_enclosing_context (); - } - else - { - // If we are already cleaning up from a previous interrupt, - // take note of the fact that another interrupt signal has - // arrived. - - if (octave_interrupt_state < 0) - octave_interrupt_state = 0; - - octave_signal_caught = 1; - octave_interrupt_state++; - - if (interactive && octave_interrupt_state == 2) - std::cerr << "Press Control-C again to abort." << std::endl; - - if (octave_interrupt_state >= 3) - my_friendly_exit (sig_name, sig_number, true); - } - } - -} - -static void -sigint_handler (int sig) -{ -#ifdef USE_W32_SIGINT - if (w32_in_main_thread ()) - user_abort (strsignal (sig), sig); - else - w32_raise (sig); -#else - user_abort (strsignal (sig), sig); -#endif -} - -#ifdef SIGPIPE -static void -sigpipe_handler (int /* sig */) -{ - octave_signal_caught = 1; - - octave_signals_caught[SIGPIPE] = true; - - // Don't loop forever on account of this. - - if (pipe_handler_error_count++ > 100 && octave_interrupt_state >= 0) - octave_interrupt_state++; -} -#endif /* defined (SIGPIPE) */ - -#ifdef USE_W32_SIGINT -static BOOL CALLBACK -w32_sigint_handler (DWORD sig) -{ - const char *sig_name; - - switch (sig) - { - case CTRL_BREAK_EVENT: - sig_name = "Ctrl-Break"; - break; - case CTRL_C_EVENT: - sig_name = "Ctrl-C"; - break; - case CTRL_CLOSE_EVENT: - sig_name = "close console"; - break; - case CTRL_LOGOFF_EVENT: - sig_name = "logoff"; - break; - case CTRL_SHUTDOWN_EVENT: - sig_name = "shutdown"; - break; - default: - sig_name = "unknown console event"; - break; - } - - switch (sig) - { - case CTRL_BREAK_EVENT: - case CTRL_C_EVENT: - w32_raise (SIGINT); - break; - - case CTRL_CLOSE_EVENT: - clean_up_and_exit (0); - break; - case CTRL_LOGOFF_EVENT: - case CTRL_SHUTDOWN_EVENT: - default: - // We should do the following: - // clean_up_and_exit (0); - // We can't because we aren't running in the normal Octave thread. - user_abort (sig_name, sig); - break; - } - - // Return TRUE if the event was handled, or FALSE if another handler - // should be called. - // FIXME check that windows terminates the thread. - return TRUE; -} -#endif /* w32_sigint_handler */ - - -octave_interrupt_handler -octave_catch_interrupts (void) -{ - octave_interrupt_handler retval; - -#ifdef SIGINT - retval.int_handler = octave_set_signal_handler (SIGINT, sigint_handler); -#endif - -#ifdef SIGBREAK - retval.brk_handler = octave_set_signal_handler (SIGBREAK, sigint_handler); -#endif - -#ifdef USE_W32_SIGINT - - // Intercept windows console control events. - // Note that the windows console signal handlers chain, so if - // install_signal_handlers is called more than once in the same program, - // then first call the following to avoid duplicates: - // - // SetConsoleCtrlHandler (w32_sigint_handler, FALSE); - - if (! SetConsoleCtrlHandler (w32_sigint_handler, TRUE)) - error ("SetConsoleCtrlHandler failed with %ld\n", GetLastError ()); - - w32_set_quiet_shutdown (); - -#endif - - return retval; -} - -octave_interrupt_handler -octave_ignore_interrupts (void) -{ - octave_interrupt_handler retval; - -#ifdef SIGINT - retval.int_handler = octave_set_signal_handler (SIGINT, SIG_IGN); -#endif - -#ifdef SIGBREAK - retval.brk_handler = octave_set_signal_handler (SIGBREAK, SIG_IGN); -#endif - - return retval; -} - -octave_interrupt_handler -octave_set_interrupt_handler (const volatile octave_interrupt_handler& h, - bool restart_syscalls) -{ - octave_interrupt_handler retval; - -#ifdef SIGINT - retval.int_handler = octave_set_signal_handler (SIGINT, h.int_handler, - restart_syscalls); -#endif - -#ifdef SIGBREAK - retval.brk_handler = octave_set_signal_handler (SIGBREAK, h.brk_handler, - restart_syscalls); -#endif - - return retval; -} - -// Install all the handlers for the signals we might care about. - -void -install_signal_handlers (void) -{ - for (int i = 0; i < NSIG; i++) - octave_signals_caught[i] = false; - - octave_catch_interrupts (); - -#ifdef SIGABRT - octave_set_signal_handler (SIGABRT, generic_sig_handler); -#endif - -#ifdef SIGALRM - octave_set_signal_handler (SIGALRM, generic_sig_handler); -#endif - -#ifdef SIGBUS - octave_set_signal_handler (SIGBUS, generic_sig_handler); -#endif - -#ifdef SIGCHLD - octave_set_signal_handler (SIGCHLD, sigchld_handler); -#endif - - // SIGCLD - // SIGCONT - -#ifdef SIGEMT - octave_set_signal_handler (SIGEMT, generic_sig_handler); -#endif - -#ifdef SIGFPE -#if defined (__alpha__) - octave_set_signal_handler (SIGFPE, sigfpe_handler); -#else - octave_set_signal_handler (SIGFPE, generic_sig_handler); -#endif -#endif - -#ifdef SIGHUP - octave_set_signal_handler (SIGHUP, sig_hup_or_term_handler); -#endif - -#ifdef SIGILL - octave_set_signal_handler (SIGILL, generic_sig_handler); -#endif - - // SIGINFO - // SIGINT - -#ifdef SIGIOT - octave_set_signal_handler (SIGIOT, generic_sig_handler); -#endif - -#ifdef SIGLOST - octave_set_signal_handler (SIGLOST, generic_sig_handler); -#endif - -#ifdef SIGPIPE - octave_set_signal_handler (SIGPIPE, sigpipe_handler); -#endif - -#ifdef SIGPOLL - octave_set_signal_handler (SIGPOLL, SIG_IGN); -#endif - - // SIGPROF - // SIGPWR - -#ifdef SIGQUIT - octave_set_signal_handler (SIGQUIT, generic_sig_handler); -#endif - -#ifdef SIGSEGV - octave_set_signal_handler (SIGSEGV, generic_sig_handler); -#endif - - // SIGSTOP - -#ifdef SIGSYS - octave_set_signal_handler (SIGSYS, generic_sig_handler); -#endif - -#ifdef SIGTERM - octave_set_signal_handler (SIGTERM, sig_hup_or_term_handler); -#endif - -#ifdef SIGTRAP - octave_set_signal_handler (SIGTRAP, generic_sig_handler); -#endif - - // SIGTSTP - // SIGTTIN - // SIGTTOU - // SIGURG - -#ifdef SIGUSR1 - octave_set_signal_handler (SIGUSR1, generic_sig_handler); -#endif - -#ifdef SIGUSR2 - octave_set_signal_handler (SIGUSR2, generic_sig_handler); -#endif - -#ifdef SIGVTALRM - octave_set_signal_handler (SIGVTALRM, generic_sig_handler); -#endif - -#ifdef SIGIO - octave_set_signal_handler (SIGIO, SIG_IGN); -#endif - -#if 0 -#ifdef SIGWINCH - octave_set_signal_handler (SIGWINCH, sigwinch_handler); -#endif -#endif - -#ifdef SIGXCPU - octave_set_signal_handler (SIGXCPU, generic_sig_handler); -#endif - -#ifdef SIGXFSZ - octave_set_signal_handler (SIGXFSZ, generic_sig_handler); -#endif - -} - -static octave_scalar_map -make_sig_struct (void) -{ - octave_scalar_map m; - -#ifdef SIGABRT - m.assign ("ABRT", SIGABRT); -#endif - -#ifdef SIGALRM - m.assign ("ALRM", SIGALRM); -#endif - -#ifdef SIGBUS - m.assign ("BUS", SIGBUS); -#endif - -#ifdef SIGCHLD - m.assign ("CHLD", SIGCHLD); -#endif - -#ifdef SIGCLD - m.assign ("CLD", SIGCLD); -#endif - -#ifdef SIGCONT - m.assign ("CONT", SIGCONT); -#endif - -#ifdef SIGEMT - m.assign ("EMT", SIGEMT); -#endif - -#ifdef SIGFPE - m.assign ("FPE", SIGFPE); -#endif - -#ifdef SIGHUP - m.assign ("HUP", SIGHUP); -#endif - -#ifdef SIGILL - m.assign ("ILL", SIGILL); -#endif - -#ifdef SIGINFO - m.assign ("INFO", SIGINFO); -#endif - -#ifdef SIGINT - m.assign ("INT", SIGINT); -#endif - -#ifdef SIGIOT - m.assign ("IOT", SIGIOT); -#endif - -#ifdef SIGLOST - m.assign ("LOST", SIGLOST); -#endif - -#ifdef SIGPIPE - m.assign ("PIPE", SIGPIPE); -#endif - -#ifdef SIGPOLL - m.assign ("POLL", SIGPOLL); -#endif - -#ifdef SIGPROF - m.assign ("PROF", SIGPROF); -#endif - -#ifdef SIGPWR - m.assign ("PWR", SIGPWR); -#endif - -#ifdef SIGQUIT - m.assign ("QUIT", SIGQUIT); -#endif - -#ifdef SIGSEGV - m.assign ("SEGV", SIGSEGV); -#endif - -#ifdef SIGSTOP - m.assign ("STOP", SIGSTOP); -#endif - -#ifdef SIGSYS - m.assign ("SYS", SIGSYS); -#endif - -#ifdef SIGTERM - m.assign ("TERM", SIGTERM); -#endif - -#ifdef SIGTRAP - m.assign ("TRAP", SIGTRAP); -#endif - -#ifdef SIGTSTP - m.assign ("TSTP", SIGTSTP); -#endif - -#ifdef SIGTTIN - m.assign ("TTIN", SIGTTIN); -#endif - -#ifdef SIGTTOU - m.assign ("TTOU", SIGTTOU); -#endif - -#ifdef SIGURG - m.assign ("URG", SIGURG); -#endif - -#ifdef SIGUSR1 - m.assign ("USR1", SIGUSR1); -#endif - -#ifdef SIGUSR2 - m.assign ("USR2", SIGUSR2); -#endif - -#ifdef SIGVTALRM - m.assign ("VTALRM", SIGVTALRM); -#endif - -#ifdef SIGIO - m.assign ("IO", SIGIO); -#endif - -#ifdef SIGWINCH - m.assign ("WINCH", SIGWINCH); -#endif - -#ifdef SIGXCPU - m.assign ("XCPU", SIGXCPU); -#endif - -#ifdef SIGXFSZ - m.assign ("XFSZ", SIGXFSZ); -#endif - - return m; -} - -octave_child_list::octave_child_list_rep *octave_child_list::instance = 0; - -bool -octave_child_list::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_child_list_rep (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create child list object!"); - - retval = false; - } - - return retval; -} - -void -octave_child_list::insert (pid_t pid, octave_child::child_event_handler f) -{ - if (instance_ok ()) - instance->insert (pid, f); -} - -void -octave_child_list::reap (void) -{ - if (instance_ok ()) - instance->reap (); -} - -bool -octave_child_list::wait (void) -{ - return (instance_ok ()) ? instance->wait () : false; -} - -class pid_equal -{ -public: - - pid_equal (pid_t v) : val (v) { } - - bool operator () (const octave_child& oc) const { return oc.pid == val; } - -private: - - pid_t val; -}; - -void -octave_child_list::remove (pid_t pid) -{ - if (instance_ok ()) - instance->remove_if (pid_equal (pid)); -} - -#define OCL_REP octave_child_list::octave_child_list_rep - -void -OCL_REP::insert (pid_t pid, octave_child::child_event_handler f) -{ - append (octave_child (pid, f)); -} - -void -OCL_REP::reap (void) -{ - // Mark the record for PID invalid. - - for (iterator p = begin (); p != end (); p++) - { - // The call to the octave_child::child_event_handler might - // invalidate the iterator (for example, by calling - // octave_child_list::remove), so we increment the iterator - // here. - - octave_child& oc = *p; - - if (oc.have_status) - { - oc.have_status = 0; - - octave_child::child_event_handler f = oc.handler; - - if (f && f (oc.pid, oc.status)) - oc.pid = -1; - } - } - - remove_if (pid_equal (-1)); -} - -// Wait on our children and record any changes in their status. - -bool -OCL_REP::wait (void) -{ - bool retval = false; - - for (iterator p = begin (); p != end (); p++) - { - octave_child& oc = *p; - - pid_t pid = oc.pid; - - if (pid > 0) - { - int status; - - if (octave_syscalls::waitpid (pid, &status, WNOHANG) > 0) - { - oc.have_status = 1; - - oc.status = status; - - retval = true; - - break; - } - } - } - - return retval; -} - -DEFUN (SIG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SIG ()\n\ -Return a structure containing Unix signal names and their defined values.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - { - static octave_scalar_map m = make_sig_struct (); - - retval = m; - } - else - print_usage (); - - return retval; -} - -/* -%!assert (isstruct (SIG ())) -%!assert (! isempty (SIG ())) - -%!error SIG (1) -*/ - -DEFUN (debug_on_interrupt, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} debug_on_interrupt ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_interrupt (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} debug_on_interrupt (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to enter debugging mode when it receives an interrupt signal (typically\n\ -generated with @kbd{C-c}). If a second interrupt signal is received\n\ -before reaching the debugging mode, a normal interrupt will occur.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (debug_on_interrupt); -} - -/* -%!test -%! orig_val = debug_on_interrupt (); -%! old_val = debug_on_interrupt (! orig_val); -%! assert (orig_val, old_val); -%! assert (debug_on_interrupt (), ! orig_val); -%! debug_on_interrupt (orig_val); -%! assert (debug_on_interrupt (), orig_val); - -%!error (debug_on_interrupt (1, 2)) -*/ - -DEFUN (sighup_dumps_octave_core, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} sighup_dumps_octave_core ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} sighup_dumps_octave_core (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} sighup_dumps_octave_core (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave tries\n\ -to save all current variables to the file \"octave-workspace\" if it receives\n\ -a hangup signal.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (sighup_dumps_octave_core); -} - -/* -%!test -%! orig_val = sighup_dumps_octave_core (); -%! old_val = sighup_dumps_octave_core (! orig_val); -%! assert (orig_val, old_val); -%! assert (sighup_dumps_octave_core (), ! orig_val); -%! sighup_dumps_octave_core (orig_val); -%! assert (sighup_dumps_octave_core (), orig_val); - -%!error (sighup_dumps_octave_core (1, 2)) -*/ - -DEFUN (sigterm_dumps_octave_core, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} sigterm_dumps_octave_core ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} sigterm_dumps_octave_core (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} sigterm_dumps_octave_core (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave tries\n\ -to save all current variables to the file \"octave-workspace\" if it receives\n\ -a terminate signal.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (sigterm_dumps_octave_core); -} - -/* -%!test -%! orig_val = sigterm_dumps_octave_core (); -%! old_val = sigterm_dumps_octave_core (! orig_val); -%! assert (orig_val, old_val); -%! assert (sigterm_dumps_octave_core (), ! orig_val); -%! sigterm_dumps_octave_core (orig_val); -%! assert (sigterm_dumps_octave_core (), orig_val); - -%!error (sigterm_dumps_octave_core (1, 2)) -*/ diff -r d02b229ce693 -r a132d206a36a src/sighandlers.h --- a/src/sighandlers.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,177 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -/* - -The signal blocking macros defined below were adapted from similar -functions from GNU Bash, the Bourne Again SHell, copyright (C) 1994 -Free Software Foundation, Inc. - -*/ - -// This file should always be included after config.h! - -#if !defined (octave_sighandlers_h) -#define octave_sighandlers_h 1 - -// Include signal.h, not csignal since the latter might only define -// the ANSI standard C signal interface. - -#include - -#include "syswait.h" -#include "siglist.h" - -#include "base-list.h" - -typedef void sig_handler (int); - -// FIXME -- the data should probably be private... - -struct -octave_interrupt_handler -{ -#ifdef SIGINT - sig_handler *int_handler; -#endif - -#ifdef SIGBREAK - sig_handler *brk_handler; -#endif -}; - -// Nonzero means we have already printed a message for this series of -// SIGPIPES. We assume that the writer will eventually give up. -extern int pipe_handler_error_count; - -// TRUE means we can be interrupted. -extern OCTINTERP_API bool can_interrupt; - -extern OCTINTERP_API sig_handler *octave_set_signal_handler (int, sig_handler *, - bool restart_syscalls = true); - -extern OCTINTERP_API void install_signal_handlers (void); - -extern OCTINTERP_API void octave_signal_handler (void); - -extern OCTINTERP_API octave_interrupt_handler octave_catch_interrupts (void); - -extern OCTINTERP_API octave_interrupt_handler octave_ignore_interrupts (void); - -extern OCTINTERP_API octave_interrupt_handler -octave_set_interrupt_handler (const volatile octave_interrupt_handler&, - bool restart_syscalls = true); - -// extern void ignore_sigchld (void); - -// Maybe this should be in a separate file? - -class -OCTINTERP_API -octave_child -{ -public: - - // Do whatever to handle event for child with PID (might not - // actually be dead, could just be stopped). Return true if - // the list element corresponding to PID should be removed from - // list. This function should not call any functions that modify - // the octave_child_list. - - typedef bool (*child_event_handler) (pid_t, int); - - octave_child (pid_t id = -1, child_event_handler f = 0) - : pid (id), handler (f), have_status (0), status (0) { } - - octave_child (const octave_child& oc) - : pid (oc.pid), handler (oc.handler), - have_status (oc.have_status), status (oc.status) { } - - octave_child& operator = (const octave_child& oc) - { - if (&oc != this) - { - pid = oc.pid; - handler = oc.handler; - have_status = oc.have_status; - status = oc.status; - } - return *this; - } - - ~octave_child (void) { } - - // The process id of this child. - pid_t pid; - - // The function we call if an event happens for this child. - child_event_handler handler; - - // Nonzero if this child has stopped or terminated. - sig_atomic_t have_status; - - // The status of this child; 0 if running, otherwise a status value - // from waitpid. - int status; -}; - -class -OCTINTERP_API -octave_child_list -{ -protected: - - octave_child_list (void) { } - - class octave_child_list_rep : public octave_base_list - { - public: - - void insert (pid_t pid, octave_child::child_event_handler f); - - void reap (void); - - bool wait (void); - }; - -public: - - ~octave_child_list (void) { } - - static void insert (pid_t pid, octave_child::child_event_handler f); - - static void reap (void); - - static bool wait (void); - - static void remove (pid_t pid); - -private: - - static bool instance_ok (void); - - static octave_child_list_rep *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } -}; - -#endif diff -r d02b229ce693 -r a132d206a36a src/sparse.cc --- a/src/sparse.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,268 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "variables.h" -#include "utils.h" -#include "pager.h" -#include "defun.h" -#include "gripes.h" -#include "quit.h" -#include "unwind-prot.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "ov-bool-sparse.h" - -DEFUN (issparse, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} issparse (@var{x})\n\ -Return true if @var{x} is a sparse matrix.\n\ -@seealso{ismatrix}\n\ -@end deftypefn") -{ - if (args.length () != 1) - { - print_usage (); - return octave_value (); - } - else - return octave_value (args(0).is_sparse_type ()); -} - -DEFUN (sparse, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{s} =} sparse (@var{a})\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv}, @var{m}, @var{n}, @var{nzmax})\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv})\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{s}, @var{m}, @var{n}, \"unique\")\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{m}, @var{n})\n\ -Create a sparse matrix from the full matrix or row, column, value triplets.\n\ -If @var{a} is a full matrix, convert it to a sparse matrix representation,\n\ -removing all zero values in the process.\n\ -\n\ -Given the integer index vectors @var{i} and @var{j}, a 1-by-@code{nnz} vector\n\ -of real of complex values @var{sv}, overall dimensions @var{m} and @var{n}\n\ -of the sparse matrix. The argument @code{nzmax} is ignored but accepted for\n\ -compatibility with @sc{matlab}. If @var{m} or @var{n} are not specified\n\ -their values are derived from the maximum index in the vectors @var{i} and\n\ -@var{j} as given by @code{@var{m} = max (@var{i})},\n\ -@code{@var{n} = max (@var{j})}.\n\ -\n\ -@strong{Note}: if multiple values are specified with the same\n\ -@var{i}, @var{j} indices, the corresponding values in @var{s} will\n\ -be added. See @code{accumarray} for an example of how to produce different\n\ -behavior, such as taking the minimum instead.\n\ -\n\ -The following are all equivalent:\n\ -\n\ -@example\n\ -@group\n\ -s = sparse (i, j, s, m, n)\n\ -s = sparse (i, j, s, m, n, \"summation\")\n\ -s = sparse (i, j, s, m, n, \"sum\")\n\ -@end group\n\ -@end example\n\ -\n\ -Given the option \"unique\". if more than two values are specified for the\n\ -same @var{i}, @var{j} indices, the last specified value will be used.\n\ -\n\ -@code{sparse (@var{m}, @var{n})} is equivalent to\n\ -@code{sparse ([], [], [], @var{m}, @var{n}, 0)}\n\ -\n\ -If any of @var{sv}, @var{i} or @var{j} are scalars, they are expanded\n\ -to have a common size.\n\ -@seealso{full, accumarray}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - // Temporarily disable sparse_auto_mutate if set (it's obsolete anyway). - unwind_protect frame; - frame.protect_var (Vsparse_auto_mutate); - Vsparse_auto_mutate = false; - - if (nargin == 1) - { - octave_value arg = args (0); - if (arg.is_bool_type ()) - retval = arg.sparse_bool_matrix_value (); - else if (arg.is_complex_type ()) - retval = arg.sparse_complex_matrix_value (); - else if (arg.is_numeric_type ()) - retval = arg.sparse_matrix_value (); - else - gripe_wrong_type_arg ("sparse", arg); - } - else if (nargin == 2) - { - octave_idx_type m = 0, n = 0; - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - { - m = args(0).idx_type_value (); - n = args(1).idx_type_value (); - } - else - error ("sparse: dimensions M,N must be scalar"); - - if (! error_state) - { - if (m >= 0 && n >= 0) - retval = SparseMatrix (m, n); - else - error ("sparse: dimensions M,N must be positive or zero"); - } - } - else if (nargin >= 3) - { - bool summation = true; - if (nargin > 3 && args(nargin-1).is_string ()) - { - std::string opt = args(nargin-1).string_value (); - if (opt == "unique") - summation = false; - else if (opt == "sum" || opt == "summation") - summation = true; - else - error ("sparse: invalid option: %s", opt.c_str ()); - - nargin -= 1; - } - - if (! error_state) - { - octave_idx_type m = -1, n = -1, nzmax = -1; - if (nargin == 6) - { - nzmax = args(5).idx_type_value (); - nargin --; - } - - if (nargin == 5) - { - if (args(3).is_scalar_type () && args(4).is_scalar_type ()) - { - m = args(3).idx_type_value (); - n = args(4).idx_type_value (); - } - else - error ("sparse: expecting scalar dimensions"); - - - if (! error_state && (m < 0 || n < 0)) - error ("sparse: dimensions must be non-negative"); - } - else if (nargin != 3) - print_usage (); - - if (! error_state) - { - idx_vector i = args(0).index_vector (); - idx_vector j = args(1).index_vector (); - - if (args(2).is_bool_type ()) - retval = SparseBoolMatrix (args(2).bool_array_value (), i, j, - m, n, summation, nzmax); - else if (args(2).is_complex_type ()) - retval = SparseComplexMatrix (args(2).complex_array_value (), - i, j, m, n, summation, nzmax); - else if (args(2).is_numeric_type ()) - retval = SparseMatrix (args(2).array_value (), i, j, - m, n, summation, nzmax); - else - gripe_wrong_type_arg ("sparse", args(2)); - } - - } - } - - return retval; -} - -DEFUN (spalloc, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{s} =} spalloc (@var{m}, @var{n}, @var{nz})\n\ -Create an @var{m}-by-@var{n} sparse matrix with pre-allocated space for at\n\ -most @var{nz} nonzero elements. This is useful for building the matrix\n\ -incrementally by a sequence of indexed assignments. Subsequent indexed\n\ -assignments will reuse the pre-allocated memory, provided they are of one of\n\ -the simple forms\n\ -\n\ -@itemize\n\ -@item @code{@var{s}(I:J) = @var{x}}\n\ -\n\ -@item @code{@var{s}(:,I:J) = @var{x}}\n\ -\n\ -@item @code{@var{s}(K:L,I:J) = @var{x}}\n\ -@end itemize\n\ -\n\ -@b{and} that the following conditions are met:\n\ -\n\ -@itemize\n\ -@item the assignment does not decrease nnz (@var{S}).\n\ -\n\ -@item after the assignment, nnz (@var{S}) does not exceed @var{nz}.\n\ -\n\ -@item no index is out of bounds.\n\ -@end itemize\n\ -\n\ -Partial movement of data may still occur, but in general the assignment will\n\ -be more memory and time-efficient under these circumstances. In particular,\n\ -it is possible to efficiently build a pre-allocated sparse matrix from\n\ -contiguous block of columns.\n\ -\n\ -The amount of pre-allocated memory for a given matrix may be queried using\n\ -the function @code{nzmax}.\n\ -@seealso{nzmax, sparse}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - octave_idx_type m = args(0).idx_type_value (); - octave_idx_type n = args(1).idx_type_value (); - octave_idx_type nz = 0; - if (nargin == 3) - nz = args(2).idx_type_value (); - if (error_state) - ; - else if (m >= 0 && n >= 0 && nz >= 0) - retval = SparseMatrix (dim_vector (m, n), nz); - else - error ("spalloc: M,N,NZ must be non-negative"); - } - else - print_usage (); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/strfns.cc --- a/src/strfns.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,973 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "dMatrix.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "ov.h" -#include "oct-obj.h" -#include "unwind-prot.h" -#include "utils.h" - -DEFUN (char, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} char (@var{x})\n\ -@deftypefnx {Built-in Function} {} char (@var{x}, @dots{})\n\ -@deftypefnx {Built-in Function} {} char (@var{s1}, @var{s2}, @dots{})\n\ -@deftypefnx {Built-in Function} {} char (@var{cell_array})\n\ -Create a string array from one or more numeric matrices, character\n\ -matrices, or cell arrays. Arguments are concatenated vertically.\n\ -The returned values are padded with blanks as needed to make each row\n\ -of the string array have the same length. Empty input strings are\n\ -significant and will concatenated in the output.\n\ -\n\ -For numerical input, each element is converted\n\ -to the corresponding ASCII character. A range error results if an input\n\ -is outside the ASCII range (0-255).\n\ -\n\ -For cell arrays, each element is concatenated separately. Cell arrays\n\ -converted through\n\ -@code{char} can mostly be converted back with @code{cellstr}.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -char ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ - @result{} [\"abc \"\n\ - \" \"\n\ - \"98 \"\n\ - \"99 \"\n\ - \"d \"\n\ - \"str1 \"\n\ - \"half \"]\n\ -@end group\n\ -@end example\n\ -@seealso{strvcat, cellstr}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = ""; - else if (nargin == 1) - retval = args(0).convert_to_str (true, true, - args(0).is_dq_string () ? '"' : '\''); - else - { - int n_elts = 0; - - int max_len = 0; - - std::queue args_as_strings; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args(i).all_strings (); - - if (error_state) - { - error ("char: unable to convert some args to strings"); - return retval; - } - - if (s.length () > 0) - n_elts += s.length (); - else - n_elts += 1; - - int s_max_len = s.max_length (); - - if (s_max_len > max_len) - max_len = s_max_len; - - args_as_strings.push (s); - } - - string_vector result (n_elts); - - int k = 0; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args_as_strings.front (); - args_as_strings.pop (); - - int n = s.length (); - - if (n > 0) - { - for (int j = 0; j < n; j++) - { - std::string t = s[j]; - int t_len = t.length (); - - if (max_len > t_len) - t += std::string (max_len - t_len, ' '); - - result[k++] = t; - } - } - else - result[k++] = std::string (max_len, ' '); - } - - retval = octave_value (result, '\''); - } - - return retval; -} - -/* -%!assert (char (), ''); -%!assert (char (100), "d"); -%!assert (char (100,100), ["d";"d"]) -%!assert (char ({100,100}), ["d";"d"]) -%!assert (char ([100,100]), ["dd"]) -%!assert (char ({100,{100}}), ["d";"d"]) -%!assert (char (100, [], 100), ["d";" ";"d"]) -%!assert (char ({100, [], 100}), ["d";" ";"d"]) -%!assert (char ({100,{100, {""}}}), ["d";"d";" "]) -%!assert (char (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) -%!assert (char ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) -%!assert (char ([65, 83, 67, 73, 73]), "ASCII") - -%!test -%! x = char ("foo", "bar", "foobar"); -%! assert (x(1,:), "foo "); -%! assert (x(2,:), "bar "); -%! assert (x(3,:), "foobar"); -*/ - -DEFUN (strvcat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strvcat (@var{x})\n\ -@deftypefnx {Built-in Function} {} strvcat (@var{x}, @dots{})\n\ -@deftypefnx {Built-in Function} {} strvcat (@var{s1}, @var{s2}, @dots{})\n\ -@deftypefnx {Built-in Function} {} strvcat (@var{cell_array})\n\ -Create a character array from one or more numeric matrices, character\n\ -matrices, or cell arrays. Arguments are concatenated vertically.\n\ -The returned values are padded with blanks as needed to make each row\n\ -of the string array have the same length. Unlike @code{char}, empty\n\ -strings are removed and will not appear in the output.\n\ -\n\ -For numerical input, each element is converted\n\ -to the corresponding ASCII character. A range error results if an input\n\ -is outside the ASCII range (0-255).\n\ -\n\ -For cell arrays, each element is concatenated separately. Cell arrays\n\ -converted through\n\ -@code{strvcat} can mostly be converted back with @code{cellstr}.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -strvcat ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ - @result{} [\"abc \"\n\ - \"98 \"\n\ - \"99 \"\n\ - \"d \"\n\ - \"str1 \"\n\ - \"half \"]\n\ -@end group\n\ -@end example\n\ -@seealso{char, strcat, cstrcat}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin > 0) - { - int n_elts = 0; - - size_t max_len = 0; - - std::queue args_as_strings; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args(i).all_strings (); - - if (error_state) - { - error ("strvcat: unable to convert some args to strings"); - return retval; - } - - size_t n = s.length (); - - // do not count empty strings in calculation of number of elements - if (n > 0) - { - for (size_t j = 0; j < n; j++) - { - if (s[j].length () > 0) - n_elts++; - } - } - - size_t s_max_len = s.max_length (); - - if (s_max_len > max_len) - max_len = s_max_len; - - args_as_strings.push (s); - } - - string_vector result (n_elts); - - octave_idx_type k = 0; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args_as_strings.front (); - args_as_strings.pop (); - - size_t n = s.length (); - - if (n > 0) - { - for (size_t j = 0; j < n; j++) - { - std::string t = s[j]; - if (t.length () > 0) - { - size_t t_len = t.length (); - - if (max_len > t_len) - t += std::string (max_len - t_len, ' '); - - result[k++] = t; - } - } - } - } - - retval = octave_value (result, '\''); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strvcat (""), ""); -%!assert (strvcat (100) == "d"); -%!assert (strvcat (100,100), ["d";"d"]) -%!assert (strvcat ({100,100}), ["d";"d"]) -%!assert (strvcat ([100,100]), ["dd"]) -%!assert (strvcat ({100,{100}}), ["d";"d"]) -%!assert (strvcat (100, [], 100), ["d";"d"]) -%!assert (strvcat ({100, [], 100}), ["d";"d"]) -%!assert (strvcat ({100,{100, {""}}}), ["d";"d"]) -%!assert (strvcat (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) -%!assert (strvcat ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) - -%!error strvcat () -*/ - - -DEFUN (ischar, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ischar (@var{x})\n\ -Return true if @var{x} is a character array.\n\ -@seealso{isfloat, isinteger, islogical, isnumeric, iscellstr, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 && args(0).is_defined ()) - retval = args(0).is_string (); - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar ("a"), true) -%!assert (ischar (["ab";"cd"]), true) -%!assert (ischar ({"ab"}), false) -%!assert (ischar (1), false) -%!assert (ischar ([1, 2]), false) -%!assert (ischar ([]), false) -%!assert (ischar ([1, 2; 3, 4]), false) -%!assert (ischar (""), true) -%!assert (ischar ("test"), true) -%!assert (ischar (["test"; "ing"]), true) -%!assert (ischar (struct ("foo", "bar")), false) - -%!error ischar () -%!error ischar ("test", 1) -*/ - -static octave_value -do_strcmp_fun (const octave_value& arg0, const octave_value& arg1, - octave_idx_type n, const char *fcn_name, - bool (*array_op) (const charNDArray&, const charNDArray&, octave_idx_type), - bool (*str_op) (const std::string&, const std::string&, octave_idx_type)) - -{ - octave_value retval; - - bool s1_string = arg0.is_string (); - bool s1_cell = arg0.is_cell (); - bool s2_string = arg1.is_string (); - bool s2_cell = arg1.is_cell (); - - if (s1_string && s2_string) - retval = array_op (arg0.char_array_value (), arg1.char_array_value (), n); - else if ((s1_string && s2_cell) || (s1_cell && s2_string)) - { - octave_value str_val, cell_val; - - if (s1_string) - { - str_val = arg0; - cell_val = arg1; - } - else - { - str_val = arg1; - cell_val = arg0; - } - - const Cell cell = cell_val.cell_value (); - const string_vector str = str_val.all_strings (); - octave_idx_type r = str.length (); - - if (r == 0 || r == 1) - { - // Broadcast the string. - - boolNDArray output (cell_val.dims (), false); - - std::string s = r == 0 ? std::string () : str[0]; - - if (cell_val.is_cellstr ()) - { - const Array cellstr = cell_val.cellstr_value (); - for (octave_idx_type i = 0; i < cellstr.length (); i++) - output(i) = str_op (cellstr(i), s, n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < cell.length (); i++) - { - if (cell(i).is_string ()) - output(i) = str_op (cell(i).string_value (), s, n); - } - } - - retval = output; - } - else if (r > 1) - { - if (cell.length () == 1) - { - // Broadcast the cell. - - const dim_vector dv (r, 1); - boolNDArray output (dv, false); - - if (cell(0).is_string ()) - { - const std::string str2 = cell(0).string_value (); - - for (octave_idx_type i = 0; i < r; i++) - output(i) = str_op (str[i], str2, n); - } - - retval = output; - } - else - { - // Must match in all dimensions. - - boolNDArray output (cell.dims (), false); - - if (cell.length () == r) - { - if (cell_val.is_cellstr ()) - { - const Array cellstr = cell_val.cellstr_value (); - for (octave_idx_type i = 0; i < cellstr.length (); i++) - output(i) = str_op (str[i], cellstr(i), n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < r; i++) - { - if (cell(i).is_string ()) - output(i) = str_op (str[i], cell(i).string_value (), n); - } - } - - retval = output; - } - else - retval = false; - } - } - } - else if (s1_cell && s2_cell) - { - octave_value cell1_val, cell2_val; - octave_idx_type r1 = arg0.numel (), r2; - - if (r1 == 1) - { - // Make the singleton cell2. - - cell1_val = arg1; - cell2_val = arg0; - } - else - { - cell1_val = arg0; - cell2_val = arg1; - } - - const Cell cell1 = cell1_val.cell_value (); - const Cell cell2 = cell2_val.cell_value (); - r1 = cell1.numel (); - r2 = cell2.numel (); - - const dim_vector size1 = cell1.dims (); - const dim_vector size2 = cell2.dims (); - - boolNDArray output (size1, false); - - if (r2 == 1) - { - // Broadcast cell2. - - if (cell2(0).is_string ()) - { - const std::string str2 = cell2(0).string_value (); - - if (cell1_val.is_cellstr ()) - { - const Array cellstr = cell1_val.cellstr_value (); - for (octave_idx_type i = 0; i < cellstr.length (); i++) - output(i) = str_op (cellstr(i), str2, n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < r1; i++) - { - if (cell1(i).is_string ()) - { - const std::string str1 = cell1(i).string_value (); - output(i) = str_op (str1, str2, n); - } - } - } - } - } - else - { - if (size1 != size2) - { - error ("%s: nonconformant cell arrays", fcn_name); - return retval; - } - - if (cell1.is_cellstr () && cell2.is_cellstr ()) - { - const Array cellstr1 = cell1_val.cellstr_value (); - const Array cellstr2 = cell2_val.cellstr_value (); - for (octave_idx_type i = 0; i < r1; i++) - output (i) = str_op (cellstr1(i), cellstr2(i), n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < r1; i++) - { - if (cell1(i).is_string () && cell2(i).is_string ()) - { - const std::string str1 = cell1(i).string_value (); - const std::string str2 = cell2(i).string_value (); - output(i) = str_op (str1, str2, n); - } - } - } - } - - retval = output; - } - else - retval = false; - - return retval; -} - -// If both args are arrays, dimensions may be significant. -static bool -strcmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) -{ - return (s1.dims () == s2.dims () - && std::equal (s1.data (), s1.data () + s1.numel (), s2.data ())); -} - -// Otherwise, just use strings. -static bool -strcmp_str_op (const std::string& s1, const std::string& s2, - octave_idx_type) -{ - return s1 == s2; -} - -DEFUN (strcmp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strcmp (@var{s1}, @var{s2})\n\ -Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ -and 0 otherwise.\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -@seealso{strcmpi, strncmp, strncmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - retval = do_strcmp_fun (args (0), args (1), 0, - "strcmp", strcmp_array_op, strcmp_str_op); - } - else - print_usage (); - - return retval; -} - -/* -%!shared x -%! x = char (zeros (0, 2)); -%!assert (strcmp ("", x), false) -%!assert (strcmp (x, ""), false) -%!assert (strcmp (x, x), true) -## %!assert (strcmp ({""}, x), true) -## %!assert (strcmp ({x}, ""), false) -## %!assert (strcmp ({x}, x), true) -## %!assert (strcmp ("", {x}), false) -## %!assert (strcmp (x, {""}), false) -## %!assert (strcmp (x, {x}), true) -## %!assert (strcmp ({x; x}, ""), [false; false]) -## %!assert (strcmp ({x; x}, {""}), [false; false]) -## %!assert (strcmp ("", {x; x}), [false; false]) -## %!assert (strcmp ({""}, {x; x}), [false; false]) -%!assert (strcmp ({"foo"}, x), false) -%!assert (strcmp ({"foo"}, "foo"), true) -%!assert (strcmp ({"foo"}, x), false) -%!assert (strcmp (x, {"foo"}), false) -%!assert (strcmp ("foo", {"foo"}), true) -%!assert (strcmp (x, {"foo"}), false) -%!shared y -%! y = char (zeros (2, 0)); -%!assert (strcmp ("", y), false) -%!assert (strcmp (y, ""), false) -%!assert (strcmp (y, y), true) -%!assert (strcmp ({""}, y), [true; true]) -%!assert (strcmp ({y}, ""), true) -%!assert (strcmp ({y}, y), [true; true]) -%!assert (strcmp ("", {y}), true) -%!assert (strcmp (y, {""}), [true; true]) -%!assert (strcmp (y, {y}), [true; true]) -%!assert (strcmp ({y; y}, ""), [true; true]) -%!assert (strcmp ({y; y}, {""}), [true; true]) -%!assert (strcmp ("", {y; y}), [true; true]) -%!assert (strcmp ({""}, {y; y}), [true; true]) -%!assert (strcmp ({"foo"}, y), [false; false]) -%!assert (strcmp ({"foo"}, y), [false; false]) -%!assert (strcmp (y, {"foo"}), [false; false]) -%!assert (strcmp (y, {"foo"}), [false; false]) -%!assert (strcmp ("foobar", "foobar"), true) -%!assert (strcmp ("fooba", "foobar"), false) - -%!error strcmp () -%!error strcmp ("foo", "bar", 3) -*/ - -// Apparently, Matlab ignores the dims with strncmp. It also -static bool -strncmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.numel (), l2 = s2.numel (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data ())); -} - -// Otherwise, just use strings. Note that we neither extract substrings (which -// would mean a copy, at least in GCC), nor use string::compare (which is a -// 3-way compare). -static bool -strncmp_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.length (), l2 = s2.length (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data ())); -} - -DEFUN (strncmp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strncmp (@var{s1}, @var{s2}, @var{n})\n\ -Return 1 if the first @var{n} characters of strings @var{s1} and @var{s2} are\n\ -the same, and 0 otherwise.\n\ -\n\ -@example\n\ -@group\n\ -strncmp (\"abce\", \"abcd\", 3)\n\ - @result{} 1\n\ -@end group\n\ -@end example\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@example\n\ -@group\n\ -strncmp (\"abce\", @{\"abcd\", \"bca\", \"abc\"@}, 3)\n\ - @result{} [1, 0, 1]\n\ -@end group\n\ -@end example\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmp\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -@seealso{strncmpi, strcmp, strcmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 3) - { - octave_idx_type n = args(2).idx_type_value (); - - if (! error_state) - { - if (n > 0) - { - retval = do_strcmp_fun (args(0), args(1), n, "strncmp", - strncmp_array_op, strncmp_str_op); - } - else - error ("strncmp: N must be greater than 0"); - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strncmp ("abce", "abc", 3), true) -%!assert (strncmp (100, 100, 1), false) -%!assert (strncmp ("abce", {"abcd", "bca", "abc"}, 3), logical ([1, 0, 1])) -%!assert (strncmp ("abc", {"abcd", "bca", "abc"}, 4), logical ([0, 0, 0])) -%!assert (strncmp ({"abcd", "bca", "abc"},"abce", 3), logical ([1, 0, 1])) -%!assert (strncmp ({"abcd", "bca", "abc"},{"abcd", "bca", "abe"}, 3), logical ([1, 1, 0])) -%!assert (strncmp ("abc", {"abcd", 10}, 2), logical ([1, 0])) - -%!error strncmp () -%!error strncmp ("abc", "def") -*/ - -// case-insensitive character equality functor -struct icmp_char_eq : public std::binary_function -{ - bool operator () (char x, char y) const - { return std::toupper (x) == std::toupper (y); } -}; - -// strcmpi is equivalent to strcmp in that it checks all dims. -static bool -strcmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) -{ - return (s1.dims () == s2.dims () - && std::equal (s1.data (), s1.data () + s1.numel (), s2.data (), - icmp_char_eq ())); -} - -// Ditto for string. -static bool -strcmpi_str_op (const std::string& s1, const std::string& s2, - octave_idx_type) -{ - return (s1.size () == s2.size () - && std::equal (s1.data (), s1.data () + s1.size (), s2.data (), - icmp_char_eq ())); -} - -DEFUNX ("strcmpi", Fstrcmpi, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strcmpi (@var{s1}, @var{s2})\n\ -Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ -disregarding case of alphabetic characters, and 0 otherwise.\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -\n\ -@strong{Caution:} National alphabets are not supported.\n\ -@seealso{strcmp, strncmp, strncmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - retval = do_strcmp_fun (args (0), args (1), 0, - "strcmpi", strcmpi_array_op, strcmpi_str_op); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strcmpi ("abc123", "ABC123"), true) -*/ - -// Like strncmp. -static bool -strncmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.numel (), l2 = s2.numel (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data (), - icmp_char_eq ())); -} - -// Ditto. -static bool -strncmpi_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.length (), l2 = s2.length (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data (), - icmp_char_eq ())); -} - -DEFUNX ("strncmpi", Fstrncmpi, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strncmpi (@var{s1}, @var{s2}, @var{n})\n\ -Return 1 if the first @var{n} character of @var{s1} and @var{s2} are the\n\ -same, disregarding case of alphabetic characters, and 0 otherwise.\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmpi\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -\n\ -@strong{Caution:} National alphabets are not supported.\n\ -@seealso{strncmp, strcmp, strcmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 3) - { - octave_idx_type n = args(2).idx_type_value (); - - if (! error_state) - { - if (n > 0) - { - retval = do_strcmp_fun (args(0), args(1), n, "strncmpi", - strncmpi_array_op, strncmpi_str_op); - } - else - error ("strncmpi: N must be greater than 0"); - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strncmpi ("abc123", "ABC456", 3), true) -*/ - -DEFUN (list_in_columns, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} list_in_columns (@var{arg}, @var{width}, @var{prefix})\n\ -Return a string containing the elements of @var{arg} listed in\n\ -columns with an overall maximum width of @var{width} and optional\n\ -prefix @var{prefix}. The argument @var{arg} must be a cell array\n\ -of character strings or a character array. If @var{width} is not\n\ -specified or is an empty matrix, or less than or equal to zero,\n\ -the width of the terminal screen is used.\n\ -Newline characters are used to break the lines in the output string.\n\ -For example:\n\ -@c Set example in small font to prevent overfull line\n\ -\n\ -@smallexample\n\ -@group\n\ -list_in_columns (@{\"abc\", \"def\", \"ghijkl\", \"mnop\", \"qrs\", \"tuv\"@}, 20)\n\ - @result{} abc mnop\n\ - def qrs\n\ - ghijkl tuv\n\ -\n\ -whos ans\n\ - @result{}\n\ - Variables in the current scope:\n\ -\n\ - Attr Name Size Bytes Class\n\ - ==== ==== ==== ===== =====\n\ - ans 1x37 37 char\n\ -\n\ - Total is 37 elements using 37 bytes\n\ -@end group\n\ -@end smallexample\n\ -\n\ -@seealso{terminal_size}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 3) - { - print_usage (); - return retval; - } - - string_vector s = args(0).all_strings (); - - if (error_state) - { - error ("list_in_columns: expecting cellstr or char array"); - return retval; - } - - int width = -1; - - if (nargin > 1 && ! args(1).is_empty ()) - { - width = args(1).int_value (); - - if (error_state) - { - error ("list_in_columns: WIDTH must be an integer"); - return retval; - } - } - - std::string prefix; - - if (nargin > 2) - { - if (args(2).is_string ()) - { - prefix = args(2).string_value (); - - if (error_state) - { - error ("list_in_columns: PREFIX must be a character string"); - return retval; - } - } - else - { - error ("list_in_columns: PREFIX must be a character string"); - return retval; - } - } - - std::ostringstream buf; - - s.list_in_columns (buf, width, prefix); - - retval = buf.str (); - - return retval; -} - -/* -%!test -%! input = {"abc", "def", "ghijkl", "mnop", "qrs", "tuv"}; -%! result = "abc mnop\ndef qrs\nghijkl tuv\n"; -%! assert (list_in_columns (input, 20), result); -%!test -%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; -%! result = "abc mnop \ndef qrs \nghijkl tuv \n"; -%! assert (list_in_columns (input, 20), result); -%!test -%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; -%! result = " abc mnop \n def qrs \n ghijkl tuv \n"; -%! assert (list_in_columns (input, 20, " "), result); - -%!error list_in_columns () -%!error list_in_columns (["abc", "def"], 20, 2) -%!error list_in_columns (["abc", "def"], 20, " ", 3) -%!error list_in_columns (["abc", "def"], "a") -*/ diff -r d02b229ce693 -r a132d206a36a src/symtab.cc --- a/src/symtab.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1744 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague, a.s. - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "oct-time.h" -#include "singleton-cleanup.h" - -#include "debug.h" -#include "defun.h" -#include "dirfns.h" -#include "input.h" -#include "load-path.h" -#include "ov-fcn.h" -#include "ov-usr-fcn.h" -#include "pager.h" -#include "parse.h" -#include "pt-arg-list.h" -#include "symtab.h" -#include "unwind-prot.h" -#include "utils.h" - -symbol_table *symbol_table::instance = 0; - -symbol_table::scope_id_cache *symbol_table::scope_id_cache::instance = 0; - -std::map symbol_table::all_instances; - -std::map symbol_table::global_table; - -std::map symbol_table::fcn_table; - -std::map > symbol_table::class_precedence_table; - -std::map > symbol_table::parent_map; - -const symbol_table::scope_id symbol_table::xglobal_scope = 0; -const symbol_table::scope_id symbol_table::xtop_scope = 1; - -symbol_table::scope_id symbol_table::xcurrent_scope = 1; - -symbol_table::context_id symbol_table::xcurrent_context = 0; - -// Should Octave always check to see if function files have changed -// since they were last compiled? -static int Vignore_function_time_stamp = 1; - -void -symbol_table::scope_id_cache::create_instance (void) -{ - instance = new scope_id_cache (); - - singleton_cleanup_list::add (cleanup_instance); -} - -symbol_table::context_id -symbol_table::symbol_record::symbol_record_rep::active_context (void) const -{ - octave_user_function *fcn = curr_fcn; - - // FIXME -- If active_context () == -1, then it does not make much - // sense to use this symbol_record. This means an attempt at accessing - // a variable from a function that has not been called yet is - // happening. This should be cleared up when an implementing closures. - - return fcn && fcn->active_context () != static_cast (-1) - ? fcn->active_context () : xcurrent_context; -} - -void -symbol_table::symbol_record::symbol_record_rep::dump - (std::ostream& os, const std::string& prefix) const -{ - octave_value val = varval (); - - os << prefix << name; - - if (val.is_defined ()) - { - os << " [" - << (is_local () ? "l" : "") - << (is_automatic () ? "a" : "") - << (is_formal () ? "f" : "") - << (is_hidden () ? "h" : "") - << (is_inherited () ? "i" : "") - << (is_global () ? "g" : "") - << (is_persistent () ? "p" : "") - << "] "; - val.dump (os); - } - - os << "\n"; -} - -octave_value -symbol_table::symbol_record::find (const octave_value_list& args) const -{ - octave_value retval; - - if (is_global ()) - retval = symbol_table::global_varref (name ()); - else - { - retval = varval (); - - if (retval.is_undefined ()) - { - // Use cached fcn_info pointer if possible. - if (rep->finfo) - retval = rep->finfo->find (args); - else - { - retval = symbol_table::find_function (name (), args); - - if (retval.is_defined ()) - rep->finfo = get_fcn_info (name ()); - } - } - } - - return retval; -} - -// Check the load path to see if file that defined this is still -// visible. If the file is no longer visible, then erase the -// definition and move on. If the file is visible, then we also -// need to check to see whether the file has changed since the the -// function was loaded/parsed. However, this check should only -// happen once per prompt (for files found from relative path -// elements, we also check if the working directory has changed -// since the last time the function was loaded/parsed). -// -// FIXME -- perhaps this should be done for all loaded functions when -// the prompt is printed or the directory has changed, and then we -// would not check for it when finding symbol definitions. - -static inline bool -load_out_of_date_fcn (const std::string& ff, const std::string& dir_name, - octave_value& function, - const std::string& dispatch_type = std::string ()) -{ - bool retval = false; - - octave_function *fcn = load_fcn_from_file (ff, dir_name, dispatch_type); - - if (fcn) - { - retval = true; - - function = octave_value (fcn); - } - else - function = octave_value (); - - return retval; -} - -bool -out_of_date_check (octave_value& function, - const std::string& dispatch_type, - bool check_relative) -{ - bool retval = false; - - octave_function *fcn = function.function_value (true); - - if (fcn) - { - // FIXME -- we need to handle subfunctions properly here. - - if (! fcn->is_subfunction ()) - { - std::string ff = fcn->fcn_file_name (); - - if (! ff.empty ()) - { - octave_time tc = fcn->time_checked (); - - bool relative = check_relative && fcn->is_relative (); - - if (tc < Vlast_prompt_time - || (relative && tc < Vlast_chdir_time)) - { - bool clear_breakpoints = false; - std::string nm = fcn->name (); - - bool is_same_file = false; - - std::string file; - std::string dir_name; - - if (check_relative) - { - int nm_len = nm.length (); - - if (octave_env::absolute_pathname (nm) - && ((nm_len > 4 && (nm.substr (nm_len-4) == ".oct" - || nm.substr (nm_len-4) == ".mex")) - || (nm_len > 2 && nm.substr (nm_len-2) == ".m"))) - file = nm; - else - { - // We don't want to make this an absolute name, - // because load_fcn_file looks at the name to - // decide whether it came from a relative lookup. - - if (! dispatch_type.empty ()) - { - file = load_path::find_method (dispatch_type, nm, - dir_name); - - if (file.empty ()) - { - const std::list& plist - = symbol_table::parent_classes (dispatch_type); - std::list::const_iterator it - = plist.begin (); - - while (it != plist.end ()) - { - file = load_path::find_method (*it, nm, dir_name); - if (! file.empty ()) - break; - - it++; - } - } - } - - // Maybe it's an autoload? - if (file.empty ()) - file = lookup_autoload (nm); - - if (file.empty ()) - file = load_path::find_fcn (nm, dir_name); - } - - if (! file.empty ()) - is_same_file = same_file (file, ff); - } - else - { - is_same_file = true; - file = ff; - } - - if (file.empty ()) - { - // Can't see this function from current - // directory, so we should clear it. - - function = octave_value (); - - clear_breakpoints = true; - } - else if (is_same_file) - { - // Same file. If it is out of date, then reload it. - - octave_time ottp = fcn->time_parsed (); - time_t tp = ottp.unix_time (); - - fcn->mark_fcn_file_up_to_date (octave_time ()); - - if (! (Vignore_function_time_stamp == 2 - || (Vignore_function_time_stamp - && fcn->is_system_fcn_file ()))) - { - file_stat fs (ff); - - if (fs) - { - if (fs.is_newer (tp)) - { - retval = load_out_of_date_fcn (ff, dir_name, - function, - dispatch_type); - - clear_breakpoints = true; - } - } - else - { - function = octave_value (); - - clear_breakpoints = true; - } - } - } - else - { - // Not the same file, so load the new file in - // place of the old. - - retval = load_out_of_date_fcn (file, dir_name, function, - dispatch_type); - - clear_breakpoints = true; - } - - // If the function has been replaced then clear any - // breakpoints associated with it - if (clear_breakpoints) - bp_table::remove_all_breakpoints_in_file (nm, true); - } - } - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::load_private_function - (const std::string& dir_name) -{ - octave_value retval; - - std::string file_name = load_path::find_private_fcn (dir_name, name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name); - - if (fcn) - { - std::string class_name; - - size_t pos = dir_name.find_last_of (file_ops::dir_sep_chars ()); - - if (pos != std::string::npos) - { - std::string tmp = dir_name.substr (pos+1); - - if (tmp[0] == '@') - class_name = tmp.substr (1); - } - - fcn->mark_as_private_function (class_name); - - retval = octave_value (fcn); - - private_functions[dir_name] = retval; - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::load_class_constructor (void) -{ - octave_value retval; - - std::string dir_name; - - std::string file_name = load_path::find_method (name, name, dir_name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name, name); - - if (fcn) - { - retval = octave_value (fcn); - - class_constructors[name] = retval; - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::load_class_method - (const std::string& dispatch_type) -{ - octave_value retval; - - if (name == dispatch_type) - retval = load_class_constructor (); - else - { - std::string dir_name; - - std::string file_name = load_path::find_method (dispatch_type, name, - dir_name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name, - dispatch_type); - - if (fcn) - { - retval = octave_value (fcn); - - class_methods[dispatch_type] = retval; - } - } - - if (retval.is_undefined ()) - { - // Search parent classes - - const std::list& plist = parent_classes (dispatch_type); - - std::list::const_iterator it = plist.begin (); - - while (it != plist.end ()) - { - retval = find_method (*it); - - if (retval.is_defined ()) - { - class_methods[dispatch_type] = retval; - break; - } - - it++; - } - } - } - - return retval; -} - -void -symbol_table::fcn_info::fcn_info_rep:: mark_subfunction_in_scope_as_private - (scope_id scope, const std::string& class_name) -{ - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - { - octave_function *fcn = p->second.function_value (); - - if (fcn) - fcn->mark_as_private_function (class_name); - } -} - -void -symbol_table::fcn_info::fcn_info_rep::print_dispatch (std::ostream& os) const -{ - if (dispatch_map.empty ()) - os << "dispatch: " << name << " is not overloaded" << std::endl; - else - { - os << "Overloaded function " << name << ":\n\n"; - - for (dispatch_map_const_iterator p = dispatch_map.begin (); - p != dispatch_map.end (); p++) - os << " " << name << " (" << p->first << ", ...) -> " - << p->second << " (" << p->first << ", ...)\n"; - - os << std::endl; - } -} - -std::string -symbol_table::fcn_info::fcn_info_rep::help_for_dispatch (void) const -{ - std::string retval; - - if (! dispatch_map.empty ()) - { - retval = "Overloaded function:\n\n"; - - for (dispatch_map_const_iterator p = dispatch_map.begin (); - p != dispatch_map.end (); p++) - retval += " " + p->second + " (" + p->first + ", ...)\n\n"; - } - - return retval; -} - -// :-) JWE, can you parse this? Returns a 2D array with second dimension equal -// to btyp_num_types (static constant). Only the leftmost dimension can be -// variable in C/C++. Typedefs are boring. - -static builtin_type_t (*build_sup_table (void))[btyp_num_types] -{ - static builtin_type_t sup_table[btyp_num_types][btyp_num_types]; - for (int i = 0; i < btyp_num_types; i++) - for (int j = 0; j < btyp_num_types; j++) - { - builtin_type_t ityp = static_cast (i); - builtin_type_t jtyp = static_cast (j); - // FIXME: Is this really right? - bool use_j = - (jtyp == btyp_func_handle || ityp == btyp_bool - || (btyp_isarray (ityp) - && (! btyp_isarray (jtyp) - || (btyp_isinteger (jtyp) && ! btyp_isinteger (ityp)) - || ((ityp == btyp_double || ityp == btyp_complex || ityp == btyp_char) - && (jtyp == btyp_float || jtyp == btyp_float_complex))))); - - sup_table[i][j] = use_j ? jtyp : ityp; - } - - return sup_table; -} - -std::string -get_dispatch_type (const octave_value_list& args, - builtin_type_t& builtin_type) -{ - static builtin_type_t (*sup_table)[btyp_num_types] = build_sup_table (); - std::string dispatch_type; - - int n = args.length (); - - if (n > 0) - { - int i = 0; - builtin_type = args(0).builtin_type (); - if (builtin_type != btyp_unknown) - { - for (i = 1; i < n; i++) - { - builtin_type_t bti = args(i).builtin_type (); - if (bti != btyp_unknown) - builtin_type = sup_table[builtin_type][bti]; - else - { - builtin_type = btyp_unknown; - break; - } - } - } - - if (builtin_type == btyp_unknown) - { - // There's a non-builtin class in the argument list. - dispatch_type = args(i).class_name (); - - for (int j = i+1; j < n; j++) - { - octave_value arg = args(j); - - if (arg.builtin_type () == btyp_unknown) - { - std::string cname = arg.class_name (); - - // Only switch to type of ARG if it is marked superior - // to the current DISPATCH_TYPE. - if (! symbol_table::is_superiorto (dispatch_type, cname) - && symbol_table::is_superiorto (cname, dispatch_type)) - dispatch_type = cname; - } - } - } - else - dispatch_type = btyp_class_name[builtin_type]; - } - else - builtin_type = btyp_unknown; - - return dispatch_type; -} - -std::string -get_dispatch_type (const octave_value_list& args) -{ - builtin_type_t builtin_type; - return get_dispatch_type (args, builtin_type); -} - -// Find the definition of NAME according to the following precedence -// list: -// -// variable -// subfunction -// private function -// class method -// class constructor -// legacy dispatch -// command-line function -// autoload function -// function on the path -// built-in function -// -// Matlab documentation states that constructors have higher precedence -// than methods, but that does not seem to be the case. - -octave_value -symbol_table::fcn_info::fcn_info_rep::find (const octave_value_list& args, - bool local_funcs) -{ - octave_value retval = xfind (args, local_funcs); - - if (! (error_state || retval.is_defined ())) - { - // It is possible that the user created a file on the fly since - // the last prompt or chdir, so try updating the load path and - // searching again. - - load_path::update (); - - retval = xfind (args, local_funcs); - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::xfind (const octave_value_list& args, - bool local_funcs) -{ - if (local_funcs) - { - // Subfunction. I think it only makes sense to check for - // subfunctions if we are currently executing a function defined - // from a .m file. - - octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); - - for (scope_id scope = xcurrent_scope; scope >= 0;) - { - scope_val_iterator r = subfunctions.find (scope); - if (r != subfunctions.end ()) - { - // FIXME -- out-of-date check here. - - return r->second; - } - - octave_user_function *scope_curr_fcn = get_curr_fcn (scope); - if (scope_curr_fcn) - scope = scope_curr_fcn->parent_fcn_scope (); - else - scope = -1; - } - - // Private function. - - if (curr_fcn) - { - std::string dir_name = curr_fcn->dir_name (); - - if (! dir_name.empty ()) - { - str_val_iterator q = private_functions.find (dir_name); - - if (q == private_functions.end ()) - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval, "", false); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - } - } - } - } - - // Class methods. - - if (! args.empty ()) - { - std::string dispatch_type = get_dispatch_type (args); - - octave_value fcn = find_method (dispatch_type); - - if (fcn.is_defined ()) - return fcn; - } - - // Class constructors. The class name and function name are the same. - - str_val_iterator q = class_constructors.find (name); - - if (q == class_constructors.end ()) - { - octave_value val = load_class_constructor (); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval, name); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_class_constructor (); - - if (val.is_defined ()) - return val; - } - } - - // Legacy dispatch. - - if (! args.empty () && ! dispatch_map.empty ()) - { - std::string dispatch_type = args(0).type_name (); - - std::string fname; - - dispatch_map_iterator p = dispatch_map.find (dispatch_type); - - if (p == dispatch_map.end ()) - p = dispatch_map.find ("any"); - - if (p != dispatch_map.end ()) - { - fname = p->second; - - octave_value fcn - = symbol_table::find_function (fname, args); - - if (fcn.is_defined ()) - return fcn; - } - } - - // Command-line function. - - if (cmdline_function.is_defined ()) - return cmdline_function; - - // Autoload? - - octave_value fcn = find_autoload (); - - if (fcn.is_defined ()) - return fcn; - - // Function on the path. - - fcn = find_user_function (); - - if (fcn.is_defined ()) - return fcn; - - // Built-in function (might be undefined). - - return built_in_function; -} - -// Find the definition of NAME according to the following precedence -// list: -// -// built-in function -// function on the path -// autoload function -// command-line function -// private function -// subfunction - -// This function is used to implement the "builtin" function, which -// searches for "built-in" functions. In Matlab, "builtin" only -// returns functions that are actually built-in to the interpreter. -// But since the list of built-in functions is different in Octave and -// Matlab, we also search up the precedence list until we find -// something that matches. Note that we are only searching by name, -// so class methods, constructors, and legacy dispatch functions are -// skipped. - -octave_value -symbol_table::fcn_info::fcn_info_rep::builtin_find (void) -{ - octave_value retval = x_builtin_find (); - - if (! retval.is_defined ()) - { - // It is possible that the user created a file on the fly since - // the last prompt or chdir, so try updating the load path and - // searching again. - - load_path::update (); - - retval = x_builtin_find (); - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::x_builtin_find (void) -{ - // Built-in function. - if (built_in_function.is_defined ()) - return built_in_function; - - // Function on the path. - - octave_value fcn = find_user_function (); - - if (fcn.is_defined ()) - return fcn; - - // Autoload? - - fcn = find_autoload (); - - if (fcn.is_defined ()) - return fcn; - - // Command-line function. - - if (cmdline_function.is_defined ()) - return cmdline_function; - - // Private function. - - octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); - - if (curr_fcn) - { - std::string dir_name = curr_fcn->dir_name (); - - if (! dir_name.empty ()) - { - str_val_iterator q = private_functions.find (dir_name); - - if (q == private_functions.end ()) - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - } - } - } - - // Subfunction. I think it only makes sense to check for - // subfunctions if we are currently executing a function defined - // from a .m file. - - for (scope_id scope = xcurrent_scope; scope >= 0;) - { - scope_val_iterator r = subfunctions.find (scope); - if (r != subfunctions.end ()) - { - // FIXME -- out-of-date check here. - - return r->second; - } - - octave_user_function *scope_curr_fcn = get_curr_fcn (scope); - if (scope_curr_fcn) - scope = scope_curr_fcn->parent_fcn_scope (); - else - scope = -1; - } - - return octave_value (); -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::find_method (const std::string& dispatch_type) -{ - octave_value retval; - - str_val_iterator q = class_methods.find (dispatch_type); - - if (q == class_methods.end ()) - { - octave_value val = load_class_method (dispatch_type); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval, dispatch_type); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_class_method (dispatch_type); - - if (val.is_defined ()) - return val; - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::find_autoload (void) -{ - octave_value retval; - - // Autoloaded function. - - if (autoload_function.is_defined ()) - out_of_date_check (autoload_function); - - if (! autoload_function.is_defined ()) - { - std::string file_name = lookup_autoload (name); - - if (! file_name.empty ()) - { - size_t pos = file_name.find_last_of (file_ops::dir_sep_chars ()); - - std::string dir_name = file_name.substr (0, pos); - - octave_function *fcn = load_fcn_from_file (file_name, dir_name, - "", name, true); - - if (fcn) - autoload_function = octave_value (fcn); - } - } - - return autoload_function; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::find_user_function (void) -{ - // Function on the path. - - if (function_on_path.is_defined ()) - out_of_date_check (function_on_path); - - if (! (error_state || function_on_path.is_defined ())) - { - std::string dir_name; - - std::string file_name = load_path::find_fcn (name, dir_name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name); - - if (fcn) - function_on_path = octave_value (fcn); - } - } - - return function_on_path; -} - -// Insert INF_CLASS in the set of class names that are considered -// inferior to SUP_CLASS. Return FALSE if INF_CLASS is currently -// marked as superior to SUP_CLASS. - -bool -symbol_table::set_class_relationship (const std::string& sup_class, - const std::string& inf_class) -{ - class_precedence_table_const_iterator p - = class_precedence_table.find (inf_class); - - if (p != class_precedence_table.end ()) - { - const std::set& inferior_classes = p->second; - - std::set::const_iterator q - = inferior_classes.find (sup_class); - - if (q != inferior_classes.end ()) - return false; - } - - class_precedence_table[sup_class].insert (inf_class); - - return true; -} - -// Has class A been marked as superior to class B? Also returns -// TRUE if B has been marked as inferior to A, since we only keep -// one table, and convert inferiort information to a superiorto -// relationship. Two calls are required to determine whether there -// is no relationship between two classes: -// -// if (symbol_table::is_superiorto (a, b)) -// // A is superior to B, or B has been marked inferior to A. -// else if (symbol_table::is_superiorto (b, a)) -// // B is superior to A, or A has been marked inferior to B. -// else -// // No relation. - -bool -symbol_table::is_superiorto (const std::string& a, const std::string& b) -{ - bool retval = false; - - class_precedence_table_const_iterator p = class_precedence_table.find (a); - - if (p != class_precedence_table.end ()) - { - const std::set& inferior_classes = p->second; - std::set::const_iterator q = inferior_classes.find (b); - - if (q != inferior_classes.end ()) - retval = true; - } - - return retval; -} - -static std::string -fcn_file_name (const octave_value& fcn) -{ - const octave_function *f = fcn.function_value (); - - return f ? f->fcn_file_name () : std::string (); -} - -void -symbol_table::fcn_info::fcn_info_rep::dump - (std::ostream& os, const std::string& prefix) const -{ - os << prefix << name - << " [" - << (cmdline_function.is_defined () ? "c" : "") - << (built_in_function.is_defined () ? "b" : "") - << "]\n"; - - std::string tprefix = prefix + " "; - - if (autoload_function.is_defined ()) - os << tprefix << "autoload: " - << fcn_file_name (autoload_function) << "\n"; - - if (function_on_path.is_defined ()) - os << tprefix << "function from path: " - << fcn_file_name (function_on_path) << "\n"; - - if (! subfunctions.empty ()) - { - for (scope_val_const_iterator p = subfunctions.begin (); - p != subfunctions.end (); p++) - os << tprefix << "subfunction: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! private_functions.empty ()) - { - for (str_val_const_iterator p = private_functions.begin (); - p != private_functions.end (); p++) - os << tprefix << "private: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! class_constructors.empty ()) - { - for (str_val_const_iterator p = class_constructors.begin (); - p != class_constructors.end (); p++) - os << tprefix << "constructor: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! class_methods.empty ()) - { - for (str_val_const_iterator p = class_methods.begin (); - p != class_methods.end (); p++) - os << tprefix << "method: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! dispatch_map.empty ()) - { - for (dispatch_map_const_iterator p = dispatch_map.begin (); - p != dispatch_map.end (); p++) - os << tprefix << "dispatch: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } -} - -void -symbol_table::install_nestfunction (const std::string& name, - const octave_value& fcn, - scope_id parent_scope) -{ - install_subfunction (name, fcn, parent_scope); - - // Stash the nest_parent for resolving variables after parsing is done. - octave_function *fv = fcn.function_value (); - - symbol_table *fcn_table_loc = get_instance (fv->scope ()); - - symbol_table *parent_table = get_instance (parent_scope); - - parent_table->add_nest_child (*fcn_table_loc); -} - -octave_value -symbol_table::find (const std::string& name, - const octave_value_list& args, - bool skip_variables, - bool local_funcs) -{ - symbol_table *inst = get_instance (xcurrent_scope); - - return inst - ? inst->do_find (name, args, skip_variables, local_funcs) - : octave_value (); -} - -octave_value -symbol_table::builtin_find (const std::string& name) -{ - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_builtin_find (name) : octave_value (); -} - -octave_value -symbol_table::find_function (const std::string& name, - const octave_value_list& args, - bool local_funcs) -{ - octave_value retval; - - if (! name.empty () && name[0] == '@') - { - // Look for a class specific function. - std::string dispatch_type = - name.substr (1, name.find_first_of (file_ops::dir_sep_str ()) - 1); - - std::string method = - name.substr (name.find_last_of (file_ops::dir_sep_str ()) + 1, - std::string::npos); - - retval = find_method (method, dispatch_type); - } - else - { - size_t pos = name.find_first_of (Vfilemarker); - - if (pos == std::string::npos) - retval = find (name, args, true, local_funcs); - else - { - std::string fcn_scope = name.substr (0, pos); - scope_id stored_scope = xcurrent_scope; - xcurrent_scope = xtop_scope; - octave_value parent = find_function (name.substr (0, pos), - octave_value_list (), false); - - if (parent.is_defined ()) - { - octave_function *parent_fcn = parent.function_value (); - - if (parent_fcn) - { - xcurrent_scope = parent_fcn->scope (); - - if (xcurrent_scope > 1) - retval = find_function (name.substr (pos + 1), args); - } - } - - xcurrent_scope = stored_scope; - } - } - - return retval; -} - -void -symbol_table::dump (std::ostream& os, scope_id scope) -{ - if (scope == xglobal_scope) - dump_global (os); - else - { - symbol_table *inst = get_instance (scope, false); - - if (inst) - { - os << "*** dumping symbol table scope " << scope - << " (" << inst->table_name << ")\n\n"; - - std::map sfuns - = symbol_table::subfunctions_defined_in_scope (scope); - - if (! sfuns.empty ()) - { - os << " subfunctions defined in this scope:\n"; - - for (std::map::const_iterator p = sfuns.begin (); - p != sfuns.end (); p++) - os << " " << p->first << "\n"; - - os << "\n"; - } - - inst->do_dump (os); - } - } -} - -void -symbol_table::dump_global (std::ostream& os) -{ - if (! global_table.empty ()) - { - os << "*** dumping global symbol table\n\n"; - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - { - std::string nm = p->first; - octave_value val = p->second; - - os << " " << nm << " "; - val.dump (os); - os << "\n"; - } - } -} - -void -symbol_table::dump_functions (std::ostream& os) -{ - if (! fcn_table.empty ()) - { - os << "*** dumping globally visible functions from symbol table\n" - << " (c=commandline, b=built-in)\n\n"; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - p->second.dump (os, " "); - - os << "\n"; - } -} - -void -symbol_table::stash_dir_name_for_subfunctions (scope_id scope, - const std::string& dir_name) -{ - // FIXME -- is this the best way to do this? Maybe it would be - // better if we had a map from scope to list of subfunctions - // stored with the function. Do we? - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - std::pair tmp - = p->second.subfunction_defined_in_scope (scope); - - std::string nm = tmp.first; - - if (! nm.empty ()) - { - octave_value& fcn = tmp.second; - - octave_user_function *f = fcn.user_function_value (); - - if (f) - f->stash_dir_name (dir_name); - } - } -} - -octave_value -symbol_table::do_find (const std::string& name, - const octave_value_list& args, - bool skip_variables, - bool local_funcs) -{ - octave_value retval; - - // Variable. - - if (! skip_variables) - { - table_iterator p = table.find (name); - - if (p != table.end ()) - { - symbol_record sr = p->second; - - // FIXME -- should we be using something other than varref here? - - if (sr.is_global ()) - return symbol_table::global_varref (name); - else - { - octave_value& val = sr.varref (); - - if (val.is_defined ()) - return val; - } - } - } - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - return p->second.find (args, local_funcs); - else - { - fcn_info finfo (name); - - octave_value fcn = finfo.find (args, local_funcs); - - if (fcn.is_defined ()) - fcn_table[name] = finfo; - - return fcn; - } - - return retval; -} - -octave_value -symbol_table::do_builtin_find (const std::string& name) -{ - octave_value retval; - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - return p->second.builtin_find (); - else - { - fcn_info finfo (name); - - octave_value fcn = finfo.builtin_find (); - - if (fcn.is_defined ()) - fcn_table[name] = finfo; - - return fcn; - } - - return retval; -} - -void -symbol_table::do_dump (std::ostream& os) -{ - if (! persistent_table.empty ()) - { - os << " persistent variables in this scope:\n\n"; - - for (persistent_table_const_iterator p = persistent_table.begin (); - p != persistent_table.end (); p++) - { - std::string nm = p->first; - octave_value val = p->second; - - os << " " << nm << " "; - val.dump (os); - os << "\n"; - } - - os << "\n"; - } - - if (! table.empty ()) - { - os << " other symbols in this scope (l=local; a=auto; f=formal\n" - << " h=hidden; i=inherited; g=global; p=persistent)\n\n"; - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - p->second.dump (os, " "); - - os << "\n"; - } -} - -void symbol_table::cleanup (void) -{ - // Clear variables in top scope. - all_instances[xtop_scope]->clear_variables (); - - // Clear function table. This is a hard clear, ignoring mlocked functions. - fcn_table.clear (); - - // Clear variables in global scope. - // FIXME: are there any? - all_instances[xglobal_scope]->clear_variables (); - - // Clear global variables. - global_table.clear (); - - // Delete all possibly remaining scopes. - for (all_instances_iterator iter = all_instances.begin (); - iter != all_instances.end (); iter++) - { - scope_id scope = iter->first; - if (scope != xglobal_scope && scope != xtop_scope) - scope_id_cache::free (scope); - - // First zero the table entry to avoid possible duplicate delete. - symbol_table *inst = iter->second; - iter->second = 0; - - // Now delete the scope. Note that there may be side effects, such as - // deleting other scopes. - delete inst; - } -} - -void -symbol_table::do_update_nest (void) -{ - if (nest_parent || nest_children.size ()) - curr_fcn->mark_as_nested_function (); - - if (nest_parent) - { - // fix bad symbol_records - for (table_iterator ti = table.begin (); ti != table.end (); ++ti) - { - symbol_record &ours = ti->second; - symbol_record parents; - if (! ours.is_formal () - && nest_parent->look_nonlocal (ti->first, parents)) - { - if (ours.is_global () || ours.is_persistent ()) - ::error ("global and persistent may only be used in the topmost level in which a nested variable is used"); - - if (! ours.is_formal ()) - { - ours.invalidate (); - ti->second = parents; - } - } - else - ours.set_curr_fcn (curr_fcn); - } - } - else if (nest_children.size ()) - for (table_iterator ti = table.begin (); ti != table.end (); ++ti) - ti->second.set_curr_fcn (curr_fcn); - - for (std::vector::iterator iter = nest_children.begin (); - iter != nest_children.end (); ++iter) - (*iter)->do_update_nest (); -} - -DEFUN (ignore_function_time_stamp, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} ignore_function_time_stamp ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} ignore_function_time_stamp (@var{new_val})\n\ -Query or set the internal variable that controls whether Octave checks\n\ -the time stamp on files each time it looks up functions defined in\n\ -function files. If the internal variable is set to @code{\"system\"},\n\ -Octave will not automatically recompile function files in subdirectories of\n\ -@file{@var{octave-home}/lib/@var{version}} if they have changed since\n\ -they were last compiled, but will recompile other function files in the\n\ -search path if they change. If set to @code{\"all\"}, Octave will not\n\ -recompile any function files unless their definitions are removed with\n\ -@code{clear}. If set to \"none\", Octave will always check time stamps\n\ -on files to determine whether functions defined in function files\n\ -need to recompiled.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - { - switch (Vignore_function_time_stamp) - { - case 1: - retval = "system"; - break; - - case 2: - retval = "all"; - break; - - default: - retval = "none"; - break; - } - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - if (sval == "all") - Vignore_function_time_stamp = 2; - else if (sval == "system") - Vignore_function_time_stamp = 1; - else if (sval == "none") - Vignore_function_time_stamp = 0; - else - error ("ignore_function_time_stamp: expecting argument to be \"all\", \"system\", or \"none\""); - } - else - error ("ignore_function_time_stamp: expecting argument to be character string"); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -/* -%!shared old_state -%! old_state = ignore_function_time_stamp (); -%!test -%! state = ignore_function_time_stamp ("all"); -%! assert (state, old_state); -%! assert (ignore_function_time_stamp (), "all"); -%! state = ignore_function_time_stamp ("system"); -%! assert (state, "all"); -%! assert (ignore_function_time_stamp (), "system"); -%! ignore_function_time_stamp (old_state); - -## Test input validation -%!error (ignore_function_time_stamp ("all", "all")) -%!error (ignore_function_time_stamp ("UNKNOWN_VALUE")) -%!error (ignore_function_time_stamp (42)) -*/ - -DEFUN (__current_scope__, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{scope}, @var{context}]} __dump_symtab_info__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = symbol_table::current_context (); - retval(0) = symbol_table::current_scope (); - - return retval; -} - -DEFUN (__dump_symtab_info__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __dump_symtab_info__ ()\n\ -@deftypefnx {Built-in Function} {} __dump_symtab_info__ (@var{scope})\n\ -@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"scopes\")\n\ -@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"functions\")\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - { - symbol_table::dump_functions (octave_stdout); - - symbol_table::dump_global (octave_stdout); - - std::list lst = symbol_table::scopes (); - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - symbol_table::dump (octave_stdout, *p); - } - else if (nargin == 1) - { - octave_value arg = args(0); - - if (arg.is_string ()) - { - std::string s_arg = arg.string_value (); - - if (s_arg == "scopes") - { - std::list lst = symbol_table::scopes (); - - RowVector v (lst.size ()); - - octave_idx_type k = 0; - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - v.xelem (k++) = *p; - - retval = v; - } - else if (s_arg == "functions") - { - symbol_table::dump_functions (octave_stdout); - } - else - error ("__dump_symtab_info__: expecting \"functions\" or \"scopes\""); - } - else - { - int s = arg.int_value (); - - if (! error_state) - symbol_table::dump (octave_stdout, s); - else - error ("__dump_symtab_info__: expecting string or scope id"); - } - } - else - print_usage (); - - return retval; -} - -#if 0 - -// FIXME -- should we have functions like this in Octave? - -DEFUN (set_variable, args, , "set_variable (NAME, VALUE)") -{ - octave_value retval; - - if (args.length () == 2) - { - std::string name = args(0).string_value (); - - if (! error_state) - symbol_table::varref (name) = args(1); - else - error ("set_variable: expecting variable name as first argument"); - } - else - print_usage (); - - return retval; -} - -DEFUN (variable_value, args, , "VALUE = variable_value (NAME)") -{ - octave_value retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - retval = symbol_table::varval (name); - - if (retval.is_undefined ()) - error ("variable_value: `%s' is not a variable in the current scope", - name.c_str ()); - } - else - error ("variable_value: expecting variable name as first argument"); - } - else - print_usage (); - - return retval; -} -#endif - - -/* -bug #34497: 'clear -f' does not work for command line functions - -This test relies on bar being a core function that is implemented in an m-file. -If the first assert fails, this is no longer the case and the tests need to be -updated to use some other function. - -%!assert (! strcmp (which ("bar"), "")); - -%!function x = bar () -%! x = 5; -%!endfunction -%!test -%! assert (bar == 5); -%! assert (strcmp (which ("bar"), "")); -%! clear -f bar; -%! assert (! strcmp (which ("bar"), "")); - -%!function x = bar () -%! x = 5; -%!endfunction -%!test -%! assert (bar == 5); -%! assert (strcmp (which ("bar"), "")); -%! clear bar; -%! assert (! strcmp (which ("bar"), "")); - */ diff -r d02b229ce693 -r a132d206a36a src/symtab.h --- a/src/symtab.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2660 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_symtab_h) -#define octave_symtab_h 1 - -#include -#include -#include -#include -#include - -#include "glob-match.h" -#include "regexp.h" - -class tree_argument_list; -class octave_user_function; - -#include "oct-obj.h" -#include "oct-refcount.h" -#include "ov.h" - -class -OCTINTERP_API -symbol_table -{ -public: - - typedef int scope_id; - typedef size_t context_id; - - class - scope_id_cache - { - protected: - - typedef std::set::iterator set_iterator; - typedef std::set::const_iterator set_const_iterator; - - // We start with 2 because we allocate 0 for the global symbols - // and 1 for the top-level workspace. - - scope_id_cache (void) : next_available (2), in_use (), free_list () { } - - public: - - ~scope_id_cache (void) { } - - static scope_id alloc (void) - { - return instance_ok () ? instance->do_alloc () : -1; - } - - static void free (scope_id scope) - { - if (instance_ok ()) - return instance->do_free (scope); - } - - static std::list scopes (void) - { - return instance_ok () ? instance->do_scopes () : std::list (); - } - - static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create scope_id_cache object!"); - - retval = false; - } - - return retval; - } - - private: - - // No copying! - - scope_id_cache (const scope_id_cache&); - - scope_id_cache& operator = (const scope_id_cache&); - - static scope_id_cache *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - // The next available scope not in the free list. - scope_id next_available; - - // The set of scope IDs that are currently allocated. - std::set in_use; - - // The set of scope IDs that are currently available. - std::set free_list; - - scope_id do_alloc (void) - { - scope_id retval; - - set_iterator p = free_list.begin (); - - if (p != free_list.end ()) - { - retval = *p; - free_list.erase (p); - } - else - retval = next_available++; - - in_use.insert (retval); - - return retval; - } - - void do_free (scope_id scope) - { - set_iterator p = in_use.find (scope); - - if (p != in_use.end ()) - { - in_use.erase (p); - free_list.insert (scope); - } - else - error ("free_scope: scope %d not found!", scope); - } - - std::list do_scopes (void) const - { - std::list retval; - - for (set_const_iterator p = in_use.begin (); p != in_use.end (); p++) - retval.push_back (*p); - - retval.sort (); - - return retval; - } - }; - - class fcn_info; - - class - symbol_record - { - public: - - // generic variable - static const unsigned int local = 1; - - // varargin, argn, .nargin., .nargout. - // (FIXME -- is this really used now?) - static const unsigned int automatic = 2; - - // formal parameter - static const unsigned int formal = 4; - - // not listed or cleared (.nargin., .nargout.) - static const unsigned int hidden = 8; - - // inherited from parent scope; not cleared at function exit - static const unsigned int inherited = 16; - - // global (redirects to global scope) - static const unsigned int global = 32; - - // not cleared at function exit - static const unsigned int persistent = 64; - - // temporary variables forced into symbol table for parsing - static const unsigned int forced = 128; - - private: - - class - symbol_record_rep - { - public: - - symbol_record_rep (scope_id s, const std::string& nm, - const octave_value& v, unsigned int sc) - : decl_scope (s), curr_fcn (0), name (nm), value_stack (), - storage_class (sc), finfo (), valid (true), count (1) - { - value_stack.push_back (v); - } - - void force_variable (context_id context = xdefault_context) - { - if (context == xdefault_context) - context = active_context (); - - octave_value& val = varref (context); - - if (! val.is_defined ()) - mark_forced (); - } - - octave_value& varref (context_id context = xdefault_context) - { - if (is_global ()) - return symbol_table::global_varref (name); - else if (is_persistent ()) - return symbol_table::persistent_varref (name); - else - { - if (context == xdefault_context) - context = active_context (); - - context_id n = value_stack.size (); - while (n++ <= context) - value_stack.push_back (octave_value ()); - - return value_stack[context]; - } - } - - octave_value varval (context_id context = xdefault_context) const - { - if (is_global ()) - return symbol_table::global_varval (name); - else if (is_persistent ()) - return symbol_table::persistent_varval (name); - else - { - if (context == xdefault_context) - context = active_context (); - - if (context < value_stack.size ()) - return value_stack[context]; - else - return octave_value (); - } - } - - void push_context (scope_id s) - { - if (! (is_persistent () || is_global ()) - && s == scope ()) - value_stack.push_back (octave_value ()); - } - - // If pop_context returns 0, we are out of values and this element - // of the symbol table should be deleted. This can happen for - // functions like - // - // function foo (n) - // if (n > 0) - // foo (n-1); - // else - // eval ("x = 1"); - // endif - // endfunction - // - // Here, X should only exist in the final stack frame. - - size_t pop_context (scope_id s) - { - size_t retval = 1; - - if (! (is_persistent () || is_global ()) - && s == scope ()) - { - value_stack.pop_back (); - retval = value_stack.size (); - } - - return retval; - } - - void clear (void) { clear (scope ()); } - - void clear (scope_id s) - { - if (! (is_hidden () || is_inherited ()) - && s == scope ()) - { - if (is_global ()) - unmark_global (); - - if (is_persistent ()) - { - symbol_table::persistent_varref (name) - = varval (); - - unmark_persistent (); - } - - varref () = octave_value (); - } - } - - bool is_defined (context_id context = xdefault_context) const - { - if (context == xdefault_context) - context = active_context (); - - return varval (context).is_defined (); - } - - bool is_valid (void) const - { - return valid; - } - - bool is_variable (context_id context) const - { - if (context == xdefault_context) - context = active_context (); - - return (! is_local () || is_defined (context) || is_forced ()); - } - - bool is_local (void) const { return storage_class & local; } - bool is_automatic (void) const { return storage_class & automatic; } - bool is_formal (void) const { return storage_class & formal; } - bool is_hidden (void) const { return storage_class & hidden; } - bool is_inherited (void) const { return storage_class & inherited; } - bool is_global (void) const { return storage_class & global; } - bool is_persistent (void) const { return storage_class & persistent; } - bool is_forced (void) const { return storage_class & forced; } - - void mark_local (void) { storage_class |= local; } - void mark_automatic (void) { storage_class |= automatic; } - void mark_formal (void) { storage_class |= formal; } - void mark_hidden (void) { storage_class |= hidden; } - void mark_inherited (void) { storage_class |= inherited; } - void mark_global (void) - { - if (is_persistent ()) - error ("can't make persistent variable %s global", name.c_str ()); - else - storage_class |= global; - } - void mark_persistent (void) - { - if (is_global ()) - error ("can't make global variable %s persistent", name.c_str ()); - else - storage_class |= persistent; - } - void mark_forced (void) { storage_class |= forced; } - - void unmark_local (void) { storage_class &= ~local; } - void unmark_automatic (void) { storage_class &= ~automatic; } - void unmark_formal (void) { storage_class &= ~formal; } - void unmark_hidden (void) { storage_class &= ~hidden; } - void unmark_inherited (void) { storage_class &= ~inherited; } - void unmark_global (void) { storage_class &= ~global; } - void unmark_persistent (void) { storage_class &= ~persistent; } - void unmark_forced (void) { storage_class &= ~forced; } - - void init_persistent (void) - { - if (! is_defined ()) - { - mark_persistent (); - - varref () = symbol_table::persistent_varval (name); - } - // FIXME -- this causes trouble with recursive calls. - // else - // error ("unable to declare existing variable persistent"); - } - - void invalidate (void) - { - valid = false; - } - - void erase_persistent (void) - { - unmark_persistent (); - symbol_table::erase_persistent (name); - } - - context_id active_context (void) const; - - scope_id scope (void) const { return decl_scope; } - - void set_curr_fcn (octave_user_function *fcn) - { - curr_fcn = fcn; - } - - symbol_record_rep *dup (scope_id new_scope) const - { - return new symbol_record_rep (new_scope, name, varval (), - storage_class); - } - - void dump (std::ostream& os, const std::string& prefix) const; - - scope_id decl_scope; - - octave_user_function* curr_fcn; - - std::string name; - - std::deque value_stack; - - unsigned int storage_class; - - fcn_info *finfo; - - bool valid; - - octave_refcount count; - - private: - - // No copying! - - symbol_record_rep (const symbol_record_rep& ov); - - symbol_record_rep& operator = (const symbol_record_rep&); - }; - - public: - - symbol_record (scope_id s = xcurrent_scope, - const std::string& nm = std::string (), - const octave_value& v = octave_value (), - unsigned int sc = local) - : rep (new symbol_record_rep (s, nm, v, sc)) { } - - symbol_record (const symbol_record& sr) - : rep (sr.rep) - { - rep->count++; - } - - symbol_record& operator = (const symbol_record& sr) - { - if (this != &sr) - { - if (--rep->count == 0) - delete rep; - - rep = sr.rep; - rep->count++; - } - - return *this; - } - - ~symbol_record (void) - { - if (--rep->count == 0) - delete rep; - } - - symbol_record dup (scope_id new_scope) const - { - return symbol_record (rep->dup (new_scope)); - } - - const std::string& name (void) const { return rep->name; } - - octave_value - find (const octave_value_list& args = octave_value_list ()) const; - - void force_variable (context_id context = xdefault_context) - { - rep->force_variable (context); - } - - octave_value& varref (context_id context = xdefault_context) - { - return rep->varref (context); - } - - octave_value varval (context_id context = xdefault_context) const - { - return rep->varval (context); - } - - void push_context (scope_id s) { rep->push_context (s); } - - size_t pop_context (scope_id s) { return rep->pop_context (s); } - - void clear (void) { rep->clear (); } - - void clear (scope_id s) { rep->clear (s); } - - bool is_defined (context_id context = xdefault_context) const - { - return rep->is_defined (context); - } - - bool is_valid (void) const - { - return rep->is_valid (); - } - - bool is_variable (context_id context = xdefault_context) const - { - return rep->is_variable (context); - } - - bool is_local (void) const { return rep->is_local (); } - bool is_automatic (void) const { return rep->is_automatic (); } - bool is_formal (void) const { return rep->is_formal (); } - bool is_global (void) const { return rep->is_global (); } - bool is_hidden (void) const { return rep->is_hidden (); } - bool is_inherited (void) const { return rep->is_inherited (); } - bool is_persistent (void) const { return rep->is_persistent (); } - bool is_forced (void) const { return rep->is_forced (); } - - void mark_local (void) { rep->mark_local (); } - void mark_automatic (void) { rep->mark_automatic (); } - void mark_formal (void) { rep->mark_formal (); } - void mark_hidden (void) { rep->mark_hidden (); } - void mark_inherited (void) { rep->mark_inherited (); } - void mark_global (void) { rep->mark_global (); } - void mark_persistent (void) { rep->mark_persistent (); } - void mark_forced (void) { rep->mark_forced (); } - - void unmark_local (void) { rep->unmark_local (); } - void unmark_automatic (void) { rep->unmark_automatic (); } - void unmark_formal (void) { rep->unmark_formal (); } - void unmark_hidden (void) { rep->unmark_hidden (); } - void unmark_inherited (void) { rep->unmark_inherited (); } - void unmark_global (void) { rep->unmark_global (); } - void unmark_persistent (void) { rep->unmark_persistent (); } - void unmark_forced (void) { rep->unmark_forced (); } - - void init_persistent (void) { rep->init_persistent (); } - - void erase_persistent (void) { rep->erase_persistent (); } - - void invalidate (void) { rep->invalidate (); } - - context_id active_context (void) const { return rep->active_context (); } - - scope_id scope (void) const { return rep->scope (); } - - unsigned int xstorage_class (void) const { return rep->storage_class; } - - void set_curr_fcn (octave_user_function *fcn) { rep->set_curr_fcn (fcn); } - - void - dump (std::ostream& os, const std::string& prefix = std::string ()) const - { - rep->dump (os, prefix); - } - - private: - - symbol_record_rep *rep; - - symbol_record (symbol_record_rep *new_rep) : rep (new_rep) { } - }; - - // Always access a symbol from the current scope. - // Useful for scripts, as they may be executed in more than one scope. - class - symbol_reference - { - public: - symbol_reference (void) : scope (-1) {} - - symbol_reference (symbol_record record, - scope_id curr_scope = symbol_table::current_scope ()) - : scope (curr_scope), sym (record) - {} - - symbol_reference& operator = (const symbol_reference& ref) - { - scope = ref.scope; - sym = ref.sym; - return *this; - } - - // The name is the same regardless of scope. - const std::string& name (void) const { return sym.name (); } - - symbol_record *operator-> (void) - { - update (); - return &sym; - } - - symbol_record *operator-> (void) const - { - update (); - return &sym; - } - - // can be used to place symbol_reference in maps, we don't overload < as - // it doesn't make any sense for symbol_reference - struct comparator - { - bool operator ()(const symbol_reference& lhs, - const symbol_reference& rhs) const - { - return lhs.name () < rhs.name (); - } - }; - private: - void update (void) const - { - scope_id curr_scope = symbol_table::current_scope (); - if (scope != curr_scope || ! sym.is_valid ()) - { - scope = curr_scope; - sym = symbol_table::insert (sym.name ()); - } - } - - mutable scope_id scope; - mutable symbol_record sym; - }; - - class - fcn_info - { - public: - - typedef std::map dispatch_map_type; - - typedef std::map::const_iterator scope_val_const_iterator; - typedef std::map::iterator scope_val_iterator; - - typedef std::map::const_iterator str_val_const_iterator; - typedef std::map::iterator str_val_iterator; - - typedef dispatch_map_type::const_iterator dispatch_map_const_iterator; - typedef dispatch_map_type::iterator dispatch_map_iterator; - - private: - - class - fcn_info_rep - { - public: - - fcn_info_rep (const std::string& nm) - : name (nm), subfunctions (), private_functions (), - class_constructors (), class_methods (), dispatch_map (), - cmdline_function (), autoload_function (), function_on_path (), - built_in_function (), count (1) { } - - octave_value load_private_function (const std::string& dir_name); - - octave_value load_class_constructor (void); - - octave_value load_class_method (const std::string& dispatch_type); - - octave_value find (const octave_value_list& args, bool local_funcs); - - octave_value builtin_find (void); - - octave_value find_method (const std::string& dispatch_type); - - octave_value find_autoload (void); - - octave_value find_user_function (void); - - bool is_user_function_defined (void) const - { - return function_on_path.is_defined (); - } - - octave_value find_function (const octave_value_list& args, bool local_funcs) - { - return find (args, local_funcs); - } - - void lock_subfunction (scope_id scope) - { - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - p->second.lock (); - } - - void unlock_subfunction (scope_id scope) - { - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - p->second.unlock (); - } - - std::pair - subfunction_defined_in_scope (scope_id scope) const - { - scope_val_const_iterator p = subfunctions.find (scope); - - return p == subfunctions.end () - ? std::pair () - : std::pair (name, p->second); - } - - void erase_subfunction (scope_id scope) - { - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - subfunctions.erase (p); - } - - void mark_subfunction_in_scope_as_private (scope_id scope, - const std::string& class_name); - - void install_cmdline_function (const octave_value& f) - { - cmdline_function = f; - } - - void install_subfunction (const octave_value& f, scope_id scope) - { - subfunctions[scope] = f; - } - - void install_user_function (const octave_value& f) - { - function_on_path = f; - } - - void install_built_in_function (const octave_value& f) - { - built_in_function = f; - } - - template - void - clear_unlocked (std::map& map) - { - typename std::map::iterator p = map.begin (); - - while (p != map.end ()) - { - if (p->second.islocked ()) - p++; - else - map.erase (p++); - } - } - - void clear_autoload_function (void) - { - if (! autoload_function.islocked ()) - autoload_function = octave_value (); - } - - // We also clear command line functions here, as these are both - // "user defined" - void clear_user_function (void) - { - if (! function_on_path.islocked ()) - { - function_on_path.erase_subfunctions (); - - function_on_path = octave_value (); - } - - if (! cmdline_function.islocked ()) - cmdline_function = octave_value (); - } - - void clear_mex_function (void) - { - if (function_on_path.is_mex_function ()) - clear_user_function (); - } - - void clear (void) - { - clear_unlocked (subfunctions); - clear_unlocked (private_functions); - clear_unlocked (class_constructors); - clear_unlocked (class_methods); - clear_autoload_function (); - clear_user_function (); - } - - void add_dispatch (const std::string& type, const std::string& fname) - { - dispatch_map[type] = fname; - } - - void clear_dispatch (const std::string& type) - { - dispatch_map_iterator p = dispatch_map.find (type); - - if (p != dispatch_map.end ()) - dispatch_map.erase (p); - } - - void print_dispatch (std::ostream& os) const; - - std::string help_for_dispatch (void) const; - - dispatch_map_type get_dispatch (void) const { return dispatch_map; } - - void dump (std::ostream& os, const std::string& prefix) const; - - std::string name; - - // Scope id to function object. - std::map subfunctions; - - // Directory name to function object. - std::map private_functions; - - // Class name to function object. - std::map class_constructors; - - // Dispatch type to function object. - std::map class_methods; - - // Legacy dispatch map (dispatch type name to function name). - dispatch_map_type dispatch_map; - - octave_value cmdline_function; - - octave_value autoload_function; - - octave_value function_on_path; - - octave_value built_in_function; - - octave_refcount count; - - private: - - octave_value xfind (const octave_value_list& args, bool local_funcs); - - octave_value x_builtin_find (void); - - // No copying! - - fcn_info_rep (const fcn_info_rep&); - - fcn_info_rep& operator = (const fcn_info_rep&); - }; - - public: - - fcn_info (const std::string& nm = std::string ()) - : rep (new fcn_info_rep (nm)) { } - - fcn_info (const fcn_info& fi) : rep (fi.rep) - { - rep->count++; - } - - fcn_info& operator = (const fcn_info& fi) - { - if (this != &fi) - { - if (--rep->count == 0) - delete rep; - - rep = fi.rep; - rep->count++; - } - - return *this; - } - - ~fcn_info (void) - { - if (--rep->count == 0) - delete rep; - } - - octave_value find (const octave_value_list& args = octave_value_list (), - bool local_funcs = true) - { - return rep->find (args, local_funcs); - } - - octave_value builtin_find (void) - { - return rep->builtin_find (); - } - - octave_value find_method (const std::string& dispatch_type) const - { - return rep->find_method (dispatch_type); - } - - octave_value find_built_in_function (void) const - { - return rep->built_in_function; - } - - octave_value find_cmdline_function (void) const - { - return rep->cmdline_function; - } - - octave_value find_autoload (void) - { - return rep->find_autoload (); - } - - octave_value find_user_function (void) - { - return rep->find_user_function (); - } - - bool is_user_function_defined (void) const - { - return rep->is_user_function_defined (); - } - - octave_value find_function (const octave_value_list& args = octave_value_list (), - bool local_funcs = true) - { - return rep->find_function (args, local_funcs); - } - - void lock_subfunction (scope_id scope) - { - rep->lock_subfunction (scope); - } - - void unlock_subfunction (scope_id scope) - { - rep->unlock_subfunction (scope); - } - - std::pair - subfunction_defined_in_scope (scope_id scope = xcurrent_scope) const - { - return rep->subfunction_defined_in_scope (scope); - } - - void erase_subfunction (scope_id scope) - { - rep->erase_subfunction (scope); - } - - void mark_subfunction_in_scope_as_private (scope_id scope, - const std::string& class_name) - { - rep->mark_subfunction_in_scope_as_private (scope, class_name); - } - - void install_cmdline_function (const octave_value& f) - { - rep->install_cmdline_function (f); - } - - void install_subfunction (const octave_value& f, scope_id scope) - { - rep->install_subfunction (f, scope); - } - - void install_user_function (const octave_value& f) - { - rep->install_user_function (f); - } - - void install_built_in_function (const octave_value& f) - { - rep->install_built_in_function (f); - } - - void clear (void) { rep->clear (); } - - void clear_user_function (void) { rep->clear_user_function (); } - - void clear_autoload_function (void) { rep->clear_autoload_function (); } - - void clear_mex_function (void) { rep->clear_mex_function (); } - - void add_dispatch (const std::string& type, const std::string& fname) - { - rep->add_dispatch (type, fname); - } - - void clear_dispatch (const std::string& type) - { - rep->clear_dispatch (type); - } - - void print_dispatch (std::ostream& os) const - { - rep->print_dispatch (os); - } - - std::string help_for_dispatch (void) const { return rep->help_for_dispatch (); } - - dispatch_map_type get_dispatch (void) const - { - return rep->get_dispatch (); - } - - void - dump (std::ostream& os, const std::string& prefix = std::string ()) const - { - rep->dump (os, prefix); - } - - private: - - fcn_info_rep *rep; - }; - - static scope_id global_scope (void) { return xglobal_scope; } - static scope_id top_scope (void) { return xtop_scope; } - - static scope_id current_scope (void) { return xcurrent_scope; } - - static context_id current_context (void) { return xcurrent_context; } - - static scope_id alloc_scope (void) { return scope_id_cache::alloc (); } - - static void set_scope (scope_id scope) - { - if (scope == xglobal_scope) - error ("can't set scope to global"); - else if (scope != xcurrent_scope) - { - all_instances_iterator p = all_instances.find (scope); - - if (p == all_instances.end ()) - { - symbol_table *inst = new symbol_table (scope); - - if (inst) - all_instances[scope] = instance = inst; - } - else - instance = p->second; - - xcurrent_scope = scope; - xcurrent_context = 0; - } - } - - static void set_scope_and_context (scope_id scope, context_id context) - { - if (scope == xglobal_scope) - error ("can't set scope to global"); - else - { - if (scope != xcurrent_scope) - { - all_instances_iterator p = all_instances.find (scope); - - if (p == all_instances.end ()) - error ("scope not found!"); - else - { - instance = p->second; - - xcurrent_scope = scope; - - xcurrent_context = context; - } - } - else - xcurrent_context = context; - } - } - - static void erase_scope (scope_id scope) - { - assert (scope != xglobal_scope); - - all_instances_iterator p = all_instances.find (scope); - - if (p != all_instances.end ()) - { - delete p->second; - - all_instances.erase (p); - - free_scope (scope); - } - } - - static void erase_subfunctions_in_scope (scope_id scope) - { - for (fcn_table_iterator q = fcn_table.begin (); - q != fcn_table.end (); q++) - q->second.erase_subfunction (scope); - } - - static void - mark_subfunctions_in_scope_as_private (scope_id scope, - const std::string& class_name) - { - for (fcn_table_iterator q = fcn_table.begin (); - q != fcn_table.end (); q++) - q->second.mark_subfunction_in_scope_as_private (scope, class_name); - } - - static scope_id dup_scope (scope_id scope) - { - scope_id retval = -1; - - symbol_table *inst = get_instance (scope); - - if (inst) - { - scope_id new_scope = alloc_scope (); - - symbol_table *new_symbol_table = new symbol_table (scope); - - if (new_symbol_table) - { - all_instances[new_scope] = new_symbol_table; - - inst->do_dup_scope (*new_symbol_table); - - retval = new_scope; - } - } - - return retval; - } - - static std::list scopes (void) - { - return scope_id_cache::scopes (); - } - - static symbol_record - find_symbol (const std::string& name, scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - - return inst ? inst->do_find_symbol (name) : - symbol_record (scope); - } - - static void - inherit (scope_id scope, scope_id donor_scope, context_id donor_context) - { - symbol_table *inst = get_instance (scope); - - if (inst) - { - symbol_table *donor_symbol_table = get_instance (donor_scope); - - if (donor_symbol_table) - inst->do_inherit (*donor_symbol_table, donor_context); - } - } - - static bool at_top_level (void) { return xcurrent_scope == xtop_scope; } - - // Find a value corresponding to the given name in the table. - static octave_value - find (const std::string& name, - const octave_value_list& args = octave_value_list (), - bool skip_variables = false, - bool local_funcs = true); - - static octave_value builtin_find (const std::string& name); - - // Insert a new name in the table. - static symbol_record& insert (const std::string& name) - { - static symbol_record foobar; - - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_insert (name) : foobar; - } - - static void force_variable (const std::string& name, - scope_id scope = xcurrent_scope, - context_id context = xdefault_context) - { - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_force_variable (name, context); - } - - static octave_value& varref (const std::string& name, - scope_id scope = xcurrent_scope, - context_id context = xdefault_context) - { - static octave_value foobar; - - symbol_table *inst = get_instance (scope); - - return inst ? inst->do_varref (name, context) : foobar; - } - - static octave_value varval (const std::string& name, - scope_id scope = xcurrent_scope, - context_id context = xdefault_context) - { - symbol_table *inst = get_instance (scope); - - return inst ? inst->do_varval (name, context) : octave_value (); - } - - static octave_value& - global_varref (const std::string& name) - { - global_table_iterator p = global_table.find (name); - - return (p == global_table.end ()) ? global_table[name] : p->second; - } - - static octave_value - global_varval (const std::string& name) - { - global_table_const_iterator p = global_table.find (name); - - return (p != global_table.end ()) ? p->second : octave_value (); - } - - static octave_value& - top_level_varref (const std::string& name) - { - return varref (name, top_scope (), 0); - } - - static octave_value - top_level_varval (const std::string& name) - { - return varval (name, top_scope (), 0); - } - - static octave_value& persistent_varref (const std::string& name) - { - static octave_value foobar; - - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_persistent_varref (name) : foobar; - } - - static octave_value persistent_varval (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_persistent_varval (name) : octave_value (); - } - - static void erase_persistent (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_erase_persistent (name); - } - - static bool is_variable (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_is_variable (name) : false; - } - - static bool - is_built_in_function_name (const std::string& name) - { - octave_value val = find_built_in_function (name); - - return val.is_defined (); - } - - static octave_value - find_method (const std::string& name, const std::string& dispatch_type) - { - fcn_table_const_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - return p->second.find_method (dispatch_type); - else - { - fcn_info finfo (name); - - octave_value fcn = finfo.find_method (dispatch_type); - - if (fcn.is_defined ()) - fcn_table[name] = finfo; - - return fcn; - } - } - - static octave_value - find_built_in_function (const std::string& name) - { - fcn_table_const_iterator p = fcn_table.find (name); - - return (p != fcn_table.end ()) - ? p->second.find_built_in_function () : octave_value (); - } - - static octave_value - find_autoload (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - return (p != fcn_table.end ()) - ? p->second.find_autoload () : octave_value (); - } - - static octave_value - find_function (const std::string& name, - const octave_value_list& args = octave_value_list (), - bool local_funcs = true); - - static octave_value find_user_function (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - return (p != fcn_table.end ()) - ? p->second.find_user_function () : octave_value (); - } - - static void install_cmdline_function (const std::string& name, - const octave_value& fcn) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_cmdline_function (fcn); - } - else - { - fcn_info finfo (name); - - finfo.install_cmdline_function (fcn); - - fcn_table[name] = finfo; - } - } - - static void install_subfunction (const std::string& name, - const octave_value& fcn, - scope_id scope) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_subfunction (fcn, scope); - } - else - { - fcn_info finfo (name); - - finfo.install_subfunction (fcn, scope); - - fcn_table[name] = finfo; - } - } - - static void install_nestfunction (const std::string& name, - const octave_value& fcn, - scope_id parent_scope); - - static void update_nest (scope_id scope) - { - symbol_table *inst = get_instance (scope); - if (inst) - inst->do_update_nest (); - } - - static void install_user_function (const std::string& name, - const octave_value& fcn) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_user_function (fcn); - } - else - { - fcn_info finfo (name); - - finfo.install_user_function (fcn); - - fcn_table[name] = finfo; - } - } - - static void install_built_in_function (const std::string& name, - const octave_value& fcn) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_built_in_function (fcn); - } - else - { - fcn_info finfo (name); - - finfo.install_built_in_function (fcn); - - fcn_table[name] = finfo; - } - } - - static void clear (const std::string& name) - { - clear_variable (name); - } - - static void clear_all (void) - { - clear_variables (); - - clear_global_pattern ("*"); - - clear_functions (); - } - - static void clear_variables (scope_id scope) - { - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_clear_variables (); - } - - // This is split for unwind_protect. - static void clear_variables (void) - { - clear_variables (xcurrent_scope); - } - - static void clear_objects (scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_clear_objects (); - } - - static void unmark_forced_variables (scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_unmark_forced_variables (); - } - - static void clear_functions (void) - { - for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) - p->second.clear (); - } - - static void clear_function (const std::string& name) - { - clear_user_function (name); - } - - static void clear_global (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_global (name); - } - - static void clear_variable (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_variable (name); - } - - static void clear_symbol (const std::string& name) - { - // FIXME -- are we supposed to do both here? - - clear_variable (name); - clear_function (name); - } - - static void clear_function_pattern (const std::string& pat) - { - glob_match pattern (pat); - - for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) - { - if (pattern.match (p->first)) - p->second.clear_user_function (); - } - } - - static void clear_global_pattern (const std::string& pat) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_global_pattern (pat); - } - - static void clear_variable_pattern (const std::string& pat) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_variable_pattern (pat); - } - - static void clear_variable_regexp (const std::string& pat) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_variable_regexp (pat); - } - - static void clear_symbol_pattern (const std::string& pat) - { - // FIXME -- are we supposed to do both here? - - clear_variable_pattern (pat); - clear_function_pattern (pat); - } - - static void clear_user_function (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.clear_user_function (); - } - // FIXME -- is this necessary, or even useful? - // else - // error ("clear: no such function `%s'", name.c_str ()); - } - - // This clears oct and mex files, incl. autoloads. - static void clear_dld_function (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.clear_autoload_function (); - finfo.clear_user_function (); - } - } - - static void clear_mex_functions (void) - { - for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) - { - fcn_info& finfo = p->second; - - finfo.clear_mex_function (); - } - } - - static bool set_class_relationship (const std::string& sup_class, - const std::string& inf_class); - - static bool is_superiorto (const std::string& a, const std::string& b); - - static void alias_built_in_function (const std::string& alias, - const std::string& name) - { - octave_value fcn = find_built_in_function (name); - - if (fcn.is_defined ()) - { - fcn_info finfo (alias); - - finfo.install_built_in_function (fcn); - - fcn_table[alias] = finfo; - } - else - panic ("alias: `%s' is undefined", name.c_str ()); - } - - static void add_dispatch (const std::string& name, const std::string& type, - const std::string& fname) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.add_dispatch (type, fname); - } - else - { - fcn_info finfo (name); - - finfo.add_dispatch (type, fname); - - fcn_table[name] = finfo; - } - } - - static void clear_dispatch (const std::string& name, const std::string& type) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.clear_dispatch (type); - } - } - - static void print_dispatch (std::ostream& os, const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.print_dispatch (os); - } - } - - static fcn_info::dispatch_map_type get_dispatch (const std::string& name) - { - fcn_info::dispatch_map_type retval; - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - retval = finfo.get_dispatch (); - } - - return retval; - } - - static std::string help_for_dispatch (const std::string& name) - { - std::string retval; - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - retval = finfo.help_for_dispatch (); - } - - return retval; - } - - static void push_context (void) - { - if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) - error ("invalid call to xymtab::push_context"); - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_push_context (); - } - } - - static void pop_context (void) - { - if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) - error ("invalid call to xymtab::pop_context"); - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_pop_context (); - } - } - - // For unwind_protect. - static void pop_context (void *) { pop_context (); } - - static void mark_automatic (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_mark_automatic (name); - } - - static void mark_hidden (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_mark_hidden (name); - } - - static void mark_global (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_mark_global (name); - } - - static std::list - all_variables (scope_id scope = xcurrent_scope, - context_id context = xdefault_context, - bool defined_only = true) - { - symbol_table *inst = get_instance (scope); - - return inst - ? inst->do_all_variables (context, defined_only) : std::list (); - } - - static std::list glob (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_glob (pattern) : std::list (); - } - - static std::list regexp (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_regexp (pattern) : std::list (); - } - - static std::list glob_variables (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_glob (pattern, true) : std::list (); - } - - static std::list regexp_variables (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_regexp (pattern, true) : std::list (); - } - - static std::list - glob_global_variables (const std::string& pattern) - { - std::list retval; - - glob_match pat (pattern); - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - { - // We generate a list of symbol_record objects so that - // the results from glob_variables and glob_global_variables - // may be handled the same way. - - if (pat.match (p->first)) - retval.push_back (symbol_record (xglobal_scope, - p->first, p->second, - symbol_record::global)); - } - - return retval; - } - - static std::list - regexp_global_variables (const std::string& pattern) - { - std::list retval; - - ::regexp pat (pattern); - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - { - // We generate a list of symbol_record objects so that - // the results from regexp_variables and regexp_global_variables - // may be handled the same way. - - if (pat.is_match (p->first)) - retval.push_back (symbol_record (xglobal_scope, - p->first, p->second, - symbol_record::global)); - } - - return retval; - } - - static std::list glob_variables (const string_vector& patterns) - { - std::list retval; - - size_t len = patterns.length (); - - for (size_t i = 0; i < len; i++) - { - std::list tmp = glob_variables (patterns[i]); - - retval.insert (retval.begin (), tmp.begin (), tmp.end ()); - } - - return retval; - } - - static std::list regexp_variables - (const string_vector& patterns) - { - std::list retval; - - size_t len = patterns.length (); - - for (size_t i = 0; i < len; i++) - { - std::list tmp = regexp_variables (patterns[i]); - - retval.insert (retval.begin (), tmp.begin (), tmp.end ()); - } - - return retval; - } - - static std::list user_function_names (void) - { - std::list retval; - - for (fcn_table_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - if (p->second.is_user_function_defined ()) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; - } - - static std::list global_variable_names (void) - { - std::list retval; - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - retval.push_back (p->first); - - retval.sort (); - - return retval; - } - - static std::list top_level_variable_names (void) - { - symbol_table *inst = get_instance (xtop_scope); - - return inst ? inst->do_variable_names () : std::list (); - } - - static std::list variable_names (void) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_variable_names () : std::list (); - } - - static std::list built_in_function_names (void) - { - std::list retval; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - octave_value fcn = p->second.find_built_in_function (); - - if (fcn.is_defined ()) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; - } - - static std::list cmdline_function_names (void) - { - std::list retval; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - octave_value fcn = p->second.find_cmdline_function (); - - if (fcn.is_defined ()) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; - } - - static bool is_local_variable (const std::string& name) - { - if (xcurrent_scope == xglobal_scope) - return false; - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_is_local_variable (name) : false; - } - } - - static bool is_global (const std::string& name) - { - if (xcurrent_scope == xglobal_scope) - return true; - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_is_global (name) : false; - } - } - - static void dump (std::ostream& os, scope_id scope = xcurrent_scope); - - static void dump_global (std::ostream& os); - - static void dump_functions (std::ostream& os); - - static void cache_name (scope_id scope, const std::string& name) - { - symbol_table *inst = get_instance (scope, false); - - if (inst) - inst->do_cache_name (name); - } - - static void lock_subfunctions (scope_id scope = xcurrent_scope) - { - for (fcn_table_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - p->second.lock_subfunction (scope); - } - - static void unlock_subfunctions (scope_id scope = xcurrent_scope) - { - for (fcn_table_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - p->second.unlock_subfunction (scope); - } - - static void free_scope (scope_id scope) - { - if (scope == xglobal_scope || scope == xtop_scope) - error ("can't free global or top-level scopes!"); - else - symbol_table::scope_id_cache::free (scope); - } - - static void stash_dir_name_for_subfunctions (scope_id scope, - const std::string& dir_name); - - static void add_to_parent_map (const std::string& classname, - const std::list& parent_list) - { - parent_map[classname] = parent_list; - } - - static std::list - parent_classes (const std::string& dispatch_type) - { - std::list retval; - - const_parent_map_iterator it = parent_map.find (dispatch_type); - - if (it != parent_map.end ()) - retval = it->second; - - for (std::list::const_iterator lit = retval.begin (); - lit != retval.end (); lit++) - { - // Search for parents of parents and append them to the list. - - // FIXME -- should we worry about a circular inheritance graph? - - std::list parents = parent_classes (*lit); - - if (! parents.empty ()) - retval.insert (retval.end (), parents.begin (), parents.end ()); - } - - return retval; - } - - static octave_user_function *get_curr_fcn (scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - return inst->curr_fcn; - } - - static void set_curr_fcn (octave_user_function *curr_fcn, - scope_id scope = xcurrent_scope) - { - assert (scope != xtop_scope && scope != xglobal_scope); - symbol_table *inst = get_instance (scope); - // FIXME: normally, functions should not usurp each other's scope. - // If for any incredible reason this is needed, call - // set_user_function (0, scope) first. This may cause problems with - // nested functions, as the curr_fcn of symbol_records must be updated. - assert (inst->curr_fcn == 0 || curr_fcn == 0); - inst->curr_fcn = curr_fcn; - } - - static void cleanup (void); - -private: - - // No copying! - - symbol_table (const symbol_table&); - - symbol_table& operator = (const symbol_table&); - - typedef std::map::const_iterator table_const_iterator; - typedef std::map::iterator table_iterator; - - typedef std::map::const_iterator global_table_const_iterator; - typedef std::map::iterator global_table_iterator; - - typedef std::map::const_iterator persistent_table_const_iterator; - typedef std::map::iterator persistent_table_iterator; - - typedef std::map::const_iterator all_instances_const_iterator; - typedef std::map::iterator all_instances_iterator; - - typedef std::map::const_iterator fcn_table_const_iterator; - typedef std::map::iterator fcn_table_iterator; - - // The scope of this symbol table. - scope_id my_scope; - - // Name for this table (usually the file name of the function - // corresponding to the scope); - std::string table_name; - - // Map from symbol names to symbol info. - std::map table; - - // Child nested functions. - std::vector nest_children; - - // Parent nested function (may be null). - symbol_table *nest_parent; - - // The associated user code (may be null). - octave_user_function *curr_fcn; - - // Map from names of global variables to values. - static std::map global_table; - - // Map from names of persistent variables to values. - std::map persistent_table; - - // Pointer to symbol table for current scope (variables only). - static symbol_table *instance; - - // Map from scope id to symbol table instances. - static std::map all_instances; - - // Map from function names to function info (subfunctions, private - // functions, class constructors, class methods, etc.) - static std::map fcn_table; - - // Mape from class names to set of classes that have lower - // precedence. - static std::map > class_precedence_table; - - typedef std::map >::const_iterator class_precedence_table_const_iterator; - typedef std::map >::iterator class_precedence_table_iterator; - - // Map from class names to parent class names. - static std::map > parent_map; - - typedef std::map >::const_iterator const_parent_map_iterator; - typedef std::map >::iterator parent_map_iterator; - - static const scope_id xglobal_scope; - static const scope_id xtop_scope; - - static scope_id xcurrent_scope; - - static context_id xcurrent_context; - - static const context_id xdefault_context = static_cast (-1); - - symbol_table (scope_id scope) - : my_scope (scope), table_name (), table (), nest_children (), nest_parent (0), - curr_fcn (0), persistent_table () { } - - ~symbol_table (void) { } - - static symbol_table *get_instance (scope_id scope, bool create = true) - { - symbol_table *retval = 0; - - bool ok = true; - - if (scope != xglobal_scope) - { - if (scope == xcurrent_scope) - { - if (! instance && create) - { - symbol_table *inst = new symbol_table (scope); - - if (inst) - { - all_instances[scope] = instance = inst; - - if (scope == xtop_scope) - instance->do_cache_name ("top-level"); - } - } - - if (! instance) - ok = false; - - retval = instance; - } - else - { - all_instances_iterator p = all_instances.find (scope); - - if (p == all_instances.end ()) - { - if (create) - { - retval = new symbol_table (scope); - - if (retval) - all_instances[scope] = retval; - else - ok = false; - } - else - ok = false; - } - else - retval = p->second; - } - } - - if (! ok) - error ("unable to %s symbol_table object for scope %d!", - create ? "create" : "find", scope); - - return retval; - } - - void add_nest_child (symbol_table& st) - { - assert (!st.nest_parent); - nest_children.push_back (&st); - st.nest_parent = this; - } - - void insert_symbol_record (const symbol_record& sr) - { - table[sr.name ()] = sr; - } - - void - do_dup_scope (symbol_table& new_symbol_table) const - { - for (table_const_iterator p = table.begin (); p != table.end (); p++) - new_symbol_table.insert_symbol_record (p->second.dup (new_symbol_table.my_scope)); - } - - symbol_record do_find_symbol (const std::string& name) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - return do_insert (name); - else - return p->second; - } - - void do_inherit (symbol_table& donor_table, context_id donor_context) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (! (sr.is_automatic () || sr.is_formal ())) - { - std::string nm = sr.name (); - - if (nm != "__retval__") - { - octave_value val = donor_table.do_varval (nm, donor_context); - - if (val.is_defined ()) - { - sr.varref (0) = val; - - sr.mark_inherited (); - } - } - } - } - } - - static fcn_info *get_fcn_info (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - return p != fcn_table.end () ? &p->second : 0; - } - - octave_value - do_find (const std::string& name, const octave_value_list& args, - bool skip_variables, bool local_funcs); - - octave_value do_builtin_find (const std::string& name); - - symbol_record& do_insert (const std::string& name) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - { - symbol_record parent_symbol; - - if (nest_parent && nest_parent->look_nonlocal (name, parent_symbol)) - return table[name] = parent_symbol; - else - return table[name] = symbol_record (my_scope, name, octave_value ()); - } - else - return p->second; - } - - void do_force_variable (const std::string& name, context_id context) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - { - symbol_record& sr = do_insert (name); - - sr.force_variable (context); - } - else - p->second.force_variable (context); - } - - octave_value& do_varref (const std::string& name, context_id context) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - { - symbol_record& sr = do_insert (name); - - return sr.varref (context); - } - else - return p->second.varref (context); - } - - octave_value do_varval (const std::string& name, context_id context) const - { - table_const_iterator p = table.find (name); - - return (p != table.end ()) ? p->second.varval (context) : octave_value (); - } - - octave_value& do_persistent_varref (const std::string& name) - { - persistent_table_iterator p = persistent_table.find (name); - - return (p == persistent_table.end ()) - ? persistent_table[name] : p->second; - } - - octave_value do_persistent_varval (const std::string& name) - { - persistent_table_const_iterator p = persistent_table.find (name); - - return (p != persistent_table.end ()) ? p->second : octave_value (); - } - - void do_erase_persistent (const std::string& name) - { - persistent_table_iterator p = persistent_table.find (name); - - if (p != persistent_table.end ()) - persistent_table.erase (p); - } - - bool do_is_variable (const std::string& name) const - { - bool retval = false; - - table_const_iterator p = table.find (name); - - if (p != table.end ()) - { - const symbol_record& sr = p->second; - - retval = sr.is_variable (); - } - - return retval; - } - - void do_push_context (void) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - p->second.push_context (my_scope); - } - - void do_pop_context (void) - { - for (table_iterator p = table.begin (); p != table.end (); ) - { - if (p->second.pop_context (my_scope) == 0) - table.erase (p++); - else - p++; - } - } - - void do_clear_variables (void) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - p->second.clear (my_scope); - } - - void do_clear_objects (void) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - octave_value& val = sr.varref (); - if (val.is_object ()) - p->second.clear (my_scope); - } - } - - void do_unmark_forced_variables (void) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - p->second.unmark_forced (); - } - - void do_clear_global (const std::string& name) - { - table_iterator p = table.find (name); - - if (p != table.end ()) - { - symbol_record& sr = p->second; - - if (sr.is_global ()) - sr.unmark_global (); - } - - global_table_iterator q = global_table.find (name); - - if (q != global_table.end ()) - global_table.erase (q); - - } - - void do_clear_variable (const std::string& name) - { - table_iterator p = table.find (name); - - if (p != table.end ()) - p->second.clear (my_scope); - } - - void do_clear_global_pattern (const std::string& pat) - { - glob_match pattern (pat); - - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (sr.is_global () && pattern.match (sr.name ())) - sr.unmark_global (); - } - - - for (global_table_iterator q = global_table.begin (); - q != global_table.end ();) - { - if (pattern.match (q->first)) - global_table.erase (q++); //Gotta be careful to not - //invalidate iterators - else - q++; - } - - - } - - void do_clear_variable_pattern (const std::string& pat) - { - glob_match pattern (pat); - - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (sr.is_defined () || sr.is_global ()) - { - if (pattern.match (sr.name ())) - sr.clear (my_scope); - } - } - } - - void do_clear_variable_regexp (const std::string& pat) - { - ::regexp pattern (pat); - - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (sr.is_defined () || sr.is_global ()) - { - if (pattern.is_match (sr.name ())) - sr.clear (my_scope); - } - } - } - - void do_mark_automatic (const std::string& name) - { - do_insert (name).mark_automatic (); - } - - void do_mark_hidden (const std::string& name) - { - do_insert (name).mark_hidden (); - } - - void do_mark_global (const std::string& name) - { - do_insert (name).mark_global (); - } - - std::list - do_all_variables (context_id context, bool defined_only) const - { - std::list retval; - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - const symbol_record& sr = p->second; - - if (defined_only && ! sr.is_defined (context)) - continue; - - retval.push_back (sr); - } - - return retval; - } - - std::list do_glob (const std::string& pattern, - bool vars_only = false) const - { - std::list retval; - - glob_match pat (pattern); - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - if (pat.match (p->first)) - { - const symbol_record& sr = p->second; - - if (vars_only && ! sr.is_variable ()) - continue; - - retval.push_back (sr); - } - } - - return retval; - } - - std::list do_regexp (const std::string& pattern, - bool vars_only = false) const - { - std::list retval; - - ::regexp pat (pattern); - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - if (pat.is_match (p->first)) - { - const symbol_record& sr = p->second; - - if (vars_only && ! sr.is_variable ()) - continue; - - retval.push_back (sr); - } - } - - return retval; - } - - std::list do_variable_names (void) - { - std::list retval; - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - if (p->second.is_variable ()) - retval.push_back (p->first); - } - - retval.sort (); - - return retval; - } - - static std::map - subfunctions_defined_in_scope (scope_id scope = xcurrent_scope) - { - std::map retval; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - std::pair tmp - = p->second.subfunction_defined_in_scope (scope); - - std::string nm = tmp.first; - - if (! nm.empty ()) - retval[nm] = tmp.second; - } - - return retval; - } - - bool do_is_local_variable (const std::string& name) const - { - table_const_iterator p = table.find (name); - - return (p != table.end () - && ! p->second.is_global () - && p->second.is_defined ()); - } - - bool do_is_global (const std::string& name) const - { - table_const_iterator p = table.find (name); - - return p != table.end () && p->second.is_global (); - } - - void do_dump (std::ostream& os); - - void do_cache_name (const std::string& name) { table_name = name; } - - void do_update_nest (void); - - bool look_nonlocal (const std::string& name, symbol_record& result) - { - table_iterator p = table.find (name); - if (p == table.end ()) - { - if (nest_parent) - return nest_parent->look_nonlocal (name, result); - } - else if (! p->second.is_automatic ()) - { - result = p->second; - return true; - } - - return false; - } -}; - -extern bool out_of_date_check (octave_value& function, - const std::string& dispatch_type = std::string (), - bool check_relative = true); - -extern OCTINTERP_API std::string -get_dispatch_type (const octave_value_list& args); -extern OCTINTERP_API std::string -get_dispatch_type (const octave_value_list& args, builtin_type_t& builtin_type); - -#endif diff -r d02b229ce693 -r a132d206a36a src/syscalls.cc --- a/src/syscalls.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1943 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -// Thomas Baier added the original versions of -// the following functions: -// -// mkfifo unlink waitpid - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include - -#include - -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "oct-syscalls.h" -#include "oct-uname.h" - -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "lo-utils.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "oct-stdstrm.h" -#include "oct-stream.h" -#include "sysdep.h" -#include "utils.h" -#include "variables.h" -#include "input.h" - -static octave_scalar_map -mk_stat_map (const base_file_stat& fs) -{ - octave_scalar_map m; - - m.assign ("dev", static_cast (fs.dev ())); - m.assign ("ino", fs.ino ()); - m.assign ("mode", fs.mode ()); - m.assign ("modestr", fs.mode_as_string ()); - m.assign ("nlink", fs.nlink ()); - m.assign ("uid", fs.uid ()); - m.assign ("gid", fs.gid ()); -#if defined (HAVE_STRUCT_STAT_ST_RDEV) - m.assign ("rdev", static_cast (fs.rdev ())); -#endif - m.assign ("size", fs.size ()); - m.assign ("atime", fs.atime ()); - m.assign ("mtime", fs.mtime ()); - m.assign ("ctime", fs.ctime ()); -#if defined (HAVE_STRUCT_STAT_ST_BLKSIZE) - m.assign ("blksize", fs.blksize ()); -#endif -#if defined (HAVE_STRUCT_STAT_ST_BLOCKS) - m.assign ("blocks", fs.blocks ()); -#endif - - return m; -} - -static octave_value_list -mk_stat_result (const base_file_stat& fs) -{ - octave_value_list retval; - - if (fs) - { - retval(2) = std::string (); - retval(1) = 0; - retval(0) = octave_value (mk_stat_map (fs)); - } - else - { - retval(2) = fs.error (); - retval(1) = -1; - retval(0) = Matrix (); - } - - return retval; -} - -DEFUNX ("dup2", Fdup2, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} dup2 (@var{old}, @var{new})\n\ -Duplicate a file descriptor.\n\ -\n\ -If successful, @var{fid} is greater than zero and contains the new file\n\ -ID@. Otherwise, @var{fid} is negative and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - octave_stream old_stream - = octave_stream_list::lookup (args(0), "dup2"); - - if (! error_state) - { - octave_stream new_stream - = octave_stream_list::lookup (args(1), "dup2"); - - if (! error_state) - { - int i_old = old_stream.file_number (); - int i_new = new_stream.file_number (); - - if (i_old >= 0 && i_new >= 0) - { - std::string msg; - - int status = octave_syscalls::dup2 (i_old, i_new, msg); - - retval(1) = msg; - retval(0) = status; - } - } - } - else - error ("dup2: invalid stream"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("exec", Fexec, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} exec (@var{file}, @var{args})\n\ -Replace current process with a new process. Calling @code{exec} without\n\ -first calling @code{fork} will terminate your current Octave process and\n\ -replace it with the program named by @var{file}. For example,\n\ -\n\ -@example\n\ -exec (\"ls\" \"-l\")\n\ -@end example\n\ -\n\ -@noindent\n\ -will run @code{ls} and return you to your shell prompt.\n\ -\n\ -If successful, @code{exec} does not return. If @code{exec} does return,\n\ -@var{err} will be nonzero, and @var{msg} will contain a system-dependent\n\ -error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string exec_file = args(0).string_value (); - - if (! error_state) - { - string_vector exec_args; - - if (nargin == 2) - { - string_vector tmp = args(1).all_strings (); - - if (! error_state) - { - int len = tmp.length (); - - exec_args.resize (len + 1); - - exec_args[0] = exec_file; - - for (int i = 0; i < len; i++) - exec_args[i+1] = tmp[i]; - } - else - error ("exec: arguments must be character strings"); - } - else - { - exec_args.resize (1); - - exec_args[0] = exec_file; - } - - if (! error_state) - { - std::string msg; - - int status = octave_syscalls::execvp (exec_file, exec_args, msg); - - retval(1) = msg; - retval(0) = status; - } - } - else - error ("exec: FILE must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("popen2", Fpopen2, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{in}, @var{out}, @var{pid}] =} popen2 (@var{command}, @var{args})\n\ -Start a subprocess with two-way communication. The name of the process\n\ -is given by @var{command}, and @var{args} is an array of strings\n\ -containing options for the command. The file identifiers for the input\n\ -and output streams of the subprocess are returned in @var{in} and\n\ -@var{out}. If execution of the command is successful, @var{pid}\n\ -contains the process ID of the subprocess. Otherwise, @var{pid} is\n\ -@minus{}1.\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -[in, out, pid] = popen2 (\"sort\", \"-r\");\n\ -fputs (in, \"these\\nare\\nsome\\nstrings\\n\");\n\ -fclose (in);\n\ -EAGAIN = errno (\"EAGAIN\");\n\ -done = false;\n\ -do\n\ - s = fgets (out);\n\ - if (ischar (s))\n\ - fputs (stdout, s);\n\ - elseif (errno () == EAGAIN)\n\ - sleep (0.1);\n\ - fclear (out);\n\ - else\n\ - done = true;\n\ - endif\n\ -until (done)\n\ -fclose (out);\n\ -waitpid (pid);\n\ -\n\ - @print{} these\n\ - @print{} strings\n\ - @print{} some\n\ - @print{} are\n\ -@end example\n\ -\n\ -Note that @code{popen2}, unlike @code{popen}, will not \"reap\" the\n\ -child process. If you don't use @code{waitpid} to check the child's\n\ -exit status, it will linger until Octave exits.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = -1; - retval(1) = Matrix (); - retval(0) = Matrix (); - - int nargin = args.length (); - - if (nargin >= 1 && nargin <= 3) - { - std::string exec_file = args(0).string_value (); - - if (! error_state) - { - string_vector arg_list; - - if (nargin >= 2) - { - string_vector tmp = args(1).all_strings (); - - if (! error_state) - { - int len = tmp.length (); - - arg_list.resize (len + 1); - - arg_list[0] = exec_file; - - for (int i = 0; i < len; i++) - arg_list[i+1] = tmp[i]; - } - else - error ("popen2: arguments must be character strings"); - } - else - { - arg_list.resize (1); - - arg_list[0] = exec_file; - } - - if (! error_state) - { - bool sync_mode = (nargin == 3 ? args(2).bool_value () : false); - - if (! error_state) - { - int fildes[2]; - std::string msg; - pid_t pid; - - pid = octave_syscalls::popen2 (exec_file, arg_list, sync_mode, fildes, msg, interactive); - if (pid >= 0) - { - FILE *ifile = fdopen (fildes[1], "r"); - FILE *ofile = fdopen (fildes[0], "w"); - - std::string nm; - - octave_stream is = octave_stdiostream::create (nm, ifile, - std::ios::in); - - octave_stream os = octave_stdiostream::create (nm, ofile, - std::ios::out); - - Cell file_ids (1, 2); - - retval(2) = pid; - retval(1) = octave_stream_list::insert (is); - retval(0) = octave_stream_list::insert (os); - } - else - error (msg.c_str ()); - } - } - else - error ("popen2: arguments must be character strings"); - } - else - error ("popen2: COMMAND argument must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! if (isunix ()) -%! [in, out, pid] = popen2 ("sort", "-r"); -%! EAGAIN = errno ("EAGAIN"); -%! else -%! [in, out, pid] = popen2 ("sort", "/R"); -%! EAGAIN = errno ("EINVAL"); -%! endif -%! fputs (in, "these\nare\nsome\nstrings\n"); -%! fclose (in); -%! done = false; -%! str = {}; -%! idx = 0; -%! errs = 0; -%! do -%! if (!isunix ()) -%! errno (0); -%! endif -%! s = fgets (out); -%! if (ischar (s)) -%! idx++; -%! str{idx} = s; -%! elseif (errno () == EAGAIN) -%! fclear (out); -%! sleep (0.1); -%! if (++errs == 100) -%! done = true; -%! endif -%! else -%! done = true; -%! endif -%! until (done) -%! fclose (out); -%! if (isunix ()) -%! assert (str, {"these\n","strings\n","some\n","are\n"}); -%! else -%! assert (str, {"these\r\n","strings\r\n","some\r\n","are\r\n"}); -%! endif -*/ - -DEFUNX ("fcntl", Ffcntl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} fcntl (@var{fid}, @var{request}, @var{arg})\n\ -Change the properties of the open file @var{fid}. The following values\n\ -may be passed as @var{request}:\n\ -\n\ -@vtable @code\n\ -@item F_DUPFD\n\ -Return a duplicate file descriptor.\n\ -\n\ -@item F_GETFD\n\ -Return the file descriptor flags for @var{fid}.\n\ -\n\ -@item F_SETFD\n\ -Set the file descriptor flags for @var{fid}.\n\ -\n\ -@item F_GETFL\n\ -Return the file status flags for @var{fid}. The following codes may be\n\ -returned (some of the flags may be undefined on some systems).\n\ -\n\ -@vtable @code\n\ -@item O_RDONLY\n\ -Open for reading only.\n\ -\n\ -@item O_WRONLY\n\ -Open for writing only.\n\ -\n\ -@item O_RDWR\n\ -Open for reading and writing.\n\ -\n\ -@item O_APPEND\n\ -Append on each write.\n\ -\n\ -@item O_CREAT\n\ -Create the file if it does not exist.\n\ -\n\ -@item O_NONBLOCK\n\ -Non-blocking mode.\n\ -\n\ -@item O_SYNC\n\ -Wait for writes to complete.\n\ -\n\ -@item O_ASYNC\n\ -Asynchronous I/O.\n\ -@end vtable\n\ -\n\ -@item F_SETFL\n\ -Set the file status flags for @var{fid} to the value specified by\n\ -@var{arg}. The only flags that can be changed are @w{@code{O_APPEND}} and\n\ -@w{@code{O_NONBLOCK}}.\n\ -@end vtable\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 3) - { - octave_stream strm = octave_stream_list::lookup (args (0), "fcntl"); - - if (! error_state) - { - int fid = strm.file_number (); - - int req = args(1).int_value (true); - int arg = args(2).int_value (true); - - if (! error_state) - { - // FIXME -- Need better checking here? - if (fid < 0) - error ("fcntl: invalid file id"); - else - { - std::string msg; - - int status = octave_fcntl (fid, req, arg, msg); - - retval(1) = msg; - retval(0) = status; - } - } - } - else - error ("fcntl: FID, REQUEST, and ARG must be integers"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("fork", Ffork, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{pid}, @var{msg}] =} fork ()\n\ -Create a copy of the current process.\n\ -\n\ -Fork can return one of the following values:\n\ -\n\ -@table @asis\n\ -@item > 0\n\ -You are in the parent process. The value returned from @code{fork} is\n\ -the process id of the child process. You should probably arrange to\n\ -wait for any child processes to exit.\n\ -\n\ -@item 0\n\ -You are in the child process. You can call @code{exec} to start another\n\ -process. If that fails, you should probably call @code{exit}.\n\ -\n\ -@item < 0\n\ -The call to @code{fork} failed for some reason. You must take evasive\n\ -action. A system dependent error message will be waiting in @var{msg}.\n\ -@end table\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - std::string msg; - - pid_t pid = octave_syscalls::fork (msg); - - retval(1) = msg; - retval(0) = pid; - } - else - print_usage (); - - return retval; -} - -DEFUNX ("getpgrp", Fgetpgrp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {pgid =} getpgrp ()\n\ -Return the process group id of the current process.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - std::string msg; - - retval(1) = msg; - retval(0) = octave_syscalls::getpgrp (msg); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("getpid", Fgetpid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {pid =} getpid ()\n\ -Return the process id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getpid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getppid", Fgetppid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {pid =} getppid ()\n\ -Return the process id of the parent process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getppid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getegid", Fgetegid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {egid =} getegid ()\n\ -Return the effective group id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getegid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getgid", Fgetgid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {gid =} getgid ()\n\ -Return the real group id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getgid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("geteuid", Fgeteuid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {euid =} geteuid ()\n\ -Return the effective user id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::geteuid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getuid", Fgetuid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {uid =} getuid ()\n\ -Return the real user id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getuid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("kill", Fkill, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} kill (@var{pid}, @var{sig})\n\ -Send signal @var{sig} to process @var{pid}.\n\ -\n\ -If @var{pid} is positive, then signal @var{sig} is sent to @var{pid}.\n\ -\n\ -If @var{pid} is 0, then signal @var{sig} is sent to every process\n\ -in the process group of the current process.\n\ -\n\ -If @var{pid} is -1, then signal @var{sig} is sent to every process\n\ -except process 1.\n\ -\n\ -If @var{pid} is less than -1, then signal @var{sig} is sent to every\n\ -process in the process group @var{-pid}.\n\ -\n\ -If @var{sig} is 0, then no signal is sent, but error checking is still\n\ -performed.\n\ -\n\ -Return 0 if successful, otherwise return -1.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - if (args.length () == 2) - { - pid_t pid = args(0).int_value (true); - - if (! error_state) - { - int sig = args(1).int_value (true); - - if (! error_state) - { - std::string msg; - - int status = octave_syscalls::kill (pid, sig, msg); - - retval(1) = msg; - retval(0) = status; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("lstat", Flstat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{symlink})\n\ -Return a structure @var{info} containing information about the symbolic link\n\ -@var{symlink}. The function outputs are described in the documentation for\n\ -@code{stat}.\n\ -@seealso{stat}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - std::string fname = args(0).string_value (); - - if (! error_state) - { - file_stat fs (fname, false); - - retval = mk_stat_result (fs); - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("mkfifo", Fmkfifo, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} mkfifo (@var{name}, @var{mode})\n\ -Create a @var{fifo} special file named @var{name} with file mode @var{mode}\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - if (args(0).is_string ()) - { - std::string name = args(0).string_value (); - - if (args(1).is_scalar_type ()) - { - long mode = args(1).long_value (); - - if (! error_state) - { - std::string msg; - - int status = octave_mkfifo (name, mode, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - else - error ("mkfifo: invalid MODE"); - } - else - error ("mkfifo: MODE must be an integer"); - } - else - error ("mkfifo: FILE must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("pipe", Fpipe, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{read_fd}, @var{write_fd}, @var{err}, @var{msg}] =} pipe ()\n\ -Create a pipe and return the reading and writing ends of the pipe\n\ -into @var{read_fd} and @var{write_fd} respectively.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(3) = std::string (); - retval(2) = -1; - retval(1) = -1; - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - int fid[2]; - - std::string msg; - - int status = octave_syscalls::pipe (fid, msg); - - if (status < 0) - retval(3) = msg; - else - { - FILE *ifile = fdopen (fid[0], "r"); - FILE *ofile = fdopen (fid[1], "w"); - - std::string nm; - - octave_stream is = octave_stdiostream::create (nm, ifile, - std::ios::in); - - octave_stream os = octave_stdiostream::create (nm, ofile, - std::ios::out); - - retval(2) = status; - retval(1) = octave_stream_list::insert (os); - retval(0) = octave_stream_list::insert (is); - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("stat", Fstat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{file})\n\ -@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{fid})\n\ -@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{file})\n\ -@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{fid})\n\ -Return a structure @var{info} containing the following information about\n\ -@var{file} or file identifier @var{fid}.\n\ -\n\ -@table @code\n\ -@item dev\n\ -ID of device containing a directory entry for this file.\n\ -\n\ -@item ino\n\ -File number of the file.\n\ -\n\ -@item mode\n\ -File mode, as an integer. Use the functions @w{@code{S_ISREG}},\n\ -@w{@code{S_ISDIR}}, @w{@code{S_ISCHR}}, @w{@code{S_ISBLK}}, @w{@code{S_ISFIFO}},\n\ -@w{@code{S_ISLNK}}, or @w{@code{S_ISSOCK}} to extract information from this\n\ -value.\n\ -\n\ -@item modestr\n\ -File mode, as a string of ten letters or dashes as would be returned by\n\ -@kbd{ls -l}.\n\ -\n\ -@item nlink\n\ -Number of links.\n\ -\n\ -@item uid\n\ -User ID of file's owner.\n\ -\n\ -@item gid\n\ -Group ID of file's group.\n\ -\n\ -@item rdev\n\ -ID of device for block or character special files.\n\ -\n\ -@item size\n\ -Size in bytes.\n\ -\n\ -@item atime\n\ -Time of last access in the same form as time values returned from\n\ -@code{time}. @xref{Timing Utilities}.\n\ -\n\ -@item mtime\n\ -Time of last modification in the same form as time values returned from\n\ -@code{time}. @xref{Timing Utilities}.\n\ -\n\ -@item ctime\n\ -Time of last file status change in the same form as time values\n\ -returned from @code{time}. @xref{Timing Utilities}.\n\ -\n\ -@item blksize\n\ -Size of blocks in the file.\n\ -\n\ -@item blocks\n\ -Number of blocks allocated for file.\n\ -@end table\n\ -\n\ -If the call is successful @var{err} is 0 and @var{msg} is an empty\n\ -string. If the file does not exist, or some other error occurs, @var{s}\n\ -is an empty matrix, @var{err} is @minus{}1, and @var{msg} contains the\n\ -corresponding system error message.\n\ -\n\ -If @var{file} is a symbolic link, @code{stat} will return information\n\ -about the actual file that is referenced by the link. Use @code{lstat}\n\ -if you want information about the symbolic link itself.\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -[s, err, msg] = stat (\"/vmlinuz\")\n\ - @result{} s =\n\ - @{\n\ - atime = 855399756\n\ - rdev = 0\n\ - ctime = 847219094\n\ - uid = 0\n\ - size = 389218\n\ - blksize = 4096\n\ - mtime = 847219094\n\ - gid = 6\n\ - nlink = 1\n\ - blocks = 768\n\ - mode = -rw-r--r--\n\ - modestr = -rw-r--r--\n\ - ino = 9316\n\ - dev = 2049\n\ - @}\n\ - @result{} err = 0\n\ - @result{} msg =\n\ -@end example\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - if (args(0).is_scalar_type ()) - { - int fid = octave_stream_list::get_file_number (args(0)); - - if (! error_state) - { - file_fstat fs (fid); - - retval = mk_stat_result (fs); - } - } - else - { - std::string fname = args(0).string_value (); - - if (! error_state) - { - file_stat fs (fname); - - retval = mk_stat_result (fs); - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISREG", FS_ISREG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISREG (@var{mode})\n\ -Return true if @var{mode} corresponds to a regular file. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_reg (static_cast (mode)); - else - error ("S_ISREG: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISDIR", FS_ISDIR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISDIR (@var{mode})\n\ -Return true if @var{mode} corresponds to a directory. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_dir (static_cast (mode)); - else - error ("S_ISDIR: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISCHR", FS_ISCHR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISCHR (@var{mode})\n\ -Return true if @var{mode} corresponds to a character device. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_chr (static_cast (mode)); - else - error ("S_ISCHR: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISBLK", FS_ISBLK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISBLK (@var{mode})\n\ -Return true if @var{mode} corresponds to a block device. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_blk (static_cast (mode)); - else - error ("S_ISBLK: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISFIFO", FS_ISFIFO, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISFIFO (@var{mode})\n\ -Return true if @var{mode} corresponds to a fifo. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_fifo (static_cast (mode)); - else - error ("S_ISFIFO: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISLNK", FS_ISLNK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISLNK (@var{mode})\n\ -Return true if @var{mode} corresponds to a symbolic link. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_lnk (static_cast (mode)); - else - error ("S_ISLNK: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISSOCK", FS_ISSOCK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISSOCK (@var{mode})\n\ -Return true if @var{mode} corresponds to a socket. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_sock (static_cast (mode)); - else - error ("S_ISSOCK: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUN (gethostname, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} gethostname ()\n\ -Return the hostname of the system where Octave is running.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = octave_env::get_host_name (); - else - print_usage (); - - return retval; -} - -DEFUN (uname, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{uts}, @var{err}, @var{msg}] =} uname ()\n\ -Return system information in the structure. For example:\n\ -\n\ -@example\n\ -@group\n\ -uname ()\n\ - @result{} @{\n\ - sysname = x86_64\n\ - nodename = segfault\n\ - release = 2.6.15-1-amd64-k8-smp\n\ - version = Linux\n\ - machine = #2 SMP Thu Feb 23 04:57:49 UTC 2006\n\ - @}\n\ -@end group\n\ -@end example\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 0) - { - octave_uname sysinfo; - - octave_scalar_map m; - - m.assign ("sysname", sysinfo.sysname ()); - m.assign ("nodename", sysinfo.nodename ()); - m.assign ("release", sysinfo.release ()); - m.assign ("version", sysinfo.version ()); - m.assign ("machine", sysinfo.machine ()); - - retval(2) = sysinfo.message (); - retval(1) = sysinfo.error (); - retval(0) = m; - } - else - print_usage (); - - return retval; -} - -DEFUNX ("unlink", Funlink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} unlink (@var{file})\n\ -Delete the file named @var{file}.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - std::string name = args(0).string_value (); - - std::string msg; - - int status = octave_unlink (name, msg); - - retval(1) = msg; - retval(0) = status; - } - else - error ("unlink: FILE must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("waitpid", Fwaitpid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{pid}, @var{status}, @var{msg}] =} waitpid (@var{pid}, @var{options})\n\ -Wait for process @var{pid} to terminate. The @var{pid} argument can be:\n\ -\n\ -@table @asis\n\ -@item @minus{}1\n\ -Wait for any child process.\n\ -\n\ -@item 0\n\ -Wait for any child process whose process group ID is equal to that of\n\ -the Octave interpreter process.\n\ -\n\ -@item > 0\n\ -Wait for termination of the child process with ID @var{pid}.\n\ -@end table\n\ -\n\ -The @var{options} argument can be a bitwise OR of zero or more of\n\ -the following constants:\n\ -\n\ -@table @code\n\ -@item 0\n\ -Wait until signal is received or a child process exits (this is the\n\ -default if the @var{options} argument is missing).\n\ -\n\ -@item WNOHANG\n\ -Do not hang if status is not immediately available.\n\ -\n\ -@item WUNTRACED\n\ -Report the status of any child processes that are stopped, and whose\n\ -status has not yet been reported since they stopped.\n\ -\n\ -@item WCONTINUE\n\ -Return if a stopped child has been resumed by delivery of @code{SIGCONT}.\n\ -This value may not be meaningful on all systems.\n\ -@end table\n\ -\n\ -If the returned value of @var{pid} is greater than 0, it is the process\n\ -ID of the child process that exited. If an error occurs, @var{pid} will\n\ -be less than zero and @var{msg} will contain a system-dependent error\n\ -message. The value of @var{status} contains additional system-dependent\n\ -information about the subprocess that exited.\n\ -@seealso{WCONTINUE, WCOREDUMP, WEXITSTATUS, WIFCONTINUED, WIFSIGNALED, WIFSTOPPED, WNOHANG, WSTOPSIG, WTERMSIG, WUNTRACED}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = 0; - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - pid_t pid = args(0).int_value (true); - - if (! error_state) - { - int options = 0; - - if (args.length () == 2) - options = args(1).int_value (true); - - if (! error_state) - { - std::string msg; - - int status = 0; - - pid_t result = octave_syscalls::waitpid (pid, &status, options, msg); - - retval(2) = msg; - retval(1) = status; - retval(0) = result; - } - else - error ("waitpid: OPTIONS must be an integer"); - } - else - error ("waitpid: PID must be an integer value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("WIFEXITED", FWIFEXITED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFEXITED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child terminated normally.\n\ -@seealso{waitpid, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFEXITED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFEXITED (status); - else - error ("WIFEXITED: STATUS must be an integer"); - } -#else - warning ("WIFEXITED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WEXITSTATUS", FWEXITSTATUS, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WEXITSTATUS (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return the exit\n\ -status of the child. This function should only be employed if\n\ -@code{WIFEXITED} returned true.\n\ -@seealso{waitpid, WIFEXITED, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WEXITSTATUS) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WEXITSTATUS (status); - else - error ("WEXITSTATUS: STATUS must be an integer"); - } -#else - warning ("WEXITSTATUS always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WIFSIGNALED", FWIFSIGNALED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFSIGNALED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child process was terminated by a signal.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFSIGNALED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFSIGNALED (status); - else - error ("WIFSIGNALED: STATUS must be an integer"); - } -#else - warning ("WIFSIGNALED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WTERMSIG", FWTERMSIG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WTERMSIG (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return the number of\n\ -the signal that caused the child process to terminate. This function\n\ -should only be employed if @code{WIFSIGNALED} returned true.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WTERMSIG) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WTERMSIG (status); - else - error ("WTERMSIG: STATUS must be an integer"); - } -#else - warning ("WTERMSIG always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WCOREDUMP", FWCOREDUMP, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WCOREDUMP (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child produced a core dump. This function should only be employed if\n\ -@code{WIFSIGNALED} returned true. The macro used to implement this\n\ -function is not specified in POSIX.1-2001 and is not available on some\n\ -Unix implementations (e.g., AIX, SunOS).\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WCOREDUMP) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WCOREDUMP (status); - else - error ("WCOREDUMP: STATUS must be an integer"); - } -#else - warning ("WCOREDUMP always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WIFSTOPPED", FWIFSTOPPED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFSTOPPED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child process was stopped by delivery of a signal; this is only\n\ -possible if the call was done using @code{WUNTRACED} or when the child\n\ -is being traced (see ptrace(2)).\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFSTOPPED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFSTOPPED (status); - else - error ("WIFSTOPPED: STATUS must be an integer"); - } -#else - warning ("WIFSTOPPED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WSTOPSIG", FWSTOPSIG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WSTOPSIG (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return the number of\n\ -the signal which caused the child to stop. This function should only\n\ -be employed if @code{WIFSTOPPED} returned true.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WSTOPSIG) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WSTOPSIG (status); - else - error ("WSTOPSIG: STATUS must be an integer"); - } -#else - warning ("WSTOPSIG always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WIFCONTINUED", FWIFCONTINUED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFCONTINUED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child process was resumed by delivery of @code{SIGCONT}.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFCONTINUED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFCONTINUED (status); - else - error ("WIFCONTINUED: STATUS must be an integer"); - } -#else - warning ("WIFCONTINUED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("canonicalize_file_name", Fcanonicalize_file_name, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{cname}, @var{status}, @var{msg}] =} canonicalize_file_name (@var{fname})\n\ -Return the canonical name of file @var{fname}. If the file does not exist\n\ -the empty string (\"\") is returned.\n\ -@seealso{make_absolute_filename, is_absolute_filename, is_rooted_relative_filename}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - std::string msg; - - std::string result = octave_canonicalize_file_name (name, msg); - - retval(2) = msg; - retval(1) = msg.empty () ? 0 : -1; - retval(0) = result; - } - else - error ("canonicalize_file_name: NAME must be a character string"); - } - else - print_usage (); - - return retval; -} - -static octave_value -const_value (const octave_value_list& args, int val) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = val; - else - print_usage (); - - return retval; -} - -#if !defined (O_NONBLOCK) && defined (O_NDELAY) -#define O_NONBLOCK O_NDELAY -#endif - -DEFUNX ("F_DUPFD", FF_DUPFD, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_DUPFD ()\n\ -Return the numerical value to pass to @code{fcntl} to return a\n\ -duplicate file descriptor.\n\ -@seealso{fcntl, F_GETFD, F_GETFL, F_SETFD, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_DUPFD) - return const_value (args, F_DUPFD); -#else - error ("F_DUPFD: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_GETFD", FF_GETFD, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_GETFD ()\n\ -Return the numerical value to pass to @code{fcntl} to return the\n\ -file descriptor flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFL, F_SETFD, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_GETFD) - return const_value (args, F_GETFD); -#else - error ("F_GETFD: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_GETFL", FF_GETFL, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_GETFL ()\n\ -Return the numerical value to pass to @code{fcntl} to return the\n\ -file status flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFD, F_SETFD, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_GETFL) - return const_value (args, F_GETFL); -#else - error ("F_GETFL: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_SETFD", FF_SETFD, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_SETFD ()\n\ -Return the numerical value to pass to @code{fcntl} to set the file\n\ -descriptor flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_SETFD) - return const_value (args, F_SETFD); -#else - error ("F_SETFD: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_SETFL", FF_SETFL, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_SETFL ()\n\ -Return the numerical value to pass to @code{fcntl} to set the file\n\ -status flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFD}\n\ -@end deftypefn") -{ -#if defined (F_SETFL) - return const_value (args, F_SETFL); -#else - error ("F_SETFL: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_APPEND", FO_APPEND, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_APPEND ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate each write operation appends,\n\ -or that may be passed to @code{fcntl} to set the write mode to append.\n\ -@seealso{fcntl, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_APPEND) - return const_value (args, O_APPEND); -#else - error ("O_APPEND: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_ASYNC", FO_ASYNC, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_ASYNC ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate asynchronous I/O.\n\ -@seealso{fcntl, O_APPEND, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_ASYNC) - return const_value (args, O_ASYNC); -#else - error ("O_ASYNC: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_CREAT", FO_CREAT, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_CREAT ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file should be\n\ -created if it does not exist.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_CREAT) - return const_value (args, O_CREAT); -#else - error ("O_CREAT: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_EXCL", FO_EXCL, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_EXCL ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that file locking is used.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_EXCL) - return const_value (args, O_EXCL); -#else - error ("O_EXCL: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_NONBLOCK", FO_NONBLOCK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_NONBLOCK ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that non-blocking I/O is in use,\n\ -or that may be passsed to @code{fcntl} to set non-blocking I/O.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_NONBLOCK) - return const_value (args, O_NONBLOCK); -#else - error ("O_NONBLOCK: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_RDONLY", FO_RDONLY, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_RDONLY ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for\n\ -reading only.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_RDONLY) - return const_value (args, O_RDONLY); -#else - error ("O_RDONLY: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_RDWR", FO_RDWR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_RDWR ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for both\n\ -reading and writing.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_RDWR) - return const_value (args, O_RDWR); -#else - error ("O_RDWR: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_SYNC", FO_SYNC, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_SYNC ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for\n\ -synchronous I/O.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_SYNC) - return const_value (args, O_SYNC); -#else - error ("O_SYNC: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_TRUNC", FO_TRUNC, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} O_TRUNC ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that if file exists, it should\n\ -be truncated when writing.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_TRUNC) - return const_value (args, O_TRUNC); -#else - error ("O_TRUNC: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_WRONLY", FO_WRONLY, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_WRONLY ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for\n\ -writing only.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC}\n\ -@end deftypefn") -{ -#if defined (O_WRONLY) - return const_value (args, O_WRONLY); -#else - error ("O_WRONLY: not available on this system"); - return octave_value (); -#endif -} - -#if !defined (WNOHANG) -#define WNOHANG 0 -#endif - -DEFUNX ("WNOHANG", FWNOHANG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WNOHANG ()\n\ -Return the numerical value of the option argument that may be\n\ -passed to @code{waitpid} to indicate that it should return its\n\ -status immediately instead of waiting for a process to exit.\n\ -@seealso{waitpid, WUNTRACED, WCONTINUE}\n\ -@end deftypefn") -{ - return const_value (args, WNOHANG); -} - -#if !defined (WUNTRACED) -#define WUNTRACED 0 -#endif - -DEFUNX ("WUNTRACED", FWUNTRACED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WUNTRACED ()\n\ -Return the numerical value of the option argument that may be\n\ -passed to @code{waitpid} to indicate that it should also return\n\ -if the child process has stopped but is not traced via the\n\ -@code{ptrace} system call\n\ -@seealso{waitpid, WNOHANG, WCONTINUE}\n\ -@end deftypefn") -{ - return const_value (args, WUNTRACED); -} - -#if !defined (WCONTINUE) -#define WCONTINUE 0 -#endif - -DEFUNX ("WCONTINUE", FWCONTINUE, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WCONTINUE ()\n\ -Return the numerical value of the option argument that may be\n\ -passed to @code{waitpid} to indicate that it should also return\n\ -if a stopped child has been resumed by delivery of a @code{SIGCONT}\n\ -signal.\n\ -@seealso{waitpid, WNOHANG, WUNTRACED}\n\ -@end deftypefn") -{ - return const_value (args, WCONTINUE); -} diff -r d02b229ce693 -r a132d206a36a src/sysdep.cc --- a/src/sysdep.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,905 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include - -#include -#include - -#include -#include - -#if defined (HAVE_TERMIOS_H) -#include -#elif defined (HAVE_TERMIO_H) -#include -#elif defined (HAVE_SGTTY_H) -#include -#endif - -#if defined (HAVE_CONIO_H) -#include -#endif - -#if defined (HAVE_SYS_IOCTL_H) -#include -#endif - -#if defined (HAVE_FLOATINGPOINT_H) -#include -#endif - -#if defined (HAVE_IEEEFP_H) -#include -#endif - -#include "cmd-edit.h" -#include "file-ops.h" -#include "lo-mappers.h" -#include "lo-math.h" -#include "mach-info.h" -#include "oct-env.h" -#include "quit.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "input.h" -#include "oct-obj.h" -#include "ov.h" -#include "pager.h" -#include "parse.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "toplev.h" -#include "utils.h" -#include "file-stat.h" - -#ifndef STDIN_FILENO -#define STDIN_FILENO 1 -#endif - -#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) -static void -BSD_init (void) -{ -#if defined (HAVE_FLOATINGPOINT_H) - // Disable trapping on common exceptions. -#ifndef FP_X_DNML -#define FP_X_DNML 0 -#endif - fpsetmask (~(FP_X_OFL|FP_X_INV|FP_X_DZ|FP_X_DNML|FP_X_UFL|FP_X_IMP)); -#endif -} -#endif - -#if defined (__WIN32__) && ! defined (_POSIX_VERSION) - -#define WIN32_LEAN_AND_MEAN -#include - -static void -w32_set_octave_home (void) -{ - std::string bin_dir; - - HANDLE h = CreateToolhelp32Snapshot (TH32CS_SNAPMODULE -#ifdef TH32CS_SNAPMODULE32 - | TH32CS_SNAPMODULE32 -#endif - , 0); - - if (h != INVALID_HANDLE_VALUE) - { - MODULEENTRY32 mod_info; - - ZeroMemory (&mod_info, sizeof (mod_info)); - mod_info.dwSize = sizeof (mod_info); - - if (Module32First (h, &mod_info)) - { - do - { - std::string mod_name (mod_info.szModule); - - if (mod_name.find ("octinterp") != std::string::npos) - { - bin_dir = mod_info.szExePath; - if (bin_dir[bin_dir.length () - 1] != '\\') - bin_dir.append (1, '\\'); - break; - } - } - while (Module32Next (h, &mod_info)); - } - - CloseHandle (h); - } - - if (! bin_dir.empty ()) - { - size_t pos = bin_dir.rfind ("\\bin\\"); - - if (pos != std::string::npos) - octave_env::putenv ("OCTAVE_HOME", bin_dir.substr (0, pos)); - } -} - -void -w32_set_quiet_shutdown (void) -{ - // Let the user close the console window or shutdown without the - // pesky dialog. - // - // FIXME -- should this be user configurable? - SetProcessShutdownParameters (0x280, SHUTDOWN_NORETRY); -} - -void -MINGW_signal_cleanup (void) -{ - w32_set_quiet_shutdown (); - - w32_raise_final (); -} -#endif - -#if defined (__MINGW32__) -static void -MINGW_init (void) -{ - w32_set_octave_home (); - - // Init mutex to protect setjmp/longjmp and get main thread context - w32_sigint_init (); - - w32_set_quiet_shutdown (); -} -#endif - -#if defined (_MSC_VER) -static void -MSVC_init (void) -{ - w32_set_octave_home (); - - // Init mutex to protect setjmp/longjmp and get main thread context - w32_sigint_init (); - - w32_set_quiet_shutdown (); -} -#endif - - -// Return TRUE if FILE1 and FILE2 refer to the same (physical) file. - -bool -same_file_internal (const std::string& file1, const std::string& file2) -{ -#ifdef OCTAVE_USE_WINDOWS_API - - bool retval = false; - - // Windows native code - // Reference: http://msdn2.microsoft.com/en-us/library/aa363788.aspx - - HANDLE hfile1 = CreateFile (file1.c_str (), 0, FILE_SHARE_READ, 0, - OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); - - if (hfile1 != INVALID_HANDLE_VALUE) - { - HANDLE hfile2 = CreateFile (file2.c_str (), 0, FILE_SHARE_READ, 0, - OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); - - if (hfile2 != INVALID_HANDLE_VALUE) - { - BY_HANDLE_FILE_INFORMATION hfi1; - BY_HANDLE_FILE_INFORMATION hfi2; - - if (GetFileInformationByHandle (hfile1, &hfi1) - && GetFileInformationByHandle (hfile2, &hfi2)) - - retval = (hfi1.dwVolumeSerialNumber == hfi2.dwVolumeSerialNumber - && hfi1.nFileIndexHigh == hfi2.nFileIndexHigh - && hfi1.nFileIndexLow == hfi2.nFileIndexLow); - - CloseHandle (hfile2); - } - - CloseHandle (hfile1); - } - - return retval; - -#else - - // POSIX Code - - file_stat fs_file1 (file1); - file_stat fs_file2 (file2); - - return (fs_file1 && fs_file2 - && fs_file1.ino () == fs_file2.ino () - && fs_file1.dev () == fs_file2.dev ()); - -#endif -} - -void -sysdep_init (void) -{ -#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) - BSD_init (); -#elif defined (__MINGW32__) - MINGW_init (); -#elif defined (_MSC_VER) - MSVC_init (); -#endif -} - -void -sysdep_cleanup (void) -{ - MINGW_SIGNAL_CLEANUP (); -} - -// Set terminal in raw mode. From less-177. -// -// Change terminal to "raw mode", or restore to "normal" mode. -// "Raw mode" means -// 1. An outstanding read will complete on receipt of a single keystroke. -// 2. Input is not echoed. -// 3. On output, \n is mapped to \r\n. -// 4. \t is NOT expanded into spaces. -// 5. Signal-causing characters such as ctrl-C (interrupt), -// etc. are NOT disabled. -// It doesn't matter whether an input \n is mapped to \r, or vice versa. - -void -raw_mode (bool on, bool wait) -{ - static bool curr_on = false; - - int tty_fd = STDIN_FILENO; - if (! gnulib::isatty (tty_fd)) - { - if (interactive) - error ("stdin is not a tty!"); - return; - } - - if (on == curr_on) - return; - -#if defined (HAVE_TERMIOS_H) - { - struct termios s; - static struct termios save_term; - - if (on) - { - // Get terminal modes. - - tcgetattr (tty_fd, &s); - - // Save modes and set certain variables dependent on modes. - - save_term = s; -// ospeed = s.c_cflag & CBAUD; -// erase_char = s.c_cc[VERASE]; -// kill_char = s.c_cc[VKILL]; - - // Set the modes to the way we want them. - - s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); - s.c_oflag |= (OPOST|ONLCR); -#if defined (OCRNL) - s.c_oflag &= ~(OCRNL); -#endif -#if defined (ONOCR) - s.c_oflag &= ~(ONOCR); -#endif -#if defined (ONLRET) - s.c_oflag &= ~(ONLRET); -#endif - s.c_cc[VMIN] = wait ? 1 : 0; - s.c_cc[VTIME] = 0; - } - else - { - // Restore saved modes. - - s = save_term; - } - - tcsetattr (tty_fd, wait ? TCSAFLUSH : TCSADRAIN, &s); - } -#elif defined (HAVE_TERMIO_H) - { - struct termio s; - static struct termio save_term; - - if (on) - { - // Get terminal modes. - - ioctl (tty_fd, TCGETA, &s); - - // Save modes and set certain variables dependent on modes. - - save_term = s; -// ospeed = s.c_cflag & CBAUD; -// erase_char = s.c_cc[VERASE]; -// kill_char = s.c_cc[VKILL]; - - // Set the modes to the way we want them. - - s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); - s.c_oflag |= (OPOST|ONLCR); -#if defined (OCRNL) - s.c_oflag &= ~(OCRNL); -#endif -#if defined (ONOCR) - s.c_oflag &= ~(ONOCR); -#endif -#if defined (ONLRET) - s.c_oflag &= ~(ONLRET); -#endif - s.c_cc[VMIN] = wait ? 1 : 0; - } - else - { - // Restore saved modes. - - s = save_term; - } - - ioctl (tty_fd, TCSETAW, &s); - } -#elif defined (HAVE_SGTTY_H) - { - struct sgttyb s; - static struct sgttyb save_term; - - if (on) - { - // Get terminal modes. - - ioctl (tty_fd, TIOCGETP, &s); - - // Save modes and set certain variables dependent on modes. - - save_term = s; -// ospeed = s.sg_ospeed; -// erase_char = s.sg_erase; -// kill_char = s.sg_kill; - - // Set the modes to the way we want them. - - s.sg_flags |= CBREAK; - s.sg_flags &= ~(ECHO); - } - else - { - // Restore saved modes. - - s = save_term; - } - - ioctl (tty_fd, TIOCSETN, &s); - } -#else - warning ("no support for raw mode console I/O on this system"); - - // Make sure the current mode doesn't toggle. - on = curr_on; -#endif - - curr_on = on; -} - -FILE * -octave_popen (const char *command, const char *mode) -{ -#if defined (__MINGW32__) || defined (_MSC_VER) - if (mode && mode[0] && ! mode[1]) - { - char tmode[3]; - tmode[0] = mode[0]; - tmode[1] = 'b'; - tmode[2] = 0; - - return _popen (command, tmode); - } - else - return _popen (command, mode); -#else - return popen (command, mode); -#endif -} - -int -octave_pclose (FILE *f) -{ -#if defined (__MINGW32__) || defined (_MSC_VER) - return _pclose (f); -#else - return pclose (f); -#endif -} - -// Read one character from the terminal. - -int -octave_kbhit (bool wait) -{ -#ifdef HAVE__KBHIT - int c = (! wait && ! _kbhit ()) ? 0 : std::cin.get (); -#else - raw_mode (true, wait); - - // Get current handler. - octave_interrupt_handler saved_interrupt_handler - = octave_ignore_interrupts (); - - // Restore it, disabling system call restarts (if possible) so the - // read can be interrupted. - - octave_set_interrupt_handler (saved_interrupt_handler, false); - - int c = std::cin.get (); - - if (std::cin.fail () || std::cin.eof ()) - std::cin.clear (); - - // Restore it, enabling system call restarts (if possible). - octave_set_interrupt_handler (saved_interrupt_handler, true); - - raw_mode (false, true); -#endif - - return c; -} - -std::string -get_P_tmpdir (void) -{ -#if defined (__WIN32__) && ! defined (_POSIX_VERSION) - - std::string retval; - -#if defined (P_tmpdir) - retval = P_tmpdir; -#endif - - // Apparently some versions of MinGW and MSVC either don't define - // P_tmpdir, or they define it to a single backslash, neither of which - // is particularly helpful. - - if (retval.empty () || retval == "\\") - { - retval = octave_env::getenv ("TEMP"); - - if (retval.empty ()) - retval = octave_env::getenv ("TMP"); - - if (retval.empty ()) - retval = "c:\\temp"; - } - - return retval; - -#elif defined (P_tmpdir) - - return P_tmpdir; - -#else - - return "/tmp"; - -#endif -} - -DEFUN (clc, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} clc ()\n\ -@deftypefnx {Built-in Function} {} home ()\n\ -Clear the terminal screen and move the cursor to the upper left corner.\n\ -@end deftypefn") -{ - command_editor::clear_screen (); - - return octave_value_list (); -} - -DEFALIAS (home, clc); - -DEFUN (getenv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} getenv (@var{var})\n\ -Return the value of the environment variable @var{var}. For example,\n\ -\n\ -@example\n\ -getenv (\"PATH\")\n\ -@end example\n\ -\n\ -@noindent\n\ -returns a string containing the value of your path.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - retval = octave_env::getenv (name); - } - else - print_usage (); - - return retval; -} - -DEFUN (putenv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} putenv (@var{var}, @var{value})\n\ -@deftypefnx {Built-in Function} {} setenv (@var{var}, @var{value})\n\ -Set the value of the environment variable @var{var} to @var{value}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 1) - { - std::string var = args(0).string_value (); - - if (! error_state) - { - std::string val = (nargin == 2 - ? args(1).string_value () : std::string ()); - - if (! error_state) - octave_env::putenv (var, val); - else - error ("putenv: VALUE must be a string"); - } - else - error ("putenv: VAR must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFALIAS (setenv, putenv); - -/* -%!assert (ischar (getenv ("OCTAVE_HOME"))) -%!test -%! setenv ("dummy_variable_that_cannot_matter", "foobar"); -%! assert (getenv ("dummy_variable_that_cannot_matter"), "foobar"); -*/ - -// FIXME -- perhaps kbhit should also be able to print a prompt? - -DEFUN (kbhit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} kbhit ()\n\ -Read a single keystroke from the keyboard. If called with one\n\ -argument, don't wait for a keypress. For example,\n\ -\n\ -@example\n\ -x = kbhit ();\n\ -@end example\n\ -\n\ -@noindent\n\ -will set @var{x} to the next character typed at the keyboard as soon as\n\ -it is typed.\n\ -\n\ -@example\n\ -x = kbhit (1);\n\ -@end example\n\ -\n\ -@noindent\n\ -identical to the above example, but don't wait for a keypress,\n\ -returning the empty string if no key is available.\n\ -@end deftypefn") -{ - octave_value retval; - - // FIXME -- add timeout and default value args? - - if (interactive || forced_interactive) - { - feval ("drawnow"); - - int c = octave_kbhit (args.length () == 0); - - if (c == -1) - c = 0; - - char *s = new char [2]; - s[0] = c; - s[1] = '\0'; - retval = s; - } - - return retval; -} - -DEFUN (pause, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pause (@var{seconds})\n\ -Suspend the execution of the program. If invoked without any arguments,\n\ -Octave waits until you type a character. With a numeric argument, it\n\ -pauses for the given number of seconds. For example, the following\n\ -statement prints a message and then waits 5 seconds before clearing the\n\ -screen.\n\ -\n\ -@example\n\ -@group\n\ -fprintf (stderr, \"wait please...\\n\");\n\ -pause (5);\n\ -clc;\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (! (nargin == 0 || nargin == 1)) - { - print_usage (); - return retval; - } - - if (nargin == 1) - { - double dval = args(0).double_value (); - - if (! error_state) - { - if (! xisnan (dval)) - { - feval ("drawnow"); - - if (xisinf (dval)) - { - flush_octave_stdout (); - octave_kbhit (); - } - else - octave_sleep (dval); - } - else - warning ("pause: NaN is an invalid delay"); - } - } - else - { - feval ("drawnow"); - flush_octave_stdout (); - octave_kbhit (); - } - - return retval; -} - -/* -%!test -%! pause (1); - -%!error (pause (1, 2)) -*/ - -DEFUN (sleep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sleep (@var{seconds})\n\ -Suspend the execution of the program for the given number of seconds.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - double dval = args(0).double_value (); - - if (! error_state) - { - if (xisnan (dval)) - warning ("sleep: NaN is an invalid delay"); - else - { - feval ("drawnow"); - octave_sleep (dval); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! sleep (1); - -%!error (sleep ()) -%!error (sleep (1, 2)) -*/ - -DEFUN (usleep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} usleep (@var{microseconds})\n\ -Suspend the execution of the program for the given number of\n\ -microseconds. On systems where it is not possible to sleep for periods\n\ -of time less than one second, @code{usleep} will pause the execution for\n\ -@code{round (@var{microseconds} / 1e6)} seconds.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - double dval = args(0).double_value (); - - if (! error_state) - { - if (xisnan (dval)) - warning ("usleep: NaN is an invalid delay"); - else - { - feval ("drawnow"); - - int delay = NINT (dval); - - if (delay > 0) - octave_usleep (delay); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! usleep (1000); - -%!error (usleep ()) -%!error (usleep (1, 2)) -*/ - -// FIXME -- maybe this should only return 1 if IEEE floating -// point functions really work. - -DEFUN (isieee, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isieee ()\n\ -Return true if your computer @emph{claims} to conform to the IEEE standard\n\ -for floating point calculations. No actual tests are performed.\n\ -@end deftypefn") -{ - oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); - - return octave_value (flt_fmt == oct_mach_info::flt_fmt_ieee_little_endian - || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); -} - -/* -%!assert (islogical (isieee ())) -*/ - -DEFUN (native_float_format, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} native_float_format ()\n\ -Return the native floating point format as a string\n\ -@end deftypefn") -{ - oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); - - return octave_value (oct_mach_info::float_format_as_string (flt_fmt)); -} - -/* -%!assert (ischar (native_float_format ())) -*/ - -DEFUN (tilde_expand, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} tilde_expand (@var{string})\n\ -Perform tilde expansion on @var{string}. If @var{string} begins with a\n\ -tilde character, (@samp{~}), all of the characters preceding the first\n\ -slash (or all characters, if there is no slash) are treated as a\n\ -possible user name, and the tilde and the following characters up to the\n\ -slash are replaced by the home directory of the named user. If the\n\ -tilde is followed immediately by a slash, the tilde is replaced by the\n\ -home directory of the user running Octave. For example:\n\ -\n\ -@example\n\ -@group\n\ -tilde_expand (\"~joeuser/bin\")\n\ - @result{} \"/home/joeuser/bin\"\n\ -tilde_expand (\"~/bin\")\n\ - @result{} \"/home/jwe/bin\"\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value arg = args(0); - - string_vector sv = arg.all_strings (); - - if (! error_state) - { - sv = file_ops::tilde_expand (sv); - - if (arg.is_cellstr ()) - retval = Cell (arg.dims (), sv); - else - retval = sv; - } - else - error ("tilde_expand: expecting argument to be char or cellstr object"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! if (isempty (getenv ("HOME"))) -%! setenv ("HOME", "foobar"); -%! endif -%! home = getenv ("HOME"); -%! assert (tilde_expand ("~/foobar"), strcat (home, "/foobar")); -%! assert (tilde_expand ("/foo/bar"), "/foo/bar"); -%! assert (tilde_expand ("foo/bar"), "foo/bar"); -*/ diff -r d02b229ce693 -r a132d206a36a src/sysdep.h --- a/src/sysdep.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,58 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_sysdep_h) -#define octave_sysdep_h 1 - -#include - -#include - -#include "lo-ieee.h" -#include "lo-sysdep.h" - -extern void sysdep_init (void); - -extern void sysdep_cleanup (void); - -extern OCTINTERP_API void raw_mode (bool, bool wait = true); - -extern OCTINTERP_API FILE *octave_popen (const char *command, const char *mode); -extern OCTINTERP_API int octave_pclose (FILE *f); - -extern OCTINTERP_API int octave_kbhit (bool wait = true); - -extern OCTINTERP_API std::string get_P_tmpdir (void); - -extern void w32_set_quiet_shutdown (void); - -#if defined (__WIN32__) && ! defined (_POSIX_VERSION) -extern void MINGW_signal_cleanup (void); -#define USE_W32_SIGINT 1 -#define MINGW_SIGNAL_CLEANUP() MINGW_signal_cleanup () -#else -#define MINGW_SIGNAL_CLEANUP() do { } while (0) -#endif - -extern OCTINTERP_API bool same_file_internal (const std::string&, const std::string&); - -#endif diff -r d02b229ce693 -r a132d206a36a src/template-inst/Array-jit.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/template-inst/Array-jit.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,40 @@ +/* + +Copyright (C) 2012 Max Brister + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#ifdef HAVE_LLVM + +#include "Array.h" +#include "Array.cc" + +extern template class OCTAVE_API Array; + +#include "pt-jit.h" + +NO_INSTANTIATE_ARRAY_SORT (jit_function); + +INSTANTIATE_ARRAY (jit_function, OCTINTERP_API); + +#endif diff -r d02b229ce693 -r a132d206a36a src/template-inst/Array-os.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/template-inst/Array-os.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,47 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Instantiate Arrays of octave_stream objects. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "Array.h" +#include "Array.cc" + +extern template class OCTAVE_API Array; +extern template class OCTAVE_API Array; + +#include "oct-stream.h" + +typedef scanf_format_elt* scanf_format_elt_ptr; +typedef printf_format_elt* printf_format_elt_ptr; + +NO_INSTANTIATE_ARRAY_SORT (scanf_format_elt_ptr); +INSTANTIATE_ARRAY (scanf_format_elt_ptr, OCTINTERP_API); + +NO_INSTANTIATE_ARRAY_SORT (printf_format_elt_ptr); +INSTANTIATE_ARRAY (printf_format_elt_ptr, OCTINTERP_API); + +NO_INSTANTIATE_ARRAY_SORT (octave_stream); +INSTANTIATE_ARRAY (octave_stream, OCTINTERP_API); diff -r d02b229ce693 -r a132d206a36a src/template-inst/Array-sym.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/template-inst/Array-sym.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,39 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Instantiate Arrays of octave_child objects. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "Array.h" +#include "Array.cc" + +#include "oct-obj.h" +#include "symtab.h" + +typedef symbol_record* symbol_record_ptr; + +NO_INSTANTIATE_ARRAY_SORT (symbol_record_ptr); + +INSTANTIATE_ARRAY (symbol_record_ptr, OCTINTERP_API); diff -r d02b229ce693 -r a132d206a36a src/template-inst/Array-tc.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/template-inst/Array-tc.cc Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,38 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 3 of the License, or (at your +option) any later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, see +. + +*/ + +// Instantiate Arrays of octave_values. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "Array.h" +#include "Array.cc" + +#include "ov.h" + +#include "oct-sort.cc" + +NO_INSTANTIATE_ARRAY_SORT (octave_value); + +INSTANTIATE_ARRAY (octave_value, OCTINTERP_API); diff -r d02b229ce693 -r a132d206a36a src/template-inst/module.mk --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/template-inst/module.mk Fri Aug 03 14:59:40 2012 -0400 @@ -0,0 +1,6 @@ +EXTRA_DIST += template-inst/module.mk + +TEMPLATE_INST_SRC = \ + template-inst/Array-os.cc \ + template-inst/Array-tc.cc \ + template-inst/Array-jit.cc diff -r d02b229ce693 -r a132d206a36a src/toplev.cc --- a/src/toplev.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1537 +0,0 @@ -/* - -Copyright (C) 1995-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include - -#include -#include -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "cmd-hist.h" -#include "file-ops.h" -#include "lo-error.h" -#include "lo-mappers.h" -#include "oct-env.h" -#include "oct-locbuf.h" -#include "quit.h" -#include "singleton-cleanup.h" -#include "str-vec.h" - -#include "defaults.h" -#include "defun.h" -#include "error.h" -#include "file-io.h" -#include "graphics.h" -#include "input.h" -#include "lex.h" -#include "oct-conf.h" -#include "oct-hist.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "ov.h" -#include "pager.h" -#include "parse.h" -#include "pathsearch.h" -#include "procstream.h" -#include "pt-eval.h" -#include "pt-jump.h" -#include "pt-stmt.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "syswait.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" - -void (*octave_exit) (int) = ::exit; - -// TRUE means the quit() call is allowed. -bool quit_allowed = true; - -// TRUE means we are exiting via the builtin exit or quit functions. -bool quitting_gracefully = false; -// This stores the exit status. -int exit_status = 0; - -// TRUE means we are ready to interpret commands, but not everything -// is ready for interactive use. -bool octave_interpreter_ready = false; - -// TRUE means we've processed all the init code and we are good to go. -bool octave_initialized = false; - -// Current command to execute. -tree_statement_list *global_command = 0; - -octave_call_stack *octave_call_stack::instance = 0; - -void -octave_call_stack::create_instance (void) -{ - instance = new octave_call_stack (); - - if (instance) - { - instance->do_push (0, symbol_table::top_scope (), 0); - - singleton_cleanup_list::add (cleanup_instance); - } -} - -int -octave_call_stack::do_current_line (void) const -{ - tree_statement *stmt = do_current_statement (); - - return stmt ? stmt->line () : -1; -} - -int -octave_call_stack::do_current_column (void) const -{ - tree_statement *stmt = do_current_statement (); - - return stmt ? stmt->column () : -1; -} - -int -octave_call_stack::do_caller_user_code_line (void) const -{ - int retval = -1; - - const_iterator p = cs.end (); - - while (p != cs.begin ()) - { - const call_stack_elt& elt = *(--p); - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - tree_statement *stmt = elt.stmt; - - if (stmt) - { - retval = stmt->line (); - break; - } - } - } - - return retval; -} - -int -octave_call_stack::do_caller_user_code_column (void) const -{ - int retval = -1; - - const_iterator p = cs.end (); - - while (p != cs.begin ()) - { - const call_stack_elt& elt = *(--p); - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - tree_statement *stmt = elt.stmt; - - if (stmt) - { - retval = stmt->column (); - break; - } - } - } - - return retval; -} - -size_t -octave_call_stack::do_num_user_code_frames (octave_idx_type& curr_user_frame) const -{ - size_t retval = 0; - - curr_user_frame = 0; - - // Look for the caller of dbstack. - size_t frame = cs[curr_frame].prev; - - bool found = false; - - size_t k = cs.size (); - - for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) - { - octave_function *f = (*p).fcn; - - if (--k == frame) - found = true; - - if (f && f->is_user_code ()) - { - if (! found) - curr_user_frame++; - - retval++; - } - } - - // We counted how many user frames were not the one, in reverse. - // Now set curr_user_frame to be the index in the other direction. - curr_user_frame = retval - curr_user_frame - 1; - - return retval; -} - -octave_user_code * -octave_call_stack::do_caller_user_code (size_t nskip) const -{ - octave_user_code *retval = 0; - - const_iterator p = cs.end (); - - while (p != cs.begin ()) - { - const call_stack_elt& elt = *(--p); - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - if (nskip > 0) - nskip--; - else - { - retval = dynamic_cast (f); - break; - } - } - } - - return retval; -} - -// Use static fields for the best efficiency. -// NOTE: C++0x will allow these two to be merged into one. -static const char *bt_fieldnames[] = { "file", "name", "line", - "column", "scope", "context", 0 }; -static const octave_fields bt_fields (bt_fieldnames); - -octave_map -octave_call_stack::empty_backtrace (void) -{ - return octave_map (dim_vector (0, 1), bt_fields); -} - -octave_map -octave_call_stack::do_backtrace (size_t nskip, - octave_idx_type& curr_user_frame) const -{ - size_t user_code_frames = do_num_user_code_frames (curr_user_frame); - - size_t nframes = nskip <= user_code_frames ? user_code_frames - nskip : 0; - - // Our list is reversed. - curr_user_frame = nframes - curr_user_frame - 1; - - octave_map retval (dim_vector (nframes, 1), bt_fields); - - Cell& file = retval.contents (0); - Cell& name = retval.contents (1); - Cell& line = retval.contents (2); - Cell& column = retval.contents (3); - Cell& scope = retval.contents (4); - Cell& context = retval.contents (5); - - if (nframes > 0) - { - int k = 0; - - for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) - { - const call_stack_elt& elt = *p; - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - if (nskip > 0) - nskip--; - else - { - scope(k) = elt.scope; - context(k) = elt.context; - - file(k) = f->fcn_file_name (); - std::string parent_fcn_name = f->parent_fcn_name (); - if (parent_fcn_name == std::string ()) - name(k) = f->name (); - else - name(k) = f->parent_fcn_name () + Vfilemarker + f->name (); - - tree_statement *stmt = elt.stmt; - - if (stmt) - { - line(k) = stmt->line (); - column(k) = stmt->column (); - } - else - { - line(k) = -1; - column(k) = -1; - } - - k++; - } - } - } - } - - return retval; -} - -bool -octave_call_stack::do_goto_frame (size_t n, bool verbose) -{ - bool retval = false; - - if (n < cs.size ()) - { - retval = true; - - curr_frame = n; - - const call_stack_elt& elt = cs[n]; - - symbol_table::set_scope_and_context (elt.scope, elt.context); - - if (verbose) - { - octave_function *f = elt.fcn; - std::string nm = f ? f->name () : std::string (""); - - tree_statement *s = elt.stmt; - int l = -1; - int c = -1; - if (s) - { - l = s->line (); - c = s->column (); - } - - octave_stdout << "stopped in " << nm - << " at line " << l << " column " << c - << " (" << elt.scope << "[" << elt.context << "])" - << std::endl; - } - } - - return retval; -} - -bool -octave_call_stack::do_goto_frame_relative (int nskip, bool verbose) -{ - bool retval = false; - - int incr = 0; - - if (nskip < 0) - incr = -1; - else if (nskip > 0) - incr = 1; - - // Start looking with the caller of dbup/dbdown/keyboard. - size_t frame = cs[curr_frame].prev; - - while (true) - { - if ((incr < 0 && frame == 0) || (incr > 0 && frame == cs.size () - 1)) - break; - - frame += incr; - - const call_stack_elt& elt = cs[frame]; - - octave_function *f = elt.fcn; - - if (frame == 0 || (f && f->is_user_code ())) - { - if (nskip > 0) - nskip--; - else if (nskip < 0) - nskip++; - - if (nskip == 0) - { - curr_frame = frame; - cs[cs.size () - 1].prev = curr_frame; - - symbol_table::set_scope_and_context (elt.scope, elt.context); - - if (verbose) - { - std::ostringstream buf; - - if (f) - { - tree_statement *s = elt.stmt; - - int l = s ? s->line () : -1; - - buf << "stopped in " << f->name () - << " at line " << l << std::endl; - } - else - buf << "at top level" << std::endl; - - octave_stdout << buf.str (); - } - - retval = true; - break; - } - } - - // There is no need to set scope and context here. That will - // happen when the dbup/dbdown/keyboard frame is popped and we - // jump to the new "prev" frame set above. - } - - return retval; -} - -void -octave_call_stack::do_goto_caller_frame (void) -{ - size_t frame = curr_frame; - - bool skipped = false; - - while (frame != 0) - { - frame = cs[frame].prev; - - const call_stack_elt& elt = cs[frame]; - - octave_function *f = elt.fcn; - - if (frame == 0 || (f && f->is_user_code ())) - { - if (! skipped) - // We found the current user code frame, so skip it. - skipped = true; - else - { - // We found the caller user code frame. - call_stack_elt tmp (elt); - tmp.prev = curr_frame; - - curr_frame = cs.size (); - - cs.push_back (tmp); - - symbol_table::set_scope_and_context (tmp.scope, tmp.context); - - break; - } - } - } -} - -void -octave_call_stack::do_goto_base_frame (void) -{ - call_stack_elt tmp (cs[0]); - tmp.prev = curr_frame; - - curr_frame = cs.size (); - - cs.push_back (tmp); - - symbol_table::set_scope_and_context (tmp.scope, tmp.context); -} - -void -octave_call_stack::do_backtrace_error_message (void) const -{ - if (error_state > 0) - { - error_state = -1; - - error ("called from:"); - } - - if (! cs.empty ()) - { - const call_stack_elt& elt = cs.back (); - - octave_function *fcn = elt.fcn; - tree_statement *stmt = elt.stmt; - - std::string fcn_name = "?unknown?"; - - if (fcn) - { - fcn_name = fcn->fcn_file_name (); - - if (fcn_name.empty ()) - fcn_name = fcn->name (); - } - - int line = stmt ? stmt->line () : -1; - int column = stmt ? stmt->column () : -1; - - error (" %s at line %d, column %d", - fcn_name.c_str (), line, column); - } -} - -void -recover_from_exception (void) -{ - can_interrupt = true; - octave_interrupt_immediately = 0; - octave_interrupt_state = 0; - octave_signal_caught = 0; - octave_exception_state = octave_no_exception; - octave_restore_signal_mask (); - octave_catch_interrupts (); -} - -int -main_loop (void) -{ - octave_save_signal_mask (); - - can_interrupt = true; - - octave_signal_hook = octave_signal_handler; - octave_interrupt_hook = 0; - octave_bad_alloc_hook = 0; - - octave_catch_interrupts (); - - octave_initialized = true; - - // The big loop. - - int retval = 0; - do - { - try - { - unwind_protect frame; - - reset_error_handler (); - - reset_parser (); - - if (symbol_table::at_top_level ()) - tree_evaluator::reset_debug_state (); - - // Do this with an unwind-protect cleanup function so that - // the forced variables will be unmarked in the event of an - // interrupt. - symbol_table::scope_id scope = symbol_table::top_scope (); - frame.add_fcn (symbol_table::unmark_forced_variables, scope); - - frame.protect_var (global_command); - - global_command = 0; - - // This is the same as yyparse in parse.y. - retval = octave_parse (); - - if (retval == 0) - { - if (global_command) - { - // Use an unwind-protect cleanup function so that the - // global_command list will be deleted in the event of - // an interrupt. - - frame.add_fcn (cleanup_statement_list, &global_command); - - global_command->accept (*current_evaluator); - - octave_quit (); - - if (! (interactive || forced_interactive)) - { - bool quit = (tree_return_command::returning - || tree_break_command::breaking); - - if (tree_return_command::returning) - tree_return_command::returning = 0; - - if (tree_break_command::breaking) - tree_break_command::breaking--; - - if (quit) - break; - } - - if (error_state) - { - if (! (interactive || forced_interactive)) - { - // We should exit with a non-zero status. - retval = 1; - break; - } - } - else - { - if (octave_completion_matches_called) - octave_completion_matches_called = false; - else - command_editor::increment_current_command_number (); - } - } - else if (parser_end_of_input) - break; - } - } - catch (octave_interrupt_exception) - { - recover_from_exception (); - octave_stdout << "\n"; - if (quitting_gracefully) - { - clean_up_and_exit (exit_status); - break; // If user has overriden the exit func. - } - } - catch (octave_execution_exception) - { - recover_from_exception (); - std::cerr - << "error: unhandled execution exception -- trying to return to prompt" - << std::endl; - } - catch (std::bad_alloc) - { - recover_from_exception (); - std::cerr - << "error: memory exhausted or requested size too large for range of Octave's index type -- trying to return to prompt" - << std::endl; - } - } - while (retval == 0); - - return retval; -} - -// Fix up things before exiting. - -void -clean_up_and_exit (int retval) -{ - do_octave_atexit (); - - if (octave_exit) - (*octave_exit) (retval == EOF ? 0 : retval); -} - -DEFUN (quit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} exit (@var{status})\n\ -@deftypefnx {Built-in Function} {} quit (@var{status})\n\ -Exit the current Octave session. If the optional integer value\n\ -@var{status} is supplied, pass that value to the operating system as the\n\ -Octave's exit status. The default value is zero.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (! quit_allowed) - error ("quit: not supported in embedded mode"); - else - { - if (args.length () > 0) - { - int tmp = args(0).nint_value (); - - if (! error_state) - exit_status = tmp; - } - - if (! error_state) - { - // Instead of simply calling exit, we simulate an interrupt - // with a request to exit cleanly so that no matter where the - // call to quit occurs, we will run the unwind_protect stack, - // clear the OCTAVE_LOCAL_BUFFER allocations, etc. before - // exiting. - - quitting_gracefully = true; - - octave_interrupt_state = -1; - - octave_throw_interrupt_exception (); - } - } - - return retval; -} - -DEFALIAS (exit, quit); - -DEFUN (warranty, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} warranty ()\n\ -Describe the conditions for copying and distributing Octave.\n\ -@end deftypefn") -{ - octave_value_list retval; - - octave_stdout << "\n" \ - OCTAVE_NAME_VERSION_AND_COPYRIGHT "\n\ -\n\ -GNU Octave free software; you can redistribute it and/or modify\n\ -it under the terms of the GNU General Public License as published by\n\ -the Free Software Foundation; either version 3 of the License, or\n\ -(at your option) any later version.\n\ -\n\ -GNU Octave is distributed in the hope that it will be useful,\n\ -but WITHOUT ANY WARRANTY; without even the implied warranty of\n\ -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n\ -GNU General Public License for more details.\n\ -\n\ -You should have received a copy of the GNU General Public License\n\ -along with this program. If not, see .\n\ -\n"; - - return retval; -} - -// Execute a shell command. - -static int -wait_for_input (int fid) -{ - int retval = -1; - -#if defined (HAVE_SELECT) - if (fid >= 0) - { - fd_set set; - - FD_ZERO (&set); - FD_SET (fid, &set); - - retval = gnulib::select (FD_SETSIZE, &set, 0, 0, 0); - } -#else - retval = 1; -#endif - - return retval; -} - -static octave_value_list -run_command_and_return_output (const std::string& cmd_str) -{ - octave_value_list retval; - unwind_protect frame; - - iprocstream *cmd = new iprocstream (cmd_str.c_str ()); - - frame.add_delete (cmd); - frame.add_fcn (octave_child_list::remove, cmd->pid ()); - - if (*cmd) - { - int fid = cmd->file_number (); - - std::ostringstream output_buf; - - char ch; - - for (;;) - { - if (cmd->get (ch)) - output_buf.put (ch); - else - { - if (! cmd->eof () && errno == EAGAIN) - { - cmd->clear (); - - if (wait_for_input (fid) != 1) - break; - } - else - break; - } - } - - int cmd_status = cmd->close (); - - if (WIFEXITED (cmd_status)) - cmd_status = WEXITSTATUS (cmd_status); - else - cmd_status = 127; - - retval(1) = output_buf.str (); - retval(0) = cmd_status; - } - else - error ("unable to start subprocess for `%s'", cmd_str.c_str ()); - - return retval; -} - -enum system_exec_type { et_sync, et_async }; - -DEFUN (system, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} system (\"@var{string}\")\n\ -@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output})\n\ -@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output}, @var{type})\n\ -@deftypefnx {Built-in Function} {[@var{status}, @var{output}] =} system (@dots{})\n\ -Execute a shell command specified by @var{string}.\n\ -If the optional argument @var{type} is \"async\", the process\n\ -is started in the background and the process ID of the child process\n\ -is returned immediately. Otherwise, the child process is started and\n\ -Octave waits until it exits. If the @var{type} argument is omitted, it\n\ -defaults to the value \"sync\".\n\ -\n\ -If @var{system} is called with one or more output arguments, or if the\n\ -optional argument @var{return_output} is true and the subprocess is started\n\ -synchronously, then the output from the command is returned as a variable. \n\ -Otherwise, if the subprocess is executed synchronously, its output is sent\n\ -to the standard output. To send the output of a command executed with\n\ -@code{system} through the pager, use a command like\n\ -\n\ -@example\n\ -@group\n\ -[output, text] = system (\"cmd\");\n\ -disp (text);\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -or\n\ -\n\ -@example\n\ -printf (\"%s\\n\", nthargout (2, \"system\", \"cmd\"));\n\ -@end example\n\ -\n\ -The @code{system} function can return two values. The first is the\n\ -exit status of the command and the second is any output from the\n\ -command that was written to the standard output stream. For example,\n\ -\n\ -@example\n\ -[status, output] = system (\"echo foo; exit 2\");\n\ -@end example\n\ -\n\ -@noindent\n\ -will set the variable @code{output} to the string @samp{foo}, and the\n\ -variable @code{status} to the integer @samp{2}.\n\ -\n\ -For commands run asynchronously, @var{status} is the process id of the\n\ -command shell that is started to run the command.\n\ -@seealso{unix, dos}\n\ -@end deftypefn") -{ - octave_value_list retval; - - unwind_protect frame; - - int nargin = args.length (); - - if (nargin > 0 && nargin < 4) - { - bool return_output = (nargin == 1 && nargout > 1); - - system_exec_type type = et_sync; - - if (nargin == 3) - { - std::string type_str = args(2).string_value (); - - if (! error_state) - { - if (type_str == "sync") - type = et_sync; - else if (type_str == "async") - type = et_async; - else - { - error ("system: TYPE must be \"sync\" or \"async\""); - return retval; - } - } - else - { - error ("system: TYPE must be a character string"); - return retval; - } - } - - if (nargin > 1) - { - return_output = args(1).is_true (); - - if (error_state) - { - error ("system: RETURN_OUTPUT must be boolean value true or false"); - return retval; - } - } - - if (return_output && type == et_async) - { - error ("system: can't return output from commands run asynchronously"); - return retval; - } - - std::string cmd_str = args(0).string_value (); - - if (! error_state) - { -#if defined (__WIN32__) && ! defined (__CYGWIN__) - // Work around weird double-quote handling on Windows systems. - if (type == et_sync) - cmd_str = "\"" + cmd_str + "\""; -#endif - - if (type == et_async) - { - // FIXME -- maybe this should go in sysdep.cc? -#ifdef HAVE_FORK - pid_t pid = fork (); - - if (pid < 0) - error ("system: fork failed -- can't create child process"); - else if (pid == 0) - { - // FIXME -- should probably replace this - // call with something portable. - - execl ("/bin/sh", "sh", "-c", cmd_str.c_str (), - static_cast (0)); - - panic_impossible (); - } - else - retval(0) = pid; -#elif defined (__WIN32__) - STARTUPINFO si; - PROCESS_INFORMATION pi; - ZeroMemory (&si, sizeof (si)); - ZeroMemory (&pi, sizeof (pi)); - OCTAVE_LOCAL_BUFFER (char, xcmd_str, cmd_str.length ()+1); - strcpy (xcmd_str, cmd_str.c_str ()); - - if (! CreateProcess (0, xcmd_str, 0, 0, FALSE, 0, 0, 0, &si, &pi)) - error ("system: CreateProcess failed -- can't create child process"); - else - { - retval(0) = pi.dwProcessId; - CloseHandle (pi.hProcess); - CloseHandle (pi.hThread); - } -#else - error ("asynchronous system calls are not supported"); -#endif - } - else if (return_output) - retval = run_command_and_return_output (cmd_str); - else - { - int status = system (cmd_str.c_str ()); - - // The value in status is as returned by waitpid. If - // the process exited normally, extract the actual exit - // status of the command. Otherwise, return 127 as a - // failure code. - - if (WIFEXITED (status)) - status = WEXITSTATUS (status); - - retval(0) = status; - } - } - else - error ("system: expecting string as first argument"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! cmd = ls_command (); -%! [status, output] = system (cmd); -%! assert (status, 0); -%! assert (ischar (output)); -%! assert (! isempty (output)); - -%!error system () -%!error system (1, 2, 3) -*/ - -// FIXME -- this should really be static, but that causes -// problems on some systems. -std::list octave_atexit_functions; - -void -do_octave_atexit (void) -{ - static bool deja_vu = false; - - while (! octave_atexit_functions.empty ()) - { - std::string fcn = octave_atexit_functions.front (); - - octave_atexit_functions.pop_front (); - - OCTAVE_SAFE_CALL (reset_error_handler, ()); - - OCTAVE_SAFE_CALL (feval, (fcn, octave_value_list (), 0)); - - OCTAVE_SAFE_CALL (flush_octave_stdout, ()); - } - - if (! deja_vu) - { - deja_vu = true; - - // Do this explicitly so that destructors for mex file objects - // are called, so that functions registered with mexAtExit are - // called. - OCTAVE_SAFE_CALL (clear_mex_functions, ()); - - OCTAVE_SAFE_CALL (command_editor::restore_terminal_state, ()); - - // FIXME -- is this needed? Can it cause any trouble? - OCTAVE_SAFE_CALL (raw_mode, (0)); - - OCTAVE_SAFE_CALL (octave_history_write_timestamp, ()); - - if (! command_history::ignoring_entries ()) - OCTAVE_SAFE_CALL (command_history::clean_up_and_save, ()); - - OCTAVE_SAFE_CALL (gh_manager::close_all_figures, ()); - - OCTAVE_SAFE_CALL (gtk_manager::unload_all_toolkits, ()); - - OCTAVE_SAFE_CALL (close_files, ()); - - OCTAVE_SAFE_CALL (cleanup_tmp_files, ()); - - OCTAVE_SAFE_CALL (symbol_table::cleanup, ()); - - OCTAVE_SAFE_CALL (cleanup_parser, ()); - - OCTAVE_SAFE_CALL (sysdep_cleanup, ()); - - OCTAVE_SAFE_CALL (flush_octave_stdout, ()); - - if (! quitting_gracefully && (interactive || forced_interactive)) - { - octave_stdout << "\n"; - - // Yes, we want this to be separate from the call to - // flush_octave_stdout above. - - OCTAVE_SAFE_CALL (flush_octave_stdout, ()); - } - - // Don't call singleton_cleanup_list::cleanup until we have the - // problems with registering/unregistering types worked out. For - // example, uncomment the following line, then use the make_int - // function from the examples directory to create an integer - // object and then exit Octave. Octave should crash with a - // segfault when cleaning up the typinfo singleton. We need some - // way to force new octave_value_X types that are created in - // .oct files to be unregistered when the .oct file shared library - // is unloaded. - // - // OCTAVE_SAFE_CALL (singleton_cleanup_list::cleanup, ()); - - OCTAVE_SAFE_CALL (octave_chunk_buffer::clear, ()); - } -} - -void -octave_add_atexit_function (const std::string& fname) -{ - octave_atexit_functions.push_front (fname); -} - -bool -octave_remove_atexit_function (const std::string& fname) -{ - bool found = false; - - for (std::list::iterator p = octave_atexit_functions.begin (); - p != octave_atexit_functions.end (); p++) - { - if (*p == fname) - { - octave_atexit_functions.erase (p); - found = true; - break; - } - } - - return found; -} - - -DEFUN (atexit, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} atexit (@var{fcn})\n\ -@deftypefnx {Built-in Function} {} atexit (@var{fcn}, @var{flag})\n\ -Register a function to be called when Octave exits. For example,\n\ -\n\ -@example\n\ -@group\n\ -function last_words ()\n\ - disp (\"Bye bye\");\n\ -endfunction\n\ -atexit (\"last_words\");\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -will print the message \"Bye bye\" when Octave exits.\n\ -\n\ -The additional argument @var{flag} will register or unregister\n\ -@var{fcn} from the list of functions to be called when Octave\n\ -exits. If @var{flag} is true, the function is registered, and if\n\ -@var{flag} is false, it is unregistered. For example,\n\ -after registering the function @code{last_words} above,\n\ -\n\ -@example\n\ -atexit (\"last_words\", false);\n\ -@end example\n\ -\n\ -@noindent\n\ -will remove the function from the list and Octave will not call\n\ -@code{last_words} when it exits.\n\ -\n\ -Note that @code{atexit} only removes the first occurrence of a function\n\ -from the list, so if a function was placed in the list multiple\n\ -times with @code{atexit}, it must also be removed from the list\n\ -multiple times.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string arg = args(0).string_value (); - - if (! error_state) - { - bool add_mode = true; - - if (nargin == 2) - { - add_mode = args(1).bool_value (); - - if (error_state) - error ("atexit: FLAG argument must be a logical value"); - } - - if (! error_state) - { - if (add_mode) - octave_add_atexit_function (arg); - else - { - bool found = octave_remove_atexit_function (arg); - - if (nargout > 0) - retval(0) = found; - } - } - } - else - error ("atexit: FCN argument must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (octave_config_info, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} octave_config_info ()\n\ -@deftypefnx {Built-in Function} {} octave_config_info (@var{option})\n\ -Return a structure containing configuration and installation\n\ -information for Octave.\n\ -\n\ -If @var{option} is a string, return the configuration information for the\n\ -specified option.\n\ -\n\ -@end deftypefn") -{ - octave_value retval; - -#if defined (ENABLE_DYNAMIC_LINKING) - bool octave_supports_dynamic_linking = true; -#else - bool octave_supports_dynamic_linking = false; -#endif - - static bool initialized = false; - static octave_scalar_map m; - - struct conf_info_struct - { - bool subst_home; - const char *key; - const char *val; - }; - - static const conf_info_struct conf_info[] = - { - { false, "ALL_CFLAGS", OCTAVE_CONF_ALL_CFLAGS }, - { false, "ALL_CXXFLAGS", OCTAVE_CONF_ALL_CXXFLAGS }, - { false, "ALL_FFLAGS", OCTAVE_CONF_ALL_FFLAGS }, - { false, "ALL_LDFLAGS", OCTAVE_CONF_ALL_LDFLAGS }, - { false, "AMD_CPPFLAGS", OCTAVE_CONF_AMD_CPPFLAGS }, - { false, "AMD_LDFLAGS", OCTAVE_CONF_AMD_LDFLAGS }, - { false, "AMD_LIBS", OCTAVE_CONF_AMD_LIBS }, - { false, "AR", OCTAVE_CONF_AR }, - { false, "ARFLAGS", OCTAVE_CONF_ARFLAGS }, - { false, "ARPACK_CPPFLAGS", OCTAVE_CONF_ARPACK_CPPFLAGS }, - { false, "ARPACK_LDFLAGS", OCTAVE_CONF_ARPACK_LDFLAGS }, - { false, "ARPACK_LIBS", OCTAVE_CONF_ARPACK_LIBS }, - { false, "BLAS_LIBS", OCTAVE_CONF_BLAS_LIBS }, - { false, "CARBON_LIBS", OCTAVE_CONF_CARBON_LIBS }, - { false, "CAMD_CPPFLAGS", OCTAVE_CONF_CAMD_CPPFLAGS }, - { false, "CAMD_LDFLAGS", OCTAVE_CONF_CAMD_LDFLAGS }, - { false, "CAMD_LIBS", OCTAVE_CONF_CAMD_LIBS }, - { false, "CC", OCTAVE_CONF_CC }, - { false, "CC_VERSION", OCTAVE_CONF_CC_VERSION }, - { false, "CCOLAMD_CPPFLAGS", OCTAVE_CONF_CCOLAMD_CPPFLAGS }, - { false, "CCOLAMD_LDFLAGS", OCTAVE_CONF_CCOLAMD_LDFLAGS }, - { false, "CCOLAMD_LIBS", OCTAVE_CONF_CCOLAMD_LIBS }, - { false, "CFLAGS", OCTAVE_CONF_CFLAGS }, - { false, "CHOLMOD_CPPFLAGS", OCTAVE_CONF_CHOLMOD_CPPFLAGS }, - { false, "CHOLMOD_LDFLAGS", OCTAVE_CONF_CHOLMOD_LDFLAGS }, - { false, "CHOLMOD_LIBS", OCTAVE_CONF_CHOLMOD_LIBS }, - { false, "COLAMD_CPPFLAGS", OCTAVE_CONF_COLAMD_CPPFLAGS }, - { false, "COLAMD_LDFLAGS", OCTAVE_CONF_COLAMD_LDFLAGS }, - { false, "COLAMD_LIBS", OCTAVE_CONF_COLAMD_LIBS }, - { false, "CPICFLAG", OCTAVE_CONF_CPICFLAG }, - { false, "CPPFLAGS", OCTAVE_CONF_CPPFLAGS }, - { false, "CURL_CPPFLAGS", OCTAVE_CONF_CURL_CPPFLAGS }, - { false, "CURL_LDFLAGS", OCTAVE_CONF_CURL_LDFLAGS }, - { false, "CURL_LIBS", OCTAVE_CONF_CURL_LIBS }, - { false, "CXSPARSE_CPPFLAGS", OCTAVE_CONF_CXSPARSE_CPPFLAGS }, - { false, "CXSPARSE_LDFLAGS", OCTAVE_CONF_CXSPARSE_LDFLAGS }, - { false, "CXSPARSE_LIBS", OCTAVE_CONF_CXSPARSE_LIBS }, - { false, "CXX", OCTAVE_CONF_CXX }, - { false, "CXXCPP", OCTAVE_CONF_CXXCPP }, - { false, "CXXFLAGS", OCTAVE_CONF_CXXFLAGS }, - { false, "CXXPICFLAG", OCTAVE_CONF_CXXPICFLAG }, - { false, "CXX_VERSION", OCTAVE_CONF_CXX_VERSION }, - { false, "DEFAULT_PAGER", OCTAVE_DEFAULT_PAGER }, - { false, "DEFS", OCTAVE_CONF_DEFS }, - { false, "DL_LD", OCTAVE_CONF_DL_LD }, - { false, "DL_LDFLAGS", OCTAVE_CONF_DL_LDFLAGS }, - { false, "DL_LIBS", OCTAVE_CONF_DL_LIBS }, - { false, "ENABLE_DYNAMIC_LINKING", OCTAVE_CONF_ENABLE_DYNAMIC_LINKING }, - { false, "EXEEXT", OCTAVE_CONF_EXEEXT }, - { false, "F77", OCTAVE_CONF_F77 }, - { false, "F77_FLOAT_STORE_FLAG", OCTAVE_CONF_F77_FLOAT_STORE_FLAG }, - { false, "F77_INTEGER_8_FLAG", OCTAVE_CONF_F77_INTEGER_8_FLAG }, - { false, "FC", OCTAVE_CONF_FC }, - { false, "FFLAGS", OCTAVE_CONF_FFLAGS }, - { false, "FFTW3_CPPFLAGS", OCTAVE_CONF_FFTW3_CPPFLAGS }, - { false, "FFTW3_LDFLAGS", OCTAVE_CONF_FFTW3_LDFLAGS }, - { false, "FFTW3_LIBS", OCTAVE_CONF_FFTW3_LIBS }, - { false, "FFTW3F_CPPFLAGS", OCTAVE_CONF_FFTW3F_CPPFLAGS }, - { false, "FFTW3F_LDFLAGS", OCTAVE_CONF_FFTW3F_LDFLAGS }, - { false, "FFTW3F_LIBS", OCTAVE_CONF_FFTW3F_LIBS }, - { false, "FLIBS", OCTAVE_CONF_FLIBS }, - { false, "FPICFLAG", OCTAVE_CONF_FPICFLAG }, - { false, "FT2_LIBS", OCTAVE_CONF_FT2_LIBS }, - { false, "GLPK_CPPFLAGS", OCTAVE_CONF_GLPK_CPPFLAGS }, - { false, "GLPK_LDFLAGS", OCTAVE_CONF_GLPK_LDFLAGS }, - { false, "GLPK_LIBS", OCTAVE_CONF_GLPK_LIBS }, - { false, "GNUPLOT", OCTAVE_CONF_GNUPLOT }, - { false, "GRAPHICS_LIBS", OCTAVE_CONF_GRAPHICS_LIBS }, - { false, "HDF5_CPPFLAGS", OCTAVE_CONF_HDF5_CPPFLAGS }, - { false, "HDF5_LDFLAGS", OCTAVE_CONF_HDF5_LDFLAGS }, - { false, "HDF5_LIBS", OCTAVE_CONF_HDF5_LIBS }, - { false, "INCFLAGS", OCTAVE_CONF_INCFLAGS }, - { false, "LAPACK_LIBS", OCTAVE_CONF_LAPACK_LIBS }, - { false, "LDFLAGS", OCTAVE_CONF_LDFLAGS }, - { false, "LD_CXX", OCTAVE_CONF_LD_CXX }, - { false, "LD_STATIC_FLAG", OCTAVE_CONF_LD_STATIC_FLAG }, - { false, "LEX", OCTAVE_CONF_LEX }, - { false, "LEXLIB", OCTAVE_CONF_LEXLIB }, - { false, "LFLAGS", OCTAVE_CONF_LFLAGS }, - { false, "LIBCRUFT", OCTAVE_CONF_LIBCRUFT }, - { false, "LIBEXT", OCTAVE_CONF_LIBEXT }, - { false, "LIBFLAGS", OCTAVE_CONF_LIBFLAGS }, - { false, "LIBOCTAVE", OCTAVE_CONF_LIBOCTAVE }, - { false, "LIBOCTINTERP", OCTAVE_CONF_LIBOCTINTERP }, - { false, "LIBS", OCTAVE_CONF_LIBS }, - { false, "LN_S", OCTAVE_CONF_LN_S }, - { false, "MAGICK_CPPFLAGS", OCTAVE_CONF_MAGICK_CPPFLAGS }, - { false, "MAGICK_LDFLAGS", OCTAVE_CONF_MAGICK_LDFLAGS }, - { false, "MAGICK_LIBS", OCTAVE_CONF_MAGICK_LIBS }, - { false, "LLVM_CPPFLAGS", OCTAVE_CONF_LLVM_CPPFLAGS }, - { false, "LLVM_LDFLAGS", OCTAVE_CONF_LLVM_LDFLAGS }, - { false, "LLVM_LIBS", OCTAVE_CONF_LLVM_LIBS }, - { false, "MKOCTFILE_DL_LDFLAGS", OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS }, - { false, "OCTAVE_LINK_DEPS", OCTAVE_CONF_OCTAVE_LINK_DEPS }, - { false, "OCTAVE_LINK_OPTS", OCTAVE_CONF_OCTAVE_LINK_OPTS }, - { false, "OCT_LINK_DEPS", OCTAVE_CONF_OCT_LINK_DEPS }, - { false, "OCT_LINK_OPTS", OCTAVE_CONF_OCT_LINK_OPTS }, - { false, "OPENGL_LIBS", OCTAVE_CONF_OPENGL_LIBS }, - { false, "PTHREAD_CFLAGS", OCTAVE_CONF_PTHREAD_CFLAGS }, - { false, "PTHREAD_LIBS", OCTAVE_CONF_PTHREAD_LIBS }, - { false, "QHULL_CPPFLAGS", OCTAVE_CONF_QHULL_CPPFLAGS }, - { false, "QHULL_LDFLAGS", OCTAVE_CONF_QHULL_LDFLAGS }, - { false, "QHULL_LIBS", OCTAVE_CONF_QHULL_LIBS }, - { false, "QRUPDATE_CPPFLAGS", OCTAVE_CONF_QRUPDATE_CPPFLAGS }, - { false, "QRUPDATE_LDFLAGS", OCTAVE_CONF_QRUPDATE_LDFLAGS }, - { false, "QRUPDATE_LIBS", OCTAVE_CONF_QRUPDATE_LIBS }, - { false, "RANLIB", OCTAVE_CONF_RANLIB }, - { false, "RDYNAMIC_FLAG", OCTAVE_CONF_RDYNAMIC_FLAG }, - { false, "READLINE_LIBS", OCTAVE_CONF_READLINE_LIBS }, - { false, "REGEX_LIBS", OCTAVE_CONF_REGEX_LIBS }, - { false, "SED", OCTAVE_CONF_SED }, - { false, "SHARED_LIBS", OCTAVE_CONF_SHARED_LIBS }, - { false, "SHLEXT", OCTAVE_CONF_SHLEXT }, - { false, "SHLEXT_VER", OCTAVE_CONF_SHLEXT_VER }, - { false, "SH_LD", OCTAVE_CONF_SH_LD }, - { false, "SH_LDFLAGS", OCTAVE_CONF_SH_LDFLAGS }, - { false, "SONAME_FLAGS", OCTAVE_CONF_SONAME_FLAGS }, - { false, "STATIC_LIBS", OCTAVE_CONF_STATIC_LIBS }, - { false, "TERM_LIBS", OCTAVE_CONF_TERM_LIBS }, - { false, "UGLY_DEFS", OCTAVE_CONF_UGLY_DEFS }, - { false, "UMFPACK_CPPFLAGS", OCTAVE_CONF_UMFPACK_CPPFLAGS }, - { false, "UMFPACK_LDFLAGS", OCTAVE_CONF_UMFPACK_LDFLAGS }, - { false, "UMFPACK_LIBS", OCTAVE_CONF_UMFPACK_LIBS }, - { false, "USE_64_BIT_IDX_T", OCTAVE_CONF_USE_64_BIT_IDX_T }, - { false, "X11_INCFLAGS", OCTAVE_CONF_X11_INCFLAGS }, - { false, "X11_LIBS", OCTAVE_CONF_X11_LIBS }, - { false, "XTRA_CFLAGS", OCTAVE_CONF_XTRA_CFLAGS }, - { false, "XTRA_CXXFLAGS", OCTAVE_CONF_XTRA_CXXFLAGS }, - { false, "YACC", OCTAVE_CONF_YACC }, - { false, "YFLAGS", OCTAVE_CONF_YFLAGS }, - { false, "Z_CPPFLAGS", OCTAVE_CONF_Z_CPPFLAGS }, - { false, "Z_LDFLAGS", OCTAVE_CONF_Z_LDFLAGS }, - { false, "Z_LIBS", OCTAVE_CONF_Z_LIBS }, - { false, "api_version", OCTAVE_API_VERSION }, - { true, "archlibdir", OCTAVE_ARCHLIBDIR }, - { true, "bindir", OCTAVE_BINDIR }, - { false, "canonical_host_type", OCTAVE_CANONICAL_HOST_TYPE }, - { false, "config_opts", OCTAVE_CONF_config_opts }, - { true, "datadir", OCTAVE_DATADIR }, - { true, "datarootdir", OCTAVE_DATAROOTDIR }, - { true, "exec_prefix", OCTAVE_EXEC_PREFIX }, - { true, "fcnfiledir", OCTAVE_FCNFILEDIR }, - { true, "imagedir", OCTAVE_IMAGEDIR }, - { true, "includedir", OCTAVE_INCLUDEDIR }, - { true, "infodir", OCTAVE_INFODIR }, - { true, "infofile", OCTAVE_INFOFILE }, - { true, "libdir", OCTAVE_LIBDIR }, - { true, "libexecdir", OCTAVE_LIBEXECDIR }, - { true, "localapiarchlibdir", OCTAVE_LOCALAPIARCHLIBDIR }, - { true, "localapifcnfiledir", OCTAVE_LOCALAPIFCNFILEDIR }, - { true, "localapioctfiledir", OCTAVE_LOCALAPIOCTFILEDIR }, - { true, "localarchlibdir", OCTAVE_LOCALARCHLIBDIR }, - { true, "localfcnfiledir", OCTAVE_LOCALFCNFILEDIR }, - { true, "localoctfiledir", OCTAVE_LOCALOCTFILEDIR }, - { true, "localstartupfiledir", OCTAVE_LOCALSTARTUPFILEDIR }, - { true, "localverarchlibdir", OCTAVE_LOCALVERARCHLIBDIR }, - { true, "localverfcnfiledir", OCTAVE_LOCALVERFCNFILEDIR }, - { true, "localveroctfiledir", OCTAVE_LOCALVEROCTFILEDIR }, - { true, "man1dir", OCTAVE_MAN1DIR }, - { false, "man1ext", OCTAVE_MAN1EXT }, - { true, "mandir", OCTAVE_MANDIR }, - { true, "octfiledir", OCTAVE_OCTFILEDIR }, - { true, "octetcdir", OCTAVE_OCTETCDIR }, - { true, "octincludedir", OCTAVE_OCTINCLUDEDIR }, - { true, "octlibdir", OCTAVE_OCTLIBDIR }, - { true, "prefix", OCTAVE_PREFIX }, - { true, "startupfiledir", OCTAVE_STARTUPFILEDIR }, - { false, "version", OCTAVE_VERSION }, - { false, 0, 0 } - }; - - if (! initialized) - { - m.assign ("dld", octave_value (octave_supports_dynamic_linking)); - - oct_mach_info::float_format ff = oct_mach_info::native_float_format (); - m.assign ("float_format", - octave_value (oct_mach_info::float_format_as_string (ff))); - - m.assign ("words_big_endian", - octave_value (oct_mach_info::words_big_endian ())); - - m.assign ("words_little_endian", - octave_value (oct_mach_info::words_little_endian ())); - - int i = 0; - - while (true) - { - const conf_info_struct& elt = conf_info[i++]; - - const char *key = elt.key; - - if (key) - { - if (elt.subst_home) - m.assign (key, subst_octave_home (elt.val)); - else - m.assign (key, elt.val); - } - else - break; - } - - bool unix_system = true; - bool mac_system = false; - bool windows_system = false; - -#if defined (WIN32) - windows_system = true; -#if !defined (__CYGWIN__) - unix_system = false; -#endif -#endif - -#if defined (OCTAVE_USE_OS_X_API) - mac_system = true; -#endif - - m.assign ("unix", octave_value (unix_system)); - m.assign ("mac", octave_value (mac_system)); - m.assign ("windows", octave_value (windows_system)); - - initialized = true; - } - - int nargin = args.length (); - - if (nargin == 1) - { - std::string arg = args(0).string_value (); - - if (! error_state) - { - Cell c = m.contents (arg.c_str ()); - - if (c.is_empty ()) - error ("octave_config_info: no info for `%s'", arg.c_str ()); - else - retval = c(0); - } - } - else if (nargin == 0) - retval = m; - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar (octave_config_info ("version"))) -%!test -%! x = octave_config_info (); -%! assert (isstruct (x)); -%! assert (! isempty (x)); - -%!error octave_config_info (1, 2) -*/ - -#if defined (__GNUG__) && defined (DEBUG_NEW_DELETE) - -int debug_new_delete = 0; - -typedef void (*vfp)(void); -extern vfp __new_handler; - -void * -__builtin_new (size_t sz) -{ - void *p; - - /* malloc (0) is unpredictable; avoid it. */ - if (sz == 0) - sz = 1; - p = malloc (sz); - while (p == 0) - { - (*__new_handler) (); - p = malloc (sz); - } - - if (debug_new_delete) - std::cerr << "__builtin_new: " << p << std::endl; - - return p; -} - -void -__builtin_delete (void *ptr) -{ - if (debug_new_delete) - std::cerr << "__builtin_delete: " << ptr << std::endl; - - if (ptr) - free (ptr); -} - -#endif diff -r d02b229ce693 -r a132d206a36a src/toplev.h --- a/src/toplev.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,455 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_toplev_h) -#define octave_toplev_h 1 - -#include - -#include -#include - -class octave_value; -class octave_value_list; -class octave_function; -class octave_user_script; -class tree_statement; -class tree_statement_list; -class charMatrix; - -#include "quit.h" - -#include "input.h" -#include "oct-map.h" - - -typedef void (*octave_exit_func) (int); -extern OCTINTERP_API octave_exit_func octave_exit; - -extern OCTINTERP_API bool quit_allowed; - -extern OCTINTERP_API bool quitting_gracefully; - -extern OCTINTERP_API int exit_status; - -extern OCTINTERP_API void -clean_up_and_exit (int); - -extern OCTINTERP_API void recover_from_exception (void); - -extern OCTINTERP_API int main_loop (void); - -extern OCTINTERP_API void -do_octave_atexit (void); - -extern OCTINTERP_API void -octave_add_atexit_function (const std::string& fname); - -extern OCTINTERP_API bool -octave_remove_atexit_function (const std::string& fname); - -// Current command to execute. -extern OCTINTERP_API tree_statement_list *global_command; - -// TRUE means we are ready to interpret commands, but not everything -// is ready for interactive use. -extern OCTINTERP_API bool octave_interpreter_ready; - -// TRUE means we've processed all the init code and we are good to go. -extern OCTINTERP_API bool octave_initialized; - -class -OCTINTERP_API -octave_call_stack -{ -private: - - struct call_stack_elt - { - call_stack_elt (octave_function *f, symbol_table::scope_id s, - symbol_table::context_id c, size_t p = 0) - : fcn (f), stmt (0), scope (s), context (c), prev (p) { } - - call_stack_elt (const call_stack_elt& elt) - : fcn (elt.fcn), stmt (elt.stmt), scope (elt.scope), - context (elt.context), prev (elt.prev) { } - - octave_function *fcn; - tree_statement *stmt; - symbol_table::scope_id scope; - symbol_table::context_id context; - size_t prev; - }; - -protected: - - octave_call_stack (void) : cs (), curr_frame (0) { } - -public: - - typedef std::deque::iterator iterator; - typedef std::deque::const_iterator const_iterator; - - typedef std::deque::reverse_iterator reverse_iterator; - typedef std::deque::const_reverse_iterator const_reverse_iterator; - - static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create call stack object!"); - - retval = false; - } - - return retval; - } - - // Current function (top of stack). - static octave_function *current (void) - { - return instance_ok () ? instance->do_current () : 0; - } - - // Current statement (top of stack). - static tree_statement *current_statement (void) - { - return instance_ok () ? instance->do_current_statement () : 0; - } - - // Current line in current function. - static int current_line (void) - { - return instance_ok () ? instance->do_current_line () : -1; - } - - // Current column in current function. - static int current_column (void) - { - return instance_ok () ? instance->do_current_column () : -1; - } - - // Line in user code caller. - static int caller_user_code_line (void) - { - return instance_ok () ? instance->do_caller_user_code_line () : -1; - } - - // Column in user code caller. - static int caller_user_code_column (void) - { - return instance_ok () ? instance->do_caller_user_code_column () : -1; - } - - // Caller function, may be built-in. - static octave_function *caller (void) - { - return instance_ok () ? instance->do_caller () : 0; - } - - static size_t current_frame (void) - { - return instance_ok () ? instance->do_current_frame () : 0; - } - - static size_t size (void) - { - return instance_ok () ? instance->do_size () : 0; - } - - static size_t num_user_code_frames (octave_idx_type& curr_user_frame) - { - return instance_ok () - ? instance->do_num_user_code_frames (curr_user_frame) : 0; - } - - static symbol_table::scope_id current_scope (void) - { - return instance_ok () ? instance->do_current_scope () : 0; - } - - static symbol_table::context_id current_context (void) - { - return instance_ok () ? instance->do_current_context () : 0; - } - - // Function at location N on the call stack (N == 0 is current), may - // be built-in. - static octave_function *element (size_t n) - { - return instance_ok () ? instance->do_element (n) : 0; - } - - // First user-defined function on the stack. - static octave_user_code *caller_user_code (size_t nskip = 0) - { - return instance_ok () ? instance->do_caller_user_code (nskip) : 0; - } - - static void - push (octave_function *f, - symbol_table::scope_id scope = symbol_table::current_scope (), - symbol_table::context_id context = symbol_table::current_context ()) - { - if (instance_ok ()) - instance->do_push (f, scope, context); - } - - static void - push (symbol_table::scope_id scope = symbol_table::current_scope (), - symbol_table::context_id context = symbol_table::current_context ()) - { - if (instance_ok ()) - instance->do_push (0, scope, context); - } - - static void set_statement (tree_statement *s) - { - if (instance_ok ()) - instance->do_set_statement (s); - } - - static bool goto_frame (size_t n = 0, bool verbose = false) - { - return instance_ok () ? instance->do_goto_frame (n, verbose) : false; - } - - static void restore_frame (size_t n) - { - goto_frame (n); - } - - static bool goto_frame_relative (int n, bool verbose = false) - { - return instance_ok () - ? instance->do_goto_frame_relative (n, verbose) : false; - } - - static void goto_caller_frame (void) - { - if (instance_ok ()) - instance->do_goto_caller_frame (); - } - - static void goto_base_frame (void) - { - if (instance_ok ()) - instance->do_goto_base_frame (); - } - - static octave_map backtrace (size_t nskip, octave_idx_type& curr_user_frame) - { - return instance_ok () - ? instance->do_backtrace (nskip, curr_user_frame) : octave_map (); - } - - static octave_map empty_backtrace (void); - - static void pop (void) - { - if (instance_ok ()) - instance->do_pop (); - } - - static void clear (void) - { - if (instance_ok ()) - instance->do_clear (); - } - - static void backtrace_error_message (void) - { - if (instance_ok ()) - instance->do_backtrace_error_message (); - } - -private: - - // The current call stack. - std::deque cs; - - size_t curr_frame; - - static octave_call_stack *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - int do_current_line (void) const; - - int do_current_column (void) const; - - int do_caller_user_code_line (void) const; - - int do_caller_user_code_column (void) const; - - octave_function *do_caller (void) const - { - return curr_frame > 1 ? cs[curr_frame-1].fcn : cs[0].fcn; - } - - size_t do_current_frame (void) { return curr_frame; } - - size_t do_size (void) { return cs.size (); } - - size_t do_num_user_code_frames (octave_idx_type& curr_user_frame) const; - - symbol_table::scope_id do_current_scope (void) const - { - return curr_frame > 0 && curr_frame < cs.size () - ? cs[curr_frame].scope : 0; - } - - symbol_table::context_id do_current_context (void) const - { - return curr_frame > 0 && curr_frame < cs.size () - ? cs[curr_frame].context : 0; - } - - octave_function *do_element (size_t n) - { - octave_function *retval = 0; - - if (cs.size () > n) - { - call_stack_elt& elt = cs[n]; - retval = elt.fcn; - } - - return retval; - } - - octave_user_code *do_caller_user_code (size_t nskip) const; - - void do_push (octave_function *f, symbol_table::scope_id scope, - symbol_table::context_id context) - { - size_t prev_frame = curr_frame; - curr_frame = cs.size (); - cs.push_back (call_stack_elt (f, scope, context, prev_frame)); - symbol_table::set_scope_and_context (scope, context); - } - - octave_function *do_current (void) const - { - octave_function *retval = 0; - - if (! cs.empty ()) - { - const call_stack_elt& elt = cs[curr_frame]; - retval = elt.fcn; - } - - return retval; - } - - tree_statement *do_current_statement (void) const - { - tree_statement *retval = 0; - - if (! cs.empty ()) - { - const call_stack_elt& elt = cs[curr_frame]; - retval = elt.stmt; - } - - return retval; - } - - void do_set_statement (tree_statement *s) - { - if (! cs.empty ()) - { - call_stack_elt& elt = cs.back (); - elt.stmt = s; - } - } - - octave_map do_backtrace (size_t nskip, - octave_idx_type& curr_user_frame) const; - - bool do_goto_frame (size_t n, bool verbose); - - bool do_goto_frame_relative (int n, bool verbose); - - void do_goto_caller_frame (void); - - void do_goto_base_frame (void); - - void do_pop (void) - { - if (cs.size () > 1) - { - const call_stack_elt& elt = cs.back (); - curr_frame = elt.prev; - cs.pop_back (); - const call_stack_elt& new_elt = cs[curr_frame]; - symbol_table::set_scope_and_context (new_elt.scope, new_elt.context); - } - } - - void do_clear (void) { cs.clear (); } - - void do_backtrace_error_message (void) const; -}; - -// Call a function with exceptions handled to avoid problems with -// errors while shutting down. - -#define OCTAVE_IGNORE_EXCEPTION(E) \ - catch (E) \ - { \ - std::cerr << "error: ignoring " #E " while preparing to exit" << std::endl; \ - recover_from_exception (); \ - } - -#define OCTAVE_SAFE_CALL(F, ARGS) \ - do \ - { \ - try \ - { \ - unwind_protect frame; \ - \ - frame.protect_var (Vdebug_on_error); \ - frame.protect_var (Vdebug_on_warning); \ - \ - Vdebug_on_error = false; \ - Vdebug_on_warning = false; \ - \ - F ARGS; \ - } \ - OCTAVE_IGNORE_EXCEPTION (octave_interrupt_exception) \ - OCTAVE_IGNORE_EXCEPTION (octave_execution_exception) \ - OCTAVE_IGNORE_EXCEPTION (std::bad_alloc) \ - \ - if (error_state) \ - error_state = 0; \ - } \ - while (0) - -#endif diff -r d02b229ce693 -r a132d206a36a src/utils.cc --- a/src/utils.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1432 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include - -#include -#include - -#include "vasnprintf.h" - -#include "quit.h" - -#include "dir-ops.h" -#include "file-ops.h" -#include "file-stat.h" -#include "lo-mappers.h" -#include "lo-utils.h" -#include "oct-cmplx.h" -#include "oct-env.h" -#include "pathsearch.h" -#include "str-vec.h" - -#include "Cell.h" -#include -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "lex.h" -#include "load-path.h" -#include "oct-errno.h" -#include "oct-hist.h" -#include "oct-obj.h" -#include "ov-range.h" -#include "pager.h" -#include "parse.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Return TRUE if S is a valid identifier. - -bool -valid_identifier (const char *s) -{ - if (! s || ! (isalpha (*s) || *s == '_' || *s == '$')) - return false; - - while (*++s != '\0') - if (! (isalnum (*s) || *s == '_' || *s == '$')) - return false; - - return true; -} - -bool -valid_identifier (const std::string& s) -{ - return valid_identifier (s.c_str ()); -} - -DEFUN (isvarname, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isvarname (@var{name})\n\ -Return true if @var{name} is a valid variable name.\n\ -@seealso{iskeyword, exist, who}\n\ -@end deftypefn") -{ - octave_value retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("isvarname"); - - if (error_state) - return retval; - - if (argc == 2) - retval = valid_identifier (argv[1]) && ! is_keyword (argv[1]); - else - print_usage (); - - return retval; -} - -/* -%!assert (isvarname ("foo"), true) -%!assert (isvarname ("_foo"), true) -%!assert (isvarname ("_1"), true) -%!assert (isvarname ("1foo"), false) -%!assert (isvarname (""), false) - -%!error isvarname () -%!error isvarname ("foo", "bar"); -*/ - -// Return TRUE if F and G are both names for the same file. - -bool -same_file (const std::string& f, const std::string& g) -{ - return same_file_internal (f, g); -} - -int -almost_match (const std::string& std, const std::string& s, int min_match_len, - int case_sens) -{ - int stdlen = std.length (); - int slen = s.length (); - - return (slen <= stdlen - && slen >= min_match_len - && (case_sens - ? (strncmp (std.c_str (), s.c_str (), slen) == 0) - : (octave_strncasecmp (std.c_str (), s.c_str (), slen) == 0))); -} - -// Ugh. - -int -keyword_almost_match (const char * const *std, int *min_len, const std::string& s, - int min_toks_to_match, int max_toks) -{ - int status = 0; - int tok_count = 0; - int toks_matched = 0; - - if (s.empty () || max_toks < 1) - return status; - - char *kw = strsave (s.c_str ()); - - char *t = kw; - while (*t != '\0') - { - if (*t == '\t') - *t = ' '; - t++; - } - - char *beg = kw; - while (*beg == ' ') - beg++; - - if (*beg == '\0') - return status; - - - const char **to_match = new const char * [max_toks + 1]; - const char * const *s1 = std; - const char **s2 = to_match; - - if (! s1 || ! s2) - goto done; - - s2[tok_count] = beg; - char *end; - while ((end = strchr (beg, ' ')) != 0) - { - *end = '\0'; - beg = end + 1; - - while (*beg == ' ') - beg++; - - if (*beg == '\0') - break; - - tok_count++; - if (tok_count >= max_toks) - goto done; - - s2[tok_count] = beg; - } - s2[tok_count+1] = 0; - - s2 = to_match; - - for (;;) - { - if (! almost_match (*s1, *s2, min_len[toks_matched], 0)) - goto done; - - toks_matched++; - - s1++; - s2++; - - if (! *s2) - { - status = (toks_matched >= min_toks_to_match); - goto done; - } - - if (! *s1) - goto done; - } - - done: - - delete [] kw; - delete [] to_match; - - return status; -} - -// Return non-zero if either NR or NC is zero. Return -1 if this -// should be considered fatal; return 1 if this is ok. - -int -empty_arg (const char * /* name */, octave_idx_type nr, octave_idx_type nc) -{ - return (nr == 0 || nc == 0); -} - -// See if the given file is in the path. - -std::string -search_path_for_file (const std::string& path, const string_vector& names) -{ - dir_path p (path); - - return octave_env::make_absolute (p.find_first_of (names)); -} - -// Find all locations of the given file in the path. - -string_vector -search_path_for_all_files (const std::string& path, const string_vector& names) -{ - dir_path p (path); - - string_vector sv = p.find_all_first_of (names); - - octave_idx_type len = sv.length (); - - for (octave_idx_type i = 0; i < len; i++) - sv[i] = octave_env::make_absolute (sv[i]); - - return sv; -} - -static string_vector -make_absolute (const string_vector& sv) -{ - octave_idx_type len = sv.length (); - - string_vector retval (len); - - for (octave_idx_type i = 0; i < len; i++) - retval[i] = octave_env::make_absolute (sv[i]); - - return retval; -} - -DEFUN (file_in_loadpath, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} file_in_loadpath (@var{file})\n\ -@deftypefnx {Built-in Function} {} file_in_loadpath (@var{file}, \"all\")\n\ -\n\ -Return the absolute name of @var{file} if it can be found in\n\ -the list of directories specified by @code{path}.\n\ -If no file is found, return an empty character string.\n\ -\n\ -If the first argument is a cell array of strings, search each\n\ -directory of the loadpath for element of the cell array and return\n\ -the first that matches.\n\ -\n\ -If the second optional argument @code{\"all\"} is supplied, return\n\ -a cell array containing the list of all files that have the same\n\ -name in the path. If no files are found, return an empty cell array.\n\ -@seealso{file_in_path, path}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - string_vector names = args(0).all_strings (); - - if (! error_state && names.length () > 0) - { - if (nargin == 1) - retval = octave_env::make_absolute (load_path::find_first_of (names)); - else if (nargin == 2) - { - std::string opt = args(1).string_value (); - - if (! error_state && opt == "all") - retval = Cell (make_absolute - (load_path::find_all_first_of (names))); - else - error ("file_in_loadpath: invalid option"); - } - } - else - error ("file_in_loadpath: FILE argument must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! f = file_in_loadpath ("plot.m"); -%! assert (ischar (f)); -%! assert (! isempty (f)); - -%!test -%! f = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$"); -%! assert (f, ""); - -%!test -%! lst = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$", "all"); -%! assert (lst, {}); - -%!error file_in_loadpath () -%!error file_in_loadpath ("foo", "bar", 1) -*/ - -DEFUN (file_in_path, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} file_in_path (@var{path}, @var{file})\n\ -@deftypefnx {Built-in Function} {} file_in_path (@var{path}, @var{file}, \"all\")\n\ -Return the absolute name of @var{file} if it can be found in\n\ -@var{path}. The value of @var{path} should be a colon-separated list of\n\ -directories in the format described for @code{path}. If no file\n\ -is found, return an empty character string. For example:\n\ -\n\ -@example\n\ -@group\n\ -file_in_path (EXEC_PATH, \"sh\")\n\ - @result{} \"/bin/sh\"\n\ -@end group\n\ -@end example\n\ -\n\ -If the second argument is a cell array of strings, search each\n\ -directory of the path for element of the cell array and return\n\ -the first that matches.\n\ -\n\ -If the third optional argument @code{\"all\"} is supplied, return\n\ -a cell array containing the list of all files that have the same\n\ -name in the path. If no files are found, return an empty cell array.\n\ -@seealso{file_in_loadpath}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - std::string path = args(0).string_value (); - - if (! error_state) - { - string_vector names = args(1).all_strings (); - - if (! error_state && names.length () > 0) - { - if (nargin == 2) - retval = search_path_for_file (path, names); - else if (nargin == 3) - { - std::string opt = args(2).string_value (); - - if (! error_state && opt == "all") - retval = Cell (make_absolute - (search_path_for_all_files (path, names))); - else - error ("file_in_path: invalid option"); - } - } - else - error ("file_in_path: all arguments must be strings"); - } - else - error ("file_in_path: PATH must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! f = file_in_path (path (), "plot.m"); -%! assert (ischar (f)); -%! assert (! isempty (f)); - -%!test -%! f = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$"); -%! assert (f, ""); - -%!test -%! lst = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$", "all"); -%! assert (lst, {}); - -%!error file_in_path () -%!error file_in_path ("foo") -%!error file_in_path ("foo", "bar", "baz", 1) -*/ - -std::string -file_in_path (const std::string& name, const std::string& suffix) -{ - std::string nm = name; - - if (! suffix.empty ()) - nm.append (suffix); - - return octave_env::make_absolute (load_path::find_file (nm)); -} - -// See if there is an function file in the path. If so, return the -// full path to the file. - -std::string -fcn_file_in_path (const std::string& name) -{ - std::string retval; - - int len = name.length (); - - if (len > 0) - { - if (octave_env::absolute_pathname (name)) - { - file_stat fs (name); - - if (fs.exists ()) - retval = name; - } - else if (len > 2 && name[len - 2] == '.' && name[len - 1] == 'm') - retval = load_path::find_fcn_file (name.substr (0, len-2)); - else - { - std::string fname = name; - size_t pos = name.find_first_of (Vfilemarker); - if (pos != std::string::npos) - fname = name.substr (0, pos); - - retval = load_path::find_fcn_file (fname); - } - } - - return retval; -} - -// See if there is a directory called "name" in the path and if it -// contains a Contents.m file return the full path to this file. - -std::string -contents_file_in_path (const std::string& dir) -{ - std::string retval; - - if (dir.length () > 0) - { - std::string tcontents = file_ops::concat (load_path::find_dir (dir), - std::string ("Contents.m")); - - file_stat fs (tcontents); - - if (fs.exists ()) - retval = octave_env::make_absolute (tcontents); - } - - return retval; -} - -// See if there is a .oct file in the path. If so, return the -// full path to the file. - -std::string -oct_file_in_path (const std::string& name) -{ - std::string retval; - - int len = name.length (); - - if (len > 0) - { - if (octave_env::absolute_pathname (name)) - { - file_stat fs (name); - - if (fs.exists ()) - retval = name; - } - else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'o' - && name[len - 2] == 'c' && name[len - 1] == 't') - retval = load_path::find_oct_file (name.substr (0, len-4)); - else - retval = load_path::find_oct_file (name); - } - - return retval; -} - -// See if there is a .mex file in the path. If so, return the -// full path to the file. - -std::string -mex_file_in_path (const std::string& name) -{ - std::string retval; - - int len = name.length (); - - if (len > 0) - { - if (octave_env::absolute_pathname (name)) - { - file_stat fs (name); - - if (fs.exists ()) - retval = name; - } - else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'm' - && name[len - 2] == 'e' && name[len - 1] == 'x') - retval = load_path::find_mex_file (name.substr (0, len-4)); - else - retval = load_path::find_mex_file (name); - } - - return retval; -} - -// Replace backslash escapes in a string with the real values. - -std::string -do_string_escapes (const std::string& s) -{ - std::string retval; - - size_t i = 0; - size_t j = 0; - size_t len = s.length (); - - retval.resize (len); - - while (j < len) - { - if (s[j] == '\\' && j+1 < len) - { - switch (s[++j]) - { - case '0': - retval[i] = '\0'; - break; - - case 'a': - retval[i] = '\a'; - break; - - case 'b': // backspace - retval[i] = '\b'; - break; - - case 'f': // formfeed - retval[i] = '\f'; - break; - - case 'n': // newline - retval[i] = '\n'; - break; - - case 'r': // carriage return - retval[i] = '\r'; - break; - - case 't': // horizontal tab - retval[i] = '\t'; - break; - - case 'v': // vertical tab - retval[i] = '\v'; - break; - - case '\\': // backslash - retval[i] = '\\'; - break; - - case '\'': // quote - retval[i] = '\''; - break; - - case '"': // double quote - retval[i] = '"'; - break; - - default: - warning ("unrecognized escape sequence `\\%c' --\ - converting to `%c'", s[j], s[j]); - retval[i] = s[j]; - break; - } - } - else - { - retval[i] = s[j]; - } - - i++; - j++; - } - - retval.resize (i); - - return retval; -} - -DEFUN (do_string_escapes, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} do_string_escapes (@var{string})\n\ -Convert special characters in @var{string} to their escaped forms.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - retval = do_string_escapes (args(0).string_value ()); - else - error ("do_string_escapes: STRING argument must be of type string"); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (do_string_escapes ('foo\nbar'), "foo\nbar") -%!assert (do_string_escapes ("foo\\nbar"), "foo\nbar") -%!assert (do_string_escapes ("foo\\nbar"), ["foo", char(10), "bar"]) -%!assert ("foo\nbar", ["foo", char(10), "bar"]) - -%!assert (do_string_escapes ('\a\b\f\n\r\t\v'), "\a\b\f\n\r\t\v") -%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), "\a\b\f\n\r\t\v") -%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), -%! char ([7, 8, 12, 10, 13, 9, 11])) -%!assert ("\a\b\f\n\r\t\v", char ([7, 8, 12, 10, 13, 9, 11])) - -%!error do_string_escapes () -%!error do_string_escapes ("foo", "bar") -*/ - -const char * -undo_string_escape (char c) -{ - if (! c) - return ""; - - switch (c) - { - case '\0': - return "\\0"; - - case '\a': - return "\\a"; - - case '\b': // backspace - return "\\b"; - - case '\f': // formfeed - return "\\f"; - - case '\n': // newline - return "\\n"; - - case '\r': // carriage return - return "\\r"; - - case '\t': // horizontal tab - return "\\t"; - - case '\v': // vertical tab - return "\\v"; - - case '\\': // backslash - return "\\\\"; - - case '"': // double quote - return "\\\""; - - default: - { - static char retval[2]; - retval[0] = c; - retval[1] = '\0'; - return retval; - } - } -} - -std::string -undo_string_escapes (const std::string& s) -{ - std::string retval; - - for (size_t i = 0; i < s.length (); i++) - retval.append (undo_string_escape (s[i])); - - return retval; -} - -DEFUN (undo_string_escapes, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} undo_string_escapes (@var{s})\n\ -Convert special characters in strings back to their escaped forms. For\n\ -example, the expression\n\ -\n\ -@example\n\ -bell = \"\\a\";\n\ -@end example\n\ -\n\ -@noindent\n\ -assigns the value of the alert character (control-g, ASCII code 7) to\n\ -the string variable @code{bell}. If this string is printed, the\n\ -system will ring the terminal bell (if it is possible). This is\n\ -normally the desired outcome. However, sometimes it is useful to be\n\ -able to print the original representation of the string, with the\n\ -special characters replaced by their escape sequences. For example,\n\ -\n\ -@example\n\ -@group\n\ -octave:13> undo_string_escapes (bell)\n\ -ans = \\a\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -replaces the unprintable alert character with its printable\n\ -representation.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - retval = undo_string_escapes (args(0).string_value ()); - else - error ("undo_string_escapes: S argument must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (undo_string_escapes ("foo\nbar"), 'foo\nbar') -%!assert (undo_string_escapes ("foo\nbar"), "foo\\nbar") -%!assert (undo_string_escapes (["foo", char(10), "bar"]), "foo\\nbar") - -%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), '\a\b\f\n\r\t\v') -%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), "\\a\\b\\f\\n\\r\\t\\v") -%!assert (undo_string_escapes (char ([7, 8, 12, 10, 13, 9, 11])), -%! "\\a\\b\\f\\n\\r\\t\\v") - -%!error undo_string_escapes () -%!error undo_string_escapes ("foo", "bar") -*/ - -DEFUN (is_absolute_filename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} is_absolute_filename (@var{file})\n\ -Return true if @var{file} is an absolute filename.\n\ -@seealso{is_rooted_relative_filename, make_absolute_filename, isdir}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - retval = (args(0).is_string () - && octave_env::absolute_pathname (args(0).string_value ())); - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error is_absolute_filename () -%!error is_absolute_filename ("foo", "bar") -*/ - -DEFUN (is_rooted_relative_filename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} is_rooted_relative_filename (@var{file})\n\ -Return true if @var{file} is a rooted-relative filename.\n\ -@seealso{is_absolute_filename, make_absolute_filename, isdir}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - retval = (args(0).is_string () - && octave_env::rooted_relative_pathname (args(0).string_value ())); - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error is_rooted_relative_filename () -%!error is_rooted_relative_filename ("foo", "bar") -*/ - -DEFUN (make_absolute_filename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} make_absolute_filename (@var{file})\n\ -Return the full name of @var{file} beginning from the root of the file\n\ -system. No check is done for the existence of @var{file}.\n\ -@seealso{canonicalize_file_name, is_absolute_filename, is_rooted_relative_filename, isdir}\n\ -@end deftypefn") -{ - octave_value retval = std::string (); - - if (args.length () == 1) - { - std::string nm = args(0).string_value (); - - if (! error_state) - retval = octave_env::make_absolute (nm); - else - error ("make_absolute_filename: FILE argument must be a file name"); - } - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error make_absolute_filename () -%!error make_absolute_filename ("foo", "bar") -*/ - -DEFUN (find_dir_in_path, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} find_dir_in_path (@var{dir})\n\ -@deftypefnx {Built-in Function} {} find_dir_in_path (@var{dir}, \"all\")\n\ -Return the full name of the path element matching @var{dir}. The\n\ -match is performed at the end of each path element. For example, if\n\ -@var{dir} is @code{\"foo/bar\"}, it matches the path element\n\ -@code{\"/some/dir/foo/bar\"}, but not @code{\"/some/dir/foo/bar/baz\"}\n\ -or @code{\"/some/dir/allfoo/bar\"}.\n\ -\n\ -The second argument is optional. If it is supplied, return a cell array\n\ -containing all name matches rather than just the first.\n\ -@end deftypefn") -{ - octave_value retval = std::string (); - - int nargin = args.length (); - - std::string dir; - - if (nargin == 1 || nargin == 2) - { - dir = args(0).string_value (); - - if (! error_state) - { - if (nargin == 1) - retval = load_path::find_dir (dir); - else if (nargin == 2) - retval = Cell (load_path::find_matching_dirs (dir)); - } - else - error ("find_dir_in_path: DIR must be a directory name"); - } - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error find_dir_in_path () -%!error find_dir_in_path ("foo", "bar", 1) -*/ - -DEFUNX ("errno", Ferrno, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{err} =} errno ()\n\ -@deftypefnx {Built-in Function} {@var{err} =} errno (@var{val})\n\ -@deftypefnx {Built-in Function} {@var{err} =} errno (@var{name})\n\ -Return the current value of the system-dependent variable errno,\n\ -set its value to @var{val} and return the previous value, or return\n\ -the named error code given @var{name} as a character string, or -1\n\ -if @var{name} is not found.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - std::string nm = args(0).string_value (); - - if (! error_state) - retval = octave_errno::lookup (nm); - else - error ("errno: expecting character string argument"); - } - else - { - int val = args(0).int_value (); - - if (! error_state) - retval = octave_errno::set (val); - else - error ("errno: expecting integer argument"); - } - } - else if (nargin == 0) - retval = octave_errno::get (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isnumeric (errno ())) - -%!test -%! lst = errno_list (); -%! fns = fieldnames (lst); -%! oldval = errno (fns{1}); -%! assert (isnumeric (oldval)); -%! errno (oldval); -%! newval = errno (); -%! assert (oldval, newval); - -%!error errno ("foo", 1) -*/ - -DEFUN (errno_list, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} errno_list ()\n\ -Return a structure containing the system-dependent errno values.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = octave_errno::list (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isstruct (errno_list ())) - -%!error errno_list ("foo") -*/ - -static void -check_dimensions (octave_idx_type& nr, octave_idx_type& nc, const char *warnfor) -{ - if (nr < 0 || nc < 0) - { - warning_with_id ("Octave:neg-dim-as-zero", - "%s: converting negative dimension to zero", warnfor); - - nr = (nr < 0) ? 0 : nr; - nc = (nc < 0) ? 0 : nc; - } -} - -void -check_dimensions (dim_vector& dim, const char *warnfor) -{ - bool neg = false; - - for (int i = 0; i < dim.length (); i++) - { - if (dim(i) < 0) - { - dim(i) = 0; - neg = true; - } - } - - if (neg) - warning_with_id ("Octave:neg-dim-as-zero", - "%s: converting negative dimension to zero", warnfor); -} - - -void -get_dimensions (const octave_value& a, const char *warn_for, - dim_vector& dim) -{ - if (a.is_scalar_type ()) - { - dim.resize (2); - dim(0) = a.int_value (); - dim(1) = dim(0); - } - else - { - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.columns (); - - if (nr == 1 || nc == 1) - { - Array v = a.vector_value (); - - if (error_state) - return; - - octave_idx_type n = v.length (); - dim.resize (n); - for (octave_idx_type i = 0; i < n; i++) - dim(i) = static_cast (fix (v(i))); - } - else - error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); - } - - if (! error_state) - check_dimensions (dim, warn_for); // May set error_state. -} - - -void -get_dimensions (const octave_value& a, const char *warn_for, - octave_idx_type& nr, octave_idx_type& nc) -{ - if (a.is_scalar_type ()) - { - nr = nc = a.int_value (); - } - else - { - nr = a.rows (); - nc = a.columns (); - - if ((nr == 1 && nc == 2) || (nr == 2 && nc == 1)) - { - Array v = a.vector_value (); - - if (error_state) - return; - - nr = static_cast (fix (v (0))); - nc = static_cast (fix (v (1))); - } - else - error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); - } - - if (! error_state) - check_dimensions (nr, nc, warn_for); // May set error_state. -} - -void -get_dimensions (const octave_value& a, const octave_value& b, - const char *warn_for, octave_idx_type& nr, octave_idx_type& nc) -{ - nr = a.is_empty () ? 0 : a.int_value (); - nc = b.is_empty () ? 0 : b.int_value (); - - if (error_state) - error ("%s: expecting two scalar arguments", warn_for); - else - check_dimensions (nr, nc, warn_for); // May set error_state. -} - -octave_idx_type -dims_to_numel (const dim_vector& dims, const octave_value_list& idx) -{ - octave_idx_type retval; - - octave_idx_type len = idx.length (); - - if (len == 0) - retval = dims.numel (); - else - { - const dim_vector dv = dims.redim (len); - retval = 1; - for (octave_idx_type i = 0; i < len; i++) - { - octave_value idxi = idx(i); - if (idxi.is_magic_colon ()) - retval *= dv(i); - else if (idxi.is_numeric_type ()) - retval *= idxi.numel (); - else - { - idx_vector jdx = idxi.index_vector (); - if (error_state) - break; - retval *= jdx.length (dv(i)); - } - } - } - - return retval; -} - -Matrix -identity_matrix (octave_idx_type nr, octave_idx_type nc) -{ - Matrix m (nr, nc, 0.0); - - if (nr > 0 && nc > 0) - { - octave_idx_type n = std::min (nr, nc); - - for (octave_idx_type i = 0; i < n; i++) - m (i, i) = 1.0; - } - - return m; -} - -FloatMatrix -float_identity_matrix (octave_idx_type nr, octave_idx_type nc) -{ - FloatMatrix m (nr, nc, 0.0); - - if (nr > 0 && nc > 0) - { - octave_idx_type n = std::min (nr, nc); - - for (octave_idx_type i = 0; i < n; i++) - m (i, i) = 1.0; - } - - return m; -} - -size_t -octave_format (std::ostream& os, const char *fmt, ...) -{ - size_t retval; - - va_list args; - va_start (args, fmt); - - retval = octave_vformat (os, fmt, args); - - va_end (args); - - return retval; -} - -size_t -octave_vformat (std::ostream& os, const char *fmt, va_list args) -{ - std::string s = octave_vasprintf (fmt, args); - - os << s; - - return s.length (); -} - -std::string -octave_vasprintf (const char *fmt, va_list args) -{ - std::string retval; - - char *result; - - int status = gnulib::vasprintf (&result, fmt, args); - - if (status >= 0) - { - retval = result; - ::free (result); - } - - return retval; -} - -std::string -octave_asprintf (const char *fmt, ...) -{ - std::string retval; - - va_list args; - va_start (args, fmt); - - retval = octave_vasprintf (fmt, args); - - va_end (args); - - return retval; -} - -void -octave_sleep (double seconds) -{ - if (seconds > 0) - { - double t; - - unsigned int usec - = static_cast (modf (seconds, &t) * 1000000); - - unsigned int sec - = (t > UINT_MAX) ? UINT_MAX : static_cast (t); - - // Versions of these functions that accept unsigned int args are - // defined in cutils.c. - octave_sleep (sec); - octave_usleep (usec); - - octave_quit (); - } -} - -DEFUN (isindex, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isindex (@var{ind})\n\ -@deftypefnx {Built-in Function} {} isindex (@var{ind}, @var{n})\n\ -Return true if @var{ind} is a valid index. Valid indices are\n\ -either positive integers (although possibly of real data type), or logical\n\ -arrays. If present, @var{n} specifies the maximum extent of the dimension\n\ -to be indexed. When possible the internal result is cached so that\n\ -subsequent indexing using @var{ind} will not perform the check again.\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - octave_idx_type n = 0; - - if (nargin == 2) - n = args(1).idx_type_value (); - else if (nargin != 1) - print_usage (); - - if (! error_state) - { - unwind_protect frame; - - frame.protect_var (Vallow_noninteger_range_as_index); - Vallow_noninteger_range_as_index = false; - - frame.protect_var (error_state); - - frame.protect_var (discard_error_messages); - discard_error_messages = true; - - try - { - idx_vector idx = args(0).index_vector (); - if (! error_state) - { - if (nargin == 2) - retval = idx.extent (n) <= n; - else - retval = true; - } - else - retval = false; - } - catch (octave_execution_exception) - { - retval = false; - } - } - - return retval; -} - -/* -%!assert (isindex ([1, 2, 3])) -%!assert (isindex (1:3)) -%!assert (isindex ([1, 2, -3]), false) - -%!error isindex () -*/ - -octave_value_list -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args, - int nargout) -{ - octave_value_list new_args = args, retval; - int nargin = args.length (); - OCTAVE_LOCAL_BUFFER (bool, iscell, nargin); - OCTAVE_LOCAL_BUFFER (Cell, cells, nargin); - OCTAVE_LOCAL_BUFFER (Cell, rcells, nargout); - - const Cell *ccells = cells; - - octave_idx_type numel = 1; - dim_vector dims (1, 1); - - for (int i = 0; i < nargin; i++) - { - octave_value arg = new_args(i); - iscell[i] = arg.is_cell (); - if (iscell[i]) - { - cells[i] = arg.cell_value (); - octave_idx_type n = ccells[i].numel (); - if (n == 1) - { - iscell[i] = false; - new_args(i) = ccells[i](0); - } - else if (numel == 1) - { - numel = n; - dims = ccells[i].dims (); - } - else if (dims != ccells[i].dims ()) - { - error ("%s: cell arguments must have matching sizes", fun_name); - break; - } - } - } - - if (! error_state) - { - for (int i = 0; i < nargout; i++) - rcells[i].clear (dims); - - for (octave_idx_type j = 0; j < numel; j++) - { - for (int i = 0; i < nargin; i++) - if (iscell[i]) - new_args(i) = ccells[i](j); - - octave_quit (); - - const octave_value_list tmp = fun (new_args, nargout); - - if (tmp.length () < nargout) - { - error ("%s: do_simple_cellfun: internal error", fun_name); - break; - } - else - { - for (int i = 0; i < nargout; i++) - rcells[i](j) = tmp(i); - } - } - } - - if (! error_state) - { - retval.resize (nargout); - for (int i = 0; i < nargout; i++) - retval(i) = rcells[i]; - } - - return retval; -} - -octave_value -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args) -{ - octave_value retval; - const octave_value_list tmp = do_simple_cellfun (fun, fun_name, args, 1); - if (tmp.length () > 0) - retval = tmp(0); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/utils.h --- a/src/utils.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,130 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_utils_h) -#define octave_utils_h 1 - -#include - -#include -#include -#include - -#include "dMatrix.h" -#include "lo-utils.h" - -#include "cutils.h" - -class octave_value; -class octave_value_list; -class string_vector; - -extern OCTINTERP_API bool valid_identifier (const char *s); -extern OCTINTERP_API bool valid_identifier (const std::string& s); - -extern OCTINTERP_API bool -same_file (const std::string& f, const std::string& g); - -extern OCTINTERP_API int almost_match (const std::string& std, - const std::string& s, - int min_match_len = 1, - int case_sens = 1); - -extern OCTINTERP_API int -keyword_almost_match (const char * const *std, int *min_len, - const std::string& s, int min_toks_to_match, - int max_toks); - -extern OCTINTERP_API int empty_arg (const char *name, octave_idx_type nr, - octave_idx_type nc); - -extern OCTINTERP_API std::string -search_path_for_file (const std::string&, const string_vector&); - -extern OCTINTERP_API string_vector -search_path_for_all_files (const std::string&, const string_vector&); - -extern OCTINTERP_API std::string -file_in_path (const std::string&, const std::string&); - -extern OCTINTERP_API std::string contents_file_in_path (const std::string&); - -extern OCTINTERP_API std::string fcn_file_in_path (const std::string&); -extern OCTINTERP_API std::string oct_file_in_path (const std::string&); -extern OCTINTERP_API std::string mex_file_in_path (const std::string&); - -extern OCTINTERP_API std::string do_string_escapes (const std::string& s); - -extern OCTINTERP_API const char *undo_string_escape (char c); - -extern OCTINTERP_API std::string undo_string_escapes (const std::string& s); - -extern OCTINTERP_API void -check_dimensions (dim_vector& dim, const char *warnfor); - -extern OCTINTERP_API void -get_dimensions (const octave_value& a, const char *warn_for, - dim_vector& dim); - -extern OCTINTERP_API void -get_dimensions (const octave_value& a, const octave_value& b, - const char *warn_for, octave_idx_type& nr, - octave_idx_type& nc); - -extern OCTINTERP_API void -get_dimensions (const octave_value& a,const char *warn_for, - octave_idx_type& nr, octave_idx_type& nc); - -extern OCTINTERP_API octave_idx_type -dims_to_numel (const dim_vector& dims, const octave_value_list& idx); - -extern OCTINTERP_API Matrix -identity_matrix (octave_idx_type nr, octave_idx_type nc); - -extern OCTINTERP_API FloatMatrix -float_identity_matrix (octave_idx_type nr, octave_idx_type nc); - -extern OCTINTERP_API size_t -octave_format (std::ostream& os, const char *fmt, ...); - -extern OCTINTERP_API size_t -octave_vformat (std::ostream& os, const char *fmt, va_list args); - -extern OCTINTERP_API std::string -octave_vasprintf (const char *fmt, va_list args); - -extern OCTINTERP_API std::string octave_asprintf (const char *fmt, ...); - -extern OCTINTERP_API void octave_sleep (double seconds); - -extern OCTINTERP_API -octave_value_list -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args, - int nargout); - -extern OCTINTERP_API -octave_value -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args); - -#endif diff -r d02b229ce693 -r a132d206a36a src/variables.cc --- a/src/variables.cc Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2596 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include - -#include "file-stat.h" -#include "oct-env.h" -#include "file-ops.h" -#include "glob-match.h" -#include "regexp.h" -#include "str-vec.h" - -#include -#include "Cell.h" -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "lex.h" -#include "load-path.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-class.h" -#include "ov-usr-fcn.h" -#include "pager.h" -#include "parse.h" -#include "symtab.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Defines layout for the whos/who -long command -static std::string Vwhos_line_format - = " %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\n"; - -void -clear_mex_functions (void) -{ - symbol_table::clear_mex_functions (); -} - -void -clear_function (const std::string& nm) -{ - symbol_table::clear_function (nm); -} - -void -clear_variable (const std::string& nm) -{ - symbol_table::clear_variable (nm); -} - -void -clear_symbol (const std::string& nm) -{ - symbol_table::clear_symbol (nm); -} - -// Attributes of variables and functions. - -// Is this octave_value a valid function? - -octave_function * -is_valid_function (const std::string& fcn_name, - const std::string& warn_for, bool warn) -{ - octave_function *ans = 0; - - if (! fcn_name.empty ()) - { - octave_value val = symbol_table::find_function (fcn_name); - - if (val.is_defined ()) - ans = val.function_value (true); - } - - if (! ans && warn) - error ("%s: the symbol `%s' is not valid as a function", - warn_for.c_str (), fcn_name.c_str ()); - - return ans; -} - -octave_function * -is_valid_function (const octave_value& arg, - const std::string& warn_for, bool warn) -{ - octave_function *ans = 0; - - std::string fcn_name; - - if (arg.is_string ()) - { - fcn_name = arg.string_value (); - - if (! error_state) - ans = is_valid_function (fcn_name, warn_for, warn); - else if (warn) - error ("%s: expecting function name as argument", warn_for.c_str ()); - } - else if (warn) - error ("%s: expecting function name as argument", warn_for.c_str ()); - - return ans; -} - -octave_function * -extract_function (const octave_value& arg, const std::string& warn_for, - const std::string& fname, const std::string& header, - const std::string& trailer) -{ - octave_function *retval = 0; - - retval = is_valid_function (arg, warn_for, 0); - - if (! retval) - { - std::string s = arg.string_value (); - - std::string cmd = header; - cmd.append (s); - cmd.append (trailer); - - if (! error_state) - { - int parse_status; - - eval_string (cmd, true, parse_status, 0); - - if (parse_status == 0) - { - retval = is_valid_function (fname, warn_for, 0); - - if (! retval) - { - error ("%s: `%s' is not valid as a function", - warn_for.c_str (), fname.c_str ()); - return retval; - } - - warning ("%s: passing function body as a string is obsolete; please use anonymous functions", - warn_for.c_str ()); - } - else - error ("%s: `%s' is not valid as a function", - warn_for.c_str (), fname.c_str ()); - } - else - error ("%s: expecting first argument to be a string", - warn_for.c_str ()); - } - - return retval; -} - -string_vector -get_struct_elts (const std::string& text) -{ - int n = 1; - - size_t pos = 0; - - size_t len = text.length (); - - while ((pos = text.find ('.', pos)) != std::string::npos) - { - if (++pos == len) - break; - - n++; - } - - string_vector retval (n); - - pos = 0; - - for (int i = 0; i < n; i++) - { - len = text.find ('.', pos); - - if (len != std::string::npos) - len -= pos; - - retval[i] = text.substr (pos, len); - - if (len != std::string::npos) - pos += len + 1; - } - - return retval; -} - -static inline bool -is_variable (const std::string& name) -{ - bool retval = false; - - if (! name.empty ()) - { - octave_value val = symbol_table::varval (name); - - retval = val.is_defined (); - } - - return retval; -} - -string_vector -generate_struct_completions (const std::string& text, - std::string& prefix, std::string& hint) -{ - string_vector names; - - size_t pos = text.rfind ('.'); - - if (pos != std::string::npos) - { - if (pos == text.length ()) - hint = ""; - else - hint = text.substr (pos+1); - - prefix = text.substr (0, pos); - - std::string base_name = prefix; - - pos = base_name.find_first_of ("{(."); - - if (pos != std::string::npos) - base_name = base_name.substr (0, pos); - - if (is_variable (base_name)) - { - int parse_status; - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (warning_state); - - frame.protect_var (discard_error_messages); - frame.protect_var (discard_warning_messages); - - discard_error_messages = true; - discard_warning_messages = true; - - octave_value tmp = eval_string (prefix, true, parse_status); - - frame.run (); - - if (tmp.is_defined () && tmp.is_map ()) - names = tmp.map_keys (); - } - } - - return names; -} - -// FIXME -- this will have to be much smarter to work -// "correctly". - -bool -looks_like_struct (const std::string& text) -{ - bool retval = (! text.empty () - && text != "." - && text.find_first_of (file_ops::dir_sep_chars ()) == std::string::npos - && text.find ("..") == std::string::npos - && text.rfind ('.') != std::string::npos); - -#if 0 - symbol_record *sr = curr_sym_tab->lookup (text); - - if (sr && ! sr->is_function ()) - { - int parse_status; - - unwind_protect frame; - - frame.protect_var (discard_error_messages); - frame.protect_var (error_state); - - discard_error_messages = true; - - octave_value tmp = eval_string (text, true, parse_status); - - frame.run (); - - retval = (tmp.is_defined () && tmp.is_map ()); - } -#endif - - return retval; -} - -static octave_value -do_isglobal (const octave_value_list& args) -{ - octave_value retval = false; - - int nargin = args.length (); - - if (nargin != 1) - { - print_usage (); - return retval; - } - - std::string name = args(0).string_value (); - - if (error_state) - { - error ("isglobal: NAME must be a string"); - return retval; - } - - return symbol_table::is_global (name); -} - -DEFUN (isglobal, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isglobal (@var{name})\n\ -Return true if @var{name} is a globally visible variable.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -global x\n\ -isglobal (\"x\")\n\ - @result{} 1\n\ -@end group\n\ -@end example\n\ -@seealso{isvarname, exist}\n\ -@end deftypefn") -{ - return do_isglobal (args); -} - -static octave_value -safe_symbol_lookup (const std::string& symbol_name) -{ - octave_value retval; - - unwind_protect frame; - interpreter_try (frame); - - retval = symbol_table::find (symbol_name); - - error_state = 0; - - return retval; -} - -int -symbol_exist (const std::string& name, const std::string& type) -{ - int retval = 0; - - std::string struct_elts; - std::string symbol_name = name; - - size_t pos = name.find ('.'); - - if (pos != std::string::npos && pos > 0) - { - struct_elts = name.substr (pos+1); - symbol_name = name.substr (0, pos); - } - - // We shouldn't need to look in the global symbol table, since any - // name that is visible in the current scope will be in the local - // symbol table. - - octave_value val = safe_symbol_lookup (symbol_name); - - if (val.is_defined ()) - { - bool not_a_struct = struct_elts.empty (); - bool var_ok = not_a_struct /* || val.is_map_element (struct_elts) */; - - if (! retval - && var_ok - && (type == "any" || type == "var") - && (val.is_constant () || val.is_object () - || val.is_function_handle () - || val.is_anonymous_function () - || val.is_inline_function ())) - { - retval = 1; - } - - if (! retval - && (type == "any" || type == "builtin")) - { - if (not_a_struct && val.is_builtin_function ()) - { - retval = 5; - } - } - - if (! retval - && not_a_struct - && (type == "any" || type == "file") - && (val.is_user_function () || val.is_dld_function ())) - { - octave_function *f = val.function_value (true); - std::string s = f ? f->fcn_file_name () : std::string (); - - retval = s.empty () ? 103 : (val.is_user_function () ? 2 : 3); - } - } - - if (! (type == "var" || type == "builtin")) - { - if (! retval) - { - std::string file_name = lookup_autoload (name); - - if (file_name.empty ()) - file_name = load_path::find_fcn (name); - - size_t len = file_name.length (); - - if (len > 0) - { - if (type == "any" || type == "file") - { - if (len > 4 && (file_name.substr (len-4) == ".oct" - || file_name.substr (len-4) == ".mex")) - retval = 3; - else - retval = 2; - } - } - } - - if (! retval) - { - std::string file_name = file_in_path (name, ""); - - if (file_name.empty ()) - file_name = name; - - file_stat fs (file_name); - - if (fs) - { - if (type == "any" || type == "file") - retval = fs.is_dir () ? 7 : 2; - else if (type == "dir" && fs.is_dir ()) - retval = 7; - } - } - } - - return retval; -} - -#define GET_IDX(LEN) \ - static_cast ((LEN-1) * static_cast (rand ()) / RAND_MAX) - -std::string -unique_symbol_name (const std::string& basename) -{ - static const std::string alpha - = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; - - static size_t len = alpha.length (); - - std::string nm = basename + alpha[GET_IDX (len)]; - - size_t pos = nm.length (); - - if (nm.substr (0, 2) == "__") - nm.append ("__"); - - while (symbol_exist (nm, "any")) - nm.insert (pos++, 1, alpha[GET_IDX (len)]); - - return nm; -} - -DEFUN (exist, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} exist (@var{name}, @var{type})\n\ -Return 1 if the name exists as a variable, 2 if the name is an\n\ -absolute file name, an ordinary file in Octave's @code{path}, or (after\n\ -appending @samp{.m}) a function file in Octave's @code{path}, 3 if the\n\ -name is a @samp{.oct} or @samp{.mex} file in Octave's @code{path},\n\ -5 if the name is a built-in function, 7 if the name is a directory, or 103\n\ -if the name is a function not associated with a file (entered on\n\ -the command line).\n\ -\n\ -Otherwise, return 0.\n\ -\n\ -This function also returns 2 if a regular file called @var{name}\n\ -exists in Octave's search path. If you want information about\n\ -other types of files, you should use some combination of the functions\n\ -@code{file_in_path} and @code{stat} instead.\n\ -\n\ -If the optional argument @var{type} is supplied, check only for\n\ -symbols of the specified type. Valid types are\n\ -\n\ -@table @asis\n\ -@item \"var\"\n\ -Check only for variables.\n\ -\n\ -@item \"builtin\"\n\ -Check only for built-in functions.\n\ -\n\ -@item \"file\"\n\ -Check only for files.\n\ -\n\ -@item \"dir\"\n\ -Check only for directories.\n\ -@end table\n\ -\n\ -@seealso{file_in_loadpath}\n\ -@end deftypefn") -{ - octave_value retval = false; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - std::string type - = (nargin == 2) ? args(1).string_value () : std::string ("any"); - - if (! error_state) - retval = symbol_exist (name, type); - else - error ("exist: TYPE must be a string"); - } - else - error ("exist: NAME must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! if (isunix ()) -%! assert (exist ("/tmp") == 7); -%! assert (exist ("/tmp", "file") == 7); -%! assert (exist ("/tmp", "dir") == 7); -%! assert (exist ("/bin/sh") == 2); -%! assert (exist ("/bin/sh", "file") == 2); -%! assert (exist ("/bin/sh", "dir") == 0); -%! assert (exist ("/dev/null") == 2); -%! assert (exist ("/dev/null", "file") == 2); -%! assert (exist ("/dev/null", "dir") == 0); -%! endif -*/ - -octave_value -lookup_function_handle (const std::string& nm) -{ - octave_value val = symbol_table::varval (nm); - - return val.is_function_handle () ? val : octave_value (); -} - -octave_value -get_global_value (const std::string& nm, bool silent) -{ - octave_value val = symbol_table::global_varval (nm); - - if (val.is_undefined () && ! silent) - error ("get_global_value: undefined symbol `%s'", nm.c_str ()); - - return val; -} - -void -set_global_value (const std::string& nm, const octave_value& val) -{ - symbol_table::global_varref (nm) = val; -} - -octave_value -get_top_level_value (const std::string& nm, bool silent) -{ - octave_value val = symbol_table::top_level_varval (nm); - - if (val.is_undefined () && ! silent) - error ("get_top_level_value: undefined symbol `%s'", nm.c_str ()); - - return val; -} - -void -set_top_level_value (const std::string& nm, const octave_value& val) -{ - symbol_table::top_level_varref (nm) = val; -} - -// Variable values. - -static bool -wants_local_change (const octave_value_list& args, int& nargin) -{ - bool retval = false; - - if (nargin == 2) - { - if (args(1).is_string () && args(1).string_value () == "local") - { - nargin = 1; - retval = true; - } - else - { - error_with_cfn ("expecting second argument to be \"local\""); - nargin = 0; - } - } - - return retval; -} - -template -bool try_local_protect (T& var) -{ - octave_user_code *curr_usr_code = octave_call_stack::caller_user_code (); - octave_user_function *curr_usr_fcn = 0; - if (curr_usr_code && curr_usr_code->is_user_function ()) - curr_usr_fcn = dynamic_cast (curr_usr_code); - - if (curr_usr_fcn && curr_usr_fcn->local_protect (var)) - return true; - else - return false; -} - -octave_value -set_internal_variable (bool& var, const octave_value_list& args, - int nargout, const char *nm) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - bool bval = args(0).bool_value (); - - if (! error_state) - var = bval; - else - error ("%s: expecting arg to be a logical value", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (char& var, const octave_value_list& args, - int nargout, const char *nm) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - switch (sval.length ()) - { - case 1: - var = sval[0]; - break; - - case 0: - var = '\0'; - break; - - default: - error ("%s: argument must be a single character", nm); - break; - } - } - else - error ("%s: argument must be a single character", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, - int minval, int maxval) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - int ival = args(0).int_value (); - - if (! error_state) - { - if (ival < minval) - error ("%s: expecting arg to be greater than %d", nm, minval); - else if (ival > maxval) - error ("%s: expecting arg to be less than or equal to %d", - nm, maxval); - else - var = ival; - } - else - error ("%s: expecting arg to be an integer value", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (double& var, const octave_value_list& args, - int nargout, const char *nm, - double minval, double maxval) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - double dval = args(0).scalar_value (); - - if (! error_state) - { - if (dval < minval) - error ("%s: expecting arg to be greater than %g", minval); - else if (dval > maxval) - error ("%s: expecting arg to be less than or equal to %g", maxval); - else - var = dval; - } - else - error ("%s: expecting arg to be a scalar value", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (std::string& var, const octave_value_list& args, - int nargout, const char *nm, bool empty_ok) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - if (empty_ok || ! sval.empty ()) - var = sval; - else - error ("%s: value must not be empty", nm); - } - else - error ("%s: expecting arg to be a character string", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, const char **choices) -{ - octave_value retval; - int nchoices = 0; - while (choices[nchoices] != 0) - nchoices++; - - int nargin = args.length (); - assert (var < nchoices); - - if (nargout > 0 || nargin == 0) - retval = choices[var]; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - int i = 0; - for (; i < nchoices; i++) - { - if (sval == choices[i]) - { - var = i; - break; - } - } - if (i == nchoices) - error ("%s: value not allowed (\"%s\")", nm, sval.c_str ()); - } - else - error ("%s: expecting arg to be a character string", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -struct -whos_parameter -{ - char command; - char modifier; - int parameter_length; - int first_parameter_length; - int balance; - std::string text; - std::string line; -}; - -static void -print_descriptor (std::ostream& os, std::list params) -{ - // This method prints a line of information on a given symbol - std::list::iterator i = params.begin (); - std::ostringstream param_buf; - - while (i != params.end ()) - { - whos_parameter param = *i; - - if (param.command != '\0') - { - // Do the actual printing - switch (param.modifier) - { - case 'l': - os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - break; - - case 'r': - os << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); - break; - - case 'c': - if (param.command != 's') - { - os << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - } - break; - - default: - os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - } - - if (param.command == 's' && param.modifier == 'c') - { - int a, b; - - if (param.modifier == 'c') - { - a = param.first_parameter_length - param.balance; - a = (a < 0 ? 0 : a); - b = param.parameter_length - a - param.text . length (); - b = (b < 0 ? 0 : b); - os << std::setiosflags (std::ios::left) << std::setw (a) - << "" << std::resetiosflags (std::ios::left) << param.text - << std::setiosflags (std::ios::left) - << std::setw (b) << "" - << std::resetiosflags (std::ios::left); - param_buf << std::setiosflags (std::ios::left) << std::setw (a) - << "" << std::resetiosflags (std::ios::left) << param.line - << std::setiosflags (std::ios::left) - << std::setw (b) << "" - << std::resetiosflags (std::ios::left); - } - } - else - { - os << param.text; - param_buf << param.line; - } - os << std::resetiosflags (std::ios::left) - << std::resetiosflags (std::ios::right); - param_buf << std::resetiosflags (std::ios::left) - << std::resetiosflags (std::ios::right); - i++; - } - else - { - os << param.text; - param_buf << param.line; - i++; - } - } - - os << param_buf.str (); -} - -// FIXME -- This is a bit of a kluge. We'd like to just use val.dims() -// and if val is an object, expect that dims will call size if it is -// overloaded by a user-defined method. But there are currently some -// unresolved const issues that prevent that solution from working. - -std::string -get_dims_str (const octave_value& val) -{ - octave_value tmp = val; - - Matrix sz = tmp.size (); - - dim_vector dv = dim_vector::alloc (sz.numel ()); - - for (octave_idx_type i = 0; i < dv.length (); i++) - dv(i) = sz(i); - - return dv.str (); -} - -class -symbol_info_list -{ -private: - struct symbol_info - { - symbol_info (const symbol_table::symbol_record& sr, - const std::string& expr_str = std::string (), - const octave_value& expr_val = octave_value ()) - : name (expr_str.empty () ? sr.name () : expr_str), - varval (expr_val.is_undefined () ? sr.varval () : expr_val), - is_automatic (sr.is_automatic ()), - is_complex (varval.is_complex_type ()), - is_formal (sr.is_formal ()), - is_global (sr.is_global ()), - is_persistent (sr.is_persistent ()) - { } - - void display_line (std::ostream& os, - const std::list& params) const - { - std::string dims_str = get_dims_str (varval); - - std::list::const_iterator i = params.begin (); - - while (i != params.end ()) - { - whos_parameter param = *i; - - if (param.command != '\0') - { - // Do the actual printing. - - switch (param.modifier) - { - case 'l': - os << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - break; - - case 'r': - os << std::setiosflags (std::ios::right) - << std::setw (param.parameter_length); - break; - - case 'c': - if (param.command == 's') - { - int front = param.first_parameter_length - - dims_str.find ('x'); - int back = param.parameter_length - - dims_str.length () - - front; - front = (front > 0) ? front : 0; - back = (back > 0) ? back : 0; - - os << std::setiosflags (std::ios::left) - << std::setw (front) - << "" - << std::resetiosflags (std::ios::left) - << dims_str - << std::setiosflags (std::ios::left) - << std::setw (back) - << "" - << std::resetiosflags (std::ios::left); - } - else - { - os << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - } - break; - - default: - error ("whos_line_format: modifier `%c' unknown", - param.modifier); - - os << std::setiosflags (std::ios::right) - << std::setw (param.parameter_length); - } - - switch (param.command) - { - case 'a': - { - char tmp[6]; - - tmp[0] = (is_automatic ? 'a' : ' '); - tmp[1] = (is_complex ? 'c' : ' '); - tmp[2] = (is_formal ? 'f' : ' '); - tmp[3] = (is_global ? 'g' : ' '); - tmp[4] = (is_persistent ? 'p' : ' '); - tmp[5] = 0; - - os << tmp; - } - break; - - case 'b': - os << varval.byte_size (); - break; - - case 'c': - os << varval.class_name (); - break; - - case 'e': - os << varval.capacity (); - break; - - case 'n': - os << name; - break; - - case 's': - if (param.modifier != 'c') - os << dims_str; - break; - - case 't': - os << varval.type_name (); - break; - - default: - error ("whos_line_format: command `%c' unknown", - param.command); - } - - os << std::resetiosflags (std::ios::left) - << std::resetiosflags (std::ios::right); - i++; - } - else - { - os << param.text; - i++; - } - } - } - - std::string name; - octave_value varval; - bool is_automatic; - bool is_complex; - bool is_formal; - bool is_global; - bool is_persistent; - }; - -public: - symbol_info_list (void) : lst () { } - - symbol_info_list (const symbol_info_list& sil) : lst (sil.lst) { } - - symbol_info_list& operator = (const symbol_info_list& sil) - { - if (this != &sil) - lst = sil.lst; - - return *this; - } - - ~symbol_info_list (void) { } - - void append (const symbol_table::symbol_record& sr) - { - lst.push_back (symbol_info (sr)); - } - - void append (const symbol_table::symbol_record& sr, - const std::string& expr_str, - const octave_value& expr_val) - { - lst.push_back (symbol_info (sr, expr_str, expr_val)); - } - - size_t size (void) const { return lst.size (); } - - bool empty (void) const { return lst.empty (); } - - octave_map - map_value (const std::string& caller_function_name, int nesting_level) const - { - size_t len = lst.size (); - - Cell name_info (len, 1); - Cell size_info (len, 1); - Cell bytes_info (len, 1); - Cell class_info (len, 1); - Cell global_info (len, 1); - Cell sparse_info (len, 1); - Cell complex_info (len, 1); - Cell nesting_info (len, 1); - Cell persistent_info (len, 1); - - std::list::const_iterator p = lst.begin (); - - for (size_t j = 0; j < len; j++) - { - const symbol_info& si = *p++; - - octave_scalar_map ni; - - ni.assign ("function", caller_function_name); - ni.assign ("level", nesting_level); - - name_info(j) = si.name; - global_info(j) = si.is_global; - persistent_info(j) = si.is_persistent; - - octave_value val = si.varval; - - size_info(j) = val.size (); - bytes_info(j) = val.byte_size (); - class_info(j) = val.class_name (); - sparse_info(j) = val.is_sparse_type (); - complex_info(j) = val.is_complex_type (); - nesting_info(j) = ni; - } - - octave_map info; - - info.assign ("name", name_info); - info.assign ("size", size_info); - info.assign ("bytes", bytes_info); - info.assign ("class", class_info); - info.assign ("global", global_info); - info.assign ("sparse", sparse_info); - info.assign ("complex", complex_info); - info.assign ("nesting", nesting_info); - info.assign ("persistent", persistent_info); - - return info; - } - - void display (std::ostream& os) - { - if (! lst.empty ()) - { - size_t bytes = 0; - size_t elements = 0; - - std::list params = parse_whos_line_format (); - - print_descriptor (os, params); - - octave_stdout << "\n"; - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - { - p->display_line (os, params); - - octave_value val = p->varval; - - elements += val.capacity (); - bytes += val.byte_size (); - } - - os << "\nTotal is " << elements - << (elements == 1 ? " element" : " elements") - << " using " << bytes << (bytes == 1 ? " byte" : " bytes") - << "\n"; - } - } - - // Parse the string whos_line_format, and return a parameter list, - // containing all information needed to print the given - // attributtes of the symbols. - std::list parse_whos_line_format (void) - { - int idx; - size_t format_len = Vwhos_line_format.length (); - char garbage; - std::list params; - - size_t bytes1; - int elements1; - - std::string param_string = "abcenst"; - Array param_length (dim_vector (param_string.length (), 1)); - Array param_names (dim_vector (param_string.length (), 1)); - size_t pos_a, pos_b, pos_c, pos_e, pos_n, pos_s, pos_t; - - pos_a = param_string.find ('a'); // Attributes - pos_b = param_string.find ('b'); // Bytes - pos_c = param_string.find ('c'); // Class - pos_e = param_string.find ('e'); // Elements - pos_n = param_string.find ('n'); // Name - pos_s = param_string.find ('s'); // Size - pos_t = param_string.find ('t'); // Type - - param_names(pos_a) = "Attr"; - param_names(pos_b) = "Bytes"; - param_names(pos_c) = "Class"; - param_names(pos_e) = "Elements"; - param_names(pos_n) = "Name"; - param_names(pos_s) = "Size"; - param_names(pos_t) = "Type"; - - for (size_t i = 0; i < param_string.length (); i++) - param_length(i) = param_names(i).length (); - - // The attribute column needs size 5. - param_length(pos_a) = 5; - - // Calculating necessary spacing for name column, - // bytes column, elements column and class column - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - { - std::stringstream ss1, ss2; - std::string str; - - str = p->name; - param_length(pos_n) = ((str.length () - > static_cast (param_length(pos_n))) - ? str.length () : param_length(pos_n)); - - octave_value val = p->varval; - - str = val.type_name (); - param_length(pos_t) = ((str.length () - > static_cast (param_length(pos_t))) - ? str.length () : param_length(pos_t)); - - elements1 = val.capacity (); - ss1 << elements1; - str = ss1.str (); - param_length(pos_e) = ((str.length () - > static_cast (param_length(pos_e))) - ? str.length () : param_length(pos_e)); - - bytes1 = val.byte_size (); - ss2 << bytes1; - str = ss2.str (); - param_length(pos_b) = ((str.length () - > static_cast (param_length(pos_b))) - ? str.length () : param_length (pos_b)); - } - - idx = 0; - while (static_cast (idx) < format_len) - { - whos_parameter param; - param.command = '\0'; - - if (Vwhos_line_format[idx] == '%') - { - bool error_encountered = false; - param.modifier = 'r'; - param.parameter_length = 0; - - int a = 0, b = -1, balance = 1; - unsigned int items; - size_t pos; - std::string cmd; - - // Parse one command from whos_line_format - cmd = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); - pos = cmd.find (';'); - if (pos != std::string::npos) - cmd = cmd.substr (0, pos+1); - else - error ("parameter without ; in whos_line_format"); - - idx += cmd.length (); - - // FIXME -- use iostream functions instead of sscanf! - - if (cmd.find_first_of ("crl") != 1) - items = sscanf (cmd.c_str (), "%c%c:%d:%d:%d;", - &garbage, ¶m.command, &a, &b, &balance); - else - items = sscanf (cmd.c_str (), "%c%c%c:%d:%d:%d;", - &garbage, ¶m.modifier, ¶m.command, - &a, &b, &balance) - 1; - - if (items < 2) - { - error ("whos_line_format: parameter structure without command in whos_line_format"); - error_encountered = true; - } - - // Insert data into parameter - param.first_parameter_length = 0; - pos = param_string.find (param.command); - if (pos != std::string::npos) - { - param.parameter_length = param_length(pos); - param.text = param_names(pos); - param.line.assign (param_names(pos).length (), '='); - - param.parameter_length = (a > param.parameter_length - ? a : param.parameter_length); - if (param.command == 's' && param.modifier == 'c' && b > 0) - param.first_parameter_length = b; - } - else - { - error ("whos_line_format: '%c' is not a command", - param.command); - error_encountered = true; - } - - if (param.command == 's') - { - // Have to calculate space needed for printing - // matrix dimensions Space needed for Size column is - // hard to determine in prior, because it depends on - // dimensions to be shown. That is why it is - // recalculated for each Size-command int first, - // rest = 0, total; - int rest = 0; - int first = param.first_parameter_length; - int total = param.parameter_length; - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - { - octave_value val = p->varval; - std::string dims_str = get_dims_str (val); - int first1 = dims_str.find ('x'); - int total1 = dims_str.length (); - int rest1 = total1 - first1; - rest = (rest1 > rest ? rest1 : rest); - first = (first1 > first ? first1 : first); - total = (total1 > total ? total1 : total); - } - - if (param.modifier == 'c') - { - if (first < balance) - first += balance - first; - if (rest + balance < param.parameter_length) - rest += param.parameter_length - rest - balance; - - param.parameter_length = first + rest; - param.first_parameter_length = first; - param.balance = balance; - } - else - { - param.parameter_length = total; - param.first_parameter_length = 0; - } - } - else if (param.modifier == 'c') - { - error ("whos_line_format: modifier 'c' not available for command '%c'", - param.command); - error_encountered = true; - } - - // What happens if whos_line_format contains negative numbers - // at param_length positions? - param.balance = (b < 0 ? 0 : param.balance); - param.first_parameter_length = (b < 0 ? 0 : - param.first_parameter_length); - param.parameter_length = (a < 0 - ? 0 - : (param.parameter_length - < param_length(pos_s) - ? param_length(pos_s) - : param.parameter_length)); - - // Parameter will not be pushed into parameter list if ... - if (! error_encountered) - params.push_back (param); - } - else - { - // Text string, to be printed as it is ... - std::string text; - size_t pos; - text = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); - pos = text.find ('%'); - if (pos != std::string::npos) - text = text.substr (0, pos); - - // Push parameter into list ... - idx += text.length (); - param.text=text; - param.line.assign (text.length (), ' '); - params.push_back (param); - } - } - - return params; - } - -private: - std::list lst; - -}; - -static octave_value -do_who (int argc, const string_vector& argv, bool return_list, - bool verbose = false, std::string msg = std::string ()) -{ - octave_value retval; - - std::string my_name = argv[0]; - - bool global_only = false; - bool have_regexp = false; - - int i; - for (i = 1; i < argc; i++) - { - if (argv[i] == "-file") - { - // FIXME. This is an inefficient manner to implement this as the - // variables are loaded in to a temporary context and then treated. - // It would be better to refecat symbol_info_list to not store the - // symbol records and then use it in load-save.cc (do_load) to - // implement this option there so that the variables are never - // stored at all. - if (i == argc - 1) - error ("whos: -file argument must be followed by a file name"); - else - { - std::string nm = argv[i + 1]; - - unwind_protect frame; - - // Set up temporary scope. - - symbol_table::scope_id tmp_scope = symbol_table::alloc_scope (); - frame.add_fcn (symbol_table::erase_scope, tmp_scope); - - symbol_table::set_scope (tmp_scope); - - octave_call_stack::push (tmp_scope, 0); - frame.add_fcn (octave_call_stack::pop); - - frame.add_fcn (symbol_table::clear_variables); - - feval ("load", octave_value (nm), 0); - - if (! error_state) - { - std::string newmsg = std::string ("Variables in the file ") + - nm + ":\n\n"; - - retval = do_who (i, argv, return_list, verbose, newmsg); - } - } - - return retval; - } - else if (argv[i] == "-regexp") - have_regexp = true; - else if (argv[i] == "global") - global_only = true; - else if (argv[i][0] == '-') - warning ("%s: unrecognized option `%s'", my_name.c_str (), - argv[i].c_str ()); - else - break; - } - - int npats = argc - i; - string_vector pats; - if (npats > 0) - { - pats.resize (npats); - for (int j = 0; j < npats; j++) - pats[j] = argv[i+j]; - } - else - { - pats.resize (++npats); - pats[0] = "*"; - } - - symbol_info_list symbol_stats; - std::list symbol_names; - - for (int j = 0; j < npats; j++) - { - std::string pat = pats[j]; - - if (have_regexp) - { - std::list tmp = global_only - ? symbol_table::regexp_global_variables (pat) - : symbol_table::regexp_variables (pat); - - for (std::list::const_iterator p = tmp.begin (); - p != tmp.end (); p++) - { - if (p->is_variable ()) - { - if (verbose) - symbol_stats.append (*p); - else - symbol_names.push_back (p->name ()); - } - } - } - else - { - size_t pos = pat.find_first_of (".({"); - - if (pos != std::string::npos && pos > 0) - { - if (verbose) - { - // NOTE: we can only display information for - // expressions based on global values if the variable is - // global in the current scope because we currently have - // no way of looking up the base value in the global - // scope and then evaluating the arguments in the - // current scope. - - std::string base_name = pat.substr (0, pos); - - if (symbol_table::is_variable (base_name)) - { - symbol_table::symbol_record sr - = symbol_table::find_symbol (base_name); - - if (! global_only || sr.is_global ()) - { - int parse_status; - - octave_value expr_val - = eval_string (pat, true, parse_status); - - if (! error_state) - symbol_stats.append (sr, pat, expr_val); - else - return retval; - } - } - } - } - else - { - std::list tmp = global_only - ? symbol_table::glob_global_variables (pat) - : symbol_table::glob_variables (pat); - - for (std::list::const_iterator p = tmp.begin (); - p != tmp.end (); p++) - { - if (p->is_variable ()) - { - if (verbose) - symbol_stats.append (*p); - else - symbol_names.push_back (p->name ()); - } - } - } - } - } - - if (return_list) - { - if (verbose) - { - std::string caller_function_name; - octave_function *caller = octave_call_stack::caller (); - if (caller) - caller_function_name = caller->name (); - - retval = symbol_stats.map_value (caller_function_name, 1); - } - else - retval = Cell (string_vector (symbol_names)); - } - else if (! (symbol_stats.empty () && symbol_names.empty ())) - { - if (msg.length () == 0) - if (global_only) - octave_stdout << "Global variables:\n\n"; - else - octave_stdout << "Variables in the current scope:\n\n"; - else - octave_stdout << msg; - - if (verbose) - symbol_stats.display (octave_stdout); - else - { - string_vector names (symbol_names); - - names.list_in_columns (octave_stdout); - } - - octave_stdout << "\n"; - } - - return retval; -} - -DEFUN (who, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} who\n\ -@deftypefnx {Command} {} who pattern @dots{}\n\ -@deftypefnx {Command} {} who option pattern @dots{}\n\ -@deftypefnx {Command} {C =} who (\"pattern\", @dots{})\n\ -List currently defined variables matching the given patterns. Valid\n\ -pattern syntax is the same as described for the @code{clear} command.\n\ -If no patterns are supplied, all variables are listed.\n\ -By default, only variables visible in the local scope are displayed.\n\ -\n\ -The following are valid options but may not be combined.\n\ -\n\ -@table @code\n\ -@item global\n\ -List variables in the global scope rather than the current scope.\n\ -\n\ -@item -regexp\n\ -The patterns are considered to be regular expressions when matching the\n\ -variables to display. The same pattern syntax accepted by\n\ -the @code{regexp} function is used.\n\ -\n\ -@item -file\n\ -The next argument is treated as a filename. All variables found within the\n\ -specified file are listed. No patterns are accepted when reading variables\n\ -from a file.\n\ -@end table\n\ -\n\ -If called as a function, return a cell array of defined variable names\n\ -matching the given patterns.\n\ -@seealso{whos, isglobal, isvarname, exist, regexp}\n\ -@end deftypefn") -{ - octave_value retval; - - if (nargout < 2) - { - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("who"); - - if (! error_state) - retval = do_who (argc, argv, nargout == 1); - } - else - print_usage (); - - return retval; -} - -DEFUN (whos, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} whos\n\ -@deftypefnx {Command} {} whos pattern @dots{}\n\ -@deftypefnx {Command} {} whos option pattern @dots{}\n\ -@deftypefnx {Command} {S =} whos (\"pattern\", @dots{})\n\ -Provide detailed information on currently defined variables matching the\n\ -given patterns. Options and pattern syntax are the same as for the\n\ -@code{who} command. Extended information about each variable is\n\ -summarized in a table with the following default entries.\n\ -\n\ -@table @asis\n\ -@item Attr\n\ -Attributes of the listed variable. Possible attributes are:\n\ -\n\ -@table @asis\n\ -@item blank\n\ -Variable in local scope\n\ -\n\ -@item @code{a}\n\ -Automatic variable. An automatic variable is one created by the\n\ -interpreter, for example @code{argn}.\n\ -\n\ -@item @code{c}\n\ -Variable of complex type.\n\ -\n\ -@item @code{f}\n\ -Formal parameter (function argument).\n\ -\n\ -@item @code{g}\n\ -Variable with global scope.\n\ -\n\ -@item @code{p}\n\ -Persistent variable.\n\ -@end table\n\ -\n\ -@item Name\n\ -The name of the variable.\n\ -\n\ -@item Size\n\ -The logical size of the variable. A scalar is 1x1, a vector is\n\ -@nospell{1xN} or @nospell{Nx1}, a 2-D matrix is @nospell{MxN}.\n\ -\n\ -@item Bytes\n\ -The amount of memory currently used to store the variable.\n\ -\n\ -@item Class\n\ -The class of the variable. Examples include double, single, char, uint16,\n\ -cell, and struct.\n\ -@end table\n\ -\n\ -The table can be customized to display more or less information through\n\ -the function @code{whos_line_format}.\n\ -\n\ -If @code{whos} is called as a function, return a struct array of defined\n\ -variable names matching the given patterns. Fields in the structure\n\ -describing each variable are: name, size, bytes, class, global, sparse,\n\ -complex, nesting, persistent.\n\ -@seealso{who, whos_line_format}\n\ -@end deftypefn") -{ - octave_value retval; - - if (nargout < 2) - { - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("whos"); - - if (! error_state) - retval = do_who (argc, argv, nargout == 1, true); - } - else - print_usage (); - - return retval; -} - -// Defining variables. - -void -bind_ans (const octave_value& val, bool print) -{ - static std::string ans = "ans"; - - if (val.is_defined ()) - { - if (val.is_cs_list ()) - { - octave_value_list lst = val.list_value (); - - for (octave_idx_type i = 0; i < lst.length (); i++) - bind_ans (lst(i), print); - } - else - { - symbol_table::varref (ans) = val; - - if (print) - val.print_with_name (octave_stdout, ans); - } - } -} - -void -bind_internal_variable (const std::string& fname, const octave_value& val) -{ - octave_value_list args; - - args(0) = val; - - feval (fname, args, 0); -} - -void -mlock (void) -{ - octave_function *fcn = octave_call_stack::current (); - - if (fcn) - fcn->lock (); - else - error ("mlock: invalid use outside a function"); -} - -void -munlock (const std::string& nm) -{ - octave_value val = symbol_table::find_function (nm); - - if (val.is_defined ()) - { - octave_function *fcn = val.function_value (); - - if (fcn) - fcn->unlock (); - } -} - -bool -mislocked (const std::string& nm) -{ - bool retval = false; - - octave_value val = symbol_table::find_function (nm); - - if (val.is_defined ()) - { - octave_function *fcn = val.function_value (); - - if (fcn) - retval = fcn->islocked (); - } - - return retval; -} - -DEFUN (mlock, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mlock ()\n\ -Lock the current function into memory so that it can't be cleared.\n\ -@seealso{munlock, mislocked, persistent}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 0) - { - octave_function *fcn = octave_call_stack::caller (); - - if (fcn) - fcn->lock (); - else - error ("mlock: invalid use outside a function"); - } - else - print_usage (); - - return retval; -} - -DEFUN (munlock, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} munlock ()\n\ -@deftypefnx {Built-in Function} {} munlock (@var{fcn})\n\ -Unlock the named function @var{fcn}. If no function is named\n\ -then unlock the current function.\n\ -@seealso{mlock, mislocked, persistent}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - munlock (name); - else - error ("munlock: FCN must be a string"); - } - else if (args.length () == 0) - { - octave_function *fcn = octave_call_stack::caller (); - - if (fcn) - fcn->unlock (); - else - error ("munlock: invalid use outside a function"); - } - else - print_usage (); - - return retval; -} - - -DEFUN (mislocked, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mislocked ()\n\ -@deftypefnx {Built-in Function} {} mislocked (@var{fcn})\n\ -Return true if the named function @var{fcn} is locked. If no function is\n\ -named then return true if the current function is locked.\n\ -@seealso{mlock, munlock, persistent}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - retval = mislocked (name); - else - error ("mislocked: FCN must be a string"); - } - else if (args.length () == 0) - { - octave_function *fcn = octave_call_stack::caller (); - - if (fcn) - retval = fcn->islocked (); - else - error ("mislocked: invalid use outside a function"); - } - else - print_usage (); - - return retval; -} - -// Deleting names from the symbol tables. - -static inline bool -name_matches_any_pattern (const std::string& nm, const string_vector& argv, - int argc, int idx, bool have_regexp = false) -{ - bool retval = false; - - for (int k = idx; k < argc; k++) - { - std::string patstr = argv[k]; - if (! patstr.empty ()) - { - if (have_regexp) - { - if (is_regexp_match (patstr, nm)) - { - retval = true; - break; - } - } - else - { - glob_match pattern (patstr); - - if (pattern.match (nm)) - { - retval = true; - break; - } - } - } - } - - return retval; -} - -static inline void -maybe_warn_exclusive (bool exclusive) -{ - if (exclusive) - warning ("clear: ignoring --exclusive option"); -} - -static void -do_clear_functions (const string_vector& argv, int argc, int idx, - bool exclusive = false) -{ - if (idx == argc) - symbol_table::clear_functions (); - else - { - if (exclusive) - { - string_vector fcns = symbol_table::user_function_names (); - - int fcount = fcns.length (); - - for (int i = 0; i < fcount; i++) - { - std::string nm = fcns[i]; - - if (! name_matches_any_pattern (nm, argv, argc, idx)) - symbol_table::clear_function (nm); - } - } - else - { - while (idx < argc) - symbol_table::clear_function_pattern (argv[idx++]); - } - } -} - -static void -do_clear_globals (const string_vector& argv, int argc, int idx, - bool exclusive = false) -{ - if (idx == argc) - { - string_vector gvars = symbol_table::global_variable_names (); - - int gcount = gvars.length (); - - for (int i = 0; i < gcount; i++) - symbol_table::clear_global (gvars[i]); - } - else - { - if (exclusive) - { - string_vector gvars = symbol_table::global_variable_names (); - - int gcount = gvars.length (); - - for (int i = 0; i < gcount; i++) - { - std::string nm = gvars[i]; - - if (! name_matches_any_pattern (nm, argv, argc, idx)) - symbol_table::clear_global (nm); - } - } - else - { - while (idx < argc) - symbol_table::clear_global_pattern (argv[idx++]); - } - } -} - -static void -do_clear_variables (const string_vector& argv, int argc, int idx, - bool exclusive = false, bool have_regexp = false) -{ - if (idx == argc) - symbol_table::clear_variables (); - else - { - if (exclusive) - { - string_vector lvars = symbol_table::variable_names (); - - int lcount = lvars.length (); - - for (int i = 0; i < lcount; i++) - { - std::string nm = lvars[i]; - - if (! name_matches_any_pattern (nm, argv, argc, idx, have_regexp)) - symbol_table::clear_variable (nm); - } - } - else - { - if (have_regexp) - while (idx < argc) - symbol_table::clear_variable_regexp (argv[idx++]); - else - while (idx < argc) - symbol_table::clear_variable_pattern (argv[idx++]); - } - } -} - -static void -do_clear_symbols (const string_vector& argv, int argc, int idx, - bool exclusive = false) -{ - if (idx == argc) - symbol_table::clear_variables (); - else - { - if (exclusive) - { - // FIXME -- is this really what we want, or do we - // somehow want to only clear the functions that are not - // shadowed by local variables? It seems that would be a - // bit harder to do. - - do_clear_variables (argv, argc, idx, exclusive); - do_clear_functions (argv, argc, idx, exclusive); - } - else - { - while (idx < argc) - symbol_table::clear_symbol_pattern (argv[idx++]); - } - } -} - -static void -do_matlab_compatible_clear (const string_vector& argv, int argc, int idx) -{ - // This is supposed to be mostly Matlab compatible. - - for (; idx < argc; idx++) - { - if (argv[idx] == "all" - && ! symbol_table::is_local_variable ("all")) - { - symbol_table::clear_all (); - } - else if (argv[idx] == "functions" - && ! symbol_table::is_local_variable ("functions")) - { - do_clear_functions (argv, argc, ++idx); - } - else if (argv[idx] == "global" - && ! symbol_table::is_local_variable ("global")) - { - do_clear_globals (argv, argc, ++idx); - } - else if (argv[idx] == "variables" - && ! symbol_table::is_local_variable ("variables")) - { - symbol_table::clear_variables (); - } - else if (argv[idx] == "classes" - && ! symbol_table::is_local_variable ("classes")) - { - symbol_table::clear_objects (); - octave_class::clear_exemplar_map (); - } - else - { - symbol_table::clear_symbol_pattern (argv[idx]); - } - } -} - -#define CLEAR_OPTION_ERROR(cond) \ - do \ - { \ - if (cond) \ - { \ - print_usage (); \ - return retval; \ - } \ - } \ - while (0) - -DEFUN (clear, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} clear [options] pattern @dots{}\n\ -Delete the names matching the given patterns from the symbol table. The\n\ -pattern may contain the following special characters:\n\ -\n\ -@table @code\n\ -@item ?\n\ -Match any single character.\n\ -\n\ -@item *\n\ -Match zero or more characters.\n\ -\n\ -@item [ @var{list} ]\n\ -Match the list of characters specified by @var{list}. If the first\n\ -character is @code{!} or @code{^}, match all characters except those\n\ -specified by @var{list}. For example, the pattern @samp{[a-zA-Z]} will\n\ -match all lowercase and uppercase alphabetic characters.\n\ -@end table\n\ -\n\ -For example, the command\n\ -\n\ -@example\n\ -clear foo b*r\n\ -@end example\n\ -\n\ -@noindent\n\ -clears the name @code{foo} and all names that begin with the letter\n\ -@code{b} and end with the letter @code{r}.\n\ -\n\ -If @code{clear} is called without any arguments, all user-defined\n\ -variables (local and global) are cleared from the symbol table. If\n\ -@code{clear} is called with at least one argument, only the visible\n\ -names matching the arguments are cleared. For example, suppose you have\n\ -defined a function @code{foo}, and then hidden it by performing the\n\ -assignment @code{foo = 2}. Executing the command @kbd{clear foo} once\n\ -will clear the variable definition and restore the definition of\n\ -@code{foo} as a function. Executing @kbd{clear foo} a second time will\n\ -clear the function definition.\n\ -\n\ -The following options are available in both long and short form\n\ -\n\ -@table @code\n\ -@item -all, -a\n\ -Clears all local and global user-defined variables and all functions\n\ -from the symbol table.\n\ -\n\ -@item -exclusive, -x\n\ -Clears the variables that don't match the following pattern.\n\ -\n\ -@item -functions, -f\n\ -Clears the function names and the built-in symbols names.\n\ -\n\ -@item -global, -g\n\ -Clears the global symbol names.\n\ -\n\ -@item -variables, -v\n\ -Clears the local variable names.\n\ -\n\ -@item -classes, -c\n\ -Clears the class structure table and clears all objects.\n\ -\n\ -@item -regexp, -r\n\ -The arguments are treated as regular expressions as any variables that\n\ -match will be cleared.\n\ -@end table\n\ -\n\ -With the exception of @code{exclusive}, all long options can be used\n\ -without the dash as well.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("clear"); - - if (! error_state) - { - if (argc == 1) - { - do_clear_globals (argv, argc, 1); - do_clear_variables (argv, argc, 1); - } - else - { - int idx = 0; - - bool clear_all = false; - bool clear_functions = false; - bool clear_globals = false; - bool clear_variables = false; - bool clear_objects = false; - bool exclusive = false; - bool have_regexp = false; - bool have_dash_option = false; - - while (++idx < argc) - { - if (argv[idx] == "-all" || argv[idx] == "-a") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_all = true; - } - else if (argv[idx] == "-exclusive" || argv[idx] == "-x") - { - have_dash_option = true; - exclusive = true; - } - else if (argv[idx] == "-functions" || argv[idx] == "-f") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_functions = true; - } - else if (argv[idx] == "-global" || argv[idx] == "-g") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_globals = true; - } - else if (argv[idx] == "-variables" || argv[idx] == "-v") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_variables = true; - } - else if (argv[idx] == "-classes" || argv[idx] == "-c") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_objects = true; - } - else if (argv[idx] == "-regexp" || argv[idx] == "-r") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - have_regexp = true; - } - else - break; - } - - if (idx <= argc) - { - if (! have_dash_option) - { - do_matlab_compatible_clear (argv, argc, idx); - } - else - { - if (clear_all) - { - maybe_warn_exclusive (exclusive); - - if (++idx < argc) - warning - ("clear: ignoring extra arguments after -all"); - - symbol_table::clear_all (); - } - else if (have_regexp) - { - do_clear_variables (argv, argc, idx, exclusive, true); - } - else if (clear_functions) - { - do_clear_functions (argv, argc, idx, exclusive); - } - else if (clear_globals) - { - do_clear_globals (argv, argc, idx, exclusive); - } - else if (clear_variables) - { - do_clear_variables (argv, argc, idx, exclusive); - } - else if (clear_objects) - { - symbol_table::clear_objects (); - octave_class::clear_exemplar_map (); - } - else - { - do_clear_symbols (argv, argc, idx, exclusive); - } - } - } - } - } - - return retval; -} - -DEFUN (whos_line_format, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} whos_line_format ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} whos_line_format (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} whos_line_format (@var{new_val}, \"local\")\n\ -Query or set the format string used by the command @code{whos}.\n\ -\n\ -A full format string is:\n\ -@c Set example in small font to prevent overfull line\n\ -\n\ -@smallexample\n\ -%[modifier][:width[:left-min[:balance]]];\n\ -@end smallexample\n\ -\n\ -The following command sequences are available:\n\ -\n\ -@table @code\n\ -@item %a\n\ -Prints attributes of variables (g=global, p=persistent,\n\ -f=formal parameter, a=automatic variable).\n\ -\n\ -@item %b\n\ -Prints number of bytes occupied by variables.\n\ -\n\ -@item %c\n\ -Prints class names of variables.\n\ -\n\ -@item %e\n\ -Prints elements held by variables.\n\ -\n\ -@item %n\n\ -Prints variable names.\n\ -\n\ -@item %s\n\ -Prints dimensions of variables.\n\ -\n\ -@item %t\n\ -Prints type names of variables.\n\ -@end table\n\ -\n\ -Every command may also have an alignment modifier:\n\ -\n\ -@table @code\n\ -@item l\n\ -Left alignment.\n\ -\n\ -@item r\n\ -Right alignment (default).\n\ -\n\ -@item c\n\ -Column-aligned (only applicable to command %s).\n\ -@end table\n\ -\n\ -The @code{width} parameter is a positive integer specifying the minimum\n\ -number of columns used for printing. No maximum is needed as the field will\n\ -auto-expand as required.\n\ -\n\ -The parameters @code{left-min} and @code{balance} are only available when the\n\ -column-aligned modifier is used with the command @samp{%s}.\n\ -@code{balance} specifies the column number within the field width which will\n\ -be aligned between entries. Numbering starts from 0 which indicates the\n\ -leftmost column. @code{left-min} specifies the minimum field width to the\n\ -left of the specified balance column.\n\ -\n\ -The default format is\n\ -@code{\" %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\\n\"}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{whos}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (whos_line_format); -} - -static std::string Vmissing_function_hook = "unimplemented"; - -DEFUN (missing_function_hook, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} missing_function_hook ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} missing_function_hook (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} missing_function_hook (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the function to call when\n\ -an unknown identifier is requested.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (missing_function_hook); -} - -void maybe_missing_function_hook (const std::string& name) -{ - // Don't do this if we're handling errors. - if (buffer_error_messages == 0 && ! Vmissing_function_hook.empty ()) - { - // Ensure auto-restoration. - unwind_protect frame; - frame.protect_var (Vmissing_function_hook); - - // Clear the variable prior to calling the function. - const std::string func_name = Vmissing_function_hook; - Vmissing_function_hook.clear (); - - // Call. - feval (func_name, octave_value (name)); - } -} - -DEFUN (__varval__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __varval__ (@var{name})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - retval = symbol_table::varval (args(0).string_value ()); - else - error ("__varval__: expecting argument to be variable name"); - } - else - print_usage (); - - return retval; -} diff -r d02b229ce693 -r a132d206a36a src/variables.h --- a/src/variables.h Thu Aug 02 12:12:00 2012 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,147 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton - -This file is part of Octave. - -Octave is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 3 of the License, or (at your -option) any later version. - -Octave is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -for more details. - -You should have received a copy of the GNU General Public License -along with Octave; see the file COPYING. If not, see -. - -*/ - -#if !defined (octave_variables_h) -#define octave_variables_h 1 - -class octave_function; -class octave_user_function; - -class tree_identifier; -class octave_value; -class octave_value_list; -class octave_builtin; -class string_vector; - -#include -#include - -#include - -#include "ov.h" -#include "ov-builtin.h" -#include "symtab.h" - -extern OCTINTERP_API void clear_mex_functions (void); - -extern OCTINTERP_API octave_function * -is_valid_function (const octave_value&, const std::string& = std::string (), - bool warn = false); - -extern OCTINTERP_API octave_function * -is_valid_function (const std::string&, const std::string& = std::string (), - bool warn = false); - -extern OCTINTERP_API octave_function * -extract_function (const octave_value& arg, const std::string& warn_for, - const std::string& fname, const std::string& header, - const std::string& trailer); - -extern OCTINTERP_API string_vector -get_struct_elts (const std::string& text); - -extern OCTINTERP_API string_vector -generate_struct_completions (const std::string& text, std::string& prefix, - std::string& hint); - -extern OCTINTERP_API bool -looks_like_struct (const std::string& text); - -extern OCTINTERP_API int -symbol_exist (const std::string& name, const std::string& type = "any"); - -extern OCTINTERP_API std::string -unique_symbol_name (const std::string& basename); - -extern OCTINTERP_API octave_value lookup_function_handle (const std::string& nm); - -extern OCTINTERP_API octave_value -get_global_value (const std::string& nm, bool silent = false); - -extern OCTINTERP_API void -set_global_value (const std::string& nm, const octave_value& val); - -extern OCTINTERP_API octave_value -get_top_level_value (const std::string& nm, bool silent = false); - -extern OCTINTERP_API void -set_top_level_value (const std::string& nm, const octave_value& val); - -extern OCTINTERP_API octave_value -set_internal_variable (bool& var, const octave_value_list& args, - int nargout, const char *nm); - -extern OCTINTERP_API octave_value -set_internal_variable (char& var, const octave_value_list& args, - int nargout, const char *nm); - -extern OCTINTERP_API octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, - int minval = INT_MIN, int maxval = INT_MAX); - -extern OCTINTERP_API octave_value -set_internal_variable (double& var, const octave_value_list& args, - int nargout, const char *nm, - double minval = DBL_MIN, double maxval = DBL_MAX); - -extern OCTINTERP_API octave_value -set_internal_variable (std::string& var, const octave_value_list& args, - int nargout, const char *nm, bool empty_ok = true); - -extern OCTINTERP_API octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, const char **choices); - -#define SET_INTERNAL_VARIABLE(NM) \ - set_internal_variable (V ## NM, args, nargout, #NM) - -#define SET_NONEMPTY_INTERNAL_STRING_VARIABLE(NM) \ - set_internal_variable (V ## NM, args, nargout, #NM, false) - -#define SET_INTERNAL_VARIABLE_WITH_LIMITS(NM, MINVAL, MAXVAL) \ - set_internal_variable (V ## NM, args, nargout, #NM, MINVAL, MAXVAL) - -// in the following, CHOICES must be a C string array terminated by null. -#define SET_INTERNAL_VARIABLE_CHOICES(NM, CHOICES) \ - set_internal_variable (V ## NM, args, nargout, #NM, CHOICES) - -extern OCTINTERP_API std::string builtin_string_variable (const std::string&); -extern OCTINTERP_API int builtin_real_scalar_variable (const std::string&, double&); -extern OCTINTERP_API octave_value builtin_any_variable (const std::string&); - -extern OCTINTERP_API void bind_ans (const octave_value& val, bool print); - -extern OCTINTERP_API void -bind_internal_variable (const std::string& fname, const octave_value& val); - -extern OCTINTERP_API void mlock (void); -extern OCTINTERP_API void munlock (const std::string&); -extern OCTINTERP_API bool mislocked (const std::string&); - -extern OCTINTERP_API void clear_function (const std::string& nm); -extern OCTINTERP_API void clear_variable (const std::string& nm); -extern OCTINTERP_API void clear_symbol (const std::string& nm); - -extern OCTINTERP_API void maybe_missing_function_hook (const std::string& name); - -#endif diff -r d02b229ce693 -r a132d206a36a src/version.in.h --- a/src/version.in.h Thu Aug 02 12:12:00 2012 +0200 +++ b/src/version.in.h Fri Aug 03 14:59:40 2012 -0400 @@ -1,3 +1,4 @@ +// DO NOT EDIT! Generated automatically from version.in.h by configure /* Copyright (C) 1992-2012 John W. Eaton