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