Mercurial > hg > octave-nkf

comparison src/ov.cc @ 2376:2142216bf85a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1996-10-12 01:39:07 by jwe]
author jwe
date Sat, 12 Oct 1996 01:39:21 +0000
parents
children 47e5f57fb4bd
comparison
equal deleted inserted replaced
2375:7ef24992e290 2376:2142216bf85a
1 /*
2
3 Copyright (C) 1996 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 2, or (at your option) any
10 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, write to the Free
19 Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
20
21 */
22
23 #if defined (__GNUG__)
24 #pragma implementation
25 #endif
26
27 #ifdef HAVE_CONFIG_H
28 #include <config.h>
29 #endif
30
31 #include "Array-flags.h"
32
33 #include "ov.h"
34 #include "ov-base.h"
35 #include "ov-scalar.h"
36 #include "ov-re-mat.h"
37 #include "ov-complex.h"
38 #include "ov-cx-mat.h"
39 #include "ov-ch-mat.h"
40 #include "ov-str-mat.h"
41 #include "ov-range.h"
42 #include "ov-struct.h"
43 #include "ov-colon.h"
44 #include "ov-va-args.h"
45 #include "ov-typeinfo.h"
46
47 #include "defun.h"
48 #include "gripes.h"
49 #include "pager.h"
50 #include "pr-output.h"
51 #include "utils.h"
52 #include "variables.h"
53
54 // If TRUE, allow assignments like
55 //
56 // octave> A(1) = 3; A(2) = 5
57 //
58 // for A already defined and a matrix type.
59 bool Vdo_fortran_indexing;
60
61 // Should we allow things like:
62 //
63 // octave> 'abc' + 0
64 // 97 98 99
65 //
66 // to happen? A positive value means yes. A negative value means
67 // yes, but print a warning message. Zero means it should be
68 // considered an error.
69 int Vimplicit_str_to_num_ok;
70
71 // Should we allow silent conversion of complex to real when a real
72 // type is what we're really looking for? A positive value means yes.
73 // A negative value means yes, but print a warning message. Zero
74 // means it should be considered an error.
75 int Vok_to_lose_imaginary_part;
76
77 // If TRUE, create column vectors when doing assignments like:
78 //
79 // octave> A(1) = 3; A(2) = 5
80 //
81 // (for A undefined). Only matters when resize_on_range_error is also
82 // TRUE.
83 bool Vprefer_column_vectors;
84
85 // If TRUE, prefer logical (zore-one) indexing over normal indexing
86 // when there is a conflice. For example, given a = [2, 3], the
87 // expression a ([1, 1]) would return [2 3] (instead of [2 2], which
88 // would be returned if prefer_zero_one_indxing were FALSE).
89 bool Vprefer_zero_one_indexing;
90
91 // If TRUE, print the name along with the value.
92 bool Vprint_answer_id_name;
93
94 // Should operations on empty matrices return empty matrices or an
95 // error? A positive value means yes. A negative value means yes,
96 // but print a warning message. Zero means it should be considered an
97 // error.
98 int Vpropagate_empty_matrices;
99
100 // If TRUE, resize matrices when performing and indexed assignment and
101 // the indices are outside the current bounds.
102 bool Vresize_on_range_error;
103
104 // How many levels of structure elements should we print?
105 int Vstruct_levels_to_print;
106
107 // Allow divide by zero errors to be suppressed.
108 bool Vwarn_divide_by_zero;
109
110 // Indentation level for structures.
111 int struct_indent = 0;
112
113 // XXX FIXME XXX
114 void
115 increment_struct_indent (void)
116 {
117 struct_indent += 2;
118 }
119
120 void
121 decrement_struct_indent (void)
122 {
123 struct_indent -= 2;
124 }
125
126 // Octave's value type.
127
128 string
129 octave_value::binary_op_as_string (binary_op op)
130 {
131 string retval;
132
133 switch (op)
134 {
135 case add:
136 retval = "+";
137 break;
138
139 case sub:
140 retval = "-";
141 break;
142
143 case mul:
144 retval = "*";
145 break;
146
147 case div:
148 retval = "/";
149 break;
150
151 case pow:
152 retval = "^";
153 break;
154
155 case ldiv:
156 retval = "\\";
157 break;
158
159 case lt:
160 retval = "<";
161 break;
162
163 case le:
164 retval = "<=";
165 break;
166
167 case eq:
168 retval = "==";
169 break;
170
171 case ge:
172 retval = ">=";
173 break;
174
175 case gt:
176 retval = ">";
177 break;
178
179 case ne:
180 retval = "!=";
181 break;
182
183 case el_mul:
184 retval = ".*";
185 break;
186
187 case el_div:
188 retval = "./";
189 break;
190
191 case el_pow:
192 retval = ".^";
193 break;
194
195 case el_ldiv:
196 retval = ".\\";
197 break;
198
199 case el_and:
200 retval = "&";
201 break;
202
203 case el_or:
204 retval = "|";
205 break;
206
207 case struct_ref:
208 retval = ".";
209 break;
210
211 default:
212 retval = "<unknown>";
213 }
214
215 return retval;
216 }
217
218 octave_value::octave_value (void)
219 : rep (new octave_base_value ()) { rep->count = 1; }
220
221 octave_value::octave_value (double d)
222 : rep (new octave_scalar (d)) { rep->count = 1; }
223
224 octave_value::octave_value (const Matrix& m)
225 : rep (new octave_matrix (m)) { rep->count = 1; }
226
227 octave_value::octave_value (const DiagMatrix& d)
228 : rep (new octave_matrix (d)) { rep->count = 1; }
229
230 octave_value::octave_value (const RowVector& v, int pcv)
231 : rep (new octave_matrix (v, pcv)) { rep->count = 1; }
232
233 octave_value::octave_value (const ColumnVector& v, int pcv)
234 : rep (new octave_matrix (v, pcv)) { rep->count = 1; }
235
236 octave_value::octave_value (const Complex& C)
237 : rep (new octave_complex (C)) { rep->count = 1; }
238
239 octave_value::octave_value (const ComplexMatrix& m)
240 : rep (new octave_complex_matrix (m)) { rep->count = 1; }
241
242 octave_value::octave_value (const ComplexDiagMatrix& d)
243 : rep (new octave_complex_matrix (d)) { rep->count = 1; }
244
245 octave_value::octave_value (const ComplexRowVector& v, int pcv)
246 : rep (new octave_complex_matrix (v, pcv)) { rep->count = 1; }
247
248 octave_value::octave_value (const ComplexColumnVector& v, int pcv)
249 : rep (new octave_complex_matrix (v, pcv)) { rep->count = 1; }
250
251 octave_value::octave_value (const char *s)
252 : rep (new octave_char_matrix_str (s)) { rep->count = 1; }
253
254 octave_value::octave_value (const string& s)
255 : rep (new octave_char_matrix_str (s)) { rep->count = 1; }
256
257 octave_value::octave_value (const string_vector& s)
258 : rep (new octave_char_matrix_str (s)) { rep->count = 1; }
259
260 octave_value::octave_value (const charMatrix& chm, bool is_string)
261 {
262 if (is_string)
263 rep = new octave_char_matrix_str (chm);
264 else
265 rep = new octave_char_matrix (chm);
266
267 rep->count = 1;
268 }
269
270 octave_value::octave_value (double base, double limit, double inc)
271 : rep (new octave_range (base, limit, inc)) { rep->count = 1; }
272
273 octave_value::octave_value (const Range& r)
274 : rep (new octave_range (r)) { rep->count = 1; }
275
276 octave_value::octave_value (const Octave_map& m)
277 : rep (new octave_struct (m)) { rep->count = 1; }
278
279 octave_value::octave_value (octave_value::magic_colon)
280 : rep (new octave_magic_colon ()) { rep->count = 1; }
281
282 octave_value::octave_value (octave_value::all_va_args)
283 : rep (new octave_all_va_args ()) { rep->count = 1; }
284
285 octave_value::octave_value (octave_value *new_rep)
286 : rep (new_rep) { rep->count = 1; }
287
288 octave_value::~octave_value (void)
289 {
290 #if defined (MDEBUG)
291 cerr << "~octave_value: rep: " << rep
292 << " rep->count: " << rep->count << "\n";
293 #endif
294
295 if (rep && --rep->count == 0)
296 {
297 delete rep;
298 rep = 0;
299 }
300 }
301
302 static void
303 gripe_indexed_assignment (const string& tn1, const string& tn2)
304 {
305 error ("assignment of %s to indexed %s not implemented",
306 tn2.c_str (), tn1.c_str ());
307 }
308
309 static void
310 gripe_no_conversion (const string& tn1, const string& tn2)
311 {
312 error ("no suitable conversion found for assignment of %s to indexed %s",
313 tn2.c_str (), tn1.c_str ());
314 }
315
316 static void
317 gripe_conversion_failed (const string& tn1, const string& tn2)
318 {
319 error ("type conversion for assignment of %s to indexed %s failed",
320 tn2.c_str (), tn1.c_str ());
321 }
322
323 octave_value&
324 octave_value::assign (const octave_value_list& idx, const octave_value& rhs)
325 {
326 make_unique ();
327
328 int t_lhs = type_id ();
329 int t_rhs = rhs.type_id ();
330
331 octave_value::assign_op_fcn f
332 = octave_value_typeinfo::lookup_assign_op (t_lhs, t_rhs);
333
334 if (f)
335 f (*(this->rep), idx, *(rhs.rep));
336 else
337 {
338 int t_result
339 = octave_value_typeinfo::lookup_pref_assign_conv (t_lhs, t_rhs);
340
341 if (t_result >= 0)
342 {
343 octave_value::widening_op_fcn wf
344 = octave_value_typeinfo::lookup_widening_op (t_lhs, t_result);
345
346 if (wf)
347 {
348 octave_value *tmp = wf (*(this->rep));
349
350 if (tmp && tmp != rep)
351 {
352 if (--rep->count == 0)
353 delete rep;
354
355 rep = tmp;
356 rep->count = 1;
357
358 t_lhs = type_id ();
359
360 f = octave_value_typeinfo::lookup_assign_op (t_lhs, t_rhs);
361
362 if (f)
363 f (*(this->rep), idx, *(rhs.rep));
364 else
365 gripe_indexed_assignment (type_name (), rhs.type_name ());
366 }
367 else
368 gripe_conversion_failed (type_name (), rhs.type_name ());
369 }
370 else
371 gripe_indexed_assignment (type_name (), rhs.type_name ());
372 }
373 else
374 gripe_no_conversion (type_name (), rhs.type_name ());
375 }
376
377 return *this;
378 }
379
380 Octave_map
381 octave_value::map_value (void) const
382 {
383 return rep->map_value ();
384 }
385
386 ColumnVector
387 octave_value::vector_value (bool force_string_conv,
388 bool force_vector_conversion) const
389 {
390 ColumnVector retval;
391
392 Matrix m = matrix_value (force_string_conv);
393
394 if (error_state)
395 return retval;
396
397 int nr = m.rows ();
398 int nc = m.columns ();
399
400 if (nr == 1)
401 {
402 retval.resize (nc);
403 for (int i = 0; i < nc; i++)
404 retval (i) = m (0, i);
405 }
406 else if (nc == 1)
407 {
408 retval.resize (nr);
409 for (int i = 0; i < nr; i++)
410 retval (i) = m (i, 0);
411 }
412 else if (nr > 0 && nc > 0
413 && (Vdo_fortran_indexing || force_vector_conversion))
414 {
415 retval.resize (nr * nc);
416 int k = 0;
417 for (int j = 0; j < nc; j++)
418 for (int i = 0; i < nr; i++)
419 retval (k++) = m (i, j);
420 }
421 else
422 {
423 string tn = type_name ();
424 gripe_invalid_conversion (tn.c_str (), "real vector");
425 }
426
427 return retval;
428 }
429
430 ComplexColumnVector
431 octave_value::complex_vector_value (bool force_string_conv,
432 bool force_vector_conversion) const
433 {
434 ComplexColumnVector retval;
435
436 ComplexMatrix m = complex_matrix_value (force_string_conv);
437
438 if (error_state)
439 return retval;
440
441 int nr = m.rows ();
442 int nc = m.columns ();
443
444 if (nr == 1)
445 {
446 retval.resize (nc);
447 for (int i = 0; i < nc; i++)
448 retval (i) = m (0, i);
449 }
450 else if (nc == 1)
451 {
452 retval.resize (nr);
453 for (int i = 0; i < nr; i++)
454 retval (i) = m (i, 0);
455 }
456 else if (nr > 0 && nc > 0
457 && (Vdo_fortran_indexing || force_vector_conversion))
458 {
459 retval.resize (nr * nc);
460 int k = 0;
461 for (int j = 0; j < nc; j++)
462 for (int i = 0; i < nr; i++)
463 retval (k++) = m (i, j);
464 }
465 else
466 {
467 string tn = type_name ();
468 gripe_invalid_conversion (tn.c_str (), "complex vector");
469 }
470
471 return retval;
472 }
473
474 void
475 octave_value::print (void)
476 {
477 print (octave_stdout);
478 }
479
480 void
481 octave_value::print_with_name (const string& name, bool print_padding)
482 {
483 print_with_name (octave_stdout, name, print_padding);
484 }
485
486 void
487 octave_value::print_with_name (ostream& output_buf, const string& name,
488 bool print_padding)
489 {
490 bool pad_after = false;
491
492 if (Vprint_answer_id_name)
493 {
494 if (print_as_scalar ())
495 output_buf << name << " = ";
496 else if (print_as_structure ())
497 {
498 pad_after = true;
499 output_buf << name << " =";
500 }
501 else
502 {
503 pad_after = true;
504 output_buf << name << " =\n\n";
505 }
506 }
507
508 print (output_buf);
509
510 if (print_padding && pad_after)
511 output_buf << "\n";
512 }
513
514 bool
515 octave_value::print_as_scalar (void)
516 {
517 int nr = rows ();
518 int nc = columns ();
519
520 return (is_scalar_type ()
521 || (is_string () && nr <= 1)
522 || (is_matrix_type ()
523 && ((nr == 1 && nc == 1)
524 || nr == 0
525 || nc == 0)));
526 }
527
528 static void
529 gripe_binary_op (const string& on, const string& tn1, const string& tn2)
530 {
531 error ("binary operator %s not implemented for %s by %s operations",
532 on.c_str (), tn1.c_str (), tn2.c_str ());
533 }
534
535 octave_value
536 do_binary_op (octave_value::binary_op op, const octave_value& v1,
537 const octave_value& v2)
538 {
539 octave_value retval;
540
541 int t1 = v1.type_id ();
542 int t2 = v2.type_id ();
543
544 octave_value::binary_op_fcn f
545 = octave_value_typeinfo::lookup_binary_op (op, t1, t2);
546
547 if (f)
548 retval = f (*v1.rep, *v2.rep);
549 else
550 {
551 octave_value tv1;
552 octave_value::numeric_conv_fcn cf1 = v1.numeric_conversion_function ();
553
554 if (cf1)
555 {
556 tv1 = octave_value (cf1 (*v1.rep));
557 t1 = tv1.type_id ();
558 }
559 else
560 tv1 = v1;
561
562 octave_value tv2;
563 octave_value::numeric_conv_fcn cf2 = v2.numeric_conversion_function ();
564
565 if (cf2)
566 {
567 tv2 = octave_value (cf2 (*v2.rep));
568 t2 = tv2.type_id ();
569 }
570 else
571 tv2 = v2;
572
573 if (cf1 || cf2)
574 {
575 octave_value::binary_op_fcn f
576 = octave_value_typeinfo::lookup_binary_op (op, t1, t2);
577
578 if (f)
579 retval = f (*tv1.rep, *tv2.rep);
580 else
581 gripe_binary_op (octave_value::binary_op_as_string (op),
582 v1.type_name (), v2.type_name ());
583 }
584 else
585 gripe_binary_op (octave_value::binary_op_as_string (op),
586 v1.type_name (), v2.type_name ());
587 }
588
589 return retval;
590 }
591
592 void
593 install_types (void)
594 {
595 octave_base_value::register_type ();
596 octave_scalar::register_type ();
597 octave_complex::register_type ();
598 octave_matrix::register_type ();
599 octave_complex_matrix::register_type ();
600 octave_range::register_type ();
601 octave_char_matrix::register_type ();
602 octave_char_matrix_str::register_type ();
603 octave_struct::register_type ();
604 octave_all_va_args::register_type ();
605 octave_magic_colon::register_type ();
606 }
607
608 static int
609 do_fortran_indexing (void)
610 {
611 Vdo_fortran_indexing = check_preference ("do_fortran_indexing");
612
613 liboctave_dfi_flag = Vdo_fortran_indexing;
614
615 return 0;
616 }
617
618 static int
619 implicit_str_to_num_ok (void)
620 {
621 Vimplicit_str_to_num_ok = check_preference ("implicit_str_to_num_ok");
622
623 return 0;
624 }
625
626 static int
627 ok_to_lose_imaginary_part (void)
628 {
629 Vok_to_lose_imaginary_part = check_preference ("ok_to_lose_imaginary_part");
630
631 return 0;
632 }
633
634 static int
635 prefer_column_vectors (void)
636 {
637 Vprefer_column_vectors
638 = check_preference ("prefer_column_vectors");
639
640 liboctave_pcv_flag = Vprefer_column_vectors;
641
642 return 0;
643 }
644
645 static int
646 prefer_zero_one_indexing (void)
647 {
648 Vprefer_zero_one_indexing = check_preference ("prefer_zero_one_indexing");
649
650 liboctave_pzo_flag = Vprefer_zero_one_indexing;
651
652 return 0;
653 }
654
655 static int
656 print_answer_id_name (void)
657 {
658 Vprint_answer_id_name = check_preference ("print_answer_id_name");
659
660 return 0;
661 }
662
663 static int
664 propagate_empty_matrices (void)
665 {
666 Vpropagate_empty_matrices = check_preference ("propagate_empty_matrices");
667
668 return 0;
669 }
670
671 static int
672 resize_on_range_error (void)
673 {
674 Vresize_on_range_error = check_preference ("resize_on_range_error");
675
676 liboctave_rre_flag = Vresize_on_range_error;
677
678 return 0;
679 }
680
681 static int
682 struct_levels_to_print (void)
683 {
684 double val;
685 if (builtin_real_scalar_variable ("struct_levels_to_print", val)
686 && ! xisnan (val))
687 {
688 int ival = NINT (val);
689 if (ival >= 0 && (double) ival == val)
690 {
691 Vstruct_levels_to_print = ival;
692 return 0;
693 }
694 }
695 gripe_invalid_value_specified ("struct_levels_to_print");
696 return -1;
697 }
698
699 static int
700 warn_divide_by_zero (void)
701 {
702 Vwarn_divide_by_zero = check_preference ("warn_divide_by_zero");
703
704 return 0;
705 }
706
707 void
708 symbols_of_value (void)
709 {
710 DEFVAR (do_fortran_indexing, 0.0, 0, do_fortran_indexing,
711 "allow single indices for matrices");
712
713 DEFVAR (implicit_str_to_num_ok, 0.0, 0, implicit_str_to_num_ok,
714 "allow implicit string to number conversion");
715
716 DEFVAR (ok_to_lose_imaginary_part, "warn", 0, ok_to_lose_imaginary_part,
717 "silently convert from complex to real by dropping imaginary part");
718
719 DEFVAR (prefer_column_vectors, 1.0, 0, prefer_column_vectors,
720 "prefer column/row vectors");
721
722 DEFVAR (prefer_zero_one_indexing, 0.0, 0, prefer_zero_one_indexing,
723 "when there is a conflict, prefer zero-one style indexing");
724
725 DEFVAR (print_answer_id_name, 1.0, 0, print_answer_id_name,
726 "set output style to print `var_name = ...'");
727
728 DEFVAR (propagate_empty_matrices, 1.0, 0, propagate_empty_matrices,
729 "operations on empty matrices return an empty matrix, not an error");
730
731 DEFVAR (resize_on_range_error, 1.0, 0, resize_on_range_error,
732 "enlarge matrices on assignment");
733
734 DEFVAR (struct_levels_to_print, 2.0, 0, struct_levels_to_print,
735 "number of levels of structure elements to print");
736
737 DEFVAR (warn_divide_by_zero, 1.0, 0, warn_divide_by_zero,
738 "If TRUE, warn about division by zero");
739 }
740
741 /*
742 ;;; Local Variables: ***
743 ;;; mode: C++ ***
744 ;;; End: ***
745 */