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