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