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