GNU Octave  4.2.1
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
pt-fcn-handle.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 2003-2017 John W. Eaton
4 
5 This file is part of Octave.
6 
7 Octave is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 3 of the License, or (at your
10 option) any later version.
11 
12 Octave is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16 
17 You should have received a copy of the GNU General Public License
18 along with Octave; see the file COPYING. If not, see
19 <http://www.gnu.org/licenses/>.
20 
21 */
22 
23 #if defined (HAVE_CONFIG_H)
24 # include "config.h"
25 #endif
26 
27 #include <iostream>
28 
29 #include "call-stack.h"
30 #include "error.h"
31 #include "ovl.h"
32 #include "ov-fcn-handle.h"
33 #include "pt-fcn-handle.h"
34 #include "pager.h"
35 #include "pt-const.h"
36 #include "pt-walk.h"
37 #include "variables.h"
38 
39 void
40 tree_fcn_handle::print (std::ostream& os, bool pr_as_read_syntax,
41  bool pr_orig_text)
42 {
43  print_raw (os, pr_as_read_syntax, pr_orig_text);
44 }
45 
46 void
47 tree_fcn_handle::print_raw (std::ostream& os, bool pr_as_read_syntax,
48  bool pr_orig_text)
49 {
50  os << ((pr_as_read_syntax || pr_orig_text) ? "@" : "") << nm;
51 }
52 
55 {
56  return make_fcn_handle (nm);
57 }
58 
61 {
63 
64  if (nargout > 1)
65  error ("invalid number of output arguments for function handle expression");
66 
67  retval = rvalue1 (nargout);
68 
69  return retval;
70 }
71 
75 {
76  tree_fcn_handle *new_fh = new tree_fcn_handle (nm, line (), column ());
77 
78  new_fh->copy_base (*this);
79 
80  return new_fh;
81 }
82 
83 void
85 {
86  tw.visit_fcn_handle (*this);
87 }
88 
91 {
92  // FIXME: should CMD_LIST be limited to a single expression?
93  // I think that is what Matlab does.
94 
95  tree_parameter_list *param_list = parameter_list ();
96  tree_parameter_list *ret_list = return_list ();
97  tree_statement_list *cmd_list = body ();
98  symbol_table::scope_id this_scope = scope ();
99 
100  symbol_table::scope_id new_scope = symbol_table::dup_scope (this_scope);
101 
102  if (new_scope > 0)
105 
107  = new octave_user_function (new_scope,
108  param_list ? param_list->dup (new_scope, 0) : 0,
109  ret_list ? ret_list->dup (new_scope, 0) : 0,
110  cmd_list ? cmd_list->dup (new_scope, 0) : 0);
111 
113 
114  if (curr_fcn)
115  {
116  // FIXME: maybe it would be better to just stash curr_fcn
117  // instead of individual bits of info about it?
118 
119  uf->stash_parent_fcn_name (curr_fcn->name ());
120  uf->stash_dir_name (curr_fcn->dir_name ());
121 
122  symbol_table::scope_id parent_scope = curr_fcn->parent_fcn_scope ();
123 
124  if (parent_scope < 0)
125  parent_scope = curr_fcn->scope ();
126 
127  uf->stash_parent_fcn_scope (parent_scope);
128 
129  if (curr_fcn->is_class_method () || curr_fcn->is_class_constructor ())
130  uf->stash_dispatch_class (curr_fcn->dispatch_class ());
131  }
132 
135  uf->stash_fcn_location (line (), column ());
136 
137  octave_value ov_fcn (uf);
138 
140 
141  return fh;
142 }
143 
144 /*
145 %!function r = __f2 (f, x)
146 %! r = f (x);
147 %!endfunction
148 %!function f = __f1 (k)
149 %! f = @(x) __f2 (@(y) y-k, x);
150 %!endfunction
151 
152 %!assert ((__f1 (3)) (10) == 7)
153 
154 %!test
155 %! g = @(t) feval (@(x) t*x, 2);
156 %! assert (g(0.5) == 1);
157 
158 %!test
159 %! h = @(x) sin (x);
160 %! g = @(f, x) h (x);
161 %! f = @() g (@(x) h, pi);
162 %! assert (f () == sin (pi));
163 
164 The next two tests are intended to test parsing of a character string
165 vs. hermitian operator at the beginning of an anonymous function
166 expression. The use of ' for the character string and the spacing is
167 intentional, so don't change it.
168 
169 %!test
170 %! f = @() 'foo';
171 %! assert (f (), 'foo');
172 
173 %!test
174 %! f = @()'foo';
175 %! assert (f (), 'foo');
176 */
177 
180 {
182 
183  if (nargout > 1)
184  error ("invalid number of output arguments for anonymous function handle expression");
185 
186  retval = rvalue1 (nargout);
187 
188  return retval;
189 }
190 
194 {
195  tree_parameter_list *param_list = parameter_list ();
196  tree_parameter_list *ret_list = return_list ();
197  tree_statement_list *cmd_list = body ();
198  symbol_table::scope_id this_scope = scope ();
199 
200  symbol_table::scope_id new_scope = symbol_table::dup_scope (this_scope);
201 
202  if (new_scope > 0)
205 
206  tree_anon_fcn_handle *new_afh = new
207  tree_anon_fcn_handle (param_list ? param_list->dup (new_scope, 0) : 0,
208  ret_list ? ret_list->dup (new_scope, 0) : 0,
209  cmd_list ? cmd_list->dup (new_scope, 0) : 0,
210  new_scope, line (), column ());
211 
212  new_afh->copy_base (*this);
213 
214  return new_afh;
215 }
216 
217 void
219 {
220  tw.visit_anon_fcn_handle (*this);
221 }
static scope_id dup_scope(scope_id scope)
Definition: symtab.h:1247
tree_expression * dup(symbol_table::scope_id scope, symbol_table::context_id context) const
void accept(tree_walker &tw)
octave_value_list rvalue(int nargout)
void print(std::ostream &os, bool pr_as_read_syntax=false, bool pr_orig_txt=true)
octave_value_list rvalue(int nargout)
void error(const char *fmt,...)
Definition: error.cc:570
static octave_function * current(void)
Definition: call-stack.h:108
tree_fcn_handle(int l=-1, int c=-1)
Definition: pt-fcn-handle.h:50
tree_parameter_list * dup(symbol_table::scope_id scope, symbol_table::context_id context) const
Definition: pt-misc.cc:301
virtual void copy_base(const tree_expression &e)
Definition: pt-exp.h:131
void stash_dir_name(const std::string &dir)
Definition: ov-fcn.h:127
void stash_fcn_location(int line, int col)
Definition: ov-usr-fcn.h:205
static context_id current_context(void)
Definition: symtab.h:1165
tree_parameter_list * return_list(void) const
OCTAVE_EXPORT octave_value_list return the number of command line arguments passed to Octave If called with the optional argument the function xample nargout(@histc)
Definition: ov-usr-fcn.cc:935
void stash_parent_fcn_scope(symbol_table::scope_id ps)
Definition: ov-usr-fcn.h:227
octave_value retval
Definition: data.cc:6294
virtual int line(void) const
Definition: pt.h:49
void print_raw(std::ostream &os, bool pr_as_read_syntax=false, bool pr_orig_txt=true)
octave_value rvalue1(int nargout=1)
tree_expression * dup(symbol_table::scope_id scope, symbol_table::context_id context) const
virtual void visit_fcn_handle(tree_fcn_handle &)=0
octave_value rvalue1(int nargout=1)
symbol_table::scope_id scope(void) const
static octave_fcn_handle * maybe_binder(const octave_value &f)
static octave_value make_fcn_handle(octave_builtin::fcn ff, const std::string &nm)
Definition: ov-classdef.cc:127
tree_statement_list * body(void) const
tree_anon_fcn_handle(int l=-1, int c=-1)
Definition: pt-fcn-handle.h:96
void stash_dispatch_class(const std::string &nm)
Definition: ov-fcn.h:101
static void inherit(scope_id scope, scope_id donor_scope, context_id donor_context)
Definition: symtab.h:1287
void mark_as_anonymous_function(void)
Definition: ov-usr-fcn.h:304
tree_parameter_list * parameter_list(void) const
void stash_fcn_file_name(const std::string &nm)
Definition: ov-usr-fcn.cc:237
void stash_parent_fcn_name(const std::string &p)
Definition: ov-usr-fcn.h:225
virtual int column(void) const
Definition: pt.h:51
void accept(tree_walker &tw)
static scope_id current_scope(void)
Definition: symtab.h:1163
virtual void visit_anon_fcn_handle(tree_anon_fcn_handle &)=0
tree_statement_list * dup(symbol_table::scope_id scope, symbol_table::context_id context) const
Definition: pt-stmt.cc:306
std::string nm
Definition: pt-fcn-handle.h:82