cint/dummies.pl

   1 # Create files containing dummies, wrappers and so on to overcome certain
   2 # deficiencies in Cint.  In an ideal world it would be unnecessary.
   3
   4 $header='dummies.h';
   5 $source='dummies.cpp';
   6
   7 # Generate a header file which is additionally included in cint
   8 # to work around the broken overloading resolution of cint for
   9 # C library functions and other problems.
  10 # E.g: if a function declared as ex sin(ex const & x) and called
  11 # with sin(y) where y is a symbol, cint favours a conversion from
  12 # symbol to void * to double over symbol to ex and thus calls the
  13 # C math library function double sin(double x) (sigh!)
  14
  15 # types which need help to be converted to ex
  16 @types=('symbol','function','constant','idx','lorentzidx','coloridx');
  17 @moretypes=('numeric','int','double');
  18 @extype=('ex');
  19
  20 # C math library functions with one parameter and return type 'function'
  21 @cfunc_1p_function=('sin','cos','tan','asin','acos','atan','exp','log',
  22                     'sinh','cosh','tanh','abs');
  23
  24 # C math library functions with one parameter and return type 'ex'
  25 @cfunc_1p_ex=('sqrt');
  26
  27 # C math library functions with two parameters and return type 'function'
  28 @cfunc_2p_function=('atan2');
  29
  30 # C math library functions with two parameters and return type 'ex'
  31 @cfunc_2p_ex=('pow');
  32
  33 @binops_ex=('+','-','*','/','%');
  34 @binops_relational=('==','!=','<','<=','>','>=');
  35 @binops_exconstref=('+=','-=','*=','/=');
  36
  37 open OUT,">$header";
  38
  39 $opening=<<END_OF_OPENING;
  40 /*  dummies.h
  41  *
  42  *  Dummies and wrappers to overcome certain deficiencies of Cint.
  43  *  This file was generated automatically by dummies.pl.
  44  *  Please do not modify it directly, edit the perl script instead!
  45  */
  46
  47 #if (!defined(G_CINTVERSION)) || (G_CINTVERSION < 501437)
  48 // this dummy file seems to be no longer needed for cint >= 5.14.37
  49
  50 END_OF_OPENING
  51
  52 print OUT $opening;
  53
  54 sub inline_cfunc_1p {
  55     my ($rettype,$funcsref)=@_;
  56     foreach $f (@$funcsref) {
  57         print OUT "// fixes for $rettype $f(x)\n";
  58         foreach $t (@types) {
  59             print OUT "inline $rettype $f($t const & x) { return $f(ex(x)); }\n";
  60         }
  61         print OUT "\n";
  62     }
  63 }
  64
  65 inline_cfunc_1p('function',\@cfunc_1p_function);
  66 inline_cfunc_1p('ex',\@cfunc_1p_ex);
  67
  68 sub inline_single_cfunc_2p {
  69     my ($rettype,$types1ref,$types2ref)=@_;
  70     foreach $t1 (@$types1ref) {
  71         foreach $t2 (@$types2ref) {
  72             print OUT "inline $rettype $f($t1 const & x,$t2 const & y) {\n";
  73             print OUT "    return $f(ex(x),ex(y));\n";
  74             print OUT "}\n";
  75         }
  76     }
  77 }
  78
  79 sub inline_cfunc_2p {
  80     my ($rettype,$funcsref)=@_;
  81     foreach $f (@$funcsref) {
  82         print OUT "// fixes for $rettype $f(x,y)\n";
  83         inline_single_cfunc_2p($rettype,\@types,\@types);
  84         inline_single_cfunc_2p($rettype,\@types,\@moretypes);
  85         inline_single_cfunc_2p($rettype,\@moretypes,\@types);
  86         inline_single_cfunc_2p($rettype,\@extype,\@moretypes);
  87         inline_single_cfunc_2p($rettype,\@moretypes,\@extype);
  88         print OUT "\n";
  89     }
  90 }
  91
  92 inline_cfunc_2p('function',\@cfunc_2p_function);
  93 inline_cfunc_2p('ex',\@cfunc_2p_ex);
  94
  95 sub inline_function_1p {
  96     my ($rettype,$func)=@_;
  97     print OUT "inline $rettype $func(basic const & x) {\n";
  98     print OUT "    return $func(ex(x));\n";
  99     print OUT "}\n";
 100 }
 101
 102 sub inline_single_function_2p {
 103     my ($rettype,$func,$t1,$cast1,$t2,$cast2)=@_;
 104     print OUT "inline $rettype $func($t1 x, $t2 y) {\n";
 105     print OUT "    return $func($cast1(x),$cast2(y));\n";
 106     print OUT "}\n";
 107 }
 108
 109 sub inline_single_function_2p_with_defarg {
 110     my ($rettype,$func,$t1,$defarg)=@_;
 111     print OUT "inline $rettype $func(basic const & x, $t1 y=$defarg) {\n";
 112     print OUT "    return $func(ex(x),y);\n";
 113     print OUT "}\n";
 114 }
 115
 116 sub inline_single_function_3p {
 117     my ($rettype,$func,$t1,$cast1,$t2,$cast2,$t3,$cast3)=@_;
 118     print OUT "inline $rettype $func($t1 x, $t2 y, $t3 z) {\n";
 119     print OUT "    return $func($cast1(x),$cast2(y),$cast3(z));\n";
 120     print OUT "}\n";
 121 }
 122
 123 sub inline_single_function_3p_with_defarg {
 124     my ($rettype,$func,$t1,$cast1,$t2,$cast2,$t3,$defarg)=@_;
 125     print OUT "inline $rettype $func($t1 x, $t2 y, $t3 z=$defarg) {\n";
 126     print OUT "    return $func($cast1(x),$cast2(y),z);\n";
 127     print OUT "}\n";
 128 }
 129
 130 sub inline_single_function_4p_with_defarg {
 131     my ($rettype,$func,$t1,$cast1,$t2,$cast2,$t3,$cast3,$t4,$defarg)=@_;
 132     print OUT "inline $rettype $func($t1 x, $t2 y, $t3 z, $t4 zz=$defarg) {\n";
 133     print OUT "    return $func($cast1(x),$cast2(y),$cast3(z),zz);\n";
 134     print OUT "}\n";
 135 }
 136
 137 sub inline_single_binop {
 138     my ($rettype,$op,$t1,$cast1,$t2,$cast2)=@_;
 139     inline_single_function_2p($rettype,'operator'.$op,$t1,$cast1,$t2,$cast2);
 140 }
 141
 142 sub inline_single_unaryop {
 143     my ($rettype,$op)=@_;
 144     print OUT "inline $rettype operator$op(basic const & x) {\n";
 145     print OUT "    return operator$op(ex(x));\n";
 146     print OUT "}\n";
 147 }
 148
 149 sub inline_function_2p {
 150     my ($rettype,$func)=@_;
 151     print OUT "// fixes for $rettype $func(x,y)\n";
 152     inline_single_function_2p($rettype,$func,'ex const &','','basic const &','ex');
 153     inline_single_function_2p($rettype,$func,'basic const &','ex','ex const &','');
 154     inline_single_function_2p($rettype,$func,'basic const &','ex','basic const &','ex');
 155     print OUT "\n";
 156 }
 157
 158 sub inline_binops {
 159     my ($rettype,$opsref)=@_;
 160     foreach $op (@$opsref) {
 161         inline_function_2p($rettype,'operator'.$op);
 162     }
 163 }
 164
 165 inline_binops('ex',\@binops_ex);
 166 inline_binops('relational',\@binops_relational);
 167 foreach $op (@binops_exconstref) {
 168     print OUT "// fixes for ex const & operator$op(x,y)\n";
 169     inline_single_binop('ex const &',$op,'ex &','','basic const &','ex');
 170 }
 171
 172 print OUT "// fixes for other operators\n";
 173 inline_single_unaryop('ex','+');
 174 inline_single_unaryop('ex','-');
 175 print OUT "inline ostream & operator<<(ostream & os, basic const & x) {\n";
 176 print OUT "    return operator<<(os,ex(x));\n";
 177 print OUT "}\n";
 178
 179 print OUT "// fixes for functions\n";
 180 inline_function_2p('bool','are_ex_trivially_equal');
 181 inline_function_1p('unsigned','nops');
 182 inline_function_1p('ex','expand');
 183 inline_function_2p('bool','has');
 184 inline_single_function_2p('int','degree','basic const &','ex','symbol const &','');
 185 inline_single_function_2p('int','ldegree','basic const &','ex','symbol const &','');
 186 inline_single_function_3p_with_defarg('ex','coeff','basic const &','ex','symbol const &','','int','1');
 187 inline_function_1p('ex','numer');
 188 inline_function_1p('ex','denom');
 189 inline_single_function_2p_with_defarg('ex','normal','int','0');
 190 inline_single_function_2p('ex','collect','basic const &','ex','symbol const &','');
 191 inline_single_function_2p_with_defarg('ex','eval','int','0');
 192 inline_single_function_2p_with_defarg('ex','evalf','int','0');
 193 inline_single_function_3p_with_defarg('ex','diff','basic const &','ex','symbol const &','','int','1');
 194 inline_single_function_3p('ex','series','const basic &','ex','const relational &','ex','int','');
 195 inline_single_function_3p('ex','series','const basic &','ex','const symbol &','ex','int','');
 196 inline_function_2p('ex','subs');
 197 inline_single_function_3p('ex','subs','basic const &','ex','lst const &','','lst const &','');
 198 inline_single_function_2p('ex','op','basic const &','ex','int','');
 199 inline_function_1p('ex','lhs');
 200 inline_function_1p('ex','rhs');
 201 inline_function_1p('bool','is_zero');
 202
 203 # fixes for simp_lor.h
 204 inline_function_2p('simp_lor','lor_g');
 205 inline_single_function_2p('simp_lor','lor_vec','const string &','','const basic &','ex');
 206
 207 print OUT "\n#endif // (!defined(G_CINTVERSION)) || (G_CINTVERSION < 501437)\n";
 208
 209 close OUT;
 210
 211 # Create a file containing stubs that may be necessary because Cint always
 212 # wants to link against anything that was ever declared:
 213
 214 open OUT,">$source";
 215
 216 $opening=<<END_OF_OPENING;
 217 /*  dummies.cpp
 218  *
 219  *  Dummies and stubs to overcome certain deficiencies of Cint.
 220  *  This file was generated automatically by dummies.pl.
 221  *  Please do not modify it directly, edit the perl script instead!
 222  */
 223
 224 #include <ginac/function.h>
 225
 226 #ifndef NO_NAMESPACE_GINAC
 227 namespace GiNaC {
 228 #endif // ndef NO_NAMESPACE_GINAC
 229
 230 END_OF_OPENING
 231
 232 print OUT $opening;
 233 print OUT "void ginsh_get_ginac_functions(void) { }\n";
 234
 235 $closing=<<END_OF_CLOSING;
 236
 237 #ifndef NO_NAMESPACE_GINAC
 238 }
 239 #endif // ndef NO_NAMESPACE_GINAC
 240
 241 END_OF_CLOSING
 242
 243 print OUT $closing;
 244
 245 close OUT;
 246
 247 # Create dummies