GNU Octave  4.2.1
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
ov-usr-fcn.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 1996-2017 John W. Eaton
4 
5 This file is part of Octave.
6 
7 Octave is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 3 of the License, or (at your
10 option) any later version.
11 
12 Octave is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16 
17 You should have received a copy of the GNU General Public License
18 along with Octave; see the file COPYING. If not, see
19 <http://www.gnu.org/licenses/>.
20 
21 */
22 
23 #if defined (HAVE_CONFIG_H)
24 # include "config.h"
25 #endif
26 
27 #include <sstream>
28 
29 #include "str-vec.h"
30 
31 #include "builtin-defun-decls.h"
32 #include "call-stack.h"
33 #include <defaults.h>
34 #include "Cell.h"
35 #include "defun.h"
36 #include "error.h"
37 #include "errwarn.h"
38 #include "input.h"
39 #include "ovl.h"
40 #include "ov-usr-fcn.h"
41 #include "ov.h"
42 #include "pager.h"
43 #include "pt-eval.h"
44 #include "pt-jit.h"
45 #include "pt-jump.h"
46 #include "pt-misc.h"
47 #include "pt-pr-code.h"
48 #include "pt-stmt.h"
49 #include "pt-walk.h"
50 #include "symtab.h"
51 #include "interpreter.h"
52 #include "unwind-prot.h"
53 #include "utils.h"
54 #include "parse.h"
55 #include "profiler.h"
56 #include "variables.h"
57 #include "ov-fcn-handle.h"
58 
59 // Whether to optimize subsasgn method calls.
60 static bool Voptimize_subsasgn_calls = true;
61 
62 // The character to fill with when creating string arrays.
63 extern char Vstring_fill_char; // see pt-mat.cc
64 
65 std::map<std::string, octave_value>
67 {
68  return std::map<std::string, octave_value> ();
69 }
70 
71 // User defined scripts.
72 
74  "user-defined script",
75  "user-defined script");
76 
78  : octave_user_code (), cmd_list (0), file_name (),
79  t_parsed (static_cast<time_t> (0)),
80  t_checked (static_cast<time_t> (0)),
81  call_depth (-1)
82 { }
83 
85  const std::string& nm,
86  tree_statement_list *cmds,
87  const std::string& ds)
88  : octave_user_code (nm, ds), cmd_list (cmds), file_name (fnm),
89  t_parsed (static_cast<time_t> (0)),
90  t_checked (static_cast<time_t> (0)),
91  call_depth (-1)
92 {
93  if (cmd_list)
95 }
96 
98  const std::string& nm,
99  const std::string& ds)
100  : octave_user_code (nm, ds), cmd_list (0), file_name (fnm),
101  t_parsed (static_cast<time_t> (0)),
102  t_checked (static_cast<time_t> (0)),
103  call_depth (-1)
104 { }
105 
107 {
108  if (cmd_list)
110 
111  delete cmd_list;
112 }
113 
116  const std::list<octave_value_list>&, int)
117 {
118  error ("invalid use of script %s in index expression", file_name.c_str ());
119 }
120 
123  const octave_value_list& args)
124 {
126 
128 
129  if (args.length () != 0 || nargout != 0)
130  error ("invalid call to script %s", file_name.c_str ());
131 
132  if (cmd_list)
133  {
134  frame.protect_var (call_depth);
135  call_depth++;
136 
138  error ("max_recursion_depth exceeded");
139 
141 
143 
144  // Update line number even if debugging.
146  Vtrack_line_num = true;
147 
150 
152 
154 
156 
159 
162  }
163 
164  return retval;
165 }
166 
167 void
169 {
170  tw.visit_octave_user_script (*this);
171 }
172 
173 // User defined functions.
174 
176  "user-defined function",
177  "user-defined function");
178 
179 // Ugh. This really needs to be simplified (code/data?
180 // extrinsic/intrinsic state?).
181 
185  : octave_user_code ("", ""),
186  param_list (pl), ret_list (rl), cmd_list (cl),
187  lead_comm (), trail_comm (), file_name (),
188  location_line (0), location_column (0),
189  parent_name (), t_parsed (static_cast<time_t> (0)),
190  t_checked (static_cast<time_t> (0)),
191  system_fcn_file (false), call_depth (-1),
192  num_named_args (param_list ? param_list->length () : 0),
193  subfunction (false), inline_function (false),
194  anonymous_function (false), nested_function (false),
195  class_constructor (none), class_method (false),
196  parent_scope (-1), local_scope (sid),
197  curr_unwind_protect_frame (0)
198 #if defined (HAVE_LLVM)
199  , jit_info (0)
200 #endif
201 {
202  if (cmd_list)
203  cmd_list->mark_as_function_body ();
204 
205  if (local_scope >= 0)
206  symbol_table::set_curr_fcn (this, local_scope);
207 }
208 
210 {
211  if (cmd_list)
213 
214  delete param_list;
215  delete ret_list;
216  delete cmd_list;
217  delete lead_comm;
218  delete trail_comm;
219 
220 #if defined (HAVE_LLVM)
221  delete jit_info;
222 #endif
223 
224  // FIXME: this is really playing with fire.
226 }
227 
230 {
231  ret_list = t;
232 
233  return this;
234 }
235 
236 void
238 {
239  file_name = nm;
240 }
241 
242 // If there is no explicit end statement at the end of the function,
243 // relocate the no_op that was generated for the end of file condition
244 // to appear on the next line after the last statement in the file, or
245 // the next line after the function keyword if there are no statements.
246 // More precisely, the new location should probably be on the next line
247 // after the end of the parameter list, but we aren't tracking that
248 // information (yet).
249 
250 void
252 {
253  if (cmd_list && ! cmd_list->empty ())
254  {
255  tree_statement *last_stmt = cmd_list->back ();
256 
257  if (last_stmt && last_stmt->is_end_of_fcn_or_script ()
258  && last_stmt->is_end_of_file ())
259  {
261  next_to_last_elt = cmd_list->rbegin ();
262 
263  next_to_last_elt++;
264 
265  int new_eof_line;
266  int new_eof_col;
267 
268  if (next_to_last_elt == cmd_list->rend ())
269  {
270  new_eof_line = beginning_line ();
271  new_eof_col = beginning_column ();
272  }
273  else
274  {
275  tree_statement *next_to_last_stmt = *next_to_last_elt;
276 
277  new_eof_line = next_to_last_stmt->line ();
278  new_eof_col = next_to_last_stmt->column ();
279  }
280 
281  last_stmt->set_location (new_eof_line + 1, new_eof_col);
282  }
283  }
284 }
285 
286 void
288 {
289  std::map<std::string, octave_value> fcns = subfunctions ();
290 
291  if (! fcns.empty ())
292  {
293  for (std::map<std::string, octave_value>::iterator p = fcns.begin ();
294  p != fcns.end (); p++)
295  {
297 
298  if (f)
300  }
301  }
302 
304 }
305 
308 {
309  std::ostringstream result;
310 
311  if (is_anonymous_function ())
312  result << "anonymous@" << fcn_file_name ()
313  << ":" << location_line << ":" << location_column;
314  else if (is_subfunction ())
315  result << parent_fcn_name () << ">" << name ();
316  else if (is_class_method ())
317  result << "@" << dispatch_class () << "/" << name ();
319  result << "@" << name ();
320  else if (is_inline_function ())
321  result << "inline@" << fcn_file_name ()
322  << ":" << location_line << ":" << location_column;
323  else
324  result << name ();
325 
326  return result.str ();
327 }
328 
329 void
331 {
332  if (! file_name.empty ())
333  {
334  // We really should stash the whole path to the file we found,
335  // when we looked it up, to avoid possible race conditions...
336  // FIXME
337  //
338  // We probably also don't need to get the library directory
339  // every time, but since this function is only called when the
340  // function file is parsed, it probably doesn't matter that
341  // much.
342 
344 
345  if (Vfcn_file_dir == ff_name.substr (0, Vfcn_file_dir.length ()))
346  system_fcn_file = true;
347  }
348  else
349  system_fcn_file = false;
350 }
351 
352 bool
354 {
355  return (param_list && param_list->takes_varargs ());
356 }
357 
358 bool
360 {
361  return (ret_list && ret_list->takes_varargs ());
362 }
363 
364 void
366 {
368 }
369 
370 void
372 {
374 }
375 
376 std::map<std::string, octave_value>
378 {
380 }
381 
382 bool
384 {
385  return ! subfcn_names.empty ();
386 }
387 
388 void
390  (const std::list<std::string>& names)
391 {
392  subfcn_names = names;
393 }
394 
397 {
399 
400  octave_idx_type n = args.length () - num_named_args;
401 
402  if (n > 0)
403  retval = args.slice (num_named_args, n);
404 
405  return retval;
406 }
407 
410  const std::list<octave_value_list>& idx,
411  int nargout)
412 {
413  return octave_user_function::subsref (type, idx, nargout, 0);
414 }
415 
418  const std::list<octave_value_list>& idx,
419  int nargout,
420  const std::list<octave_lvalue>* lvalue_list)
421 {
423 
424  switch (type[0])
425  {
426  case '(':
427  {
428  int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout;
429 
430  retval = do_multi_index_op (tmp_nargout, idx.front (),
431  idx.size () == 1 ? lvalue_list : 0);
432  }
433  break;
434 
435  case '{':
436  case '.':
437  {
438  std::string nm = type_name ();
439  error ("%s cannot be indexed with %c", nm.c_str (), type[0]);
440  }
441  break;
442 
443  default:
444  panic_impossible ();
445  }
446 
447  // FIXME: perhaps there should be an
448  // octave_value_list::next_subsref member function? See also
449  // octave_builtin::subsref.
450 
451  if (idx.size () > 1)
452  retval = retval(0).next_subsref (nargout, type, idx);
453 
454  return retval;
455 }
456 
459  const octave_value_list& args)
460 {
461  return do_multi_index_op (nargout, args, 0);
462 }
463 
466  const octave_value_list& _args,
467  const std::list<octave_lvalue>* lvalue_list)
468 {
470 
471  if (! cmd_list)
472  return retval;
473 
474  // If this function is a classdef constructor, extract the first input
475  // argument, which must be the partially constructed object instance.
476 
477  octave_value_list args (_args);
478  octave_value_list ret_args;
479 
481  {
482  if (args.length () > 0)
483  {
484  ret_args = args.slice (0, 1, true);
485  args = args.slice (1, args.length () - 1, true);
486  }
487  else
488  panic_impossible ();
489  }
490 
491 #if defined (HAVE_LLVM)
492  if (is_special_expr ()
493  && tree_jit::execute (*this, args, retval))
494  return retval;
495 #endif
496 
498 
499  frame.protect_var (call_depth);
500  call_depth++;
501 
503  error ("max_recursion_depth exceeded");
504 
505  // Save old and set current symbol table context, for
506  // eval_undefined_error().
507 
508  int context = active_context ();
509 
510  octave_call_stack::push (this, local_scope, context);
511 
513  Vtrack_line_num = true; // update source line numbers, even if debugging
515 
516  if (call_depth > 0 && ! is_anonymous_function ())
517  {
519 
521  }
522 
523  string_vector arg_names = args.name_tags ();
524 
525  if (param_list && ! param_list->varargs_only ())
527 
528  // For classdef constructor, pre-populate the output arguments
529  // with the pre-initialized object instance, extracted above.
530 
532  {
533  if (! ret_list)
534  error ("%s: invalid classdef constructor, no output argument defined",
535  dispatch_class ().c_str ());
536 
537  ret_list->define_from_arg_vector (ret_args);
538  }
539 
540  // Force parameter list to be undefined when this function exits.
541  // Doing so decrements the reference counts on the values of local
542  // variables that are also named function parameters.
543 
544  if (param_list)
546 
547  // Force return list to be undefined when this function exits.
548  // Doing so decrements the reference counts on the values of local
549  // variables that are also named values returned by this function.
550 
551  if (ret_list)
553 
554  if (call_depth == 0)
555  {
556  // Force symbols to be undefined again when this function
557  // exits.
558  //
559  // This cleanup function is added to the unwind_protect stack
560  // after the calls to clear the parameter lists so that local
561  // variables will be cleared before the parameter lists are
562  // cleared. That way, any function parameters that have been
563  // declared global will be unmarked as global before they are
564  // undefined by the clear_param_list cleanup function.
565 
567  }
568 
569  bind_automatic_vars (arg_names, args.length (), nargout,
570  all_va_args (args), lvalue_list);
571 
573 
574  bool echo_commands = (Vecho_executing_commands & ECHO_FUNCTIONS);
575 
576  if (echo_commands)
578 
579  // Set pointer to the current unwind_protect frame to allow
580  // certain builtins register simple cleanup in a very optimized manner.
581  // This is *not* intended as a general-purpose on-cleanup mechanism,
584 
585  // Evaluate the commands that make up the function.
586 
589 
591 
592  if (is_special_expr ())
593  {
594  assert (cmd_list->length () == 1);
595 
596  tree_statement *stmt = cmd_list->front ();
597 
598  tree_expression *expr = stmt->expression ();
599 
600  if (expr)
601  {
602  octave_call_stack::set_location (stmt->line (), stmt->column ());
603 
604  retval = (lvalue_list
605  ? expr->rvalue (nargout, lvalue_list)
606  : expr->rvalue (nargout));
607  }
608  }
609  else
611 
613 
614  if (echo_commands)
616 
619 
622 
623  // Copy return values out.
624 
625  if (ret_list && ! is_special_expr ())
626  {
628 
629  Cell varargout;
630 
631  if (ret_list->takes_varargs ())
632  {
633  octave_value varargout_varval = symbol_table::varval ("varargout");
634 
635  if (varargout_varval.is_defined ())
636  varargout = varargout_varval.xcell_value ("varargout must be a cell array object");
637  }
638 
639  retval = ret_list->convert_to_const_vector (nargout, varargout);
640  }
641 
642  return retval;
643 }
644 
645 void
647 {
648  tw.visit_octave_user_function (*this);
649 }
650 
653 {
654  assert (is_special_expr ());
655  assert (cmd_list->length () == 1);
656 
657  tree_statement *stmt = cmd_list->front ();
658  return stmt->expression ();
659 }
660 
661 bool
663 {
664  bool retval = false;
665  if (Voptimize_subsasgn_calls
666  && param_list && ret_list
667  && param_list->length () > 0 && ! param_list->varargs_only ()
668  && ret_list->length () == 1 && ! ret_list->takes_varargs ())
669  {
670  tree_identifier *par1 = param_list->front ()->ident ();
671  tree_identifier *ret1 = ret_list->front ()->ident ();
672  retval = par1->name () == ret1->name ();
673  }
674 
675  return retval;
676 }
677 
678 #if 0
679 void
680 octave_user_function::print_symtab_info (std::ostream& os) const
681 {
682  symbol_table::print_info (os, local_scope);
683 }
684 #endif
685 
686 void
688 {
690 
692 }
693 
694 void
696 {
698 
700 }
701 
702 void
704  (const string_vector& arg_names, int nargin, int nargout,
705  const octave_value_list& va_args,
706  const std::list<octave_lvalue> *lvalue_list)
707 {
708  if (! arg_names.empty ())
709  {
710  // It is better to save this in the hidden variable .argn. and
711  // then use that in the inputname function instead of using argn,
712  // which might be redefined in a function. Keep the old argn name
713  // for backward compatibility of functions that use it directly.
714 
716  charMatrix (arg_names, Vstring_fill_char));
717  symbol_table::force_assign (".argn.", Cell (arg_names));
718 
719  symbol_table::mark_hidden (".argn.");
720 
722  symbol_table::mark_automatic (".argn.");
723  }
724 
725  symbol_table::force_assign (".nargin.", nargin);
726  symbol_table::force_assign (".nargout.", nargout);
727 
728  symbol_table::mark_hidden (".nargin.");
729  symbol_table::mark_hidden (".nargout.");
730 
731  symbol_table::mark_automatic (".nargin.");
732  symbol_table::mark_automatic (".nargout.");
733 
734  symbol_table::assign (".saved_warning_states.");
735 
736  symbol_table::mark_automatic (".saved_warning_states.");
737  symbol_table::mark_automatic (".saved_warning_states.");
738 
739  if (takes_varargs ())
740  symbol_table::assign ("varargin", va_args.cell_value ());
741 
742  // Force .ignored. variable to be undefined by default.
743  symbol_table::assign (".ignored.");
744 
745  if (lvalue_list)
746  {
747  octave_idx_type nbh = 0;
748  for (std::list<octave_lvalue>::const_iterator p = lvalue_list->begin ();
749  p != lvalue_list->end (); p++)
750  nbh += p->is_black_hole ();
751 
752  if (nbh > 0)
753  {
754  // Only assign the hidden variable if black holes actually present.
755  Matrix bh (1, nbh);
756  octave_idx_type k = 0;
757  octave_idx_type l = 0;
758  for (std::list<octave_lvalue>::const_iterator
759  p = lvalue_list->begin (); p != lvalue_list->end (); p++)
760  {
761  if (p->is_black_hole ())
762  bh(l++) = k+1;
763  k += p->numel ();
764  }
765 
766  symbol_table::assign (".ignored.", bh);
767  }
768  }
769 
770  symbol_table::mark_hidden (".ignored.");
771  symbol_table::mark_automatic (".ignored.");
772 }
773 
774 void
776 {
777  octave_value val = symbol_table::varval (".saved_warning_states.");
778 
779  if (val.is_defined ())
780  {
781  // Fail spectacularly if .saved_warning_states. is not an
782  // octave_map (or octave_scalar_map) object.
783 
784  if (! val.is_map ())
785  panic_impossible ();
786 
787  octave_map m = val.map_value ();
788 
789  Cell ids = m.contents ("identifier");
790  Cell states = m.contents ("state");
791 
792  for (octave_idx_type i = 0; i < m.numel (); i++)
793  Fwarning (ovl (states(i), ids(i)));
794  }
795 }
796 
797 DEFUN (nargin, args, ,
798  doc: /* -*- texinfo -*-
799 @deftypefn {} {} nargin ()
800 @deftypefnx {} {} nargin (@var{fcn})
801 Report the number of input arguments to a function.
802 
803 Called from within a function, return the number of arguments passed to the
804 function. At the top level, return the number of command line arguments
805 passed to Octave.
806 
807 If called with the optional argument @var{fcn}---a function name or
808 handle---return the declared number of arguments that the function can
809 accept.
810 
811 If the last argument to @var{fcn} is @var{varargin} the returned value is
812 negative. For example, the function @code{union} for sets is declared as
813 
814 @example
815 @group
816 function [y, ia, ib] = union (a, b, varargin)
817 
818 and
819 
820 nargin ("union")
821 @result{} -3
822 @end group
823 @end example
824 
825 Programming Note: @code{nargin} does not work on compiled functions
826 (@file{.oct} files) such as built-in or dynamically loaded functions.
827 @seealso{nargout, narginchk, varargin, inputname}
828 @end deftypefn */)
829 {
830  int nargin = args.length ();
831 
832  if (nargin > 1)
833  print_usage ();
834 
836 
837  if (nargin == 1)
838  {
839  octave_value func = args(0);
840 
841  if (func.is_string ())
842  {
843  std::string name = func.string_value ();
844  func = symbol_table::find_function (name);
845  if (func.is_undefined ())
846  error ("nargin: invalid function name: %s", name.c_str ());
847  }
848 
849  octave_function *fcn_val = func.function_value (true);
850  if (! fcn_val)
851  error ("nargin: FCN must be a string or function handle");
852 
853  octave_user_function *fcn = fcn_val->user_function_value (true);
854 
855  if (! fcn)
856  {
857  // Matlab gives up for histc, so maybe it's ok that we
858  // give up sometimes too?
859 
860  std::string type = fcn_val->type_name ();
861  error ("nargin: number of input arguments unavailable for %s objects",
862  type.c_str ());
863  }
864 
865  tree_parameter_list *param_list = fcn->parameter_list ();
866 
867  retval = param_list ? param_list->length () : 0;
868  if (fcn->takes_varargs ())
869  retval = -1 - retval;
870  }
871  else
872  {
873  retval = symbol_table::varval (".nargin.");
874 
875  if (retval.is_undefined ())
876  retval = 0;
877  }
878 
879  return retval;
880 }
881 
882 DEFUN (nargout, args, ,
883  doc: /* -*- texinfo -*-
884 @deftypefn {} {} nargout ()
885 @deftypefnx {} {} nargout (@var{fcn})
886 Report the number of output arguments from a function.
887 
888 Called from within a function, return the number of values the caller
889 expects to receive. At the top level, @code{nargout} with no argument is
890 undefined and will produce an error.
891 
892 If called with the optional argument @var{fcn}---a function name or
893 handle---return the number of declared output values that the function can
894 produce.
895 
896 If the final output argument is @var{varargout} the returned value is
897 negative.
898 
899 For example,
900 
901 @example
902 f ()
903 @end example
904 
905 @noindent
906 will cause @code{nargout} to return 0 inside the function @code{f} and
907 
908 @example
909 [s, t] = f ()
910 @end example
911 
912 @noindent
913 will cause @code{nargout} to return 2 inside the function @code{f}.
914 
915 In the second usage,
916 
917 @example
918 nargout (@@histc) # or nargout ("histc") using a string input
919 @end example
920 
921 @noindent
922 will return 2, because @code{histc} has two outputs, whereas
923 
924 @example
925 nargout (@@imread)
926 @end example
927 
928 @noindent
929 will return -2, because @code{imread} has two outputs and the second is
930 @var{varargout}.
931 
932 Programming Note. @code{nargout} does not work for built-in functions and
933 returns -1 for all anonymous functions.
934 @seealso{nargin, varargout, isargout, nthargout}
935 @end deftypefn */)
936 {
937  int nargin = args.length ();
938 
939  if (nargin > 1)
940  print_usage ();
941 
943 
944  if (nargin == 1)
945  {
946  octave_value func = args(0);
947 
948  if (func.is_string ())
949  {
950  std::string name = func.string_value ();
951  func = symbol_table::find_function (name);
952  if (func.is_undefined ())
953  error ("nargout: invalid function name: %s", name.c_str ());
954  }
955 
956  if (func.is_inline_function ())
957  return ovl (1);
958 
959  if (func.is_function_handle ())
960  {
961  octave_fcn_handle *fh = func.fcn_handle_value ();
962  std::string fh_nm = fh->fcn_name ();
963 
964  if (fh_nm == octave_fcn_handle::anonymous)
965  return ovl (-1);
966  }
967 
968  octave_function *fcn_val = func.function_value (true);
969  if (! fcn_val)
970  error ("nargout: FCN must be a string or function handle");
971 
972  octave_user_function *fcn = fcn_val->user_function_value (true);
973 
974  if (! fcn)
975  {
976  // Matlab gives up for histc, so maybe it's ok that we
977  // give up sometimes too?
978 
979  std::string type = fcn_val->type_name ();
980  error ("nargout: number of output arguments unavailable for %s objects",
981  type.c_str ());
982  }
983 
984  tree_parameter_list *ret_list = fcn->return_list ();
985 
986  retval = ret_list ? ret_list->length () : 0;
987 
988  if (fcn->takes_var_return ())
989  retval = -1 - retval;
990  }
991  else
992  {
994  error ("nargout: invalid call at top level");
995 
996  retval = symbol_table::varval (".nargout.");
997 
998  if (retval.is_undefined ())
999  retval = 0;
1000  }
1001 
1002  return retval;
1003 }
1004 
1005 DEFUN (optimize_subsasgn_calls, args, nargout,
1006  doc: /* -*- texinfo -*-
1007 @deftypefn {} {@var{val} =} optimize_subsasgn_calls ()
1008 @deftypefnx {} {@var{old_val} =} optimize_subsasgn_calls (@var{new_val})
1009 @deftypefnx {} {} optimize_subsasgn_calls (@var{new_val}, "local")
1010 Query or set the internal flag for @code{subsasgn} method call
1011 optimizations.
1012 
1013 If true, Octave will attempt to eliminate the redundant copying when calling
1014 the @code{subsasgn} method of a user-defined class.
1015 
1016 When called from inside a function with the @qcode{"local"} option, the
1017 variable is changed locally for the function and any subroutines it calls.
1018 The original variable value is restored when exiting the function.
1019 @seealso{subsasgn}
1020 @end deftypefn */)
1021 {
1022  return SET_INTERNAL_VARIABLE (optimize_subsasgn_calls);
1023 }
1024 
1025 static bool val_in_table (const Matrix& table, double val)
1026 {
1027  if (table.is_empty ())
1028  return false;
1029 
1030  octave_idx_type i = table.lookup (val, ASCENDING);
1031  return (i > 0 && table(i-1) == val);
1032 }
1033 
1034 static bool isargout1 (int nargout, const Matrix& ignored, double k)
1035 {
1036  if (k != octave::math::round (k) || k <= 0)
1037  error ("isargout: K must be a positive integer");
1038 
1039  return (k == 1 || k <= nargout) && ! val_in_table (ignored, k);
1040 }
1041 
1042 DEFUN (isargout, args, ,
1043  doc: /* -*- texinfo -*-
1044 @deftypefn {} {} isargout (@var{k})
1045 Within a function, return a logical value indicating whether the argument
1046 @var{k} will be assigned to a variable on output.
1047 
1048 If the result is false, the argument has been ignored during the function
1049 call through the use of the tilde (~) special output argument. Functions
1050 can use @code{isargout} to avoid performing unnecessary calculations for
1051 outputs which are unwanted.
1052 
1053 If @var{k} is outside the range @code{1:max (nargout)}, the function returns
1054 false. @var{k} can also be an array, in which case the function works
1055 element-by-element and a logical array is returned. At the top level,
1056 @code{isargout} returns an error.
1057 @seealso{nargout, varargout, nthargout}
1058 @end deftypefn */)
1059 {
1060  if (args.length () != 1)
1061  print_usage ();
1062 
1064  error ("isargout: invalid call at top level");
1065 
1066  int nargout1 = symbol_table::varval (".nargout.").int_value ();
1067 
1068  Matrix ignored;
1069  octave_value tmp = symbol_table::varval (".ignored.");
1070  if (tmp.is_defined ())
1071  ignored = tmp.matrix_value ();
1072 
1073  if (args(0).is_scalar_type ())
1074  {
1075  double k = args(0).double_value ();
1076 
1077  return ovl (isargout1 (nargout1, ignored, k));
1078  }
1079  else if (args(0).is_numeric_type ())
1080  {
1081  const NDArray ka = args(0).array_value ();
1082 
1083  boolNDArray r (ka.dims ());
1084  for (octave_idx_type i = 0; i < ka.numel (); i++)
1085  r(i) = isargout1 (nargout1, ignored, ka(i));
1086 
1087  return ovl (r);
1088  }
1089  else
1090  err_wrong_type_arg ("isargout", args(0));
1091 
1092  return ovl ();
1093 }
1094 
1095 /*
1096 %!function [x, y] = try_isargout ()
1097 %! if (isargout (1))
1098 %! if (isargout (2))
1099 %! x = 1; y = 2;
1100 %! else
1101 %! x = -1;
1102 %! endif
1103 %! else
1104 %! if (isargout (2))
1105 %! y = -2;
1106 %! else
1107 %! error ("no outputs requested");
1108 %! endif
1109 %! endif
1110 %!endfunction
1111 %!
1112 %!test
1113 %! [x, y] = try_isargout ();
1114 %! assert ([x, y], [1, 2]);
1115 %!
1116 %!test
1117 %! [x, ~] = try_isargout ();
1118 %! assert (x, -1);
1119 %!
1120 %!test
1121 %! [~, y] = try_isargout ();
1122 %! assert (y, -2);
1123 %!
1124 %!error [~, ~] = try_isargout ()
1125 %!
1126 %% Check to see that isargout isn't sticky:
1127 %!test
1128 %! [x, y] = try_isargout ();
1129 %! assert ([x, y], [1, 2]);
1130 %!
1131 %% It should work without ():
1132 %!test
1133 %! [~, y] = try_isargout;
1134 %! assert (y, -2);
1135 %!
1136 %% It should work in function handles, anonymous functions, and cell
1137 %% arrays of handles or anonymous functions.
1138 %!test
1139 %! fh = @try_isargout;
1140 %! af = @() try_isargout;
1141 %! c = {fh, af};
1142 %! [~, y] = fh ();
1143 %! assert (y, -2);
1144 %! [~, y] = af ();
1145 %! assert (y, -2);
1146 %! [~, y] = c{1}();
1147 %! assert (y, -2);
1148 %! [~, y] = c{2}();
1149 %! assert (y, -2);
1150 */
virtual std::map< std::string, octave_value > subfunctions(void) const
Definition: ov-usr-fcn.cc:66
bool has_subfunctions(void) const
Definition: ov-usr-fcn.cc:383
int beginning_line(void) const
Definition: ov-usr-fcn.h:211
octave::unwind_protect * curr_unwind_protect_frame
Definition: ov-usr-fcn.h:500
static bool Voptimize_subsasgn_calls
Definition: ov-usr-fcn.cc:60
symbol_table::scope_id local_scope
Definition: ov-usr-fcn.h:497
const Cell & contents(const_iterator p) const
Definition: oct-map.h:313
bool is_empty(void) const
Definition: Array.h:575
void accept(tree_walker &tw)
Definition: ov-usr-fcn.cc:168
Definition: Cell.h:37
octave_user_function * user_function_value(bool=false)
Definition: ov-usr-fcn.h:195
std::string my_name
Definition: ov-fcn.h:210
static const std::string anonymous
Definition: ov-fcn-handle.h:50
std::list< std::string > subfcn_names
Definition: ov-usr-fcn.h:456
bool takes_var_return(void) const
Definition: ov-usr-fcn.cc:359
static bool at_top_level(void)
Definition: symtab.h:1300
virtual void visit_octave_user_function(octave_user_function &)=0
octave_comment_list * trail_comm
Definition: ov-usr-fcn.h:440
octave_value_list slice(octave_idx_type offset, octave_idx_type len, bool tags=false) const
Definition: ovl.h:114
void set_location(int l, int c)
Definition: pt-stmt.cc:119
tree_parameter_list * parameter_list(void)
Definition: ov-usr-fcn.h:377
OCTAVE_EXPORT octave_value_list isa nd deftypefn *return ovl(args(0).is_integer_type())
OCTINTERP_API void print_usage(void)
Definition: defun.cc:52
void visit_octave_user_function_header(octave_user_function &)
Definition: pt-pr-code.cc:339
octave_idx_type numel(void) const
Number of elements in the array.
Definition: Array.h:363
identity matrix If supplied two scalar respectively For allows like xample val
Definition: data.cc:5068
F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T const F77_REAL const F77_REAL F77_REAL &F77_RET_T const F77_DBLE const F77_DBLE F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T const F77_DBLE F77_DBLE &F77_RET_T const F77_REAL F77_REAL &F77_RET_T F77_REAL F77_REAL &F77_RET_T F77_DBLE F77_DBLE &F77_RET_T const F77_DBLE const F77_DBLE * f
octave_idx_type length(void) const
Definition: ovl.h:96
void accept(tree_walker &tw)
Definition: pt-stmt.cc:324
virtual void visit_octave_user_script(octave_user_script &)=0
octave_map map_value(void) const
Definition: ov.cc:1693
OCTINTERP_API std::string fcn_file_in_path(const std::string &)
void bind_automatic_vars(const string_vector &arg_names, int nargin, int nargout, const octave_value_list &va_args, const std::list< octave_lvalue > *lvalue_list)
Definition: ov-usr-fcn.cc:704
Cell xcell_value(const char *fmt,...) const
Definition: ov.cc:2125
bool is_defined(void) const
Definition: ov.h:536
bool is_classdef_constructor(const std::string &cname="") const
Definition: ov-usr-fcn.h:340
bool empty(void) const
Definition: str-vec.h:79
static bool execute(tree_simple_for_command &cmd, const octave_value &bounds)
Definition: pt-jit.cc:2026
octave_value_list all_va_args(const octave_value_list &args)
Definition: ov-usr-fcn.cc:396
void maybe_relocate_end_internal(void)
Definition: ov-usr-fcn.cc:251
for large enough k
Definition: lu.cc:606
bool varargs_only(void)
Definition: pt-misc.h:75
int int_value(bool req_int=false, bool frc_str_conv=false) const
Definition: ov.h:746
string_vector name_tags(void) const
Definition: ovl.h:146
bool empty(void) const
Definition: base-list.h:47
bool is_inline_function(void) const
Definition: ov-usr-fcn.h:302
void protect_var(T &var)
#define DEFUN(name, args_name, nargout_name, doc)
Definition: defun.h:46
void error(const char *fmt,...)
Definition: error.cc:570
std::string name(void) const
Definition: ov-fcn.h:163
#define SET_INTERNAL_VARIABLE(NM)
Definition: variables.h:126
bool is_special_expr(void) const
Definition: ov-usr-fcn.h:321
elt_type & back(void)
Definition: base-list.h:98
std::string Vfcn_file_dir
Definition: defaults.cc:79
#define DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA(t, n, c)
Definition: ov-base.h:169
octave_comment_list * lead_comm
Definition: ov-usr-fcn.h:437
octave_value subsref(const std::string &type, const std::list< octave_value_list > &idx)
Definition: ov-usr-fcn.h:128
bool is_class_method(const std::string &cname="") const
Definition: ov-usr-fcn.h:348
static void lock_subfunctions(scope_id scope=xcurrent_scope)
Definition: symtab.h:2239
octave_idx_type numel(void) const
Definition: oct-map.h:371
OCTAVE_EXPORT octave_value_list return the number of command line arguments passed to Octave If called with the optional argument the function t
Definition: ov-usr-fcn.cc:935
bool is_end_of_file(void) const
Definition: pt-stmt.cc:153
void restore_warning_states(void)
Definition: ov-usr-fcn.cc:775
static void set_location(int l, int c)
Definition: call-stack.h:230
static void mark_automatic(const std::string &name, scope_id scope=xcurrent_scope)
Definition: symtab.h:1957
octave_fcn_handle * fcn_handle_value(bool silent=false) const
Definition: ov.cc:1729
void add_method(T *obj, void(T::*method)(void))
static octave_value find_function(const std::string &name, const octave_value_list &args=octave_value_list(), bool local_funcs=true)
Definition: symtab.cc:1276
#define END_PROFILER_BLOCK
Definition: profiler.h:215
symbol_table::context_id active_context() const
Definition: ov-usr-fcn.h:187
std::list< tree_statement * >::reverse_iterator reverse_iterator
Definition: base-list.h:43
static octave_value varval(const std::string &name, scope_id scope=xcurrent_scope, context_id context=xdefault_context)
Definition: symtab.h:1373
static void clear_variables(void)
Definition: symtab.h:1691
octave_idx_type lookup(const T &value, sortmode mode=UNSORTED) const
Do a binary lookup in a sorted array.
Definition: Array.cc:2166
bool is_function_handle(void) const
Definition: ov.h:702
double round(double x)
Definition: lo-mappers.cc:333
octave_function * fcn
Definition: ov-class.cc:1743
bool takes_varargs(void) const
Definition: ov-usr-fcn.cc:353
std::string dispatch_class(void) const
Definition: ov-fcn.h:103
bool is_subfunction(void) const
Definition: ov-usr-fcn.h:298
tree_identifier * ident(void)
Definition: pt-decl.h:87
bool is_class_constructor(const std::string &cname="") const
Definition: ov-usr-fcn.h:334
Cell cell_value(void) const
Definition: ovl.h:88
static void set_curr_fcn(octave_user_function *curr_fcn, scope_id scope=xcurrent_scope)
Definition: symtab.h:2322
JNIEnv void * args
Definition: ov-java.cc:67
static void push_context(scope_id scope=xcurrent_scope)
Definition: symtab.h:1925
tree_evaluator * current_evaluator
void define_from_arg_vector(const octave_value_list &args)
Definition: pt-misc.cc:176
const dim_vector & dims(void) const
Return a const-reference so that dims ()(i) works efficiently.
Definition: Array.h:439
static int breaking
Definition: pt-jump.h:50
void print_code_function_header(void)
Definition: ov-usr-fcn.cc:687
reverse_iterator rbegin(void)
Definition: base-list.h:89
bool is_anonymous_function(void) const
Definition: ov-usr-fcn.h:306
octave_user_script(void)
Definition: ov-usr-fcn.cc:77
std::string profiler_name(void) const
Definition: ov-usr-fcn.cc:307
OCTAVE_EXPORT octave_value_list any number nd example oindent prints the prompt xample Pick a any number!nd example oindent and waits for the user to enter a value The string entered by the user is evaluated as an so it may be a literal a variable name
Definition: input.cc:871
OCTAVE_EXPORT octave_value_list isdir nd deftypefn *std::string nm
Definition: utils.cc:941
virtual octave_user_function * user_function_value(bool silent=false)
Definition: ov-base.cc:923
OCTAVE_EXPORT octave_value_list return the number of command line arguments passed to Octave If called with the optional argument the function xample nargout(@histc)
Definition: ov-usr-fcn.cc:935
void add_fcn(void(*fcn)(void))
void lock_subfunctions(void)
Definition: ov-usr-fcn.cc:365
static llvm::LLVMContext & context
Definition: jit-typeinfo.cc:76
bool Vtrack_line_num
Definition: input.cc:114
std::string string_value(bool force=false) const
Definition: ov.h:908
void mark_as_system_fcn_file(void)
Definition: ov-usr-fcn.cc:330
tree_parameter_list * return_list(void)
Definition: ov-usr-fcn.h:379
nd deftypefn *octave_map m
Definition: ov-struct.cc:2058
std::string name(void) const
Definition: pt-id.h:67
int nargin
Definition: graphics.cc:10115
void maybe_relocate_end(void)
Definition: ov-usr-fcn.cc:287
void stash_subfunction_names(const std::list< std::string > &names)
Definition: ov-usr-fcn.cc:390
bool is_string(void) const
Definition: ov.h:578
static void force_assign(const std::string &name, const octave_value &value=octave_value(), scope_id scope=xcurrent_scope, context_id context=xdefault_context)
Definition: symtab.h:1355
bool is_inline_function(void) const
Definition: ov.h:708
octave_value_list do_multi_index_op(int nargout, const octave_value_list &args)
Definition: ov-usr-fcn.cc:122
octave_value_list convert_to_const_vector(int nargout, const Cell &varargout)
Definition: pt-misc.cc:236
void unlock_subfunctions(void)
Definition: ov-usr-fcn.cc:371
double tmp
Definition: data.cc:6300
static void pop_context(void)
Definition: symtab.h:1951
octave_value retval
Definition: data.cc:6294
octave_user_function(symbol_table::scope_id sid=-1, tree_parameter_list *pl=0, tree_parameter_list *rl=0, tree_statement_list *cl=0)
Definition: ov-usr-fcn.cc:183
#define panic_impossible()
Definition: error.h:40
static void assign(const std::string &name, const octave_value &value=octave_value(), scope_id scope=xcurrent_scope, context_id context=xdefault_context, bool force_add=false)
Definition: symtab.h:1330
static void push(octave_function *f, symbol_table::scope_id scope=symbol_table::current_scope(), symbol_table::context_id context=symbol_table::current_context())
Definition: call-stack.h:214
idx type
Definition: ov.cc:3129
Definition: dMatrix.h:37
tree_statement_list * cmd_list
Definition: ov-usr-fcn.h:149
std::string fcn_file_name(void) const
Definition: ov-usr-fcn.h:241
tree_expression * special_expr(void)
Definition: ov-usr-fcn.cc:652
octave_value subsref(const std::string &type, const std::list< octave_value_list > &idx)
Definition: ov-usr-fcn.h:354
Matrix matrix_value(bool frc_str_conv=false) const
Definition: ov.h:787
void err_wrong_type_arg(const char *name, const char *s)
Definition: errwarn.cc:156
With real return the complex result
Definition: data.cc:3375
bool takes_varargs(void) const
Definition: pt-misc.h:73
octave_function * function_value(bool silent=false) const
Definition: ov.cc:1705
std::string file_name
Definition: ov-usr-fcn.h:152
int line(void) const
Definition: pt-stmt.cc:107
bool is_map(void) const
Definition: ov.h:590
octave::unwind_protect frame
Definition: graphics.cc:11584
std::string file_name
Definition: ov-usr-fcn.h:443
bool is_end_of_fcn_or_script(void) const
Definition: pt-stmt.cc:136
int Vecho_executing_commands
Definition: input.cc:93
void visit_octave_user_function_trailer(octave_user_function &)
Definition: pt-pr-code.cc:429
bool subsasgn_optimization_ok(void)
Definition: ov-usr-fcn.cc:662
static void mark_hidden(const std::string &name, scope_id scope=xcurrent_scope)
Definition: symtab.h:1966
#define octave_stdout
Definition: pager.h:146
static int returning
Definition: pt-jump.h:106
OCTINTERP_API octave_value_list Fwarning(const octave_value_list &=octave_value_list(), int=0)
std::string type_name(void) const
Definition: ov-usr-fcn.h:524
jit_function_info * jit_info
Definition: ov-usr-fcn.h:503
octave_value_list do_multi_index_op(int nargout, const octave_value_list &args)
Definition: ov-usr-fcn.cc:458
=val(i)}if ode{val(i)}occurs in table i
Definition: lookup.cc:239
int Vmax_recursion_depth
Definition: pt-eval.cc:54
p
Definition: lu.cc:138
void initialize_undefined_elements(const std::string &warnfor, int nargout, const octave_value &val)
Definition: pt-misc.cc:119
tree_expression * expression(void)
Definition: pt-stmt.h:86
size_t length(void) const
Definition: base-list.h:50
virtual std::string type_name(void) const
Definition: ov-base.h:857
tree_statement_list * cmd_list
Definition: ov-usr-fcn.h:434
virtual octave_value_list rvalue(int nargout)
Definition: pt-exp.cc:60
elt_type & front(void)
Definition: base-list.h:97
octave_user_function * define_ret_list(tree_parameter_list *t)
Definition: ov-usr-fcn.cc:229
bool is_undefined(void) const
Definition: ov.h:539
tree_parameter_list * param_list
Definition: ov-usr-fcn.h:427
std::map< std::string, octave_value > subfunctions(void) const
Definition: ov-usr-fcn.cc:377
int column(void) const
Definition: pt-stmt.cc:113
void print_code_function_trailer(void)
Definition: ov-usr-fcn.cc:695
static void pop(void)
Definition: call-stack.h:313
static stmt_list_type statement_context
Definition: pt-eval.h:173
void stash_fcn_file_name(const std::string &nm)
Definition: ov-usr-fcn.cc:237
static void unlock_subfunctions(scope_id scope=xcurrent_scope)
Definition: symtab.h:2246
int beginning_column(void) const
Definition: ov-usr-fcn.h:212
bp_table::intmap remove_all_breakpoints(const std::string &file)
Definition: pt-stmt.cc:284
std::string parent_fcn_name(void) const
Definition: ov-usr-fcn.h:245
reverse_iterator rend(void)
Definition: base-list.h:93
static std::map< std::string, octave_value > subfunctions_defined_in_scope(scope_id scope=xcurrent_scope)
Definition: symtab.h:2254
std::string VPS4
Definition: input.cc:84
tree_parameter_list * ret_list
Definition: ov-usr-fcn.h:431
static int call_depth
Definition: daspk.cc:58
If this string is the system will ring the terminal sometimes it is useful to be able to print the original representation of the string
Definition: utils.cc:854
void mark_as_script_body(void)
Definition: pt-stmt.h:157
octave_value next_subsref(const std::string &type, const std::list< octave_value_list > &idx, size_t skip=1)
Definition: ov.cc:1462
#define BEGIN_PROFILER_BLOCK(classname)
Definition: profiler.h:211
void undefine(void)
Definition: pt-misc.cc:204
static void erase_scope(scope_id scope)
Definition: symtab.h:1215
std::string fcn_name(void) const
char Vstring_fill_char
Definition: pt-mat.cc:53
void accept(tree_walker &tw)
Definition: ov-usr-fcn.cc:646