eval.cpp

   1 // Evaluate an expression, for example...
   2 //
   3 //      push(p1)
   4 //      eval()
   5 //      p2 = pop()
   6
   7 #include "stdafx.h"
   8 #include "defs.h"
   9
  10 void
  11 eval(void)
  12 {
  13         check_esc_flag();
  14         save();
  15         p1 = pop();
  16         switch (p1->k) {
  17         case CONS:
  18                 eval_cons();
  19                 break;
  20         case NUM:
  21                 push(p1);
  22                 break;
  23         case DOUBLE:
  24                 push(p1);
  25                 break;
  26         case STR:
  27                 push(p1);
  28                 break;
  29         case TENSOR:
  30                 eval_tensor();
  31                 break;
  32         case SYM:
  33                 eval_sym();
  34                 break;
  35         default:
  36                 stop("atom?");
  37                 break;
  38         }
  39         restore();
  40 }
  41
  42 void
  43 eval_sym(void)
  44 {
  45         // bare keyword?
  46
  47         if (iskeyword(p1)) {
  48                 push(p1);
  49                 push(symbol(LAST));
  50                 list(2);
  51                 eval();
  52                 return;
  53         }
  54
  55         // evaluate symbol's binding
  56
  57         p2 = get_binding(p1);
  58         push(p2);
  59         if (p1 != p2)
  60                 eval();
  61 }
  62
  63 void
  64 eval_cons(void)
  65 {
  66         if (!issymbol(car(p1)))
  67                 stop("cons?");
  68
  69         switch (symnum(car(p1))) {
  70         case ABS:               eval_abs();             break;
  71         case ADD:               eval_add();             break;
  72         case ADJ:               eval_adj();             break;
  73         case AND:               eval_and();             break;
  74         case ARCCOS:            eval_arccos();          break;
  75         case ARCCOSH:           eval_arccosh();         break;
  76         case ARCSIN:            eval_arcsin();          break;
  77         case ARCSINH:           eval_arcsinh();         break;
  78         case ARCTAN:            eval_arctan();          break;
  79         case ARCTANH:           eval_arctanh();         break;
  80         case ARG:               eval_arg();             break;
  81         case ATOMIZE:           eval_atomize();         break;
  82         //case BESSELJ:         eval_besselj();         break;
  83         //case BESSELY:         eval_bessely();         break;
  84         case BINDING:           eval_binding();         break;
  85         case BINOMIAL:          eval_binomial();        break;
  86         case CEILING:           eval_ceiling();         break;
  87         case CHECK:             eval_check();           break;
  88         case CHOOSE:            eval_choose();          break;
  89         case CIRCEXP:           eval_circexp();         break;
  90         case CLEAR:             eval_clear();           break;
  91         case CLOCK:             eval_clock();           break;
  92         case COEFF:             eval_coeff();           break;
  93         case COFACTOR:          eval_cofactor();        break;
  94         case CONDENSE:          eval_condense();        break;
  95         case CONJ:              eval_conj();            break;
  96         case CONTRACT:          eval_contract();        break;
  97         case COS:               eval_cos();             break;
  98         case COSH:              eval_cosh();            break;
  99         case DECOMP:            eval_decomp();          break;
 100         case DEGREE:            eval_degree();          break;
 101         case DEFINT:            eval_defint();          break;
 102         case DENOMINATOR:       eval_denominator();     break;
 103         case DERIVATIVE:        eval_derivative();      break;
 104         case DET:               eval_det();             break;
 105         case DIM:               eval_dim();             break;
 106         case DIRAC:             eval_dirac();           break;
 107         //case DISPLAY:         eval_display();         break;
 108         case DIVISORS:          eval_divisors();        break;
 109         case DO:                eval_do();              break;
 110         case DOT:               eval_inner();           break;
 111         //case DRAW:            eval_draw();            break;
 112         case DSOLVE:            eval_dsolve();          break;
 113         case EIGEN:             eval_eigen();           break;
 114         case EIGENVAL:          eval_eigenval();        break;
 115         case EIGENVEC:          eval_eigenvec();        break;
 116         case ERF:               eval_erf();             break;
 117         case ERFC:              eval_erfc();            break;
 118         case EVAL:              eval_eval();            break;
 119         case EXP:               eval_exp();             break;
 120         case EXPAND:            eval_expand();          break;
 121         case EXPCOS:            eval_expcos();          break;
 122         case EXPSIN:            eval_expsin();          break;
 123         case FACTOR:            eval_factor();          break;
 124         case FACTORIAL:         eval_factorial();       break;
 125         case FACTORPOLY:        eval_factorpoly();      break;
 126         case FILTER:            eval_filter();          break;
 127         case FLOATF:            eval_float();           break;
 128         case FLOOR:             eval_floor();           break;
 129         case FOR:               eval_for();             break;
 130         case GAMMA:             eval_gamma();           break;
 131         case GCD:               eval_gcd();             break;
 132         case HERMITE:           eval_hermite();         break;
 133         case HILBERT:           eval_hilbert();         break;
 134         case IMAG:              eval_imag();            break;
 135         case INDEX:             eval_index();           break;
 136         case INNER:             eval_inner();           break;
 137         case INTEGRAL:          eval_integral();        break;
 138         case INV:               eval_inv();             break;
 139         case INVG:              eval_invg();            break;
 140         case ISINTEGER:         eval_isinteger();       break;
 141         case ISPRIME:           eval_isprime();         break;
 142         case LAGUERRE:          eval_laguerre();        break;
 143 //      case LAPLACE:           eval_laplace();         break;
 144         case LCM:               eval_lcm();             break;
 145         case LEADING:           eval_leading();         break;
 146         case LEGENDRE:          eval_legendre();        break;
 147         case LOG:               eval_log();             break;
 148         case MAG:               eval_mag();             break;
 149         case MOD:               eval_mod();             break;
 150         case MULTIPLY:          eval_multiply();        break;
 151         case NOT:               eval_not();             break;
 152         case NROOTS:            eval_nroots();          break;
 153         case NUMBER:            eval_number();          break;
 154         case NUMERATOR:         eval_numerator();       break;
 155         case OPERATOR:          eval_operator();        break;
 156         case OR:                eval_or();              break;
 157         case OUTER:             eval_outer();           break;
 158         case POLAR:             eval_polar();           break;
 159         case POWER:             eval_power();           break;
 160         case PRIME:             eval_prime();           break;
 161         case PRINT:             eval_display();         break;
 162         case PRODUCT:           eval_product();         break;
 163         case QUOTE:             eval_quote();           break;
 164         case QUOTIENT:          eval_quotient();        break;
 165 //        case RANDOM:              eval_random();            break; // by gbl08ma
 166         case RANK:              eval_rank();            break;
 167         case RATIONALIZE:       eval_rationalize();     break;
 168         case REAL:              eval_real();            break;
 169         case YYRECT:            eval_rect();            break;
 170         case ROOTS:             eval_roots();           break;
 171         case SETQ:              eval_setq();            break;
 172         case SGN:               eval_sgn();             break;
 173         case SIMPLIFY:          eval_simplify();        break;
 174         case SIN:               eval_sin();             break;
 175         case SINH:              eval_sinh();            break;
 176         case SQRT:              eval_sqrt();            break;
 177         case STOP:              eval_stop();            break;
 178         case SUBST:             eval_subst();           break;
 179         case SUM:               eval_sum();             break;
 180         case TAN:               eval_tan();             break;
 181         case TANH:              eval_tanh();            break;
 182         case TAYLOR:            eval_taylor();          break;
 183         case TEST:              eval_test();            break;
 184         case TESTEQ:            eval_testeq();          break;
 185         case TESTGE:            eval_testge();          break;
 186         case TESTGT:            eval_testgt();          break;
 187         case TESTLE:            eval_testle();          break;
 188         case TESTLT:            eval_testlt();          break;
 189         case TRANSPOSE:         eval_transpose();       break;
 190         case UNIT:              eval_unit();            break;
 191         case ZERO:              eval_zero();            break;
 192         default:                eval_user_function();   break;
 193         }
 194 }
 195
 196 void
 197 eval_binding(void)
 198 {
 199         push(get_binding(cadr(p1)));
 200 }
 201
 202 // checks a predicate, i.e. check(A = B)
 203
 204 void
 205 eval_check(void)
 206 {
 207         push(cadr(p1));
 208         eval_predicate();
 209         p1 = pop();
 210         if (iszero(p1))
 211                 stop("check(arg): arg is zero");
 212         push(symbol(NIL)); // no result is printed
 213 }
 214
 215 void
 216 eval_det(void)
 217 {
 218         push(cadr(p1));
 219         eval();
 220         det();
 221 }
 222
 223 void
 224 eval_dim(void)
 225 {
 226         int n;
 227         push(cadr(p1));
 228         eval();
 229         p2 = pop();
 230         if (iscons(cddr(p1))) {
 231                 push(caddr(p1));
 232                 eval();
 233                 n = pop_integer();
 234         } else
 235                 n = 1;
 236         if (!istensor(p2))
 237                 push_integer(1); // dim of scalar is 1
 238         else if (n < 1 || n > p2->u.tensor->ndim)
 239                 push(p1);
 240         else
 241                 push_integer(p2->u.tensor->dim[n - 1]);
 242 }
 243
 244 void
 245 eval_divisors(void)
 246 {
 247         push(cadr(p1));
 248         eval();
 249         divisors();
 250 }
 251
 252 void
 253 eval_do(void)
 254 {
 255         push(car(p1));
 256         p1 = cdr(p1);
 257         while (iscons(p1)) {
 258                 pop();
 259                 push(car(p1));
 260                 eval();
 261                 p1 = cdr(p1);
 262         }
 263 }
 264
 265 void
 266 eval_dsolve(void)
 267 {
 268         push(cadr(p1));
 269         eval();
 270         push(caddr(p1));
 271         eval();
 272         push(cadddr(p1));
 273         eval();
 274         dsolve();
 275 }
 276
 277 // for example, eval(f,x,2)
 278
 279 void
 280 eval_eval(void)
 281 {
 282         push(cadr(p1));
 283         eval();
 284         p1 = cddr(p1);
 285         while (iscons(p1)) {
 286                 push(car(p1));
 287                 eval();
 288                 push(cadr(p1));
 289                 eval();
 290                 subst();
 291                 p1 = cddr(p1);
 292         }
 293         eval();
 294 }
 295
 296 void
 297 eval_exp(void)
 298 {
 299         push(cadr(p1));
 300         eval();
 301         exponential();
 302 }
 303
 304 void
 305 eval_factorial(void)
 306 {
 307         push(cadr(p1));
 308         eval();
 309         factorial();
 310 }
 311
 312 void
 313 eval_factorpoly(void)
 314 {
 315         p1 = cdr(p1);
 316         push(car(p1));
 317         eval();
 318         p1 = cdr(p1);
 319         push(car(p1));
 320         eval();
 321         factorpoly();
 322         p1 = cdr(p1);
 323         while (iscons(p1)) {
 324                 push(car(p1));
 325                 eval();
 326                 factorpoly();
 327                 p1 = cdr(p1);
 328         }
 329 }
 330
 331 void
 332 eval_hermite(void)
 333 {
 334         push(cadr(p1));
 335         eval();
 336         push(caddr(p1));
 337         eval();
 338         hermite();
 339 }
 340
 341 void
 342 eval_hilbert(void)
 343 {
 344         push(cadr(p1));
 345         eval();
 346         hilbert();
 347 }
 348
 349 void
 350 eval_index(void)
 351 {
 352         int h;
 353         h = tos;
 354         p1 = cdr(p1);
 355         while (iscons(p1)) {
 356                 push(car(p1));
 357                 eval();
 358                 p1 = cdr(p1);
 359         }
 360         index_function(tos - h);
 361 }
 362
 363 void
 364 eval_inv(void)
 365 {
 366         push(cadr(p1));
 367         eval();
 368         inv();
 369 }
 370
 371 void
 372 eval_invg(void)
 373 {
 374         push(cadr(p1));
 375         eval();
 376         invg();
 377 }
 378
 379 void
 380 eval_isinteger(void)
 381 {
 382         int n;
 383         push(cadr(p1));
 384         eval();
 385         p1 = pop();
 386         if (isrational(p1)) {
 387                 if (isinteger(p1))
 388                         push(one);
 389                 else
 390                         push(zero);
 391                 return;
 392         }
 393         if (isdouble(p1)) {
 394                 n = (int) p1->u.d;
 395                 if (n == p1->u.d)
 396                         push(one);
 397                 else
 398                         push(zero);
 399                 return;
 400         }
 401         push_symbol(ISINTEGER);
 402         push(p1);
 403         list(2);
 404 }
 405
 406 void
 407 eval_multiply(void)
 408 {
 409         push(cadr(p1));
 410         eval();
 411         p1 = cddr(p1);
 412         while (iscons(p1)) {
 413                 push(car(p1));
 414                 eval();
 415                 multiply();
 416                 p1 = cdr(p1);
 417         }
 418 }
 419
 420 void
 421 eval_number(void)
 422 {
 423         push(cadr(p1));
 424         eval();
 425         p1 = pop();
 426         if (p1->k == NUM || p1->k == DOUBLE)
 427                 push_integer(1);
 428         else
 429                 push_integer(0);
 430 }
 431
 432 void
 433 eval_operator(void)
 434 {
 435         int h = tos;
 436         push_symbol(OPERATOR);
 437         p1 = cdr(p1);
 438         while (iscons(p1)) {
 439                 push(car(p1));
 440                 eval();
 441                 p1 = cdr(p1);
 442         }
 443         list(tos - h);
 444 }
 445
 446 void
 447 eval_print(void)
 448 {
 449         p1 = cdr(p1);
 450         while (iscons(p1)) {
 451                 push(car(p1));
 452                 eval();
 453                 if (equaln(get_binding(symbol(TTY)), 1))
 454                         printline(pop());
 455                 else
 456                         display(pop());
 457                 p1 = cdr(p1);
 458         }
 459         push(symbol(NIL));
 460 }
 461
 462 void
 463 eval_quote(void)
 464 {
 465         push(cadr(p1));
 466 }
 467
 468 void
 469 eval_rank(void)
 470 {
 471         push(cadr(p1));
 472         eval();
 473         p1 = pop();
 474         if (istensor(p1))
 475                 push_integer(p1->u.tensor->ndim);
 476         else
 477                 push(zero);
 478 }
 479
 480 //-----------------------------------------------------------------------------
 481 //
 482 //      Example: a[1] = b
 483 //
 484 //      p1      *-------*-----------------------*
 485 //              |       |                       |
 486 //              setq    *-------*-------*       b
 487 //                      |       |       |
 488 //                      index   a       1
 489 //
 490 //      cadadr(p1) -> a
 491 //
 492 //-----------------------------------------------------------------------------
 493
 494 void
 495 setq_indexed(void)
 496 {
 497         int h;
 498         p4 = cadadr(p1);
 499         if (!issymbol(p4))
 500                 stop("indexed assignment: error in symbol");
 501         h = tos;
 502         push(caddr(p1));
 503         eval();
 504         p2 = cdadr(p1);
 505         while (iscons(p2)) {
 506                 push(car(p2));
 507                 eval();
 508                 p2 = cdr(p2);
 509         }
 510         set_component(tos - h);
 511         p3 = pop();
 512         set_binding(p4, p3);
 513         push(symbol(NIL));
 514 }
 515
 516 void
 517 eval_setq(void)
 518 {
 519         if (caadr(p1) == symbol(INDEX)) {
 520                 setq_indexed();
 521                 return;
 522         }
 523
 524         if (iscons(cadr(p1))) {
 525                 define_user_function();
 526                 return;
 527         }
 528
 529         if (!issymbol(cadr(p1)))
 530                 stop("symbol assignment: error in symbol");
 531
 532         push(caddr(p1));
 533         eval();
 534         p2 = pop();
 535         set_binding(cadr(p1), p2);
 536
 537         push(symbol(NIL));
 538 }
 539
 540 void
 541 eval_sqrt(void)
 542 {
 543         push(cadr(p1));
 544         eval();
 545         push_rational(1, 2);
 546         power();
 547 }
 548
 549 void
 550 eval_stop(void)
 551 {
 552         stop("user stop");
 553 }
 554
 555 void
 556 eval_subst(void)
 557 {
 558         push(cadddr(p1));
 559         eval();
 560         push(caddr(p1));
 561         eval();
 562         push(cadr(p1));
 563         eval();
 564         subst();
 565         eval(); // normalize
 566 }
 567
 568 void
 569 eval_unit(void)
 570 {
 571         int i, n;
 572         push(cadr(p1));
 573         eval();
 574         n = pop_integer();
 575         if (n < 2) {
 576                 push(p1);
 577                 return;
 578         }
 579         p1 = alloc_tensor(n * n);
 580         p1->u.tensor->ndim = 2;
 581         p1->u.tensor->dim[0] = n;
 582         p1->u.tensor->dim[1] = n;
 583         for (i = 0; i < n; i++)
 584                 p1->u.tensor->elem[n * i + i] = one;
 585         push(p1);
 586 }
 587
 588 void
 589 eval_noexpand(void)
 590 {
 591         int x = expanding;
 592         expanding = 0;
 593         eval();
 594         expanding = x;
 595 }
 596
 597 // like eval() except "=" is evaluated as "=="
 598
 599 void
 600 eval_predicate(void)
 601 {
 602         save();
 603         p1 = pop();
 604         if (car(p1) == symbol(SETQ))
 605                 eval_testeq();
 606         else {
 607                 push(p1);
 608                 eval();
 609         }
 610         restore();
 611 }