GNU Octave  4.0.0
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-2015 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 #ifdef HAVE_CONFIG_H
24 #include <config.h>
25 #endif
26 
27 #include <sstream>
28 
29 #include "str-vec.h"
30 
31 #include <defaults.h>
32 #include "Cell.h"
33 #include "builtins.h"
34 #include "defun.h"
35 #include "error.h"
36 #include "gripes.h"
37 #include "input.h"
38 #include "oct-obj.h"
39 #include "ov-usr-fcn.h"
40 #include "ov.h"
41 #include "pager.h"
42 #include "pt-eval.h"
43 #include "pt-jit.h"
44 #include "pt-jump.h"
45 #include "pt-misc.h"
46 #include "pt-pr-code.h"
47 #include "pt-stmt.h"
48 #include "pt-walk.h"
49 #include "symtab.h"
50 #include "toplev.h"
51 #include "unwind-prot.h"
52 #include "utils.h"
53 #include "parse.h"
54 #include "profiler.h"
55 #include "variables.h"
56 #include "ov-fcn-handle.h"
57 
58 // Whether to optimize subsasgn method calls.
59 static bool Voptimize_subsasgn_calls = true;
60 
61 // The character to fill with when creating string arrays.
62 extern char Vstring_fill_char; // see pt-mat.cc
63 
64 std::map<std::string, octave_value>
66 {
67  return std::map<std::string, octave_value> ();
68 }
69 
70 // User defined scripts.
71 
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 
115 octave_user_script::subsref (const std::string&,
116  const std::list<octave_value_list>&, int)
117 {
118  octave_value_list retval;
119 
120  ::error ("invalid use of script %s in index expression", file_name.c_str ());
121 
122  return retval;
123 }
124 
127  const octave_value_list& args)
128 {
129  octave_value_list retval;
130 
131  unwind_protect frame;
132 
133  if (! error_state)
134  {
135  if (args.length () == 0 && nargout == 0)
136  {
137  if (cmd_list)
138  {
139  frame.protect_var (call_depth);
140  call_depth++;
141 
143  {
145 
147 
150 
152 
154 
156 
159 
162  }
163  else
164  ::error ("max_recursion_depth exceeded");
165  }
166  }
167  else
168  error ("invalid call to script %s", file_name.c_str ());
169  }
170 
171  return retval;
172 }
173 
174 void
176 {
177  tw.visit_octave_user_script (*this);
178 }
179 
180 // User defined functions.
181 
182 
184  "user-defined function",
185  "user-defined function");
186 
187 // Ugh. This really needs to be simplified (code/data?
188 // extrinsic/intrinsic state?).
189 
193  : octave_user_code (std::string (), std::string ()),
194  param_list (pl), ret_list (rl), cmd_list (cl),
195  lead_comm (), trail_comm (), file_name (),
196  location_line (0), location_column (0),
197  parent_name (), t_parsed (static_cast<time_t> (0)),
198  t_checked (static_cast<time_t> (0)),
199  system_fcn_file (false), call_depth (-1),
200  num_named_args (param_list ? param_list->length () : 0),
201  subfunction (false), inline_function (false),
202  anonymous_function (false), nested_function (false),
203  class_constructor (none), class_method (false),
204  parent_scope (-1), local_scope (sid),
205  curr_unwind_protect_frame (0)
206 #ifdef HAVE_LLVM
207  , jit_info (0)
208 #endif
209 {
210  if (cmd_list)
211  cmd_list->mark_as_function_body ();
212 
213  if (local_scope >= 0)
214  symbol_table::set_curr_fcn (this, local_scope);
215 }
216 
218 {
219  if (cmd_list)
221 
222  delete param_list;
223  delete ret_list;
224  delete cmd_list;
225  delete lead_comm;
226  delete trail_comm;
227 
228 #ifdef HAVE_LLVM
229  delete jit_info;
230 #endif
231 
232  // FIXME: this is really playing with fire.
234 }
235 
238 {
239  ret_list = t;
240 
241  return this;
242 }
243 
244 void
246 {
247  file_name = nm;
248 }
249 
250 // If there is no explicit end statement at the end of the function,
251 // relocate the no_op that was generated for the end of file condition
252 // to appear on the next line after the last statement in the file, or
253 // the next line after the function keyword if there are no statements.
254 // More precisely, the new location should probably be on the next line
255 // after the end of the parameter list, but we aren't tracking that
256 // information (yet).
257 
258 void
260 {
261  if (cmd_list && ! cmd_list->empty ())
262  {
263  tree_statement *last_stmt = cmd_list->back ();
264 
265  if (last_stmt && last_stmt->is_end_of_fcn_or_script ()
266  && last_stmt->is_end_of_file ())
267  {
269  next_to_last_elt = cmd_list->rbegin ();
270 
271  next_to_last_elt++;
272 
273  int new_eof_line;
274  int new_eof_col;
275 
276  if (next_to_last_elt == cmd_list->rend ())
277  {
278  new_eof_line = beginning_line ();
279  new_eof_col = beginning_column ();
280  }
281  else
282  {
283  tree_statement *next_to_last_stmt = *next_to_last_elt;
284 
285  new_eof_line = next_to_last_stmt->line ();
286  new_eof_col = next_to_last_stmt->column ();
287  }
288 
289  last_stmt->set_location (new_eof_line + 1, new_eof_col);
290  }
291  }
292 }
293 
294 void
296 {
297  std::map<std::string, octave_value> fcns = subfunctions ();
298 
299  if (! fcns.empty ())
300  {
301  for (std::map<std::string, octave_value>::iterator p = fcns.begin ();
302  p != fcns.end (); p++)
303  {
304  octave_user_function *f = (p->second).user_function_value ();
305 
306  if (f)
308  }
309  }
310 
312 }
313 
314 std::string
316 {
317  std::ostringstream result;
318 
319  if (is_anonymous_function ())
320  result << "anonymous@" << fcn_file_name ()
321  << ":" << location_line << ":" << location_column;
322  else if (is_subfunction ())
323  result << parent_fcn_name () << ">" << name ();
324  else if (is_class_method ())
325  result << "@" << dispatch_class () << "/" << name ();
327  result << "@" << name ();
328  else if (is_inline_function ())
329  result << "inline@" << fcn_file_name ()
330  << ":" << location_line << ":" << location_column;
331  else
332  result << name ();
333 
334  return result.str ();
335 }
336 
337 void
339 {
340  if (! file_name.empty ())
341  {
342  // We really should stash the whole path to the file we found,
343  // when we looked it up, to avoid possible race conditions...
344  // FIXME
345  //
346  // We probably also don't need to get the library directory
347  // every time, but since this function is only called when the
348  // function file is parsed, it probably doesn't matter that
349  // much.
350 
351  std::string ff_name = fcn_file_in_path (file_name);
352 
353  if (Vfcn_file_dir == ff_name.substr (0, Vfcn_file_dir.length ()))
354  system_fcn_file = true;
355  }
356  else
357  system_fcn_file = false;
358 }
359 
360 bool
362 {
363  return (param_list && param_list->takes_varargs ());
364 }
365 
366 bool
368 {
369  return (ret_list && ret_list->takes_varargs ());
370 }
371 
372 void
374 {
376 }
377 
378 void
380 {
382 }
383 
384 std::map<std::string, octave_value>
386 {
388 }
389 
390 bool
392 {
393  return ! subfcn_names.empty ();
394 }
395 
396 void
398  (const std::list<std::string>& names)
399 {
400  subfcn_names = names;
401 }
402 
405 {
406  octave_value_list retval;
407 
408  octave_idx_type n = args.length () - num_named_args;
409 
410  if (n > 0)
411  retval = args.slice (num_named_args, n);
412 
413  return retval;
414 }
415 
418  const std::list<octave_value_list>& idx,
419  int nargout)
420 {
421  return octave_user_function::subsref (type, idx, nargout, 0);
422 }
423 
426  const std::list<octave_value_list>& idx,
427  int nargout,
428  const std::list<octave_lvalue>* lvalue_list)
429 {
430  octave_value_list retval;
431 
432  switch (type[0])
433  {
434  case '(':
435  {
436  int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout;
437 
438  retval = do_multi_index_op (tmp_nargout, idx.front (),
439  idx.size () == 1 ? lvalue_list : 0);
440  }
441  break;
442 
443  case '{':
444  case '.':
445  {
446  std::string nm = type_name ();
447  error ("%s cannot be indexed with %c", nm.c_str (), type[0]);
448  }
449  break;
450 
451  default:
452  panic_impossible ();
453  }
454 
455  // FIXME: perhaps there should be an
456  // octave_value_list::next_subsref member function? See also
457  // octave_builtin::subsref.
458 
459  if (idx.size () > 1)
460  retval = retval(0).next_subsref (nargout, type, idx);
461 
462  return retval;
463 }
464 
467  const octave_value_list& args)
468 {
469  return do_multi_index_op (nargout, args, 0);
470 }
471 
474  const octave_value_list& _args,
475  const std::list<octave_lvalue>* lvalue_list)
476 {
477  octave_value_list retval;
478 
479  if (error_state)
480  return retval;
481 
482  if (! cmd_list)
483  return retval;
484 
485  // If this function is a classdef constructor, extract the first input
486  // argument, which must be the partially constructed object instance.
487 
488  octave_value_list args (_args);
489  octave_value_list ret_args;
490 
492  {
493  if (args.length () > 0)
494  {
495  ret_args = args.slice (0, 1, true);
496  args = args.slice (1, args.length () - 1, true);
497  }
498  else
499  panic_impossible ();
500  }
501 
502 #ifdef HAVE_LLVM
503  if (is_special_expr ()
504  && tree_jit::execute (*this, args, retval))
505  return retval;
506 #endif
507 
508  int nargin = args.length ();
509 
510  unwind_protect frame;
511 
512  frame.protect_var (call_depth);
513  call_depth++;
514 
516  {
517  ::error ("max_recursion_depth exceeded");
518  return retval;
519  }
520 
521  // Save old and set current symbol table context, for
522  // eval_undefined_error().
523 
524  int context = active_context ();
525 
526  octave_call_stack::push (this, local_scope, context);
528 
529  if (call_depth > 0 && ! is_anonymous_function ())
530  {
532 
534  }
535 
536  string_vector arg_names = args.name_tags ();
537 
538  if (param_list && ! param_list->varargs_only ())
539  {
541  if (error_state)
542  return retval;
543  }
544 
545  // For classdef constructor, pre-populate the output arguments
546  // with the pre-initialized object instance, extracted above.
547 
549  {
550  if (ret_list)
551  {
552  ret_list->define_from_arg_vector (ret_args);
553  if (error_state)
554  return retval;
555  }
556  else
557  {
558  ::error ("%s: invalid classdef constructor, no output argument defined",
559  dispatch_class ().c_str ());
560  return retval;
561  }
562  }
563 
564  // Force parameter list to be undefined when this function exits.
565  // Doing so decrements the reference counts on the values of local
566  // variables that are also named function parameters.
567 
568  if (param_list)
570 
571  // Force return list to be undefined when this function exits.
572  // Doing so decrements the reference counts on the values of local
573  // variables that are also named values returned by this function.
574 
575  if (ret_list)
577 
578  if (call_depth == 0)
579  {
580  // Force symbols to be undefined again when this function
581  // exits.
582  //
583  // This cleanup function is added to the unwind_protect stack
584  // after the calls to clear the parameter lists so that local
585  // variables will be cleared before the parameter lists are
586  // cleared. That way, any function parameters that have been
587  // declared global will be unmarked as global before they are
588  // undefined by the clear_param_list cleanup function.
589 
591  }
592 
593  bind_automatic_vars (arg_names, nargin, nargout, all_va_args (args),
594  lvalue_list);
595 
597 
598  bool echo_commands = (Vecho_executing_commands & ECHO_FUNCTIONS);
599 
600  if (echo_commands)
602 
603  // Set pointer to the current unwind_protect frame to allow
604  // certain builtins register simple cleanup in a very optimized manner.
605  // This is *not* intended as a general-purpose on-cleanup mechanism,
607  curr_unwind_protect_frame = &frame;
608 
609  // Evaluate the commands that make up the function.
610 
613 
615 
616  if (is_special_expr ())
617  {
618  tree_expression *expr = special_expr ();
619 
620  if (expr)
621  retval = (lvalue_list
622  ? expr->rvalue (nargout, lvalue_list)
623  : expr->rvalue (nargout));
624  }
625  else
627 
629 
630  if (echo_commands)
632 
635 
638 
639  if (error_state)
640  return retval;
641 
642  // Copy return values out.
643 
644  if (ret_list && ! is_special_expr ())
645  {
647 
648  Cell varargout;
649 
650  if (ret_list->takes_varargs ())
651  {
652  octave_value varargout_varval = symbol_table::varval ("varargout");
653 
654  if (varargout_varval.is_defined ())
655  {
656  varargout = varargout_varval.cell_value ();
657 
658  if (error_state)
659  error ("expecting varargout to be a cell array object");
660  }
661  }
662 
663  if (! error_state)
664  retval = ret_list->convert_to_const_vector (nargout, varargout);
665  }
666 
667  return retval;
668 }
669 
670 void
672 {
673  tw.visit_octave_user_function (*this);
674 }
675 
678 {
679  assert (is_special_expr ());
680  assert (cmd_list->length () == 1);
681 
682  tree_statement *stmt = cmd_list->front ();
683  return stmt->expression ();
684 }
685 
686 bool
688 {
689  bool retval = false;
691  && param_list && ret_list
692  && param_list->length () > 0 && ! param_list->varargs_only ()
693  && ret_list->length () == 1 && ! ret_list->takes_varargs ())
694  {
695  tree_identifier *par1 = param_list->front ()->ident ();
696  tree_identifier *ret1 = ret_list->front ()->ident ();
697  retval = par1->name () == ret1->name ();
698  }
699 
700  return retval;
701 }
702 
703 #if 0
704 void
705 octave_user_function::print_symtab_info (std::ostream& os) const
706 {
707  symbol_table::print_info (os, local_scope);
708 }
709 #endif
710 
711 void
713 {
715 
717 }
718 
719 void
721 {
723 
725 }
726 
727 void
729  (const string_vector& arg_names, int nargin, int nargout,
730  const octave_value_list& va_args,
731  const std::list<octave_lvalue> *lvalue_list)
732 {
733  if (! arg_names.empty ())
734  {
735  // It is better to save this in the hidden variable .argn. and
736  // then use that in the inputname function instead of using argn,
737  // which might be redefined in a function. Keep the old argn name
738  // for backward compatibility of functions that use it directly.
739 
741  charMatrix (arg_names, Vstring_fill_char));
742  symbol_table::force_assign (".argn.", Cell (arg_names));
743 
744  symbol_table::mark_hidden (".argn.");
745 
747  symbol_table::mark_automatic (".argn.");
748  }
749 
750  symbol_table::force_assign (".nargin.", nargin);
751  symbol_table::force_assign (".nargout.", nargout);
752 
753  symbol_table::mark_hidden (".nargin.");
754  symbol_table::mark_hidden (".nargout.");
755 
756  symbol_table::mark_automatic (".nargin.");
757  symbol_table::mark_automatic (".nargout.");
758 
759  symbol_table::assign (".saved_warning_states.");
760 
761  symbol_table::mark_automatic (".saved_warning_states.");
762  symbol_table::mark_automatic (".saved_warning_states.");
763 
764  if (takes_varargs ())
765  symbol_table::assign ("varargin", va_args.cell_value ());
766 
767  // Force .ignored. variable to be undefined by default.
768  symbol_table::assign (".ignored.");
769 
770  if (lvalue_list)
771  {
772  octave_idx_type nbh = 0;
773  for (std::list<octave_lvalue>::const_iterator p = lvalue_list->begin ();
774  p != lvalue_list->end (); p++)
775  nbh += p->is_black_hole ();
776 
777  if (nbh > 0)
778  {
779  // Only assign the hidden variable if black holes actually present.
780  Matrix bh (1, nbh);
781  octave_idx_type k = 0;
782  octave_idx_type l = 0;
783  for (std::list<octave_lvalue>::const_iterator
784  p = lvalue_list->begin (); p != lvalue_list->end (); p++)
785  {
786  if (p->is_black_hole ())
787  bh(l++) = k+1;
788  k += p->numel ();
789  }
790 
791  symbol_table::assign (".ignored.", bh);
792  }
793  }
794 
795  symbol_table::mark_hidden (".ignored.");
796  symbol_table::mark_automatic (".ignored.");
797 }
798 
799 void
801 {
802  octave_value val = symbol_table::varval (".saved_warning_states.");
803 
804  if (val.is_defined ())
805  {
806  // Don't use the usual approach of attempting to extract a value
807  // and then checking error_state since this code might be
808  // executing when error_state is already set. But do fail
809  // spectacularly if .saved_warning_states. is not an octave_map
810  // (or octave_scalar_map) object.
811 
812  if (! val.is_map ())
813  panic_impossible ();
814 
815  octave_map m = val.map_value ();
816 
817  Cell ids = m.contents ("identifier");
818  Cell states = m.contents ("state");
819 
820  for (octave_idx_type i = 0; i < m.numel (); i++)
821  Fwarning (ovl (states(i), ids(i)));
822  }
823 }
824 
825 DEFUN (nargin, args, ,
826  "-*- texinfo -*-\n\
827 @deftypefn {Built-in Function} {} nargin ()\n\
828 @deftypefnx {Built-in Function} {} nargin (@var{fcn})\n\
829 Report the number of input arguments to a function.\n\
830 \n\
831 Called from within a function, return the number of arguments passed to the\n\
832 function. At the top level, return the number of command line arguments\n\
833 passed to Octave.\n\
834 \n\
835 If called with the optional argument @var{fcn}---a function name or handle---\n\
836 return the declared number of arguments that the function can accept.\n\
837 \n\
838 If the last argument to @var{fcn} is @var{varargin} the returned value is\n\
839 negative. For example, the function @code{union} for sets is declared as\n\
840 \n\
841 @example\n\
842 @group\n\
843 function [y, ia, ib] = union (a, b, varargin)\n\
844 \n\
845 and\n\
846 \n\
847 nargin (\"union\")\n\
848 @result{} -3\n\
849 @end group\n\
850 @end example\n\
851 \n\
852 Programming Note: @code{nargin} does not work on built-in functions.\n\
853 @seealso{nargout, narginchk, varargin, inputname}\n\
854 @end deftypefn")
855 {
856  octave_value retval;
857 
858  int nargin = args.length ();
859 
860  if (nargin == 1)
861  {
862  octave_value func = args(0);
863 
864  if (func.is_string ())
865  {
866  std::string name = func.string_value ();
867  func = symbol_table::find_function (name);
868  if (func.is_undefined ())
869  error ("nargout: invalid function name: %s", name.c_str ());
870  }
871 
872  octave_function *fcn_val = func.function_value ();
873  if (fcn_val)
874  {
875  octave_user_function *fcn = fcn_val->user_function_value (true);
876 
877  if (fcn)
878  {
879  tree_parameter_list *param_list = fcn->parameter_list ();
880 
881  retval = param_list ? param_list->length () : 0;
882  if (fcn->takes_varargs ())
883  retval = -1 - retval;
884  }
885  else
886  {
887  // Matlab gives up for histc,
888  // so maybe it's ok that that we give up somtimes too?
889  error ("nargin: nargin information not available for built-in functions");
890  }
891  }
892  else
893  error ("nargin: FCN must be a string or function handle");
894  }
895  else if (nargin == 0)
896  {
897  retval = symbol_table::varval (".nargin.");
898 
899  if (retval.is_undefined ())
900  retval = 0;
901  }
902  else
903  print_usage ();
904 
905  return retval;
906 }
907 
908 DEFUN (nargout, args, ,
909  "-*- texinfo -*-\n\
910 @deftypefn {Built-in Function} {} nargout ()\n\
911 @deftypefnx {Built-in Function} {} nargout (@var{fcn})\n\
912 Report the number of output arguments from a function.\n\
913 \n\
914 Called from within a function, return the number of values the caller expects\n\
915 to receive. At the top level, @code{nargout} with no argument is undefined\n\
916 and will produce an error.\n\
917 \n\
918 If called with the optional argument @var{fcn}---a function name or\n\
919 handle---return the number of declared output values that the function can\n\
920 produce.\n\
921 \n\
922 If the final output argument is @var{varargout} the returned value is\n\
923 negative.\n\
924 \n\
925 For example,\n\
926 \n\
927 @example\n\
928 f ()\n\
929 @end example\n\
930 \n\
931 @noindent\n\
932 will cause @code{nargout} to return 0 inside the function @code{f} and\n\
933 \n\
934 @example\n\
935 [s, t] = f ()\n\
936 @end example\n\
937 \n\
938 @noindent\n\
939 will cause @code{nargout} to return 2 inside the function @code{f}.\n\
940 \n\
941 In the second usage,\n\
942 \n\
943 @example\n\
944 nargout (@@histc) \% or nargout (\"histc\")\n\
945 @end example\n\
946 \n\
947 @noindent\n\
948 will return 2, because @code{histc} has two outputs, whereas\n\
949 \n\
950 @example\n\
951 nargout (@@imread)\n\
952 @end example\n\
953 \n\
954 @noindent\n\
955 will return -2, because @code{imread} has two outputs and the second is\n\
956 @var{varargout}.\n\
957 \n\
958 Programming Note. @code{nargout} does not work for built-in functions and\n\
959 returns -1 for all anonymous functions.\n\
960 @seealso{nargin, varargout, isargout, nthargout}\n\
961 @end deftypefn")
962 {
963  octave_value retval;
964 
965  int nargin = args.length ();
966 
967  if (nargin == 1)
968  {
969  octave_value func = args(0);
970 
971  if (func.is_string ())
972  {
973  std::string name = func.string_value ();
974  func = symbol_table::find_function (name);
975  if (func.is_undefined ())
976  error ("nargout: invalid function name: %s", name.c_str ());
977  }
978 
979  if (func.is_inline_function ())
980  {
981  retval = 1;
982  return retval;
983  }
984 
985  if (func.is_function_handle ())
986  {
987  octave_fcn_handle *fh = func.fcn_handle_value ();
988  std::string fh_nm = fh->fcn_name ();
989 
990  if (fh_nm == octave_fcn_handle::anonymous)
991  {
992  retval = -1;
993  return retval;
994  }
995  }
996 
997  octave_function *fcn_val = func.function_value ();
998  if (fcn_val)
999  {
1000  octave_user_function *fcn = fcn_val->user_function_value (true);
1001 
1002  if (fcn)
1003  {
1004  tree_parameter_list *ret_list = fcn->return_list ();
1005 
1006  retval = ret_list ? ret_list->length () : 0;
1007 
1008  if (fcn->takes_var_return ())
1009  retval = -1 - retval;
1010  }
1011  else
1012  {
1013  // JWE said this information is not available (2011-03-10)
1014  // without making intrusive changes to Octave.
1015  // Matlab gives up for histc,
1016  // so maybe it's ok that we give up somtimes too?
1017  error ("nargout: nargout information not available for built-in functions.");
1018  }
1019  }
1020  else
1021  error ("nargout: FCN must be a string or function handle");
1022  }
1023  else if (nargin == 0)
1024  {
1025  if (! symbol_table::at_top_level ())
1026  {
1027  retval = symbol_table::varval (".nargout.");
1028 
1029  if (retval.is_undefined ())
1030  retval = 0;
1031  }
1032  else
1033  error ("nargout: invalid call at top level");
1034  }
1035  else
1036  print_usage ();
1037 
1038  return retval;
1039 }
1040 
1041 DEFUN (optimize_subsasgn_calls, args, nargout,
1042  "-*- texinfo -*-\n\
1043 @deftypefn {Built-in Function} {@var{val} =} optimize_subsasgn_calls ()\n\
1044 @deftypefnx {Built-in Function} {@var{old_val} =} optimize_subsasgn_calls (@var{new_val})\n\
1045 @deftypefnx {Built-in Function} {} optimize_subsasgn_calls (@var{new_val}, \"local\")\n\
1046 Query or set the internal flag for subsasgn method call optimizations.\n\
1047 \n\
1048 If true, Octave will attempt to eliminate the redundant copying when calling\n\
1049 the subsasgn method of a user-defined class.\n\
1050 \n\
1051 When called from inside a function with the @qcode{\"local\"} option, the\n\
1052 variable is changed locally for the function and any subroutines it calls.\n\
1053 The original variable value is restored when exiting the function.\n\
1054 @end deftypefn")
1055 {
1056  return SET_INTERNAL_VARIABLE (optimize_subsasgn_calls);
1057 }
1058 
1059 static bool val_in_table (const Matrix& table, double val)
1060 {
1061  if (table.is_empty ())
1062  return false;
1063 
1064  octave_idx_type i = table.lookup (val, ASCENDING);
1065  return (i > 0 && table(i-1) == val);
1066 }
1067 
1068 static bool isargout1 (int nargout, const Matrix& ignored, double k)
1069 {
1070  if (k != xround (k) || k <= 0)
1071  {
1072  error ("isargout: K must be a positive integer");
1073  return false;
1074  }
1075  else
1076  return (k == 1 || k <= nargout) && ! val_in_table (ignored, k);
1077 }
1078 
1079 DEFUN (isargout, args, ,
1080  "-*- texinfo -*-\n\
1081 @deftypefn {Built-in Function} {} isargout (@var{k})\n\
1082 Within a function, return a logical value indicating whether the argument\n\
1083 @var{k} will be assigned to a variable on output.\n\
1084 \n\
1085 If the result is false, the argument has been ignored during the function\n\
1086 call through the use of the tilde (~) special output argument. Functions\n\
1087 can use @code{isargout} to avoid performing unnecessary calculations for\n\
1088 outputs which are unwanted.\n\
1089 \n\
1090 If @var{k} is outside the range @code{1:max (nargout)}, the function returns\n\
1091 false. @var{k} can also be an array, in which case the function works\n\
1092 element-by-element and a logical array is returned. At the top level,\n\
1093 @code{isargout} returns an error.\n\
1094 @seealso{nargout, varargout, nthargout}\n\
1095 @end deftypefn")
1096 {
1097  octave_value retval;
1098 
1099  int nargin = args.length ();
1100 
1101  if (nargin == 1)
1102  {
1103  if (! symbol_table::at_top_level ())
1104  {
1105  int nargout1 = symbol_table::varval (".nargout.").int_value ();
1106  if (error_state)
1107  {
1108  error ("isargout: internal error");
1109  return retval;
1110  }
1111 
1112  Matrix ignored;
1113  octave_value tmp = symbol_table::varval (".ignored.");
1114  if (tmp.is_defined ())
1115  ignored = tmp.matrix_value ();
1116 
1117  if (args(0).is_scalar_type ())
1118  {
1119  double k = args(0).double_value ();
1120  if (! error_state)
1121  retval = isargout1 (nargout1, ignored, k);
1122  }
1123  else if (args(0).is_numeric_type ())
1124  {
1125  const NDArray ka = args(0).array_value ();
1126  if (! error_state)
1127  {
1128  boolNDArray r (ka.dims ());
1129  for (octave_idx_type i = 0;
1130  i < ka.numel () && ! error_state;
1131  i++)
1132  r(i) = isargout1 (nargout1, ignored, ka(i));
1133 
1134  retval = r;
1135  }
1136  }
1137  else
1138  gripe_wrong_type_arg ("isargout", args(0));
1139  }
1140  else
1141  error ("isargout: invalid call at top level");
1142  }
1143  else
1144  print_usage ();
1145 
1146  return retval;
1147 }
1148 
1149 /*
1150 %!function [x, y] = try_isargout ()
1151 %! if (isargout (1))
1152 %! if (isargout (2))
1153 %! x = 1; y = 2;
1154 %! else
1155 %! x = -1;
1156 %! endif
1157 %! else
1158 %! if (isargout (2))
1159 %! y = -2;
1160 %! else
1161 %! error ("no outputs requested");
1162 %! endif
1163 %! endif
1164 %!endfunction
1165 %!
1166 %!test
1167 %! [x, y] = try_isargout ();
1168 %! assert ([x, y], [1, 2]);
1169 %!
1170 %!test
1171 %! [x, ~] = try_isargout ();
1172 %! assert (x, -1);
1173 %!
1174 %!test
1175 %! [~, y] = try_isargout ();
1176 %! assert (y, -2);
1177 %!
1178 %!error [~, ~] = try_isargout ();
1179 %!
1180 %% Check to see that isargout isn't sticky:
1181 %!test
1182 %! [x, y] = try_isargout ();
1183 %! assert ([x, y], [1, 2]);
1184 %!
1185 %% It should work without ():
1186 %!test
1187 %! [~, y] = try_isargout;
1188 %! assert (y, -2);
1189 %!
1190 %% It should work in function handles, anonymous functions, and cell
1191 %% arrays of handles or anonymous functions.
1192 %!test
1193 %! fh = @try_isargout;
1194 %! af = @() try_isargout;
1195 %! c = {fh, af};
1196 %! [~, y] = fh ();
1197 %! assert (y, -2);
1198 %! [~, y] = af ();
1199 %! assert (y, -2);
1200 %! [~, y] = c{1}();
1201 %! assert (y, -2);
1202 %! [~, y] = c{2}();
1203 %! assert (y, -2);
1204 */
reverse_iterator rbegin(void)
Definition: base-list.h:84
virtual std::map< std::string, octave_value > subfunctions(void) const
Definition: ov-usr-fcn.cc:65
bool has_subfunctions(void) const
Definition: ov-usr-fcn.cc:391
int beginning_line(void) const
Definition: ov-usr-fcn.h:210
static bool Voptimize_subsasgn_calls
Definition: ov-usr-fcn.cc:59
symbol_table::scope_id local_scope
Definition: ov-usr-fcn.h:496
const Cell & contents(const_iterator p) const
Definition: oct-map.h:314
bool is_empty(void) const
Definition: Array.h:472
void accept(tree_walker &tw)
Definition: ov-usr-fcn.cc:175
size_t length(void) const
Definition: base-list.h:45
Definition: Cell.h:35
octave_user_function * user_function_value(bool=false)
Definition: ov-usr-fcn.h:194
std::string my_name
Definition: ov-fcn.h:208
static void mark_hidden(const std::string &name)
Definition: symtab.h:1939
static bool val_in_table(const Matrix &table, double val)
Definition: ov-usr-fcn.cc:1059
static const std::string anonymous
Definition: ov-fcn-handle.h:49
std::list< std::string > subfcn_names
Definition: ov-usr-fcn.h:455
bool takes_var_return(void) const
Definition: ov-usr-fcn.cc:367
void gripe_wrong_type_arg(const char *name, const char *s, bool is_error)
Definition: gripes.cc:135
static bool at_top_level(void)
Definition: symtab.h:1303
virtual void visit_octave_user_function(octave_user_function &)=0
double xround(double x)
Definition: lo-mappers.cc:63
octave_comment_list * trail_comm
Definition: ov-usr-fcn.h:439
octave_value_list slice(octave_idx_type offset, octave_idx_type len, bool tags=false) const
Definition: oct-obj.h:107
void set_location(int l, int c)
Definition: pt-stmt.cc:110
tree_parameter_list * parameter_list(void)
Definition: ov-usr-fcn.h:376
OCTINTERP_API void print_usage(void)
Definition: defun.cc:51
void visit_octave_user_function_header(octave_user_function &)
Definition: pt-pr-code.cc:339
static void mark_automatic(const std::string &name)
Definition: symtab.h:1931
octave_idx_type numel(void) const
Number of elements in the array.
Definition: Array.h:275
bool is_classdef_constructor(const std::string &cname=std::string()) const
Definition: ov-usr-fcn.h:339
octave_idx_type length(void) const
Definition: oct-obj.h:89
void accept(tree_walker &tw)
Definition: pt-stmt.cc:289
virtual void visit_octave_user_script(octave_user_script &)=0
octave_map map_value(void) const
Definition: ov.cc:1585
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:729
bool is_defined(void) const
Definition: ov.h:520
bool empty(void) const
Definition: str-vec.h:73
static bool execute(tree_simple_for_command &cmd, const octave_value &bounds)
Definition: pt-jit.cc:2027
octave_value_list all_va_args(const octave_value_list &args)
Definition: ov-usr-fcn.cc:404
void maybe_relocate_end_internal(void)
Definition: ov-usr-fcn.cc:259
bool varargs_only(void)
Definition: pt-misc.h:73
int int_value(bool req_int=false, bool frc_str_conv=false) const
Definition: ov.h:730
string_vector name_tags(void) const
Definition: oct-obj.h:139
bool is_inline_function(void) const
Definition: ov-usr-fcn.h:301
void protect_var(T &var)
#define DEFUN(name, args_name, nargout_name, doc)
Definition: defun.h:44
void error(const char *fmt,...)
Definition: error.cc:476
std::string name(void) const
Definition: ov-fcn.h:161
#define SET_INTERNAL_VARIABLE(NM)
Definition: variables.h:120
bool is_special_expr(void) const
Definition: ov-usr-fcn.h:320
std::string Vfcn_file_dir
Definition: defaults.cc:82
static string_vector names(const map_type &lst)
Definition: help.cc:782
elt_type & back(void)
Definition: base-list.h:93
static stmt_list_type statement_context
Definition: pt-eval.h:165
#define DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA(t, n, c)
Definition: ov-base.h:164
octave_comment_list * lead_comm
Definition: ov-usr-fcn.h:436
octave_value subsref(const std::string &type, const std::list< octave_value_list > &idx)
Definition: ov-usr-fcn.h:126
static void lock_subfunctions(scope_id scope=xcurrent_scope)
Definition: symtab.h:2204
octave_idx_type numel(void) const
Definition: oct-map.h:372
bool is_end_of_file(void) const
Definition: pt-stmt.cc:144
void restore_warning_states(void)
Definition: ov-usr-fcn.cc:800
elt_type & front(void)
Definition: base-list.h:92
octave_fcn_handle * fcn_handle_value(bool silent=false) const
Definition: ov.cc:1621
void add_method(T *obj, void(T::*method)(void))
std::string fcn_file_in_path(const std::string &name)
Definition: utils.cc:504
static octave_value find_function(const std::string &name, const octave_value_list &args=octave_value_list(), bool local_funcs=true)
Definition: symtab.cc:1271
std::list< tree_statement * >::reverse_iterator reverse_iterator
Definition: base-list.h:39
#define END_PROFILER_BLOCK
Definition: profiler.h:213
symbol_table::context_id active_context() const
Definition: ov-usr-fcn.h:186
static octave_value varval(const std::string &name, scope_id scope=xcurrent_scope, context_id context=xdefault_context)
Definition: symtab.h:1385
static void clear_variables(void)
Definition: symtab.h:1673
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:686
unwind_protect * curr_unwind_protect_frame
Definition: ov-usr-fcn.h:499
bool takes_varargs(void) const
Definition: ov-usr-fcn.cc:361
std::string dispatch_class(void) const
Definition: ov-fcn.h:101
bool is_subfunction(void) const
Definition: ov-usr-fcn.h:297
tree_identifier * ident(void)
Definition: pt-decl.h:85
bool is_class_method(const std::string &cname=std::string()) const
Definition: ov-usr-fcn.h:347
Cell cell_value(void) const
Definition: oct-obj.h:81
static void set_curr_fcn(octave_user_function *curr_fcn, scope_id scope=xcurrent_scope)
Definition: symtab.h:2287
Cell cell_value(void) const
Definition: ov.cc:1566
void define_from_arg_vector(const octave_value_list &args)
Definition: pt-misc.cc:183
const dim_vector & dims(void) const
Return a const-reference so that dims ()(i) works efficiently.
Definition: Array.h:337
static int breaking
Definition: pt-jump.h:48
void print_code_function_header(void)
Definition: ov-usr-fcn.cc:712
bool is_anonymous_function(void) const
Definition: ov-usr-fcn.h:305
octave_user_script(void)
Definition: ov-usr-fcn.cc:77
std::string profiler_name(void) const
Definition: ov-usr-fcn.cc:315
virtual octave_user_function * user_function_value(bool silent=false)
Definition: ov-base.cc:1003
F77_RET_T const double const double * f
void add_fcn(void(*fcn)(void))
void lock_subfunctions(void)
Definition: ov-usr-fcn.cc:373
static llvm::LLVMContext & context
Definition: jit-typeinfo.cc:76
std::string string_value(bool force=false) const
Definition: ov.h:897
void mark_as_system_fcn_file(void)
Definition: ov-usr-fcn.cc:338
bool empty(void) const
Definition: base-list.h:42
tree_parameter_list * return_list(void)
Definition: ov-usr-fcn.h:378
std::string name(void) const
Definition: pt-id.h:65
reverse_iterator rend(void)
Definition: base-list.h:88
void maybe_relocate_end(void)
Definition: ov-usr-fcn.cc:295
void stash_subfunction_names(const std::list< std::string > &names)
Definition: ov-usr-fcn.cc:398
bool is_string(void) const
Definition: ov.h:562
static void push_context(void)
Definition: symtab.h:1902
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:1365
int error_state
Definition: error.cc:101
bool is_inline_function(void) const
Definition: ov.h:692
octave_value_list do_multi_index_op(int nargout, const octave_value_list &args)
Definition: ov-usr-fcn.cc:126
octave_value_list convert_to_const_vector(int nargout, const Cell &varargout)
Definition: pt-misc.cc:248
void unlock_subfunctions(void)
Definition: ov-usr-fcn.cc:379
static void pop_context(void)
Definition: symtab.h:1915
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:191
#define panic_impossible()
Definition: error.h:33
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:1335
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: toplev.h:233
Definition: dMatrix.h:35
tree_statement_list * cmd_list
Definition: ov-usr-fcn.h:147
std::string fcn_file_name(void) const
Definition: ov-usr-fcn.h:240
tree_expression * special_expr(void)
Definition: ov-usr-fcn.cc:677
tree_evaluator * current_evaluator
Definition: pt-eval.cc:52
octave_value subsref(const std::string &type, const std::list< octave_value_list > &idx)
Definition: ov-usr-fcn.h:353
Matrix matrix_value(bool frc_str_conv=false) const
Definition: ov.h:773
bool takes_varargs(void) const
Definition: pt-misc.h:71
octave_function * function_value(bool silent=false) const
Definition: ov.cc:1597
std::string file_name
Definition: ov-usr-fcn.h:150
int line(void) const
Definition: pt-stmt.cc:98
bool is_map(void) const
Definition: ov.h:574
std::string file_name
Definition: ov-usr-fcn.h:442
bool is_end_of_fcn_or_script(void) const
Definition: pt-stmt.cc:127
int Vecho_executing_commands
Definition: input.cc:94
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:687
#define octave_stdout
Definition: pager.h:144
static int returning
Definition: pt-jump.h:104
OCTINTERP_API octave_value_list Fwarning(const octave_value_list &=octave_value_list(), int=0)
Definition: error.cc:1417
octave_value_list ovl(const octave_value &a0)
Definition: oct-obj.h:178
jit_function_info * jit_info
Definition: ov-usr-fcn.h:502
octave_value_list do_multi_index_op(int nargout, const octave_value_list &args)
Definition: ov-usr-fcn.cc:466
int Vmax_recursion_depth
Definition: pt-eval.cc:69
void initialize_undefined_elements(const std::string &warnfor, int nargout, const octave_value &val)
Definition: pt-misc.cc:126
tree_expression * expression(void)
Definition: pt-stmt.h:83
tree_statement_list * cmd_list
Definition: ov-usr-fcn.h:433
virtual octave_value_list rvalue(int nargout)
Definition: pt-exp.cc:65
octave_user_function * define_ret_list(tree_parameter_list *t)
Definition: ov-usr-fcn.cc:237
bool is_undefined(void) const
Definition: ov.h:523
tree_parameter_list * param_list
Definition: ov-usr-fcn.h:426
std::map< std::string, octave_value > subfunctions(void) const
Definition: ov-usr-fcn.cc:385
int column(void) const
Definition: pt-stmt.cc:104
void print_code_function_trailer(void)
Definition: ov-usr-fcn.cc:720
static void pop(void)
Definition: toplev.h:332
void stash_fcn_file_name(const std::string &nm)
Definition: ov-usr-fcn.cc:245
static void unlock_subfunctions(scope_id scope=xcurrent_scope)
Definition: symtab.h:2211
static bool isargout1(int nargout, const Matrix &ignored, double k)
Definition: ov-usr-fcn.cc:1068
int beginning_column(void) const
Definition: ov-usr-fcn.h:211
bool is_class_constructor(const std::string &cname=std::string()) const
Definition: ov-usr-fcn.h:333
OCTAVE_EMPTY_CPP_ARG std::string type_name(void) const
Definition: ov-usr-fcn.h:524
bp_table::intmap remove_all_breakpoints(const std::string &file)
Definition: pt-stmt.cc:248
std::string parent_fcn_name(void) const
Definition: ov-usr-fcn.h:244
static std::map< std::string, octave_value > subfunctions_defined_in_scope(scope_id scope=xcurrent_scope)
Definition: symtab.h:2219
std::string VPS4
Definition: input.cc:85
tree_parameter_list * ret_list
Definition: ov-usr-fcn.h:430
static int call_depth
Definition: daspk.cc:58
void mark_as_script_body(void)
Definition: pt-stmt.h:154
#define BEGIN_PROFILER_BLOCK(classname)
Definition: profiler.h:209
void undefine(void)
Definition: pt-misc.cc:216
static void erase_scope(scope_id scope)
Definition: symtab.h:1218
std::string fcn_name(void) const
char Vstring_fill_char
Definition: pt-mat.cc:52
void accept(tree_walker &tw)
Definition: ov-usr-fcn.cc:671