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('    const ex & ${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
 124 /*
 125  *  This file was generated automatically by structure.pl.
 126  *  Please do not modify it directly, edit the perl script instead!
 127  *
 128  *  GiNaC Copyright (C) 1999-2001 Johannes Gutenberg University Mainz, Germany
 129  *
 130  *  This program is free software; you can redistribute it and/or modify
 131  *  it under the terms of the GNU General Public License as published by
 132  *  the Free Software Foundation; either version 2 of the License, or
 133  *  (at your option) any later version.
 134  *
 135  *  This program is distributed in the hope that it will be useful,
 136  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 137  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 138  *  GNU General Public License for more details.
 139  *
 140  *  You should have received a copy of the GNU General Public License
 141  *  along with this program; if not, write to the Free Software
 142  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 143  */
 144
 145 // structure.pl input:
 146 ${input_structure}
 147
 148 #ifndef __GINAC_${STRUCTURE_UC}_H__
 149 #define __GINAC_${STRUCTURE_UC}_H__
 150
 151 #include "structure.h"
 152
 153 namespace GiNaC {
 154
 155 class ${STRUCTURE} : public structure
 156 {
 157 // member functions
 158
 159         // default ctor, dtor, copy ctor assignment operator and helpers
 160 public:
 161         ${STRUCTURE}();
 162         ~${STRUCTURE}();
 163         ${STRUCTURE}(${STRUCTURE} const & other);
 164         ${STRUCTURE} const & operator=(${STRUCTURE} const & other);
 165 protected:
 166         void copy(${STRUCTURE} const & other);
 167         void destroy(bool call_parent);
 168
 169         // other ctors
 170 public:
 171         ${STRUCTURE}(${constructor_arglist});
 172
 173         // functions overriding virtual functions from base classes
 174 public:
 175         basic * duplicate() const;
 176         void print(const print_context & c, unsigned level = 0) const;
 177         int nops() const;
 178         ex & let_op(int i);
 179         ex expand(unsigned options=0) const;
 180         bool has(const ex & other) const;
 181         ex eval(int level=0) const;
 182         ex evalf(int level=0) const;
 183         ex normal(lst &sym_lst, lst &repl_lst, int level=0) const;
 184         ex diff(const symbol & s) const;
 185         ex subs(const lst & ls, const lst & lr) const;
 186 protected:
 187         int compare_same_type(const basic & other) const;
 188         bool is_equal_same_type(const basic & other) const;
 189         unsigned return_type(void) const;
 190
 191         // new virtual functions which can be overridden by derived classes
 192         // none
 193
 194         // non-virtual functions in this class
 195 public:
 196 ${member_access_functions}
 197         bool types_ok(void) const;
 198
 199 // member variables
 200 protected:
 201 ${members}
 202 public:
 203 ${op_access_indices_decl}
 204 };
 205
 206 // global constants
 207
 208 extern const ${STRUCTURE} some_${STRUCTURE};
 209 extern const type_info & typeid_${STRUCTURE};
 210 extern const unsigned tinfo_${STRUCTURE};
 211
 212 } // namespace GiNaC
 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
 223 /*
 224  *  This file was generated automatically by STRUCTURE.pl.
 225  *  Please do not modify it directly, edit the perl script instead!
 226  *
 227  *  GiNaC Copyright (C) 1999-2001 Johannes Gutenberg University Mainz, Germany
 228  *
 229  *  This program is free software; you can redistribute it and/or modify
 230  *  it under the terms of the GNU General Public License as published by
 231  *  the Free Software Foundation; either version 2 of the License, or
 232  *  (at your option) any later version.
 233  *
 234  *  This program is distributed in the hope that it will be useful,
 235  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 236  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 237  *  GNU General Public License for more details.
 238  *
 239  *  You should have received a copy of the GNU General Public License
 240  *  along with this program; if not, write to the Free Software
 241  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 242  */
 243
 244 // structure.pl input:
 245 ${input_structure}
 246
 247 #include <iostream>
 248 #include <stdexcept>
 249
 250 #include "${STRUCTURE}.h"
 251 #include "print.h"
 252
 253 namespace GiNaC {
 254
 255 //////////
 256 // default ctor, destructor, copy ctor assignment operator and helpers
 257 //////////
 258
 259 // public
 260
 261 ${STRUCTURE}::${STRUCTURE}()
 262 {
 263         debugmsg("${STRUCTURE} default ctor",LOGLEVEL_CONSTRUCT);
 264         tinfo_key=tinfo_${STRUCTURE};
 265 }
 266
 267 ${STRUCTURE}::~${STRUCTURE}()
 268 {
 269         debugmsg("${STRUCTURE} destructor",LOGLEVEL_DESTRUCT);
 270         destroy(false);
 271 }
 272
 273 ${STRUCTURE}::${STRUCTURE}(${STRUCTURE} const & other)
 274 {
 275         debugmsg("${STRUCTURE} copy ctor",LOGLEVEL_CONSTRUCT);
 276         copy(other);
 277 }
 278
 279 ${STRUCTURE} const & ${STRUCTURE}::operator=(${STRUCTURE} const & other)
 280 {
 281         debugmsg("${STRUCTURE} operator=",LOGLEVEL_ASSIGNMENT);
 282         if (this != &other) {
 283                 destroy(true);
 284                 copy(other);
 285         }
 286         return *this;
 287 }
 288
 289 // protected
 290
 291 void ${STRUCTURE}::copy(${STRUCTURE} const & other)
 292 {
 293         structure::copy(other);
 294 ${copy_statements}
 295 }
 296
 297 void ${STRUCTURE}::destroy(bool call_parent)
 298 {
 299         if (call_parent) structure::destroy(call_parent);
 300 }
 301
 302 //////////
 303 // other ctors
 304 //////////
 305
 306 // public
 307
 308 ${STRUCTURE}::${STRUCTURE}(${constructor_arglist})
 309         : ${constructor_statements}
 310 {
 311         debugmsg("${STRUCTURE} ctor from children", LOGLEVEL_CONSTRUCT);
 312         tinfo_key=tinfo_${STRUCTURE};
 313 }
 314
 315 //////////
 316 // functions overriding virtual functions from base classes
 317 //////////
 318
 319 // public
 320
 321 basic * ${STRUCTURE}::duplicate() const
 322 {
 323         debugmsg("${STRUCTURE} duplicate",LOGLEVEL_DUPLICATE);
 324         return new ${STRUCTURE}(*this);
 325 }
 326
 327 void ${STRUCTURE}::print(const print_context & c, unsigned level) const
 328 {
 329         debugmsg("${STRUCTURE} print", LOGLEVEL_PRINT);
 330         c.s << class_name() << "()";
 331 }
 332
 333 int ${STRUCTURE}::nops() const
 334 {
 335         return ${number_of_members};
 336 }
 337
 338 ex & ${STRUCTURE}::let_op(int i)
 339 {
 340         GINAC_ASSERT(i>=0);
 341         GINAC_ASSERT(i<nops());
 342
 343         switch (i) {
 344 ${let_op_statements}
 345         }
 346         throw(std::runtime_error("${STRUCTURE}::let_op(): should not have reached this point"));
 347 }
 348
 349 ex ${STRUCTURE}::expand(unsigned options) const
 350 {
 351         bool all_are_trivially_equal=true;
 352 ${expand_statements}
 353         if (all_are_trivially_equal) {
 354                 return *this;
 355         }
 356         return ${STRUCTURE}(${temporary_arglist});
 357 }
 358
 359 // a ${STRUCTURE} 'has' an expression if it is this expression itself or a child 'has' it
 360
 361 bool ${STRUCTURE}::has(const ex & other) const
 362 {
 363         GINAC_ASSERT(other.bp!=0);
 364         if (is_equal(*other.bp)) return true;
 365 ${has_statements}
 366         return false;
 367 }
 368
 369 ex ${STRUCTURE}::eval(int level) const
 370 {
 371         if (level==1) {
 372                 return this->hold();
 373         }
 374         bool all_are_trivially_equal=true;
 375 ${eval_statements}
 376         if (all_are_trivially_equal) {
 377                 return this->hold();
 378         }
 379         return ${STRUCTURE}(${temporary_arglist});
 380 }
 381
 382 ex ${STRUCTURE}::evalf(int level) const
 383 {
 384         if (level==1) {
 385                 return *this;
 386         }
 387         bool all_are_trivially_equal=true;
 388 ${evalf_statements}
 389         if (all_are_trivially_equal) {
 390                 return *this;
 391         }
 392         return ${STRUCTURE}(${temporary_arglist});
 393 }
 394
 395 /** Implementation of ex::normal() for ${STRUCTURE}s. It normalizes the arguments
 396  *  and replaces the ${STRUCTURE} by a temporary symbol.
 397  *  \@see ex::normal */
 398 ex ${STRUCTURE}::normal(lst &sym_lst, lst &repl_lst, int level) const
 399 {
 400         if (level==1) {
 401                 return basic::normal(sym_lst,repl_lst,level);
 402         }
 403         bool all_are_trivially_equal=true;
 404 ${normal_statements}
 405         if (all_are_trivially_equal) {
 406                 return basic::normal(sym_lst,repl_lst,level);
 407         }
 408         ex n=${STRUCTURE}(${temporary_arglist});
 409         return n.bp->basic::normal(sym_lst,repl_lst,level);
 410 }
 411
 412 /** ${STRUCTURE}::diff() differentiates the children.
 413         there is no need to check for triavially equal, since diff usually
 414         does not return itself unevaluated. */
 415 ex ${STRUCTURE}::diff(const symbol & s) const
 416 {
 417 ${diff_statements}
 418         return ${STRUCTURE}(${temporary_arglist});
 419 }
 420
 421 ex ${STRUCTURE}::subs(const lst & ls, const lst & lr) const
 422 {
 423         bool all_are_trivially_equal=true;
 424 ${subs_statements}
 425         if (all_are_trivially_equal) {
 426                 return *this;
 427         }
 428         return ${STRUCTURE}(${temporary_arglist});
 429 }
 430
 431 // protected
 432
 433 int ${STRUCTURE}::compare_same_type(const basic & other) const
 434 {
 435         GINAC_ASSERT(is_of_type(other,${STRUCTURE}));
 436         ${STRUCTURE} const &o = static_cast<const ${STRUCTURE} &>(other);
 437         int cmpval;
 438 ${compare_statements}
 439         return 0;
 440 }
 441
 442 bool ${STRUCTURE}::is_equal_same_type(const basic & other) const
 443 {
 444         GINAC_ASSERT(is_of_type(other,${STRUCTURE}));
 445         ${STRUCTURE} const &o = static_cast<const ${STRUCTURE} &>(other);
 446 ${is_equal_statements}
 447         return true;
 448 }
 449
 450 unsigned ${STRUCTURE}::return_type(void) const
 451 {
 452         return return_types::noncommutative_composite;
 453 }
 454
 455 //////////
 456 // new virtual functions which can be overridden by derived classes
 457 //////////
 458
 459 // none
 460
 461 //////////
 462 // non-virtual functions in this class
 463 //////////
 464
 465 // public
 466
 467 #define SKIP_TYPE_CHECK_FOR_ex
 468 // this is a hack since there is no meaningful
 469 // is_ex_exactly_of_type(...,ex) macro definition
 470
 471 bool ${STRUCTURE}::types_ok(void) const
 472 {
 473 ${types_ok_statements}
 474         return true;
 475 }
 476
 477 //////////
 478 // static member variables
 479 //////////
 480
 481 ${op_access_indices_def}
 482
 483 //////////
 484 // global constants
 485 //////////
 486
 487 const ${STRUCTURE} some_${STRUCTURE};
 488 const type_info & typeid_${STRUCTURE}=typeid(some_${STRUCTURE});
 489 const unsigned tinfo_${STRUCTURE}=structure::register_new("${STRUCTURE}");
 490
 491 } // namespace GiNaC
 492
 493 END_OF_IMPLEMENTATION
 494
 495 print "Creating interface file ${STRUCTURE}.h...";
 496 open OUT,">${STRUCTURE}.h" or die "cannot open ${STRUCTURE}.h";
 497 print OUT $interface;
 498 close OUT;
 499 print "ok.\n";
 500
 501 print "Creating implementation file ${STRUCTURE}.cpp...";
 502 open OUT,">${STRUCTURE}.cpp" or die "cannot open ${STRUCTURE}.cpp";
 503 print OUT $implementation;
 504 close OUT;
 505 print "ok.\n";
 506
 507 print "done.\n";