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
 127 // structure.pl input:
 128 ${input_structure}
 129
 130 #ifndef _${STRUCTURE_UC}_H_
 131 #define _${STRUCTURE_UC}_H_
 132
 133 #include <ginac/ginac.h>
 134
 135 class ${STRUCTURE} : public structure
 136 {
 137 // member functions
 138
 139     // default constructor, destructor, copy constructor assignment operator and helpers
 140 public:
 141     ${STRUCTURE}();
 142     ~${STRUCTURE}();
 143     ${STRUCTURE}(${STRUCTURE} const & other);
 144     ${STRUCTURE} const & operator=(${STRUCTURE} const & other);
 145 protected:
 146     void copy(${STRUCTURE} const & other);
 147     void destroy(bool call_parent);
 148
 149     // other constructors
 150 public:
 151     ${STRUCTURE}(${constructor_arglist});
 152
 153     // functions overriding virtual functions from bases classes
 154 public:
 155     basic * duplicate() const;
 156     void printraw(ostream & os) const;
 157     void print(ostream & os, unsigned upper_precedence=0) const;
 158     void printtree(ostream & os, unsigned indent) const;
 159     int nops() const;
 160     ex & let_op(int const i);
 161     ex expand(unsigned options=0) const;
 162     bool has(ex const & other) const;
 163     ex eval(int level=0) const;
 164     ex evalf(int level=0) const;
 165     ex normal(lst &sym_lst, lst &repl_lst, int level=0) const;
 166     ex diff(symbol const & s) const;
 167     ex subs(lst const & ls, lst const & lr) const;
 168 protected:
 169     int compare_same_type(basic const & other) const;
 170     bool is_equal_same_type(basic const & other) const;
 171     unsigned return_type(void) const;
 172
 173     // new virtual functions which can be overridden by derived classes
 174     // none
 175
 176     // non-virtual functions in this class
 177 public:
 178 ${member_access_functions}
 179     bool types_ok(void) const;
 180
 181 // member variables
 182 protected:
 183 ${members}
 184 public:
 185 ${op_access_indices_decl}
 186 };
 187
 188 // global constants
 189
 190 extern const ${STRUCTURE} some_${STRUCTURE};
 191 extern type_info const & typeid_${STRUCTURE};
 192 extern const unsigned tinfo_${STRUCTURE};
 193
 194 // macros
 195
 196 #define ex_to_${STRUCTURE}(X) (static_cast<${STRUCTURE} const &>(*(X).bp))
 197
 198 #endif // ndef _${STRUCTURE_UC}_H_
 199
 200 END_OF_INTERFACE
 201
 202 $implementation=<<END_OF_IMPLEMENTATION;
 203 /** \@file ${STRUCTURE}.cpp
 204  *
 205  *  Implementation of GiNaC's user defined structure ${STRUCTURE}.
 206  *  This file was generated automatically by STRUCTURE.pl.
 207  *  Please do not modify it directly, edit the perl script instead!
 208  */
 209
 210 // structure.pl input:
 211 ${input_structure}
 212
 213 #include <iostream>
 214
 215 #include "ginac.h"
 216
 217 //////////
 218 // default constructor, destructor, copy constructor assignment operator and helpers
 219 //////////
 220
 221 // public
 222
 223 ${STRUCTURE}::${STRUCTURE}()
 224 {
 225     debugmsg("${STRUCTURE} default constructor",LOGLEVEL_CONSTRUCT);
 226     tinfo_key=tinfo_${STRUCTURE};
 227 }
 228
 229 ${STRUCTURE}::~${STRUCTURE}()
 230 {
 231     debugmsg("${STRUCTURE} destructor",LOGLEVEL_DESTRUCT);
 232     destroy(0);
 233 }
 234
 235 ${STRUCTURE}::${STRUCTURE}(${STRUCTURE} const & other)
 236 {
 237     debugmsg("${STRUCTURE} copy constructor",LOGLEVEL_CONSTRUCT);
 238     copy(other);
 239 }
 240
 241 ${STRUCTURE} const & ${STRUCTURE}::operator=(${STRUCTURE} const & other)
 242 {
 243     debugmsg("${STRUCTURE} operator=",LOGLEVEL_ASSIGNMENT);
 244     if (this != &other) {
 245         destroy(1);
 246         copy(other);
 247     }
 248     return *this;
 249 }
 250
 251 // protected
 252
 253 void ${STRUCTURE}::copy(${STRUCTURE} const & other)
 254 {
 255     structure::copy(other);
 256 ${copy_statements}
 257 }
 258
 259 void ${STRUCTURE}::destroy(bool call_parent)
 260 {
 261     if (call_parent) structure::destroy(call_parent);
 262 }
 263
 264 //////////
 265 // other constructors
 266 //////////
 267
 268 // public
 269
 270 ${STRUCTURE}::${STRUCTURE}(${constructor_arglist})
 271     : ${constructor_statements}
 272 {
 273     debugmsg("${STRUCTURE} constructor from children",
 274              LOGLEVEL_CONSTRUCT);
 275     tinfo_key=tinfo_${STRUCTURE};
 276 }
 277
 278 //////////
 279 // functions overriding virtual functions from bases classes
 280 //////////
 281
 282 // public
 283
 284 basic * ${STRUCTURE}::duplicate() const
 285 {
 286     debugmsg("${STRUCTURE} duplicate",LOGLEVEL_DUPLICATE);
 287     return new ${STRUCTURE}(*this);
 288 }
 289
 290 void ${STRUCTURE}::printraw(ostream & os) const
 291 {
 292     debugmsg("${STRUCTURE} printraw",LOGLEVEL_PRINT);
 293     os << "${STRUCTURE}()";
 294 }
 295
 296 void ${STRUCTURE}::print(ostream & os, unsigned upper_precedence) const
 297 {
 298     debugmsg("${STRUCTURE} print",LOGLEVEL_PRINT);
 299     os << "${STRUCTURE}()";
 300 }
 301
 302 void ${STRUCTURE}::printtree(ostream & os, unsigned indent) const
 303 {
 304     debugmsg("${STRUCTURE} printtree",LOGLEVEL_PRINT);
 305     os << "${STRUCTURE}()";
 306 }
 307
 308 int ${STRUCTURE}::nops() const
 309 {
 310     return ${number_of_members};
 311 }
 312
 313 ex & ${STRUCTURE}::let_op(int const i)
 314 {
 315     ASSERT(i>=0);
 316     ASSERT(i<nops());
 317
 318     switch (i) {
 319 ${let_op_statements}
 320     }
 321     errormsg("${STRUCTURE}::let_op(): should not reach this point");
 322     return *new ex(fail());
 323 }
 324
 325 ex ${STRUCTURE}::expand(unsigned options) const
 326 {
 327     bool all_are_trivially_equal=true;
 328 ${expand_statements}
 329     if (all_are_trivially_equal) {
 330         return *this;
 331     }
 332     return ${STRUCTURE}(${temporary_arglist});
 333 }
 334
 335 // a ${STRUCTURE} 'has' an expression if it is this expression itself or a child 'has' it
 336
 337 bool ${STRUCTURE}::has(ex const & other) const
 338 {
 339     ASSERT(other.bp!=0);
 340     if (is_equal(*other.bp)) return true;
 341 ${has_statements}
 342     return false;
 343 }
 344
 345 ex ${STRUCTURE}::eval(int level) const
 346 {
 347     if (level==1) {
 348         return this->hold();
 349     }
 350     bool all_are_trivially_equal=true;
 351 ${eval_statements}
 352     if (all_are_trivially_equal) {
 353         return this->hold();
 354     }
 355     return ${STRUCTURE}(${temporary_arglist});
 356 }
 357
 358 ex ${STRUCTURE}::evalf(int level) const
 359 {
 360     if (level==1) {
 361         return *this;
 362     }
 363     bool all_are_trivially_equal=true;
 364 ${evalf_statements}
 365     if (all_are_trivially_equal) {
 366         return *this;
 367     }
 368     return ${STRUCTURE}(${temporary_arglist});
 369 }
 370
 371 /** Implementation of ex::normal() for ${STRUCTURE}s. It normalizes the arguments
 372  *  and replaces the ${STRUCTURE} by a temporary symbol.
 373  *  \@see ex::normal */
 374 ex ${STRUCTURE}::normal(lst &sym_lst, lst &repl_lst, int level) const
 375 {
 376     if (level==1) {
 377         return basic::normal(sym_lst,repl_lst,level);
 378     }
 379     bool all_are_trivially_equal=true;
 380 ${normal_statements}
 381     if (all_are_trivially_equal) {
 382         return basic::normal(sym_lst,repl_lst,level);
 383     }
 384     ex n=${STRUCTURE}(${temporary_arglist});
 385     return n.bp->basic::normal(sym_lst,repl_lst,level);
 386 }
 387
 388 /** ${STRUCTURE}::diff() differentiates the children.
 389     there is no need to check for triavially equal, since diff usually
 390     does not return itself unevaluated. */
 391 ex ${STRUCTURE}::diff(symbol const & s) const
 392 {
 393 ${diff_statements}
 394     return ${STRUCTURE}(${temporary_arglist});
 395 }
 396
 397 ex ${STRUCTURE}::subs(lst const & ls, lst const & lr) const
 398 {
 399     bool all_are_trivially_equal=true;
 400 ${subs_statements}
 401     if (all_are_trivially_equal) {
 402         return *this;
 403     }
 404     return ${STRUCTURE}(${temporary_arglist});
 405 }
 406
 407 // protected
 408
 409 int ${STRUCTURE}::compare_same_type(basic const & other) const
 410 {
 411     ASSERT(is_of_type(other,${STRUCTURE}));
 412     ${STRUCTURE} const & o=static_cast<${STRUCTURE} const &>
 413                                     (const_cast<basic &>(other));
 414     int cmpval;
 415 ${compare_statements}
 416     return 0;
 417 }
 418
 419 bool ${STRUCTURE}::is_equal_same_type(basic const & other) const
 420 {
 421     ASSERT(is_of_type(other,${STRUCTURE}));
 422     ${STRUCTURE} const & o=static_cast<${STRUCTURE} const &>
 423                                     (const_cast<basic &>(other));
 424 ${is_equal_statements}
 425     return true;
 426 }
 427
 428 unsigned ${STRUCTURE}::return_type(void) const
 429 {
 430     return return_types::noncommutative_composite;
 431 }
 432
 433 //////////
 434 // new virtual functions which can be overridden by derived classes
 435 //////////
 436
 437 // none
 438
 439 //////////
 440 // non-virtual functions in this class
 441 //////////
 442
 443 // public
 444
 445 #define SKIP_TYPE_CHECK_FOR_ex
 446 // this is a hack since there is no meaningful
 447 // is_ex_exactly_of_type(...,ex) macro definition
 448
 449 bool ${STRUCTURE}::types_ok(void) const
 450 {
 451 ${types_ok_statements}
 452     return true;
 453 }
 454
 455 //////////
 456 // static member variables
 457 //////////
 458
 459 ${op_access_indices_def}
 460
 461 //////////
 462 // global constants
 463 //////////
 464
 465 const ${STRUCTURE} some_${STRUCTURE};
 466 type_info const & typeid_${STRUCTURE}=typeid(some_${STRUCTURE});
 467 const unsigned tinfo_${STRUCTURE}=structure::register_new("${STRUCTURE}");
 468
 469 END_OF_IMPLEMENTATION
 470
 471 print "Creating interface file ${STRUCTURE}.h...";
 472 open OUT,">${STRUCTURE}.h" or die "cannot open ${STRUCTURE}.h";
 473 print OUT $interface;
 474 close OUT;
 475 print "ok.\n";
 476
 477 print "Creating implementation file ${STRUCTURE}.cpp...";
 478 open OUT,">${STRUCTURE}.cpp" or die "cannot open ${STRUCTURE}.cpp";
 479 print OUT $implementation;
 480 close OUT;
 481 print "ok.\n";
 482
 483 print "done.\n";