ginac/structure.pl

   1 #!/usr/bin/perl -w
   2
   3 $input_structure='';
   4 $original_input_structure='';
   5 while (<>) {
   6     $input_structure .= '// '.$_;
   7     $original_input_structure .= $_;
   8 }
   9
  10 $original_input_structure =~ tr/ \t\n\r\f/     /;
  11 $original_input_structure =~ tr/ //s;
  12
  13 if ($original_input_structure =~ /^struct (\w+) ?\{ ?(.*)\}\;? ?$/) {
  14     $STRUCTURE=$1;
  15     $decl=$2;
  16 } else {
  17     die "illegal struct, must match 'struct name { type var; /*comment*/ ...};': $original_input_structure";
  18 }
  19
  20 # split off a part 'type var[,var...];' with a possible C-comment '/* ... */'
  21 while ($decl =~ /^ ?(\w+) ([\w \,]+)\; ?((\/\*.*?\*\/)?)(.*)$/) {
  22     $type=$1;
  23     $member=$2;
  24     $comment=$3;
  25     $decl=$5;
  26     while ($member =~ /^(\w+) ?\, ?(.*)$/) {
  27         push @TYPES,$type;
  28         push @MEMBERS,$1;
  29         push @COMMENTS,$comment;
  30         if ($comment ne '') {
  31             $comment='/* see above */';
  32         }
  33         $member=$2;
  34     }
  35     if ($member !~ /^\w$/) {
  36         die "illegal struct, must match 'struct name { type var; /*comment*/ ...};': $input_structure";
  37     }
  38     push @TYPES,$type;
  39     push @MEMBERS,$member;
  40     push @COMMENTS,$comment;
  41 }
  42
  43 if ($decl !~ /^ ?$/) {
  44     die "illegal struct, must match 'struct name { type var; /*comment*/ ...};': $input_structure";
  45 }
  46
  47 #$STRUCTURE='teststruct';
  48 $STRUCTURE_UC=uc(${STRUCTURE});
  49 #@TYPES=('ex','ex','ex');
  50 #@MEMBERS=('q10','q20','q21');
  51
  52 sub generate {
  53     my ($template,$conj)=@_;
  54     my ($res,$N);
  55
  56     $res='';
  57     for ($N=1; $N<=$#MEMBERS+1; $N++) {
  58         $TYPE=$TYPES[$N-1];
  59         $MEMBER=$MEMBERS[$N-1];
  60         $COMMENT=$COMMENTS[$N-1];
  61         $res .= eval('"' . $template . '"');
  62         $TYPE=''; # to avoid main::TYPE used only once warning
  63         $MEMBER=''; # same as above
  64         $COMMENT=''; # same as above
  65         if ($N!=$#MEMBERS+1) {
  66             $res .= $conj;
  67         }
  68     }
  69     return $res;
  70 }
  71
  72 $number_of_members=$#MEMBERS+1;
  73 $constructor_arglist=generate('ex tmp_${MEMBER}',', ');
  74 $member_access_functions=generate('    ex const & ${MEMBER}(void) { return m_${MEMBER}; }',"\n");
  75 $op_access_indices_decl=generate('    static unsigned op_${MEMBER};',"\n");
  76 $op_access_indices_def=generate('unsigned ${STRUCTURE}::op_${MEMBER}=${N}-1;',"\n");
  77 $members=generate('    ex m_${MEMBER}; ${COMMENT}',"\n");
  78 $copy_statements=generate('    m_${MEMBER}=other.m_${MEMBER};',"\n");
  79 $constructor_statements=generate('m_${MEMBER}(tmp_${MEMBER})',', ');
  80 $let_op_statements=generate(
  81 '    case ${N}-1:'."\n".
  82 '        return m_${MEMBER};'."\n".
  83 '        break;',
  84 "\n");
  85 $temporary_arglist=generate('tmp_${MEMBER}',', ');
  86 $expand_statements=generate('    ex tmp_${MEMBER}=m_${MEMBER}.expand(options);',"\n");
  87 $has_statements=generate('    if (m_${MEMBER}.has(other)) return true;',"\n");
  88 $eval_statements=generate(
  89 '    ex tmp_${MEMBER}=m_${MEMBER}.eval(level-1);'."\n".
  90 '    all_are_trivially_equal = all_are_trivially_equal &&'."\n".
  91 '                              are_ex_trivially_equal(tmp_${MEMBER},m_${MEMBER});',
  92 "\n");
  93 $evalf_statements=generate(
  94 '    ex tmp_${MEMBER}=m_${MEMBER}.evalf(level-1);'."\n".
  95 '    all_are_trivially_equal = all_are_trivially_equal &&'."\n".
  96 '                              are_ex_trivially_equal(tmp_${MEMBER},m_${MEMBER});',
  97 "\n");
  98 $normal_statements=generate(
  99 '    ex tmp_${MEMBER}=m_${MEMBER}.normal(level-1);'."\n".
 100 '    all_are_trivially_equal = all_are_trivially_equal &&'."\n".
 101 '                              are_ex_trivially_equal(tmp_${MEMBER},m_${MEMBER});',
 102 "\n");
 103 $diff_statements=generate('    ex tmp_${MEMBER}=m_${MEMBER}.diff(s);',"\n");
 104 $subs_statements=generate(
 105 '    ex tmp_${MEMBER}=m_${MEMBER}.subs(ls,lr);'."\n".
 106 '    all_are_trivially_equal = all_are_trivially_equal &&'."\n".
 107 '                              are_ex_trivially_equal(tmp_${MEMBER},m_${MEMBER});',
 108 "\n");
 109 $compare_statements=generate(
 110 '    cmpval=m_${MEMBER}.compare(o.m_${MEMBER});'."\n".
 111 '    if (cmpval!=0) return cmpval;',
 112 "\n");
 113 $is_equal_statements=generate('    if (!m_${MEMBER}.is_equal(o.m_${MEMBER})) return false;',"\n");
 114 $types_ok_statements=generate(
 115 '#ifndef SKIP_TYPE_CHECK_FOR_${TYPE}'."\n".
 116 '    if (!is_ex_exactly_of_type(m_${MEMBER},${TYPE})) return false;'."\n".
 117 '#endif // ndef SKIP_TYPE_CHECK_FOR_${TYPE}',"\n");
 118
 119 $interface=<<END_OF_INTERFACE;
 120 /** \@file ${STRUCTURE}.h
 121  *
 122  *  Definition of GiNaC's user defined structure ${STRUCTURE}.
 123  *  This file was generated automatically by structure.pl.
 124  *  Please do not modify it directly, edit the perl script instead!
 125  *
 126  *  GiNaC Copyright (C) 1999 Johannes Gutenberg University Mainz, Germany
 127  *
 128  *  This program is free software; you can redistribute it and/or modify
 129  *  it under the terms of the GNU General Public License as published by
 130  *  the Free Software Foundation; either version 2 of the License, or
 131  *  (at your option) any later version.
 132  *
 133  *  This program is distributed in the hope that it will be useful,
 134  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 135  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 136  *  GNU General Public License for more details.
 137  *
 138  *  You should have received a copy of the GNU General Public License
 139  *  along with this program; if not, write to the Free Software
 140  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 141  */
 142
 143 // structure.pl input:
 144 ${input_structure}
 145
 146 #ifndef __GINAC_${STRUCTURE_UC}_H__
 147 #define __GINAC_${STRUCTURE_UC}_H__
 148
 149 #include <ginac/ginac.h>
 150
 151 class ${STRUCTURE} : public structure
 152 {
 153 // member functions
 154
 155     // default constructor, destructor, copy constructor assignment operator and helpers
 156 public:
 157     ${STRUCTURE}();
 158     ~${STRUCTURE}();
 159     ${STRUCTURE}(${STRUCTURE} const & other);
 160     ${STRUCTURE} const & operator=(${STRUCTURE} const & other);
 161 protected:
 162     void copy(${STRUCTURE} const & other);
 163     void destroy(bool call_parent);
 164
 165     // other constructors
 166 public:
 167     ${STRUCTURE}(${constructor_arglist});
 168
 169     // functions overriding virtual functions from bases classes
 170 public:
 171     basic * duplicate() const;
 172     void printraw(ostream & os) const;
 173     void print(ostream & os, unsigned upper_precedence=0) const;
 174     void printtree(ostream & os, unsigned indent) const;
 175     int nops() const;
 176     ex & let_op(int const i);
 177     ex expand(unsigned options=0) const;
 178     bool has(ex const & other) const;
 179     ex eval(int level=0) const;
 180     ex evalf(int level=0) const;
 181     ex normal(lst &sym_lst, lst &repl_lst, int level=0) const;
 182     ex diff(symbol const & s) const;
 183     ex subs(lst const & ls, lst const & lr) const;
 184 protected:
 185     int compare_same_type(basic const & other) const;
 186     bool is_equal_same_type(basic const & other) const;
 187     unsigned return_type(void) const;
 188
 189     // new virtual functions which can be overridden by derived classes
 190     // none
 191
 192     // non-virtual functions in this class
 193 public:
 194 ${member_access_functions}
 195     bool types_ok(void) const;
 196
 197 // member variables
 198 protected:
 199 ${members}
 200 public:
 201 ${op_access_indices_decl}
 202 };
 203
 204 // global constants
 205
 206 extern const ${STRUCTURE} some_${STRUCTURE};
 207 extern type_info const & typeid_${STRUCTURE};
 208 extern const unsigned tinfo_${STRUCTURE};
 209
 210 // macros
 211
 212 #define ex_to_${STRUCTURE}(X) (static_cast<${STRUCTURE} const &>(*(X).bp))
 213
 214 #endif // ndef _${STRUCTURE_UC}_H_
 215
 216 END_OF_INTERFACE
 217
 218 $implementation=<<END_OF_IMPLEMENTATION;
 219 /** \@file ${STRUCTURE}.cpp
 220  *
 221  *  Implementation of GiNaC's user defined structure ${STRUCTURE}.
 222  *  This file was generated automatically by STRUCTURE.pl.
 223  *  Please do not modify it directly, edit the perl script instead!
 224  *
 225  *  GiNaC Copyright (C) 1999 Johannes Gutenberg University Mainz, Germany
 226  *
 227  *  This program is free software; you can redistribute it and/or modify
 228  *  it under the terms of the GNU General Public License as published by
 229  *  the Free Software Foundation; either version 2 of the License, or
 230  *  (at your option) any later version.
 231  *
 232  *  This program is distributed in the hope that it will be useful,
 233  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 234  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 235  *  GNU General Public License for more details.
 236  *
 237  *  You should have received a copy of the GNU General Public License
 238  *  along with this program; if not, write to the Free Software
 239  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 240  */
 241
 242 // structure.pl input:
 243 ${input_structure}
 244
 245 #include <iostream>
 246
 247 #include "ginac.h"
 248
 249 //////////
 250 // default constructor, destructor, copy constructor assignment operator and helpers
 251 //////////
 252
 253 // public
 254
 255 ${STRUCTURE}::${STRUCTURE}()
 256 {
 257     debugmsg("${STRUCTURE} default constructor",LOGLEVEL_CONSTRUCT);
 258     tinfo_key=tinfo_${STRUCTURE};
 259 }
 260
 261 ${STRUCTURE}::~${STRUCTURE}()
 262 {
 263     debugmsg("${STRUCTURE} destructor",LOGLEVEL_DESTRUCT);
 264     destroy(0);
 265 }
 266
 267 ${STRUCTURE}::${STRUCTURE}(${STRUCTURE} const & other)
 268 {
 269     debugmsg("${STRUCTURE} copy constructor",LOGLEVEL_CONSTRUCT);
 270     copy(other);
 271 }
 272
 273 ${STRUCTURE} const & ${STRUCTURE}::operator=(${STRUCTURE} const & other)
 274 {
 275     debugmsg("${STRUCTURE} operator=",LOGLEVEL_ASSIGNMENT);
 276     if (this != &other) {
 277         destroy(1);
 278         copy(other);
 279     }
 280     return *this;
 281 }
 282
 283 // protected
 284
 285 void ${STRUCTURE}::copy(${STRUCTURE} const & other)
 286 {
 287     structure::copy(other);
 288 ${copy_statements}
 289 }
 290
 291 void ${STRUCTURE}::destroy(bool call_parent)
 292 {
 293     if (call_parent) structure::destroy(call_parent);
 294 }
 295
 296 //////////
 297 // other constructors
 298 //////////
 299
 300 // public
 301
 302 ${STRUCTURE}::${STRUCTURE}(${constructor_arglist})
 303     : ${constructor_statements}
 304 {
 305     debugmsg("${STRUCTURE} constructor from children",
 306              LOGLEVEL_CONSTRUCT);
 307     tinfo_key=tinfo_${STRUCTURE};
 308 }
 309
 310 //////////
 311 // functions overriding virtual functions from bases classes
 312 //////////
 313
 314 // public
 315
 316 basic * ${STRUCTURE}::duplicate() const
 317 {
 318     debugmsg("${STRUCTURE} duplicate",LOGLEVEL_DUPLICATE);
 319     return new ${STRUCTURE}(*this);
 320 }
 321
 322 void ${STRUCTURE}::printraw(ostream & os) const
 323 {
 324     debugmsg("${STRUCTURE} printraw",LOGLEVEL_PRINT);
 325     os << "${STRUCTURE}()";
 326 }
 327
 328 void ${STRUCTURE}::print(ostream & os, unsigned upper_precedence) const
 329 {
 330     debugmsg("${STRUCTURE} print",LOGLEVEL_PRINT);
 331     os << "${STRUCTURE}()";
 332 }
 333
 334 void ${STRUCTURE}::printtree(ostream & os, unsigned indent) const
 335 {
 336     debugmsg("${STRUCTURE} printtree",LOGLEVEL_PRINT);
 337     os << "${STRUCTURE}()";
 338 }
 339
 340 int ${STRUCTURE}::nops() const
 341 {
 342     return ${number_of_members};
 343 }
 344
 345 ex & ${STRUCTURE}::let_op(int const i)
 346 {
 347     ASSERT(i>=0);
 348     ASSERT(i<nops());
 349
 350     switch (i) {
 351 ${let_op_statements}
 352     }
 353     errormsg("${STRUCTURE}::let_op(): should not reach this point");
 354     return *new ex(fail());
 355 }
 356
 357 ex ${STRUCTURE}::expand(unsigned options) const
 358 {
 359     bool all_are_trivially_equal=true;
 360 ${expand_statements}
 361     if (all_are_trivially_equal) {
 362         return *this;
 363     }
 364     return ${STRUCTURE}(${temporary_arglist});
 365 }
 366
 367 // a ${STRUCTURE} 'has' an expression if it is this expression itself or a child 'has' it
 368
 369 bool ${STRUCTURE}::has(ex const & other) const
 370 {
 371     ASSERT(other.bp!=0);
 372     if (is_equal(*other.bp)) return true;
 373 ${has_statements}
 374     return false;
 375 }
 376
 377 ex ${STRUCTURE}::eval(int level) const
 378 {
 379     if (level==1) {
 380         return this->hold();
 381     }
 382     bool all_are_trivially_equal=true;
 383 ${eval_statements}
 384     if (all_are_trivially_equal) {
 385         return this->hold();
 386     }
 387     return ${STRUCTURE}(${temporary_arglist});
 388 }
 389
 390 ex ${STRUCTURE}::evalf(int level) const
 391 {
 392     if (level==1) {
 393         return *this;
 394     }
 395     bool all_are_trivially_equal=true;
 396 ${evalf_statements}
 397     if (all_are_trivially_equal) {
 398         return *this;
 399     }
 400     return ${STRUCTURE}(${temporary_arglist});
 401 }
 402
 403 /** Implementation of ex::normal() for ${STRUCTURE}s. It normalizes the arguments
 404  *  and replaces the ${STRUCTURE} by a temporary symbol.
 405  *  \@see ex::normal */
 406 ex ${STRUCTURE}::normal(lst &sym_lst, lst &repl_lst, int level) const
 407 {
 408     if (level==1) {
 409         return basic::normal(sym_lst,repl_lst,level);
 410     }
 411     bool all_are_trivially_equal=true;
 412 ${normal_statements}
 413     if (all_are_trivially_equal) {
 414         return basic::normal(sym_lst,repl_lst,level);
 415     }
 416     ex n=${STRUCTURE}(${temporary_arglist});
 417     return n.bp->basic::normal(sym_lst,repl_lst,level);
 418 }
 419
 420 /** ${STRUCTURE}::diff() differentiates the children.
 421     there is no need to check for triavially equal, since diff usually
 422     does not return itself unevaluated. */
 423 ex ${STRUCTURE}::diff(symbol const & s) const
 424 {
 425 ${diff_statements}
 426     return ${STRUCTURE}(${temporary_arglist});
 427 }
 428
 429 ex ${STRUCTURE}::subs(lst const & ls, lst const & lr) const
 430 {
 431     bool all_are_trivially_equal=true;
 432 ${subs_statements}
 433     if (all_are_trivially_equal) {
 434         return *this;
 435     }
 436     return ${STRUCTURE}(${temporary_arglist});
 437 }
 438
 439 // protected
 440
 441 int ${STRUCTURE}::compare_same_type(basic const & other) const
 442 {
 443     ASSERT(is_of_type(other,${STRUCTURE}));
 444     ${STRUCTURE} const & o=static_cast<${STRUCTURE} const &>
 445                                     (const_cast<basic &>(other));
 446     int cmpval;
 447 ${compare_statements}
 448     return 0;
 449 }
 450
 451 bool ${STRUCTURE}::is_equal_same_type(basic const & other) const
 452 {
 453     ASSERT(is_of_type(other,${STRUCTURE}));
 454     ${STRUCTURE} const & o=static_cast<${STRUCTURE} const &>
 455                                     (const_cast<basic &>(other));
 456 ${is_equal_statements}
 457     return true;
 458 }
 459
 460 unsigned ${STRUCTURE}::return_type(void) const
 461 {
 462     return return_types::noncommutative_composite;
 463 }
 464
 465 //////////
 466 // new virtual functions which can be overridden by derived classes
 467 //////////
 468
 469 // none
 470
 471 //////////
 472 // non-virtual functions in this class
 473 //////////
 474
 475 // public
 476
 477 #define SKIP_TYPE_CHECK_FOR_ex
 478 // this is a hack since there is no meaningful
 479 // is_ex_exactly_of_type(...,ex) macro definition
 480
 481 bool ${STRUCTURE}::types_ok(void) const
 482 {
 483 ${types_ok_statements}
 484     return true;
 485 }
 486
 487 //////////
 488 // static member variables
 489 //////////
 490
 491 ${op_access_indices_def}
 492
 493 //////////
 494 // global constants
 495 //////////
 496
 497 const ${STRUCTURE} some_${STRUCTURE};
 498 type_info const & typeid_${STRUCTURE}=typeid(some_${STRUCTURE});
 499 const unsigned tinfo_${STRUCTURE}=structure::register_new("${STRUCTURE}");
 500
 501 END_OF_IMPLEMENTATION
 502
 503 print "Creating interface file ${STRUCTURE}.h...";
 504 open OUT,">${STRUCTURE}.h" or die "cannot open ${STRUCTURE}.h";
 505 print OUT $interface;
 506 close OUT;
 507 print "ok.\n";
 508
 509 print "Creating implementation file ${STRUCTURE}.cpp...";
 510 open OUT,">${STRUCTURE}.cpp" or die "cannot open ${STRUCTURE}.cpp";
 511 print OUT $implementation;
 512 close OUT;
 513 print "ok.\n";
 514
 515 print "done.\n";