Mercurial > hg > octave-nkf

comparison libinterp/parse-tree/pt-assign.cc @ 15195:2fc554ffbc28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
split libinterp from src * libinterp: New directory. Move all files from src directory here except Makefile.am, main.cc, main-cli.cc, mkoctfile.in.cc, mkoctfilr.in.sh, octave-config.in.cc, octave-config.in.sh. * libinterp/Makefile.am: New file, extracted from src/Makefile.am. * src/Makefile.am: Delete everything except targets and definitions needed to build and link main and utility programs. * Makefile.am (SUBDIRS): Include libinterp in the list. * autogen.sh: Run config-module.sh in libinterp/dldfcn directory, not src/dldfcn directory. * configure.ac (AC_CONFIG_SRCDIR): Use libinterp/octave.cc, not src/octave.cc. (DL_LDFLAGS, LIBOCTINTERP): Use libinterp, not src. (AC_CONFIG_FILES): Include libinterp/Makefile in the list. * find-docstring-files.sh: Look in libinterp, not src. * gui/src/Makefile.am (liboctgui_la_CPPFLAGS): Find header files in libinterp, not src.
author John W. Eaton <jwe@octave.org>
date Sat, 18 Aug 2012 16:23:39 -0400
parents src/parse-tree/pt-assign.cc@46b19589b593
children fb9dffe5fbfb
comparison
equal deleted inserted replaced
15194:0f0b795044c3 15195:2fc554ffbc28
1 /*
2
3 Copyright (C) 1996-2012 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 #ifdef 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 "gripes.h"
33 #include "input.h"
34 #include "oct-obj.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-walk.h"
42 #include "utils.h"
43 #include "variables.h"
44
45 // Simple assignment expressions.
46
47 // FIXME -- the following variable and the function that uses it
48 // should be removed from some future version of Octave.
49
50 static const char *former_built_in_variables[] =
51 {
52 "DEFAULT_EXEC_PATH",
53 "DEFAULT_LOADPATH",
54 "EDITOR",
55 "EXEC_PATH",
56 "FFTW_WISDOM_PROGRAM",
57 "IMAGEPATH",
58 "INFO_FILE",
59 "INFO_PROGRAM",
60 "LOADPATH",
61 "MAKEINFO_PROGRAM",
62 "PAGER",
63 "PS1",
64 "PS2",
65 "PS4",
66 "__kluge_procbuf_delay__",
67 "automatic_replot",
68 "beep_on_error",
69 "completion_append_char",
70 "crash_dumps_octave_core",
71 "current_script_file_name",
72 "debug_on_error",
73 "debug_on_interrupt",
74 "debug_on_warning",
75 "debug_symtab_lookups",
76 "default_save_options",
77 "echo_executing_commands",
78 "fixed_point_format",
79 "gnuplot_binary",
80 "gnuplot_command_axes",
81 "gnuplot_command_end",
82 "gnuplot_command_plot",
83 "gnuplot_command_replot",
84 "gnuplot_command_splot",
85 "gnuplot_command_title",
86 "gnuplot_command_using",
87 "gnuplot_command_with",
88 "gnuplot_has_frames",
89 "history_file",
90 "history_size",
91 "ignore_function_time_stamp",
92 "max_recursion_depth",
93 "octave_core_file_format",
94 "octave_core_file_limit",
95 "octave_core_file_name",
96 "output_max_field_width",
97 "output_precision",
98 "page_output_immediately",
99 "page_screen_output",
100 "print_answer_id_name",
101 "print_empty_dimensions",
102 "print_rhs_assign_val",
103 "save_header_format_string",
104 "save_precision",
105 "saving_history",
106 "sighup_dumps_octave_core",
107 "sigterm_dumps_octave_core",
108 "silent_functions",
109 "split_long_rows",
110 "string_fill_char",
111 "struct_levels_to_print",
112 "suppress_verbose_help_message",
113 "variables_can_hide_functions",
114 "warn_assign_as_truth_value",
115 "warn_associativity_change",
116 "warn_divide_by_zero",
117 "warn_empty_list_elements",
118 "warn_fortran_indexing",
119 "warn_function_name_clash",
120 "warn_future_time_stamp",
121 "warn_imag_to_real",
122 "warn_matlab_incompatible",
123 "warn_missing_semicolon",
124 "warn_neg_dim_as_zero",
125 "warn_num_to_str",
126 "warn_precedence_change",
127 "warn_reload_forces_clear",
128 "warn_resize_on_range_error",
129 "warn_separator_insert",
130 "warn_single_quote_string",
131 "warn_str_to_num",
132 "warn_undefined_return_values",
133 "warn_variable_switch_label",
134 "whos_line_format",
135 0,
136 };
137
138 static void
139 maybe_warn_former_built_in_variable (const std::string& nm)
140 {
141 static bool initialized = false;
142
143 static std::set<std::string> vars;
144
145 if (! initialized)
146 {
147 const char **p = former_built_in_variables;
148
149 while (*p)
150 vars.insert (*p++);
151
152 initialized = true;
153 }
154
155 if (vars.find (nm) != vars.end ())
156 {
157 const char *nm_c_str = nm.c_str ();
158
159 warning_with_id ("Octave:built-in-variable-assignment",
160 "\
161 In recent versions of Octave, %s is a function instead\n\
162 of a built-in variable.\n\n\
163 By assigning to %s, you have created a variable that hides\n\
164 the function %s. To remove the variable and restore the \n\
165 function, type \"clear %s\"\n",
166 nm_c_str, nm_c_str, nm_c_str, nm_c_str);
167 }
168 }
169
170 tree_simple_assignment::tree_simple_assignment
171 (tree_expression *le, tree_expression *re,
172 bool plhs, int l, int c, octave_value::assign_op t)
173 : tree_expression (l, c), lhs (le), rhs (re), preserve (plhs), etype (t),
174 first_execution (true) { }
175
176 tree_simple_assignment::~tree_simple_assignment (void)
177 {
178 if (! preserve)
179 delete lhs;
180
181 delete rhs;
182 }
183
184 octave_value_list
185 tree_simple_assignment::rvalue (int nargout)
186 {
187 octave_value_list retval;
188
189 if (nargout > 1)
190 error ("invalid number of output arguments for expression X = RHS");
191 else
192 retval = rvalue1 (nargout);
193
194 return retval;
195 }
196
197 octave_value
198 tree_simple_assignment::rvalue1 (int)
199 {
200 octave_value retval;
201
202 if (first_execution && lhs)
203 maybe_warn_former_built_in_variable (lhs->name ());
204
205 if (error_state)
206 return retval;
207
208 if (rhs)
209 {
210 octave_value rhs_val = rhs->rvalue1 ();
211
212 if (! error_state)
213 {
214 if (rhs_val.is_undefined ())
215 {
216 error ("value on right hand side of assignment is undefined");
217 return retval;
218 }
219 else
220 {
221 if (rhs_val.is_cs_list ())
222 {
223 const octave_value_list lst = rhs_val.list_value ();
224
225 if (! lst.empty ())
226 rhs_val = lst(0);
227 else
228 {
229 error ("invalid number of elements on RHS of assignment");
230 return retval;
231 }
232 }
233
234 octave_lvalue ult = lhs->lvalue ();
235
236 if (ult.numel () != 1)
237 gripe_nonbraced_cs_list_assignment ();
238
239 if (! error_state)
240 {
241 ult.assign (etype, rhs_val);
242
243 if (! error_state)
244 {
245 if (etype == octave_value::op_asn_eq)
246 retval = rhs_val;
247 else
248 retval = ult.value ();
249
250 if (print_result ())
251 {
252 // We clear any index here so that we can
253 // get the new value of the referenced
254 // object below, instead of the indexed
255 // value (which should be the same as the
256 // right hand side value).
257
258 ult.clear_index ();
259
260 octave_value lhs_val = ult.value ();
261
262 if (! error_state)
263 lhs_val.print_with_name (octave_stdout,
264 lhs->name ());
265 }
266 }
267 }
268 }
269 }
270 }
271
272 first_execution = false;
273
274 return retval;
275 }
276
277 std::string
278 tree_simple_assignment::oper (void) const
279 {
280 return octave_value::assign_op_as_string (etype);
281 }
282
283 tree_expression *
284 tree_simple_assignment::dup (symbol_table::scope_id scope,
285 symbol_table::context_id context) const
286 {
287 tree_simple_assignment *new_sa
288 = new tree_simple_assignment (lhs ? lhs->dup (scope, context) : 0,
289 rhs ? rhs->dup (scope, context) : 0,
290 preserve, etype);
291
292 new_sa->copy_base (*this);
293
294 return new_sa;
295 }
296
297 void
298 tree_simple_assignment::accept (tree_walker& tw)
299 {
300 tw.visit_simple_assignment (*this);
301 }
302
303 // Multi-valued assignment expressions.
304
305 tree_multi_assignment::tree_multi_assignment
306 (tree_argument_list *lst, tree_expression *r,
307 bool plhs, int l, int c)
308 : tree_expression (l, c), lhs (lst), rhs (r), preserve (plhs),
309 first_execution (true) { }
310
311 tree_multi_assignment::~tree_multi_assignment (void)
312 {
313 if (! preserve)
314 delete lhs;
315
316 delete rhs;
317 }
318
319 octave_value
320 tree_multi_assignment::rvalue1 (int nargout)
321 {
322 octave_value retval;
323
324 const octave_value_list tmp = rvalue (nargout);
325
326 if (! tmp.empty ())
327 retval = tmp(0);
328
329 return retval;
330 }
331
332 // FIXME -- this works, but it would look a little better if
333 // it were broken up into a couple of separate functions.
334
335 octave_value_list
336 tree_multi_assignment::rvalue (int)
337 {
338 octave_value_list retval;
339
340 if (error_state)
341 return retval;
342
343 if (first_execution)
344 {
345 for (tree_argument_list::iterator p = lhs->begin (); p != lhs->end (); p++)
346 {
347 tree_expression *lhs_expr = *p;
348
349 if (lhs_expr)
350 maybe_warn_former_built_in_variable (lhs_expr->name ());
351 }
352 }
353
354 if (rhs)
355 {
356 std::list<octave_lvalue> lvalue_list = lhs->lvalue_list ();
357
358 if (error_state)
359 return retval;
360
361 octave_idx_type n_out = 0;
362
363 for (std::list<octave_lvalue>::const_iterator p = lvalue_list.begin ();
364 p != lvalue_list.end ();
365 p++)
366 n_out += p->numel ();
367
368 // The following trick is used to keep rhs_val constant.
369 const octave_value_list rhs_val1 = rhs->rvalue (n_out, &lvalue_list);
370 const octave_value_list rhs_val = (rhs_val1.length () == 1 && rhs_val1(0).is_cs_list ()
371 ? rhs_val1(0).list_value () : rhs_val1);
372
373 if (error_state)
374 return retval;
375
376 octave_idx_type k = 0;
377
378 octave_idx_type n = rhs_val.length ();
379
380 // To avoid copying per elements and possible optimizations, we
381 // postpone joining the final values.
382 std::list<octave_value_list> retval_list;
383
384 tree_argument_list::iterator q = lhs->begin ();
385
386 for (std::list<octave_lvalue>::iterator p = lvalue_list.begin ();
387 p != lvalue_list.end ();
388 p++)
389 {
390 tree_expression *lhs_elt = *q++;
391
392 octave_lvalue ult = *p;
393
394 octave_idx_type nel = ult.numel ();
395
396 if (nel != 1)
397 {
398 if (k + nel <= n)
399 {
400 // This won't do a copy.
401 octave_value_list ovl = rhs_val.slice (k, nel);
402
403 ult.assign (octave_value::op_asn_eq, octave_value (ovl, true));
404
405 if (! error_state)
406 {
407 retval_list.push_back (ovl);
408
409 k += nel;
410 }
411 }
412 else
413 error ("some elements undefined in return list");
414 }
415 else
416 {
417 if (k < n)
418 {
419 ult.assign (octave_value::op_asn_eq, rhs_val(k));
420
421 if (ult.is_black_hole ())
422 {
423 k++;
424 continue;
425 }
426 else if (! error_state)
427 {
428 retval_list.push_back (rhs_val(k));
429
430 k++;
431 }
432 }
433 else
434 {
435 // This can happen for a function like
436 //
437 // function varargout = f ()
438 // varargout{1} = nargout;
439 // endfunction
440 //
441 // called with
442 //
443 // [a, ~] = f ();
444 //
445 // Then the list of of RHS values will contain one
446 // element but we are iterating over the list of all
447 // RHS values. We shouldn't complain that a value we
448 // don't need is missing from the list.
449
450 if (ult.is_black_hole ())
451 {
452 k++;
453 continue;
454 }
455 else
456 error ("element number %d undefined in return list", k+1);
457 }
458 }
459
460 if (error_state)
461 break;
462 else if (print_result ())
463 {
464 // We clear any index here so that we can get
465 // the new value of the referenced object below,
466 // instead of the indexed value (which should be
467 // the same as the right hand side value).
468
469 ult.clear_index ();
470
471 octave_value lhs_val = ult.value ();
472
473 if (! error_state)
474 lhs_val.print_with_name (octave_stdout,
475 lhs_elt->name ());
476 }
477
478 if (error_state)
479 break;
480
481 }
482
483 // Concatenate return values.
484 retval = retval_list;
485
486 }
487
488 first_execution = false;
489
490 return retval;
491 }
492
493 /*
494 %!function varargout = f ()
495 %! varargout{1} = nargout;
496 %!endfunction
497 %!
498 %!test
499 %! [a, ~] = f ();
500 %! assert (a, 2);
501 %!test
502 %! [a, ~, ~, ~, ~] = f ();
503 %! assert (a, 5);
504 */
505
506 std::string
507 tree_multi_assignment::oper (void) const
508 {
509 return octave_value::assign_op_as_string (op_type ());
510 }
511
512 tree_expression *
513 tree_multi_assignment::dup (symbol_table::scope_id scope,
514 symbol_table::context_id context) const
515 {
516 tree_multi_assignment *new_ma
517 = new tree_multi_assignment (lhs ? lhs->dup (scope, context) : 0,
518 rhs ? rhs->dup (scope, context) : 0,
519 preserve);
520
521 new_ma->copy_base (*this);
522
523 return new_ma;
524 }
525
526 void
527 tree_multi_assignment::accept (tree_walker& tw)
528 {
529 tw.visit_multi_assignment (*this);
530 }