|
3998
|
1 #! /usr/bin/perl |
|
|
2 |
|
|
3 # Generate option handling code from a simpler input files for |
|
|
4 # Octave's functions like lsode, dassl, etc. |
|
|
5 |
|
3999
|
6 # TODO: |
|
|
7 # |
|
|
8 # * Improve default documentation and/or individual documentation |
|
|
9 # in data files. |
|
|
10 # |
|
|
11 # * Fix print/show code to display/return something more informative |
|
|
12 # for special values (for example, -1 ==> infinite in some cases). |
|
|
13 # Probably need more information in the data files for this. |
|
|
14 |
|
3998
|
15 # Input file format: |
|
|
16 # |
|
|
17 # CLASS = string |
|
|
18 # FCN_NAME = string |
|
|
19 # DOC_STRING doc END_DOC_STRING |
|
|
20 # OPTION |
|
|
21 # NAME = string |
|
|
22 # TYPE = string |
|
|
23 # SET_ARG_TYPE = string (optional, defaults to TYPE) |
|
|
24 # INIT_VALUE = string | INIT_BODY code END_INIT_BODY |
|
|
25 # SET_EXPR = string | SET_BODY code END_SET_BODY | SET_CODE code END_SET_CODE |
|
|
26 # END_OPTION |
|
|
27 # |
|
|
28 # END_* must appear at beginning of line (whitespace ignored). |
|
|
29 |
|
|
30 use Getopt::Long; |
|
|
31 |
|
|
32 $opt_emit_opt_class_header = 0; |
|
|
33 $opt_emit_opt_handler_fcns = 0; |
|
|
34 $opt_debug = 0; |
|
|
35 |
|
|
36 GetOptions ("opt-class-header" => \$opt_emit_opt_class_header, |
|
|
37 "opt-handler-fcns" => \$opt_emit_opt_handler_fcns, |
|
|
38 "debug" => \$opt_debug); |
|
|
39 |
|
|
40 if (@ARGV == 1) |
|
|
41 { |
|
|
42 $INFILE = shift @ARGV; |
|
|
43 open (INFILE) || die "unable to open input file $INFILE"; |
|
|
44 } |
|
|
45 else |
|
|
46 { |
|
|
47 die "usage: mk-opts.pl [options] FILE"; |
|
|
48 } |
|
|
49 |
|
|
50 $opt_num = 0; |
|
|
51 |
|
|
52 &parse_input; |
|
|
53 |
|
|
54 &process_data; |
|
|
55 |
|
|
56 FOO: |
|
|
57 { |
|
|
58 $opt_emit_opt_class_header && do { &emit_opt_class_header; last FOO; }; |
|
|
59 |
|
|
60 $opt_emit_opt_handler_fcns && do { &emit_opt_handler_fcns; last FOO; }; |
|
|
61 |
|
|
62 $opt_debug && do { &emit_options_debug; last FOO; }; |
|
|
63 } |
|
|
64 |
|
|
65 sub parse_input |
|
|
66 { |
|
|
67 local ($have_doc_string); |
|
|
68 |
|
|
69 while (<INFILE>) |
|
|
70 { |
|
|
71 next if (/^\s*$/); |
|
|
72 |
|
|
73 if (/^\s*OPTION\s*$/) |
|
|
74 { |
|
|
75 &parse_option_block; |
|
|
76 } |
|
|
77 elsif (/^\s*CLASS\s*=\s*"(\w+)"\s*$/) |
|
|
78 { |
|
|
79 die "duplicate CLASS" if ($class ne ""); |
|
|
80 $CLASS = $1; |
|
|
81 $class_name = "${CLASS}_options"; |
|
|
82 $struct_name = "${class_name}_struct"; |
|
|
83 $static_table_name = "${class_name}_table"; |
|
|
84 } |
|
|
85 elsif (/^\s*FCN_NAME\s*=\s*"(\w+)"\s*$/) |
|
|
86 { |
|
|
87 die "duplicate FCN_NAME" if ($fcn_name ne ""); |
|
|
88 $fcn_name = $1; |
|
|
89 } |
|
|
90 elsif (/^\s*DOC_STRING\s*$/) |
|
|
91 { |
|
|
92 die "duplicate DOC_STRING" if ($have_doc_string); |
|
|
93 &parse_doc_string; |
|
|
94 $have_doc_string = 1; |
|
|
95 } |
|
|
96 } |
|
|
97 } |
|
|
98 |
|
|
99 sub parse_option_block |
|
|
100 { |
|
|
101 local ($have_init_body, $have_set_body, $have_set_code); |
|
|
102 |
|
|
103 while (<INFILE>) |
|
|
104 { |
|
|
105 next if (/^\s*$/); |
|
|
106 |
|
|
107 die "missing END_OPTION" if (/^\s*OPTION\s*$/); |
|
|
108 |
|
|
109 last if (/^\s*END_OPTION\s*$/); |
|
|
110 |
|
|
111 if (/^\s*NAME\s*=\s*"(.*)"\s*$/) |
|
|
112 { |
|
|
113 die "duplicate NAME" if ($name[$opt_num] ne ""); |
|
|
114 $name[$opt_num] = $1; |
|
|
115 ($opt[$opt_num] = $name[$opt_num]) =~ s/\s+/_/g; |
|
|
116 $optvar[$opt_num] = "x_$opt[$opt_num]"; |
|
|
117 $kw_tok[$opt_num] = [ split (/\s+/, $name[$opt_num]) ]; |
|
|
118 $n_toks[$opt_num] = @{$kw_tok[$opt_num]}; |
|
|
119 } |
|
|
120 elsif (/^\s*TYPE\s*=\s*"(.*)"\s*$/) |
|
|
121 { |
|
|
122 die "duplicate TYPE" if ($type[$opt_num] ne ""); |
|
|
123 $type[$opt_num] = $1; |
|
|
124 } |
|
|
125 elsif (/^\s*SET_ARG_TYPE\s*=\s*"(.*)"\s*$/) |
|
|
126 { |
|
|
127 die "duplicate SET_ARG_TYPE" if ($set_arg_type[$opt_num] ne ""); |
|
|
128 $set_arg_type[$opt_num] = $1; |
|
|
129 } |
|
|
130 elsif (/^\s*INIT_VALUE\s*=\s*"(.*)"\s*$/) |
|
|
131 { |
|
|
132 die "duplicate INIT_VALUE" if ($init_value[$opt_num] ne ""); |
|
|
133 $init_value[$opt_num] = $1; |
|
|
134 } |
|
|
135 elsif (/^\s*SET_EXPR\s*=\s*"(.*)"\s*$/) |
|
|
136 { |
|
|
137 die "duplicate SET_EXPR" if ($set_expr[$opt_num] ne ""); |
|
|
138 $set_expr[$opt_num] = $1; |
|
|
139 } |
|
|
140 elsif (/^\s*INIT_BODY\s*$/) |
|
|
141 { |
|
|
142 die "duplicate INIT_BODY" if ($have_init_body); |
|
|
143 &parse_init_body; |
|
|
144 $have_init_body = 1; |
|
|
145 } |
|
|
146 elsif (/^\s*SET_BODY\s*$/) |
|
|
147 { |
|
|
148 die "duplicate SET_BODY" if ($have_set_body); |
|
|
149 &parse_set_body; |
|
|
150 $have_set_body = 1; |
|
|
151 } |
|
|
152 elsif (/^\s*SET_CODE\s*$/) |
|
|
153 { |
|
|
154 die "duplicate SET_CODE" if ($have_set_code); |
|
|
155 &parse_set_code; |
|
|
156 $have_set_code = 1; |
|
|
157 } |
|
|
158 } |
|
|
159 |
|
|
160 if ($set_arg_type[$opt_num] eq "") |
|
|
161 { |
|
|
162 $set_arg_type[$opt_num] = $type[$opt_num] |
|
|
163 } |
|
|
164 else |
|
|
165 { |
|
|
166 $set_arg_type[$opt_num] |
|
|
167 = &substopt ($set_arg_type[$opt_num], $optvar[$opt_num], |
|
|
168 $opt[$opt_num], $type[$opt_num]); |
|
|
169 } |
|
|
170 |
|
|
171 $opt_num++; |
|
|
172 } |
|
|
173 |
|
|
174 sub process_data |
|
|
175 { |
|
|
176 $max_tokens = &max (@n_toks); |
|
|
177 |
|
|
178 &get_min_match_len_info ($max_tokens); |
|
|
179 |
|
|
180 $fcn_name = lc ($CLASS) if ($fcn_name eq ""); |
|
|
181 |
|
|
182 $opt_fcn_name = "${fcn_name}_options" if ($opt_fcn_name eq ""); |
|
|
183 |
|
|
184 $static_object_name = "${fcn_name}_opts"; |
|
|
185 |
|
|
186 if ($doc_string eq "") |
|
|
187 { |
|
|
188 $doc_string = "When called with two arguments, this function\\n\\ |
|
|
189 allows you set options parameters for the function \@code{$fcn_name}.\\n\\ |
|
|
190 Given one argument, \@code{$opt_fcn_name} returns the value of the\\n\\ |
|
|
191 corresponding option. If no arguments are supplied, the names of all\\n\\ |
|
|
192 the available options and their current values are displayed.\\n\\\n"; |
|
|
193 } |
|
|
194 } |
|
|
195 |
|
|
196 sub get_min_match_len_info |
|
|
197 { |
|
|
198 local ($max_tokens) = @_; |
|
|
199 |
|
|
200 local ($i, $j, $k); |
|
|
201 |
|
|
202 for ($i = 0; $i < $opt_num; $i++) |
|
|
203 { |
|
|
204 for ($j = 0; $j < $max_tokens; $j++) |
|
|
205 { |
|
|
206 $min_tok_len_to_match[$i][$j] = 0; |
|
|
207 } |
|
|
208 |
|
|
209 $min_toks_to_match[$i] = 1; |
|
|
210 |
|
|
211 L1: for ($k = 0; $k < $opt_num; $k++) |
|
|
212 { |
|
|
213 local ($duplicate) = 1; |
|
|
214 |
|
|
215 if ($i != $k) |
|
|
216 { |
|
|
217 L2: for ($j = 0; $j < $max_tokens; $j++) |
|
|
218 { |
|
|
219 if ($j < $n_toks[$i]) |
|
|
220 { |
|
|
221 if ($kw_tok[$i][$j] eq $kw_tok[$k][$j]) |
|
|
222 { |
|
|
223 if ($min_tok_len_to_match[$i][$j] == 0) |
|
|
224 { |
|
|
225 $min_tok_len_to_match[$i][$j] = 1; |
|
|
226 } |
|
|
227 |
|
|
228 $min_toks_to_match[$i]++; |
|
|
229 } |
|
|
230 else |
|
|
231 { |
|
|
232 $duplicate = 0; |
|
|
233 |
|
|
234 if ($min_tok_len_to_match[$i][$j] == 0) |
|
|
235 { |
|
|
236 $min_tok_len_to_match[$i][$j] = 1; |
|
|
237 } |
|
|
238 |
|
|
239 local (@s) = split (//, $kw_tok[$i][$j]); |
|
|
240 local (@t) = split (//, $kw_tok[$k][$j]); |
|
|
241 |
|
|
242 local ($n, $ii); |
|
|
243 $n = scalar (@s); |
|
|
244 $n = scalar (@t) if (@t < $n); |
|
|
245 |
|
|
246 for ($ii = 0; $ii < $n; $ii++) |
|
|
247 { |
|
|
248 if ("$s[$ii]" eq "$t[$ii]") |
|
|
249 { |
|
|
250 if ($ii + 2 > $min_tok_len_to_match[$i][$j]) |
|
|
251 { |
|
|
252 $min_tok_len_to_match[$i][$j]++; |
|
|
253 } |
|
|
254 } |
|
|
255 else |
|
|
256 { |
|
|
257 last L2; |
|
|
258 } |
|
|
259 } |
|
|
260 |
|
|
261 last L1; |
|
|
262 } |
|
|
263 } |
|
|
264 else |
|
|
265 { |
|
|
266 die "ambiguous options \"$name[$i]\" and \"$name[$k]\"" if ($duplicate); |
|
|
267 } |
|
|
268 } |
|
|
269 } |
|
|
270 } |
|
|
271 } |
|
|
272 } |
|
|
273 |
|
|
274 sub parse_doc_string |
|
|
275 { |
|
|
276 while (<INFILE>) |
|
|
277 { |
|
|
278 last if (/^\s*END_DOC_STRING\s*$/); |
|
|
279 |
|
|
280 $doc_string .= $_; |
|
|
281 } |
|
|
282 |
|
|
283 $doc_string =~ s/\n/\\n\\\n/g; |
|
|
284 } |
|
|
285 |
|
|
286 sub parse_init_body |
|
|
287 { |
|
|
288 while (<INFILE>) |
|
|
289 { |
|
|
290 last if (/^\s*END_INIT_BODY\s*$/); |
|
|
291 |
|
|
292 $init_body[$opt_num] .= $_; |
|
|
293 } |
|
|
294 } |
|
|
295 |
|
|
296 sub parse_set_body |
|
|
297 { |
|
|
298 while (<INFILE>) |
|
|
299 { |
|
|
300 last if (/^\s*END_SET_BODY\s*$/); |
|
|
301 |
|
|
302 $set_body[$opt_num] .= $_; |
|
|
303 } |
|
|
304 } |
|
|
305 |
|
|
306 sub parse_set_code |
|
|
307 { |
|
|
308 while (<INFILE>) |
|
|
309 { |
|
|
310 last if (/^\s*END_SET_CODE\s*$/); |
|
|
311 |
|
|
312 $set_code[$opt_num] .= $_; |
|
|
313 } |
|
|
314 } |
|
|
315 |
|
|
316 sub emit_opt_class_header |
|
|
317 { |
|
|
318 local ($i, $s); |
|
|
319 |
|
|
320 print "// DO NOT EDIT! |
|
|
321 // Generated automatically from $INFILE. |
|
|
322 |
|
|
323 #if !defined (octave_${class_name}_h) |
|
|
324 #define octave_${class_name}_h 1 |
|
|
325 |
|
|
326 #include <cfloat> |
|
|
327 #include <cmath> |
|
|
328 |
|
|
329 class |
|
|
330 ${class_name} |
|
|
331 { |
|
|
332 public: |
|
|
333 |
|
|
334 ${class_name} (void) { init (); } |
|
|
335 |
|
|
336 ${class_name} (const ${class_name}& opt) { copy (opt); } |
|
|
337 |
|
|
338 ${class_name}& operator = (const ${class_name}& opt) |
|
|
339 { |
|
|
340 if (this != &opt) |
|
|
341 copy (opt); |
|
|
342 |
|
|
343 return *this; |
|
|
344 } |
|
|
345 |
|
|
346 ~${class_name} (void) { }\n"; |
|
|
347 |
|
|
348 print "\n void init (void)\n {\n"; |
|
|
349 |
|
|
350 for ($i = 0; $i < $opt_num; $i++) |
|
|
351 { |
|
|
352 if ($init_value[$i]) |
|
|
353 { |
|
|
354 print " $optvar[$i] = $init_value[$i];\n"; |
|
|
355 } |
|
|
356 elsif ($init_body[$i]) |
|
|
357 { |
|
|
358 $s = &substopt ($init_body[$i], $optvar[$i], $opt[$i], $type[$i]); |
|
|
359 chop ($s); |
|
|
360 $s =~ s/^\s*/ /g; |
|
|
361 $s =~ s/\n\s*/\n /g; |
|
|
362 print "$s\n"; |
|
|
363 } |
|
|
364 } |
|
|
365 |
|
|
366 print " }\n"; |
|
|
367 |
|
|
368 print "\n void copy (const ${class_name}& opt)\n {\n"; |
|
|
369 |
|
|
370 for ($i = 0; $i < $opt_num; $i++) |
|
|
371 { |
|
|
372 print " $optvar[$i] = opt.$optvar[$i];\n"; |
|
|
373 } |
|
|
374 |
|
|
375 print " }\n"; |
|
|
376 |
|
|
377 print "\n void set_default_options (void) { init (); }\n"; |
|
|
378 |
|
|
379 for ($i = 0; $i < $opt_num; $i++) |
|
|
380 { |
|
|
381 if ($set_expr[$i]) |
|
|
382 { |
|
|
383 &emit_set_decl ($i); |
|
|
384 |
|
|
385 print "\n { $optvar[$i] = $set_expr[$i]; }\n"; |
|
|
386 } |
|
|
387 elsif ($set_body[$i]) |
|
|
388 { |
|
|
389 &emit_set_decl ($i); |
|
|
390 |
|
|
391 $s = &substopt ($set_body[$i], $optvar[$i], $opt[$i], $type[$i]); |
|
|
392 chop ($s); |
|
|
393 $s =~ s/^/ /g; |
|
|
394 $s =~ s/\n/\n /g; |
|
|
395 print "\n {\n$s\n }\n"; |
|
|
396 } |
|
|
397 elsif ($set_code[$i]) |
|
|
398 { |
|
|
399 $s = &substopt ($set_code[$i], $optvar[$i], $opt[$i], $type[$i]); |
|
|
400 chop ($s); |
|
|
401 $s =~ s/^ //g; |
|
|
402 $s =~ s/\n /\n/g; |
|
|
403 print "\n$s\n"; |
|
|
404 } |
|
|
405 } |
|
|
406 |
|
|
407 for ($i = 0; $i < $opt_num; $i++) |
|
|
408 { |
|
|
409 print " $type[$i] $opt[$i] (void) const\n { return $optvar[$i]; }\n\n"; |
|
|
410 } |
|
|
411 |
|
|
412 print "private:\n\n"; |
|
|
413 |
|
|
414 for ($i = 0; $i < $opt_num; $i++) |
|
|
415 { |
|
|
416 print " $type[$i] $optvar[$i];\n"; |
|
|
417 } |
|
|
418 |
|
|
419 print "};\n\n#endif\n"; |
|
|
420 } |
|
|
421 |
|
|
422 sub emit_set_decl |
|
|
423 { |
|
|
424 local ($i) = @_; |
|
|
425 |
|
|
426 print " |
|
|
427 void set_$opt[$i] ($set_arg_type[$i] val)"; |
|
|
428 } |
|
|
429 |
|
|
430 sub emit_opt_handler_fcns |
|
|
431 { |
|
|
432 local ($i); |
|
|
433 |
|
|
434 print "// DO NOT EDIT!\n// Generated automatically from $INFILE.\n\n"; |
|
|
435 |
|
|
436 print "#ifdef HAVE_CONFIG_H |
|
|
437 #include <config.h> |
|
|
438 #endif |
|
|
439 |
|
|
440 #include <iomanip> |
|
|
441 #include <iostream> |
|
|
442 |
|
|
443 #include \"defun-dld.h\" |
|
|
444 #include \"pr-output.h\" |
|
|
445 |
|
|
446 static ${class_name} ${static_object_name};\n\n"; |
|
|
447 |
|
|
448 &emit_struct_decl; |
|
|
449 |
|
|
450 &emit_struct_def; |
|
|
451 |
|
|
452 &emit_print_function; |
|
|
453 |
|
|
454 &emit_set_functions; |
|
|
455 |
|
|
456 &emit_show_function; |
|
|
457 |
|
|
458 &emit_options_function; |
|
|
459 } |
|
|
460 |
|
|
461 sub emit_struct_decl |
|
|
462 { |
|
|
463 local ($i); |
|
|
464 |
|
|
465 print "#define MAX_TOKENS $max_tokens\n\n"; |
|
|
466 |
|
|
467 print "struct ${struct_name}\n{\n"; |
|
|
468 |
|
|
469 print " const char *keyword;\n"; |
|
|
470 print " const char *kw_tok[MAX_TOKENS + 1];\n"; |
|
|
471 print " int min_len[MAX_TOKENS + 1];\n"; |
|
|
472 print " int min_toks_to_match;\n"; |
|
|
473 |
|
|
474 print "};\n\n"; |
|
|
475 } |
|
|
476 |
|
|
477 sub emit_struct_def |
|
|
478 { |
|
|
479 local ($i); |
|
|
480 |
|
|
481 print "#define NUM_OPTIONS $opt_num\n\n"; |
|
|
482 |
|
|
483 print "static ${struct_name} ${static_table_name} [] =\n{\n"; |
|
|
484 |
|
|
485 for ($i = 0; $i < $opt_num; $i++) |
|
|
486 { |
|
|
487 &emit_option_table_entry ($i, 0); |
|
|
488 |
|
|
489 if ($i < $opt_num - 1) |
|
|
490 { |
|
|
491 print "\n"; |
|
|
492 } |
|
|
493 } |
|
|
494 |
|
|
495 print "};\n\n"; |
|
|
496 } |
|
|
497 |
|
|
498 sub emit_option_table_entry |
|
|
499 { |
|
|
500 local ($i, $empty) = @_; |
|
|
501 |
|
|
502 local ($k); |
|
|
503 |
|
|
504 if ($empty) |
|
|
505 { |
|
|
506 print " { 0,\n"; |
|
|
507 } |
|
|
508 else |
|
|
509 { |
|
|
510 print " { \"$name[$i]\",\n"; |
|
|
511 } |
|
|
512 |
|
|
513 local ($n) = scalar $#{$kw_tok[$i]}; |
|
|
514 print " {"; |
|
|
515 for $k (0 .. $max_tokens) |
|
|
516 { |
|
|
517 if ($empty || $k > $n) |
|
|
518 { |
|
|
519 print " 0,"; |
|
|
520 } |
|
|
521 else |
|
|
522 { |
|
|
523 print " \"$kw_tok[$i][$k]\","; |
|
|
524 } |
|
|
525 } |
|
|
526 print " },\n"; |
|
|
527 |
|
|
528 print " {"; |
|
|
529 for $k (0 .. $max_tokens) |
|
|
530 { |
|
|
531 if ($empty || $k > $n) |
|
|
532 { |
|
|
533 print " 0,"; |
|
|
534 } |
|
|
535 else |
|
|
536 { |
|
|
537 print " $min_tok_len_to_match[$i][$k],"; |
|
|
538 } |
|
|
539 } |
|
|
540 print " }, $min_toks_to_match[$i], "; |
|
|
541 |
|
|
542 print "},\n"; |
|
|
543 } |
|
|
544 |
|
|
545 sub emit_print_function |
|
|
546 { |
|
|
547 local ($i); |
|
|
548 |
|
|
549 print "static void |
|
|
550 print_${class_name} (std::ostream& os) |
|
|
551 { |
|
|
552 print_usage (\"$opt_fcn_name\", 1); |
|
|
553 |
|
|
554 os << \"\\n\" |
|
|
555 << \"Options for $CLASS include:\\n\\n\" |
|
|
556 << \" keyword value\\n\" |
|
|
557 << \" ------- -----\\n\"; |
|
|
558 |
|
|
559 $struct_name *list = $static_table_name;\n\n"; |
|
|
560 |
|
|
561 for ($i = 0; $i < $opt_num; $i++) |
|
|
562 { |
|
|
563 print " {\n os << \" \" |
|
|
564 << std::setiosflags (std::ios::left) << std::setw (40) |
|
|
565 << list[$i].keyword |
|
|
566 << std::resetiosflags (std::ios::left) |
|
|
567 << \" \";\n\n"; |
|
|
568 |
|
|
569 if ($type[$i] eq "double") |
|
|
570 { |
|
|
571 print " double val = $static_object_name.$opt[$i] ();\n\n"; |
|
|
572 print " os << val << \"\\n\";\n"; |
|
|
573 } |
|
|
574 elsif ($type[$i] eq "int") |
|
|
575 { |
|
|
576 print " int val = $static_object_name.$opt[$i] ();\n\n"; |
|
|
577 print " os << val << \"\\n\";\n"; |
|
|
578 } |
|
|
579 elsif ($type[$i] eq "std::string") |
|
|
580 { |
|
|
581 print " os << $static_object_name.$opt[$i] () << \"\\n\";\n"; |
|
|
582 } |
|
|
583 elsif ($type[$i] eq "Array<double>") |
|
|
584 { |
|
|
585 print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; |
|
|
586 print " if (val.length () == 1) |
|
|
587 { |
|
|
588 os << val(0) << \"\\n\"; |
|
|
589 } |
|
|
590 else |
|
|
591 { |
|
|
592 os << \"\\n\\n\"; |
|
|
593 Matrix tmp = Matrix (ColumnVector (val)); |
|
|
594 octave_print_internal (os, tmp, false, 2); |
|
|
595 os << \"\\n\\n\"; |
|
|
596 }\n"; |
|
|
597 } |
|
|
598 else |
|
|
599 { |
|
|
600 die ("unknown type $type[$i]"); |
|
|
601 } |
|
|
602 |
|
|
603 print " }\n\n"; |
|
|
604 } |
|
|
605 |
|
|
606 print " os << \"\\n\";\n}\n\n"; |
|
|
607 } |
|
|
608 |
|
|
609 sub emit_set_functions |
|
|
610 { |
|
|
611 print "static void |
|
|
612 set_${class_name} (const std::string& keyword, const octave_value& val) |
|
|
613 { |
|
|
614 $struct_name *list = $static_table_name;\n\n"; |
|
|
615 |
|
|
616 $iftok = "if"; |
|
|
617 |
|
|
618 for ($i = 0; $i < $opt_num; $i++) |
|
|
619 { |
|
|
620 $iftok = "else if" if ($i > 0); |
|
|
621 |
|
|
622 print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, |
|
|
623 keyword, list[$i].min_toks_to_match, MAX_TOKENS)) |
|
|
624 {\n"; |
|
|
625 |
|
|
626 if ($type[$i] eq "double") |
|
|
627 { |
|
|
628 print " double tmp = val.double_value ();\n\n"; |
|
|
629 print " if (! error_state) |
|
|
630 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
|
631 } |
|
|
632 elsif ($type[$i] eq "int") |
|
|
633 { |
|
|
634 print " int tmp = val.int_value ();\n\n"; |
|
|
635 print " if (! error_state) |
|
|
636 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
|
637 } |
|
|
638 elsif ($type[$i] eq "std::string") |
|
|
639 { |
|
|
640 print " std::string tmp = val.string_value ();\n\n"; |
|
|
641 print " if (! error_state) |
|
|
642 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
|
643 } |
|
|
644 elsif ($type[$i] eq "Array<double>") |
|
|
645 { |
|
|
646 print " Array<double> tmp = val.vector_value ();\n\n"; |
|
|
647 print " if (! error_state) |
|
|
648 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
|
649 } |
|
|
650 else |
|
|
651 { |
|
|
652 die ("unknown type $type[$i]"); |
|
|
653 } |
|
|
654 |
|
|
655 print " }\n"; |
|
|
656 } |
|
|
657 |
|
|
658 print " else |
|
|
659 { |
|
|
660 warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); |
|
|
661 } |
|
|
662 }\n\n"; |
|
|
663 } |
|
|
664 |
|
|
665 sub emit_show_function |
|
|
666 { |
|
|
667 local ($i, $iftok); |
|
|
668 |
|
|
669 print "static octave_value_list |
|
|
670 show_${class_name} (const std::string& keyword) |
|
|
671 { |
|
|
672 octave_value retval; |
|
|
673 |
|
|
674 $struct_name *list = $static_table_name;\n\n"; |
|
|
675 |
|
|
676 $iftok = "if"; |
|
|
677 |
|
|
678 for ($i = 0; $i < $opt_num; $i++) |
|
|
679 { |
|
|
680 $iftok = "else if" if ($i > 0); |
|
|
681 |
|
|
682 print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, |
|
|
683 keyword, list[$i].min_toks_to_match, MAX_TOKENS)) |
|
|
684 {\n"; |
|
|
685 |
|
|
686 if ($type[$i] eq "double") |
|
|
687 { |
|
|
688 print " double val = $static_object_name.$opt[$i] ();\n\n"; |
|
|
689 print " retval = val;\n"; |
|
|
690 } |
|
|
691 elsif ($type[$i] eq "int") |
|
|
692 { |
|
|
693 print " int val = $static_object_name.$opt[$i] ();\n\n"; |
|
|
694 print " retval = static_cast<double> (val);\n"; |
|
|
695 } |
|
|
696 elsif ($type[$i] eq "std::string") |
|
|
697 { |
|
|
698 print " retval = $static_object_name.$opt[$i] ();\n"; |
|
|
699 } |
|
|
700 elsif ($type[$i] eq "Array<double>") |
|
|
701 { |
|
|
702 print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; |
|
|
703 print " if (val.length () == 1) |
|
|
704 { |
|
|
705 retval = val(0); |
|
|
706 } |
|
|
707 else |
|
|
708 { |
|
|
709 retval = ColumnVector (val); |
|
|
710 }\n"; |
|
|
711 } |
|
|
712 else |
|
|
713 { |
|
|
714 die ("unknown type $type[$i]"); |
|
|
715 } |
|
|
716 |
|
|
717 print " }\n"; |
|
|
718 } |
|
|
719 |
|
|
720 print " else |
|
|
721 { |
|
|
722 warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); |
|
|
723 } |
|
|
724 |
|
|
725 return retval;\n}\n\n"; |
|
|
726 } |
|
|
727 |
|
|
728 sub emit_options_function |
|
|
729 { |
|
|
730 print "DEFUN_DLD ($opt_fcn_name, args, , |
|
|
731 \"-*- texinfo -*-\\n\\ |
|
|
732 \@deftypefn {Loadable Function} {} $opt_fcn_name (\@var{opt}, \@var{val})\\n\\ |
|
|
733 $doc_string\@end deftypefn\") |
|
|
734 { |
|
|
735 octave_value_list retval; |
|
|
736 |
|
|
737 int nargin = args.length (); |
|
|
738 |
|
|
739 if (nargin == 0) |
|
|
740 { |
|
|
741 print_${class_name} (octave_stdout); |
|
|
742 } |
|
|
743 else if (nargin == 1 || nargin == 2) |
|
|
744 { |
|
|
745 std::string keyword = args(0).string_value (); |
|
|
746 |
|
|
747 if (! error_state) |
|
|
748 { |
|
|
749 if (nargin == 1) |
|
|
750 retval = show_${class_name} (keyword); |
|
|
751 else |
|
|
752 set_${class_name} (keyword, args(1)); |
|
|
753 } |
|
|
754 else |
|
|
755 error (\"$opt_fcn_name: expecting keyword as first argument\"); |
|
|
756 } |
|
|
757 else |
|
|
758 print_usage (\"$opt_fcn_name\"); |
|
|
759 |
|
|
760 return retval; |
|
|
761 }"; |
|
|
762 } |
|
|
763 |
|
|
764 sub emit_options_debug |
|
|
765 { |
|
|
766 print "CLASS = \"$class\"\n"; |
|
|
767 |
|
|
768 for ($i = 0; $i < $opt_num; $i++) |
|
|
769 { |
|
|
770 $NAME = $name[$i]; |
|
|
771 ($OPT = $NAME) =~ s/\s+/_/g; |
|
|
772 $OPTVAR = "x_$OPT"; |
|
|
773 $TYPE = $type[$i]; |
|
|
774 print "\n"; |
|
|
775 print "OPTION\n"; |
|
|
776 print " NAME = \"$NAME\"\n"; |
|
|
777 print " TYPE = \"$TYPE\"\n"; |
|
|
778 if ($set_arg_type[$i]) |
|
|
779 { |
|
|
780 print eval ("\" SET_ARG_TYPE = \\\"$set_arg_type[$i]\\\"\"") . "\n"; |
|
|
781 } |
|
|
782 if ($init_value[$i]) |
|
|
783 { |
|
|
784 print " INIT_VALUE = \"$init_value[$i]\"\n"; |
|
|
785 } |
|
|
786 if ($init_body[$i]) |
|
|
787 { |
|
|
788 print " INIT_BODY\n"; |
|
|
789 print &substopt ($init_body[$i]); |
|
|
790 print " END_INIT_BODY\n"; |
|
|
791 } |
|
|
792 if ($set_expr[$i]) |
|
|
793 { |
|
|
794 print " SET_EXPR = \"$set_expr[$i]\"\n"; |
|
|
795 } |
|
|
796 if ($set_body[$i]) |
|
|
797 { |
|
|
798 print " SET_BODY\n"; |
|
|
799 print &substopt ($set_body[$i]); |
|
|
800 print " END_SET_BODY\n"; |
|
|
801 } |
|
|
802 if ($set_code[$i]) |
|
|
803 { |
|
|
804 print " SET_CODE\n"; |
|
|
805 print &substopt ($set_code[$i]); |
|
|
806 print " END_SET_CODE\n"; |
|
|
807 } |
|
|
808 print "END_OPTION\n"; |
|
|
809 } |
|
|
810 } |
|
|
811 |
|
|
812 sub substopt |
|
|
813 { |
|
|
814 local ($string, $OPTVAR, $OPT, $TYPE) = @_; |
|
|
815 |
|
|
816 $string =~ s/\$OPTVAR/$OPTVAR/g; |
|
|
817 $string =~ s/\$OPT/$OPT/g; |
|
|
818 $string =~ s/\$TYPE/$TYPE/g; |
|
|
819 |
|
|
820 $string; |
|
|
821 } |
|
|
822 |
|
|
823 sub print_assoc_array |
|
|
824 { |
|
|
825 local (%t) = @_; |
|
|
826 |
|
|
827 local ($k); |
|
|
828 |
|
|
829 foreach $k (keys (%t)) |
|
|
830 { |
|
|
831 print "$k: $t{$k}\n"; |
|
|
832 } |
|
|
833 } |
|
|
834 |
|
|
835 sub max |
|
|
836 { |
|
|
837 local ($max) = shift; |
|
|
838 |
|
|
839 foreach (@_) |
|
|
840 { |
|
|
841 $max = $_ if $max < $_; |
|
|
842 } |
|
|
843 |
|
|
844 $max; |
|
|
845 } |
