Mercurial > octave
view build-aux/mk-opts.pl @ 21244:1473547f50f5
include octave-config.h in public header files
* mk-opts.pl, mkbuiltins, mk-ops.awk, sparse-mk-ops.awk:
Emit "#include octave-config.h" statement for generated header files.
* build-env.h, builtins.h, Cell.h, base-text-renderer.h,
c-file-ptr-stream.h, cdisplay.h, comment-list.h, data.h, debug.h,
defaults.in.h, defun-dld.h, defun-int.h, defun.h, dirfns.h, display.h,
dynamic-ld.h, error.h, errwarn.h, event-queue.h, file-io.h,
ft-text-renderer.h, gl-render.h, gl2ps-print.h, graphics.in.h,
gripes.h, help.h, hook-fcn.h, input.h, jit-ir.h, jit-typeinfo.h,
jit-util.h, load-path.h, load-save.h, ls-ascii-helper.h, ls-hdf5.h,
ls-mat-ascii.h, ls-mat4.h, ls-mat5.h, ls-oct-binary.h, ls-oct-text.h,
ls-utils.h, mex.h, mexproto.h, mxarray.in.h, oct-errno.h, oct-fstrm.h,
oct-handle.h, oct-hdf5-types.h, oct-hdf5.h, oct-hist.h, oct-iostrm.h,
oct-lvalue.h, oct-map.h, oct-obj.h, oct-opengl.h, oct-prcstrm.h,
oct-procbuf.h, oct-stdstrm.h, oct-stream.h, oct-strstrm.h, oct.h,
octave-default-image.h, octave-link.h, octave-preserve-stream-state.h,
pager.h, pr-output.h, procstream.h, profiler.h, pt-jit.h,
sighandlers.h, siglist.h, sparse-xdiv.h, sparse-xpow.h, symtab.h,
sysdep.h, text-renderer.h, toplev.h, txt-eng.h, utils.h, variables.h,
workspace-element.h, xdiv.h, xnorm.h, xpow.h, zfstream.h, oct-qhull.h,
ov-base-diag.h, ov-base-int.h, ov-base-mat.h, ov-base-scalar.h,
ov-base-sparse.h, ov-base.h, ov-bool-mat.h, ov-bool-sparse.h,
ov-bool.h, ov-builtin.h, ov-cell.h, ov-ch-mat.h, ov-class.h,
ov-classdef.h, ov-colon.h, ov-complex.h, ov-cs-list.h, ov-cx-diag.h,
ov-cx-mat.h, ov-cx-sparse.h, ov-dld-fcn.h, ov-fcn-handle.h,
ov-fcn-inline.h, ov-fcn.h, ov-float.h, ov-flt-complex.h,
ov-flt-cx-diag.h, ov-flt-cx-mat.h, ov-flt-re-diag.h, ov-flt-re-mat.h,
ov-int-traits.h, ov-int16.h, ov-int32.h, ov-int64.h, ov-int8.h,
ov-intx.h, ov-java.h, ov-lazy-idx.h, ov-mex-fcn.h, ov-null-mat.h,
ov-oncleanup.h, ov-perm.h, ov-range.h, ov-re-diag.h, ov-re-mat.h,
ov-re-sparse.h, ov-scalar.h, ov-str-mat.h, ov-struct.h,
ov-type-conv.h, ov-typeinfo.h, ov-uint16.h, ov-uint32.h, ov-uint64.h,
ov-uint8.h, ov-usr-fcn.h, ov.h, ovl.h, octave.h, op-int.h, ops.h,
options-usage.h, lex.h, parse.h, pt-all.h, pt-arg-list.h,
pt-array-list.h, pt-assign.h, pt-binop.h, pt-bp.h, pt-cbinop.h,
pt-cell.h, pt-check.h, pt-classdef.h, pt-cmd.h, pt-colon.h,
pt-const.h, pt-decl.h, pt-eval.h, pt-except.h, pt-exp.h,
pt-fcn-handle.h, pt-funcall.h, pt-id.h, pt-idx.h, pt-jump.h,
pt-loop.h, pt-mat.h, pt-misc.h, pt-pr-code.h, pt-select.h, pt-stmt.h,
pt-unop.h, pt-walk.h, pt.h, token.h, version.in.h, Array-util.h,
Array.h, CColVector.h, CDiagMatrix.h, CMatrix.h, CNDArray.h,
CRowVector.h, CSparse.h, DiagArray2.h, MArray.h, MDiagArray2.h,
MSparse.h, Matrix.h, MatrixType.h, PermMatrix.h, Range.h, Sparse.h,
boolMatrix.h, boolNDArray.h, boolSparse.h, chMatrix.h, chNDArray.h,
dColVector.h, dDiagMatrix.h, dMatrix.h, dNDArray.h, dRowVector.h,
dSparse.h, dim-vector.h, fCColVector.h, fCDiagMatrix.h, fCMatrix.h,
fCNDArray.h, fCRowVector.h, fColVector.h, fDiagMatrix.h, fMatrix.h,
fNDArray.h, fRowVector.h, idx-vector.h, int16NDArray.h,
int32NDArray.h, int64NDArray.h, int8NDArray.h, intNDArray.h,
uint16NDArray.h, uint32NDArray.h, uint64NDArray.h, uint8NDArray.h,
f77-fcn.h, lo-error.h, quit.h, CmplxAEPBAL.h, CmplxCHOL.h,
CmplxGEPBAL.h, CmplxHESS.h, CmplxLU.h, CmplxQR.h, CmplxQRP.h,
CmplxSCHUR.h, CmplxSVD.h, CollocWt.h, DAE.h, DAEFunc.h, DAERT.h,
DAERTFunc.h, DASPK.h, DASRT.h, DASSL.h, DET.h, EIG.h, LSODE.h, ODE.h,
ODEFunc.h, ODES.h, ODESFunc.h, Quad.h, base-aepbal.h, base-dae.h,
base-de.h, base-lu.h, base-min.h, base-qr.h, bsxfun-decl.h, bsxfun.h,
dbleAEPBAL.h, dbleCHOL.h, dbleGEPBAL.h, dbleHESS.h, dbleLU.h,
dbleQR.h, dbleQRP.h, dbleSCHUR.h, dbleSVD.h, eigs-base.h,
fCmplxAEPBAL.h, fCmplxCHOL.h, fCmplxGEPBAL.h, fCmplxHESS.h,
fCmplxLU.h, fCmplxQR.h, fCmplxQRP.h, fCmplxSCHUR.h, fCmplxSVD.h,
fEIG.h, floatAEPBAL.h, floatCHOL.h, floatGEPBAL.h, floatHESS.h,
floatLU.h, floatQR.h, floatQRP.h, floatSCHUR.h, floatSVD.h,
lo-mappers.h, lo-specfun.h, oct-convn.h, oct-fftw.h, oct-norm.h,
oct-rand.h, oct-spparms.h, randgamma.h, randmtzig.h, randpoisson.h,
sparse-chol.h, sparse-dmsolve.h, sparse-lu.h, sparse-qr.h,
Sparse-diag-op-defs.h, Sparse-op-decls.h, Sparse-op-defs.h,
Sparse-perm-op-defs.h, mx-base.h, mx-defs.h, mx-ext.h, mx-op-decl.h,
mx-op-defs.h, dir-ops.h, file-ops.h, file-stat.h, lo-sysdep.h,
mach-info.h, oct-env.h, oct-group.h, oct-openmp.h, oct-passwd.h,
oct-syscalls.h, oct-time.h, oct-uname.h, pathlen.h, sysdir.h,
syswait.h, action-container.h, base-list.h, byte-swap.h,
caseless-str.h, cmd-edit.h, cmd-hist.h, data-conv.h, functor.h,
glob-match.h, lo-array-errwarn.h, lo-array-gripes.h, lo-cutils.h,
lo-ieee.h, lo-macros.h, lo-math.h, lo-regexp.h, lo-traits.h,
lo-utils.h, oct-alloc.h, oct-base64.h, oct-binmap.h, oct-cmplx.h,
oct-glob.h, oct-inttypes.h, oct-locbuf.h, oct-mutex.h, oct-refcount.h,
oct-rl-edit.h, oct-rl-hist.h, oct-shlib.h, oct-sort.h, oct-sparse.h,
pathsearch.h, singleton-cleanup.h, sparse-sort.h, sparse-util.h,
statdefs.h, str-vec.h, sun-utils.h, unwind-prot.h, url-transfer.h:
Include octave-config.h.
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Wed, 10 Feb 2016 14:25:53 -0500 |
parents | 429f83903400 |
children | 40de9f8f23a6 |
line wrap: on
line source
#! /usr/bin/perl -w # # Copyright (C) 2002-2015 John W. Eaton # # This file is part of Octave. # # Octave is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by the # Free Software Foundation; either version 3 of the License, or (at # your option) any later version. # # Octave is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. # # You should have received a copy of the GNU General Public License # along with Octave; see the file COPYING. If not, see # <http://www.gnu.org/licenses/>. # Generate option handling code from a simpler input files for # Octave's functions like lsode, dassl, etc. # FIXME: # # * Improve default documentation and/or individual documentation # in data files. # # * Fix print/show code to display/return something more informative # for special values (for example, -1 ==> infinite in some cases). # Probably need more information in the data files for this. # Input file format: # # CLASS = string # FCN_NAME = string # INCLUDE = file # DOC_STRING doc END_DOC_STRING # OPTION # NAME = string # DOC_ITEM doc END_DOC_ITEM # TYPE = string # SET_ARG_TYPE = string (optional, defaults to TYPE) # INIT_VALUE = string | INIT_BODY code END_INIT_BODY # SET_EXPR = string | SET_BODY code END_SET_BODY | SET_CODE code END_SET_CODE # END_OPTION # # END_* must appear at beginning of line (whitespace ignored). ################################################################################ # Load packages to # 1) process command line options ################################################################################ use Getopt::Long; ################################################################################ # Extract command line arguments &parse_options; $DEFN_FILE = shift @ARGV; open (DEFN_FILE) or die "unable to open input definition file $DEFN_FILE"; ################################################################################ # Initialize variables $BLANK_LINE = qr/^\s*$/; $COMMENT = qr/^\s*#/; ################################################################################ # Process file $OPT_NUM = 0; &parse_input; &process_data; # Produce desired style of output &emit_opt_class_header if $opt_class_header; &emit_opt_handler_fcns if $opt_handler_fcns; &emit_options_debug if $opt_debug; # End of main code ################################################################################ # Subroutines ################################################################################ sub parse_input { LINE: while (<DEFN_FILE>) { next LINE if /$BLANK_LINE/; next LINE if /$COMMENT/; if (/^\s*OPTION\s*$/) { &parse_option_block; } elsif (/^\s*CLASS\s*=\s*"(\w+)"\s*$/) { die "duplicate CLASS" if defined $CLASS; $CLASS = $1; $CLASS_NAME = "${CLASS}_options"; $STRUCT_NAME = "${CLASS_NAME}_struct"; $STATIC_TABLE_NAME = "${CLASS_NAME}_table"; } elsif (/^\s*FCN_NAME\s*=\s*"(\w+)"\s*$/) { die "duplicate FCN_NAME" if defined $FCN_NAME; $FCN_NAME = $1; } elsif (/^\s*INCLUDE\s*=\s*"(\S+)"\s*$/) { $INCLUDE .= "#include <$1>\n"; } elsif (/^\s*DOC_STRING\s*$/) { die "duplicate DOC_STRING" if defined $DOC_STRING; while (defined ($_ = <DEFN_FILE>) and not /^\s*END_DOC_STRING\s*$/) { $DOC_STRING .= $_; } $DOC_STRING =~ s/\n/\\n\\\n/g; } else { die "mk-opts.pl: unknown command: $_\n" } } $INCLUDE = "" if not defined $INCLUDE; # Initialize value if required } sub parse_option_block { while (<DEFN_FILE>) { next if /$BLANK_LINE/; die "missing END_OPTION" if /^\s*OPTION\s*$/; last if /^\s*END_OPTION\s*$/; if (/^\s*NAME\s*=\s*"(.*)"\s*$/) { die "duplicate NAME" if defined $NAME[$OPT_NUM]; $NAME[$OPT_NUM] = $1; ($OPT[$OPT_NUM] = $NAME[$OPT_NUM]) =~ s/\s+/_/g; $OPTVAR[$OPT_NUM] = 'x_' . $OPT[$OPT_NUM]; $KW_TOK[$OPT_NUM] = [ split (' ', $NAME[$OPT_NUM]) ]; $N_TOKS[$OPT_NUM] = @{$KW_TOK[$OPT_NUM]}; } elsif (/^\s*DOC_ITEM\s*$/) { die "duplicate DOC_ITEM" if defined $DOC_ITEM[$OPT_NUM]; while (defined ($_ = <DEFN_FILE>) and not /^\s*END_DOC_ITEM\s*$/) { $DOC_ITEM[$OPT_NUM] .= $_; } $DOC_ITEM[$OPT_NUM] =~ s/\n/\\n\\\n/g; } elsif (/^\s*TYPE\s*=\s*"(.*)"\s*$/) { die "duplicate TYPE" if defined $TYPE[$OPT_NUM]; $TYPE[$OPT_NUM] = $1; } elsif (/^\s*SET_ARG_TYPE\s*=\s*"(.*)"\s*$/) { die "duplicate SET_ARG_TYPE" if defined $SET_ARG_TYPE[$OPT_NUM]; $SET_ARG_TYPE[$OPT_NUM] = $1; } elsif (/^\s*INIT_VALUE\s*=\s*"(.*)"\s*$/) { die "duplicate INIT_VALUE" if defined $INIT_VALUE[$OPT_NUM]; $INIT_VALUE[$OPT_NUM] = $1; } elsif (/^\s*SET_EXPR\s*=\s*"(.*)"\s*$/) { die "duplicate SET_EXPR" if defined $SET_EXPR[$OPT_NUM]; $SET_EXPR[$OPT_NUM] = $1; } elsif (/^\s*INIT_BODY\s*$/) { die "duplicate INIT_BODY" if defined $INIT_BODY[$OPT_NUM]; while (defined ($_ = <DEFN_FILE>) and not /^\s*END_INIT_BODY\s*$/) { $INIT_BODY[$OPT_NUM] .= $_; } } elsif (/^\s*SET_BODY\s*$/) { die "duplicate SET_BODY" if defined $INIT_BODY[$OPT_NUM]; while (defined ($_ = <DEFN_FILE>) and not /^\s*END_SET_BODY\s*$/) { $SET_BODY[$OPT_NUM] .= $_; } } elsif (/^\s*SET_CODE\s*$/) { die "duplicate SET_CODE" if defined $SET_CODE[$OPT_NUM]; while (defined ($_ = <DEFN_FILE>) and not /^\s*END_SET_CODE\s*$/) { $SET_CODE[$OPT_NUM] .= $_; } } } if (not defined $SET_ARG_TYPE[$OPT_NUM]) { $SET_ARG_TYPE[$OPT_NUM] = $TYPE[$OPT_NUM]; } else { $SET_ARG_TYPE[$OPT_NUM] = substopt ($SET_ARG_TYPE[$OPT_NUM], $OPTVAR[$OPT_NUM], $OPT[$OPT_NUM], $TYPE[$OPT_NUM]); } $OPT_NUM++; } sub process_data { $MAX_TOKENS = max (@N_TOKS); &get_min_match_len_info; $FCN_NAME = lc ($CLASS) if not defined $FCN_NAME; $OPT_FCN_NAME = "${FCN_NAME}_options" if not defined $OPT_FCN_NAME; $STATIC_OBJECT_NAME = "${FCN_NAME}_opts"; if (not defined $DOC_STRING) { $DOC_STRING = "Query or set options for the function \@code{$FCN_NAME}.\\n\\ \\n\\ When called with no arguments, the names of all available options and\\n\\ their current values are displayed.\\n\\ \\n\\ Given one argument, return the value of the option \@var{opt}.\\n\\ \\n\\ When called with two arguments, \@code{$OPT_FCN_NAME} sets the option\\n\\ \@var{opt} to value \@var{val}."; } } ## FIXME: What does this routine do? And can it be simpler to understand? sub get_min_match_len_info { my ($i, $j, $k); for ($i = 0; $i < $OPT_NUM; $i++) { for ($j = 0; $j < $MAX_TOKENS; $j++) { $MIN_TOK_LEN_TO_MATCH[$i][$j] = 0; } $MIN_TOKS_TO_MATCH[$i] = 1; L1: for ($k = 0; $k < $OPT_NUM; $k++) { my $duplicate = 1; if ($i != $k) { L2: for ($j = 0; $j < $MAX_TOKENS; $j++) { if ($j < $N_TOKS[$i]) { if ($KW_TOK[$i][$j] eq $KW_TOK[$k][$j]) { if ($MIN_TOK_LEN_TO_MATCH[$i][$j] == 0) { $MIN_TOK_LEN_TO_MATCH[$i][$j] = 1; } $MIN_TOKS_TO_MATCH[$i]++; } else { $duplicate = 0; if ($MIN_TOK_LEN_TO_MATCH[$i][$j] == 0) { $MIN_TOK_LEN_TO_MATCH[$i][$j] = 1; } my @s = split (//, $KW_TOK[$i][$j]); my @t = split (//, $KW_TOK[$k][$j]); my ($n, $ii); $n = scalar (@s); $n = scalar (@t) if (@t < $n); for ($ii = 0; $ii < $n; $ii++) { if ("$s[$ii]" eq "$t[$ii]") { if ($ii + 2 > $MIN_TOK_LEN_TO_MATCH[$i][$j]) { $MIN_TOK_LEN_TO_MATCH[$i][$j]++; } } else { last L2; } } last L1; } } else { die qq|ambiguous options "$NAME[$i]" and "$NAME[$k]"| if $duplicate; } } } } } } # end of get_min_match_len_info sub emit_copy_body { my ($pfx, $var) = @_; for (my $i = 0; $i < $OPT_NUM; $i++) { print "${pfx}$OPTVAR[$i] = ${var}.$OPTVAR[$i];\n"; } print "${pfx}reset = ${var}.reset;\n"; } ## To silence GCC warnings, we create an initialization list even ## though the init function actually does the work of initialization. sub emit_default_init_list { my ($prefix) = @_; print "$OPTVAR[0] (),\n" unless ($OPT_NUM == 0); for (my $i = 1; $i < $OPT_NUM; $i++) { print "${prefix}$OPTVAR[$i] (),\n"; } print "${prefix}reset ()\n"; } sub emit_copy_ctor_init_list { my ($prefix, $var) = @_; print "$OPTVAR[0] ($var.$OPTVAR[0]),\n" unless ($OPT_NUM == 0); for (my $i = 1; $i < $OPT_NUM; $i++) { print "${prefix}$OPTVAR[$i] ($var.$OPTVAR[$i]),\n"; } print "${prefix}reset ($var.reset)\n"; } sub emit_opt_class_header { my ($i, $s); print <<"_END_EMIT_OPT_CLASS_HEADER_"; // DO NOT EDIT! // Generated automatically from $DEFN_FILE. #if ! defined (octave_${CLASS_NAME}_h) #define octave_${CLASS_NAME}_h 1 #include "octave-config.h" #include <cfloat> #include <cmath> $INCLUDE class $CLASS_NAME { public: $CLASS_NAME (void) _END_EMIT_OPT_CLASS_HEADER_ print ' : '; emit_default_init_list (" "); print " { init (); } $CLASS_NAME (const ${CLASS_NAME}& opt) : "; emit_copy_ctor_init_list (" ", "opt"); print " { } ${CLASS_NAME}& operator = (const ${CLASS_NAME}& opt) { if (this != &opt) {\n"; emit_copy_body (' ', 'opt'); print " } return *this; } ~$CLASS_NAME (void) { }\n"; print "\n void init (void)\n {\n"; for ($i = 0; $i < $OPT_NUM; $i++) { if ($INIT_VALUE[$i]) { print " $OPTVAR[$i] = $INIT_VALUE[$i];\n"; } elsif ($INIT_BODY[$i]) { $s = substopt ($INIT_BODY[$i], $OPTVAR[$i], $OPT[$i], $TYPE[$i]); chomp ($s); $s =~ s/^\s*/ /g; $s =~ s/\n\s*/\n /g; print $s,"\n"; } } print " reset = true;\n", " }\n"; ## For backward compatibility and because set_options is probably ## a better name in some contexts: print "\n void set_options (const ${CLASS_NAME}& opt)\n", " {\n"; emit_copy_body (' ', 'opt'); print " }\n\n void set_default_options (void) { init (); }\n"; for ($i = 0; $i < $OPT_NUM; $i++) { if ($SET_EXPR[$i]) { emit_set_decl ($i); print "\n { $OPTVAR[$i] = $SET_EXPR[$i]; reset = true; }\n"; } elsif ($SET_BODY[$i]) { emit_set_decl ($i); $s = substopt ($SET_BODY[$i], $OPTVAR[$i], $OPT[$i], $TYPE[$i]); chomp ($s); $s = ' ' . $s; $s =~ s/\n/\n /g; print "\n {\n$s\n reset = true;\n }\n"; } elsif ($SET_CODE[$i]) { $s = substopt ($SET_CODE[$i], $OPTVAR[$i], $OPT[$i], $TYPE[$i]); chomp ($s); $s =~ s/^ //g; $s =~ s/\n /\n/g; print "\n",$s,"\n"; } } for ($i = 0; $i < $OPT_NUM; $i++) { print " $TYPE[$i] $OPT[$i] (void) const\n { return $OPTVAR[$i]; }\n\n"; } print "private:\n\n"; for ($i = 0; $i < $OPT_NUM; $i++) { print " $TYPE[$i] $OPTVAR[$i];\n"; } print "\nprotected:\n\n bool reset;\n};\n\n#endif\n"; } sub emit_set_decl { my ($i) = @_; print "\n void set_$OPT[$i] ($SET_ARG_TYPE[$i] val)"; } sub emit_opt_handler_fcns { my $header = $DEFN_FILE; $header =~ s/[.]\w*$/.h/; # replace .in with .h $header =~ s|^.*/([^/]*)$|$1|; # strip directory part print <<"_END_EMIT_OPT_HANDLER_FCNS_"; // DO NOT EDIT! // Generated automatically from $DEFN_FILE. #ifdef HAVE_CONFIG_H #include <config.h> #endif #include <iomanip> #include <iostream> #include "$header" #include "defun.h" #include "pr-output.h" #include "ovl.h" #include "utils.h" #include "pager.h" static $CLASS_NAME $STATIC_OBJECT_NAME; _END_EMIT_OPT_HANDLER_FCNS_ &emit_struct_decl; &emit_struct_def; &emit_print_function; &emit_set_functions; &emit_show_function; &emit_options_function; } sub emit_struct_decl { print <<"_END_PRINT_STRUCT_DECL_"; #define MAX_TOKENS $MAX_TOKENS struct $STRUCT_NAME { const char *keyword; const char *kw_tok[MAX_TOKENS + 1]; int min_len[MAX_TOKENS + 1]; int min_toks_to_match; }; _END_PRINT_STRUCT_DECL_ } sub emit_struct_def { my $i; print "#define NUM_OPTIONS $OPT_NUM\n\n"; print "static $STRUCT_NAME $STATIC_TABLE_NAME [] =\n{\n"; for ($i = 0; $i < ($OPT_NUM - 1); $i++) { emit_option_table_entry ($i, 0); print "\n"; } emit_option_table_entry ($i, 0); print "};\n\n"; } sub emit_option_table_entry { my ($i, $empty) = @_; my $k; if ($empty) { print " { 0,\n"; } else { print " { \"$NAME[$i]\",\n"; } my $n = scalar $#{$KW_TOK[$i]}; print " {"; for $k (0 .. $MAX_TOKENS) { if ($empty or $k > $n) { print " 0,"; } else { print " \"$KW_TOK[$i][$k]\","; } } print " },\n"; print " {"; for $k (0 .. $MAX_TOKENS) { if ($empty or $k > $n) { print " 0,"; } else { print " $MIN_TOK_LEN_TO_MATCH[$i][$k],"; } } print " }, $MIN_TOKS_TO_MATCH[$i], "; print "},\n"; } sub emit_print_function { ## FIXME: determine the width of the table automatically. print qq|static void print_$CLASS_NAME (std::ostream& os) { std::ostringstream buf; os << "\\n" << "Options for $CLASS include:\\n\\n" << " keyword value\\n" << " ------- -----\\n"; $STRUCT_NAME *list = $STATIC_TABLE_NAME;\n\n|; for (my $i = 0; $i < $OPT_NUM; $i++) { print qq| {\n os << " " << std::setiosflags (std::ios::left) << std::setw (50) << list[$i].keyword << std::resetiosflags (std::ios::left) << " ";\n\n|; if ($TYPE[$i] eq "double") { print qq| double val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n|; print qq| os << val << "\\n";\n|; } elsif ($TYPE[$i] eq "float") { print qq| float val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n|; print qq| os << val << "\\n";\n|; } elsif ($TYPE[$i] eq "int" or $TYPE[$i] eq "octave_idx_type") { print qq| int val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n|; print qq| os << val << "\\n";\n|; } elsif ($TYPE[$i] eq "std::string") { print qq| os << $STATIC_OBJECT_NAME.$OPT[$i] () << "\\n";\n|; } elsif ($TYPE[$i] eq "Array<int>" or $TYPE[$i] eq "Array<octave_idx_type>") { my $elt_type; if ($TYPE[$i] eq "Array<int>") { $elt_type = "int"; } else { $elt_type = "octave_idx_type"; } print qq| Array<$elt_type> val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n|; print qq| if (val.numel () == 1) { os << val(0) << "\\n"; } else { os << "\\n\\n"; octave_idx_type len = val.numel (); Matrix tmp (len, 1); for (octave_idx_type i = 0; i < len; i++) tmp(i,0) = val(i); octave_print_internal (os, tmp, false, 2); os << "\\n\\n"; }\n|; } elsif ($TYPE[$i] eq "Array<double>") { print qq| Array<double> val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n|; print qq| if (val.numel () == 1) { os << val(0) << "\\n"; } else { os << "\\n\\n"; Matrix tmp = Matrix (ColumnVector (val)); octave_print_internal (os, tmp, false, 2); os << "\\n\\n"; }\n|; } elsif ($TYPE[$i] eq "Array<float>") { print qq| Array<float> val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n|; print qq| if (val.numel () == 1) { os << val(0) << "\\n"; } else { os << "\\n\\n"; FloatMatrix tmp = FloatMatrix (FloatColumnVector (val)); octave_print_internal (os, tmp, false, 2); os << "\\n\\n"; }\n|; } else { die ("unknown type $TYPE[$i]"); } print " }\n\n"; } print qq| os << "\\n";\n}\n\n|; } sub emit_set_functions { print "static void set_$CLASS_NAME (const std::string& keyword, const octave_value& val) { $STRUCT_NAME *list = $STATIC_TABLE_NAME;\n\n"; my $iftok = "if"; for (my $i = 0; $i < $OPT_NUM; $i++) { $iftok = "else if" if ($i > 0); print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, keyword, list[$i].min_toks_to_match, MAX_TOKENS)) {\n"; if ($TYPE[$i] eq "double") { print " double tmp = val.double_value ();\n\n"; print " $STATIC_OBJECT_NAME.set_$OPT[$i] (tmp);\n"; } elsif ($TYPE[$i] eq "float") { print " float tmp = val.float_value ();\n\n"; print " $STATIC_OBJECT_NAME.set_$OPT[$i] (tmp);\n"; } elsif ($TYPE[$i] eq "int" or $TYPE[$i] eq "octave_idx_type") { print " int tmp = val.int_value ();\n\n"; print " $STATIC_OBJECT_NAME.set_$OPT[$i] (tmp);\n"; } elsif ($TYPE[$i] eq "std::string") { print " std::string tmp = val.string_value ();\n\n"; print " $STATIC_OBJECT_NAME.set_$OPT[$i] (tmp);\n"; } elsif ($TYPE[$i] eq "Array<int>" or $TYPE[$i] eq "Array<octave_idx_type>") { print " Array<int> tmp = val.int_vector_value ();\n\n"; print " $STATIC_OBJECT_NAME.set_$OPT[$i] (tmp);\n"; } elsif ($TYPE[$i] eq "Array<double>") { print " Array<double> tmp = val.vector_value ();\n\n"; print " $STATIC_OBJECT_NAME.set_$OPT[$i] (tmp);\n"; } elsif ($TYPE[$i] eq "Array<float>") { print " Array<float> tmp = val.float_vector_value ();\n\n"; print " $STATIC_OBJECT_NAME.set_$OPT[$i] (tmp);\n"; } else { die ("unknown type $TYPE[$i]"); } print " }\n"; } print qq| else { warning ("$OPT_FCN_NAME: no match for `%s'", keyword.c_str ()); } }\n\n|; } sub emit_show_function { print "static octave_value_list show_$CLASS_NAME (const std::string& keyword) { octave_value retval; $STRUCT_NAME *list = $STATIC_TABLE_NAME;\n\n"; my $iftok = "if"; for (my $i = 0; $i < $OPT_NUM; $i++) { $iftok = "else if" if ($i > 0); print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, keyword, list[$i].min_toks_to_match, MAX_TOKENS)) {\n"; if ($TYPE[$i] eq "double") { print " double val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n"; print " retval = val;\n"; } elsif ($TYPE[$i] eq "float") { print " float val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n"; print " retval = val;\n"; } elsif ($TYPE[$i] eq "int" or $TYPE[$i] eq "octave_idx_type") { print " int val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n"; print " retval = static_cast<double> (val);\n"; } elsif ($TYPE[$i] eq "std::string") { print " retval = $STATIC_OBJECT_NAME.$OPT[$i] ();\n"; } elsif ($TYPE[$i] eq "Array<int>" or $TYPE[$i] eq "Array<octave_idx_type>") { my $elt_type; if ($TYPE[$i] eq "Array<int>") { $elt_type = "int"; } else { $elt_type = "octave_idx_type"; } print " Array<$elt_type> val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n"; print " if (val.numel () == 1) { retval = static_cast<double> (val(0)); } else { octave_idx_type len = val.numel (); ColumnVector tmp (len); for (octave_idx_type i = 0; i < len; i++) tmp(i) = val(i); retval = tmp; }\n"; } elsif ($TYPE[$i] eq "Array<double>") { print " Array<double> val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n"; print " if (val.numel () == 1) { retval = val(0); } else { retval = ColumnVector (val); }\n"; } elsif ($TYPE[$i] eq "Array<float>") { print " Array<float> val = $STATIC_OBJECT_NAME.$OPT[$i] ();\n\n"; print " if (val.numel () == 1) { retval = val(0); } else { retval = FloatColumnVector (val); }\n"; } else { die ("unknown type $TYPE[$i]"); } print " }\n"; } print qq| else { warning ("$OPT_FCN_NAME: no match for `%s'", keyword.c_str ()); } return retval;\n}\n\n|; } sub emit_options_function { print <<"_END_EMIT_OPTIONS_FUNCTION_HDR_"; DEFUN ($OPT_FCN_NAME, args, , "-*- texinfo -*-\\n\\ \@deftypefn {} {} $OPT_FCN_NAME ()\\n\\ \@deftypefnx {} {val =} $OPT_FCN_NAME (\@var{opt})\\n\\ \@deftypefnx {} {} $OPT_FCN_NAME (\@var{opt}, \@var{val})\\n\\ $DOC_STRING\\n\\ \\n\\ Options include\\n\\ \\n\\ \@table \@code\\n\\ _END_EMIT_OPTIONS_FUNCTION_HDR_ # FIXME: Add extra newline above for (my $i = 0; $i < $OPT_NUM; $i++) { print '@item @qcode{\"', $NAME[$i], '\"}\n\\', "\n"; print $DOC_ITEM[$i] if $DOC_ITEM[$i]; } print <<"_END_EMIT_OPTIONS_FUNCTION_BODY_"; \@end table\\n\\ \@end deftypefn") { octave_value_list retval; int nargin = args.length (); if (nargin > 2) print_usage (); if (nargin == 0) { print_$CLASS_NAME (octave_stdout); } else { std::string keyword = args(0).xstring_value ("$OPT_FCN_NAME: expecting keyword as first argument"); if (nargin == 1) retval = show_$CLASS_NAME (keyword); else set_$CLASS_NAME (keyword, args(1)); } return retval; } _END_EMIT_OPTIONS_FUNCTION_BODY_ } sub emit_options_debug { print qq|CLASS = "$CLASS"\n|; for (my $i = 0; $i < $OPT_NUM; $i++) { print "\nOPTION\n"; print qq| NAME = "$NAME[$i]"\n|; print qq| TYPE = "$TYPE[$i]"\n|; if ($SET_ARG_TYPE[$i]) { print eval ("\" SET_ARG_TYPE = \\\"$SET_ARG_TYPE[$i]\\\"\"") . "\n"; } if ($INIT_VALUE[$i]) { print qq| INIT_VALUE = "$INIT_VALUE[$i]"\n|; } if ($INIT_BODY[$i]) { print " INIT_BODY\n"; print &substopt ($INIT_BODY[$i]); print " END_INIT_BODY\n"; } if ($SET_EXPR[$i]) { print qq| SET_EXPR = "$SET_EXPR[$i]"\n|; } if ($SET_BODY[$i]) { print " SET_BODY\n"; print &substopt ($SET_BODY[$i]); print " END_SET_BODY\n"; } if ($SET_CODE[$i]) { print " SET_CODE\n"; print &substopt ($SET_CODE[$i]); print " END_SET_CODE\n"; } print "END_OPTION\n"; } } sub substopt { my ($string, $optvar, $opt, $type) = @_; $string =~ s/\$OPTVAR/$optvar/g; $string =~ s/\$OPT/$opt/g; $string =~ s/\$TYPE/$type/g; return $string; } sub max { my $max = shift; foreach (@_) { $max = $_ if $max < $_; } return $max; } ################################################################################ # Subroutine processes any command line arguments ################################################################################ sub parse_options { my $result; $opt_help = 0; $opt_class_header = 0; $opt_handler_fcns = 0; $opt_debug = 0; $result = GetOptions ("opt-class-header" => \$opt_class_header, "opt-handler-fcns" => \$opt_handler_fcns, "debug" => \$opt_debug, "help" => \$opt_help); # give user info if options incorrect or -h(elp) given &usage_info if (!$result or (@ARGV != 1) or $opt_help); if ($opt_class_header and $opt_handler_fcns) { die "Only one of [-opt-class-header | -opt-handler-fcns ] may be specified"; } } ################################################################################ # Subroutine displays usage information ################################################################################ sub usage_info { warn <<_END_OF_USAGE_; ////////////////////////////////////////////////////////////////////////////// USAGE : mk-opts.pl -opt-class-header|-opt-handler-fcns [-debug] [-help] DEFN_FILE ////////////////////////////////////////////////////////////////////////////// Automatically generate C++ code for option handling code (DASSL, DASRT, etc.) from definition file. See the head of mk-opts.pl for a description of the format that is parsed. _END_OF_USAGE_ exit(1); # exit with error code }