Mercurial > octave
changeset 26864:041caa61ed34
use get_function_handle instead of extract_function
* cellfun.cc (Fcellfun, Farrayfun): Use get_function_handle instead of
extract_function.
* daspk.cc (daspk_fcn, daspk_jac): Now octave_value objects instead
of a pointers to octave_function objects. Change all uses.
(Fdaspk): Use get_function_handle instead of extract_function.
* dasrt.cc (dasrt_fcn, dasrt_jac, dasrt_cf): Now octave_value objects
instead of a pointers to octave_function objects. Change all uses.
(Fdasrt): Use get_function_handle instead of extract_function.
* dassl.cc (dassl_fcn, dassl_jac): Now octave_value objects instead
of a pointers to octave_function objects. Change all uses.
(Fdassl): Use get_function_handle instead of extract_function.
* lsode.cc (lsode_fcn, lsode_jac): Now octave_value objects instead
of a pointers to octave_function objects. Change all uses.
(Flsode): Use get_function_handle instead of extract_function.
* quad.cc (quad_fcn): Now an octave_value object instead of a pointer
to an octave_function object. Change all uses.
(Fquad): Use get_function_handle instead of extract_function.
New tests.
* quadcc.cc (fcn): Now an octave_value object instead of a pointer
to an octave_function object. Change all uses.
(Fquadcc): Use get_function_handle instead of extract_function.
* __eigs__.cc (eigs_fcn): Now an octave_value object instead of a pointer
to an octave_function object. Change all uses.
(F__eigs__): Use get_function_handle instead of extract_function.
New tests.
* interpreter-private.cc (get_function_handle): Don't scold users for
poor choices.
* variables.h (extract_function): Tag as deprecated.
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Fri, 08 Mar 2019 06:24:34 +0000 |
| parents | c589db954a4e |
| children | dfd0a2cdb621 |
| files | libinterp/corefcn/cellfun.cc libinterp/corefcn/daspk.cc libinterp/corefcn/dasrt.cc libinterp/corefcn/dassl.cc libinterp/corefcn/interpreter-private.cc libinterp/corefcn/interpreter-private.h libinterp/corefcn/lsode.cc libinterp/corefcn/quad.cc libinterp/corefcn/quadcc.cc libinterp/corefcn/variables.h libinterp/dldfcn/__eigs__.cc |
| diffstat | 11 files changed, 200 insertions(+), 383 deletions(-) [+] |
line wrap: on
line diff
--- a/libinterp/corefcn/cellfun.cc Fri Mar 08 02:49:52 2019 +0000 +++ b/libinterp/corefcn/cellfun.cc Fri Mar 08 06:24:34 2019 +0000 @@ -39,6 +39,7 @@ #include "Cell.h" #include "oct-map.h" #include "defun.h" +#include "interpreter-private.h" #include "interpreter.h" #include "parse.h" #include "variables.h" @@ -426,17 +427,7 @@ std::string name = args(0).string_value (); if (! octave::valid_identifier (name)) - { - std::string fcn_name = unique_symbol_name ("__cellfun_fcn__"); - std::string fname = "function y = " + fcn_name + "(x) y = "; - - octave_function *ptr_func - = extract_function (args(0), "cellfun", fcn_name, - fname, "; endfunction"); - - if (ptr_func) - func = octave_value (ptr_func, true); - } + func = octave::get_function_handle (interp, args(0), "x"); else { func = symtab.find_function (name); @@ -1147,17 +1138,7 @@ std::string name = args(0).string_value (); if (! octave::valid_identifier (name)) - { - std::string fcn_name = unique_symbol_name ("__arrayfun_fcn__"); - std::string fname = "function y = " + fcn_name + "(x) y = "; - - octave_function *ptr_func - = extract_function (args(0), "arrayfun", fcn_name, - fname, "; endfunction"); - - if (ptr_func) - func = octave_value (ptr_func, true); - } + func = octave::get_function_handle (interp, args(0), "x"); else { func = symtab.find_function (name);
--- a/libinterp/corefcn/daspk.cc Fri Mar 08 02:49:52 2019 +0000 +++ b/libinterp/corefcn/daspk.cc Fri Mar 08 06:24:34 2019 +0000 @@ -24,6 +24,7 @@ # include "config.h" #endif +#include <list> #include <string> #include "DASPK.h" @@ -31,6 +32,7 @@ #include "defun.h" #include "error.h" #include "errwarn.h" +#include "interpreter-private.h" #include "ovl.h" #include "ov-fcn.h" #include "ov-cell.h" @@ -43,10 +45,10 @@ #include "DASPK-opts.cc" // Global pointer for user defined function required by daspk. -static octave_function *daspk_fcn; +static octave_value daspk_fcn; // Global pointer for optional user defined jacobian function. -static octave_function *daspk_jac; +static octave_value daspk_jac; // Have we warned about imaginary values returned from user function? static bool warned_fcn_imaginary = false; @@ -69,7 +71,7 @@ args(1) = xdot; args(0) = x; - if (daspk_fcn) + if (daspk_fcn.is_defined ()) { octave_value_list tmp; @@ -119,7 +121,7 @@ args(1) = xdot; args(0) = x; - if (daspk_jac) + if (daspk_jac.is_defined ()) { octave_value_list tmp; @@ -269,17 +271,19 @@ frame.protect_var (call_depth); call_depth++; - octave::symbol_table& symtab = interp.get_symbol_table (); - if (call_depth > 1) error ("daspk: invalid recursive call"); std::string fcn_name, fname, jac_name, jname; - daspk_fcn = nullptr; - daspk_jac = nullptr; + + daspk_fcn = octave_value (); + daspk_jac = octave_value (); octave_value f_arg = args(0); + std::list<std::string> fcn_param_names ({"x", "xdot", "t"}); + std::list<std::string> jac_param_names ({"x", "xdot", "t", "cj"}); + if (f_arg.iscell ()) { Cell c = f_arg.cell_value (); @@ -287,99 +291,61 @@ f_arg = c(0); else if (c.numel () == 2) { - if (c(0).is_function_handle () || c(0).is_inline_function ()) - daspk_fcn = c(0).function_value (); - else - { - fcn_name = unique_symbol_name ("__daspk_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, xdot, t) y = "); - daspk_fcn = extract_function (c(0), "daspk", fcn_name, - fname, "; endfunction"); - } + daspk_fcn = octave::get_function_handle (interp, c(0), + fcn_param_names); - if (daspk_fcn) + if (daspk_fcn.is_defined ()) { - if (c(1).is_function_handle () || c(1).is_inline_function ()) - daspk_jac = c(1).function_value (); - else - { - jac_name = unique_symbol_name ("__daspk_jac__"); - jname = "function jac = "; - jname.append (jac_name); - jname.append (" (x, xdot, t, cj) jac = "); - daspk_jac = extract_function (c(1), "daspk", jac_name, - jname, "; endfunction"); + daspk_jac = octave::get_function_handle (interp, c(1), + jac_param_names); - if (! daspk_jac) - { - if (fcn_name.length ()) - symtab.clear_function (fcn_name); - daspk_fcn = nullptr; - } - } + if (daspk_jac.is_undefined ()) + daspk_fcn = octave_value (); } } else error ("daspk: incorrect number of elements in cell array"); } - if (! daspk_fcn && ! f_arg.iscell ()) + if (daspk_fcn.is_undefined () && ! f_arg.iscell ()) { if (f_arg.is_function_handle () || f_arg.is_inline_function ()) - daspk_fcn = f_arg.function_value (); + daspk_fcn = f_arg; else { switch (f_arg.rows ()) { case 1: - do - { - fcn_name = unique_symbol_name ("__daspk_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, xdot, t) y = "); - daspk_fcn = extract_function (f_arg, "daspk", fcn_name, - fname, "; endfunction"); - } - while (0); + daspk_fcn = octave::get_function_handle (interp, f_arg, + fcn_param_names); break; case 2: { string_vector tmp = f_arg.string_vector_value (); - fcn_name = unique_symbol_name ("__daspk_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, xdot, t) y = "); - daspk_fcn = extract_function (tmp(0), "daspk", fcn_name, - fname, "; endfunction"); + daspk_fcn = octave::get_function_handle (interp, tmp(0), + fcn_param_names); - if (daspk_fcn) + if (daspk_fcn.is_defined ()) { - jac_name = unique_symbol_name ("__daspk_jac__"); - jname = "function jac = "; - jname.append (jac_name); - jname.append (" (x, xdot, t, cj) jac = "); - daspk_jac = extract_function (tmp(1), "daspk", jac_name, - jname, "; endfunction"); + daspk_jac = octave::get_function_handle (interp, tmp(1), + jac_param_names); - if (! daspk_jac) - { - if (fcn_name.length ()) - symtab.clear_function (fcn_name); - daspk_fcn = nullptr; - } + if (daspk_jac.is_undefined ()) + daspk_fcn = octave_value (); } } + break; + + default: + error ("daspk: first arg should be a string or 2-element string array"); } } } - if (! daspk_fcn) - return retval; + if (daspk_fcn.is_undefined ()) + error ("daspk: FCN argument is not a valid function name or handle"); ColumnVector state = args(1).xvector_value ("daspk: initial state X_0 must be a vector"); @@ -402,7 +368,7 @@ double tzero = out_times (0); DAEFunc func (daspk_user_function); - if (daspk_jac) + if (daspk_jac.is_defined ()) func.set_jacobian_function (daspk_user_jacobian); DASPK dae (state, deriv, tzero, func); @@ -416,11 +382,6 @@ else output = dae.integrate (out_times, deriv_output); - if (fcn_name.length ()) - symtab.clear_function (fcn_name); - if (jac_name.length ()) - symtab.clear_function (jac_name); - std::string msg = dae.error_message (); if (dae.integration_ok ())
--- a/libinterp/corefcn/dasrt.cc Fri Mar 08 02:49:52 2019 +0000 +++ b/libinterp/corefcn/dasrt.cc Fri Mar 08 06:24:34 2019 +0000 @@ -24,6 +24,7 @@ # include "config.h" #endif +#include <list> #include <string> #include "DASRT.h" @@ -32,6 +33,7 @@ #include "defun.h" #include "error.h" #include "errwarn.h" +#include "interpreter-private.h" #include "ovl.h" #include "ov-fcn.h" #include "ov-cell.h" @@ -44,9 +46,9 @@ #include "DASRT-opts.cc" // Global pointers for user defined function required by dasrt. -static octave_function *dasrt_f; -static octave_function *dasrt_j; -static octave_function *dasrt_cf; +static octave_value dasrt_fcn; +static octave_value dasrt_jac; +static octave_value dasrt_cf; // Have we warned about imaginary values returned from user function? static bool warned_fcn_imaginary = false; @@ -70,13 +72,13 @@ args(1) = xdot; args(0) = x; - if (dasrt_f) + if (dasrt_fcn.is_defined ()) { octave_value_list tmp; try { - tmp = octave::feval (dasrt_f, args, 1); + tmp = octave::feval (dasrt_fcn, args, 1); } catch (octave::execution_exception& e) { @@ -111,7 +113,7 @@ args(1) = t; args(0) = x; - if (dasrt_cf) + if (dasrt_cf.is_defined ()) { octave_value_list tmp; @@ -157,13 +159,13 @@ args(1) = xdot; args(0) = x; - if (dasrt_j) + if (dasrt_jac.is_defined ()) { octave_value_list tmp; try { - tmp = octave::feval (dasrt_j, args, 1); + tmp = octave::feval (dasrt_jac, args, 1); } catch (octave::execution_exception& e) { @@ -353,11 +355,10 @@ int argp = 0; std::string fcn_name, fname, jac_name, jname; - dasrt_f = nullptr; - dasrt_j = nullptr; - dasrt_cf = nullptr; - octave::symbol_table& symtab = interp.get_symbol_table (); + dasrt_fcn = octave_value (); + dasrt_jac = octave_value (); + dasrt_cf = octave_value (); // Check all the arguments. Are they the right animals? @@ -365,6 +366,9 @@ octave_value f_arg = args(0); + std::list<std::string> fcn_param_names ({"x", "xdot", "t"}); + std::list<std::string> jac_param_names ({"x", "xdot", "t", "cj"}); + if (f_arg.iscell ()) { Cell c = f_arg.cell_value (); @@ -372,83 +376,49 @@ f_arg = c(0); else if (c.numel () == 2) { - if (c(0).is_function_handle () || c(0).is_inline_function ()) - dasrt_f = c(0).function_value (); - else - { - fcn_name = unique_symbol_name ("__dasrt_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, xdot, t) y = "); - dasrt_f = extract_function (c(0), "dasrt", fcn_name, fname, - "; endfunction"); - } + dasrt_fcn = octave::get_function_handle (interp, c(0), + fcn_param_names); - if (dasrt_f) + if (dasrt_fcn.is_defined ()) { - if (c(1).is_function_handle () || c(1).is_inline_function ()) - dasrt_j = c(1).function_value (); - else - { - jac_name = unique_symbol_name ("__dasrt_jac__"); - jname = "function jac = "; - jname.append (jac_name); - jname.append (" (x, xdot, t, cj) jac = "); - dasrt_j = extract_function (c(1), "dasrt", jac_name, jname, - "; endfunction"); + dasrt_jac = octave::get_function_handle (interp, c(1), + jac_param_names); - if (! dasrt_j) - { - if (fcn_name.length ()) - symtab.clear_function (fcn_name); - dasrt_f = nullptr; - } - } + if (dasrt_jac.is_undefined ()) + dasrt_fcn = octave_value (); } } else error ("dasrt: incorrect number of elements in cell array"); } - if (! dasrt_f && ! f_arg.iscell ()) + if (dasrt_fcn.is_undefined () && ! f_arg.iscell ()) { if (f_arg.is_function_handle () || f_arg.is_inline_function ()) - dasrt_f = f_arg.function_value (); + dasrt_fcn = f_arg; else { switch (f_arg.rows ()) { case 1: - fcn_name = unique_symbol_name ("__dasrt_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, xdot, t) y = "); - dasrt_f = extract_function (f_arg, "dasrt", fcn_name, fname, - "; endfunction"); + dasrt_fcn = octave::get_function_handle (interp, f_arg, + fcn_param_names); break; case 2: { - string_vector tmp = args(0).string_vector_value (); + string_vector tmp = f_arg.string_vector_value (); - fcn_name = unique_symbol_name ("__dasrt_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, xdot, t) y = "); - dasrt_f = extract_function (tmp(0), "dasrt", fcn_name, - fname, "; endfunction"); + dasrt_fcn = octave::get_function_handle (interp, tmp(0), + fcn_param_names); - if (dasrt_f) + if (dasrt_fcn.is_defined ()) { - jac_name = unique_symbol_name ("__dasrt_jac__"); - jname = "function jac = "; - jname.append (jac_name); - jname.append (" (x, xdot, t, cj) jac = "); - dasrt_j = extract_function (tmp(1), "dasrt", jac_name, - jname, "; endfunction"); + dasrt_jac = octave::get_function_handle (interp, tmp(1), + jac_param_names); - if (! dasrt_j) - dasrt_f = nullptr; + if (dasrt_jac.is_undefined ()) + dasrt_fcn = octave_value (); } } break; @@ -459,8 +429,8 @@ } } - if (! dasrt_f) - return retval; + if (dasrt_fcn.is_undefined ()) + error ("dasrt: FCN argument is not a valid function name or handle"); DAERTFunc func (dasrt_user_f); @@ -475,19 +445,15 @@ } else { - if (args(1).is_function_handle () || args(1).is_inline_function ()) - dasrt_cf = args(1).function_value (); - else if (args(1).is_string ()) + if (args(1).is_function_handle () || args(1).is_inline_function () + || args(1).is_string ()) { - fcn_name = unique_symbol_name ("__dasrt_constraint_fcn__"); - fname = "function g_out = "; - fname.append (fcn_name); - fname.append (" (x, t) g_out = "); - dasrt_cf = extract_function (args(1), "dasrt", fcn_name, fname, - "; endfunction"); + std::list<std::string> cf_param_names ({"x", "t"}); + + dasrt_cf = octave::get_function_handle (interp, args(1), cf_param_names); } - if (dasrt_cf) + if (dasrt_cf.is_defined ()) { argp++; @@ -518,7 +484,7 @@ crit_times_set = true; } - if (dasrt_j) + if (dasrt_jac.is_defined ()) func.set_jacobian_function (dasrt_user_j); DASRT_result output; @@ -532,11 +498,6 @@ else output = dae.integrate (out_times); - if (fcn_name.length ()) - symtab.clear_function (fcn_name); - if (jac_name.length ()) - symtab.clear_function (jac_name); - std::string msg = dae.error_message (); if (dae.integration_ok ())
--- a/libinterp/corefcn/dassl.cc Fri Mar 08 02:49:52 2019 +0000 +++ b/libinterp/corefcn/dassl.cc Fri Mar 08 06:24:34 2019 +0000 @@ -31,6 +31,7 @@ #include "defun.h" #include "error.h" #include "errwarn.h" +#include "interpreter-private.h" #include "ovl.h" #include "ov-fcn.h" #include "ov-cell.h" @@ -43,10 +44,10 @@ #include "DASSL-opts.cc" // Global pointer for user defined function required by dassl. -static octave_function *dassl_fcn; +static octave_value dassl_fcn; // Global pointer for optional user defined jacobian function. -static octave_function *dassl_jac; +static octave_value dassl_jac; // Have we warned about imaginary values returned from user function? static bool warned_fcn_imaginary = false; @@ -69,7 +70,7 @@ args(1) = xdot; args(0) = x; - if (dassl_fcn) + if (dassl_fcn.is_defined ()) { octave_value_list tmp; @@ -119,7 +120,7 @@ args(1) = xdot; args(0) = x; - if (dassl_jac) + if (dassl_jac.is_defined ()) { octave_value_list tmp; @@ -273,14 +274,16 @@ if (call_depth > 1) error ("dassl: invalid recursive call"); - octave::symbol_table& symtab = interp.get_symbol_table (); + std::string fcn_name, fname, jac_name, jname; - std::string fcn_name, fname, jac_name, jname; - dassl_fcn = nullptr; - dassl_jac = nullptr; + dassl_fcn = octave_value (); + dassl_jac = octave_value (); octave_value f_arg = args(0); + std::list<std::string> fcn_param_names ({"x", "xdot", "t"}); + std::list<std::string> jac_param_names ({"x", "xdot", "t", "cj"}); + if (f_arg.iscell ()) { Cell c = f_arg.cell_value (); @@ -288,100 +291,61 @@ f_arg = c(0); else if (c.numel () == 2) { - if (c(0).is_function_handle () || c(0).is_inline_function ()) - dassl_fcn = c(0).function_value (); - else - { - fcn_name = unique_symbol_name ("__dassl_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, xdot, t) y = "); - dassl_fcn = extract_function (c(0), "dassl", fcn_name, fname, - "; endfunction"); - } + dassl_fcn = octave::get_function_handle (interp, c(0), + fcn_param_names); - if (dassl_fcn) + if (dassl_fcn.is_defined ()) { - if (c(1).is_function_handle () || c(1).is_inline_function ()) - dassl_jac = c(1).function_value (); - else - { - jac_name = unique_symbol_name ("__dassl_jac__"); - jname = "function jac = "; - jname.append (jac_name); - jname.append (" (x, xdot, t, cj) jac = "); - dassl_jac = extract_function (c(1), "dassl", jac_name, - jname, "; endfunction"); + dassl_jac = octave::get_function_handle (interp, c(1), + jac_param_names); - if (! dassl_jac) - { - if (fcn_name.length ()) - symtab.clear_function (fcn_name); - dassl_fcn = nullptr; - } - } + if (dassl_jac.is_undefined ()) + dassl_fcn = octave_value (); } } else error ("dassl: incorrect number of elements in cell array"); } - if (! dassl_fcn && ! f_arg.iscell ()) + if (dassl_fcn.is_undefined () && ! f_arg.iscell ()) { if (f_arg.is_function_handle () || f_arg.is_inline_function ()) - dassl_fcn = f_arg.function_value (); + dassl_fcn = f_arg; else { switch (f_arg.rows ()) { case 1: - do - { - fcn_name = unique_symbol_name ("__dassl_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, xdot, t) y = "); - dassl_fcn = extract_function (f_arg, "dassl", fcn_name, - fname, "; endfunction"); - } - while (0); + dassl_fcn = octave::get_function_handle (interp, f_arg, + fcn_param_names); break; case 2: { string_vector tmp = f_arg.string_vector_value (); - fcn_name = unique_symbol_name ("__dassl_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, xdot, t) y = "); - dassl_fcn = extract_function (tmp(0), "dassl", fcn_name, - fname, "; endfunction"); + dassl_fcn = octave::get_function_handle (interp, tmp(0), + fcn_param_names); - if (dassl_fcn) + if (dassl_fcn.is_defined ()) { - jac_name = unique_symbol_name ("__dassl_jac__"); - jname = "function jac = "; - jname.append (jac_name); - jname.append (" (x, xdot, t, cj) jac = "); - dassl_jac = extract_function (tmp(1), "dassl", - jac_name, jname, - "; endfunction"); + dassl_jac = octave::get_function_handle (interp, tmp(1), + jac_param_names); - if (! dassl_jac) - { - if (fcn_name.length ()) - symtab.clear_function (fcn_name); - dassl_fcn = nullptr; - } + if (dassl_jac.is_undefined ()) + dassl_fcn = octave_value (); } } + break; + + default: + error ("dassl: first arg should be a string or 2-element string array"); } } } - if (! dassl_fcn) - return retval; + if (dassl_fcn.is_undefined ()) + error ("dassl: FCN argument is not a valid function name or handle"); ColumnVector state = args(1).xvector_value ("dassl: initial state X_0 must be a vector"); @@ -404,7 +368,7 @@ double tzero = out_times (0); DAEFunc func (dassl_user_function); - if (dassl_jac) + if (dassl_jac.is_defined ()) func.set_jacobian_function (dassl_user_jacobian); DASSL dae (state, deriv, tzero, func); @@ -419,11 +383,6 @@ else output = dae.integrate (out_times, deriv_output); - if (fcn_name.length ()) - symtab.clear_function (fcn_name); - if (jac_name.length ()) - symtab.clear_function (jac_name); - std::string msg = dae.error_message (); if (dae.integration_ok ())
--- a/libinterp/corefcn/interpreter-private.cc Fri Mar 08 02:49:52 2019 +0000 +++ b/libinterp/corefcn/interpreter-private.cc Fri Mar 08 06:24:34 2019 +0000 @@ -213,9 +213,8 @@ fcn = octave_value (new octave_fcn_inline (fstr, parameter_names)); - if (fcn.is_defined ()) - warning_with_id ("Octave:function-from-text", - "get_function_handle: passing function body as text is discouraged; use an anonymous function instead"); + // Possibly warn here that passing the function body in a + // character string is discouraged. return fcn; }
--- a/libinterp/corefcn/interpreter-private.h Fri Mar 08 02:49:52 2019 +0000 +++ b/libinterp/corefcn/interpreter-private.h Fri Mar 08 06:24:34 2019 +0000 @@ -91,7 +91,7 @@ // Convert octave_value object ARG to be a function handle object. It // may be a function handle, inline function, the name of a function, // or the text of an inline function that has the given argument names - // PARAMETER_NAMES. The latter form is deprecated. + // PARAMETER_NAMES. Use of the latter form is discouraged. octave_value get_function_handle (octave::interpreter& interp, const octave_value& arg,
--- a/libinterp/corefcn/lsode.cc Fri Mar 08 02:49:52 2019 +0000 +++ b/libinterp/corefcn/lsode.cc Fri Mar 08 06:24:34 2019 +0000 @@ -24,6 +24,7 @@ # include "config.h" #endif +#include <list> #include <string> #include "LSODE.h" @@ -32,6 +33,7 @@ #include "defun.h" #include "error.h" #include "errwarn.h" +#include "interpreter-private.h" #include "ovl.h" #include "ov-fcn.h" #include "ov-cell.h" @@ -45,10 +47,10 @@ #include "LSODE-opts.cc" // Global pointer for user defined function required by lsode. -static octave_function *lsode_fcn; +static octave_value lsode_fcn; // Global pointer for optional user defined jacobian function used by lsode. -static octave_function *lsode_jac; +static octave_value lsode_jac; // Have we warned about imaginary values returned from user function? static bool warned_fcn_imaginary = false; @@ -66,7 +68,7 @@ args(1) = t; args(0) = x; - if (lsode_fcn) + if (lsode_fcn.is_defined ()) { octave_value_list tmp; @@ -106,7 +108,7 @@ args(1) = t; args(0) = x; - if (lsode_jac) + if (lsode_jac.is_defined ()) { octave_value_list tmp; @@ -275,11 +277,14 @@ octave::symbol_table& symtab = interp.get_symbol_table (); std::string fcn_name, fname, jac_name, jname; - lsode_fcn = nullptr; - lsode_jac = nullptr; + + lsode_fcn = octave_value (); + lsode_jac = octave_value (); octave_value f_arg = args(0); + std::list<std::string> parameter_names ({"x", "t"}); + if (f_arg.iscell ()) { Cell c = f_arg.cell_value (); @@ -287,92 +292,49 @@ f_arg = c(0); else if (c.numel () == 2) { - if (c(0).is_function_handle () || c(0).is_inline_function ()) - lsode_fcn = c(0).function_value (); - else - { - fcn_name = unique_symbol_name ("__lsode_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, t) y = "); - lsode_fcn = extract_function (c(0), "lsode", fcn_name, fname, - "; endfunction"); - } + lsode_fcn = octave::get_function_handle (interp, c(0), + parameter_names); - if (lsode_fcn) + if (lsode_fcn.is_defined ()) { - if (c(1).is_function_handle () || c(1).is_inline_function ()) - lsode_jac = c(1).function_value (); - else - { - jac_name = unique_symbol_name ("__lsode_jac__"); - jname = "function jac = "; - jname.append (jac_name); - jname.append (" (x, t) jac = "); - lsode_jac = extract_function (c(1), "lsode", jac_name, - jname, "; endfunction"); + lsode_jac = octave::get_function_handle (interp, c(1), + parameter_names); - if (! lsode_jac) - { - if (fcn_name.length ()) - symtab.clear_function (fcn_name); - lsode_fcn = nullptr; - } - } + if (lsode_jac.is_undefined ()) + lsode_fcn = octave_value (); } } else error ("lsode: incorrect number of elements in cell array"); } - if (! lsode_fcn && ! f_arg.iscell ()) + if (lsode_fcn.is_undefined () && ! f_arg.iscell ()) { if (f_arg.is_function_handle () || f_arg.is_inline_function ()) - lsode_fcn = f_arg.function_value (); + lsode_fcn = f_arg; else { switch (f_arg.rows ()) { case 1: - do - { - fcn_name = unique_symbol_name ("__lsode_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, t) y = "); - lsode_fcn = extract_function (f_arg, "lsode", fcn_name, - fname, "; endfunction"); - } - while (0); + lsode_fcn = octave::get_function_handle (interp, f_arg, + parameter_names); break; case 2: { string_vector tmp = f_arg.string_vector_value (); - fcn_name = unique_symbol_name ("__lsode_fcn__"); - fname = "function y = "; - fname.append (fcn_name); - fname.append (" (x, t) y = "); - lsode_fcn = extract_function (tmp(0), "lsode", fcn_name, - fname, "; endfunction"); + lsode_fcn = octave::get_function_handle (interp, tmp(0), + parameter_names); - if (lsode_fcn) + if (lsode_fcn.is_defined ()) { - jac_name = unique_symbol_name ("__lsode_jac__"); - jname = "function jac = "; - jname.append (jac_name); - jname.append (" (x, t) jac = "); - lsode_jac = extract_function (tmp(1), "lsode", - jac_name, jname, - "; endfunction"); + lsode_jac = octave::get_function_handle (interp, tmp(1), + parameter_names); - if (! lsode_jac) - { - if (fcn_name.length ()) - symtab.clear_function (fcn_name); - lsode_fcn = nullptr; - } + if (lsode_jac.is_undefined ()) + lsode_fcn = octave_value (); } } break; @@ -383,7 +345,7 @@ } } - if (! lsode_fcn) + if (lsode_fcn.is_undefined ()) error ("lsode: FCN argument is not a valid function name or handle"); ColumnVector state = args(1).xvector_value ("lsode: initial state X_0 must be a vector"); @@ -402,7 +364,8 @@ double tzero = out_times (0); ODEFunc func (lsode_user_function); - if (lsode_jac) + + if (lsode_jac.is_defined ()) func.set_jacobian_function (lsode_user_jacobian); LSODE ode (state, tzero, func);
--- a/libinterp/corefcn/quad.cc Fri Mar 08 02:49:52 2019 +0000 +++ b/libinterp/corefcn/quad.cc Fri Mar 08 06:24:34 2019 +0000 @@ -32,10 +32,11 @@ #include "defun.h" #include "error.h" #include "errwarn.h" +#include "interpreter-private.h" #include "pager.h" #include "parse.h" +#include "ov.h" #include "ovl.h" -#include "ov-fcn.h" #include "unwind-prot.h" #include "utils.h" #include "variables.h" @@ -43,7 +44,7 @@ #include "Quad-opts.cc" // Global pointer for user defined function required by quadrature functions. -static octave_function *quad_fcn; +static octave_value quad_fcn; // Have we warned about imaginary values returned from user function? static bool warned_imaginary = false; @@ -59,7 +60,7 @@ octave_value_list args; args(0) = x; - if (quad_fcn) + if (quad_fcn.is_defined ()) { octave_value_list tmp; @@ -95,7 +96,7 @@ octave_value_list args; args(0) = x; - if (quad_fcn) + if (quad_fcn.is_defined ()) { octave_value_list tmp; @@ -184,24 +185,7 @@ if (call_depth > 1) error ("quad: invalid recursive call"); - std::string fcn_name; - - if (args(0).is_function_handle () || args(0).is_inline_function ()) - quad_fcn = args(0).function_value (); - else - { - fcn_name = unique_symbol_name ("__quad_fcn__"); - std::string fname = "function y = "; - fname.append (fcn_name); - fname.append ("(x) y = "); - quad_fcn = extract_function (args(0), "quad", fcn_name, fname, - "; endfunction"); - octave::symbol_table& symtab = interp.get_symbol_table (); - frame.add_method (symtab, &octave::symbol_table::clear_function, fcn_name); - } - - if (! quad_fcn) - error ("quad: FCN argument is not a valid function name or handle"); + quad_fcn = octave::get_function_handle (interp, args(0), "x"); octave_value_list retval; @@ -430,6 +414,33 @@ %! assert (nfun > 0); %!test +%! [v, ier, nfun, err] = quad (@__f, 0.001, 3); +%! assert (ier == 0 || ier == 1); +%! assert (v, 1.98194120273598, sqrt (eps)); +%! assert (nfun > 0); + +%!test +%! fstr = "x .* sin (1 ./ x) .* sqrt (abs (1 - x))"; +%! [v, ier, nfun, err] = quad (fstr, 0.001, 3); +%! assert (ier == 0 || ier == 1); +%! assert (v, 1.98194120273598, sqrt (eps)); +%! assert (nfun > 0); + +%!test +%! anon_fcn = @(x) x .* sin (1 ./ x) .* sqrt (abs (1 - x)); +%! [v, ier, nfun, err] = quad (anon_fcn, 0.001, 3); +%! assert (ier == 0 || ier == 1); +%! assert (v, 1.98194120273598, sqrt (eps)); +%! assert (nfun > 0); + +%!test +%! inline_fcn = inline ("x .* sin (1 ./ x) .* sqrt (abs (1 - x))", "x"); +%! [v, ier, nfun, err] = quad (inline_fcn, 0.001, 3); +%! assert (ier == 0 || ier == 1); +%! assert (v, 1.98194120273598, sqrt (eps)); +%! assert (nfun > 0); + +%!test %! [v, ier, nfun, err] = quad ("__f", single (0.001), single (3)); %! assert (ier == 0 || ier == 1); %! assert (v, 1.98194120273598, sqrt (eps ("single")));
--- a/libinterp/corefcn/quadcc.cc Fri Mar 08 02:49:52 2019 +0000 +++ b/libinterp/corefcn/quadcc.cc Fri Mar 08 06:24:34 2019 +0000 @@ -33,6 +33,7 @@ #include "defun.h" #include "error.h" +#include "interpreter-private.h" #include "ovl.h" #include "parse.h" #include "utils.h" @@ -1483,8 +1484,8 @@ // The actual integration routine. -DEFUN (quadcc, args, , - doc: /* -*- texinfo -*- +DEFMETHOD (quadcc, interp, args, , + doc: /* -*- texinfo -*- @deftypefn {} {@var{q} =} quadcc (@var{f}, @var{a}, @var{b}) @deftypefnx {} {@var{q} =} quadcc (@var{f}, @var{a}, @var{b}, @var{tol}) @deftypefnx {} {@var{q} =} quadcc (@var{f}, @var{a}, @var{b}, @var{tol}, @var{sing}) @@ -1575,7 +1576,7 @@ // Arguments left and right. int nargin = args.length (); - octave_function *fcn; + octave_value fcn; double a, b, abstol, reltol, *sing; bool issingle; @@ -1600,17 +1601,7 @@ if (nargin < 3) print_usage (); - if (args(0).is_function_handle () || args(0).is_inline_function ()) - fcn = args(0).function_value (); - else - { - std::string fcn_name = unique_symbol_name ("__quadcc_fcn__"); - std::string fname = "function y = "; - fname.append (fcn_name); - fname.append ("(x) y = "); - fcn = extract_function (args(0), "quadcc", fcn_name, fname, - "; endfunction"); - } + fcn = octave::get_function_handle (interp, args(0), "x"); if (! args(1).is_real_scalar ()) error ("quadcc: lower limit of integration (A) must be a real scalar");
--- a/libinterp/corefcn/variables.h Fri Mar 08 02:49:52 2019 +0000 +++ b/libinterp/corefcn/variables.h Fri Mar 08 06:24:34 2019 +0000 @@ -53,6 +53,7 @@ is_valid_function (const std::string&, const std::string& = "", bool warn = false); +OCTAVE_DEPRECATED (6, "use 'octave::get_function_handle' instead") extern OCTINTERP_API octave_function * extract_function (const octave_value& arg, const std::string& warn_for, const std::string& fname, const std::string& header,
--- a/libinterp/dldfcn/__eigs__.cc Fri Mar 08 02:49:52 2019 +0000 +++ b/libinterp/dldfcn/__eigs__.cc Fri Mar 08 06:24:34 2019 +0000 @@ -34,6 +34,7 @@ #include "defun-dld.h" #include "error.h" #include "errwarn.h" +#include "interpreter-private.h" #include "oct-map.h" #include "ov.h" #include "ovl.h" @@ -44,7 +45,7 @@ #if defined (HAVE_ARPACK) // Global pointer for user defined function. -static octave_function *eigs_fcn = nullptr; +static octave_value eigs_fcn; // Have we warned about imaginary values returned from user function? static bool warned_imaginary = false; @@ -59,7 +60,7 @@ octave_value_list args; args(0) = x; - if (eigs_fcn) + if (eigs_fcn.is_defined ()) { octave_value_list tmp; @@ -99,7 +100,7 @@ octave_value_list args; args(0) = x; - if (eigs_fcn) + if (eigs_fcn.is_defined ()) { octave_value_list tmp; @@ -206,20 +207,9 @@ 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 (); + eigs_fcn = octave::get_function_handle (interp, args(0), "x"); - if (! eigs_fcn) + if (eigs_fcn.is_undefined ()) error ("eigs: unknown function"); if (nargin < 2)