GNU Octave 11.1.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 
Loading...
Searching...
No Matches
pt-assign.cc
Go to the documentation of this file.
1////////////////////////////////////////////////////////////////////////
2//
3// Copyright (C) 1996-2026 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 <string>
31
32#include "error.h"
33#include "interpreter.h"
34#include "oct-lvalue.h"
35#include "ov.h"
36#include "pt-arg-list.h"
37#include "pt-assign.h"
38
40
41// Simple assignment expressions.
42
44 : m_lhs (le), m_rhs (re), m_preserve (plhs), m_ans_assign (), m_etype (t)
45{ }
46
48{
49 if (! m_preserve)
50 delete m_lhs;
51
52 delete m_rhs;
53}
54
55std::string
60
63{
65 = new tree_simple_assignment (m_lhs ? m_lhs->dup (scope) : nullptr,
66 m_rhs ? m_rhs->dup (scope) : nullptr,
67 m_preserve, m_etype);
68
69 new_sa->copy_base (*this);
70
71 return new_sa;
72}
73
76{
77 octave_value val;
78
79 if (m_rhs)
80 {
81 try
82 {
83 octave_lvalue ult = m_lhs->lvalue (tw);
84
85 std::list<octave_lvalue> lvalue_list;
86 lvalue_list.push_back (ult);
87
88 unwind_action act ([&tw] (const std::list<octave_lvalue> *lvl)
89 {
90 tw.set_lvalue_list (lvl);
91 }, tw.lvalue_list ());
92 tw.set_lvalue_list (&lvalue_list);
93
94 octave_value rhs_val = m_rhs->evaluate (tw);
95
96 if (rhs_val.is_undefined ())
97 error ("value on right hand side of assignment is undefined");
98
99 if (rhs_val.is_cs_list ())
100 {
101 const octave_value_list lst = rhs_val.list_value ();
102
103 if (lst.empty ())
104 error ("invalid number of elements on RHS of assignment");
105
106 rhs_val = lst(0);
107 }
108
109 ult.assign (m_etype, rhs_val);
110
111 if (m_etype == octave_value::op_asn_eq)
112 val = rhs_val;
113 else
114 val = ult.value ();
115
117 {
118 // We clear any index here so that we can
119 // get the new value of the referenced
120 // object below, instead of the indexed
121 // value (which should be the same as the
122 // right hand side value).
123
124 ult.clear_index ();
125
126 octave_value lhs_val = ult.value ();
127
128 octave_value_list args = ovl (lhs_val);
129 args.stash_name_tags (string_vector (m_lhs->name ()));
130
131 interpreter& interp = tw.get_interpreter ();
132
133 interp.feval ("display", args);
134 }
135 }
136 catch (index_exception& ie)
137 {
138 ie.set_var (m_lhs->name ());
139 std::string msg = ie.message ();
140 error_with_id (ie.err_id (), "%s", msg.c_str ());
141 }
142 }
143
144 return val;
145}
146
147// Multi-valued assignment expressions.
148
150 : m_lhs (lst), m_rhs (r), m_preserve (plhs)
151{ }
152
154{
155 if (! m_preserve)
156 delete m_lhs;
157
158 delete m_rhs;
159}
160
161std::string
166
169{
170 error ("unexpected call to tree_multi_assignment::dup - please report this bug");
171
172 return nullptr;
173}
174
177{
179
180 if (m_rhs)
181 {
182 std::list<octave_lvalue> lvalue_list = tw.make_lvalue_list (m_lhs);
183
184 unwind_action act ([&tw] (const std::list<octave_lvalue> *lvl)
185 {
186 tw.set_lvalue_list (lvl);
187 }, tw.lvalue_list ());
188 tw.set_lvalue_list (&lvalue_list);
189
190 octave_idx_type n_out = 0;
191
192 for (const auto& lval : lvalue_list)
193 n_out += lval.numel ();
194
195 // The following trick is used to keep rhs_val constant.
196 const octave_value_list rhs_val1 = m_rhs->evaluate_n (tw, n_out);
197 const octave_value_list rhs_val = (rhs_val1.length () == 1
198 && rhs_val1(0).is_cs_list ()
199 ? rhs_val1(0).list_value ()
200 : rhs_val1);
201
202 octave_idx_type k = 0;
203
204 octave_idx_type n = rhs_val.length ();
205
206 // To avoid copying per elements and possible optimizations, we
207 // postpone joining the final values.
208 std::list<octave_value_list> retval_list;
209
210 auto q = m_lhs->begin ();
211
212 for (octave_lvalue ult : lvalue_list)
213 {
214 tree_expression *lhs_elt = *q++;
215
216 octave_idx_type nel = ult.numel ();
217
218 if (nel != 1)
219 {
220 // Huge kluge so that wrapper scripts with lines like
221 //
222 // [varargout{1:nargout}] = fcn (args);
223 //
224 // or
225 //
226 // varargout = cell (1, nargout);
227 // [varargout{1:nargout}] = fcn (args);
228 //
229 // or
230 //
231 // varargout = cell (1, nargout);
232 // [varargout{:}] = fcn (args);
233 //
234 // Will work the same as calling fcn directly when nargout
235 // is 0 and fcn produces more than one output even when
236 // nargout is 0. See also bug #43813.
237
238 if (lvalue_list.size () == 1 && nel == 0 && n > 0
239 && ! ult.is_black_hole () && ult.index_type () == "{"
240 && (ult.index_is_empty ()
241 || (ult.is_defined () && ult.index_is_colon ())))
242 {
243 // Convert undefined lvalue with empty index to a cell
244 // array with a single value and indexed by 1 to
245 // handle a single output.
246
247 nel = 1;
248
249 ult.define (Cell (1, 1));
250
251 ult.clear_index ();
252 std::list<octave_value_list> idx;
253 idx.push_back (octave_value_list (octave_value (1)));
254 ult.set_index ("{", idx);
255 }
256
257 if (k + nel > n)
258 error ("some elements undefined in return list");
259
260 // This element of the return list expects a
261 // comma-separated list of values. Slicing avoids
262 // copying.
263
264 octave_value_list ovl = rhs_val.slice (k, nel);
265
267
268 retval_list.push_back (ovl);
269
270 k += nel;
271 }
272 else
273 {
274 if (k < n)
275 {
276 if (ult.is_black_hole ())
277 {
278 k++;
279 continue;
280 }
281 else
282 {
283 octave_value tmp = rhs_val(k);
284
285 if (tmp.is_undefined ())
286 error ("element number %" OCTAVE_IDX_TYPE_FORMAT
287 " undefined in return list", k+1);
288
289 ult.assign (octave_value::op_asn_eq, tmp);
290
291 retval_list.push_back (tmp);
292
293 k++;
294 }
295 }
296 else
297 {
298 // This can happen for a function like
299 //
300 // function varargout = f ()
301 // varargout{1} = nargout;
302 // endfunction
303 //
304 // called with
305 //
306 // [a, ~] = f ();
307 //
308 // Then the list of of RHS values will contain one
309 // element but we are iterating over the list of all
310 // RHS values. We shouldn't complain that a value we
311 // don't need is missing from the list.
312
313 if (! ult.is_black_hole ())
314 error ("element number %" OCTAVE_IDX_TYPE_FORMAT
315 " undefined in return list", k+1);
316
317 k++;
318 continue;
319 }
320 }
321
323 {
324 // We clear any index here so that we can get
325 // the new value of the referenced object below,
326 // instead of the indexed value (which should be
327 // the same as the right hand side value).
328
329 ult.clear_index ();
330
331 octave_value lhs_val = ult.value ();
332
333 octave_value_list args = ovl (lhs_val);
334 args.stash_name_tags (string_vector (lhs_elt->name ()));
335
336 interpreter& interp = tw.get_interpreter ();
337
338 interp.feval ("display", args);
339 }
340 }
341
342 // Concatenate return values.
343 val = retval_list;
344 }
345
346 return val;
347}
348
349OCTAVE_END_NAMESPACE(octave)
350
351/*
352%!function varargout = f1 ()
353%! varargout{1} = nargout;
354%!endfunction
355%!
356%!test
357%! [a, ~] = f1 ();
358%! assert (a, 2);
359%!test
360%! [a, ~, ~, ~, ~] = f1 ();
361%! assert (a, 5);
362
363%!function [x, y] = f2 ()
364%! y = 1;
365%!endfunction
366%!
367%!test
368%! [~, y] = f2 ();
369%! assert (y, 1);
370
371%!function [x, y, varargout] = f3 ()
372%! y = 1;
373%! varargout = {2, 3};
374%!endfunction
375%!
376%!test
377%! [~, y, a, b] = f3 ();
378%! assert ([y, a, b], [1, 2, 3]);
379%!test
380%! [~, y, ~, b] = f3 ();
381%! assert ([y, b], [1, 3]);
382*/
Definition Cell.h:41
void set_var(const std::string &var_arg="")
virtual const char * err_id() const =0
octave_value_list feval(const char *name, const octave_value_list &args=octave_value_list(), int nargout=0)
Evaluate an Octave function (built-in or interpreted) and return the list of result values.
void clear_index()
Definition oct-lvalue.h:70
void assign(octave_value::assign_op, const octave_value &)
Definition oct-lvalue.cc:58
octave_value value() const
void stash_name_tags(const string_vector &nm)
Definition ovl.h:163
bool empty() const
Definition ovl.h:113
octave_value_list slice(octave_idx_type offset, octave_idx_type len, bool tags=false) const
Definition ovl.h:129
octave_idx_type length() const
Definition ovl.h:111
octave_value_list list_value() const
bool is_undefined() const
Definition ov.h:593
static std::string assign_op_as_string(assign_op)
Definition ov.cc:355
@ op_asn_eq
Definition ov.h:135
bool is_cs_list() const
Definition ov.h:668
interpreter & get_interpreter()
Definition pt-eval.h:428
const std::list< octave_lvalue > * lvalue_list() const
Definition pt-eval.h:768
void set_lvalue_list(const std::list< octave_lvalue > *lst)
Definition pt-eval.h:773
std::list< octave_lvalue > make_lvalue_list(tree_argument_list *)
Definition pt-eval.cc:4924
bool statement_printing_enabled()
Definition pt-eval.cc:1383
virtual octave_value evaluate(tree_evaluator &tw, int nargout=1)=0
bool print_result() const
Definition pt-exp.h:107
virtual void copy_base(const tree_expression &e)
Definition pt-exp.h:142
virtual std::string name() const
Definition pt-exp.h:114
virtual tree_expression * dup(symbol_scope &scope) const =0
virtual octave_lvalue lvalue(tree_evaluator &)
Definition pt-exp.cc:43
virtual octave_value_list evaluate_n(tree_evaluator &tw, int nargout=1)=0
std::string op_str() const
Definition pt-assign.cc:162
octave_value::assign_op op_type() const
Definition pt-assign.h:171
tree_expression * dup(symbol_scope &scope) const
Definition pt-assign.cc:168
tree_multi_assignment(bool plhs=false)
Definition pt-assign.h:126
octave_value_list evaluate_n(tree_evaluator &tw, int nargout=1)
Definition pt-assign.cc:176
octave_value evaluate(tree_evaluator &tw, int nargout=1)
Definition pt-assign.cc:75
tree_expression * dup(symbol_scope &scope) const
Definition pt-assign.cc:62
std::string op_str() const
Definition pt-assign.cc:56
OCTAVE_BEGIN_NAMESPACE(octave) static octave_value daspk_fcn
void error_with_id(const char *id, const char *fmt,...)
Definition error.cc:1053
void error(const char *fmt,...)
Definition error.cc:1008
octave_value_list ovl(const OV_Args &... args)
Construct an octave_value_list with less typing.
Definition ovl.h:217