Mercurial > hg > octave-thorsten
annotate mk-opts.pl @ 9287:a407e894ec74
conditionally enable MSVC-specific DiagArray2<T>::Proxy instantiations
author | Jaroslav Hajek <highegg@gmail.com> |
---|---|
date | Tue, 02 Jun 2009 21:29:09 +0200 |
parents | eb63fbe60fab |
children | 7bddd70bc838 |
rev | line source |
---|---|
3998 | 1 #! /usr/bin/perl |
7019 | 2 # |
8920 | 3 # Copyright (C) 2002, 2005, 2006, 2007, 2008 John W. Eaton |
7019 | 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 | |
10 # your 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/>. | |
3998 | 20 |
21 # Generate option handling code from a simpler input files for | |
22 # Octave's functions like lsode, dassl, etc. | |
23 | |
8202
cf59d542f33e
replace all TODOs and XXXs with FIXMEs
Jaroslav Hajek <highegg@gmail.com>
parents:
7806
diff
changeset
|
24 # FIXME: |
3999 | 25 # |
26 # * Improve default documentation and/or individual documentation | |
27 # in data files. | |
28 # | |
29 # * Fix print/show code to display/return something more informative | |
30 # for special values (for example, -1 ==> infinite in some cases). | |
31 # Probably need more information in the data files for this. | |
32 | |
3998 | 33 # Input file format: |
34 # | |
35 # CLASS = string | |
36 # FCN_NAME = string | |
4044 | 37 # INCLUDE = file |
3998 | 38 # DOC_STRING doc END_DOC_STRING |
39 # OPTION | |
40 # NAME = string | |
4050 | 41 # DOC_ITEM doc END_DOC_ITEM |
3998 | 42 # TYPE = string |
43 # SET_ARG_TYPE = string (optional, defaults to TYPE) | |
44 # INIT_VALUE = string | INIT_BODY code END_INIT_BODY | |
45 # SET_EXPR = string | SET_BODY code END_SET_BODY | SET_CODE code END_SET_CODE | |
46 # END_OPTION | |
47 # | |
48 # END_* must appear at beginning of line (whitespace ignored). | |
49 | |
50 use Getopt::Long; | |
51 | |
52 $opt_emit_opt_class_header = 0; | |
53 $opt_emit_opt_handler_fcns = 0; | |
54 $opt_debug = 0; | |
55 | |
56 GetOptions ("opt-class-header" => \$opt_emit_opt_class_header, | |
57 "opt-handler-fcns" => \$opt_emit_opt_handler_fcns, | |
58 "debug" => \$opt_debug); | |
59 | |
60 if (@ARGV == 1) | |
61 { | |
62 $INFILE = shift @ARGV; | |
63 open (INFILE) || die "unable to open input file $INFILE"; | |
64 } | |
65 else | |
66 { | |
67 die "usage: mk-opts.pl [options] FILE"; | |
68 } | |
69 | |
70 $opt_num = 0; | |
71 | |
72 &parse_input; | |
73 | |
74 &process_data; | |
75 | |
76 FOO: | |
77 { | |
78 $opt_emit_opt_class_header && do { &emit_opt_class_header; last FOO; }; | |
79 | |
80 $opt_emit_opt_handler_fcns && do { &emit_opt_handler_fcns; last FOO; }; | |
81 | |
82 $opt_debug && do { &emit_options_debug; last FOO; }; | |
83 } | |
84 | |
85 sub parse_input | |
86 { | |
87 local ($have_doc_string); | |
88 | |
89 while (<INFILE>) | |
90 { | |
91 next if (/^\s*$/); | |
7017 | 92 next if (/^\s*#.*$/); |
3998 | 93 |
94 if (/^\s*OPTION\s*$/) | |
95 { | |
96 &parse_option_block; | |
97 } | |
98 elsif (/^\s*CLASS\s*=\s*"(\w+)"\s*$/) | |
99 { | |
100 die "duplicate CLASS" if ($class ne ""); | |
101 $CLASS = $1; | |
102 $class_name = "${CLASS}_options"; | |
103 $struct_name = "${class_name}_struct"; | |
104 $static_table_name = "${class_name}_table"; | |
105 } | |
106 elsif (/^\s*FCN_NAME\s*=\s*"(\w+)"\s*$/) | |
107 { | |
108 die "duplicate FCN_NAME" if ($fcn_name ne ""); | |
109 $fcn_name = $1; | |
110 } | |
4044 | 111 elsif (/^\s*INCLUDE\s*=\s*"(\S+)"\s*$/) |
112 { | |
113 $include = "${include}#include <$1>\n"; | |
114 } | |
3998 | 115 elsif (/^\s*DOC_STRING\s*$/) |
116 { | |
117 die "duplicate DOC_STRING" if ($have_doc_string); | |
118 &parse_doc_string; | |
119 $have_doc_string = 1; | |
120 } | |
4044 | 121 else |
122 { | |
123 die "mk-opts.pl: unknown command: $_\n" | |
124 } | |
3998 | 125 } |
126 } | |
127 | |
128 sub parse_option_block | |
129 { | |
4050 | 130 local ($have_doc_item, $have_init_body, $have_set_body, $have_set_code); |
3998 | 131 |
132 while (<INFILE>) | |
133 { | |
134 next if (/^\s*$/); | |
135 | |
136 die "missing END_OPTION" if (/^\s*OPTION\s*$/); | |
137 | |
138 last if (/^\s*END_OPTION\s*$/); | |
139 | |
140 if (/^\s*NAME\s*=\s*"(.*)"\s*$/) | |
141 { | |
142 die "duplicate NAME" if ($name[$opt_num] ne ""); | |
143 $name[$opt_num] = $1; | |
144 ($opt[$opt_num] = $name[$opt_num]) =~ s/\s+/_/g; | |
145 $optvar[$opt_num] = "x_$opt[$opt_num]"; | |
146 $kw_tok[$opt_num] = [ split (/\s+/, $name[$opt_num]) ]; | |
147 $n_toks[$opt_num] = @{$kw_tok[$opt_num]}; | |
148 } | |
4050 | 149 elsif (/^\s*DOC_ITEM\s*$/) |
150 { | |
151 die "duplicate DOC_ITEM" if ($have_doc_item); | |
152 &parse_doc_item; | |
153 $have_doc_item = 1; | |
154 } | |
3998 | 155 elsif (/^\s*TYPE\s*=\s*"(.*)"\s*$/) |
156 { | |
157 die "duplicate TYPE" if ($type[$opt_num] ne ""); | |
158 $type[$opt_num] = $1; | |
159 } | |
160 elsif (/^\s*SET_ARG_TYPE\s*=\s*"(.*)"\s*$/) | |
161 { | |
162 die "duplicate SET_ARG_TYPE" if ($set_arg_type[$opt_num] ne ""); | |
163 $set_arg_type[$opt_num] = $1; | |
164 } | |
165 elsif (/^\s*INIT_VALUE\s*=\s*"(.*)"\s*$/) | |
166 { | |
167 die "duplicate INIT_VALUE" if ($init_value[$opt_num] ne ""); | |
168 $init_value[$opt_num] = $1; | |
169 } | |
170 elsif (/^\s*SET_EXPR\s*=\s*"(.*)"\s*$/) | |
171 { | |
172 die "duplicate SET_EXPR" if ($set_expr[$opt_num] ne ""); | |
173 $set_expr[$opt_num] = $1; | |
174 } | |
175 elsif (/^\s*INIT_BODY\s*$/) | |
176 { | |
177 die "duplicate INIT_BODY" if ($have_init_body); | |
178 &parse_init_body; | |
179 $have_init_body = 1; | |
180 } | |
181 elsif (/^\s*SET_BODY\s*$/) | |
182 { | |
183 die "duplicate SET_BODY" if ($have_set_body); | |
184 &parse_set_body; | |
185 $have_set_body = 1; | |
186 } | |
187 elsif (/^\s*SET_CODE\s*$/) | |
188 { | |
189 die "duplicate SET_CODE" if ($have_set_code); | |
190 &parse_set_code; | |
191 $have_set_code = 1; | |
192 } | |
193 } | |
194 | |
195 if ($set_arg_type[$opt_num] eq "") | |
196 { | |
197 $set_arg_type[$opt_num] = $type[$opt_num] | |
198 } | |
199 else | |
200 { | |
201 $set_arg_type[$opt_num] | |
202 = &substopt ($set_arg_type[$opt_num], $optvar[$opt_num], | |
203 $opt[$opt_num], $type[$opt_num]); | |
204 } | |
205 | |
206 $opt_num++; | |
207 } | |
208 | |
209 sub process_data | |
210 { | |
211 $max_tokens = &max (@n_toks); | |
212 | |
213 &get_min_match_len_info ($max_tokens); | |
214 | |
215 $fcn_name = lc ($CLASS) if ($fcn_name eq ""); | |
216 | |
217 $opt_fcn_name = "${fcn_name}_options" if ($opt_fcn_name eq ""); | |
218 | |
219 $static_object_name = "${fcn_name}_opts"; | |
220 | |
221 if ($doc_string eq "") | |
222 { | |
223 $doc_string = "When called with two arguments, this function\\n\\ | |
224 allows you set options parameters for the function \@code{$fcn_name}.\\n\\ | |
225 Given one argument, \@code{$opt_fcn_name} returns the value of the\\n\\ | |
226 corresponding option. If no arguments are supplied, the names of all\\n\\ | |
227 the available options and their current values are displayed.\\n\\\n"; | |
228 } | |
229 } | |
230 | |
231 sub get_min_match_len_info | |
232 { | |
233 local ($max_tokens) = @_; | |
234 | |
235 local ($i, $j, $k); | |
236 | |
237 for ($i = 0; $i < $opt_num; $i++) | |
238 { | |
239 for ($j = 0; $j < $max_tokens; $j++) | |
240 { | |
241 $min_tok_len_to_match[$i][$j] = 0; | |
242 } | |
243 | |
244 $min_toks_to_match[$i] = 1; | |
245 | |
246 L1: for ($k = 0; $k < $opt_num; $k++) | |
247 { | |
248 local ($duplicate) = 1; | |
249 | |
250 if ($i != $k) | |
251 { | |
252 L2: for ($j = 0; $j < $max_tokens; $j++) | |
253 { | |
254 if ($j < $n_toks[$i]) | |
255 { | |
256 if ($kw_tok[$i][$j] eq $kw_tok[$k][$j]) | |
257 { | |
258 if ($min_tok_len_to_match[$i][$j] == 0) | |
259 { | |
260 $min_tok_len_to_match[$i][$j] = 1; | |
261 } | |
262 | |
263 $min_toks_to_match[$i]++; | |
264 } | |
265 else | |
266 { | |
267 $duplicate = 0; | |
268 | |
269 if ($min_tok_len_to_match[$i][$j] == 0) | |
270 { | |
271 $min_tok_len_to_match[$i][$j] = 1; | |
272 } | |
273 | |
274 local (@s) = split (//, $kw_tok[$i][$j]); | |
275 local (@t) = split (//, $kw_tok[$k][$j]); | |
276 | |
277 local ($n, $ii); | |
278 $n = scalar (@s); | |
279 $n = scalar (@t) if (@t < $n); | |
280 | |
281 for ($ii = 0; $ii < $n; $ii++) | |
282 { | |
283 if ("$s[$ii]" eq "$t[$ii]") | |
284 { | |
285 if ($ii + 2 > $min_tok_len_to_match[$i][$j]) | |
286 { | |
287 $min_tok_len_to_match[$i][$j]++; | |
288 } | |
289 } | |
290 else | |
291 { | |
292 last L2; | |
293 } | |
294 } | |
295 | |
296 last L1; | |
297 } | |
298 } | |
299 else | |
300 { | |
301 die "ambiguous options \"$name[$i]\" and \"$name[$k]\"" if ($duplicate); | |
302 } | |
303 } | |
304 } | |
305 } | |
306 } | |
307 } | |
308 | |
309 sub parse_doc_string | |
310 { | |
311 while (<INFILE>) | |
312 { | |
313 last if (/^\s*END_DOC_STRING\s*$/); | |
314 | |
315 $doc_string .= $_; | |
316 } | |
317 | |
318 $doc_string =~ s/\n/\\n\\\n/g; | |
319 } | |
320 | |
4050 | 321 sub parse_doc_item |
322 { | |
323 while (<INFILE>) | |
324 { | |
325 last if (/^\s*END_DOC_ITEM\s*$/); | |
326 | |
327 $doc_item[$opt_num] .= $_; | |
328 } | |
329 | |
330 $doc_item[$opt_num] =~ s/\n/\\n\\\n/g; | |
331 } | |
332 | |
3998 | 333 sub parse_init_body |
334 { | |
335 while (<INFILE>) | |
336 { | |
337 last if (/^\s*END_INIT_BODY\s*$/); | |
338 | |
339 $init_body[$opt_num] .= $_; | |
340 } | |
341 } | |
342 | |
343 sub parse_set_body | |
344 { | |
345 while (<INFILE>) | |
346 { | |
347 last if (/^\s*END_SET_BODY\s*$/); | |
348 | |
349 $set_body[$opt_num] .= $_; | |
350 } | |
351 } | |
352 | |
353 sub parse_set_code | |
354 { | |
355 while (<INFILE>) | |
356 { | |
357 last if (/^\s*END_SET_CODE\s*$/); | |
358 | |
359 $set_code[$opt_num] .= $_; | |
360 } | |
361 } | |
362 | |
363 sub emit_opt_class_header | |
364 { | |
365 local ($i, $s); | |
366 | |
367 print "// DO NOT EDIT! | |
368 // Generated automatically from $INFILE. | |
369 | |
370 #if !defined (octave_${class_name}_h) | |
371 #define octave_${class_name}_h 1 | |
372 | |
373 #include <cfloat> | |
374 #include <cmath> | |
375 | |
4044 | 376 ${include} |
377 | |
3998 | 378 class |
379 ${class_name} | |
380 { | |
381 public: | |
382 | |
383 ${class_name} (void) { init (); } | |
384 | |
385 ${class_name} (const ${class_name}& opt) { copy (opt); } | |
386 | |
387 ${class_name}& operator = (const ${class_name}& opt) | |
388 { | |
389 if (this != &opt) | |
390 copy (opt); | |
391 | |
392 return *this; | |
393 } | |
394 | |
395 ~${class_name} (void) { }\n"; | |
396 | |
397 print "\n void init (void)\n {\n"; | |
398 | |
399 for ($i = 0; $i < $opt_num; $i++) | |
400 { | |
401 if ($init_value[$i]) | |
402 { | |
403 print " $optvar[$i] = $init_value[$i];\n"; | |
404 } | |
405 elsif ($init_body[$i]) | |
406 { | |
407 $s = &substopt ($init_body[$i], $optvar[$i], $opt[$i], $type[$i]); | |
408 chop ($s); | |
409 $s =~ s/^\s*/ /g; | |
410 $s =~ s/\n\s*/\n /g; | |
411 print "$s\n"; | |
412 } | |
413 } | |
414 | |
4049 | 415 print " reset = true; |
416 }\n"; | |
3998 | 417 |
418 print "\n void copy (const ${class_name}& opt)\n {\n"; | |
419 | |
420 for ($i = 0; $i < $opt_num; $i++) | |
421 { | |
422 print " $optvar[$i] = opt.$optvar[$i];\n"; | |
423 } | |
424 | |
4049 | 425 print " reset = opt.reset; |
426 }\n"; | |
3998 | 427 |
4122 | 428 ## For backward compatibility and because set_options is probably |
429 ## a better name in some contexts: | |
430 | |
431 print "\n void set_options (const ${class_name}& opt) { copy (opt); }\n"; | |
432 | |
3998 | 433 print "\n void set_default_options (void) { init (); }\n"; |
434 | |
435 for ($i = 0; $i < $opt_num; $i++) | |
436 { | |
437 if ($set_expr[$i]) | |
438 { | |
439 &emit_set_decl ($i); | |
440 | |
4049 | 441 print "\n { $optvar[$i] = $set_expr[$i]; reset = true; }\n"; |
3998 | 442 } |
443 elsif ($set_body[$i]) | |
444 { | |
445 &emit_set_decl ($i); | |
446 | |
447 $s = &substopt ($set_body[$i], $optvar[$i], $opt[$i], $type[$i]); | |
448 chop ($s); | |
449 $s =~ s/^/ /g; | |
450 $s =~ s/\n/\n /g; | |
4049 | 451 print "\n {\n$s\n reset = true;\n }\n"; |
3998 | 452 } |
453 elsif ($set_code[$i]) | |
454 { | |
455 $s = &substopt ($set_code[$i], $optvar[$i], $opt[$i], $type[$i]); | |
456 chop ($s); | |
457 $s =~ s/^ //g; | |
458 $s =~ s/\n /\n/g; | |
459 print "\n$s\n"; | |
460 } | |
461 } | |
462 | |
463 for ($i = 0; $i < $opt_num; $i++) | |
464 { | |
465 print " $type[$i] $opt[$i] (void) const\n { return $optvar[$i]; }\n\n"; | |
466 } | |
467 | |
468 print "private:\n\n"; | |
469 | |
470 for ($i = 0; $i < $opt_num; $i++) | |
471 { | |
472 print " $type[$i] $optvar[$i];\n"; | |
473 } | |
474 | |
4049 | 475 print "\nprotected:\n\n bool reset;\n};\n\n#endif\n"; |
3998 | 476 } |
477 | |
478 sub emit_set_decl | |
479 { | |
480 local ($i) = @_; | |
481 | |
482 print " | |
483 void set_$opt[$i] ($set_arg_type[$i] val)"; | |
484 } | |
485 | |
486 sub emit_opt_handler_fcns | |
487 { | |
488 local ($i); | |
4044 | 489 my $header = $INFILE; |
490 $header =~ s/[.]\w*$/.h/; # replace .in with .h | |
491 $header =~ s|^.*/([^/]*)$|$1|; # strip directory part | |
3998 | 492 |
493 print "// DO NOT EDIT!\n// Generated automatically from $INFILE.\n\n"; | |
494 | |
495 print "#ifdef HAVE_CONFIG_H | |
496 #include <config.h> | |
497 #endif | |
498 | |
499 #include <iomanip> | |
500 #include <iostream> | |
501 | |
4044 | 502 #include \"$header\" |
503 | |
3998 | 504 #include \"defun-dld.h\" |
505 #include \"pr-output.h\" | |
506 | |
4044 | 507 #include \"oct-obj.h\" |
508 #include \"utils.h\" | |
509 #include \"pager.h\" | |
510 | |
3998 | 511 static ${class_name} ${static_object_name};\n\n"; |
512 | |
513 &emit_struct_decl; | |
514 | |
515 &emit_struct_def; | |
516 | |
517 &emit_print_function; | |
518 | |
519 &emit_set_functions; | |
520 | |
521 &emit_show_function; | |
522 | |
523 &emit_options_function; | |
524 } | |
525 | |
526 sub emit_struct_decl | |
527 { | |
528 local ($i); | |
529 | |
530 print "#define MAX_TOKENS $max_tokens\n\n"; | |
531 | |
532 print "struct ${struct_name}\n{\n"; | |
533 | |
534 print " const char *keyword;\n"; | |
535 print " const char *kw_tok[MAX_TOKENS + 1];\n"; | |
536 print " int min_len[MAX_TOKENS + 1];\n"; | |
537 print " int min_toks_to_match;\n"; | |
538 | |
539 print "};\n\n"; | |
540 } | |
541 | |
542 sub emit_struct_def | |
543 { | |
544 local ($i); | |
545 | |
546 print "#define NUM_OPTIONS $opt_num\n\n"; | |
547 | |
548 print "static ${struct_name} ${static_table_name} [] =\n{\n"; | |
549 | |
550 for ($i = 0; $i < $opt_num; $i++) | |
551 { | |
552 &emit_option_table_entry ($i, 0); | |
553 | |
554 if ($i < $opt_num - 1) | |
555 { | |
556 print "\n"; | |
557 } | |
558 } | |
559 | |
560 print "};\n\n"; | |
561 } | |
562 | |
563 sub emit_option_table_entry | |
564 { | |
565 local ($i, $empty) = @_; | |
566 | |
567 local ($k); | |
568 | |
569 if ($empty) | |
570 { | |
571 print " { 0,\n"; | |
572 } | |
573 else | |
574 { | |
575 print " { \"$name[$i]\",\n"; | |
576 } | |
577 | |
578 local ($n) = scalar $#{$kw_tok[$i]}; | |
579 print " {"; | |
580 for $k (0 .. $max_tokens) | |
581 { | |
582 if ($empty || $k > $n) | |
583 { | |
584 print " 0,"; | |
585 } | |
586 else | |
587 { | |
588 print " \"$kw_tok[$i][$k]\","; | |
589 } | |
590 } | |
591 print " },\n"; | |
592 | |
593 print " {"; | |
594 for $k (0 .. $max_tokens) | |
595 { | |
596 if ($empty || $k > $n) | |
597 { | |
598 print " 0,"; | |
599 } | |
600 else | |
601 { | |
602 print " $min_tok_len_to_match[$i][$k],"; | |
603 } | |
604 } | |
605 print " }, $min_toks_to_match[$i], "; | |
606 | |
607 print "},\n"; | |
608 } | |
609 | |
610 sub emit_print_function | |
611 { | |
612 local ($i); | |
613 | |
5775 | 614 ## FIXME -- determine the width of the table automatically. |
4047 | 615 |
3998 | 616 print "static void |
6755 | 617 print_${class_name} (std::ostream& os) |
3998 | 618 { |
5765 | 619 std::ostringstream buf; |
3998 | 620 |
6755 | 621 os << \"\\n\" |
622 << \"Options for $CLASS include:\\n\\n\" | |
623 << \" keyword value\\n\" | |
624 << \" ------- -----\\n\"; | |
3998 | 625 |
626 $struct_name *list = $static_table_name;\n\n"; | |
627 | |
628 for ($i = 0; $i < $opt_num; $i++) | |
629 { | |
6755 | 630 print " {\n os << \" \" |
5667 | 631 << std::setiosflags (std::ios::left) << std::setw (50) |
632 << list[$i].keyword | |
633 << std::resetiosflags (std::ios::left) | |
634 << \" \";\n\n"; | |
3998 | 635 |
636 if ($type[$i] eq "double") | |
637 { | |
638 print " double val = $static_object_name.$opt[$i] ();\n\n"; | |
6755 | 639 print " os << val << \"\\n\";\n"; |
3998 | 640 } |
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
641 elsif ($type[$i] eq "float") |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
642 { |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
643 print " float val = $static_object_name.$opt[$i] ();\n\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
644 print " os << val << \"\\n\";\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
645 } |
5275 | 646 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
3998 | 647 { |
648 print " int val = $static_object_name.$opt[$i] ();\n\n"; | |
6755 | 649 print " os << val << \"\\n\";\n"; |
3998 | 650 } |
651 elsif ($type[$i] eq "std::string") | |
652 { | |
6755 | 653 print " os << $static_object_name.$opt[$i] () << \"\\n\";\n"; |
3998 | 654 } |
5275 | 655 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
4044 | 656 { |
5275 | 657 if ($type[$i] eq "Array<int>") |
658 { | |
659 $elt_type = "int"; | |
660 } | |
661 else | |
662 { | |
663 $elt_type = "octave_idx_type"; | |
664 } | |
665 print " Array<$elt_type> val = $static_object_name.$opt[$i] ();\n\n"; | |
4044 | 666 print " if (val.length () == 1) |
667 { | |
6755 | 668 os << val(0) << \"\\n\"; |
4044 | 669 } |
670 else | |
671 { | |
6755 | 672 os << \"\\n\\n\"; |
5275 | 673 octave_idx_type len = val.length (); |
4044 | 674 Matrix tmp (len, 1); |
5275 | 675 for (octave_idx_type i = 0; i < len; i++) |
4044 | 676 tmp(i,0) = val(i); |
6755 | 677 octave_print_internal (os, tmp, false, 2); |
678 os << \"\\n\\n\"; | |
4044 | 679 }\n"; |
680 } | |
3998 | 681 elsif ($type[$i] eq "Array<double>") |
682 { | |
683 print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; | |
684 print " if (val.length () == 1) | |
685 { | |
6755 | 686 os << val(0) << \"\\n\"; |
3998 | 687 } |
688 else | |
689 { | |
6755 | 690 os << \"\\n\\n\"; |
3998 | 691 Matrix tmp = Matrix (ColumnVector (val)); |
6755 | 692 octave_print_internal (os, tmp, false, 2); |
693 os << \"\\n\\n\"; | |
3998 | 694 }\n"; |
695 } | |
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
696 elsif ($type[$i] eq "Array<float>") |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
697 { |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
698 print " Array<float> val = $static_object_name.$opt[$i] ();\n\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
699 print " if (val.length () == 1) |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
700 { |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
701 os << val(0) << \"\\n\"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
702 } |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
703 else |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
704 { |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
705 os << \"\\n\\n\"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
706 FloatMatrix tmp = FloatMatrix (FloatColumnVector (val)); |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
707 octave_print_internal (os, tmp, false, 2); |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
708 os << \"\\n\\n\"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
709 }\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
710 } |
3998 | 711 else |
712 { | |
713 die ("unknown type $type[$i]"); | |
714 } | |
715 | |
716 print " }\n\n"; | |
717 } | |
718 | |
6755 | 719 print " os << \"\\n\";\n}\n\n"; |
3998 | 720 } |
721 | |
722 sub emit_set_functions | |
723 { | |
724 print "static void | |
725 set_${class_name} (const std::string& keyword, const octave_value& val) | |
726 { | |
727 $struct_name *list = $static_table_name;\n\n"; | |
728 | |
729 $iftok = "if"; | |
730 | |
731 for ($i = 0; $i < $opt_num; $i++) | |
732 { | |
733 $iftok = "else if" if ($i > 0); | |
734 | |
735 print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, | |
736 keyword, list[$i].min_toks_to_match, MAX_TOKENS)) | |
737 {\n"; | |
738 | |
739 if ($type[$i] eq "double") | |
740 { | |
741 print " double tmp = val.double_value ();\n\n"; | |
742 print " if (! error_state) | |
743 $static_object_name.set_$opt[$i] (tmp);\n"; | |
744 } | |
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
745 elsif ($type[$i] eq "float") |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
746 { |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
747 print " float tmp = val.float_value ();\n\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
748 print " if (! error_state) |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
749 $static_object_name.set_$opt[$i] (tmp);\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
750 } |
5275 | 751 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
3998 | 752 { |
753 print " int tmp = val.int_value ();\n\n"; | |
754 print " if (! error_state) | |
755 $static_object_name.set_$opt[$i] (tmp);\n"; | |
756 } | |
757 elsif ($type[$i] eq "std::string") | |
758 { | |
759 print " std::string tmp = val.string_value ();\n\n"; | |
760 print " if (! error_state) | |
761 $static_object_name.set_$opt[$i] (tmp);\n"; | |
762 } | |
5275 | 763 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
4044 | 764 { |
765 print " Array<int> tmp = val.int_vector_value ();\n\n"; | |
766 print " if (! error_state) | |
767 $static_object_name.set_$opt[$i] (tmp);\n"; | |
768 } | |
3998 | 769 elsif ($type[$i] eq "Array<double>") |
770 { | |
771 print " Array<double> tmp = val.vector_value ();\n\n"; | |
772 print " if (! error_state) | |
773 $static_object_name.set_$opt[$i] (tmp);\n"; | |
774 } | |
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
775 elsif ($type[$i] eq "Array<float>") |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
776 { |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
777 print " Array<float> tmp = val.float_vector_value ();\n\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
778 print " if (! error_state) |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
779 $static_object_name.set_$opt[$i] (tmp);\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
780 } |
3998 | 781 else |
782 { | |
783 die ("unknown type $type[$i]"); | |
784 } | |
785 | |
786 print " }\n"; | |
787 } | |
788 | |
789 print " else | |
790 { | |
791 warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); | |
792 } | |
793 }\n\n"; | |
794 } | |
795 | |
796 sub emit_show_function | |
797 { | |
798 local ($i, $iftok); | |
799 | |
800 print "static octave_value_list | |
801 show_${class_name} (const std::string& keyword) | |
802 { | |
803 octave_value retval; | |
804 | |
805 $struct_name *list = $static_table_name;\n\n"; | |
806 | |
807 $iftok = "if"; | |
808 | |
809 for ($i = 0; $i < $opt_num; $i++) | |
810 { | |
811 $iftok = "else if" if ($i > 0); | |
812 | |
813 print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, | |
814 keyword, list[$i].min_toks_to_match, MAX_TOKENS)) | |
815 {\n"; | |
816 | |
817 if ($type[$i] eq "double") | |
818 { | |
819 print " double val = $static_object_name.$opt[$i] ();\n\n"; | |
820 print " retval = val;\n"; | |
821 } | |
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
822 elsif ($type[$i] eq "float") |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
823 { |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
824 print " float val = $static_object_name.$opt[$i] ();\n\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
825 print " retval = val;\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
826 } |
5275 | 827 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
3998 | 828 { |
829 print " int val = $static_object_name.$opt[$i] ();\n\n"; | |
830 print " retval = static_cast<double> (val);\n"; | |
831 } | |
832 elsif ($type[$i] eq "std::string") | |
833 { | |
834 print " retval = $static_object_name.$opt[$i] ();\n"; | |
835 } | |
5275 | 836 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
4044 | 837 { |
5275 | 838 if ($type[$i] eq "Array<int>") |
839 { | |
840 $elt_type = "int"; | |
841 } | |
842 else | |
843 { | |
844 $elt_type = "octave_idx_type"; | |
845 } | |
846 print " Array<$elt_type> val = $static_object_name.$opt[$i] ();\n\n"; | |
4044 | 847 print " if (val.length () == 1) |
848 { | |
849 retval = static_cast<double> (val(0)); | |
850 } | |
851 else | |
852 { | |
5275 | 853 octave_idx_type len = val.length (); |
4044 | 854 ColumnVector tmp (len); |
5275 | 855 for (octave_idx_type i = 0; i < len; i++) |
4044 | 856 tmp(i) = val(i); |
857 retval = tmp; | |
858 }\n"; | |
859 } | |
3998 | 860 elsif ($type[$i] eq "Array<double>") |
861 { | |
862 print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; | |
863 print " if (val.length () == 1) | |
864 { | |
865 retval = val(0); | |
866 } | |
867 else | |
868 { | |
869 retval = ColumnVector (val); | |
870 }\n"; | |
871 } | |
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
872 elsif ($type[$i] eq "Array<float>") |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
873 { |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
874 print " Array<float> val = $static_object_name.$opt[$i] ();\n\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
875 print " if (val.length () == 1) |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
876 { |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
877 retval = val(0); |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
878 } |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
879 else |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
880 { |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
881 retval = FloatColumnVector (val); |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
882 }\n"; |
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
883 } |
3998 | 884 else |
885 { | |
886 die ("unknown type $type[$i]"); | |
887 } | |
888 | |
889 print " }\n"; | |
890 } | |
891 | |
892 print " else | |
893 { | |
894 warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); | |
895 } | |
896 | |
897 return retval;\n}\n\n"; | |
898 } | |
899 | |
900 sub emit_options_function | |
901 { | |
902 print "DEFUN_DLD ($opt_fcn_name, args, , | |
903 \"-*- texinfo -*-\\n\\ | |
904 \@deftypefn {Loadable Function} {} $opt_fcn_name (\@var{opt}, \@var{val})\\n\\ | |
4050 | 905 $doc_string\\n\\ |
906 Options include\\n\\ | |
907 \\n\\ | |
908 \@table \@code\\n\\\n"; | |
909 | |
910 for ($i = 0; $i < $opt_num; $i++) | |
911 { | |
912 print "\@item \\\"$name[$i]\\\"\\n\\\n"; | |
913 if ($doc_item[$i] ne "") | |
914 { | |
915 print "$doc_item[$i]"; | |
916 } | |
917 } | |
918 | |
919 print "\@end table\\n\\\n\@end deftypefn\") | |
3998 | 920 { |
921 octave_value_list retval; | |
922 | |
923 int nargin = args.length (); | |
924 | |
925 if (nargin == 0) | |
926 { | |
6755 | 927 print_${class_name} (octave_stdout); |
3998 | 928 } |
929 else if (nargin == 1 || nargin == 2) | |
930 { | |
931 std::string keyword = args(0).string_value (); | |
932 | |
933 if (! error_state) | |
934 { | |
935 if (nargin == 1) | |
936 retval = show_${class_name} (keyword); | |
937 else | |
938 set_${class_name} (keyword, args(1)); | |
939 } | |
940 else | |
941 error (\"$opt_fcn_name: expecting keyword as first argument\"); | |
942 } | |
943 else | |
5823 | 944 print_usage (); |
3998 | 945 |
946 return retval; | |
4035 | 947 }\n"; |
3998 | 948 } |
949 | |
950 sub emit_options_debug | |
951 { | |
952 print "CLASS = \"$class\"\n"; | |
953 | |
954 for ($i = 0; $i < $opt_num; $i++) | |
955 { | |
956 $NAME = $name[$i]; | |
957 ($OPT = $NAME) =~ s/\s+/_/g; | |
958 $OPTVAR = "x_$OPT"; | |
959 $TYPE = $type[$i]; | |
960 print "\n"; | |
961 print "OPTION\n"; | |
962 print " NAME = \"$NAME\"\n"; | |
963 print " TYPE = \"$TYPE\"\n"; | |
964 if ($set_arg_type[$i]) | |
965 { | |
966 print eval ("\" SET_ARG_TYPE = \\\"$set_arg_type[$i]\\\"\"") . "\n"; | |
967 } | |
968 if ($init_value[$i]) | |
969 { | |
970 print " INIT_VALUE = \"$init_value[$i]\"\n"; | |
971 } | |
972 if ($init_body[$i]) | |
973 { | |
974 print " INIT_BODY\n"; | |
975 print &substopt ($init_body[$i]); | |
976 print " END_INIT_BODY\n"; | |
977 } | |
978 if ($set_expr[$i]) | |
979 { | |
980 print " SET_EXPR = \"$set_expr[$i]\"\n"; | |
981 } | |
982 if ($set_body[$i]) | |
983 { | |
984 print " SET_BODY\n"; | |
985 print &substopt ($set_body[$i]); | |
986 print " END_SET_BODY\n"; | |
987 } | |
988 if ($set_code[$i]) | |
989 { | |
990 print " SET_CODE\n"; | |
991 print &substopt ($set_code[$i]); | |
992 print " END_SET_CODE\n"; | |
993 } | |
994 print "END_OPTION\n"; | |
995 } | |
996 } | |
997 | |
998 sub substopt | |
999 { | |
1000 local ($string, $OPTVAR, $OPT, $TYPE) = @_; | |
1001 | |
1002 $string =~ s/\$OPTVAR/$OPTVAR/g; | |
1003 $string =~ s/\$OPT/$OPT/g; | |
1004 $string =~ s/\$TYPE/$TYPE/g; | |
1005 | |
1006 $string; | |
1007 } | |
1008 | |
1009 sub print_assoc_array | |
1010 { | |
1011 local (%t) = @_; | |
1012 | |
1013 local ($k); | |
1014 | |
1015 foreach $k (keys (%t)) | |
1016 { | |
1017 print "$k: $t{$k}\n"; | |
1018 } | |
1019 } | |
1020 | |
1021 sub max | |
1022 { | |
1023 local ($max) = shift; | |
1024 | |
1025 foreach (@_) | |
1026 { | |
1027 $max = $_ if $max < $_; | |
1028 } | |
1029 | |
1030 $max; | |
1031 } |