1 //////////////////////////////////////////////////////////////////////// 2 // 3 // Copyright (C) 2003-2021 The Octave Project Developers 4 // 5 // See the file COPYRIGHT.md in the top-level directory of this 6 // distribution or <https://octave.org/copyright/>. 7 // 8 // This file is part of Octave. 9 // 10 // Octave is free software: you can redistribute it and/or modify it 11 // under the terms of the GNU General Public License as published by 12 // the Free Software Foundation, either version 3 of the License, or 13 // (at your option) any later version. 14 // 15 // Octave is distributed in the hope that it will be useful, but 16 // WITHOUT ANY WARRANTY; without even the implied warranty of 17 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 // GNU General Public License for more details. 19 // 20 // You should have received a copy of the GNU General Public License 21 // along with Octave; see the file COPYING. If not, see 22 // <https://www.gnu.org/licenses/>. 23 // 24 //////////////////////////////////////////////////////////////////////// 25 26 #if defined (HAVE_CONFIG_H) 27 # include "config.h" 28 #endif 29 30 #include <ostream> 31 32 #include "interpreter-private.h" 33 #include "pt-anon-scopes.h" 34 #include "pt-fcn-handle.h" 35 #include "stack-frame.h" 36 37 namespace octave 38 { 39 void print(std::ostream & os,bool pr_as_read_syntax,bool pr_orig_text)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 print_raw(std::ostream & os,bool pr_as_read_syntax,bool pr_orig_text)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) ? "@" : "") << m_name; 51 } 52 53 tree_expression * dup(symbol_scope &) const54 tree_fcn_handle::dup (symbol_scope&) const 55 { 56 tree_fcn_handle *new_fh = new tree_fcn_handle (m_name, line (), column ()); 57 58 new_fh->copy_base (*this); 59 60 return new_fh; 61 } 62 63 octave_value evaluate(tree_evaluator & tw,int)64 tree_fcn_handle::evaluate (tree_evaluator& tw, int) 65 { 66 return tw.make_fcn_handle (m_name); 67 } 68 ~tree_anon_fcn_handle(void)69 tree_anon_fcn_handle::~tree_anon_fcn_handle (void) 70 { 71 delete m_parameter_list; 72 delete m_expression; 73 } 74 75 tree_expression * dup(symbol_scope &) const76 tree_anon_fcn_handle::dup (symbol_scope&) const 77 { 78 tree_parameter_list *param_list = parameter_list (); 79 tree_expression *expr = expression (); 80 81 symbol_scope af_scope = m_scope; 82 symbol_scope af_parent_scope = m_parent_scope; 83 84 symbol_scope new_scope; 85 86 if (af_scope) 87 new_scope = af_scope.dup (); 88 89 // FIXME: if new scope is nullptr, then we are in big trouble here... 90 91 tree_anon_fcn_handle *new_afh = new 92 tree_anon_fcn_handle (param_list ? param_list->dup (new_scope) : nullptr, 93 expr ? expr->dup (new_scope) : nullptr, 94 new_scope, af_parent_scope, line (), column ()); 95 96 new_afh->copy_base (*this); 97 98 return new_afh; 99 } 100 101 octave_value evaluate(tree_evaluator & tw,int)102 tree_anon_fcn_handle::evaluate (tree_evaluator& tw, int) 103 { 104 // FIXME: should CMD_LIST be limited to a single expression? 105 // I think that is what Matlab does. 106 107 symbol_scope new_scope; 108 if (m_scope) 109 new_scope = m_scope.dup (); 110 111 tree_parameter_list *param_list_dup 112 = m_parameter_list ? m_parameter_list->dup (new_scope) : nullptr; 113 114 tree_parameter_list *ret_list = nullptr; 115 116 tree_statement_list *stmt_list = nullptr; 117 118 symbol_scope parent_scope = tw.get_current_scope (); 119 120 new_scope.set_parent (parent_scope); 121 new_scope.set_primary_parent (parent_scope); 122 123 if (m_expression) 124 { 125 tree_expression *expr_dup = m_expression->dup (new_scope); 126 tree_statement *stmt = new tree_statement (expr_dup, nullptr); 127 stmt_list = new tree_statement_list (stmt); 128 } 129 130 tree_anon_scopes anon_fcn_ctx (*this); 131 132 std::set<std::string> free_vars = anon_fcn_ctx.free_variables (); 133 134 stack_frame::local_vars_map local_vars; 135 136 call_stack& cs = tw.get_call_stack (); 137 138 std::shared_ptr<stack_frame> frame = cs.get_current_stack_frame (); 139 140 for (auto& name : free_vars) 141 { 142 octave_value val = frame->varval (name); 143 144 if (val.is_defined ()) 145 local_vars[name] = val; 146 } 147 148 octave_user_function *af 149 = new octave_user_function (new_scope, param_list_dup, ret_list, 150 stmt_list); 151 152 octave_function *curr_fcn = cs.current_function (); 153 154 bool is_nested = false; 155 156 if (curr_fcn) 157 { 158 // FIXME: maybe it would be better to just stash curr_fcn 159 // instead of individual bits of info about it? 160 161 // An anonymous function defined inside another nested function 162 // or parent of a nested function also behaves like a nested 163 // function. 164 165 if (curr_fcn->is_parent_function () || curr_fcn->is_nested_function ()) 166 { 167 is_nested = true; 168 af->mark_as_nested_function (); 169 new_scope.set_nesting_depth (parent_scope.nesting_depth () + 1); 170 } 171 172 af->stash_parent_fcn_name (curr_fcn->name ()); 173 af->stash_dir_name (curr_fcn->dir_name ()); 174 175 new_scope.cache_fcn_file_name (curr_fcn->fcn_file_name ()); 176 new_scope.cache_dir_name (curr_fcn->dir_name ()); 177 178 // The following is needed so that class method dispatch works 179 // properly for anonymous functions that wrap class methods. 180 181 if (curr_fcn->is_class_method () || curr_fcn->is_class_constructor ()) 182 af->stash_dispatch_class (curr_fcn->dispatch_class ()); 183 184 af->stash_fcn_file_name (curr_fcn->fcn_file_name ()); 185 } 186 187 af->mark_as_anonymous_function (); 188 189 octave_value ov_fcn (af); 190 191 return (is_nested 192 ? octave_value (new octave_fcn_handle (ov_fcn, local_vars, frame)) 193 : octave_value (new octave_fcn_handle (ov_fcn, local_vars))); 194 } 195 } 196 197 /* 198 %!function r = __f2 (f, x) 199 %! r = f (x); 200 %!endfunction 201 %!function f = __f1 (k) 202 %! f = @(x) __f2 (@(y) y-k, x); 203 %!endfunction 204 205 %!assert ((__f1 (3)) (10) == 7) 206 207 %!test 208 %! g = @(t) feval (@(x) t*x, 2); 209 %! assert (g(0.5) == 1); 210 211 %!test 212 %! h = @(x) sin (x); 213 %! g = @(f, x) h (x); 214 %! f = @() g (@(x) h, pi); 215 %! assert (f () == sin (pi)); 216 217 The next two tests are intended to test parsing of a character string 218 vs. hermitian operator at the beginning of an anonymous function 219 expression. The use of ' for the character string and the spacing is 220 intentional, so don't change it. 221 222 %!test 223 %! f = @() 'foo'; 224 %! assert (f (), 'foo'); 225 226 %!test 227 %! f = @()'foo'; 228 %! assert (f (), 'foo'); 229 */ 230