4 $original_input_structure='';
6 $input_structure .= '// '.$_;
7 $original_input_structure .= $_;
10 $original_input_structure =~ tr/ \t\n\r\f/ /;
11 $original_input_structure =~ tr/ //s;
13 if ($original_input_structure =~ /^struct (\w+) ?\{ ?(.*)\}\;? ?$/) {
17 die "illegal struct, must match 'struct name { type var; /*comment*/ ...};': $original_input_structure";
20 # split off a part 'type var[,var...];' with a possible C-comment '/* ... */'
21 while ($decl =~ /^ ?(\w+) ([\w \,]+)\; ?((\/\*.*?\*\/)?)(.*)$/) {
26 while ($member =~ /^(\w+) ?\, ?(.*)$/) {
29 push @COMMENTS,$comment;
31 $comment='/* see above */';
35 if ($member !~ /^\w+$/) {
36 die "illegal struct, must match 'struct name { type var; /*comment*/ ...};': $input_structure";
39 push @MEMBERS,$member;
40 push @COMMENTS,$comment;
43 if ($decl !~ /^ ?$/) {
44 die "illegal struct, must match 'struct name { type var; /*comment*/ ...};': $input_structure";
47 #$STRUCTURE='teststruct';
48 $STRUCTURE_UC=uc(${STRUCTURE});
49 #@TYPES=('ex','ex','ex');
50 #@MEMBERS=('q10','q20','q21');
53 my ($template,$conj)=@_;
57 for ($N=1; $N<=$#MEMBERS+1; $N++) {
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) {
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(
82 ' return m_${MEMBER};'."\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});',
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});',
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});',
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});',
109 $compare_statements=generate(
110 ' cmpval=m_${MEMBER}.compare(o.m_${MEMBER});'."\n".
111 ' if (cmpval!=0) return cmpval;',
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");
119 $interface=<<END_OF_INTERFACE;
120 /** \@file ${STRUCTURE}.h
122 * Definition of GiNaC's user defined structure ${STRUCTURE}. */
125 * This file was generated automatically by structure.pl.
126 * Please do not modify it directly, edit the perl script instead!
128 * GiNaC Copyright (C) 1999-2000 Johannes Gutenberg University Mainz, Germany
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.
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.
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
145 // structure.pl input:
148 #ifndef __GINAC_${STRUCTURE_UC}_H__
149 #define __GINAC_${STRUCTURE_UC}_H__
151 #include "structure.h"
153 #ifndef NO_NAMESPACE_GINAC
155 #endif // ndef NO_NAMESPACE_GINAC
157 class ${STRUCTURE} : public structure
161 // default constructor, destructor, copy constructor assignment operator and helpers
165 ${STRUCTURE}(${STRUCTURE} const & other);
166 ${STRUCTURE} const & operator=(${STRUCTURE} const & other);
168 void copy(${STRUCTURE} const & other);
169 void destroy(bool call_parent);
171 // other constructors
173 ${STRUCTURE}(${constructor_arglist});
175 // functions overriding virtual functions from bases classes
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;
183 ex expand(unsigned options=0) const;
184 bool has(const ex & 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(const symbol & s) const;
189 ex subs(const lst & ls, const lst & lr) const;
191 int compare_same_type(const basic & other) const;
192 bool is_equal_same_type(const basic & other) const;
193 unsigned return_type(void) const;
195 // new virtual functions which can be overridden by derived classes
198 // non-virtual functions in this class
200 ${member_access_functions}
201 bool types_ok(void) const;
207 ${op_access_indices_decl}
212 extern const ${STRUCTURE} some_${STRUCTURE};
213 extern const type_info & typeid_${STRUCTURE};
214 extern const unsigned tinfo_${STRUCTURE};
218 #define ex_to_${STRUCTURE}(X) (static_cast<${STRUCTURE} const &>(*(X).bp))
220 #ifndef NO_NAMESPACE_GINAC
222 #endif // ndef NO_NAMESPACE_GINAC
224 #endif // ndef _${STRUCTURE_UC}_H_
228 $implementation=<<END_OF_IMPLEMENTATION;
229 /** \@file ${STRUCTURE}.cpp
231 * Implementation of GiNaC's user defined structure ${STRUCTURE}. */
234 * This file was generated automatically by STRUCTURE.pl.
235 * Please do not modify it directly, edit the perl script instead!
237 * GiNaC Copyright (C) 1999-2000 Johannes Gutenberg University Mainz, Germany
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.
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.
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
254 // structure.pl input:
259 #include "${STRUCTURE}.h"
261 #ifndef NO_NAMESPACE_GINAC
263 #endif // ndef NO_NAMESPACE_GINAC
266 // default constructor, destructor, copy constructor assignment operator and helpers
271 ${STRUCTURE}::${STRUCTURE}()
273 debugmsg("${STRUCTURE} default constructor",LOGLEVEL_CONSTRUCT);
274 tinfo_key=tinfo_${STRUCTURE};
277 ${STRUCTURE}::~${STRUCTURE}()
279 debugmsg("${STRUCTURE} destructor",LOGLEVEL_DESTRUCT);
283 ${STRUCTURE}::${STRUCTURE}(${STRUCTURE} const & other)
285 debugmsg("${STRUCTURE} copy constructor",LOGLEVEL_CONSTRUCT);
289 ${STRUCTURE} const & ${STRUCTURE}::operator=(${STRUCTURE} const & other)
291 debugmsg("${STRUCTURE} operator=",LOGLEVEL_ASSIGNMENT);
292 if (this != &other) {
301 void ${STRUCTURE}::copy(${STRUCTURE} const & other)
303 structure::copy(other);
307 void ${STRUCTURE}::destroy(bool call_parent)
309 if (call_parent) structure::destroy(call_parent);
313 // other constructors
318 ${STRUCTURE}::${STRUCTURE}(${constructor_arglist})
319 : ${constructor_statements}
321 debugmsg("${STRUCTURE} constructor from children", LOGLEVEL_CONSTRUCT);
322 tinfo_key=tinfo_${STRUCTURE};
326 // functions overriding virtual functions from bases classes
331 basic * ${STRUCTURE}::duplicate() const
333 debugmsg("${STRUCTURE} duplicate",LOGLEVEL_DUPLICATE);
334 return new ${STRUCTURE}(*this);
337 void ${STRUCTURE}::printraw(ostream & os) const
339 debugmsg("${STRUCTURE} printraw",LOGLEVEL_PRINT);
340 os << "${STRUCTURE}()";
343 void ${STRUCTURE}::print(ostream & os, unsigned upper_precedence) const
345 debugmsg("${STRUCTURE} print",LOGLEVEL_PRINT);
346 os << "${STRUCTURE}()";
349 void ${STRUCTURE}::printtree(ostream & os, unsigned indent) const
351 debugmsg("${STRUCTURE} printtree",LOGLEVEL_PRINT);
352 os << "${STRUCTURE}()";
355 int ${STRUCTURE}::nops() const
357 return ${number_of_members};
360 ex & ${STRUCTURE}::let_op(int i)
363 GINAC_ASSERT(i<nops());
368 errormsg("${STRUCTURE}::let_op(): should not reach this point");
369 return *new ex(fail());
372 ex ${STRUCTURE}::expand(unsigned options) const
374 bool all_are_trivially_equal=true;
376 if (all_are_trivially_equal) {
379 return ${STRUCTURE}(${temporary_arglist});
382 // a ${STRUCTURE} 'has' an expression if it is this expression itself or a child 'has' it
384 bool ${STRUCTURE}::has(const ex & other) const
386 GINAC_ASSERT(other.bp!=0);
387 if (is_equal(*other.bp)) return true;
392 ex ${STRUCTURE}::eval(int level) const
397 bool all_are_trivially_equal=true;
399 if (all_are_trivially_equal) {
402 return ${STRUCTURE}(${temporary_arglist});
405 ex ${STRUCTURE}::evalf(int level) const
410 bool all_are_trivially_equal=true;
412 if (all_are_trivially_equal) {
415 return ${STRUCTURE}(${temporary_arglist});
418 /** Implementation of ex::normal() for ${STRUCTURE}s. It normalizes the arguments
419 * and replaces the ${STRUCTURE} by a temporary symbol.
420 * \@see ex::normal */
421 ex ${STRUCTURE}::normal(lst &sym_lst, lst &repl_lst, int level) const
424 return basic::normal(sym_lst,repl_lst,level);
426 bool all_are_trivially_equal=true;
428 if (all_are_trivially_equal) {
429 return basic::normal(sym_lst,repl_lst,level);
431 ex n=${STRUCTURE}(${temporary_arglist});
432 return n.bp->basic::normal(sym_lst,repl_lst,level);
435 /** ${STRUCTURE}::diff() differentiates the children.
436 there is no need to check for triavially equal, since diff usually
437 does not return itself unevaluated. */
438 ex ${STRUCTURE}::diff(const symbol & s) const
441 return ${STRUCTURE}(${temporary_arglist});
444 ex ${STRUCTURE}::subs(const lst & ls, const lst & lr) const
446 bool all_are_trivially_equal=true;
448 if (all_are_trivially_equal) {
451 return ${STRUCTURE}(${temporary_arglist});
456 int ${STRUCTURE}::compare_same_type(const basic & other) const
458 GINAC_ASSERT(is_of_type(other,${STRUCTURE}));
459 ${STRUCTURE} const & o=static_cast<${STRUCTURE} const &>
460 (const_cast<basic &>(other));
462 ${compare_statements}
466 bool ${STRUCTURE}::is_equal_same_type(const basic & other) const
468 GINAC_ASSERT(is_of_type(other,${STRUCTURE}));
469 ${STRUCTURE} const & o=static_cast<${STRUCTURE} const &>
470 (const_cast<basic &>(other));
471 ${is_equal_statements}
475 unsigned ${STRUCTURE}::return_type(void) const
477 return return_types::noncommutative_composite;
481 // new virtual functions which can be overridden by derived classes
487 // non-virtual functions in this class
492 #define SKIP_TYPE_CHECK_FOR_ex
493 // this is a hack since there is no meaningful
494 // is_ex_exactly_of_type(...,ex) macro definition
496 bool ${STRUCTURE}::types_ok(void) const
498 ${types_ok_statements}
503 // static member variables
506 ${op_access_indices_def}
512 const ${STRUCTURE} some_${STRUCTURE};
513 const type_info & typeid_${STRUCTURE}=typeid(some_${STRUCTURE});
514 const unsigned tinfo_${STRUCTURE}=structure::register_new("${STRUCTURE}");
516 #ifndef NO_NAMESPACE_GINAC
518 #endif // ndef NO_NAMESPACE_GINAC
520 END_OF_IMPLEMENTATION
522 print "Creating interface file ${STRUCTURE}.h...";
523 open OUT,">${STRUCTURE}.h" or die "cannot open ${STRUCTURE}.h";
524 print OUT $interface;
528 print "Creating implementation file ${STRUCTURE}.cpp...";
529 open OUT,">${STRUCTURE}.cpp" or die "cannot open ${STRUCTURE}.cpp";
530 print OUT $implementation;