GNU Octave 10.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-2025 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 if (ult.numel () != 1)
96
97 octave_value rhs_val = m_rhs->evaluate (tw);
98
99 if (rhs_val.is_undefined ())
100 error ("value on right hand side of assignment is undefined");
101
102 if (rhs_val.is_cs_list ())
103 {
104 const octave_value_list lst = rhs_val.list_value ();
105
106 if (lst.empty ())
107 error ("invalid number of elements on RHS of assignment");
108
109 rhs_val = lst(0);
110 }
111
112 ult.assign (m_etype, rhs_val);
113
114 if (m_etype == octave_value::op_asn_eq)
115 val = rhs_val;
116 else
117 val = ult.value ();
118
120 {
121 // We clear any index here so that we can
122 // get the new value of the referenced
123 // object below, instead of the indexed
124 // value (which should be the same as the
125 // right hand side value).
126
127 ult.clear_index ();
128
129 octave_value lhs_val = ult.value ();
130
131 octave_value_list args = ovl (lhs_val);
132 args.stash_name_tags (string_vector (m_lhs->name ()));
133
134 interpreter& interp = tw.get_interpreter ();
135
136 interp.feval ("display", args);
137 }
138 }
139 catch (index_exception& ie)
140 {
141 ie.set_var (m_lhs->name ());
142 std::string msg = ie.message ();
143 error_with_id (ie.err_id (), "%s", msg.c_str ());
144 }
145 }
146
147 return val;
148}
149
150// Multi-valued assignment expressions.
151
153 : m_lhs (lst), m_rhs (r), m_preserve (plhs)
154{ }
155
157{
158 if (! m_preserve)
159 delete m_lhs;
160
161 delete m_rhs;
162}
163
164std::string
169
172{
173 error ("unexpected call to tree_multi_assignment::dup - please report this bug");
174
175 return nullptr;
176}
177
180{
182
183 if (m_rhs)
184 {
185 std::list<octave_lvalue> lvalue_list = tw.make_lvalue_list (m_lhs);
186
187 unwind_action act ([&tw] (const std::list<octave_lvalue> *lvl)
188 {
189 tw.set_lvalue_list (lvl);
190 }, tw.lvalue_list ());
191 tw.set_lvalue_list (&lvalue_list);
192
193 octave_idx_type n_out = 0;
194
195 for (const auto& lval : lvalue_list)
196 n_out += lval.numel ();
197
198 // The following trick is used to keep rhs_val constant.
199 const octave_value_list rhs_val1 = m_rhs->evaluate_n (tw, n_out);
200 const octave_value_list rhs_val = (rhs_val1.length () == 1
201 && rhs_val1(0).is_cs_list ()
202 ? rhs_val1(0).list_value ()
203 : rhs_val1);
204
205 octave_idx_type k = 0;
206
207 octave_idx_type n = rhs_val.length ();
208
209 // To avoid copying per elements and possible optimizations, we
210 // postpone joining the final values.
211 std::list<octave_value_list> retval_list;
212
213 auto q = m_lhs->begin ();
214
215 for (octave_lvalue ult : lvalue_list)
216 {
217 tree_expression *lhs_elt = *q++;
218
219 octave_idx_type nel = ult.numel ();
220
221 if (nel != 1)
222 {
223 // Huge kluge so that wrapper scripts with lines like
224 //
225 // [varargout{1:nargout}] = fcn (args);
226 //
227 // or
228 //
229 // varargout = cell (1, nargout);
230 // [varargout{1:nargout}] = fcn (args);
231 //
232 // or
233 //
234 // varargout = cell (1, nargout);
235 // [varargout{:}] = fcn (args);
236 //
237 // Will work the same as calling fcn directly when nargout
238 // is 0 and fcn produces more than one output even when
239 // nargout is 0. See also bug #43813.
240
241 if (lvalue_list.size () == 1 && nel == 0 && n > 0
242 && ! ult.is_black_hole () && ult.index_type () == "{"
243 && (ult.index_is_empty ()
244 || (ult.is_defined () && ult.index_is_colon ())))
245 {
246 // Convert undefined lvalue with empty index to a cell
247 // array with a single value and indexed by 1 to
248 // handle a single output.
249
250 nel = 1;
251
252 ult.define (Cell (1, 1));
253
254 ult.clear_index ();
255 std::list<octave_value_list> idx;
256 idx.push_back (octave_value_list (octave_value (1)));
257 ult.set_index ("{", idx);
258 }
259
260 if (k + nel > n)
261 error ("some elements undefined in return list");
262
263 // This element of the return list expects a
264 // comma-separated list of values. Slicing avoids
265 // copying.
266
267 octave_value_list ovl = rhs_val.slice (k, nel);
268
270
271 retval_list.push_back (ovl);
272
273 k += nel;
274 }
275 else
276 {
277 if (k < n)
278 {
279 if (ult.is_black_hole ())
280 {
281 k++;
282 continue;
283 }
284 else
285 {
286 octave_value tmp = rhs_val(k);
287
288 if (tmp.is_undefined ())
289 error ("element number %" OCTAVE_IDX_TYPE_FORMAT
290 " undefined in return list", k+1);
291
292 ult.assign (octave_value::op_asn_eq, tmp);
293
294 retval_list.push_back (tmp);
295
296 k++;
297 }
298 }
299 else
300 {
301 // This can happen for a function like
302 //
303 // function varargout = f ()
304 // varargout{1} = nargout;
305 // endfunction
306 //
307 // called with
308 //
309 // [a, ~] = f ();
310 //
311 // Then the list of of RHS values will contain one
312 // element but we are iterating over the list of all
313 // RHS values. We shouldn't complain that a value we
314 // don't need is missing from the list.
315
316 if (! ult.is_black_hole ())
317 error ("element number %" OCTAVE_IDX_TYPE_FORMAT
318 " undefined in return list", k+1);
319
320 k++;
321 continue;
322 }
323 }
324
326 {
327 // We clear any index here so that we can get
328 // the new value of the referenced object below,
329 // instead of the indexed value (which should be
330 // the same as the right hand side value).
331
332 ult.clear_index ();
333
334 octave_value lhs_val = ult.value ();
335
336 octave_value_list args = ovl (lhs_val);
337 args.stash_name_tags (string_vector (lhs_elt->name ()));
338
339 interpreter& interp = tw.get_interpreter ();
340
341 interp.feval ("display", args);
342 }
343 }
344
345 // Concatenate return values.
346 val = retval_list;
347 }
348
349 return val;
350}
351
352OCTAVE_END_NAMESPACE(octave)
353
354/*
355%!function varargout = f1 ()
356%! varargout{1} = nargout;
357%!endfunction
358%!
359%!test
360%! [a, ~] = f1 ();
361%! assert (a, 2);
362%!test
363%! [a, ~, ~, ~, ~] = f1 ();
364%! assert (a, 5);
365
366%!function [x, y] = f2 ()
367%! y = 1;
368%!endfunction
369%!
370%!test
371%! [~, y] = f2 ();
372%! assert (y, 1);
373
374%!function [x, y, varargout] = f3 ()
375%! y = 1;
376%! varargout = {2, 3};
377%!endfunction
378%!
379%!test
380%! [~, y, a, b] = f3 ();
381%! assert ([y, a, b], [1, 2, 3]);
382%!test
383%! [~, y, ~, b] = f3 ();
384%! assert ([y, b], [1, 3]);
385*/
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_idx_type numel() const
Definition oct-lvalue.cc:66
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:595
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:670
interpreter & get_interpreter()
Definition pt-eval.h:422
const std::list< octave_lvalue > * lvalue_list() const
Definition pt-eval.h:762
void set_lvalue_list(const std::list< octave_lvalue > *lst)
Definition pt-eval.h:767
std::list< octave_lvalue > make_lvalue_list(tree_argument_list *)
Definition pt-eval.cc:4919
bool statement_printing_enabled()
Definition pt-eval.cc:1377
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:137
virtual std::string name() const
Definition pt-exp.h:111
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 oper() const
Definition pt-assign.cc:165
octave_value::assign_op op_type() const
Definition pt-assign.h:161
tree_expression * dup(symbol_scope &scope) const
Definition pt-assign.cc:171
tree_multi_assignment(bool plhs=false)
Definition pt-assign.h:122
octave_value_list evaluate_n(tree_evaluator &tw, int nargout=1)
Definition pt-assign.cc:179
std::string oper() const
Definition pt-assign.cc:56
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
OCTAVE_BEGIN_NAMESPACE(octave) static octave_value daspk_fcn
void error_with_id(const char *id, const char *fmt,...)
Definition error.cc:1048
void error(const char *fmt,...)
Definition error.cc:1003
void err_invalid_structure_assignment()
Definition errwarn.cc:83
octave_value_list ovl(const OV_Args &... args)
Construct an octave_value_list with less typing.
Definition ovl.h:217