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