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-fcn-handle.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 2003-2015 John W. Eaton
4 Copyright (C) 2009 VZLU Prague, a.s.
5 Copyright (C) 2010 Jaroslav Hajek
6 
7 This file is part of Octave.
8 
9 Octave is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 3 of the License, or (at your
12 option) any later version.
13 
14 Octave is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 for more details.
18 
19 You should have received a copy of the GNU General Public License
20 along with Octave; see the file COPYING. If not, see
21 <http://www.gnu.org/licenses/>.
22 
23 */
24 
25 #ifdef HAVE_CONFIG_H
26 #include <config.h>
27 #endif
28 
29 #include <iostream>
30 #include <sstream>
31 #include <vector>
32 
33 #include "file-ops.h"
34 #include "oct-locbuf.h"
35 
36 #include "defun.h"
37 #include "error.h"
38 #include "gripes.h"
39 #include "input.h"
40 #include "oct-hdf5.h"
41 #include "oct-map.h"
42 #include "ov-base.h"
43 #include "ov-fcn-handle.h"
44 #include "ov-usr-fcn.h"
45 #include "pr-output.h"
46 #include "pt-pr-code.h"
47 #include "pt-misc.h"
48 #include "pt-stmt.h"
49 #include "pt-cmd.h"
50 #include "pt-exp.h"
51 #include "pt-assign.h"
52 #include "pt-arg-list.h"
53 #include "variables.h"
54 #include "parse.h"
55 #include "unwind-prot.h"
56 #include "defaults.h"
57 #include "file-stat.h"
58 #include "load-path.h"
59 #include "oct-env.h"
60 
61 #include "byte-swap.h"
62 #include "ls-ascii-helper.h"
63 #include "ls-hdf5.h"
64 #include "ls-oct-ascii.h"
65 #include "ls-oct-binary.h"
66 #include "ls-utils.h"
67 
68 
70  "function handle",
71  "function_handle");
72 
73 const std::string octave_fcn_handle::anonymous ("@<anonymous>");
74 
76  const std::string& n)
77  : fcn (f), nm (n), has_overloads (false)
78 {
80 
81  if (uf && nm != anonymous)
83 
84  if (uf && uf->is_nested_function ())
85  ::error ("handles to nested functions are not yet supported");
86 }
87 
89 octave_fcn_handle::subsref (const std::string& type,
90  const std::list<octave_value_list>& idx,
91  int nargout)
92 {
93  return octave_fcn_handle::subsref (type, idx, nargout, 0);
94 }
95 
97 octave_fcn_handle::subsref (const std::string& type,
98  const std::list<octave_value_list>& idx,
99  int nargout,
100  const std::list<octave_lvalue>* lvalue_list)
101 {
102  octave_value_list retval;
103 
104  switch (type[0])
105  {
106  case '(':
107  {
108  int tmp_nargout = (type.length () > 1 && nargout == 0) ? 1 : nargout;
109 
110  retval = do_multi_index_op (tmp_nargout, idx.front (),
111  idx.size () == 1 ? lvalue_list : 0);
112  }
113  break;
114 
115  case '{':
116  case '.':
117  {
118  std::string tnm = type_name ();
119  error ("%s cannot be indexed with %c", tnm.c_str (), type[0]);
120  }
121  break;
122 
123  default:
124  panic_impossible ();
125  }
126 
127  // FIXME: perhaps there should be an
128  // octave_value_list::next_subsref member function? See also
129  // octave_builtin::subsref.
130 
131  if (idx.size () > 1)
132  retval = retval(0).next_subsref (nargout, type, idx);
133 
134  return retval;
135 }
136 
139  const octave_value_list& args)
140 {
141  return do_multi_index_op (nargout, args, 0);
142 }
143 
146  const octave_value_list& args,
147  const std::list<octave_lvalue>* lvalue_list)
148 {
149  octave_value_list retval;
150 
151  out_of_date_check (fcn, std::string (), false);
152 
153  if (has_overloads)
154  {
155  // Possibly overloaded function.
156  octave_value ov_fcn;
157 
158  // Compute dispatch type.
159  builtin_type_t btyp;
160  std::string dispatch_type = get_dispatch_type (args, btyp);
161 
162  // Retrieve overload.
163  if (btyp != btyp_unknown)
164  {
165  out_of_date_check (builtin_overloads[btyp], dispatch_type, false);
166  ov_fcn = builtin_overloads[btyp];
167  }
168  else
169  {
170  str_ov_map::iterator it = overloads.find (dispatch_type);
171 
172  if (it == overloads.end ())
173  {
174  // Try parent classes too.
175 
176  std::list<std::string> plist
177  = symbol_table::parent_classes (dispatch_type);
178 
179  std::list<std::string>::const_iterator pit = plist.begin ();
180 
181  while (pit != plist.end ())
182  {
183  std::string pname = *pit;
184 
185  std::string fnm = fcn_name ();
186 
187  octave_value ftmp = symbol_table::find_method (fnm, pname);
188 
189  if (ftmp.is_defined ())
190  {
191  set_overload (pname, ftmp);
192 
193  out_of_date_check (ftmp, pname, false);
194  ov_fcn = ftmp;
195 
196  break;
197  }
198 
199  pit++;
200  }
201  }
202  else
203  {
204  out_of_date_check (it->second, dispatch_type, false);
205  ov_fcn = it->second;
206  }
207  }
208 
209  if (ov_fcn.is_defined ())
210  retval = ov_fcn.do_multi_index_op (nargout, args, lvalue_list);
211  else if (fcn.is_defined ())
212  retval = fcn.do_multi_index_op (nargout, args, lvalue_list);
213  else
214  error ("%s: no method for class %s",
215  nm.c_str (), dispatch_type.c_str ());
216  }
217  else
218  {
219  // Non-overloaded function (anonymous, subfunction, private function).
220  if (fcn.is_defined ())
221  retval = fcn.do_multi_index_op (nargout, args, lvalue_list);
222  else
223  error ("%s: no longer valid function handle", nm.c_str ());
224  }
225 
226  return retval;
227 }
228 
229 bool
231 {
232  bool retval = fcn.is_copy_of (h.fcn) && (has_overloads == h.has_overloads);
233  retval = retval && (overloads.size () == h.overloads.size ());
234 
235  if (retval && has_overloads)
236  {
237  for (int i = 0; i < btyp_num_types && retval; i++)
238  retval = builtin_overloads[i].is_copy_of (h.builtin_overloads[i]);
239 
240  str_ov_map::const_iterator iter = overloads.begin ();
241  str_ov_map::const_iterator hiter = h.overloads.begin ();
242  for (; iter != overloads.end () && retval; iter++, hiter++)
243  retval = (iter->first == hiter->first)
244  && (iter->second.is_copy_of (hiter->second));
245  }
246 
247  return retval;
248 }
249 
250 bool
251 octave_fcn_handle::set_fcn (const std::string &octaveroot,
252  const std::string& fpath)
253 {
254  bool success = true;
255 
256  if (octaveroot.length () != 0
257  && fpath.length () >= octaveroot.length ()
258  && fpath.substr (0, octaveroot.length ()) == octaveroot
259  && OCTAVE_EXEC_PREFIX != octaveroot)
260  {
261  // First check if just replacing matlabroot is enough
262  std::string str = OCTAVE_EXEC_PREFIX +
263  fpath.substr (octaveroot.length ());
264  file_stat fs (str);
265 
266  if (fs.exists ())
267  {
268  size_t xpos = str.find_last_of (file_ops::dir_sep_chars ());
269 
270  std::string dir_name = str.substr (0, xpos);
271 
272  octave_function *xfcn
273  = load_fcn_from_file (str, dir_name, "", "", nm);
274 
275  if (xfcn)
276  {
277  octave_value tmp (xfcn);
278 
279  fcn = octave_value (new octave_fcn_handle (tmp, nm));
280  }
281  else
282  {
283  error ("function handle points to non-existent function");
284  success = false;
285  }
286  }
287  else
288  {
289  // Next just search for it anywhere in the system path
290  string_vector names(3);
291  names(0) = nm + ".oct";
292  names(1) = nm + ".mex";
293  names(2) = nm + ".m";
294 
296 
297  str = octave_env::make_absolute (p.find_first_of (names));
298 
299  size_t xpos = str.find_last_of (file_ops::dir_sep_chars ());
300 
301  std::string dir_name = str.substr (0, xpos);
302 
303  octave_function *xfcn = load_fcn_from_file (str, dir_name, "", "", nm);
304 
305  if (xfcn)
306  {
307  octave_value tmp (xfcn);
308 
309  fcn = octave_value (new octave_fcn_handle (tmp, nm));
310  }
311  else
312  {
313  error ("function handle points to non-existent function");
314  success = false;
315  }
316  }
317  }
318  else
319  {
320  if (fpath.length () > 0)
321  {
322  size_t xpos = fpath.find_last_of (file_ops::dir_sep_chars ());
323 
324  std::string dir_name = fpath.substr (0, xpos);
325 
326  octave_function *xfcn = load_fcn_from_file (fpath, dir_name, "", "", nm);
327 
328  if (xfcn)
329  {
330  octave_value tmp (xfcn);
331 
332  fcn = octave_value (new octave_fcn_handle (tmp, nm));
333  }
334  else
335  {
336  error ("function handle points to non-existent function");
337  success = false;
338  }
339  }
340  else
341  {
343 
344  if (! fcn.is_function ())
345  {
346  error ("function handle points to non-existent function");
347  success = false;
348  }
349  }
350  }
351 
352  return success;
353 }
354 
355 bool
357 {
358  if (nm == anonymous)
359  {
360  os << nm << "\n";
361 
362  print_raw (os, true);
363  os << "\n";
364 
365  if (fcn.is_undefined ())
366  return false;
367 
369 
370  std::list<symbol_table::symbol_record> vars
371  = symbol_table::all_variables (f->scope (), 0);
372 
373  size_t varlen = vars.size ();
374 
375  if (varlen > 0)
376  {
377  os << "# length: " << varlen << "\n";
378 
379  for (std::list<symbol_table::symbol_record>::const_iterator
380  p = vars.begin (); p != vars.end (); p++)
381  {
382  if (! save_ascii_data (os, p->varval (0), p->name (), false, 0))
383  return ! os.fail ();
384  }
385  }
386  }
387  else
388  {
390  std::string fnm = f ? f->fcn_file_name () : std::string ();
391 
392  os << "# octaveroot: " << OCTAVE_EXEC_PREFIX << "\n";
393  if (! fnm.empty ())
394  os << "# path: " << fnm << "\n";
395  os << nm << "\n";
396  }
397 
398  return true;
399 }
400 
401 bool
403 {
404  bool success = true;
405 
406  std::streampos pos = is.tellg ();
407  std::string octaveroot = extract_keyword (is, "octaveroot", true);
408  if (octaveroot.length () == 0)
409  {
410  is.seekg (pos);
411  is.clear ();
412  }
413  pos = is.tellg ();
414  std::string fpath = extract_keyword (is, "path", true);
415  if (fpath.length () == 0)
416  {
417  is.seekg (pos);
418  is.clear ();
419  }
420 
421  is >> nm;
422 
423  if (nm == anonymous)
424  {
426 
427  std::string buf;
428 
429  if (is)
430  {
431 
432  // Get a line of text whitespace characters included, leaving
433  // newline in the stream.
434  buf = read_until_newline (is, true);
435 
436  }
437 
438  pos = is.tellg ();
439 
440  unwind_protect_safe frame;
441 
442  // Set up temporary scope to use for evaluating the text that
443  // defines the anonymous function.
444 
446  frame.add_fcn (symbol_table::erase_scope, local_scope);
447 
448  symbol_table::set_scope (local_scope);
449 
450  octave_call_stack::push (local_scope, 0);
452 
453  octave_idx_type len = 0;
454 
455  if (extract_keyword (is, "length", len, true) && len >= 0)
456  {
457  if (len > 0)
458  {
459  for (octave_idx_type i = 0; i < len; i++)
460  {
461  octave_value t2;
462  bool dummy;
463 
464  std::string name
465  = read_ascii_data (is, std::string (), dummy, t2, i);
466 
467  if (!is)
468  {
469  error ("load: failed to load anonymous function handle");
470  break;
471  }
472 
473  symbol_table::assign (name, t2, local_scope, 0);
474  }
475  }
476  }
477  else
478  {
479  is.seekg (pos);
480  is.clear ();
481  }
482 
483  if (is && success)
484  {
485  int parse_status;
486  octave_value anon_fcn_handle =
487  eval_string (buf, true, parse_status);
488 
489  if (parse_status == 0)
490  {
491  octave_fcn_handle *fh =
492  anon_fcn_handle.fcn_handle_value ();
493 
494  if (fh)
495  {
496  fcn = fh->fcn;
497 
499 
500  if (uf)
502  }
503  else
504  success = false;
505  }
506  else
507  success = false;
508  }
509  else
510  success = false;
511  }
512  else
513  success = set_fcn (octaveroot, fpath);
514 
515  return success;
516 }
517 
518 bool
519 octave_fcn_handle::save_binary (std::ostream& os, bool& save_as_floats)
520 {
521  if (nm == anonymous)
522  {
523  std::ostringstream nmbuf;
524 
525  if (fcn.is_undefined ())
526  return false;
527 
529 
530  std::list<symbol_table::symbol_record> vars
531  = symbol_table::all_variables (f->scope (), 0);
532 
533  size_t varlen = vars.size ();
534 
535  if (varlen > 0)
536  nmbuf << nm << " " << varlen;
537  else
538  nmbuf << nm;
539 
540  std::string buf_str = nmbuf.str ();
541  int32_t tmp = buf_str.length ();
542  os.write (reinterpret_cast<char *> (&tmp), 4);
543  os.write (buf_str.c_str (), buf_str.length ());
544 
545  std::ostringstream buf;
546  print_raw (buf, true);
547  std::string stmp = buf.str ();
548  tmp = stmp.length ();
549  os.write (reinterpret_cast<char *> (&tmp), 4);
550  os.write (stmp.c_str (), stmp.length ());
551 
552  if (varlen > 0)
553  {
554  for (std::list<symbol_table::symbol_record>::const_iterator
555  p = vars.begin (); p != vars.end (); p++)
556  {
557  if (! save_binary_data (os, p->varval (0), p->name (),
558  "", 0, save_as_floats))
559  return ! os.fail ();
560  }
561  }
562  }
563  else
564  {
565  std::ostringstream nmbuf;
566 
568  std::string fnm = f ? f->fcn_file_name () : std::string ();
569 
570  nmbuf << nm << "\n" << OCTAVE_EXEC_PREFIX << "\n" << fnm;
571 
572  std::string buf_str = nmbuf.str ();
573  int32_t tmp = buf_str.length ();
574  os.write (reinterpret_cast<char *> (&tmp), 4);
575  os.write (buf_str.c_str (), buf_str.length ());
576  }
577 
578  return true;
579 }
580 
581 bool
582 octave_fcn_handle::load_binary (std::istream& is, bool swap,
584 {
585  bool success = true;
586 
587  int32_t tmp;
588  if (! is.read (reinterpret_cast<char *> (&tmp), 4))
589  return false;
590  if (swap)
591  swap_bytes<4> (&tmp);
592 
593  OCTAVE_LOCAL_BUFFER (char, ctmp1, tmp+1);
594  // is.get (ctmp1, tmp+1, 0); caused is.eof () to be true though
595  // effectively not reading over file end
596  is.read (ctmp1, tmp);
597  ctmp1[tmp] = 0;
598  nm = std::string (ctmp1);
599 
600  if (! is)
601  return false;
602 
603  size_t anl = anonymous.length ();
604 
605  if (nm.length () >= anl && nm.substr (0, anl) == anonymous)
606  {
607  octave_idx_type len = 0;
608 
609  if (nm.length () > anl)
610  {
611  std::istringstream nm_is (nm.substr (anl));
612  nm_is >> len;
613  nm = nm.substr (0, anl);
614  }
615 
616  if (! is.read (reinterpret_cast<char *> (&tmp), 4))
617  return false;
618  if (swap)
619  swap_bytes<4> (&tmp);
620 
621  OCTAVE_LOCAL_BUFFER (char, ctmp2, tmp+1);
622  // is.get (ctmp2, tmp+1, 0); caused is.eof () to be true though
623  // effectively not reading over file end
624  is.read (ctmp2, tmp);
625  ctmp2[tmp] = 0;
626 
627  unwind_protect_safe frame;
628 
629  // Set up temporary scope to use for evaluating the text that
630  // defines the anonymous function.
631 
633  frame.add_fcn (symbol_table::erase_scope, local_scope);
634 
635  symbol_table::set_scope (local_scope);
636 
637  octave_call_stack::push (local_scope, 0);
639 
640  if (len > 0)
641  {
642  for (octave_idx_type i = 0; i < len; i++)
643  {
644  octave_value t2;
645  bool dummy;
646  std::string doc;
647 
648  std::string name =
649  read_binary_data (is, swap, fmt, std::string (),
650  dummy, t2, doc);
651 
652  if (!is)
653  {
654  error ("load: failed to load anonymous function handle");
655  break;
656  }
657 
658  symbol_table::assign (name, t2, local_scope);
659  }
660  }
661 
662  if (is && success)
663  {
664  int parse_status;
665  octave_value anon_fcn_handle =
666  eval_string (ctmp2, true, parse_status);
667 
668  if (parse_status == 0)
669  {
670  octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value ();
671 
672  if (fh)
673  {
674  fcn = fh->fcn;
675 
677 
678  if (uf)
680  }
681  else
682  success = false;
683  }
684  else
685  success = false;
686  }
687  }
688  else
689  {
690  std::string octaveroot;
691  std::string fpath;
692 
693  if (nm.find_first_of ("\n") != std::string::npos)
694  {
695  size_t pos1 = nm.find_first_of ("\n");
696  size_t pos2 = nm.find_first_of ("\n", pos1 + 1);
697  octaveroot = nm.substr (pos1 + 1, pos2 - pos1 - 1);
698  fpath = nm.substr (pos2 + 1);
699  nm = nm.substr (0, pos1);
700  }
701 
702  success = set_fcn (octaveroot, fpath);
703  }
704 
705  return success;
706 }
707 
708 bool
710  bool save_as_floats)
711 {
712 #if defined (HAVE_HDF5)
713 
714  bool retval = true;
715 
716  hid_t group_hid = -1;
717 #if HAVE_HDF5_18
718  group_hid = H5Gcreate (loc_id, name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
719 #else
720  group_hid = H5Gcreate (loc_id, name, 0);
721 #endif
722  if (group_hid < 0)
723  return false;
724 
725  hid_t space_hid, data_hid, type_hid;
726  space_hid = data_hid = type_hid = -1;
727 
728  // attach the type of the variable
729  type_hid = H5Tcopy (H5T_C_S1);
730  H5Tset_size (type_hid, nm.length () + 1);
731  if (type_hid < 0)
732  {
733  H5Gclose (group_hid);
734  return false;
735  }
736 
737  OCTAVE_LOCAL_BUFFER (hsize_t, hdims, 2);
738  hdims[0] = 0;
739  hdims[1] = 0;
740  space_hid = H5Screate_simple (0 , hdims, 0);
741  if (space_hid < 0)
742  {
743  H5Tclose (type_hid);
744  H5Gclose (group_hid);
745  return false;
746  }
747 #if HAVE_HDF5_18
748  data_hid = H5Dcreate (group_hid, "nm", type_hid, space_hid,
749  H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
750 #else
751  data_hid = H5Dcreate (group_hid, "nm", type_hid, space_hid, H5P_DEFAULT);
752 #endif
753  if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL,
754  H5P_DEFAULT, nm.c_str ()) < 0)
755  {
756  H5Sclose (space_hid);
757  H5Tclose (type_hid);
758  H5Gclose (group_hid);
759  return false;
760  }
761  H5Dclose (data_hid);
762 
763  if (nm == anonymous)
764  {
765  std::ostringstream buf;
766  print_raw (buf, true);
767  std::string stmp = buf.str ();
768 
769  // attach the type of the variable
770  H5Tset_size (type_hid, stmp.length () + 1);
771  if (type_hid < 0)
772  {
773  H5Sclose (space_hid);
774  H5Gclose (group_hid);
775  return false;
776  }
777 
778 #if HAVE_HDF5_18
779  data_hid = H5Dcreate (group_hid, "fcn", type_hid, space_hid,
780  H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
781 #else
782  data_hid = H5Dcreate (group_hid, "fcn", type_hid, space_hid,
783  H5P_DEFAULT);
784 #endif
785  if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL,
786  H5P_DEFAULT, stmp.c_str ()) < 0)
787  {
788  H5Sclose (space_hid);
789  H5Tclose (type_hid);
790  H5Gclose (group_hid);
791  return false;
792  }
793 
794  H5Dclose (data_hid);
795 
797 
798  std::list<symbol_table::symbol_record> vars
799  = symbol_table::all_variables (f->scope (), 0);
800 
801  size_t varlen = vars.size ();
802 
803  if (varlen > 0)
804  {
805  hid_t as_id = H5Screate (H5S_SCALAR);
806 
807  if (as_id >= 0)
808  {
809 #if HAVE_HDF5_18
810  hid_t a_id = H5Acreate (group_hid, "SYMBOL_TABLE",
811  H5T_NATIVE_IDX, as_id,
812  H5P_DEFAULT, H5P_DEFAULT);
813 
814 #else
815  hid_t a_id = H5Acreate (group_hid, "SYMBOL_TABLE",
816  H5T_NATIVE_IDX, as_id, H5P_DEFAULT);
817 #endif
818 
819  if (a_id >= 0)
820  {
821  retval = (H5Awrite (a_id, H5T_NATIVE_IDX, &varlen) >= 0);
822 
823  H5Aclose (a_id);
824  }
825  else
826  retval = false;
827 
828  H5Sclose (as_id);
829  }
830  else
831  retval = false;
832 #if HAVE_HDF5_18
833  data_hid = H5Gcreate (group_hid, "symbol table",
834  H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
835 #else
836  data_hid = H5Gcreate (group_hid, "symbol table", 0);
837 #endif
838  if (data_hid < 0)
839  {
840  H5Sclose (space_hid);
841  H5Tclose (type_hid);
842  H5Gclose (group_hid);
843  return false;
844  }
845 
846  for (std::list<symbol_table::symbol_record>::const_iterator
847  p = vars.begin (); p != vars.end (); p++)
848  {
849  if (! add_hdf5_data (data_hid, p->varval (0), p->name (),
850  "", false, save_as_floats))
851  break;
852  }
853  H5Gclose (data_hid);
854  }
855  }
856  else
857  {
858  std::string octaveroot = OCTAVE_EXEC_PREFIX;
859 
861  std::string fpath = f ? f->fcn_file_name () : std::string ();
862 
863  H5Sclose (space_hid);
864  hdims[0] = 1;
865  hdims[1] = octaveroot.length ();
866  space_hid = H5Screate_simple (0 , hdims, 0);
867  if (space_hid < 0)
868  {
869  H5Tclose (type_hid);
870  H5Gclose (group_hid);
871  return false;
872  }
873 
874  H5Tclose (type_hid);
875  type_hid = H5Tcopy (H5T_C_S1);
876  H5Tset_size (type_hid, octaveroot.length () + 1);
877 #if HAVE_HDF5_18
878  hid_t a_id = H5Acreate (group_hid, "OCTAVEROOT",
879  type_hid, space_hid, H5P_DEFAULT, H5P_DEFAULT);
880 #else
881  hid_t a_id = H5Acreate (group_hid, "OCTAVEROOT",
882  type_hid, space_hid, H5P_DEFAULT);
883 #endif
884 
885  if (a_id >= 0)
886  {
887  retval = (H5Awrite (a_id, type_hid, octaveroot.c_str ()) >= 0);
888 
889  H5Aclose (a_id);
890  }
891  else
892  {
893  H5Sclose (space_hid);
894  H5Tclose (type_hid);
895  H5Gclose (group_hid);
896  return false;
897  }
898 
899  H5Sclose (space_hid);
900  hdims[0] = 1;
901  hdims[1] = fpath.length ();
902  space_hid = H5Screate_simple (0 , hdims, 0);
903  if (space_hid < 0)
904  {
905  H5Tclose (type_hid);
906  H5Gclose (group_hid);
907  return false;
908  }
909 
910  H5Tclose (type_hid);
911  type_hid = H5Tcopy (H5T_C_S1);
912  H5Tset_size (type_hid, fpath.length () + 1);
913 
914 #if HAVE_HDF5_18
915  a_id = H5Acreate (group_hid, "FILE", type_hid, space_hid,
916  H5P_DEFAULT, H5P_DEFAULT);
917 #else
918  a_id = H5Acreate (group_hid, "FILE", type_hid, space_hid, H5P_DEFAULT);
919 #endif
920 
921  if (a_id >= 0)
922  {
923  retval = (H5Awrite (a_id, type_hid, fpath.c_str ()) >= 0);
924 
925  H5Aclose (a_id);
926  }
927  else
928  retval = false;
929  }
930 
931  H5Sclose (space_hid);
932  H5Tclose (type_hid);
933  H5Gclose (group_hid);
934 
935  return retval;
936 
937 #else
938  gripe_save ("hdf5");
939  return false;
940 #endif
941 }
942 
943 bool
945 {
946 #if defined (HAVE_HDF5)
947 
948  bool success = true;
949 
950  hid_t group_hid, data_hid, space_hid, type_hid, type_class_hid, st_id;
951  hsize_t rank;
952  int slen;
953 
954 #if HAVE_HDF5_18
955  group_hid = H5Gopen (loc_id, name, H5P_DEFAULT);
956 #else
957  group_hid = H5Gopen (loc_id, name);
958 #endif
959  if (group_hid < 0)
960  return false;
961 
962 #if HAVE_HDF5_18
963  data_hid = H5Dopen (group_hid, "nm", H5P_DEFAULT);
964 #else
965  data_hid = H5Dopen (group_hid, "nm");
966 #endif
967 
968  if (data_hid < 0)
969  {
970  H5Gclose (group_hid);
971  return false;
972  }
973 
974  type_hid = H5Dget_type (data_hid);
975  type_class_hid = H5Tget_class (type_hid);
976 
977  if (type_class_hid != H5T_STRING)
978  {
979  H5Tclose (type_hid);
980  H5Dclose (data_hid);
981  H5Gclose (group_hid);
982  return false;
983  }
984 
985  space_hid = H5Dget_space (data_hid);
986  rank = H5Sget_simple_extent_ndims (space_hid);
987 
988  if (rank != 0)
989  {
990  H5Sclose (space_hid);
991  H5Tclose (type_hid);
992  H5Dclose (data_hid);
993  H5Gclose (group_hid);
994  return false;
995  }
996 
997  slen = H5Tget_size (type_hid);
998  if (slen < 0)
999  {
1000  H5Sclose (space_hid);
1001  H5Tclose (type_hid);
1002  H5Dclose (data_hid);
1003  H5Gclose (group_hid);
1004  return false;
1005  }
1006 
1007  OCTAVE_LOCAL_BUFFER (char, nm_tmp, slen);
1008 
1009  // create datatype for (null-terminated) string to read into:
1010  st_id = H5Tcopy (H5T_C_S1);
1011  H5Tset_size (st_id, slen);
1012 
1013  if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, nm_tmp) < 0)
1014  {
1015  H5Tclose (st_id);
1016  H5Sclose (space_hid);
1017  H5Tclose (type_hid);
1018  H5Dclose (data_hid);
1019  H5Gclose (group_hid);
1020  return false;
1021  }
1022  H5Tclose (st_id);
1023  H5Dclose (data_hid);
1024  nm = nm_tmp;
1025 
1026  if (nm == anonymous)
1027  {
1028 #if HAVE_HDF5_18
1029  data_hid = H5Dopen (group_hid, "fcn", H5P_DEFAULT);
1030 #else
1031  data_hid = H5Dopen (group_hid, "fcn");
1032 #endif
1033 
1034  if (data_hid < 0)
1035  {
1036  H5Sclose (space_hid);
1037  H5Tclose (type_hid);
1038  H5Gclose (group_hid);
1039  return false;
1040  }
1041 
1042  H5Tclose (type_hid);
1043  type_hid = H5Dget_type (data_hid);
1044  type_class_hid = H5Tget_class (type_hid);
1045 
1046  if (type_class_hid != H5T_STRING)
1047  {
1048  H5Sclose (space_hid);
1049  H5Tclose (type_hid);
1050  H5Dclose (data_hid);
1051  H5Gclose (group_hid);
1052  return false;
1053  }
1054 
1055  H5Sclose (space_hid);
1056  space_hid = H5Dget_space (data_hid);
1057  rank = H5Sget_simple_extent_ndims (space_hid);
1058 
1059  if (rank != 0)
1060  {
1061  H5Sclose (space_hid);
1062  H5Tclose (type_hid);
1063  H5Dclose (data_hid);
1064  H5Gclose (group_hid);
1065  return false;
1066  }
1067 
1068  slen = H5Tget_size (type_hid);
1069  if (slen < 0)
1070  {
1071  H5Sclose (space_hid);
1072  H5Tclose (type_hid);
1073  H5Dclose (data_hid);
1074  H5Gclose (group_hid);
1075  return false;
1076  }
1077 
1078  OCTAVE_LOCAL_BUFFER (char, fcn_tmp, slen);
1079 
1080  // create datatype for (null-terminated) string to read into:
1081  st_id = H5Tcopy (H5T_C_S1);
1082  H5Tset_size (st_id, slen);
1083 
1084  if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, fcn_tmp) < 0)
1085  {
1086  H5Tclose (st_id);
1087  H5Sclose (space_hid);
1088  H5Tclose (type_hid);
1089  H5Dclose (data_hid);
1090  H5Gclose (group_hid);
1091  return false;
1092  }
1093  H5Tclose (st_id);
1094  H5Dclose (data_hid);
1095 
1096  octave_idx_type len = 0;
1097 
1098  // we have to pull some shenanigans here to make sure
1099  // HDF5 doesn't print out all sorts of error messages if we
1100  // call H5Aopen for a non-existing attribute
1101 
1102  H5E_auto_t err_func;
1103  void *err_func_data;
1104 
1105  // turn off error reporting temporarily, but save the error
1106  // reporting function:
1107 #if HAVE_HDF5_18
1108  H5Eget_auto (H5E_DEFAULT, &err_func, &err_func_data);
1109  H5Eset_auto (H5E_DEFAULT, 0, 0);
1110 #else
1111  H5Eget_auto (&err_func, &err_func_data);
1112  H5Eset_auto (0, 0);
1113 #endif
1114 
1115  hid_t attr_id = H5Aopen_name (group_hid, "SYMBOL_TABLE");
1116 
1117  if (attr_id >= 0)
1118  {
1119  if (H5Aread (attr_id, H5T_NATIVE_IDX, &len) < 0)
1120  success = false;
1121 
1122  H5Aclose (attr_id);
1123  }
1124 
1125  // restore error reporting:
1126 #if HAVE_HDF5_18
1127  H5Eset_auto (H5E_DEFAULT, err_func, err_func_data);
1128 #else
1129  H5Eset_auto (err_func, err_func_data);
1130 #endif
1131 
1132  unwind_protect_safe frame;
1133 
1134  // Set up temporary scope to use for evaluating the text that
1135  // defines the anonymous function.
1136 
1138  frame.add_fcn (symbol_table::erase_scope, local_scope);
1139 
1140  symbol_table::set_scope (local_scope);
1141 
1142  octave_call_stack::push (local_scope, 0);
1144 
1145  if (len > 0 && success)
1146  {
1147  hsize_t num_obj = 0;
1148 #if HAVE_HDF5_18
1149  data_hid = H5Gopen (group_hid, "symbol table", H5P_DEFAULT);
1150 #else
1151  data_hid = H5Gopen (group_hid, "symbol table");
1152 #endif
1153  H5Gget_num_objs (data_hid, &num_obj);
1154  H5Gclose (data_hid);
1155 
1156  if (num_obj != static_cast<hsize_t>(len))
1157  {
1158  error ("load: failed to load anonymous function handle");
1159  success = false;
1160  }
1161 
1162  if (! error_state)
1163  {
1164  hdf5_callback_data dsub;
1165  int current_item = 0;
1166  for (octave_idx_type i = 0; i < len; i++)
1167  {
1168  if (H5Giterate (group_hid, "symbol table", &current_item,
1169  hdf5_read_next_data, &dsub) <= 0)
1170  {
1171  error ("load: failed to load anonymous function handle");
1172  success = false;
1173  break;
1174  }
1175 
1176  symbol_table::assign (dsub.name, dsub.tc, local_scope);
1177  }
1178  }
1179  }
1180 
1181  if (success)
1182  {
1183  int parse_status;
1184  octave_value anon_fcn_handle =
1185  eval_string (fcn_tmp, true, parse_status);
1186 
1187  if (parse_status == 0)
1188  {
1189  octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value ();
1190 
1191  if (fh)
1192  {
1193  fcn = fh->fcn;
1194 
1196 
1197  if (uf)
1198  symbol_table::cache_name (uf->scope (), nm);
1199  }
1200  else
1201  success = false;
1202  }
1203  else
1204  success = false;
1205  }
1206 
1207  frame.run ();
1208  }
1209  else
1210  {
1211  std::string octaveroot;
1212  std::string fpath;
1213 
1214  // we have to pull some shenanigans here to make sure
1215  // HDF5 doesn't print out all sorts of error messages if we
1216  // call H5Aopen for a non-existing attribute
1217 
1218  H5E_auto_t err_func;
1219  void *err_func_data;
1220 
1221  // turn off error reporting temporarily, but save the error
1222  // reporting function:
1223 #if HAVE_HDF5_18
1224  H5Eget_auto (H5E_DEFAULT, &err_func, &err_func_data);
1225  H5Eset_auto (H5E_DEFAULT, 0, 0);
1226 #else
1227  H5Eget_auto (&err_func, &err_func_data);
1228  H5Eset_auto (0, 0);
1229 #endif
1230 
1231  hid_t attr_id = H5Aopen_name (group_hid, "OCTAVEROOT");
1232  if (attr_id >= 0)
1233  {
1234  H5Tclose (type_hid);
1235  type_hid = H5Aget_type (attr_id);
1236  type_class_hid = H5Tget_class (type_hid);
1237 
1238  if (type_class_hid != H5T_STRING)
1239  success = false;
1240  else
1241  {
1242  slen = H5Tget_size (type_hid);
1243  st_id = H5Tcopy (H5T_C_S1);
1244  H5Tset_size (st_id, slen);
1245  OCTAVE_LOCAL_BUFFER (char, root_tmp, slen);
1246 
1247  if (H5Aread (attr_id, st_id, root_tmp) < 0)
1248  success = false;
1249  else
1250  octaveroot = root_tmp;
1251 
1252  H5Tclose (st_id);
1253  }
1254 
1255  H5Aclose (attr_id);
1256  }
1257 
1258  if (success)
1259  {
1260  attr_id = H5Aopen_name (group_hid, "FILE");
1261  if (attr_id >= 0)
1262  {
1263  H5Tclose (type_hid);
1264  type_hid = H5Aget_type (attr_id);
1265  type_class_hid = H5Tget_class (type_hid);
1266 
1267  if (type_class_hid != H5T_STRING)
1268  success = false;
1269  else
1270  {
1271  slen = H5Tget_size (type_hid);
1272  st_id = H5Tcopy (H5T_C_S1);
1273  H5Tset_size (st_id, slen);
1274  OCTAVE_LOCAL_BUFFER (char, path_tmp, slen);
1275 
1276  if (H5Aread (attr_id, st_id, path_tmp) < 0)
1277  success = false;
1278  else
1279  fpath = path_tmp;
1280 
1281  H5Tclose (st_id);
1282  }
1283 
1284  H5Aclose (attr_id);
1285  }
1286  }
1287 
1288  // restore error reporting:
1289 #if HAVE_HDF5_18
1290  H5Eset_auto (H5E_DEFAULT, err_func, err_func_data);
1291 #else
1292  H5Eset_auto (err_func, err_func_data);
1293 #endif
1294 
1295  success = (success ? set_fcn (octaveroot, fpath) : success);
1296  }
1297 
1298  H5Tclose (type_hid);
1299  H5Sclose (space_hid);
1300  H5Gclose (group_hid);
1301 
1302  return success;
1303 
1304 #else
1305  gripe_load ("hdf5");
1306  return false;
1307 #endif
1308 }
1309 
1310 /*
1311 %!test
1312 %! a = 2;
1313 %! f = @(x) a + x;
1314 %! g = @(x) 2 * x;
1315 %! hm = @version;
1316 %! hdld = @svd;
1317 %! hbi = @log2;
1318 %! f2 = f;
1319 %! g2 = g;
1320 %! hm2 = hm;
1321 %! hdld2 = hdld;
1322 %! hbi2 = hbi;
1323 %! modes = {"-text", "-binary"};
1324 %! if (isfield (octave_config_info, "HAVE_HDF5")
1325 %! && octave_config_info ("HAVE_HDF5"))
1326 %! modes(end+1) = "-hdf5";
1327 %! endif
1328 %! for i = 1:numel (modes)
1329 %! mode = modes{i};
1330 %! nm = tempname ();
1331 %! unwind_protect
1332 %! f2 (1); # bug #33857
1333 %! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2");
1334 %! clear f2 g2 hm2 hdld2 hbi2
1335 %! load (nm);
1336 %! assert (f (2), f2 (2));
1337 %! assert (g (2), g2 (2));
1338 %! assert (g (3), g2 (3));
1339 %! unlink (nm);
1340 %! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2");
1341 %! unwind_protect_cleanup
1342 %! unlink (nm);
1343 %! end_unwind_protect
1344 %! endfor
1345 */
1346 
1347 /*
1348 %!function fcn_handle_save_recurse (n, mode, nm, f2, g2, hm2, hdld2, hbi2)
1349 %! if (n == 0)
1350 %! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2");
1351 %! else
1352 %! fcn_handle_save_recurse (n - 1, mode, nm, f2, g2, hm2, hdld2, hbi2);
1353 %! endif
1354 %!endfunction
1355 %!function [f2, g2, hm2, hdld2, hbi2] = fcn_handle_load_recurse (n, nm)
1356 %! if (n == 0)
1357 %! load (nm)
1358 %! else
1359 %! [f2, g2, hm2, hdld2, hbi2] = fcn_handle_load_recurse (n - 1, nm);
1360 %! endif
1361 %!endfunction
1362 
1363 Test for bug #35876
1364 %!test
1365 %! a = 2;
1366 %! f = @(x) a + x;
1367 %! g = @(x) 2 * x;
1368 %! hm = @version;
1369 %! hdld = @svd;
1370 %! hbi = @log2;
1371 %! f2 = f;
1372 %! g2 = g;
1373 %! hm2 = hm;
1374 %! hdld2 = hdld;
1375 %! hbi2 = hbi;
1376 %! modes = {"-text", "-binary"};
1377 %! if (isfield (octave_config_info, "HAVE_HDF5")
1378 %! && octave_config_info ("HAVE_HDF5"))
1379 %! modes(end+1) = "-hdf5";
1380 %! endif
1381 %! for i = 1:numel (modes)
1382 %! mode = modes{i};
1383 %! nm = tempname ();
1384 %! unwind_protect
1385 %! fcn_handle_save_recurse (2, mode, nm, f2, g2, hm2, hdld2, hbi2);
1386 %! clear f2 g2 hm2 hdld2 hbi2
1387 %! [f2, f2, hm2, hdld2, hbi2] = fcn_handle_load_recurse (2, nm);
1388 %! load (nm);
1389 %! assert (f (2), f2 (2));
1390 %! assert (g (2), g2 (2));
1391 %! assert (g (3), g2 (3));
1392 %! unlink (nm);
1393 %! fcn_handle_save_recurse (2, mode, nm, f2, g2, hm2, hdld2, hbi2);
1394 %! unwind_protect_cleanup
1395 %! unlink (nm);
1396 %! end_unwind_protect
1397 %! endfor
1398 */
1399 
1400 void
1401 octave_fcn_handle::print (std::ostream& os, bool pr_as_read_syntax)
1402 {
1403  print_raw (os, pr_as_read_syntax);
1404  newline (os);
1405 }
1406 
1407 void
1408 octave_fcn_handle::print_raw (std::ostream& os, bool pr_as_read_syntax) const
1409 {
1410  bool printed = false;
1411 
1412  if (nm == anonymous)
1413  {
1414  tree_print_code tpc (os);
1415 
1416  // FCN is const because this member function is, so we can't
1417  // use it to call user_function_value, so we make a copy first.
1418 
1419  octave_value ftmp = fcn;
1420 
1422 
1423  if (f)
1424  {
1426 
1427  os << "@(";
1428 
1429  if (p)
1430  p->accept (tpc);
1431 
1432  os << ") ";
1433 
1434  tpc.print_fcn_handle_body (f->body ());
1435 
1436  printed = true;
1437  }
1438  }
1439 
1440  if (! printed)
1441  octave_print_internal (os, "@" + nm, pr_as_read_syntax,
1443 }
1444 
1446 make_fcn_handle (const std::string& nm, bool local_funcs)
1447 {
1448  octave_value retval;
1449 
1450  // Bow to the god of compatibility.
1451 
1452  // FIXME: it seems ugly to put this here, but there is no single
1453  // function in the parser that converts from the operator name to
1454  // the corresponding function name. At least try to do it without N
1455  // string compares.
1456 
1457  std::string tnm = nm;
1458 
1459  size_t len = nm.length ();
1460 
1461  if (len == 3 && nm == ".**")
1462  tnm = "power";
1463  else if (len == 2)
1464  {
1465  if (nm[0] == '.')
1466  {
1467  switch (nm[1])
1468  {
1469  case '\'':
1470  tnm = "transpose";
1471  break;
1472 
1473  case '+':
1474  tnm = "plus";
1475  break;
1476 
1477  case '-':
1478  tnm = "minus";
1479  break;
1480 
1481  case '*':
1482  tnm = "times";
1483  break;
1484 
1485  case '/':
1486  tnm = "rdivide";
1487  break;
1488 
1489  case '^':
1490  tnm = "power";
1491  break;
1492 
1493  case '\\':
1494  tnm = "ldivide";
1495  break;
1496  }
1497  }
1498  else if (nm[1] == '=')
1499  {
1500  switch (nm[0])
1501  {
1502  case '<':
1503  tnm = "le";
1504  break;
1505 
1506  case '=':
1507  tnm = "eq";
1508  break;
1509 
1510  case '>':
1511  tnm = "ge";
1512  break;
1513 
1514  case '~':
1515  case '!':
1516  tnm = "ne";
1517  break;
1518  }
1519  }
1520  else if (nm == "**")
1521  tnm = "mpower";
1522  }
1523  else if (len == 1)
1524  {
1525  switch (nm[0])
1526  {
1527  case '~':
1528  case '!':
1529  tnm = "not";
1530  break;
1531 
1532  case '\'':
1533  tnm = "ctranspose";
1534  break;
1535 
1536  case '+':
1537  tnm = "plus";
1538  break;
1539 
1540  case '-':
1541  tnm = "minus";
1542  break;
1543 
1544  case '*':
1545  tnm = "mtimes";
1546  break;
1547 
1548  case '/':
1549  tnm = "mrdivide";
1550  break;
1551 
1552  case '^':
1553  tnm = "mpower";
1554  break;
1555 
1556  case '\\':
1557  tnm = "mldivide";
1558  break;
1559 
1560  case '<':
1561  tnm = "lt";
1562  break;
1563 
1564  case '>':
1565  tnm = "gt";
1566  break;
1567 
1568  case '&':
1569  tnm = "and";
1570  break;
1571 
1572  case '|':
1573  tnm = "or";
1574  break;
1575  }
1576  }
1577 
1579  local_funcs);
1580 
1581  octave_function *fptr = f.function_value (true);
1582 
1583  // Here we are just looking to see if FCN is a method or constructor
1584  // for any class.
1585  if (local_funcs && fptr
1586  && (fptr->is_subfunction () || fptr->is_private_function ()
1587  || fptr->is_class_constructor ()
1588  || fptr->is_classdef_constructor ()))
1589  {
1590  // Locally visible function.
1591  retval = octave_value (new octave_fcn_handle (f, tnm));
1592  }
1593  else
1594  {
1595  // Globally visible (or no match yet). Query overloads.
1596  std::list<std::string> classes = load_path::overloads (tnm);
1597  bool any_match = fptr != 0 || classes.size () > 0;
1598  if (! any_match)
1599  {
1600  // No match found, try updating load_path and query classes again.
1601  load_path::update ();
1602  classes = load_path::overloads (tnm);
1603  any_match = classes.size () > 0;
1604  }
1605 
1606  if (any_match)
1607  {
1608  octave_fcn_handle *fh = new octave_fcn_handle (f, tnm);
1609  retval = fh;
1610 
1611  for (std::list<std::string>::iterator iter = classes.begin ();
1612  iter != classes.end (); iter++)
1613  {
1614  std::string class_name = *iter;
1615  octave_value fmeth = symbol_table::find_method (tnm, class_name);
1616 
1617  bool is_builtin = false;
1618  for (int i = 0; i < btyp_num_types; i++)
1619  {
1620  // FIXME: Too slow? Maybe binary lookup?
1621  if (class_name == btyp_class_name[i])
1622  {
1623  is_builtin = true;
1624  fh->set_overload (static_cast<builtin_type_t> (i), fmeth);
1625  }
1626  }
1627 
1628  if (! is_builtin)
1629  fh->set_overload (class_name, fmeth);
1630  }
1631  }
1632  else
1633  error ("@%s: no function and no method found", tnm.c_str ());
1634  }
1635 
1636  return retval;
1637 }
1638 
1639 /*
1640 %!test
1641 %! x = {".**", "power";
1642 %! ".'", "transpose";
1643 %! ".+", "plus";
1644 %! ".-", "minus";
1645 %! ".*", "times";
1646 %! "./", "rdivide";
1647 %! ".^", "power";
1648 %! ".\\", "ldivide";
1649 %! "<=", "le";
1650 %! "==", "eq";
1651 %! ">=", "ge";
1652 %! "~=", "ne";
1653 %! "!=", "ne";
1654 %! "**", "mpower";
1655 %! "~", "not";
1656 %! "!", "not";
1657 %! "\'", "ctranspose";
1658 %! "+", "plus";
1659 %! "-", "minus";
1660 %! "*", "mtimes";
1661 %! "/", "mrdivide";
1662 %! "^", "mpower";
1663 %! "\\", "mldivide";
1664 %! "<", "lt";
1665 %! ">", "gt";
1666 %! "&", "and";
1667 %! "|", "or"};
1668 %! for i = 1:rows (x)
1669 %! assert (functions (str2func (x{i,1})).function, x{i,2});
1670 %! endfor
1671 */
1672 
1673 DEFUN (functions, args, ,
1674  "-*- texinfo -*-\n\
1675 @deftypefn {Built-in Function} {@var{s} =} functions (@var{fcn_handle})\n\
1676 Return a structure containing information about the function handle\n\
1677 @var{fcn_handle}.\n\
1678 \n\
1679 The structure @var{s} always contains these three fields:\n\
1680 \n\
1681 @table @asis\n\
1682 @item function\n\
1683 The function name. For an anonymous function (no name) this will be the\n\
1684 actual function definition.\n\
1685 \n\
1686 @item type\n\
1687 Type of the function.\n\
1688 \n\
1689 @table @asis\n\
1690 @item anonymous\n\
1691 The function is anonymous.\n\
1692 \n\
1693 @item private\n\
1694 The function is private.\n\
1695 \n\
1696 @item overloaded\n\
1697 The function overloads an existing function.\n\
1698 \n\
1699 @item simple\n\
1700 The function is a built-in or m-file function.\n\
1701 \n\
1702 @item subfunction\n\
1703 The function is a subfunction within an m-file.\n\
1704 @end table\n\
1705 \n\
1706 @item file\n\
1707 The m-file that will be called to perform the function. This field is empty\n\
1708 for anonymous and built-in functions.\n\
1709 @end table\n\
1710 \n\
1711 In addition, some function types may return more information in additional\n\
1712 fields.\n\
1713 \n\
1714 @strong{Warning:} @code{functions} is provided for debugging purposes only.\n\
1715 It's behavior may change in the future and programs should not depend on a\n\
1716 particular output.\n\
1717 \n\
1718 @end deftypefn")
1719 {
1720  octave_value retval;
1721 
1722  if (args.length () == 1)
1723  {
1724  octave_fcn_handle *fh = args(0).fcn_handle_value ();
1725 
1726  if (! error_state)
1727  {
1728  octave_function *fcn = fh ? fh->function_value () : 0;
1729 
1730  if (fcn)
1731  {
1733 
1734  std::string fh_nm = fh->fcn_name ();
1735 
1736  if (fh_nm == octave_fcn_handle::anonymous)
1737  {
1738  std::ostringstream buf;
1739  fh->print_raw (buf);
1740  m.setfield ("function", buf.str ());
1741 
1742  m.setfield ("type", "anonymous");
1743  }
1744  else
1745  {
1746  m.setfield ("function", fh_nm);
1747 
1748  if (fcn->is_subfunction ())
1749  {
1750  m.setfield ("type", "subfunction");
1751  Cell parentage (dim_vector (1, 2));
1752  parentage.elem (0) = fh_nm;
1753  parentage.elem (1) = fcn->parent_fcn_name ();
1754  m.setfield ("parentage", octave_value (parentage));
1755  }
1756  else if (fcn->is_private_function ())
1757  m.setfield ("type", "private");
1758  else if (fh->is_overloaded ())
1759  m.setfield ("type", "overloaded");
1760  else
1761  m.setfield ("type", "simple");
1762  }
1763 
1764  std::string nm = fcn->fcn_file_name ();
1765 
1766  if (fh_nm == octave_fcn_handle::anonymous)
1767  {
1768  m.setfield ("file", nm);
1769 
1771 
1772  std::list<symbol_table::symbol_record> vars
1773  = symbol_table::all_variables (fu->scope (), 0);
1774 
1775  size_t varlen = vars.size ();
1776 
1777  if (varlen > 0)
1778  {
1779  octave_scalar_map ws;
1780  for (std::list<symbol_table::symbol_record>::const_iterator
1781  p = vars.begin (); p != vars.end (); p++)
1782  {
1783  ws.assign (p->name (), p->varval (0));
1784  }
1785 
1786  m.setfield ("workspace", ws);
1787  }
1788  }
1789  else if (fcn->is_user_function () || fcn->is_user_script ())
1790  {
1791  octave_function *fu = fh->function_value ();
1792  m.setfield ("file", fu->fcn_file_name ());
1793  }
1794  else
1795  m.setfield ("file", "");
1796 
1797  retval = m;
1798  }
1799  else
1800  error ("functions: FCN_HANDLE is not a valid function handle object");
1801  }
1802  else
1803  error ("functions: FCN_HANDLE argument must be a function handle object");
1804  }
1805  else
1806  print_usage ();
1807 
1808  return retval;
1809 }
1810 
1811 DEFUN (func2str, args, ,
1812  "-*- texinfo -*-\n\
1813 @deftypefn {Built-in Function} {} func2str (@var{fcn_handle})\n\
1814 Return a string containing the name of the function referenced by the\n\
1815 function handle @var{fcn_handle}.\n\
1816 @seealso{str2func, functions}\n\
1817 @end deftypefn")
1818 {
1819  octave_value retval;
1820 
1821  if (args.length () == 1)
1822  {
1823  octave_fcn_handle *fh = args(0).fcn_handle_value ();
1824 
1825  if (! error_state && fh)
1826  {
1827  std::string fh_nm = fh->fcn_name ();
1828 
1829  if (fh_nm == octave_fcn_handle::anonymous)
1830  {
1831  std::ostringstream buf;
1832 
1833  fh->print_raw (buf);
1834 
1835  retval = buf.str ();
1836  }
1837  else
1838  retval = fh_nm;
1839  }
1840  else
1841  error ("func2str: FCN_HANDLE must be a valid function handle");
1842  }
1843  else
1844  print_usage ();
1845 
1846  return retval;
1847 }
1848 
1849 DEFUN (str2func, args, ,
1850  "-*- texinfo -*-\n\
1851 @deftypefn {Built-in Function} {} str2func (@var{fcn_name})\n\
1852 @deftypefnx {Built-in Function} {} str2func (@var{fcn_name}, \"global\")\n\
1853 Return a function handle constructed from the string @var{fcn_name}.\n\
1854 \n\
1855 If the optional @qcode{\"global\"} argument is passed, locally visible\n\
1856 functions are ignored in the lookup.\n\
1857 @seealso{func2str, inline}\n\
1858 @end deftypefn")
1859 {
1860  octave_value retval;
1861  int nargin = args.length ();
1862 
1863  if (nargin == 1 || nargin == 2)
1864  {
1865  if (args(0).is_string ())
1866  {
1867  std::string nm = args(0).string_value ();
1868  retval = make_fcn_handle (nm, nargin != 2);
1869  }
1870  else
1871  error ("str2func: FCN_NAME must be a string");
1872  }
1873  else
1874  print_usage ();
1875 
1876  return retval;
1877 }
1878 
1879 /*
1880 %!function y = __testrecursionfunc (f, x, n)
1881 %! if (nargin < 3)
1882 %! n = 0;
1883 %! endif
1884 %! if (n > 2)
1885 %! y = f (x);
1886 %! else
1887 %! n++;
1888 %! y = __testrecursionfunc (@(x) f (2*x), x, n);
1889 %! endif
1890 %!endfunction
1891 %!
1892 %!assert (__testrecursionfunc (@(x) x, 1), 8)
1893 */
1894 
1895 DEFUN (is_function_handle, args, ,
1896  "-*- texinfo -*-\n\
1897 @deftypefn {Built-in Function} {} is_function_handle (@var{x})\n\
1898 Return true if @var{x} is a function handle.\n\
1899 @seealso{isa, typeinfo, class, functions}\n\
1900 @end deftypefn")
1901 {
1902  octave_value retval;
1903 
1904  int nargin = args.length ();
1905 
1906  if (nargin == 1)
1907  retval = args(0).is_function_handle ();
1908  else
1909  print_usage ();
1910 
1911  return retval;
1912 }
1913 
1914 /*
1915 %!shared fh
1916 %! fh = @(x) x;
1917 
1918 %!assert (is_function_handle (fh))
1919 %!assert (! is_function_handle ({fh}))
1920 %!assert (! is_function_handle (1))
1921 
1922 %!error is_function_handle ()
1923 %!error is_function_handle (1, 2)
1924 */
1925 
1927  const octave_value& root,
1928  const octave_value_list& templ,
1929  const std::vector<int>& mask,
1930  int exp_nargin)
1931  : octave_fcn_handle (f), root_handle (root), arg_template (templ),
1932  arg_mask (mask), expected_nargin (exp_nargin)
1933 {
1934 }
1935 
1938 {
1939  octave_fcn_handle *retval = 0;
1940 
1941  octave_user_function *usr_fcn = f.user_function_value (false);
1942  tree_parameter_list *param_list = usr_fcn ? usr_fcn->parameter_list () : 0;
1943 
1944  tree_statement_list *cmd_list = 0;
1945  tree_expression *body_expr = 0;
1946 
1947  if (usr_fcn)
1948  {
1949  cmd_list = usr_fcn->body ();
1950  if (cmd_list)
1951  {
1952  // Verify that body is a single expression (always true in theory).
1953  body_expr = (cmd_list->length () == 1
1954  ? cmd_list->front ()->expression () : 0);
1955  }
1956  }
1957 
1958  if (body_expr && body_expr->is_index_expression ()
1959  && ! (param_list && param_list->takes_varargs ()))
1960  {
1961  // It's an index expression.
1962  tree_index_expression *idx_expr = dynamic_cast<tree_index_expression *>
1963  (body_expr);
1964  tree_expression *head_expr = idx_expr->expression ();
1965  std::list<tree_argument_list *> arg_lists = idx_expr->arg_lists ();
1966  std::string type_tags = idx_expr->type_tags ();
1967 
1968  if (type_tags.length () == 1 && type_tags[0] == '('
1969  && head_expr->is_identifier ())
1970  {
1971  assert (arg_lists.size () == 1);
1972 
1973  // It's a single index expression: a(x,y,....)
1974  tree_identifier *head_id =
1975  dynamic_cast<tree_identifier *> (head_expr);
1976  tree_argument_list *arg_list = arg_lists.front ();
1977 
1978  // Build a map of input params to their position.
1979  std::map<std::string, int> arginmap;
1980  int npar = 0;
1981 
1982  if (param_list)
1983  {
1984  for (tree_parameter_list::iterator it = param_list->begin ();
1985  it != param_list->end (); ++it, ++npar)
1986  {
1987  tree_decl_elt *elt = *it;
1988  tree_identifier *id = elt ? elt->ident () : 0;
1989  if (id && ! id->is_black_hole ())
1990  arginmap[id->name ()] = npar;
1991  }
1992  }
1993 
1994  if (arg_list && arg_list->length () > 0)
1995  {
1996  bool bad = false;
1997  int nargs = arg_list->length ();
1999  std::vector<int> arg_mask (nargs);
2000 
2001  // Verify that each argument is either a named param, a constant,
2002  // or a defined identifier.
2003  int iarg = 0;
2004  for (tree_argument_list::iterator it = arg_list->begin ();
2005  it != arg_list->end (); ++it, ++iarg)
2006  {
2007  tree_expression *elt = *it;
2008  if (elt && elt->is_constant ())
2009  {
2010  arg_template(iarg) = elt->rvalue1 ();
2011  arg_mask[iarg] = -1;
2012  }
2013  else if (elt && elt->is_identifier ())
2014  {
2015  tree_identifier *elt_id =
2016  dynamic_cast<tree_identifier *> (elt);
2017  if (arginmap.find (elt_id->name ()) != arginmap.end ())
2018  {
2019  arg_mask[iarg] = arginmap[elt_id->name ()];
2020  }
2021  else if (elt_id->is_defined ())
2022  {
2023  arg_template(iarg) = elt_id->rvalue1 ();
2024  arg_mask[iarg] = -1;
2025  }
2026  else
2027  {
2028  bad = true;
2029  break;
2030  }
2031  }
2032  else
2033  {
2034  bad = true;
2035  break;
2036  }
2037  }
2038 
2039  octave_value root_val;
2040 
2041  if (! bad)
2042  {
2043  // If the head is a value, use it as root.
2044  if (head_id->is_defined ())
2045  root_val = head_id->rvalue1 ();
2046  else
2047  {
2048  // It's a name.
2049  std::string head_name = head_id->name ();
2050  // Function handles can't handle legacy dispatch, so
2051  // we make sure it's not defined.
2052  if (symbol_table::get_dispatch (head_name).size () > 0)
2053  bad = true;
2054  else
2055  {
2056  // Simulate try/catch.
2057  unwind_protect frame;
2058  interpreter_try (frame);
2059 
2060  root_val = make_fcn_handle (head_name);
2061  if (error_state)
2062  bad = true;
2063  }
2064  }
2065  }
2066 
2067  if (! bad)
2068  {
2069  // Stash proper name tags.
2070  std::list<string_vector> arg_names = idx_expr->arg_names ();
2071  assert (arg_names.size () == 1);
2072  arg_template.stash_name_tags (arg_names.front ());
2073 
2074  retval = new octave_fcn_binder (f, root_val, arg_template,
2075  arg_mask, npar);
2076  }
2077  }
2078  }
2079  }
2080 
2081  if (! retval)
2083 
2084  return retval;
2085 }
2086 
2089  const octave_value_list& args)
2090 {
2091  return do_multi_index_op (nargout, args, 0);
2092 }
2093 
2096  const octave_value_list& args,
2097  const std::list<octave_lvalue>* lvalue_list)
2098 {
2099  octave_value_list retval;
2100 
2101  if (args.length () == expected_nargin)
2102  {
2103  for (int i = 0; i < arg_template.length (); i++)
2104  {
2105  int j = arg_mask[i];
2106  if (j >= 0)
2107  arg_template(i) = args(j); // May force a copy...
2108  }
2109 
2110  // Make a shallow copy of arg_template, to ensure consistency throughout
2111  // the following call even if we happen to get back here.
2113  retval = root_handle.do_multi_index_op (nargout, tmp, lvalue_list);
2114  }
2115  else
2116  retval = octave_fcn_handle::do_multi_index_op (nargout, args, lvalue_list);
2117 
2118  return retval;
2119 }
2120 
2121 /*
2122 %!function r = __f (g, i)
2123 %! r = g(i);
2124 %!endfunction
2125 %!test
2126 %! x = [1,2;3,4];
2127 %! assert (__f (@(i) x(:,i), 1), [1;3]);
2128 */
std::string read_until_newline(std::istream &is, bool keep_newline)
static std::string system_path(void)
Definition: load-path.h:278
octave_value subsref(const std::string &type, const std::list< octave_value_list > &idx)
Definition: ov-fcn-handle.h:76
std::string find_first_of(const string_vector &names)
Definition: pathsearch.cc:132
size_t length(void) const
Definition: base-list.h:45
Definition: Cell.h:35
static const std::string anonymous
Definition: ov-fcn-handle.h:49
bool is_equal_to(const octave_fcn_handle &) const
octave_function * load_fcn_from_file(const std::string &file_name, const std::string &dir_name, const std::string &dispatch_type, const std::string &package_name, const std::string &fcn_name, bool autoload)
Definition: oct-parse.cc:8198
virtual bool is_constant(void) const
Definition: pt-exp.h:53
tree_parameter_list * parameter_list(void)
Definition: ov-usr-fcn.h:376
octave_fcn_handle * fcn_handle_value(bool=false)
static octave_value find_method(const std::string &name, const std::string &dispatch_type)
Definition: symtab.h:1501
OCTINTERP_API void print_usage(void)
Definition: defun.cc:51
octave_value tc
Definition: ls-hdf5.h:150
bool is_function(void) const
Definition: ov.h:695
void gripe_load(const char *type) const
Definition: ov-base.cc:1258
void print_raw(std::ostream &os, bool pr_as_read_syntax=false) const
bool set_fcn(const std::string &octaveroot, const std::string &fpath)
octave_idx_type length(void) const
Definition: oct-obj.h:89
static std::list< symbol_record > all_variables(scope_id scope=xcurrent_scope, context_id context=xdefault_context, bool defined_only=true, unsigned int exclude=symbol_record::hidden)
Definition: symtab.h:1957
bool out_of_date_check(octave_value &function, const std::string &dispatch_type, bool check_relative)
Definition: symtab.cc:208
bool is_defined(void) const
Definition: ov.h:520
static void set_scope(scope_id scope)
Definition: symtab.h:1169
std::string name
Definition: ls-hdf5.h:144
std::vector< int > arg_mask
bool is_defined(void)
Definition: pt-id.h:67
void run(size_t num)
FloatComplex(* fptr)(const FloatComplex &, float, int, octave_idx_type &)
Definition: lo-specfun.cc:1732
#define DEFUN(name, args_name, nargout_name, doc)
Definition: defun.h:44
void error(const char *fmt,...)
Definition: error.cc:476
symbol_table::scope_id scope(void)
Definition: ov-usr-fcn.h:248
static string_vector names(const map_type &lst)
Definition: help.cc:782
void setfield(const std::string &key, const octave_value &val)
Definition: oct-map.cc:171
static std::map< std::string, std::string > vars
Definition: mkoctfile.cc:56
static scope_id alloc_scope(void)
Definition: symtab.h:1167
#define DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA(t, n, c)
Definition: ov-base.h:164
void gripe_save(const char *type) const
Definition: ov-base.cc:1267
void interpreter_try(unwind_protect &frame)
Definition: error.cc:2161
void skip_preceeding_newline(std::istream &is)
T & elem(octave_idx_type n)
Definition: Array.h:380
octave_value_list eval_string(const std::string &eval_str, bool silent, int &parse_status, int nargout)
Definition: oct-parse.cc:8810
herr_t hdf5_read_next_data(hid_t group_id, const char *name, void *dv)
Definition: ls-hdf5.cc:249
elt_type & front(void)
Definition: base-list.h:92
tree_expression * expression(void)
Definition: pt-idx.h:72
bool load_ascii(std::istream &is)
bool is_copy_of(const octave_value &val) const
Definition: ov.h:1087
octave_fcn_handle * fcn_handle_value(bool silent=false) const
Definition: ov.cc:1621
static octave_fcn_handle * maybe_binder(const octave_value &f)
bool is_overloaded(void) const
builtin_type_t
Definition: ov-base.h:59
bool save_binary(std::ostream &os, bool &save_as_floats)
void newline(std::ostream &os) const
Definition: ov-base.cc:1500
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::string type_tags(void)
Definition: pt-idx.h:76
std::list< string_vector > arg_names(void)
Definition: pt-idx.h:78
bool is_function_handle(void) const
Definition: ov.h:686
static void cache_name(scope_id scope, const std::string &name)
Definition: symtab.h:2196
tree_identifier * ident(void)
Definition: pt-decl.h:85
octave_value make_fcn_handle(const std::string &nm, bool local_funcs)
octave_fcn_binder(const octave_value &f, const octave_value &root, const octave_value_list &templ, const std::vector< int > &mask, int exp_nargin)
octave_value_list do_multi_index_op(int nargout, const octave_value_list &idx)
Definition: ov.cc:1382
std::list< tree_decl_elt * >::iterator iterator
Definition: base-list.h:36
virtual bool is_classdef_constructor(const std::string &=std::string()) const
Definition: ov-fcn.h:89
str_ov_map overloads
iterator end(void)
Definition: base-list.h:81
std::string extract_keyword(std::istream &is, const char *keyword, const bool next_only)
Definition: ls-oct-ascii.cc:80
void swap_bytes< 4 >(void *ptr)
Definition: byte-swap.h:59
std::list< tree_argument_list * > arg_lists(void)
Definition: pt-idx.h:74
F77_RET_T const double const double * f
void add_fcn(void(*fcn)(void))
octave_value root_handle
bool save_ascii(std::ostream &os)
bool exists(void) const
Definition: file-stat.h:134
std::string name(void) const
Definition: pt-id.h:65
static std::string make_absolute(const std::string &s, const std::string &dot_path=get_current_directory())
Definition: oct-env.cc:132
std::string btyp_class_name[btyp_num_types]
Definition: ov-base.cc:83
bool add_hdf5_data(hid_t loc_id, const octave_value &tc, const std::string &name, const std::string &doc, bool mark_as_global, bool save_as_floats)
Definition: ls-hdf5.cc:868
bool save_ascii_data(std::ostream &os, const octave_value &val_arg, const std::string &name, bool mark_as_global, int precision)
octave_user_function * user_function_value(bool silent=false) const
Definition: ov.cc:1603
virtual bool is_index_expression(void) const
Definition: pt-exp.h:61
int error_state
Definition: error.cc:101
bool save_hdf5(octave_hdf5_id loc_id, const char *name, bool save_as_floats)
octave_value_list arg_template
#define panic_impossible()
Definition: error.h:33
octave_value builtin_overloads[btyp_num_types]
virtual bool is_black_hole(void)
Definition: pt-id.h:71
bool is_private_function(void) const
Definition: ov-fcn.h:114
static fcn_info::dispatch_map_type get_dispatch(const std::string &name)
Definition: symtab.h:1870
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
std::string read_binary_data(std::istream &is, bool swap, oct_mach_info::float_format fmt, const std::string &filename, bool &global, octave_value &tc, std::string &doc)
virtual bool is_user_script(void) const
Definition: ov-base.h:439
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
octave_idx_type length(void) const
Definition: ov.cc:1525
virtual bool is_user_function(void) const
Definition: ov-base.h:441
static std::list< std::string > parent_classes(const std::string &dispatch_type)
Definition: symtab.h:2256
virtual Matrix size(void)
Definition: ov-base.cc:142
iterator begin(void)
Definition: base-list.h:78
friend octave_value make_fcn_handle(const std::string &, bool)
bool load_binary(std::istream &is, bool swap, oct_mach_info::float_format fmt)
friend class octave_value
Definition: ov-base.h:206
bool takes_varargs(void) const
Definition: pt-misc.h:71
octave_function * function_value(bool silent=false) const
Definition: ov.cc:1597
octave_value rvalue1(int nargout=1)
Definition: pt-id.cc:117
virtual std::string parent_fcn_name(void) const
Definition: ov-fcn.h:69
static std::string dir_sep_chars(void)
Definition: file-ops.h:68
virtual octave_value rvalue1(int nargout=1)
Definition: pt-exp.cc:58
virtual std::string fcn_file_name(void) const
Definition: ov-fcn.h:62
#define H5T_NATIVE_IDX
Definition: ls-hdf5.h:209
static std::list< std::string > overloads(const std::string &meth)
Definition: load-path.h:123
static void update(void)
Definition: load-path.h:85
octave_value_list do_multi_index_op(int nargout, const octave_value_list &args)
virtual bool is_subfunction(void) const
Definition: ov-fcn.h:83
bool save_binary_data(std::ostream &os, const octave_value &tc, const std::string &name, const std::string &doc, bool mark_as_global, bool save_as_floats)
#define OCTAVE_EXEC_PREFIX
Definition: defaults.h:64
int current_print_indent_level(void) const
Definition: ov-base.h:805
void assign(const std::string &k, const octave_value &val)
Definition: oct-map.h:225
tree_expression * expression(void)
Definition: pt-stmt.h:83
octave_value_list do_multi_index_op(int nargout, const octave_value_list &args)
OCTAVE_EMPTY_CPP_ARG std::string type_name(void) const
octave_value fcn
void octave_print_internal(std::ostream &, char, bool)
Definition: pr-output.cc:1715
std::string get_dispatch_type(const octave_value_list &args, builtin_type_t &builtin_type)
Definition: symtab.cc:611
#define OCTAVE_LOCAL_BUFFER(T, buf, size)
Definition: oct-locbuf.h:197
bool is_undefined(void) const
Definition: ov.h:523
virtual bool is_class_constructor(const std::string &=std::string()) const
Definition: ov-fcn.h:85
void set_overload(builtin_type_t btyp, const octave_value &ov_fcn)
static void pop(void)
Definition: toplev.h:332
void print_fcn_handle_body(tree_statement_list *)
Definition: pt-pr-code.cc:1170
tree_statement_list * body(void)
Definition: ov-usr-fcn.h:380
void print(std::ostream &os, bool pr_as_read_syntax=false)
void accept(tree_walker &tw)
Definition: pt-misc.cc:332
bool load_hdf5(octave_hdf5_id loc_id, const char *name)
virtual bool is_identifier(void) const
Definition: pt-exp.h:59
octave_function * function_value(bool=false)
return octave_value(v1.char_array_value().concat(v2.char_array_value(), ra_idx),((a1.is_sq_string()||a2.is_sq_string())? '\'': '"'))
static void erase_scope(scope_id scope)
Definition: symtab.h:1218
std::string fcn_name(void) const
std::string read_ascii_data(std::istream &is, const std::string &filename, bool &global, octave_value &tc, octave_idx_type count)
bool is_nested_function(void) const
Definition: ov-usr-fcn.h:325
void stash_name_tags(const string_vector &nm)
Definition: oct-obj.h:137
octave_user_function * user_function_value(bool=false)