GNU Octave  4.2.1
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
pt-assign.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 1996-2017 John W. Eaton
4 
5 This file is part of Octave.
6 
7 Octave is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 3 of the License, or (at your
10 option) any later version.
11 
12 Octave is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16 
17 You should have received a copy of the GNU General Public License
18 along with Octave; see the file COPYING. If not, see
19 <http://www.gnu.org/licenses/>.
20 
21 */
22 
23 #if defined (HAVE_CONFIG_H)
24 # include "config.h"
25 #endif
26 
27 #include <iostream>
28 #include <set>
29 
30 #include "defun.h"
31 #include "error.h"
32 #include "errwarn.h"
33 #include "input.h"
34 #include "ovl.h"
35 #include "oct-lvalue.h"
36 #include "pager.h"
37 #include "ov.h"
38 #include "pt-arg-list.h"
39 #include "pt-bp.h"
40 #include "pt-assign.h"
41 #include "pt-eval.h"
42 #include "pt-walk.h"
43 #include "utils.h"
44 #include "variables.h"
45 
46 // Simple assignment expressions.
47 
50  bool plhs, int l, int c, octave_value::assign_op t)
51  : tree_expression (l, c), lhs (le), rhs (re), preserve (plhs), etype (t)
52 { }
53 
55 {
56  if (! preserve)
57  delete lhs;
58 
59  delete rhs;
60 }
61 
64 {
65  if (nargout > 1)
66  error ("invalid number of output arguments for expression X = RHS");
67 
68  return rvalue1 (nargout);
69 }
70 
73 {
75 
76  if (rhs)
77  {
78  octave_value rhs_val = rhs->rvalue1 ();
79 
80  if (rhs_val.is_undefined ())
81  error ("value on right hand side of assignment is undefined");
82 
83  if (rhs_val.is_cs_list ())
84  {
85  const octave_value_list lst = rhs_val.list_value ();
86 
87  if (lst.empty ())
88  error ("invalid number of elements on RHS of assignment");
89 
90  rhs_val = lst(0);
91  }
92 
93  try
94  {
95  octave_lvalue ult = lhs->lvalue ();
96 
97  if (ult.numel () != 1)
99 
100  ult.assign (etype, rhs_val);
101 
103  retval = rhs_val;
104  else
105  retval = ult.value ();
106 
107  if (print_result ()
109  {
110  // We clear any index here so that we can
111  // get the new value of the referenced
112  // object below, instead of the indexed
113  // value (which should be the same as the
114  // right hand side value).
115 
116  ult.clear_index ();
117 
118  octave_value lhs_val = ult.value ();
119 
121  lhs->name ());
122  }
123  }
124  catch (octave::index_exception& e)
125  {
126  e.set_var (lhs->name ());
127  std::string msg = e.message ();
128  error_with_id (e.err_id (), msg.c_str ());
129  }
130  }
131 
132  return retval;
133 }
134 
137 {
139 }
140 
144 {
145  tree_simple_assignment *new_sa
146  = new tree_simple_assignment (lhs ? lhs->dup (scope, context) : 0,
147  rhs ? rhs->dup (scope, context) : 0,
148  preserve, etype);
149 
150  new_sa->copy_base (*this);
151 
152  return new_sa;
153 }
154 
155 void
157 {
158  tw.visit_simple_assignment (*this);
159 }
160 
161 // Multi-valued assignment expressions.
162 
165  bool plhs, int l, int c)
166  : tree_expression (l, c), lhs (lst), rhs (r), preserve (plhs)
167 { }
168 
170 {
171  if (! preserve)
172  delete lhs;
173 
174  delete rhs;
175 }
176 
179 {
181 
182  const octave_value_list tmp = rvalue (nargout);
183 
184  if (! tmp.empty ())
185  retval = tmp(0);
186 
187  return retval;
188 }
189 
190 // FIXME: this works, but it would look a little better if
191 // it were broken up into a couple of separate functions.
192 
195 {
197 
198  if (rhs)
199  {
200  std::list<octave_lvalue> lvalue_list = lhs->lvalue_list ();
201 
202  octave_idx_type n_out = 0;
203 
204  for (std::list<octave_lvalue>::const_iterator p = lvalue_list.begin ();
205  p != lvalue_list.end ();
206  p++)
207  n_out += p->numel ();
208 
209  // The following trick is used to keep rhs_val constant.
210  const octave_value_list rhs_val1 = rhs->rvalue (n_out, &lvalue_list);
211  const octave_value_list rhs_val = (rhs_val1.length () == 1
212  && rhs_val1(0).is_cs_list ()
213  ? rhs_val1(0).list_value ()
214  : rhs_val1);
215 
216  octave_idx_type k = 0;
217 
218  octave_idx_type n = rhs_val.length ();
219 
220  // To avoid copying per elements and possible optimizations, we
221  // postpone joining the final values.
222  std::list<octave_value_list> retval_list;
223 
225 
226  for (std::list<octave_lvalue>::iterator p = lvalue_list.begin ();
227  p != lvalue_list.end ();
228  p++)
229  {
230  tree_expression *lhs_elt = *q++;
231 
232  octave_lvalue ult = *p;
233 
234  octave_idx_type nel = ult.numel ();
235 
236  if (nel != 1)
237  {
238  // Huge kluge so that wrapper scripts with lines like
239  //
240  // [varargout{1:nargout}] = 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. This only works if varargout has not yet
245  // been defined. See also bug #43813.
246 
247  if (lvalue_list.size () == 1 && nel == 0 && n > 0
248  && ! ult.is_black_hole () && ult.is_undefined ()
249  && ult.index_type () == "{" && ult.index_is_empty ())
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 won't do a copy.
269  octave_value_list ovl = rhs_val.slice (k, nel);
270 
272  octave_value (ovl, true));
273 
274  retval_list.push_back (ovl);
275 
276  k += nel;
277  }
278  else
279  {
280  if (k < n)
281  {
282  ult.assign (octave_value::op_asn_eq, rhs_val(k));
283 
284  if (ult.is_black_hole ())
285  {
286  k++;
287  continue;
288  }
289  else
290  {
291  retval_list.push_back (rhs_val(k));
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 %d undefined in return list", k+1);
315 
316  k++;
317  continue;
318  }
319  }
320 
321  if (print_result ()
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  lhs_val.print_with_name (octave_stdout, lhs_elt->name ());
334  }
335  }
336 
337  // Concatenate return values.
338  retval = retval_list;
339  }
340 
341  return retval;
342 }
343 
344 /*
345 %!function varargout = f ()
346 %! varargout{1} = nargout;
347 %!endfunction
348 %!
349 %!test
350 %! [a, ~] = f ();
351 %! assert (a, 2);
352 %!test
353 %! [a, ~, ~, ~, ~] = f ();
354 %! assert (a, 5);
355 */
356 
359 {
361 }
362 
366 {
367  tree_multi_assignment *new_ma
368  = new tree_multi_assignment (lhs ? lhs->dup (scope, context) : 0,
369  rhs ? rhs->dup (scope, context) : 0,
370  preserve);
371 
372  new_ma->copy_base (*this);
373 
374  return new_ma;
375 }
376 
377 void
379 {
380  tw.visit_multi_assignment (*this);
381 }
std::list< octave_lvalue > lvalue_list(void)
tree_multi_assignment(bool plhs=false, int l=-1, int c=-1)
Definition: pt-assign.h:119
octave_value rvalue1(int nargout=1)
Definition: pt-assign.cc:72
Definition: Cell.h:37
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:49
void err_nonbraced_cs_list_assignment(void)
Definition: errwarn.cc:80
assign_op
Definition: ov.h:131
octave_value_list slice(octave_idx_type offset, octave_idx_type len, bool tags=false) const
Definition: ovl.h:114
OCTAVE_EXPORT octave_value_list isa nd deftypefn *return ovl(args(0).is_integer_type())
octave_value::assign_op etype
Definition: pt-assign.h:103
octave_idx_type length(void) const
Definition: ovl.h:96
tree_expression * dup(symbol_table::scope_id scope, symbol_table::context_id context) const
Definition: pt-assign.cc:364
octave_value_list rvalue(int nargout)
Definition: pt-assign.cc:194
for large enough k
Definition: lu.cc:606
virtual tree_expression * dup(symbol_table::scope_id, symbol_table::context_id context) const =0
void error(const char *fmt,...)
Definition: error.cc:570
std::list< tree_expression * >::iterator iterator
Definition: base-list.h:40
static std::string assign_op_as_string(assign_op)
Definition: ov.cc:346
tree_expression * rhs
Definition: pt-assign.h:94
OCTAVE_EXPORT octave_value_list return the number of command line arguments passed to Octave If called with the optional argument the function t
Definition: ov-usr-fcn.cc:935
static bool statement_printing_enabled(void)
Definition: pt-eval.cc:131
virtual void copy_base(const tree_expression &e)
Definition: pt-exp.h:131
i e
Definition: data.cc:2724
void accept(tree_walker &tw)
Definition: pt-assign.cc:378
virtual std::string message(void) const
bool index_is_empty(void) const
Definition: oct-lvalue.cc:56
void set_var(const std::string &var_arg="")
virtual void visit_simple_assignment(tree_simple_assignment &)=0
void define(const octave_value &v)
Definition: oct-lvalue.h:83
octave_value value(void) const
Definition: oct-lvalue.cc:83
bool print_result(void) const
Definition: pt-exp.h:99
OCTAVE_EXPORT octave_value_list return the number of command line arguments passed to Octave If called with the optional argument the function xample nargout(@histc)
Definition: ov-usr-fcn.cc:935
bool is_black_hole(void) const
Definition: oct-lvalue.h:66
virtual const char * err_id(void) const =0
std::string oper(void) const
Definition: pt-assign.cc:136
octave_value rvalue1(int nargout=1)
Definition: pt-assign.cc:178
static llvm::LLVMContext & context
Definition: jit-typeinfo.cc:76
void error_with_id(const char *id, const char *fmt,...)
Definition: error.cc:615
tree_expression * lhs
Definition: pt-assign.h:91
octave_value::assign_op op_type(void) const
Definition: pt-assign.h:148
void set_index(const std::string &t, const std::list< octave_value_list > &i)
Definition: oct-lvalue.cc:45
void numel(octave_idx_type n)
Definition: oct-lvalue.h:87
double tmp
Definition: data.cc:6300
tree_argument_list * lhs
Definition: pt-assign.h:154
octave_value retval
Definition: data.cc:6294
the sparsity preserving column transformation such that that defines the pivoting threshold can be given in which case it defines the c
Definition: lu.cc:138
std::string oper(void) const
Definition: pt-assign.cc:358
virtual std::string name(void) const
Definition: pt-exp.h:103
virtual octave_value rvalue1(int nargout=1)
Definition: pt-exp.cc:54
bool empty(void) const
Definition: ovl.h:98
#define octave_stdout
Definition: pager.h:146
tree_argument_list * dup(symbol_table::scope_id scope, symbol_table::context_id context) const
void assign(octave_value::assign_op, const octave_value &)
Definition: oct-lvalue.cc:33
virtual void visit_multi_assignment(tree_multi_assignment &)=0
p
Definition: lu.cc:138
bool is_cs_list(void) const
Definition: ov.h:602
std::string index_type(void) const
Definition: oct-lvalue.h:95
void clear_index(void)
Definition: oct-lvalue.h:93
void print_with_name(std::ostream &os, const std::string &name) const
Definition: ov.h:1225
virtual octave_lvalue lvalue(void)
Definition: pt-exp.cc:72
virtual octave_value_list rvalue(int nargout)
Definition: pt-exp.cc:60
bool is_undefined(void) const
Definition: ov.h:539
octave_value_list list_value(void) const
Definition: ov.cc:1741
bool is_undefined(void) const
Definition: oct-lvalue.h:73
void accept(tree_walker &tw)
Definition: pt-assign.cc:156
tree_expression * dup(symbol_table::scope_id scope, symbol_table::context_id context) const
Definition: pt-assign.cc:142
tree_expression * rhs
Definition: pt-assign.h:157
If this string is the system will ring the terminal sometimes it is useful to be able to print the original representation of the string
Definition: utils.cc:854
octave_value_list rvalue(int nargout)
Definition: pt-assign.cc:63
iterator begin(void)
Definition: base-list.h:83