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";