GNU Octave  3.8.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
pt-fcn-handle.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 2003-2013 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 <iostream>
28 
29 #include "error.h"
30 #include "oct-obj.h"
31 #include "ov-fcn-handle.h"
32 #include "pt-fcn-handle.h"
33 #include "pager.h"
34 #include "pt-const.h"
35 #include "pt-walk.h"
36 #include "variables.h"
37 
38 void
39 tree_fcn_handle::print (std::ostream& os, bool pr_as_read_syntax,
40  bool pr_orig_text)
41 {
42  print_raw (os, pr_as_read_syntax, pr_orig_text);
43 }
44 
45 void
46 tree_fcn_handle::print_raw (std::ostream& os, bool pr_as_read_syntax,
47  bool pr_orig_text)
48 {
49  os << ((pr_as_read_syntax || pr_orig_text) ? "@" : "") << nm;
50 }
51 
54 {
55  return make_fcn_handle (nm);
56 }
57 
60 {
61  octave_value_list retval;
62 
63  if (nargout > 1)
64  error ("invalid number of output arguments for function handle expression");
65  else
66  retval = rvalue1 (nargout);
67 
68  return retval;
69 }
70 
74 {
75  tree_fcn_handle *new_fh = new tree_fcn_handle (nm, line (), column ());
76 
77  new_fh->copy_base (*this);
78 
79  return new_fh;
80 }
81 
82 void
84 {
85  tw.visit_fcn_handle (*this);
86 }
87 
90 {
91  // FIXME: should CMD_LIST be limited to a single expression?
92  // I think that is what Matlab does.
93 
94  tree_parameter_list *param_list = parameter_list ();
95  tree_parameter_list *ret_list = return_list ();
96  tree_statement_list *cmd_list = body ();
97  symbol_table::scope_id this_scope = scope ();
98 
99  symbol_table::scope_id new_scope = symbol_table::dup_scope (this_scope);
100 
101  if (new_scope > 0)
104 
106  = new octave_user_function (new_scope,
107  param_list ? param_list->dup (new_scope, 0) : 0,
108  ret_list ? ret_list->dup (new_scope, 0) : 0,
109  cmd_list ? cmd_list->dup (new_scope, 0) : 0);
110 
112 
113  if (curr_fcn)
114  {
115  // FIXME: maybe it would be better to just stash curr_fcn
116  // instead of individual bits of info about it?
117 
118  uf->stash_parent_fcn_name (curr_fcn->name ());
119  uf->stash_dir_name (curr_fcn->dir_name ());
120 
121  symbol_table::scope_id parent_scope = curr_fcn->parent_fcn_scope ();
122 
123  if (parent_scope < 0)
124  parent_scope = curr_fcn->scope ();
125 
126  uf->stash_parent_fcn_scope (parent_scope);
127 
128  if (curr_fcn->is_class_method () || curr_fcn->is_class_constructor ())
129  uf->stash_dispatch_class (curr_fcn->dispatch_class ());
130  }
131 
134  uf->stash_fcn_location (line (), column ());
135 
136  octave_value ov_fcn (uf);
137 
139 
140  return fh;
141 }
142 
143 /*
144 %!function r = __f2 (f, x)
145 %! r = f (x);
146 %!endfunction
147 %!function f = __f1 (k)
148 %! f = @(x) __f2 (@(y) y-k, x);
149 %!endfunction
150 
151 %!assert ((__f1 (3)) (10) == 7)
152 
153 %!test
154 %! g = @(t) feval (@(x) t*x, 2);
155 %! assert (g(0.5) == 1);
156 
157 %!test
158 %! h = @(x) sin (x);
159 %! g = @(f, x) h (x);
160 %! f = @() g (@(x) h, pi);
161 %! assert (f () == sin (pi));
162 
163 The next two tests are intended to test parsing of a character string
164 vs. hermitian operator at the beginning of an anonymous function
165 expression. The use of ' for the character string and the spacing is
166 intentional, so don't change it.
167 
168 %!test
169 %! f = @() 'foo';
170 %! assert (f (), 'foo');
171 
172 %!test
173 %! f = @()'foo';
174 %! assert (f (), 'foo');
175 */
176 
179 {
180  octave_value_list retval;
181 
182  if (nargout > 1)
183  error ("invalid number of output arguments for anonymous function handle expression");
184  else
185  retval = rvalue1 (nargout);
186 
187  return retval;
188 }
189 
193 {
194  tree_parameter_list *param_list = parameter_list ();
195  tree_parameter_list *ret_list = return_list ();
196  tree_statement_list *cmd_list = body ();
197  symbol_table::scope_id this_scope = scope ();
198 
199  symbol_table::scope_id new_scope = symbol_table::dup_scope (this_scope);
200 
201  if (new_scope > 0)
204 
205  tree_anon_fcn_handle *new_afh = new
206  tree_anon_fcn_handle (param_list ? param_list->dup (new_scope, 0) : 0,
207  ret_list ? ret_list->dup (new_scope, 0) : 0,
208  cmd_list ? cmd_list->dup (new_scope, 0) : 0,
209  new_scope, line (), column ());
210 
211  new_afh->copy_base (*this);
212 
213  return new_afh;
214 }
215 
216 void
218 {
219  tw.visit_anon_fcn_handle (*this);
220 }