16936d5a17eda54969eafc60645b158c539fec66
[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 #ifndef __MAKECINT__
443     friend void ginsh_get_ginac_functions(void);
444 #endif // def __MAKECINT__
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 relational & r, 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     static unsigned find_function(const string &name, unsigned nparams);
504     unsigned getserial(void) const {return serial;}
505     
506 // member variables
507
508 protected:
509     unsigned serial;
510 };
511
512 // utility functions/macros
513 inline const function &ex_to_function(const ex &e)
514 {
515     return static_cast<const function &>(*e.bp);
516 }
517
518 #ifndef NO_NAMESPACE_GINAC
519
520 #define is_ex_the_function(OBJ, FUNCNAME) \\
521     (is_ex_exactly_of_type(OBJ, function) && static_cast<GiNaC::function *>(OBJ.bp)->getserial() == function_index_##FUNCNAME)
522
523 #else // ndef NO_NAMESPACE_GINAC
524
525 #define is_ex_the_function(OBJ, FUNCNAME) \\
526     (is_ex_exactly_of_type(OBJ, function) && static_cast<function *>(OBJ.bp)->getserial() == function_index_##FUNCNAME)
527
528 #endif // ndef NO_NAMESPACE_GINAC
529
530 // global constants
531
532 extern const function some_function;
533 extern const type_info & typeid_function;
534
535 #ifndef NO_NAMESPACE_GINAC
536 } // namespace GiNaC
537 #endif // ndef NO_NAMESPACE_GINAC
538
539 #endif // ndef __GINAC_FUNCTION_H__
540
541 END_OF_INTERFACE
542
543 $implementation=<<END_OF_IMPLEMENTATION;
544 /** \@file function.cpp
545  *
546  *  Implementation of class function. */
547
548 /*
549  *  This file was generated automatically by function.pl.
550  *  Please do not modify it directly, edit the perl script instead!
551  *  function.pl options: \$maxargs=${maxargs}
552  *
553  *  GiNaC Copyright (C) 1999-2000 Johannes Gutenberg University Mainz, Germany
554  *
555  *  This program is free software; you can redistribute it and/or modify
556  *  it under the terms of the GNU General Public License as published by
557  *  the Free Software Foundation; either version 2 of the License, or
558  *  (at your option) any later version.
559  *
560  *  This program is distributed in the hope that it will be useful,
561  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
562  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
563  *  GNU General Public License for more details.
564  *
565  *  You should have received a copy of the GNU General Public License
566  *  along with this program; if not, write to the Free Software
567  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
568  */
569
570 #include <string>
571 #include <stdexcept>
572 #include <list>
573
574 #include "function.h"
575 #include "ex.h"
576 #include "lst.h"
577 #include "archive.h"
578 #include "inifcns.h"
579 #include "utils.h"
580 #include "debugmsg.h"
581 #include "remember.h"
582
583 #ifndef NO_NAMESPACE_GINAC
584 namespace GiNaC {
585 #endif // ndef NO_NAMESPACE_GINAC
586
587 //////////
588 // helper class function_options
589 //////////
590
591 function_options::function_options()
592 {
593     initialize();
594 }
595
596 function_options::function_options(string const & n, string const & tn)
597 {
598     initialize();
599     set_name(n,tn);
600 }
601
602 function_options::~function_options()
603 {
604     // nothing to clean up at the moment
605 }
606
607 void function_options::initialize(void)
608 {
609     set_name("unnamed_function","\\\\operatorname{unnamed}");
610     nparams=0;
611     eval_f=evalf_f=derivative_f=series_f=0;
612     evalf_params_first=true;
613     use_return_type=false;
614     use_remember=false;
615     functions_with_same_name=1;
616 }
617
618 function_options & function_options::set_name(string const & n,
619                                               string const & tn)
620 {
621     name=n;
622     if (tn==string()) {
623         TeX_name="\\\\operatorname{"+name+"}";
624     } else {
625         TeX_name=tn;
626     }
627     return *this;
628 }
629
630 // the following lines have been generated for max. ${maxargs} parameters
631 $eval_func_implementation
632 $evalf_func_implementation
633 $derivative_func_implementation
634 $series_func_implementation
635 // end of generated lines
636
637 function_options & function_options::set_return_type(unsigned rt, unsigned rtt)
638 {
639     use_return_type=true;
640     return_type=rt;
641     return_type_tinfo=rtt;
642     return *this;
643 }
644
645 function_options & function_options::do_not_evalf_params(void)
646 {
647     evalf_params_first=false;
648     return *this;
649 }
650
651 function_options & function_options::remember(unsigned size,
652                                               unsigned assoc_size,
653                                               unsigned strategy)
654 {
655     use_remember=true;
656     remember_size=size;
657     remember_assoc_size=assoc_size;
658     remember_strategy=strategy;
659     return *this;
660 }
661
662 function_options & function_options::overloaded(unsigned o)
663 {
664     functions_with_same_name=o;
665     return *this;
666 }
667     
668 void function_options::test_and_set_nparams(unsigned n)
669 {
670     if (nparams==0) {
671         nparams=n;
672     } else if (nparams!=n) {
673         // we do not throw an exception here because this code is
674         // usually executed before main(), so the exception could not
675         // caught anyhow
676         cerr << "WARNING: number of parameters ("
677              << n << ") differs from number set before (" 
678              << nparams << ")" << endl;
679     }
680 }
681
682 GINAC_IMPLEMENT_REGISTERED_CLASS(function, exprseq)
683
684 //////////
685 // default constructor, destructor, copy constructor assignment operator and helpers
686 //////////
687
688 // public
689
690 function::function() : serial(0)
691 {
692     debugmsg("function default constructor",LOGLEVEL_CONSTRUCT);
693     tinfo_key = TINFO_function;
694 }
695
696 function::~function()
697 {
698     debugmsg("function destructor",LOGLEVEL_DESTRUCT);
699     destroy(0);
700 }
701
702 function::function(const function & other)
703 {
704     debugmsg("function copy constructor",LOGLEVEL_CONSTRUCT);
705     copy(other);
706 }
707
708 const function & function::operator=(const function & other)
709 {
710     debugmsg("function operator=",LOGLEVEL_ASSIGNMENT);
711     if (this != &other) {
712         destroy(1);
713         copy(other);
714     }
715     return *this;
716 }
717
718 // protected
719
720 void function::copy(const function & other)
721 {
722     exprseq::copy(other);
723     serial=other.serial;
724 }
725
726 void function::destroy(bool call_parent)
727 {
728     if (call_parent) exprseq::destroy(call_parent);
729 }
730
731 //////////
732 // other constructors
733 //////////
734
735 // public
736
737 function::function(unsigned ser) : serial(ser)
738 {
739     debugmsg("function constructor from unsigned",LOGLEVEL_CONSTRUCT);
740     tinfo_key = TINFO_function;
741 }
742
743 // the following lines have been generated for max. ${maxargs} parameters
744 $constructors_implementation
745 // end of generated lines
746
747 function::function(unsigned ser, const exprseq & es) : exprseq(es), serial(ser)
748 {
749     debugmsg("function constructor from unsigned,exprseq",LOGLEVEL_CONSTRUCT);
750     tinfo_key = TINFO_function;
751 }
752
753 function::function(unsigned ser, const exvector & v, bool discardable) 
754     : exprseq(v,discardable), serial(ser)
755 {
756     debugmsg("function constructor from string,exvector,bool",LOGLEVEL_CONSTRUCT);
757     tinfo_key = TINFO_function;
758 }
759
760 function::function(unsigned ser, exvector * vp) 
761     : exprseq(vp), serial(ser)
762 {
763     debugmsg("function constructor from unsigned,exvector *",LOGLEVEL_CONSTRUCT);
764     tinfo_key = TINFO_function;
765 }
766
767 //////////
768 // archiving
769 //////////
770
771 /** Construct object from archive_node. */
772 function::function(const archive_node &n, const lst &sym_lst) : inherited(n, sym_lst)
773 {
774     debugmsg("function constructor from archive_node", LOGLEVEL_CONSTRUCT);
775
776     // Find serial number by function name
777     string s;
778     if (n.find_string("name", s)) {
779         unsigned int ser = 0;
780         vector<function_options>::const_iterator i = registered_functions().begin(), iend = registered_functions().end();
781         while (i != iend) {
782             if (s == i->name) {
783                 serial = ser;
784                 return;
785             }
786             i++; ser++;
787         }
788         throw (std::runtime_error("unknown function '" + s + "' in archive"));
789     } else
790         throw (std::runtime_error("unnamed function in archive"));
791 }
792
793 /** Unarchive the object. */
794 ex function::unarchive(const archive_node &n, const lst &sym_lst)
795 {
796     return (new function(n, sym_lst))->setflag(status_flags::dynallocated);
797 }
798
799 /** Archive the object. */
800 void function::archive(archive_node &n) const
801 {
802     inherited::archive(n);
803     GINAC_ASSERT(serial < registered_functions().size());
804     n.add_string("name", registered_functions()[serial].name);
805 }
806
807 //////////
808 // functions overriding virtual functions from bases classes
809 //////////
810
811 // public
812
813 basic * function::duplicate() const
814 {
815     debugmsg("function duplicate",LOGLEVEL_DUPLICATE);
816     return new function(*this);
817 }
818
819 void function::printraw(ostream & os) const
820 {
821     debugmsg("function printraw",LOGLEVEL_PRINT);
822
823     GINAC_ASSERT(serial<registered_functions().size());
824
825     os << "function(name=" << registered_functions()[serial].name;
826     for (exvector::const_iterator it=seq.begin(); it!=seq.end(); ++it) {
827         os << ",";
828         (*it).bp->print(os);
829     }
830     os << ")";
831 }
832
833 void function::print(ostream & os, unsigned upper_precedence) const
834 {
835     debugmsg("function print",LOGLEVEL_PRINT);
836
837     GINAC_ASSERT(serial<registered_functions().size());
838
839     os << registered_functions()[serial].name;
840     printseq(os,'(',',',')',exprseq::precedence,function::precedence);
841 }
842
843 void function::printtree(ostream & os, unsigned indent) const
844 {
845     debugmsg("function printtree",LOGLEVEL_PRINT);
846
847     GINAC_ASSERT(serial<registered_functions().size());
848
849     os << string(indent,' ') << "function "
850        << registered_functions()[serial].name
851        << ", hash=" << hashvalue << " (0x" << hex << hashvalue << dec << ")"
852        << ", flags=" << flags
853        << ", nops=" << nops() << endl;
854     for (unsigned i=0; i<nops(); ++i) {
855         seq[i].printtree(os,indent+delta_indent);
856     }
857     os << string(indent+delta_indent,' ') << "=====" << endl;
858 }
859
860 void function::printcsrc(ostream & os, unsigned type, unsigned upper_precedence) const
861 {
862     debugmsg("function print csrc",LOGLEVEL_PRINT);
863
864     GINAC_ASSERT(serial<registered_functions().size());
865
866         // Print function name in lowercase
867     string lname;
868     lname=registered_functions()[serial].name;
869     for (unsigned i=0; i<lname.size(); i++)
870         lname[i] = tolower(lname[i]);
871     os << lname << "(";
872
873         // Print arguments, separated by commas
874     exvector::const_iterator it = seq.begin();
875     exvector::const_iterator itend = seq.end();
876     while (it != itend) {
877         it->bp->printcsrc(os, type, 0);
878         it++;
879         if (it != itend)
880             os << ",";
881     }
882     os << ")";
883 }
884
885 ex function::expand(unsigned options) const
886 {
887     return this->setflag(status_flags::expanded);
888 }
889
890 ex function::eval(int level) const
891 {
892     GINAC_ASSERT(serial<registered_functions().size());
893
894     if (level>1) {
895         // first evaluate children, then we will end up here again
896         return function(serial,evalchildren(level));
897     }
898
899     if (registered_functions()[serial].eval_f==0) {
900         return this->hold();
901     }
902
903     bool use_remember=registered_functions()[serial].use_remember;
904     ex eval_result;
905     if (use_remember && lookup_remember_table(eval_result)) {
906         return eval_result;
907     }
908
909     switch (registered_functions()[serial].nparams) {
910         // the following lines have been generated for max. ${maxargs} parameters
911 ${eval_switch_statement}
912         // end of generated lines
913     default:
914         throw(std::logic_error("function::eval(): invalid nparams"));
915     }
916     if (use_remember) {
917         store_remember_table(eval_result);
918     }
919     return eval_result;
920 }
921
922 ex function::evalf(int level) const
923 {
924     GINAC_ASSERT(serial<registered_functions().size());
925
926     exvector eseq=evalfchildren(level);
927     
928     if (registered_functions()[serial].evalf_f==0) {
929         return function(serial,eseq).hold();
930     }
931     switch (registered_functions()[serial].nparams) {
932         // the following lines have been generated for max. ${maxargs} parameters
933 ${evalf_switch_statement}
934         // end of generated lines
935     }
936     throw(std::logic_error("function::evalf(): invalid nparams"));
937 }
938
939 ex function::thisexprseq(const exvector & v) const
940 {
941     return function(serial,v);
942 }
943
944 ex function::thisexprseq(exvector * vp) const
945 {
946     return function(serial,vp);
947 }
948
949 /** Implementation of ex::series for functions.
950  *  \@see ex::series */
951 ex function::series(const relational & r, int order) const
952 {
953     GINAC_ASSERT(serial<registered_functions().size());
954
955     if (registered_functions()[serial].series_f==0) {
956         return basic::series(r, order);
957     }
958     ex res;
959     switch (registered_functions()[serial].nparams) {
960         // the following lines have been generated for max. ${maxargs} parameters
961 ${series_switch_statement}
962         // end of generated lines
963     }
964     throw(std::logic_error("function::series(): invalid nparams"));
965 }
966
967 // protected
968
969
970 /** Implementation of ex::diff() for functions. It applies the chain rule,
971  *  except for the Order term function.
972  *  \@see ex::diff */
973 ex function::derivative(const symbol & s) const
974 {
975     ex result;
976     
977     if (serial == function_index_Order) {
978         // Order Term function only differentiates the argument
979         return Order(seq[0].diff(s));
980     } else if (serial == function_index_Derivative) {
981         // Inert derivative performs chain rule on the first argument only, and
982         // adds differentiation parameter to list (second argument)
983         GINAC_ASSERT(is_ex_exactly_of_type(seq[0], function));
984         GINAC_ASSERT(is_ex_exactly_of_type(seq[1], function));
985         ex fcn = seq[0];
986         ex arg_diff;
987         for (unsigned i=0; i!=fcn.nops(); i++) {
988             arg_diff = fcn.op(i).diff(s);
989             if (!arg_diff.is_zero()) {
990                 lst new_lst = ex_to_lst(seq[1]);
991                 new_lst.append(i);
992                 result += arg_diff * Derivative(fcn, new_lst);
993             }
994         }
995     } else {
996         // Chain rule
997         ex arg_diff;
998         for (unsigned i=0; i!=seq.size(); i++) {
999             arg_diff = seq[i].diff(s);
1000             // We apply the chain rule only when it makes sense.  This is not
1001             // just for performance reasons but also to allow functions to
1002             // throw when differentiated with respect to one of its arguments
1003             // without running into trouble with our automatic full
1004             // differentiation:
1005             if (!arg_diff.is_zero())
1006                 result += pderivative(i)*arg_diff;
1007         }
1008     }
1009     return result;
1010 }
1011
1012 int function::compare_same_type(const basic & other) const
1013 {
1014     GINAC_ASSERT(is_of_type(other, function));
1015     const function & o=static_cast<function &>(const_cast<basic &>(other));
1016
1017     if (serial!=o.serial) {
1018         return serial < o.serial ? -1 : 1;
1019     }
1020     return exprseq::compare_same_type(o);
1021 }
1022
1023 bool function::is_equal_same_type(const basic & other) const
1024 {
1025     GINAC_ASSERT(is_of_type(other, function));
1026     const function & o=static_cast<function &>(const_cast<basic &>(other));
1027
1028     if (serial!=o.serial) return false;
1029     return exprseq::is_equal_same_type(o);
1030 }
1031
1032 unsigned function::return_type(void) const
1033 {
1034     if (seq.size()==0) {
1035         return return_types::commutative;
1036     }
1037     return (*seq.begin()).return_type();
1038 }
1039    
1040 unsigned function::return_type_tinfo(void) const
1041 {
1042     if (seq.size()==0) {
1043         return tinfo_key;
1044     }
1045     return (*seq.begin()).return_type_tinfo();
1046 }
1047
1048 //////////
1049 // new virtual functions which can be overridden by derived classes
1050 //////////
1051
1052 // none
1053
1054 //////////
1055 // non-virtual functions in this class
1056 //////////
1057
1058 // protected
1059
1060 ex function::pderivative(unsigned diff_param) const // partial differentiation
1061 {
1062     GINAC_ASSERT(serial<registered_functions().size());
1063     
1064     if (registered_functions()[serial].derivative_f==0) {
1065         return Derivative(*this, lst(diff_param));
1066     }
1067     switch (registered_functions()[serial].nparams) {
1068         // the following lines have been generated for max. ${maxargs} parameters
1069 ${diff_switch_statement}
1070         // end of generated lines
1071     }        
1072     throw(std::logic_error("function::pderivative(): no diff function defined"));
1073 }
1074
1075 vector<function_options> & function::registered_functions(void)
1076 {
1077     static vector<function_options> * rf=new vector<function_options>;
1078     return *rf;
1079 }
1080
1081 bool function::lookup_remember_table(ex & result) const
1082 {
1083     return remember_table::remember_tables()[serial].lookup_entry(*this,result);
1084 }
1085
1086 void function::store_remember_table(ex const & result) const
1087 {
1088     remember_table::remember_tables()[serial].add_entry(*this,result);
1089 }
1090
1091 // public
1092
1093 unsigned function::register_new(function_options const & opt)
1094 {
1095     unsigned same_name=0;
1096     for (unsigned i=0; i<registered_functions().size(); ++i) {
1097         if (registered_functions()[i].name==opt.name) {
1098             same_name++;
1099         }
1100     }
1101     if (same_name>=opt.functions_with_same_name) {
1102         // we do not throw an exception here because this code is
1103         // usually executed before main(), so the exception could not
1104         // caught anyhow
1105         cerr << "WARNING: function name " << opt.name
1106              << " already in use!" << endl;
1107     }
1108     registered_functions().push_back(opt);
1109     if (opt.use_remember) {
1110         remember_table::remember_tables().
1111             push_back(remember_table(opt.remember_size,
1112                                      opt.remember_assoc_size,
1113                                      opt.remember_strategy));
1114     } else {
1115         remember_table::remember_tables().push_back(remember_table());
1116     }
1117     return registered_functions().size()-1;
1118 }
1119
1120 /** Find serial number of function by name and number of parameters.
1121  *  Throws exception if function was not found. */
1122 unsigned function::find_function(const string &name, unsigned nparams)
1123 {
1124     vector<function_options>::const_iterator i = function::registered_functions().begin(), end = function::registered_functions().end();
1125     unsigned serial = 0;
1126     while (i != end) {
1127         if (i->get_name() == name && i->get_nparams() == nparams)
1128             return serial;
1129         i++;
1130         serial++;
1131     }
1132     throw (std::runtime_error("no function '" + name + "' with " + ToString(nparams) + " parameters defined"));
1133 }
1134
1135 //////////
1136 // static member variables
1137 //////////
1138
1139 // none
1140
1141 //////////
1142 // global constants
1143 //////////
1144
1145 const function some_function;
1146 const type_info & typeid_function=typeid(some_function);
1147
1148 #ifndef NO_NAMESPACE_GINAC
1149 } // namespace GiNaC
1150 #endif // ndef NO_NAMESPACE_GINAC
1151
1152 END_OF_IMPLEMENTATION
1153
1154 print "Creating interface file function.h...";
1155 open OUT,">function.h" or die "cannot open function.h";
1156 print OUT $interface;
1157 close OUT;
1158 print "ok.\n";
1159
1160 print "Creating implementation file function.cpp...";
1161 open OUT,">function.cpp" or die "cannot open function.cpp";
1162 print OUT $implementation;
1163 close OUT;
1164 print "ok.\n";
1165
1166 print "done.\n";