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