]> www.ginac.de Git - ginac.git/blob - ginac/function.pl
- expressions can now be read from streams; the input expression can contain
[ginac.git] / ginac / function.pl
1 $maxargs=13;
2
3 sub generate_seq {
4     my ($seq_template,$n)=@_;
5     my ($res,$N);
6     
7     $res='';
8     for ($N=1; $N<=$n; $N++) {
9         $res .= eval('"' . $seq_template . '"');
10         if ($N!=$n) {
11             $res .= ', ';
12         }
13     }
14     return $res;
15 }
16
17 sub generate_from_to {
18     my ($template,$seq_template1,$seq_template2,$from,$to)=@_;
19     my ($res,$N,$SEQ);
20
21     $res='';
22     for ($N=$from; $N<=$to; $N++) {
23         $SEQ1=generate_seq($seq_template1,$N);
24         $SEQ2=generate_seq($seq_template2,$N);
25         $res .= eval('"' . $template . '"');
26         $SEQ1=''; # to avoid main::SEQ1 used only once warning
27         $SEQ2=''; # same as above
28     }
29     return $res;
30 }
31
32 sub generate {
33     my ($template,$seq_template1,$seq_template2)=@_;
34     return generate_from_to($template,$seq_template1,$seq_template2,1,$maxargs);
35 }
36
37 $declare_function_macro_namespace = <<'END_OF_DECLARE_FUNCTION_1_AND_2P_MACRO_NAMESPACE';
38 #ifdef CINT_CONVERSION_WORKAROUND
39
40 #define DECLARE_FUNCTION_1P(NAME) \
41 extern const unsigned function_index_##NAME; \
42 inline GiNaC::function NAME(const GiNaC::ex & p1) { \
43     return GiNaC::function(function_index_##NAME, p1); \
44 } \
45 inline GiNaC::function NAME(const GiNaC::basic & p1) { \
46     return GiNaC::function(function_index_##NAME, GiNaC::ex(p1)); \
47 }
48 #define DECLARE_FUNCTION_2P(NAME) \
49 extern const unsigned function_index_##NAME; \
50 inline GiNaC::function NAME(const GiNaC::ex & p1, const GiNaC::ex & p2) { \
51     return GiNaC::function(function_index_##NAME, p1, p2); \
52 } \
53 inline GiNaC::function NAME(const GiNaC::basic & p1, const GiNaC::ex & p2) { \
54     return GiNaC::function(function_index_##NAME, GiNaC::ex(p1), p2); \
55 } \
56 inline GiNaC::function NAME(const GiNaC::ex & p1, const GiNaC::basic & p2) { \
57     return GiNaC::function(function_index_##NAME, p1, GiNaC::ex(p2)); \
58 } \
59 inline GiNaC::function NAME(const GiNaC::basic & p1, const GiNaC::basic & p2) { \
60     return GiNaC::function(function_index_##NAME, GiNaC::ex(p1), GiNaC::ex(p2)); \
61 }
62
63 #else // def CINT_CONVERSION_WORKAROUND
64
65 #define DECLARE_FUNCTION_1P(NAME) \
66 extern const unsigned function_index_##NAME; \
67 inline GiNaC::function NAME(const GiNaC::ex & p1) { \
68     return GiNaC::function(function_index_##NAME, p1); \
69 }
70 #define DECLARE_FUNCTION_2P(NAME) \
71 extern const unsigned function_index_##NAME; \
72 inline GiNaC::function NAME(const GiNaC::ex & p1, const GiNaC::ex & p2) { \
73     return GiNaC::function(function_index_##NAME, p1, p2); \
74 }
75
76 #endif // def CINT_CONVERSION_WORKAROUND
77
78 END_OF_DECLARE_FUNCTION_1_AND_2P_MACRO_NAMESPACE
79
80 $declare_function_macro_namespace .= generate_from_to(
81     <<'END_OF_DECLARE_FUNCTION_MACRO_NAMESPACE','const GiNaC::ex & p${N}','p${N}',3,$maxargs);
82 #define DECLARE_FUNCTION_${N}P(NAME) \\
83 extern const unsigned function_index_##NAME; \\
84 inline GiNaC::function NAME(${SEQ1}) { \\
85     return GiNaC::function(function_index_##NAME, ${SEQ2}); \\
86 }
87
88 END_OF_DECLARE_FUNCTION_MACRO_NAMESPACE
89
90 $declare_function_macro_no_namespace = <<'END_OF_DECLARE_FUNCTION_1_AND_2P_MACRO_NO_NAMESPACE';
91 #ifdef CINT_CONVERSION_WORKAROUND
92
93 #define DECLARE_FUNCTION_1P(NAME) \
94 extern const unsigned function_index_##NAME; \
95 inline function NAME(const ex & p1) { \
96     return function(function_index_##NAME, p1); \
97 } \
98 inline function NAME(const basic & p1) { \
99     return function(function_index_##NAME, ex(p1)); \
100 }
101 #define DECLARE_FUNCTION_2P(NAME) \
102 extern const unsigned function_index_##NAME; \
103 inline function NAME(const ex & p1, const ex & p2) { \
104     return function(function_index_##NAME, p1, p2); \
105 } \
106 inline function NAME(const basic & p1, const ex & p2) { \
107     return function(function_index_##NAME, ex(p1), p2); \
108 } \
109 inline function NAME(const ex & p1, const basic & p2) { \
110     return function(function_index_##NAME, p1, ex(p2)); \
111 } \
112 inline function NAME(const basic & p1, const basic & p2) { \
113     return function(function_index_##NAME, ex(p1), ex(p2)); \
114 }
115
116 #else // def CINT_CONVERSION_WORKAROUND
117
118 #define DECLARE_FUNCTION_1P(NAME) \
119 extern const unsigned function_index_##NAME; \
120 inline function NAME(const ex & p1) { \
121     return function(function_index_##NAME, p1); \
122 }
123 #define DECLARE_FUNCTION_2P(NAME) \
124 extern const unsigned function_index_##NAME; \
125 inline function NAME(const ex & p1, const ex & p2) { \
126     return function(function_index_##NAME, p1, p2); \
127 }
128
129 #endif // def CINT_CONVERSION_WORKAROUND
130
131 END_OF_DECLARE_FUNCTION_1_AND_2P_MACRO_NO_NAMESPACE
132
133 $declare_function_macro_no_namespace .= generate_from_to(
134     <<'END_OF_DECLARE_FUNCTION_MACRO_NO_NAMESPACE','const ex & p${N}','p${N}',3,$maxargs);
135 #define DECLARE_FUNCTION_${N}P(NAME) \\
136 extern const unsigned function_index_##NAME; \\
137 inline function NAME(${SEQ1}) { \\
138     return function(function_index_##NAME, ${SEQ2}); \\
139 }
140
141 END_OF_DECLARE_FUNCTION_MACRO_NO_NAMESPACE
142
143 $typedef_eval_funcp=generate(
144 'typedef ex (* eval_funcp_${N})(${SEQ1});'."\n",
145 'const ex &','');
146
147 $typedef_evalf_funcp=generate(
148 'typedef ex (* evalf_funcp_${N})(${SEQ1});'."\n",
149 'const ex &','');
150
151 $typedef_derivative_funcp=generate(
152 'typedef ex (* derivative_funcp_${N})(${SEQ1}, unsigned);'."\n",
153 'const ex &','');
154
155 $typedef_series_funcp=generate(
156 'typedef ex (* series_funcp_${N})(${SEQ1}, const relational &, int);'."\n",
157 'const ex &','');
158
159 $eval_func_interface=generate('    function_options & eval_func(eval_funcp_${N} e);'."\n",'','');
160
161 $evalf_func_interface=generate('    function_options & evalf_func(evalf_funcp_${N} ef);'."\n",'','');
162
163 $derivative_func_interface=generate('    function_options & derivative_func(derivative_funcp_${N} d);'."\n",'','');
164
165 $series_func_interface=generate('    function_options & series_func(series_funcp_${N} s);'."\n",'','');
166
167 $constructors_interface=generate(
168 '    function(unsigned ser, ${SEQ1});'."\n",
169 'const ex & param${N}','');
170
171 $constructors_implementation=generate(
172     <<'END_OF_CONSTRUCTORS_IMPLEMENTATION','const ex & param${N}','param${N}');
173 function::function(unsigned ser, ${SEQ1})
174     : exprseq(${SEQ2}), serial(ser)
175 {
176     debugmsg(\"function constructor from unsigned,${N}*ex\",LOGLEVEL_CONSTRUCT);
177     tinfo_key = TINFO_function;
178 }
179 END_OF_CONSTRUCTORS_IMPLEMENTATION
180
181 $eval_switch_statement=generate(
182     <<'END_OF_EVAL_SWITCH_STATEMENT','seq[${N}-1]','');
183     case ${N}:
184         eval_result=((eval_funcp_${N})(registered_functions()[serial].eval_f))(${SEQ1});
185         break;
186 END_OF_EVAL_SWITCH_STATEMENT
187
188 $evalf_switch_statement=generate(
189     <<'END_OF_EVALF_SWITCH_STATEMENT','eseq[${N}-1]','');
190     case ${N}:
191         return ((evalf_funcp_${N})(registered_functions()[serial].evalf_f))(${SEQ1});
192         break;
193 END_OF_EVALF_SWITCH_STATEMENT
194
195 $diff_switch_statement=generate(
196     <<'END_OF_DIFF_SWITCH_STATEMENT','seq[${N}-1]','');
197     case ${N}:
198         return ((derivative_funcp_${N})(registered_functions()[serial].derivative_f))(${SEQ1},diff_param);
199         break;
200 END_OF_DIFF_SWITCH_STATEMENT
201
202 $series_switch_statement=generate(
203     <<'END_OF_SERIES_SWITCH_STATEMENT','seq[${N}-1]','');
204     case ${N}:
205         try {
206             res = ((series_funcp_${N})(registered_functions()[serial].series_f))(${SEQ1},r,order);
207         } catch (do_taylor) {
208             res = basic::series(r, order);
209         }
210         return res;
211         break;
212 END_OF_SERIES_SWITCH_STATEMENT
213
214 $eval_func_implementation=generate(
215     <<'END_OF_EVAL_FUNC_IMPLEMENTATION','','');
216 function_options & function_options::eval_func(eval_funcp_${N} e)
217 {
218     test_and_set_nparams(${N});
219     eval_f=eval_funcp(e);
220     return *this;
221 }        
222 END_OF_EVAL_FUNC_IMPLEMENTATION
223
224 $evalf_func_implementation=generate(
225     <<'END_OF_EVALF_FUNC_IMPLEMENTATION','','');
226 function_options & function_options::evalf_func(evalf_funcp_${N} ef)
227 {
228     test_and_set_nparams(${N});
229     evalf_f=evalf_funcp(ef);
230     return *this;
231 }        
232 END_OF_EVALF_FUNC_IMPLEMENTATION
233
234 $derivative_func_implementation=generate(
235     <<'END_OF_DERIVATIVE_FUNC_IMPLEMENTATION','','');
236 function_options & function_options::derivative_func(derivative_funcp_${N} d)
237 {
238     test_and_set_nparams(${N});
239     derivative_f=derivative_funcp(d);
240     return *this;
241 }        
242 END_OF_DERIVATIVE_FUNC_IMPLEMENTATION
243
244 $series_func_implementation=generate(
245     <<'END_OF_SERIES_FUNC_IMPLEMENTATION','','');
246 function_options & function_options::series_func(series_funcp_${N} s)
247 {
248     test_and_set_nparams(${N});
249     series_f=series_funcp(s);
250     return *this;
251 }        
252 END_OF_SERIES_FUNC_IMPLEMENTATION
253
254 $interface=<<END_OF_INTERFACE;
255 /** \@file function.h
256  *
257  *  Interface to abstract class function (new function concept). */
258
259 /*
260  *  This file was generated automatically by function.pl.
261  *  Please do not modify it directly, edit the perl script instead!
262  *  function.pl options: \$maxargs=${maxargs}
263  *
264  *  GiNaC Copyright (C) 1999-2000 Johannes Gutenberg University Mainz, Germany
265  *
266  *  This program is free software; you can redistribute it and/or modify
267  *  it under the terms of the GNU General Public License as published by
268  *  the Free Software Foundation; either version 2 of the License, or
269  *  (at your option) any later version.
270  *
271  *  This program is distributed in the hope that it will be useful,
272  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
273  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
274  *  GNU General Public License for more details.
275  *
276  *  You should have received a copy of the GNU General Public License
277  *  along with this program; if not, write to the Free Software
278  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
279  */
280
281 #ifndef __GINAC_FUNCTION_H__
282 #define __GINAC_FUNCTION_H__
283
284 #include <string>
285 #include <vector>
286
287 #ifdef __CINT__
288 // CINT needs <algorithm> to work properly with <vector> 
289 #include <algorithm>
290 #endif // def __CINT__
291
292 #include "exprseq.h"
293
294 #ifndef NO_NAMESPACE_GINAC
295
296 // the following lines have been generated for max. ${maxargs} parameters
297 $declare_function_macro_namespace
298 // end of generated lines
299
300 #else // ndef NO_NAMESPACE_GINAC
301
302 // the following lines have been generated for max. ${maxargs} parameters
303 $declare_function_macro_no_namespace
304 // end of generated lines
305
306 #endif // ndef NO_NAMESPACE_GINAC
307
308 #ifndef NO_NAMESPACE_GINAC
309
310 #define REGISTER_FUNCTION(NAME,OPT) \\
311 const unsigned function_index_##NAME= \\
312     GiNaC::function::register_new(GiNaC::function_options(#NAME).OPT);
313
314 #define REGISTER_FUNCTION_OLD(NAME,E,EF,D,S) \\
315 const unsigned function_index_##NAME= \\
316     GiNaC::function::register_new(GiNaC::function_options(#NAME). \\
317                                   eval_func(E). \\
318                                   evalf_func(EF). \\
319                                   derivative_func(D). \\
320                                   series_func(S));
321
322 #else // ndef NO_NAMESPACE_GINAC
323
324 #define REGISTER_FUNCTION(NAME,OPT) \\
325 const unsigned function_index_##NAME= \\
326     function::register_new(function_options(#NAME).OPT);
327
328 #define REGISTER_FUNCTION_OLD(NAME,E,EF,D,S) \\
329 const unsigned function_index_##NAME= \\
330     function::register_new(function_options(#NAME). \\
331                            eval_func(E). \\
332                            evalf_func(EF). \\
333                            derivative_func(D). \\
334                            series_func(S));
335
336 #endif // ndef NO_NAMESPACE_GINAC
337
338 #define BEGIN_TYPECHECK \\
339 bool automatic_typecheck=true;
340
341 #define TYPECHECK(VAR,TYPE) \\
342 if (!is_ex_exactly_of_type(VAR,TYPE)) { \\
343     automatic_typecheck=false; \\
344 } else
345
346 #ifndef NO_NAMESPACE_GINAC
347
348 #define TYPECHECK_INTEGER(VAR) \\
349 if (!(VAR).info(GiNaC::info_flags::integer)) { \\
350     automatic_typecheck=false; \\
351 } else
352
353 #else // ndef NO_NAMESPACE_GINAC
354
355 #define TYPECHECK_INTEGER(VAR) \\
356 if (!(VAR).info(info_flags::integer)) { \\
357     automatic_typecheck=false; \\
358 } else
359
360 #endif // ndef NO_NAMESPACE_GINAC
361
362 #define END_TYPECHECK(RV) \\
363 {} \\
364 if (!automatic_typecheck) { \\
365     return RV.hold(); \\
366 }
367
368 #ifndef NO_NAMESPACE_GINAC
369 namespace GiNaC {
370 #endif // ndef NO_NAMESPACE_GINAC
371
372 class function;
373
374 typedef ex (* eval_funcp)();
375 typedef ex (* evalf_funcp)();
376 typedef ex (* derivative_funcp)();
377 typedef ex (* series_funcp)();
378
379 // the following lines have been generated for max. ${maxargs} parameters
380 $typedef_eval_funcp
381 $typedef_evalf_funcp
382 $typedef_derivative_funcp
383 $typedef_series_funcp
384 // end of generated lines
385
386 class function_options
387 {
388     friend class function;
389 public:
390     function_options();
391     function_options(string const & n, string const & tn=string());
392     ~function_options();
393     void initialize(void);
394     function_options & set_name(string const & n, string const & tn=string());
395 // the following lines have been generated for max. ${maxargs} parameters
396 $eval_func_interface
397 $evalf_func_interface
398 $derivative_func_interface
399 $series_func_interface
400 // end of generated lines
401     function_options & set_return_type(unsigned rt, unsigned rtt=0);
402     function_options & do_not_evalf_params(void);
403     function_options & remember(unsigned size, unsigned assoc_size=0,
404                                 unsigned strategy=remember_strategies::delete_never);
405     function_options & overloaded(unsigned o);
406     void test_and_set_nparams(unsigned n);
407     string get_name(void) const { return name; }
408     unsigned get_nparams(void) const { return nparams; }
409
410 protected:
411     string name;
412     string TeX_name;
413
414     unsigned nparams;
415
416     eval_funcp eval_f;
417     evalf_funcp evalf_f;
418     derivative_funcp derivative_f;
419     series_funcp series_f;
420
421     bool evalf_params_first;
422
423     bool use_return_type;
424     unsigned return_type;
425     unsigned return_type_tinfo;
426
427     bool use_remember;
428     unsigned remember_size;
429     unsigned remember_assoc_size;
430     unsigned remember_strategy;
431
432     unsigned functions_with_same_name;
433 };
434
435 /** The class function is used to implement builtin functions like sin, cos...
436     and user defined functions */
437 class function : public exprseq
438 {
439     GINAC_DECLARE_REGISTERED_CLASS(function, exprseq)
440
441     // CINT has a linking problem
442     friend void ginsh_get_ginac_functions(void);
443
444     friend class remember_table_entry;
445     // friend class remember_table_list;
446     // friend class remember_table;
447
448 // member functions
449
450     // default constructor, destructor, copy constructor assignment operator and helpers
451 public:
452     function();
453     ~function();
454     function(const function & other);
455     const function & operator=(const function & other);
456 protected:
457     void copy(const function & other);
458     void destroy(bool call_parent);
459
460     // other constructors
461 public:
462     function(unsigned ser);
463     // the following lines have been generated for max. ${maxargs} parameters
464 $constructors_interface
465     // end of generated lines
466     function(unsigned ser, const exprseq & es);
467     function(unsigned ser, const exvector & v, bool discardable=0);
468     function(unsigned ser, exvector * vp); // vp will be deleted
469
470     // functions overriding virtual functions from bases classes
471 public:
472     basic * duplicate() const;
473     void printraw(ostream & os) const; 
474     void print(ostream & os, unsigned upper_precedence=0) const;
475     void printtree(ostream & os, unsigned indent) const;
476     void printcsrc(ostream & os, unsigned type, unsigned upper_precedence=0) const;
477     ex expand(unsigned options=0) const;
478     ex eval(int level=0) const;
479     ex evalf(int level=0) const;
480     ex series(const relational & r, int order) const;
481     ex thisexprseq(const exvector & v) const;
482     ex thisexprseq(exvector * vp) const;
483 protected:
484     ex derivative(const symbol & s) const;
485     int compare_same_type(const basic & other) const;
486     bool is_equal_same_type(const basic & other) const;
487     unsigned return_type(void) const;
488     unsigned return_type_tinfo(void) const;
489     
490     // new virtual functions which can be overridden by derived classes
491     // none
492     
493     // non-virtual functions in this class
494 protected:
495     ex pderivative(unsigned diff_param) const; // partial differentiation
496     static vector<function_options> & registered_functions(void);
497     bool lookup_remember_table(ex & result) const;
498     void store_remember_table(ex const & result) const;
499 public:
500     static unsigned register_new(function_options const & opt);
501     static unsigned find_function(const string &name, unsigned nparams);
502     unsigned getserial(void) const {return serial;}
503     
504 // member variables
505
506 protected:
507     unsigned serial;
508 };
509
510 // utility functions/macros
511 inline const function &ex_to_function(const ex &e)
512 {
513     return static_cast<const function &>(*e.bp);
514 }
515
516 #ifndef NO_NAMESPACE_GINAC
517
518 #define is_ex_the_function(OBJ, FUNCNAME) \\
519     (is_ex_exactly_of_type(OBJ, function) && static_cast<GiNaC::function *>(OBJ.bp)->getserial() == function_index_##FUNCNAME)
520
521 #else // ndef NO_NAMESPACE_GINAC
522
523 #define is_ex_the_function(OBJ, FUNCNAME) \\
524     (is_ex_exactly_of_type(OBJ, function) && static_cast<function *>(OBJ.bp)->getserial() == function_index_##FUNCNAME)
525
526 #endif // ndef NO_NAMESPACE_GINAC
527
528 // global constants
529
530 extern const function some_function;
531 extern const type_info & typeid_function;
532
533 #ifndef NO_NAMESPACE_GINAC
534 } // namespace GiNaC
535 #endif // ndef NO_NAMESPACE_GINAC
536
537 #endif // ndef __GINAC_FUNCTION_H__
538
539 END_OF_INTERFACE
540
541 $implementation=<<END_OF_IMPLEMENTATION;
542 /** \@file function.cpp
543  *
544  *  Implementation of class function. */
545
546 /*
547  *  This file was generated automatically by function.pl.
548  *  Please do not modify it directly, edit the perl script instead!
549  *  function.pl options: \$maxargs=${maxargs}
550  *
551  *  GiNaC Copyright (C) 1999-2000 Johannes Gutenberg University Mainz, Germany
552  *
553  *  This program is free software; you can redistribute it and/or modify
554  *  it under the terms of the GNU General Public License as published by
555  *  the Free Software Foundation; either version 2 of the License, or
556  *  (at your option) any later version.
557  *
558  *  This program is distributed in the hope that it will be useful,
559  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
560  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
561  *  GNU General Public License for more details.
562  *
563  *  You should have received a copy of the GNU General Public License
564  *  along with this program; if not, write to the Free Software
565  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
566  */
567
568 #include <string>
569 #include <stdexcept>
570 #include <list>
571
572 #include "function.h"
573 #include "ex.h"
574 #include "lst.h"
575 #include "archive.h"
576 #include "inifcns.h"
577 #include "utils.h"
578 #include "debugmsg.h"
579 #include "remember.h"
580
581 #ifndef NO_NAMESPACE_GINAC
582 namespace GiNaC {
583 #endif // ndef NO_NAMESPACE_GINAC
584
585 //////////
586 // helper class function_options
587 //////////
588
589 function_options::function_options()
590 {
591     initialize();
592 }
593
594 function_options::function_options(string const & n, string const & tn)
595 {
596     initialize();
597     set_name(n,tn);
598 }
599
600 function_options::~function_options()
601 {
602     // nothing to clean up at the moment
603 }
604
605 void function_options::initialize(void)
606 {
607     set_name("unnamed_function","\\\\operatorname{unnamed}");
608     nparams=0;
609     eval_f=evalf_f=derivative_f=series_f=0;
610     evalf_params_first=true;
611     use_return_type=false;
612     use_remember=false;
613     functions_with_same_name=1;
614 }
615
616 function_options & function_options::set_name(string const & n,
617                                               string const & tn)
618 {
619     name=n;
620     if (tn==string()) {
621         TeX_name="\\\\operatorname{"+name+"}";
622     } else {
623         TeX_name=tn;
624     }
625     return *this;
626 }
627
628 // the following lines have been generated for max. ${maxargs} parameters
629 $eval_func_implementation
630 $evalf_func_implementation
631 $derivative_func_implementation
632 $series_func_implementation
633 // end of generated lines
634
635 function_options & function_options::set_return_type(unsigned rt, unsigned rtt)
636 {
637     use_return_type=true;
638     return_type=rt;
639     return_type_tinfo=rtt;
640     return *this;
641 }
642
643 function_options & function_options::do_not_evalf_params(void)
644 {
645     evalf_params_first=false;
646     return *this;
647 }
648
649 function_options & function_options::remember(unsigned size,
650                                               unsigned assoc_size,
651                                               unsigned strategy)
652 {
653     use_remember=true;
654     remember_size=size;
655     remember_assoc_size=assoc_size;
656     remember_strategy=strategy;
657     return *this;
658 }
659
660 function_options & function_options::overloaded(unsigned o)
661 {
662     functions_with_same_name=o;
663     return *this;
664 }
665     
666 void function_options::test_and_set_nparams(unsigned n)
667 {
668     if (nparams==0) {
669         nparams=n;
670     } else if (nparams!=n) {
671         // we do not throw an exception here because this code is
672         // usually executed before main(), so the exception could not
673         // caught anyhow
674         cerr << "WARNING: number of parameters ("
675              << n << ") differs from number set before (" 
676              << nparams << ")" << endl;
677     }
678 }
679
680 GINAC_IMPLEMENT_REGISTERED_CLASS(function, exprseq)
681
682 //////////
683 // default constructor, destructor, copy constructor assignment operator and helpers
684 //////////
685
686 // public
687
688 function::function() : serial(0)
689 {
690     debugmsg("function default constructor",LOGLEVEL_CONSTRUCT);
691     tinfo_key = TINFO_function;
692 }
693
694 function::~function()
695 {
696     debugmsg("function destructor",LOGLEVEL_DESTRUCT);
697     destroy(0);
698 }
699
700 function::function(const function & other)
701 {
702     debugmsg("function copy constructor",LOGLEVEL_CONSTRUCT);
703     copy(other);
704 }
705
706 const function & function::operator=(const function & other)
707 {
708     debugmsg("function operator=",LOGLEVEL_ASSIGNMENT);
709     if (this != &other) {
710         destroy(1);
711         copy(other);
712     }
713     return *this;
714 }
715
716 // protected
717
718 void function::copy(const function & other)
719 {
720     exprseq::copy(other);
721     serial=other.serial;
722 }
723
724 void function::destroy(bool call_parent)
725 {
726     if (call_parent) exprseq::destroy(call_parent);
727 }
728
729 //////////
730 // other constructors
731 //////////
732
733 // public
734
735 function::function(unsigned ser) : serial(ser)
736 {
737     debugmsg("function constructor from unsigned",LOGLEVEL_CONSTRUCT);
738     tinfo_key = TINFO_function;
739 }
740
741 // the following lines have been generated for max. ${maxargs} parameters
742 $constructors_implementation
743 // end of generated lines
744
745 function::function(unsigned ser, const exprseq & es) : exprseq(es), serial(ser)
746 {
747     debugmsg("function constructor from unsigned,exprseq",LOGLEVEL_CONSTRUCT);
748     tinfo_key = TINFO_function;
749 }
750
751 function::function(unsigned ser, const exvector & v, bool discardable) 
752     : exprseq(v,discardable), serial(ser)
753 {
754     debugmsg("function constructor from string,exvector,bool",LOGLEVEL_CONSTRUCT);
755     tinfo_key = TINFO_function;
756 }
757
758 function::function(unsigned ser, exvector * vp) 
759     : exprseq(vp), serial(ser)
760 {
761     debugmsg("function constructor from unsigned,exvector *",LOGLEVEL_CONSTRUCT);
762     tinfo_key = TINFO_function;
763 }
764
765 //////////
766 // archiving
767 //////////
768
769 /** Construct object from archive_node. */
770 function::function(const archive_node &n, const lst &sym_lst) : inherited(n, sym_lst)
771 {
772     debugmsg("function constructor from archive_node", LOGLEVEL_CONSTRUCT);
773
774     // Find serial number by function name
775     string s;
776     if (n.find_string("name", s)) {
777         unsigned int ser = 0;
778         vector<function_options>::const_iterator i = registered_functions().begin(), iend = registered_functions().end();
779         while (i != iend) {
780             if (s == i->name) {
781                 serial = ser;
782                 return;
783             }
784             i++; ser++;
785         }
786         throw (std::runtime_error("unknown function '" + s + "' in archive"));
787     } else
788         throw (std::runtime_error("unnamed function in archive"));
789 }
790
791 /** Unarchive the object. */
792 ex function::unarchive(const archive_node &n, const lst &sym_lst)
793 {
794     return (new function(n, sym_lst))->setflag(status_flags::dynallocated);
795 }
796
797 /** Archive the object. */
798 void function::archive(archive_node &n) const
799 {
800     inherited::archive(n);
801     GINAC_ASSERT(serial < registered_functions().size());
802     n.add_string("name", registered_functions()[serial].name);
803 }
804
805 //////////
806 // functions overriding virtual functions from bases classes
807 //////////
808
809 // public
810
811 basic * function::duplicate() const
812 {
813     debugmsg("function duplicate",LOGLEVEL_DUPLICATE);
814     return new function(*this);
815 }
816
817 void function::printraw(ostream & os) const
818 {
819     debugmsg("function printraw",LOGLEVEL_PRINT);
820
821     GINAC_ASSERT(serial<registered_functions().size());
822
823     os << "function(name=" << registered_functions()[serial].name;
824     for (exvector::const_iterator it=seq.begin(); it!=seq.end(); ++it) {
825         os << ",";
826         (*it).bp->print(os);
827     }
828     os << ")";
829 }
830
831 void function::print(ostream & os, unsigned upper_precedence) const
832 {
833     debugmsg("function print",LOGLEVEL_PRINT);
834
835     GINAC_ASSERT(serial<registered_functions().size());
836
837     os << registered_functions()[serial].name;
838     printseq(os,'(',',',')',exprseq::precedence,function::precedence);
839 }
840
841 void function::printtree(ostream & os, unsigned indent) const
842 {
843     debugmsg("function printtree",LOGLEVEL_PRINT);
844
845     GINAC_ASSERT(serial<registered_functions().size());
846
847     os << string(indent,' ') << "function "
848        << registered_functions()[serial].name
849        << ", hash=" << hashvalue << " (0x" << hex << hashvalue << dec << ")"
850        << ", flags=" << flags
851        << ", nops=" << nops() << endl;
852     for (unsigned i=0; i<nops(); ++i) {
853         seq[i].printtree(os,indent+delta_indent);
854     }
855     os << string(indent+delta_indent,' ') << "=====" << endl;
856 }
857
858 void function::printcsrc(ostream & os, unsigned type, unsigned upper_precedence) const
859 {
860     debugmsg("function print csrc",LOGLEVEL_PRINT);
861
862     GINAC_ASSERT(serial<registered_functions().size());
863
864         // Print function name in lowercase
865     string lname;
866     lname=registered_functions()[serial].name;
867     for (unsigned i=0; i<lname.size(); i++)
868         lname[i] = tolower(lname[i]);
869     os << lname << "(";
870
871         // Print arguments, separated by commas
872     exvector::const_iterator it = seq.begin();
873     exvector::const_iterator itend = seq.end();
874     while (it != itend) {
875         it->bp->printcsrc(os, type, 0);
876         it++;
877         if (it != itend)
878             os << ",";
879     }
880     os << ")";
881 }
882
883 ex function::expand(unsigned options) const
884 {
885     return this->setflag(status_flags::expanded);
886 }
887
888 ex function::eval(int level) const
889 {
890     GINAC_ASSERT(serial<registered_functions().size());
891
892     if (level>1) {
893         // first evaluate children, then we will end up here again
894         return function(serial,evalchildren(level));
895     }
896
897     if (registered_functions()[serial].eval_f==0) {
898         return this->hold();
899     }
900
901     bool use_remember=registered_functions()[serial].use_remember;
902     ex eval_result;
903     if (use_remember && lookup_remember_table(eval_result)) {
904         return eval_result;
905     }
906
907     switch (registered_functions()[serial].nparams) {
908         // the following lines have been generated for max. ${maxargs} parameters
909 ${eval_switch_statement}
910         // end of generated lines
911     default:
912         throw(std::logic_error("function::eval(): invalid nparams"));
913     }
914     if (use_remember) {
915         store_remember_table(eval_result);
916     }
917     return eval_result;
918 }
919
920 ex function::evalf(int level) const
921 {
922     GINAC_ASSERT(serial<registered_functions().size());
923
924     exvector eseq=evalfchildren(level);
925     
926     if (registered_functions()[serial].evalf_f==0) {
927         return function(serial,eseq).hold();
928     }
929     switch (registered_functions()[serial].nparams) {
930         // the following lines have been generated for max. ${maxargs} parameters
931 ${evalf_switch_statement}
932         // end of generated lines
933     }
934     throw(std::logic_error("function::evalf(): invalid nparams"));
935 }
936
937 ex function::thisexprseq(const exvector & v) const
938 {
939     return function(serial,v);
940 }
941
942 ex function::thisexprseq(exvector * vp) const
943 {
944     return function(serial,vp);
945 }
946
947 /** Implementation of ex::series for functions.
948  *  \@see ex::series */
949 ex function::series(const relational & r, int order) const
950 {
951     GINAC_ASSERT(serial<registered_functions().size());
952
953     if (registered_functions()[serial].series_f==0) {
954         return basic::series(r, order);
955     }
956     ex res;
957     switch (registered_functions()[serial].nparams) {
958         // the following lines have been generated for max. ${maxargs} parameters
959 ${series_switch_statement}
960         // end of generated lines
961     }
962     throw(std::logic_error("function::series(): invalid nparams"));
963 }
964
965 // protected
966
967
968 /** Implementation of ex::diff() for functions. It applies the chain rule,
969  *  except for the Order term function.
970  *  \@see ex::diff */
971 ex function::derivative(const symbol & s) const
972 {
973     ex result;
974     
975     if (serial == function_index_Order) {
976         // Order Term function only differentiates the argument
977         return Order(seq[0].diff(s));
978     } else if (serial == function_index_Derivative) {
979         // Inert derivative performs chain rule on the first argument only, and
980         // adds differentiation parameter to list (second argument)
981         GINAC_ASSERT(is_ex_exactly_of_type(seq[0], function));
982         GINAC_ASSERT(is_ex_exactly_of_type(seq[1], function));
983         ex fcn = seq[0];
984         ex arg_diff;
985         for (unsigned i=0; i!=fcn.nops(); i++) {
986             arg_diff = fcn.op(i).diff(s);
987             if (!arg_diff.is_zero()) {
988                 lst new_lst = ex_to_lst(seq[1]);
989                 new_lst.append(i);
990                 result += arg_diff * Derivative(fcn, new_lst);
991             }
992         }
993     } else {
994         // Chain rule
995         ex arg_diff;
996         for (unsigned i=0; i!=seq.size(); i++) {
997             arg_diff = seq[i].diff(s);
998             // We apply the chain rule only when it makes sense.  This is not
999             // just for performance reasons but also to allow functions to
1000             // throw when differentiated with respect to one of its arguments
1001             // without running into trouble with our automatic full
1002             // differentiation:
1003             if (!arg_diff.is_zero())
1004                 result += pderivative(i)*arg_diff;
1005         }
1006     }
1007     return result;
1008 }
1009
1010 int function::compare_same_type(const basic & other) const
1011 {
1012     GINAC_ASSERT(is_of_type(other, function));
1013     const function & o=static_cast<function &>(const_cast<basic &>(other));
1014
1015     if (serial!=o.serial) {
1016         return serial < o.serial ? -1 : 1;
1017     }
1018     return exprseq::compare_same_type(o);
1019 }
1020
1021 bool function::is_equal_same_type(const basic & other) const
1022 {
1023     GINAC_ASSERT(is_of_type(other, function));
1024     const function & o=static_cast<function &>(const_cast<basic &>(other));
1025
1026     if (serial!=o.serial) return false;
1027     return exprseq::is_equal_same_type(o);
1028 }
1029
1030 unsigned function::return_type(void) const
1031 {
1032     if (seq.size()==0) {
1033         return return_types::commutative;
1034     }
1035     return (*seq.begin()).return_type();
1036 }
1037    
1038 unsigned function::return_type_tinfo(void) const
1039 {
1040     if (seq.size()==0) {
1041         return tinfo_key;
1042     }
1043     return (*seq.begin()).return_type_tinfo();
1044 }
1045
1046 //////////
1047 // new virtual functions which can be overridden by derived classes
1048 //////////
1049
1050 // none
1051
1052 //////////
1053 // non-virtual functions in this class
1054 //////////
1055
1056 // protected
1057
1058 ex function::pderivative(unsigned diff_param) const // partial differentiation
1059 {
1060     GINAC_ASSERT(serial<registered_functions().size());
1061     
1062     if (registered_functions()[serial].derivative_f==0) {
1063         return Derivative(*this, lst(diff_param));
1064     }
1065     switch (registered_functions()[serial].nparams) {
1066         // the following lines have been generated for max. ${maxargs} parameters
1067 ${diff_switch_statement}
1068         // end of generated lines
1069     }        
1070     throw(std::logic_error("function::pderivative(): no diff function defined"));
1071 }
1072
1073 vector<function_options> & function::registered_functions(void)
1074 {
1075     static vector<function_options> * rf=new vector<function_options>;
1076     return *rf;
1077 }
1078
1079 bool function::lookup_remember_table(ex & result) const
1080 {
1081     return remember_table::remember_tables()[serial].lookup_entry(*this,result);
1082 }
1083
1084 void function::store_remember_table(ex const & result) const
1085 {
1086     remember_table::remember_tables()[serial].add_entry(*this,result);
1087 }
1088
1089 // public
1090
1091 unsigned function::register_new(function_options const & opt)
1092 {
1093     unsigned same_name=0;
1094     for (unsigned i=0; i<registered_functions().size(); ++i) {
1095         if (registered_functions()[i].name==opt.name) {
1096             same_name++;
1097         }
1098     }
1099     if (same_name>=opt.functions_with_same_name) {
1100         // we do not throw an exception here because this code is
1101         // usually executed before main(), so the exception could not
1102         // caught anyhow
1103         cerr << "WARNING: function name " << opt.name
1104              << " already in use!" << endl;
1105     }
1106     registered_functions().push_back(opt);
1107     if (opt.use_remember) {
1108         remember_table::remember_tables().
1109             push_back(remember_table(opt.remember_size,
1110                                      opt.remember_assoc_size,
1111                                      opt.remember_strategy));
1112     } else {
1113         remember_table::remember_tables().push_back(remember_table());
1114     }
1115     return registered_functions().size()-1;
1116 }
1117
1118 /** Find serial number of function by name and number of parameters.
1119  *  Throws exception if function was not found. */
1120 unsigned function::find_function(const string &name, unsigned nparams)
1121 {
1122     vector<function_options>::const_iterator i = function::registered_functions().begin(), end = function::registered_functions().end();
1123     unsigned serial = 0;
1124     while (i != end) {
1125         if (i->get_name() == name && i->get_nparams() == nparams)
1126             return serial;
1127         i++;
1128         serial++;
1129     }
1130     throw (std::runtime_error("no function '" + name + "' with " + ToString(nparams) + " parameters defined"));
1131 }
1132
1133 //////////
1134 // static member variables
1135 //////////
1136
1137 // none
1138
1139 //////////
1140 // global constants
1141 //////////
1142
1143 const function some_function;
1144 const type_info & typeid_function=typeid(some_function);
1145
1146 #ifndef NO_NAMESPACE_GINAC
1147 } // namespace GiNaC
1148 #endif // ndef NO_NAMESPACE_GINAC
1149
1150 END_OF_IMPLEMENTATION
1151
1152 print "Creating interface file function.h...";
1153 open OUT,">function.h" or die "cannot open function.h";
1154 print OUT $interface;
1155 close OUT;
1156 print "ok.\n";
1157
1158 print "Creating implementation file function.cpp...";
1159 open OUT,">function.cpp" or die "cannot open function.cpp";
1160 print OUT $implementation;
1161 close OUT;
1162 print "ok.\n";
1163
1164 print "done.\n";